Remove accidental file

Remove accidental file

--- src/exp/sas_hierarchy_induction_old.clj
+++ src/exp/sas_hierarchy_induction_old.clj
@@ -1,249 +0,0 @@
-(ns exp.sas-hierarchy-induction
-  (:require [edu.berkeley.ai.util :as util]
-            [edu.berkeley.ai.util  [graphs :as graphs]]
-            [exp [env :as env]  [hierarchy :as hierarchy] [sas :as sas] [sas-analysis :as sas-analysis]])
-  (:import [java.util HashMap]))
-
-
-;; Right now, this is only for DAGs.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def no-effect ::NO-EFFECT)
-(defn disjoin-effect-maps [m1 m2])
-
-
-(def *vars* nil)
-(def *reverse-dtgs* nil)
-(def #^HashMap *hla-cache* nil) ; a map from [action-name] to map from init-sets to action.
-
-(def *ap-key* :!A)
-(def *vv-key* :!VV)
-
-(defprotocol SAS-Induced-Action
-  (precond-var-set [a])
-  (initial-sets    [a])
-  (effect-sets     [a]))
-
-(extend ::env/FactoredPrimitive
-  SAS-Induced-Action
-    {:precond-var-set (fn [a] (util/keyset (:precond-map a)))
-     :initial-sets    (fn [a] (util/map-vals (fn [x] #{x}) (:precond-map a)))
-     :effect-sets     (fn [a] (util/map-vals (fn [x] #{x}) (:effect-map a)))})
-
-(defn vv-hla-name [var val] [*vv-key* var val])
-(deftype SAS-VV-HLA     [var val precond-vars init-sets effect-sets refinements]
-  SAS-Induced-Action
-    (precond-var-set [] precond-vars)
-    (initial-sets    [] init-sets)
-    (effect-sets     [] effect-sets)
-  env/Action
-    (action-name [] (vv-hla-name var val))
-    (primitive?  [] false)
-  env/ContextualAction
-    (precondition-context [s] #_ (util/assert-is (util/subset? (util/keyset effect-sets) precond-vars)) precond-vars)
-  hierarchy/HighLevelAction
-    (immediate-refinements- [s] refinements)
-    (cycle-level-           [s] nil))
-
-(defn action-hla-name [action] [*ap-key* (env/action-name action)])
-(deftype SAS-Action-HLA [action  precond-vars init-sets effect-sets refinements]
-  SAS-Induced-Action
-    (precond-var-set [] precond-vars)
-    (initial-sets    [] init-sets)
-    (effect-sets     [] effect-sets)
-  env/Action
-    (action-name [] (action-hla-name action))
-    (primitive?  [] false)
-  env/ContextualAction
-    (precondition-context [s] #_ (util/assert-is (util/subset? (util/keyset effect-sets) precond-vars)) precond-vars)
-  hierarchy/HighLevelAction
-    (immediate-refinements- [s] refinements)
-    (cycle-level-           [s] nil))
-
-
-(declare induce-action-hla induce-vv-hla)
-
-;; TODO: handle effect merges properly.
-;; TODO: make sure we don't waste our time on new descendant values. (easy, just use current context.)
-; Note: in this framework, ancestor in CG does not entail ordering?
- ; Can we create graph for this bit too, so we reuse ?
-; Adding to init, can totally change a-p graph.
-
-; Question; how do we handle A-P actions generally (establishing 1 may change init for other).
-; Question: can we just do all of this on the fly ?
-
-(defn progress-refinement [prim-ref init-sets ]
-  (util/print-debug 2 "Progressing plan" prim-ref)
-  (loop [prim-ref prim-ref, hla-ref [], plan-effect-sets {}]
-    (if (empty? prim-ref)
-        [hla-ref plan-effect-sets]
-      (let [a     (first prim-ref)
-            hla-a (induce-action-hla a (merge init-sets plan-effect-sets) )]
-        (recur (rest prim-ref) (conj hla-ref hla-a) (merge plan-effect-sets (effect-sets hla-a)))))))
-
-;; Want to look at acyclic paths, which include at most one free-action. (with no precond on var.)
-;; Two things we can do here; recursive style (works from any src, more caching) or direct style
- ;; (avoid cycles, more focused description/pruning, but less caching and less general).
-
-;; TODO: induce stronger preconditions for refinements?
-;; TODO: split init-sets based on init val for var ?
-;; Now: do forward search from inits.  For each init, keep track of outgoing HLAs, init sets.
-  ;  Keep iterating until no new values added to inits.
-  ;  Also keep track of set of vals on all paths to val, to avoid cycles in exploration as possible.
-    ; If we keep all this info around in HLA, extending becomes easier.
-(defn induce-vv-hla- [var goal-val init-sets]
-  (util/print-debug 2 "Inducing HLA to get" var "to val" goal-val "from" (init-sets var))
-  (let [inits        (init-sets var)
-        reverse-dtg  (*reverse-dtgs* var)
-        forward-edges (for [[fval pmap] reverse-dtg, [pval _] pmap] [pval fval])
-        bad-edges    (set (graphs/find-cyclic-edges forward-edges (seq inits) [goal-val]))
-        reverse-dtg  (util/map-map (fn [[fval pmap]]
-                                     [fval (util/filter-map (fn [[pval _]] (not (contains? bad-edges [pval fval]))) pmap)]) reverse-dtg)
-        paths        (find-all-acyclic-paths var inits goal-val reverse-dtg)
-        refs-results (filter identity (map #(progress-refinement % init-sets ) paths))]
-    (if (and (util/singleton? refs-results) (util/singleton? (ffirst refs-results)))
-        (first (ffirst refs-results))
-      (when (seq refs-results)
-        (assert (apply = (map util/keyset (map second refs-results)))) ;; Otherwise, no-effect not handled properly when not in PC.
-        (SAS-VV-HLA var goal-val
-                    (set (for [[ref _] refs-results, a ref, v (precond-var-set a)] v))
-                    init-sets
-                    (apply merge-with clojure.set/union (map second refs-results))
-                    (map first refs-results))))))
-
-;; Ideas here:
- ; If actions can be partitioned such that effects of each set disjoint with preconditions of all other sets,
-   ; Such sets can be ordered arbitrarily.
-     ; (+ caveat about idempotent effects)
- ; Within a given set, ones with same effects can be ordered arbitrarily.
-
- ; Finally, generate interleavings ...
-
-;; Watch out: what happens when single action establishes multiple preconditions, e.g. ..
-;; TODO: need to treat subsets (i.e., transitive closure edges) specially.
-
-(defn induce-action-hla- [a init-sets ]
-  (util/print-debug 2 "Inducing HLA for preconds + action" (:name a))
-  (let [first-bits (doall (for [[pvar pval] (:precond-map a)
-                                :when (not (= (init-sets pvar) #{pval}))]
-                            (induce-vv-hla pvar pval init-sets )))]
-;    (println (:name a) (count first-bits))
-;    (doseq [b first-bits] (println "\n" (env/action-name b) "\n\n"))
-    (when (every? identity first-bits)
-     (if (empty? first-bits)
-         a
-       (let [bit (util/safe-singleton first-bits)]
-         (assert (= ((effect-sets bit) (:var bit)) #{(:val bit)}))
-         (SAS-Action-HLA
-          a
-          (clojure.set/union (util/keyset (:precond-map a)) (precond-var-set bit))
-          init-sets
-          (merge (effect-sets bit) (util/map-vals (fn [x] #{x}) (:effect-map a)))
-          [[bit a]]))))))
-
-
-;; TODO: figure out how much to generalize here.
-(defn cached-induce [name init-sets result-fn]
-  (let [entries (.get *hla-cache* name)]
-    (assert (not (identical? entries :STACK)))
-    (if-let [v (first (filter #(let [ks (precond-var-set %)]
-                                 (= (select-keys init-sets ks) (select-keys (initial-sets %) ks)))
-                              entries))]
-        (do (util/print-debug 3 "Cache hit for" name)
-            v)
-      (do (.put *hla-cache* name :STACK)
-          (let [ret (result-fn)]
-            (assert ret) ;; If we run into this, need to figure out how to properly cache failures.
-            (.put *hla-cache* name (cons ret entries))
-            ret)))))
-
-(defn induce-action-hla [a init-sets]
-  (cached-induce (action-hla-name a) init-sets #(induce-action-hla- a init-sets)))
-
-(defn induce-vv-hla [var goal-val init-sets ]
-  (cached-induce (vv-hla-name var goal-val) init-sets #(induce-vv-hla- var goal-val init-sets)))
-
-(defn induce-hierarchy [sas-problem]
-  (let [{:keys [vars actions init]} sas-problem]
-    (binding [*vars*         vars
-              *reverse-dtgs* (sas-analysis/reverse-domain-transition-graphs vars actions)
-              *hla-cache*    (HashMap.)
-              ]
-      (hierarchy/SimpleHierarchicalEnv sas-problem
-        [(util/make-safe
-          (induce-action-hla (util/safe-singleton (get-in *reverse-dtgs* [sas/goal-var-name sas/goal-true-val sas/goal-false-val]))
-                             (util/map-vals (fn [x] #{x}) init)))]))))
-
-
-
-
-
-(defmulti pretty-print-action type)
-
-(defn pretty-print-hla [h]
-  (println (str "\nRefs for HLA" (env/action-name h)) (precond-var-set h) #_ (effect-sets h))
-  (doseq [ref (:refinements h)]
-    (println " " (util/str-join ", " (map env/action-name ref))))
-  (doseq [ref (:refinements h), a ref]
-    (pretty-print-action a)))
-
-(defmethod pretty-print-action ::SAS-VV-HLA [h] (pretty-print-hla h))
-(defmethod pretty-print-action ::SAS-Action-HLA [h] (pretty-print-hla h))
-(defmethod pretty-print-action ::env/FactoredPrimitive [h] nil)
-
-
-(defn pretty-print-hierarchy [hierarchy]
-  (pretty-print-action (first (:initial-plan hierarchy))))
-
-
-
-
-
-
-
-
-
-
-;(induce-hierarchy  (make-sas-problem-from-pddl (prln (write-infinite-taxi-strips2 (make-random-infinite-taxi-env 2 2 1)))))
-
-(comment
-  ; not needed anymore?
-
-
-(defn find-all-acyclic-paths
-  ([var init-val-set goal-val reverse-dtg]
-     (find-all-acyclic-paths var init-val-set goal-val reverse-dtg nil #{} true))
-  ([var init-val-set goal-val reverse-dtg plan-suffix stack-val-set can-use-free?]
-;     (println "FACP" var init-val-set goal-val)
-     (when (and (seq init-val-set) (not (contains? stack-val-set goal-val)))
-       (if (contains? init-val-set goal-val)
-           (cons plan-suffix
-                 (find-all-acyclic-paths var (disj init-val-set goal-val) goal-val reverse-dtg plan-suffix
-                                         stack-val-set can-use-free?))
-         (apply concat
-           (for [[pval actions] (get reverse-dtg goal-val)
-                 a              actions
-                 :let  [action-free? (not (contains? (:precond-map a) var))]
-                 :when (or (not action-free?) can-use-free?)]
-             (find-all-acyclic-paths var init-val-set pval reverse-dtg (cons a plan-suffix)
-                                     (conj stack-val-set goal-val) (and can-use-free? (not action-free?)))))))))
-
-
-(defn induce-vv-hla- [var goal-val init-sets]
-  (util/print-debug 2 "Inducing HLA to get" var "to val" goal-val "from" (init-sets var))
-  (let [inits        (init-sets var)
-        reverse-dtg  (*reverse-dtgs* var)
-        paths        (find-all-acyclic-paths var inits goal-val reverse-dtg)
-        refs-results (filter identity (map #(progress-refinement % init-sets ) paths))]
-    (if (and (util/singleton? refs-results) (util/singleton? (ffirst refs-results)))
-        (first (ffirst refs-results))
-      (when (seq refs-results)
-        (assert (apply = (map util/keyset (map second refs-results)))) ;; Otherwise, no-effect not handled properly when not in PC.
-        (SAS-VV-HLA var goal-val
-                    (set (for [[ref _] refs-results, a ref, v (precond-var-set a)] v))
-                    init-sets
-                    (apply merge-with clojure.set/union (map second refs-results))
-                    (map first refs-results))))))
-
-)


minor aesthetics: no closed parens on newline

--- src/freecoin/views/transaction_form.clj
+++ src/freecoin/views/transaction_form.clj
@@ -2,8 +2,7 @@
   (:require [freecoin.config :as config]
             [freecoin.form_helpers :as fh]
             [freecoin.routes :as routes]
-            [freecoin.translation :as t]
-            ))
+            [freecoin.translation :as t]))

 (def transaction-form-spec
   {:renderer :bootstrap3-stacked


Use the same function call for all ingesting.


Using UTF-8 to directly read blobs to avoid emoji problems

--- src/ipython_clojure/messaging/utils.clj
+++ src/ipython_clojure/messaging/utils.clj
@@ -20,7 +20,7 @@

 (defn read-blob [socket]
   (let [part (zmq/receive socket)
-        blob (apply str (map char part))]
+        blob (String. part "UTF-8")]
     blob))

 (defn read-until-delimiter [socket]


[#2309] Remove test

[#2309] Remove test

--- backend/test/akvo/lumen/component/auth0_test.clj
+++ backend/test/akvo/lumen/component/auth0_test.clj
@@ -1,8 +0,0 @@
-(ns akvo.lumen.component.auth0-test
-  {:functional false}
-  (:require
-   [akvo.lumen.component.auth0 :as auth0]
-   [clojure.test :refer :all]))
-
-
-


fix TCLI-94: use js/Error, *print-err-fn*, custom format in cljs

Signed-off-by: Sean Corfield <d7e19930cc1f42c2d0781f4d9e6f1fe5891bf9cf@corfield.org>

--- src/main/clojure/clojure/tools/cli.cljc
+++ src/main/clojure/clojure/tools/cli.cljc
@@ -66,6 +66,14 @@
    (or (str default) "")
    (or docs "")])

+#?(:cljs
+   ;; `format` has been removed from cljs and Clojure's `format`
+   ;; isn't exactly what `google.format.string` does and so we
+   ;; just provide _a format_ for now
+   (defn format
+     [fmt & args]
+     (s/join " " args)))
+
 (defn- banner-for [desc specs]
   (when desc
     (println desc)
@@ -128,7 +136,8 @@
          (recur options (into extra-args (vec (rest args))) nil)

          (and (opt? opt) (nil? spec))
-         (throw (Exception. (str "'" opt "' is not a valid argument")))
+         (throw #?(:clj (Exception. (str "'" opt "' is not a valid argument"))
+                   :cljs (js/Error. (str "'" opt "' is not a valid argument"))))

          (and (opt? opt) (spec :flag))
          (recur ((spec :assoc-fn) options (spec :name) (flag-for opt))
@@ -230,9 +239,10 @@
   (when *assert*
     (let [unknown-keys (keys (apply dissoc map spec-keys))]
       (when (seq unknown-keys)
-        (binding [*out* *err*]
-          (println (str "Warning: The following options to parse-opts are unrecognized: "
-                        (s/join ", " unknown-keys)))))))
+        (let [msg (str "Warning: The following options to parse-opts are unrecognized: "
+                       (s/join ", " unknown-keys))]
+          #?(:clj  (binding [*out* *err*] (println msg))
+             :cljs (binding [*print-fn* *print-err-fn*] (println msg)))))))

   (select-keys map spec-keys))


task defaults: start in 24h and due in 48h

--- iwaswhere-web/src/cljs/iwaswhere_web/ui/entry/task.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/ui/entry/task.cljs
@@ -1,4 +1,5 @@
-(ns iwaswhere-web.ui.entry.task)
+(ns iwaswhere-web.ui.entry.task
+  (:require [matthiasn.systems-toolbox.component :as st]))

 (defn task-details
   [entry put-fn edit-mode?]
@@ -19,6 +20,12 @@
               (put-fn [:entry/update-local updated]))))]
     (fn [entry put-fn edit-mode?]
       (when (contains? (:tags entry) "#task")
+        (when-not (:task entry)
+          (let [d (* 24 60 60 1000)
+                now (st/now)
+                updated (assoc-in entry [:task] {:start (+ now d)
+                                                 :due   (+ now d d)})]
+            (put-fn [:entry/update-local updated])))
         [:form.task-details
          [:fieldset
           [:legend "Task details"]
@@ -43,11 +50,13 @@
              [:select {:value     (get-in entry [:task :follow-up-hrs])
                        :on-change (follow-up-select entry)}
               [:option ""]
-              [:option {:value 1} "1"]
-              [:option {:value 3} "3"]
-              [:option {:value 6} "6"]
-              [:option {:value 12} "12"]
-              [:option {:value 18} "18"]
-              [:option {:value 24} "24"]
-              [:option {:value 48} "48"]]
-             [:span "hours"]])]]))))
+              [:option {:value 1} "1 hour"]
+              [:option {:value 3} "3 hours"]
+              [:option {:value 6} "6 hours"]
+              [:option {:value 12} "12 hours"]
+              [:option {:value 18} "18 hours"]
+              [:option {:value 24} "24 hours"]
+              [:option {:value 48} "48 hours"]
+              [:option {:value 72} "3 days"]
+              [:option {:value 96} "4 days"]
+              [:option {:value 168} "1 week"]]])]]))))


s/:app/:bake/ (dsantiago, i changed it again)

--- src/cake/tasks/jar.clj
+++ src/cake/tasks/jar.clj
@@ -56,7 +56,7 @@
   (when-not (:omit-source *project*)
     (add-zipfileset task {:dir (source-dir)       :prefix prefix :includes "**/*.clj"})
     (add-zipfileset task {:dir (file "src" "jvm") :prefix prefix :includes "**/*.java"}))
-  (when (:app *project*)
+  (when (:bake *project*)
     (add-zipfileset task (bakepath :prefix prefix :excludes "cake.clj"))))

 (defn build-context []
@@ -70,7 +70,7 @@
 (defn build-jar []
   (let [maven (format "META-INF/maven/%s/%s" (:group-id *project*) (:artifact-id *project*))
         cake  (format "META-INF/cake/%s/%s"  (:group-id *project*) (:artifact-id *project*))]
-    (when (:app *project*)
+    (when (:bake *project*)
       (build-context))
     (ant Jar {:dest-file (jarfile)}
          (add-manifest (manifest))


fix new task

fix new task

--- src/cake/tasks/new.clj
+++ src/cake/tasks/new.clj
@@ -1,6 +1,7 @@
 (ns cake.tasks.new
   (:use cake cake.core cake.file cake.ant
-        [cake.project :only [group log]]
+        [bake.core :only [log]]
+        [cake.project :only [group]]
         [clojure.string :only [join]]
         [cake.utils.io :only [extract-resource]])
   (:import [org.apache.tools.ant.taskdefs Copy]))


Remove copied and unused code

Remove copied and unused code

--- src/cfpb/qu/loader.clj
+++ src/cfpb/qu/loader.clj
@@ -453,22 +453,6 @@
                             {"$set" update-map}
                             :multi true)))))

-(defn- set-reference-column
-  [dataset slice column columndef concepts]
-  (let [concept (keyword (:concept columndef))
-        concept-def (concepts concept)
-        collection (concept-collection concept)
-        value (keyword (:value columndef))
-        concept-data (->> (coll/find-maps collection)
-                          (map (fn [row]
-                                 [(concept row)
-                                  (value row)])))]
-    (doseq [[key value] concept-data]
-      (coll/update (name slice)
-                   {(keyword (:column columndef)) key}
-                   {"$set" {(keyword column) value}}
-                   :multi true))))
-
 (defn ez-load-slice
   "Load one slice for a dataset.
   Does not run Drake to process data first. Also does not run other


Pass along kvs-ident to coll state.

Pass along kvs-ident to coll state.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -19,7 +19,8 @@
     (act coll-init actx
          (let [res (areq coll-init kvs-mgr-ch {:op :kvs-open :name [path rev]})]
            (if (= (:status res) :ok)
-             (state-loop actx [:coll path rev] coll-handler {})
+             (state-loop actx [:coll path rev] coll-handler
+                         {:kvs-ident (:kvs-ident res)})
              (do (println "make-coll kvs-open failed" res)
                  ; TODO: Should also consume any reqs that raced onto coll-ch.
                  (aclose coll-init coll-ch)))))


[#10587] `Unable to resolve spec` at attempt to rename group chat

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/profile/db.cljs
+++ src/status_im/ui/screens/profile/db.cljs
@@ -1,6 +1,7 @@
 (ns status-im.ui.screens.profile.db
   (:require [clojure.string :as string]
-            [status-im.chat.constants :as chat.constants]))
+            [status-im.chat.constants :as chat.constants]
+            [cljs.spec.alpha :as spec]))

 (defn correct-name? [username]
   (when-let [username (some-> username (string/trim))]
@@ -16,4 +17,6 @@

 (defn base64-encoded-image-path? [photo-path]
   (or (base64-png? photo-path)
-      (base64-jpeg? photo-path)))+      (base64-jpeg? photo-path)))
+
+(spec/def :profile/name correct-name?)


Remove dead code.

Remove dead code.

--- src/circle/workers.clj
+++ src/circle/workers.clj
@@ -9,14 +9,8 @@
   (:require [fs])
   (:require [circle.model.project :as project]))

-; TODO: find another home for this
-(defn run-build-from-jruby
-  [url]
-  (let [build (config/build-from-url url)]
-    (run/run-build build)))
-
-;;; Workers. Handles starting workers, checking if they're done, and getting the
-;;; result.
+;;; Workers.
+;;; Handles starting workers, checking if they're done, and getting the results.
 (defn call-clojure-from-ruby [f args]
   (ruby/->ruby (apply f args)))


Updated how-to

Updated how-to

--- src/clj/inky/entry.clj
+++ src/clj/inky/entry.clj
@@ -285,7 +285,7 @@
         [:ol
          [:li
           "Visit "
-          [:code "http://inky.cc/compile?url=url-of-cljs-file"]
+          [:code "http://inky.cc/:gh-login/:gist-id"]
           ". This will compile the provided ClojureScript text and redirect you to the resulting sketch."]
          [:li "???"]
          [:li "Profit"]]]


Avoid extra newline when quitting

Avoid extra newline when quitting

--- src/clj/reply/exit.clj
+++ src/clj/reply/exit.clj
@@ -10,6 +10,7 @@
   "Exits the REPL. This is fairly brutal, does (System/exit 0)."
   []
   (shutdown-agents)
-  (println "Bye for now!")
+  (print "Bye for now!")
+  (flush)
   (System/exit 0))


miscellaneous fixes

miscellaneous fixes

Fixes:

* Typo in Dinosaurus hosting message
* Make the "Install and host" option of Off-Campus Apartment cost a click
* Add HQ run requirement to Leverage
* Add partial stub for Bug

Cosmetic changes:
* Move Zona Sul Shipping out of ice section and Deep Thought up into the section of working cards

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -294,6 +294,9 @@
    {:abilities [{:label "Trace 3 - Avoid taking a bad publicity"
                  :trace {:base 3 :msg "avoid taking a bad publicity"
                          :effect (effect (lose :bad-publicity 1))}}]}
+
+   "Bug"
+   {:req (req (some #{:hq} (:successful-run runner-reg)))}

    "Cache"
    {:abilities [{:counter-cost 1 :effect (effect (gain :credit 1)) :msg "gain 1 [Credits]"}]
@@ -631,6 +634,13 @@
    "Dedicated Technician Team"
    {:recurring 2}

+   "Deep Thought"
+   {:events {:successful-run {:effect (effect (add-prop card :counter 1)) :req (req (= target :rd))}
+             :runner-turn-begins
+             {:req (req (>= (get-virus-counters state side card) 3)) :msg "look at the top card of R&D"
+              :effect (effect (prompt! card (str "The top card of your R&D is "
+                                                 (:title (first (:deck corp)))) ["OK"] {}))}}}
+
    "Defective Brainchips"
    {:events {:pre-damage {:req (req (= target :brain)) :msg "to do 1 additional brain damage"
                           :once :per-turn :effect (effect (damage-bonus :brain 1))}}}
@@ -673,7 +683,7 @@
                                  (update-breaker-strength target))}
                 {:label "Host an installed non-AI icebreaker on Dinosaurus"
                  :req (req (empty? (:hosted card)))
-                 :prompt "Choose a program to host on Leprechaun"
+                 :prompt "Choose a program to host on Dinosaurus"
                  :choices {:req #(and (has? % :subtype "Icebreaker")
                                       (not (has? % :subtype "AI"))
                                       (:installed %))}
@@ -1433,7 +1443,8 @@
                  :msg (msg "host " (:title target)) :effect (effect (host card target))}]}

    "Leverage"
-   {:player :corp
+   {:req (req (some #{:hq} (:successful-run runner-reg)))
+    :player :corp
     :prompt "Take 2 bad publicity?"
     :choices ["Yes" "No"]
     :effect (req (if (= target "Yes")
@@ -1736,7 +1747,7 @@

    "Off-Campus Apartment"
    {:abilities [{:label "Install and host a connection on Off-Campus Apartment"
-                 :prompt "Choose a connection to install on Off-Campus Apartment"
+                 :cost [:click 1] :prompt "Choose a connection to install on Off-Campus Apartment"
                  :choices (req (filter #(and (has? % :subtype "Connection")
                                              (<= (:cost %) (:credit runner)))
                                        (:hand runner)))
@@ -2915,6 +2926,19 @@
    "Xanadu"
    {:events {:pre-rez {:req (req (= (:type target) "ICE"))
                        :effect (effect (rez-cost-bonus 1))}}}
+
+   "Zona Sul Shipping"
+   {:events {:runner-turn-begins {:effect (effect (add-prop card :counter 1))}}
+    :abilities [{:cost [:click 1] :msg (msg "gain " (:counter card) " [Credits]")
+                 :label "Take all credits"
+                 :effect (effect (gain :credit (:counter card)) (set-prop card :counter 0))}]
+    :effect (req (add-watch state (keyword (str "zona-sul-shipping" (:cid card)))
+                            (fn [k ref old new]
+                              (when (> (get-in new [:runner :tag]) 0)
+                                (remove-watch state (keyword (str "zona-sul-shipping" (:cid card))))
+                                (trash ref :runner card)
+                                (system-msg ref side "trash Zona Sul Shipping for being tagged")))))}
+
    ;; Icebreakers

    "Alpha"
@@ -3805,17 +3829,6 @@
                             :msg "add the top card of R&D to the bottom"
                             :effect (effect (move (first (:deck corp)) :deck))}}]}

-   "Zona Sul Shipping"
-   {:events {:runner-turn-begins {:effect (effect (add-prop card :counter 1))}}
-    :abilities [{:cost [:click 1] :msg (msg "gain " (:counter card) " [Credits]")
-                 :label "Take all credits"
-                 :effect (effect (gain :credit (:counter card)) (set-prop card :counter 0))}]
-    :effect (req (add-watch state (keyword (str "zona-sul-shipping" (:cid card)))
-                            (fn [k ref old new]
-                              (when (> (get-in new [:runner :tag]) 0)
-                                (remove-watch state (keyword (str "zona-sul-shipping" (:cid card))))
-                                (trash ref :runner card)
-                                (system-msg ref side "trash Zona Sul Shipping for being tagged")))))}

    ;; partial implementation
    "Bad Times"
@@ -3826,13 +3839,6 @@

    "Deep Red"
    {:effect (effect (gain :memory 3)) :leave-play (effect (lose :memory 3))}
-
-   "Deep Thought"
-   {:events {:successful-run {:effect (effect (add-prop card :counter 1)) :req (req (= target :rd))}
-             :runner-turn-begins
-             {:req (req (>= (get-virus-counters state side card) 3)) :msg "look at the top card of R&D"
-              :effect (effect (prompt! card (str "The top card of your R&D is "
-                                                 (:title (first (:deck corp)))) ["OK"] {}))}}}

    "Eden Shard"
    {:abilities [{:effect (effect (trash card {:cause :ability-cost}) (draw :corp 2))


better

better

--- src/cljs/uix/core.cljs
+++ src/cljs/uix/core.cljs
@@ -11,65 +11,77 @@
 ;; Views

+#_(def ui-state
+    (atom
+     {:current 0
+      :views {[:editors 0 0] {:formalism :event-b :file "m1"}
+              [:editors 0 1] {:formalism :event-b :file "m0"}
+              [:editors 1 0] {:formalism :event-b :file "m2"} ;; **
+              [:editors 1 1] {:formalism :event-b :file "m0"}
+              [:editors 1 2] {:formalism :event-b :file "ctx0"}
+              [:animations 0 0] {:editor [1 0] :model "animator0" :trace "212" :type :state-view}
+              [:animations 0 1] {:editor [1 0] :model "animator0" :trace "212" :type :events-view}
+              }}))
+
 (def ui-state
   (atom
-   {:current-page 0
-    :current-view [0 0 0]
-    :views [
-     [
-      [[{:type :editor :formalism :event-b :file "m1"}
-        {:type :editor :formalism :event-b :file "m0"}]]
-      [[{:type :editor :formalism :classical-b :file "s1.mch"}]]
-      ]
-     [[[{:model "animation0" :trace "1" :editor 0 :type :state-view}
-        {:model "animation0" :trace "1" :editor 0 :type :events-view}]
-       [{:model "animation0" :trace "2" :editor 0 :type :state-view}
-        {:model "animation0" :trace "2" :editor 0 :type :history-view}]]
-      [[{:model "animation3" :trace "9" :editor 1 :type :events-view}]]]]
-    }))
+   {:current [:animators 0 1] #_[:editors 0 0]
+    :views {:editors [[:1 :2]
+                      [:3 :4 :5]]
+            :animators [[:6 :7]]}
+
+    :pages {:1 {:type :editor :formalism :event-b :file "m1"}
+            :2 {:type :editor :formalism :event-b :file "m0"}
+            :3 {:type :editor :formalism :event-b :file "m2"}
+            :4 {:type :editor :formalism :event-b :file "m0"}
+            :5 {:type :editor :formalism :event-b :file "ctx0"}
+            :6 {:editor :3 :model "animator0" :trace "212" :type :state-view}
+            :7 {:editor [1 0] :model "animator0" :trace "212" :type :events-view}
+            }}))
+
+
+(defn show [page row column]
+  (let [c (:current @ui-state)]
+    (cond
+      (= 3 (count c)) (when-not (= c [page row column]) {:class "hidden"})
+      :otherwise {:class "thumbnail"})))

 (defmulti render-view :type)
-(defmethod render-view :editor [{:keys [formalism file]}]
-  [:div.editor (str "Editor: " file)])
+(defmethod render-view :editor [{:keys [formalism file row column]}]
+  [:div.editor
+   (show :editors row column)
+   (str "Editor: " file "@"row ","column)])

-(defmethod render-view :state-view [{:keys [model trace]}]
-  [:div.state-view (str "State: " model "/" trace)])
+(defmethod render-view :state-view [{:keys [model trace row column]}]
+  [:div.state-view
+   (show :animators row column)
+   (str "State: " model "/" trace "@"row ","column)])

-(defmethod render-view :events-view [{:keys [model trace]}]
-  [:div.events-view (str "Events: " model "/" trace)])
+(defmethod render-view :events-view [{:keys [model trace row column]}]
+  [:div.events-view
+   (show :animators row column)
+   (str "Events: " model "/" trace "@"row ","column)])

-(defmethod render-view :history-view [{:keys [model trace]}]
-  [:div.history-view (str "History: " model "/" trace)])
+(defmethod render-view :history-view [{:keys [model trace row column]}]
+  [:div.history-view
+   (show :animators row column)
+   (str "History: " model "/" trace "@"row ","column)])

-(defn render-subrow [elements]
-  [:div.subrow (map render-view elements)])
+(defn render-row [y columns]
+  [:div.row (map-indexed (fn [x key] (render-view (assoc (get-in @ui-state [:pages key]) :column x :row y))) columns)])

-(defn render-row [subrows]
-  [:div.row (map render-subrow subrows)])
+(defn render-page [[section rows]]
+  [:div.page
+   (when-not (= section (first (:current @ui-state))) {:class "hidden"})
+   (map-indexed render-row rows)
+   ])

-(defn render-page [current index rows]
-  (.log js/console current index (count rows))
-  [:div.page
-   (when-not (= current index) {:class "hidden"})
-   (map render-row rows)])
-
-(defn ^:extern animation->editor []
-  (swap! ui-state
-         (fn [{:keys [current-page current-view views] :as s}
-             {:keys [editor]} views]
-           (assoc s :current-view [editor 0 0] :current-page 0))))
-
-(defn ^:extern editor->animation []
-  (swap! ui-state
-         (fn [{:keys [current-page current-view views] :as s}
-             {:keys [editor]} views]
-           (assoc s :current-view [editor 0 0] :current-page 0))))

 (defn home-page []
-  (let [{:keys [current-page views current-view]} @ui-state]
+  (let [views (:views @ui-state)]
     [:div.ui
-     (map-indexed (partial render-page current-page current-view) views)]))
+     (map render-page views)]))

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


intro to end all intros

intro to end all intros

--- src/codemash/intro.clj
+++ src/codemash/intro.clj
@@ -40,5 +40,6 @@
 (defonce welcome-sample (load-sample "~/Workspace/music/samples/welcome to sound.wav"))
 (def welcome (sample-player welcome-sample :rate 1 :amp 1 :loop? 1 :start-pos 0))
 (ctl welcome :loop? 1 :rate -1 :start-pos (:size welcome-sample))
+(ctl welcome :loop? 1 :rate 0.5 :start-pos 0)
 (ctl welcome :loop? 0 :rate 2 :start-pos 0)
 (stop)


Update deps for Prismatic Schema in todomvs example

--- examples/todomvc/project.clj
+++ examples/todomvc/project.clj
@@ -5,7 +5,7 @@
                  [re-frame "0.8.0-SNAPSHOT"]
                  [binaryage/devtools "0.7.0"]
                  [secretary "1.2.3"]
-                 [prismatic/schema "1.0.3"]]
+                 [prismatic/schema "1.1.2"]]

   :plugins [[lein-cljsbuild "1.1.3"]
             [lein-figwheel "0.5.4-5"]]


Rename uid->id

Rename uid->id

--- src/discuss/specs.cljs
+++ src/discuss/specs.cljs
@@ -9,8 +9,8 @@

 (s/def ::no-slash (s/and string? #(not (re-find #"/" %)) #(pos? (count %))))
 (s/def ::no-slash-or-number (s/or :number number? :string ::no-slash))
-(s/def ::verbose-or-uid (s/or :verbose string? :uid number?))
-(s/def ::author ::verbose-or-uid)
+(s/def ::verbose-or-id (s/or :verbose string? :id number?))
+(s/def ::author ::verbose-or-id)
 (s/def ::content string?)
 (s/def ::aggregate-id ::no-slash-or-number)
 (s/def ::entity-id ::no-slash-or-number)


Remove padding from modal

Remove padding from modal

--- src/discuss/views.cljs
+++ src/discuss/views.cljs
@@ -118,7 +118,7 @@
             [:div {:className "modal-dialog modal-lg"
                    :role "document"}
              [:div.modal-content
-              [:div.modal-header
+              [:div.modal-header {:style {:paddingBottom 0}}
                [:button {:type "button"
                          :className "close"
                          :data-dismiss "modal"


hide file upload form until username entered

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -60,6 +60,7 @@
 (.on socket "connect" #(.emit socket "join_room" room))

 (.hide (js/$ "#message_form"))
+(.hide (js/$ "#file_upload_input"))

 (.submit (js/$ "#message_form")
   (fn []
@@ -72,6 +73,7 @@
     (.emit socket "set_username" room (.val (js/$ "#username")))
     (.hide (js/$ "#username_form"))
     (.show (js/$ "#message_form"))
+    (.show (js/$ "#file_upload_input"))
     false))

 (.on socket "chat message"


fixed formatting a bit

fixed formatting a bit

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -143,13 +143,17 @@

 (defn incr-upload-slots []
   (println "Incrementing upload slots")
-  (.emit app-state/socket "change-upload-slots" (+ (:upload-slots @app-state/app-state)
-                                         1)))
+  (.emit app-state/socket
+         "change-upload-slots"
+         (+ (:upload-slots @app-state/app-state)
+            1)))

 (defn decr-upload-slots []
   (println "Decrementing upload slots")
-  (.emit app-state/socket "change-upload-slots" (- (:upload-slots @app-state/app-state)
-                                         1)))
+  (.emit app-state/socket
+         "change-upload-slots"
+         (- (:upload-slots @app-state/app-state)
+            1)))

 (defn change-track [track-num]
   (.emit app-state/socket "change-track" track-num (.v4 js/uuid)))


Can zoom in and out with pinches

Can zoom in and out with pinches

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -90,15 +90,16 @@

 (def vec-distance (comp vec-length subtract-vec))

-(defn vec-clamp-to-bounds [v bounds]
-  (let [ratios (merge-with (comp js/Math.abs /) bounds v)
-        max-ratio (min 1 (:x ratios) (:y ratios))]
-    (scalar-multiply v max-ratio)))
-
-;; D3 magic
+;; Geometry

 (defn scroll-scale-for-state [state]
   (if (= :zoom-out (:projection state)) zoom-out-scale 1))
+
+(defn zoom-out->world-pos [state pos]
+  (let [{:keys [camera-pos view-size]} state
+        view-center (scalar-multiply view-size 0.5)
+        displacement (subtract-vec pos view-center)]
+    (add-vec camera-pos (scalar-multiply displacement (/ zoom-out-scale)))))

 (defn scaled-distance-from-camera
   "Returns the distance of the given point from the camera, scaled so that
@@ -155,6 +156,8 @@

 (defn projectors-for-state [state]
   (if (= (:projection state) :fisheye) fisheye-projectors zoom-out-projectors))
+
+;; D3 magic

 (defn sync-graph! [state & {:keys [animation-signaller]}]
   (let [{:keys [svg nodes links camera-pos view-size]} state
@@ -213,6 +216,12 @@
   (apply swap! current-state f args)
   (sync-graph! @current-state))

+(defn swap-state-animated! [animation-signaller current-state f & args]
+  ; There's no way to arrange the arguments that isn't awkward. Luckily all the
+  ; uses will probably be right here.
+  (apply swap! current-state f args)
+  (sync-graph! @current-state :animation-signaller animation-signaller))
+
 (defn update-state! [current-state k f & args]
   (apply swap! current-state update k f args)
   (sync-graph! @current-state))
@@ -222,14 +231,20 @@
                  (scalar-multiply d (/ (scroll-scale-for-state @current-state)))))

 (defn set-projection! [current-state projection animation-signaller]
-  (swap! current-state assoc :projection projection)
-  (sync-graph! @current-state :animation-signaller animation-signaller))
+  (swap-state-animated! animation-signaller
+                        current-state assoc :projection projection))

 (defn toggle-projection! [current-state animation-signaller]
   (let [projection (if (= (:projection @current-state) :fisheye)
                      :zoom-out
                      :fisheye)]
     (set-projection! current-state projection animation-signaller)))
+
+(defn zoom-in-to-pos! [current-state pos animation-signaller]
+  (swap-state-animated! animation-signaller
+                          current-state assoc
+                          :projection :fisheye
+                          :camera-pos pos))

 ;; Layout

@@ -443,21 +458,30 @@

 ;; Gestures - pinch

-(defn pinch-observable
-  "Returns a stream of the scale."
-  [manager svg]
+(defn pinch-observable [manager svg]
   (.map (gesture-observable manager svg "pinchmove")
-        #(.-scale %)))
-
-(defn zoom-out-on-pinch! [manager
-                          current-state
-                          animation-observable
-                          animation-signaller]
-  (-> (pinch-observable manager (:svg @current-state))
-      (.filter #(< % 0.8))
-      (suppress-while-animating animation-observable)
-      (.subscribe
-        #(set-projection! current-state :zoom-out animation-signaller))))
+        (fn [e] {:center (math-vec (-> e .-center .-x) (-> e .-center .-y))
+                 :scale (.-scale e)})))
+
+(defn zoom-on-pinch! [manager
+                      current-state
+                      animation-observable
+                      animation-signaller]
+  (let [pinches (pinch-observable manager (:svg @current-state))
+        pinch-ins (-> pinches (.filter #(< (:scale %) 0.8))
+                      (suppress-while-animating animation-observable))
+        pinch-outs (-> pinches (.filter #(> (:scale %) 1.2))
+                       (suppress-while-animating animation-observable))]
+    (.subscribe
+      pinch-ins
+      #(if (= (:projection @current-state) :fisheye)
+         (set-projection! current-state :zoom-out animation-signaller)))
+    (.subscribe
+      pinch-outs
+      #(if (= (:projection @current-state) :zoom-out)
+         (zoom-in-to-pos! current-state
+                          (zoom-out->world-pos @current-state (:center %))
+                          animation-signaller)))))

 ;; Exported function to do magic

@@ -480,5 +504,5 @@
     (move-camera-on-swipe! gesture-manager current-state animation-observable)
     (switch-zoom-on-spacebar!
       current-state animation-observable animation-signaller)
-    (zoom-out-on-pinch!
+    (zoom-on-pinch!
       gesture-manager current-state animation-observable animation-signaller)))


api: correct signature for store/query!

api: correct signature for store/query!

--- src/io/cyanite/api.clj
+++ src/io/cyanite/api.clj
@@ -94,7 +94,7 @@
                            (if (sequential? path) path [path]))
                    (map (partial engine/resolution engine from))
                    (remove nil?))]
-    (store/query! store index engine from to paths)))
+    (store/query! store from to paths)))

 (defmethod dispatch :default
   [_]


api: buckets is gone now.

api: buckets is gone now.

--- src/io/cyanite/api.clj
+++ src/io/cyanite/api.clj
@@ -6,7 +6,6 @@
             [io.cyanite.engine.rule     :as rule]
             [io.cyanite.engine          :as engine]
             [io.cyanite.engine.queue    :as q]
-            [io.cyanite.engine.buckets  :as b]
             [io.cyanite.index           :as index]
             [io.cyanite.store           :as store]
             [io.cyanite.query           :as query]


Separate version check from form generator; add an optional test-package argument to the from generator.

--- src/leiningen/test.clj
+++ src/leiningen/test.clj
@@ -5,39 +5,48 @@
         [clojure.contrib.find-namespaces :only [find-namespaces-in-dir]]
         [leiningen.compile :only [eval-in-project]]))

+(defn- with-version-guard
+  "Compatibility test to prevent use of clojure.test with Clojure 1.0."
+  [form]
+  `(if (and (= 1 (:major *clojure-version*))
+            (= 0 (:minor *clojure-version*)))
+     (println "\"lein test\" is not compatible with Clojure 1.0 projects.
+Please consider upgrading to a newer version of Clojure or using"
+              "the lein-test-is plugin.")
+     ~form))
+
 (defn form-for-testing-namespaces
   "Return a form that when eval'd in the context of the project will test
 each namespace and print an overall summary."
-  [namespaces]
-  `(do
-     (require ~''clojure.test)
-     (if (and (= 1 (:major *clojure-version*))
-              (= 0 (:minor *clojure-version*)))
-       (println "\"lein test\" is not compatible with Clojure 1.0.\n
-Please consider upgrading to a newer version of Clojure or using"
-                "the lein-test-is plugin.")
-       (let [resolver# (fn [fname#]
-                         (ns-resolve
-                          (find-ns 'clojure.test) fname#))
-             add-numbers# (fn [a# b#] (if (number? a#)
-                                        (+ a# b#) a#))
-             summary# (reduce (fn [summary# n#]
-                                (require n# :reload-all)
-                                (merge-with add-numbers#
-                                            summary#
-                                            ((resolver# ~''run-tests) n#)))
-                              {} '~namespaces)]
-         ((resolver# ~''with-test-out)
+  ([namespaces] (form-for-testing-namespaces namespaces 'clojure.test))
+  ([namespaces test-package]
+     `(do
+        (require '~test-package)
+        (let [resolver# (fn [fname#]
+                          (ns-resolve
+                           (find-ns '~test-package) fname#))
+              add-numbers# (fn [a# b#] (if (number? a#)
+                                         (+ a# b#) a#))
+              summary# (reduce (fn [summary# n#]
+                                 (require n# :reload-all)
+                                 (merge-with add-numbers#
+                                             summary#
+                                             ((resolver# ~''run-tests) n#)))
+                               {} '~namespaces)]
+          ((resolver# ~''with-test-out)
            (println "\n\n--------------------\nTotal:")
            ((resolver# ~''report) summary#))
-         (when-not (= "1.5" (System/getProperty "java.specification.version"))
-           (shutdown-agents))))))
+          (when-not (= "1.5" (System/getProperty "java.specification.version"))
+            (shutdown-agents))))))

 (defn test
-  "Run the project's tests. Accept a list of namespaces for which to run all
-tests for. If none are given, runs them all."
+  "Run the project's tests. Accepts a list of namespaces for which to run all
+tests. If none are given, runs them all."
   [project & namespaces]
   (let [namespaces (if (empty? namespaces)
                      (find-namespaces-in-dir (file (:test-path project)))
                      (map symbol namespaces))]
-    (eval-in-project project (form-for-testing-namespaces namespaces))))
+    (eval-in-project
+     project
+     (with-version-guard
+       (form-for-testing-namespaces namespaces)))))


Make 'git :ok-statuses handling more generic.

Rather than requiring it to be a collection, it can also be a
function.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -24,7 +24,7 @@
                     (str "--work-tree=" (.getParent gitdir))])
         all-args (concat dir-args subcmd)
         {:keys [exit] :as rtn} (apply sh "git" all-args)]
-    (when-not (contains? ok-statuses exit)
+    (when-not (ok-statuses exit)
       (throw (ex-info "git error" (assoc rtn :git all-args))))
     (assoc rtn :lines (when (not= "\n" (:out rtn))
                         (re-seq #"(?m)^.*$" (:out rtn))))))


no shutters here

no shutters here

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -174,9 +174,7 @@
   []
   (show/add-effect! :color (global-color-effect "slateblue" :include-color-wheels? true))
   (show/add-effect! :dimmers (global-dimmer-effect 255))
-  (show/add-effect! :torrent-shutter
-                    (afterglow.effects.channel/function-effect
-                     "Torrents Open" :shutter-open 50 (show/fixtures-named "torrent"))))
+)

 (core/start-web-server 16000 false)
 (show/start!)     ; Start sending its DMX frames.


Add logging for case when `assortment` doesn't find anything to render

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -549,24 +549,29 @@
   on the provided `fileset` and `options`."
   [task-name fileset options]
   (let [global-meta (perun/get-global-meta fileset)
-        grouper (:grouper options)]
-    (->> fileset
-         perun/get-meta
-         (filter (:filterer options))
-         grouper
-         (reduce
-          (fn [result [path {:keys [entries group-meta permalink]}]]
-            (let [sorted      (sort-by (:sortby options) (:comparator options) entries)
-                  new-path    (make-path (:out-dir options) permalink path)
-                  new-entry   (merge group-meta {:path new-path
-                                                 :filename path})
-                  render-data {:meta    global-meta
-                               :entry   new-entry
-                               :entries (vec sorted)}]
-              (perun/report-info task-name (str "rendered " task-name " " path))
-              (assoc result new-path {:render-data render-data
-                                      :entry       new-entry})))
-          {}))))
+        grouper (:grouper options)
+        paths (->> fileset
+                   perun/get-meta
+                   (filter (:filterer options))
+                   grouper)]
+    (if (seq paths)
+      (reduce
+       (fn [result [path {:keys [entries group-meta permalink]}]]
+         (let [sorted      (sort-by (:sortby options) (:comparator options) entries)
+               new-path    (make-path (:out-dir options) permalink path)
+               new-entry   (merge group-meta {:path new-path
+                                              :filename path})
+               render-data {:meta    global-meta
+                            :entry   new-entry
+                            :entries (vec sorted)}]
+           (perun/report-info task-name (str "rendered " task-name " " path))
+           (assoc result new-path {:render-data render-data
+                                   :entry       new-entry})))
+       {}
+       paths)
+      (do
+        (perun/report-info task-name (str task-name " found nothing to render"))
+        []))))

 (def ^:private +collection-defaults+
   {:out-dir "public"


removed printing of base64 data

removed printing of base64 data

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -54,16 +54,12 @@
     (.on stream "end"
       (fn []
         (if (= (.-id stream) (:current-download-stream-id @app-state))
-          (println (.-size (:current-file-download @app-state)))
           (let [reader (new js/FileReader)
                 blob   (:current-file-download @app-state)]
             (.readAsDataURL reader blob)
             (set! (.-onloadend reader)
               (fn []
-                (println (.-result reader))
-                (println (.attr (js/$ "#current-track") "src"))
                 (.attr (js/$ "#current-track") "src" (.-result reader))
-                (println (.attr (js/$ "#current-track") "src"))
                 (.load (.getElementById js/document "audio-tag"))
                 (.play (.getElementById js/document "audio-tag"))
                 (swap! app-state assoc :current-download-stream-id nil)


added TODO comment

added TODO comment

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -259,6 +259,7 @@

 (.on socket "hotjoin-music-info"
   (fn [room-music-info track-order current-track-id current-sound-id]
+    ; TODO: should probably convert room-music-info to clojure object before manipulating
     (let [track-order (js->clj track-order)
           sorted-music-info (.sort room-music-info (fn [a b]
                                                      (- (indices #(= %1 (.-id a)) track-order)


Remove abandoned relational goals and comment examples.

Remaining comment examples moved to the end of the file.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1232,25 +1232,27 @@
                      pidx)
             succ)))

-;; ===== relational queries =====
-
-#_
-(def obj-patho
-  (l/tabled [tree-sha so-far fname ftype fsha tree-path]
-   (l/conde
-    [(r-tree tree-sha fname ftype fsha) (l/== so-far tree-path)]
-    [(l/fresh [next-path next-sha new-path]
-              (r-tree tree-sha next-path :tree next-sha)
-              (l/conso next-path so-far new-path)
-              (obj-patho next-sha new-path fname ftype fsha tree-path))])))
-
-(def ancestoro
-  (l/tabled [childer parenter]
-          (l/conde
-           [(r-commit-parent childer parenter)]
-           [(l/fresh [nparent]
-                     (r-commit-parent childer nparent)
-                     (ancestoro nparent parenter))])))
+
+(def subtasks [#'build-deps #'deploy #'find-box #'freshen #'install
+               #'retag-all-repos #'update-repo-dbs #'ver-parse #'wrap])
+
+(def internal-subtasks [#'box #'box-new #'box-init #'box-add #'box-remove])
+
+(defn ^:no-project-needed ^{:subtasks subtasks} voom
+  "Generate and use artifacts versioned with git commit and commit time.
+
+  There are several subtasks, as well as the 'box' script which has
+  several commands of its own, built using this plugin."
+  [project subtask-name & args]
+
+  (let [subtask-var (resolve (symbol "leiningen.voom"
+                                     (s/replace subtask-name #"^:" "")))]
+    (if-let [subtask (some #{subtask-var} (concat subtasks internal-subtasks))]
+      (if (:info-subtask (meta subtask))
+        (prn (apply subtask args))
+        (apply subtask project args))
+      (println "No voom subtask found" (prn-str subtask-name)
+               " Try: lein help voom"))))

 (comment
   (l/run* [q] (l/fresh [q] (l/== (sha/mk "7b3e68a8839aeb4")
@@ -1264,263 +1266,5 @@

   (time (def db (add-git-facts pldb/empty-db (io/file voom-repos "lein-voom"))))
   (time (def db (updated-git-db (io/file voom-repos "lein-voom"))))
-  (time (def db2 (updated-git-db (io/file voom-repos "lein-voom"))))
-
-  (time
-   (let [fname "core.clj"]
-     (doall
-      (pldb/with-db db3
-        (l/run 10 [c-sha tree-path obj-sha]
-               (l/fresh [tree-sha ctime p-sha p-ctime p-tree-sha p-obj-sha]
-                        (r-commit c-sha ctime tree-sha)
-                        (r-commit-parent c-sha p-sha)
-                        (r-commit p-sha p-ctime p-tree-sha)
-                        (obj-patho p-tree-sha nil fname :blob p-obj-sha tree-path)
-                        (obj-patho tree-sha nil fname :blob obj-sha tree-path)
-                        (l/!= obj-sha p-obj-sha)))))))
-
-  ;; find merges involving projects
-  (time
-   (into #{}
-    (q db2 [s q]
-       (r-commit s _ 2 _)
-       (r-proj s _ q _ _))))
-
-  (time
-   (let [c (sha/mk "612e0705de7ff991aa65b910ed0820adabd1d921") ; for large test repo
-         p (sha/mk "65691217cd9aa2b2738518dbebd3fdc7d58b162f")]
-     (doall
-      (pldb/with-db db
-        (l/run 1 [q]
-               (ancestoro c p)
-               (l/== q true))))))
-
-  (time
-   (let [_ l/lvar]
-     (doall
-      (pldb/with-db db2
-        (l/run* [q]
-                (r-proj (_) q (_) (_) (_)))))))
-  (time
-   (count
-    (into #{}
-          (let [_ l/lvar]
-            (doall
-             (pldb/with-db db2
-               (l/run* [p v s]
-                       (r-proj (_) p v (_) s)
-                       (l/pred p #(.startsWith (str %) "lono")))))))))
-
-  (time
-   (doseq [f
-           (into #{}
-                 (let [_ l/lvar
-                       sha (sha/mk "36bb052caf1d560448dfd9e3c81e19d8e210f1a1")
-                       pname 'b2b/b2b-server]
-                   (doall
-                    (pldb/with-db db2
-                      (l/run 20 [A]
-                             (l/fresh [p v s p2 v2 s2 tpath tsha osha otsha bsha obsha oosha ootsha oobsha]
-                                      ;; For commit SHA, find the location and version of PNAME
-                                      (r-commit sha (_) tsha)
-                                      (r-proj bsha p pname v s)
-                                      (obj-patho tsha () "project.clj" :blob bsha tpath)
-                                      ;; Find an ancestor of SHA with a project at the same location
-                                      (ancestoro sha osha)
-                                      (r-commit osha (_) otsha)
-                                      (obj-patho otsha () "project.clj" :blob obsha tpath)
-                                      ;; Where the very previous commit at this location has a different project.clj blob
-                                      (r-commit-parent osha oosha)
-                                      (r-commit oosha (_) ootsha)
-                                      (l/!= obsha oobsha)
-                                      (obj-patho ootsha () "project.clj" :blob oobsha tpath)
-                                      ;; And found project.clj is also different from the current
-                                      (r-proj obsha p2 pname v2 s2)
-                                      (l/!= bsha obsha)
-                                      ;; Share the details
-                                      (l/== A [tpath osha [p v s] [p2 v2 s2]])
-                                      ))))))]
-     (prn f)))
-
-  (time
-   (doseq [f
-           (into #{}
-                 (let [_ l/lvar
-                       sha (sha/mk "36bb052caf1d560448dfd9e3c81e19d8e210f1a1")
-                       pname 'b2b/b2b-server]
-                   (doall
-                    (pldb/with-db db2
-                      (l/run 20 [a]
-                             (l/fresh [p M m i q s p2 M2 m2 i2 q2 s2 tpath tsha osha otsha bsha stsha ostsha ootsha oobsha ptpath thing]
-                                      ;; For commit SHA, find the location and version of PNAME
-                                      (r-commit sha (_) tsha)
-                                      (r-proj bsha pname M m i q s)
-                                      (obj-patho tsha () "project.clj" :blob bsha tpath)
-                                      ;; Locate the project directory
-                                      (l/conso thing ptpath tpath)
-                                      (obj-patho tsha () thing :tree stsha ptpath)
-                                      ;; Find an ancestor of SHA with a project directory at the same location
-                                      (ancestoro sha osha)
-                                      (r-commit osha (_) otsha)
-                                      (obj-patho otsha () thing :tree ostsha ptpath)
-                                      (l/!= stsha ostsha)
-                                      (l/== a [tpath sha osha [p M m i q s] [p2 M2 m2 i2 q2 s2]])
-                                      ))))))]
-     (prn f)))
-
-(time ; full
-   (doseq [f
-           (into #{}
-                 (let [_ l/lvar
-                       sha (sha/mk "36bb052caf1d560448dfd9e3c81e19d8e210f1a1")
-                       pname 'b2b/b2b-server]
-                   (doall
-                    (pldb/with-db db2
-                      (l/run 20 [a]
-                             (l/fresh [p M m i q s p2 M2 m2 i2 q2 s2 tpath tsha osha oosha otsha bsha stsha ostsha ootsha oostsha oobsha ptpath thing]
-                                      ;; For commit SHA, find the location and version of PNAME
-                                      (r-commit sha (_) tsha)
-                                      (r-proj bsha pname M m i b q s)
-                                      (obj-patho tsha () "project.clj" :blob bsha tpath)
-                                      ;; Locate the project directory
-                                      (l/conso thing ptpath tpath)
-                                      (obj-patho tsha () thing :tree stsha ptpath)
-                                      ;; Find an ancestor of SHA with a project directory at the same location
-                                      (ancestoro sha osha)
-                                      (r-commit osha (_) otsha)
-                                      (obj-patho otsha () thing :tree ostsha ptpath)
-                                      (l/!= stsha ostsha)
-                                      ;; Where the very previous commit at this location has a different project.clj blob
-                                      (r-commit-parent osha oosha)
-                                      (r-commit oosha (_) ootsha)
-                                      (obj-patho ootsha () thing :tree oostsha ptpath)
-                                      (l/!= ostsha oostsha)
-                                      ;; Find the project details
-                                      (obj-patho ootsha () "project.clj" :blob oobsha tpath)
-                                      (r-proj oobsha (_) M2 m2 i2 b2 q2 s2)
-                                      (l/== a [tpath sha osha oobsha [p M m i b q s] [p2 M2 m2 i2 b2 q2 s2]])
-                                      ))))))]
-     (prn f)))
-
-;; - where does this project live (path/repo)-wise?
-(r-proj _ ?path PNAME ?v ?S)
-;; - what are all the versions "available" for this project?
-(r-proj _ ?path PNAME ?v ?S)
-;; - what commits, after <this> version was introduced, change the path at the same
-(r-proj ?sha PATH PNAME v S)
-
-
-(time ; next
- (doseq [f
-         (into #{}
-               (let [_ l/lvar
-                     ;; We're starting at some ref or sha
-                     sha (sha/mk "36bb052caf1d560448dfd9e3c81e19d8e210f1a1")
-                     ;; We know what project
-                     pname 'b2b/b2b-server
-                     ;; We have some version constraint
-                     M 0
-                     m 0
-                     p]
-                 (doall
-                  (pldb/with-db db2
-                    (l/run 20 [a]
-                           (l/fresh [p M m i q s p2 M2 m2 i2 q2 s2 tpath tsha osha oosha otsha bsha stsha ostsha ootsha oostsha oobsha ptpath thing]
-                                    ;; For commit SHA, find the location and version of PNAME
-                                    (r-commit sha (_) tsha)
-                                    (r-proj bsha pname M m i q s)
-                                    (obj-patho tsha () "project.clj" :blob bsha tpath)
-                                    ;; Locate the project directory
-                                    (l/conso thing ptpath tpath)
-                                    (obj-patho tsha () thing :tree stsha ptpath)
-                                    ;; Find an ancestor of SHA with a project directory at the same location
-                                    (ancestoro sha osha)
-                                    (r-commit osha (_) otsha)
-                                    (obj-patho otsha () thing :tree ostsha ptpath)
-                                    (l/!= stsha ostsha)
-                                    ;; Where the very previous commit at this location has a different project.clj blob
-                                    (r-commit-parent osha oosha)
-                                    (r-commit oosha (_) ootsha)
-                                    (obj-patho ootsha () thing :tree oostsha ptpath)
-                                    (l/!= ostsha oostsha)
-                                    ;; Find the project details
-                                    (obj-patho ootsha () "project.clj" :blob oobsha tpath)
-                                    (r-proj oobsha (_) M2 m2 i2 q2 s2)
-                                    (l/== a [tpath sha osha oobsha [p M m i q s] [p2 M2 m2 i2 q2 s2]])
-                                    ))))))]
-   (prn f)))
-
-(time
- (doseq [f (let [_ l/lvar
-                 pname 'b2b/b2b-server
-                 ppath '("b2b" "modules")
-                 csha (sha/mk "36bb052")]
-           (pldb/with-db db2
-             (l/run 1 [q]
-                    (l/fresh [bsha tpath tsha psha ptsha pbsha]
-                             (r-commit csha (_) tsha)
-                             (obj-patho tsha () "server" :tree bsha ppath)
-                             (ancestoro csha psha)
-                             (r-commit psha (_) ptsha)
-                             (obj-patho ptsha () "server" :tree pbsha ppath)
-                             (l/!= bsha pbsha)
-                             (l/== q [pname ppath csha ptsha])))))]
-   (prn f)))
-
-  (time
-   (identity
-    (into #{}
-          (let [_ l/lvar
-                sha (sha/mk "612e0705de7ff991aa65b910ed0820adabd1d921")]
-            (doall
-             (pldb/with-db db2
-               (l/run* [p M m i q s tpath]
-                       (l/fresh [ctime tsha bsha]
-                                (r-commit sha ctime tsha)
-                                (obj-patho tsha nil "project.clj" :blob bsha tpath)
-                                (r-proj bsha p M m i q s)))))))))
-
-  (pldb/with-db db3
-    (l/run 10 [obj-sha]
-     (l/fresh [sha]
-       (r-tree sha "project.clj" :blob obj-sha))))
-
-  (pldb/with-db db3
-    (l/run* [filename]
-     (l/fresh [sha ftype]
-       (r-tree sha filename ftype (sha/mk "065ed5d8b4f7aca")))))
-  (pldb/with-db db3
-    (l/run 5 [dirname]
-            (l/fresh [obj-sha proj-dir-sha otherdir]
-                     (r-tree proj-dir-sha "project.clj" :blob obj-sha)
-                     (r-tree otherdir dirname :tree proj-dir-sha))))
-  (pldb/with-db db3
-    (l/run 5 [q]
-           (l/fresh [a b c d e]
-                    (r-proj a b c d e)
-                    (l/== q [a b c d e]))))
+  (time (def db2 (updated-git-db (io/file voom-repos "lonocore"))))
   )
-
-
-
-
-(def subtasks [#'build-deps #'deploy #'find-box #'freshen #'install
-               #'retag-all-repos #'update-repo-dbs #'ver-parse #'wrap])
-
-(def internal-subtasks [#'box #'box-new #'box-init #'box-add #'box-remove])
-
-(defn ^:no-project-needed ^{:subtasks subtasks} voom
-  "Generate and use artifacts versioned with git commit and commit time.
-
-  There are several subtasks, as well as the 'box' script which has
-  several commands of its own, built using this plugin."
-  [project subtask-name & args]
-
-  (let [subtask-var (resolve (symbol "leiningen.voom"
-                                     (s/replace subtask-name #"^:" "")))]
-    (if-let [subtask (some #{subtask-var} (concat subtasks internal-subtasks))]
-      (if (:info-subtask (meta subtask))
-        (prn (apply subtask args))
-        (apply subtask project args))
-      (println "No voom subtask found" (prn-str subtask-name)
-               " Try: lein help voom"))))


Fix var name.

Fix var name.

--- src/oc/storage/app.clj
+++ src/oc/storage/app.clj
@@ -81,7 +81,7 @@
     c/prod?           api-common/wrap-500 ; important that this is first
      ; important that this is second
     c/dsn             (sentry-mw/wrap-sentry c/dsn {:release c/sentry-release
-                                                    :environment c/env-name})
+                                                    :environment c/sentry-env})
     true              wrap-with-logger
     true              wrap-params
     c/liberator-trace (wrap-trace :header :ui)


Wrapped content of text/html representation of resource in a body tag, just to allow additional content to be added

--- src/kixi/hecuba/web/resources.clj
+++ src/kixi/hecuba/web/resources.clj
@@ -19,11 +19,12 @@
   :handle-ok (fn [{projects ::projects {mt :media-type} :representation :as ctx}]
                (case mt
                  "text/html"
-                 (html [:table
-                        (for [p projects]
-                          [:tr
-                           [:td [:a {:href (:href p)} (:name p)]]
-                           [:td (:project-code p)]])])
+                 (html [:body
+                        [:table
+                         (for [p projects]
+                           [:tr
+                            [:td [:a {:href (:href p)} (:name p)]]
+                            [:td (:project-code p)]])]])
                  "application/edn" (pr-str (vec projects))
                  projects))
   :post! (fn [{{body :body} :request}]


summary as flat list

summary as flat list

--- src/ontrail/weekly.clj
+++ src/ontrail/weekly.clj
@@ -57,21 +57,17 @@
     (kw coll)
     0))

-(defn accumulate-all [kw totals result]
-  (let [kw-all (keyword "Kaikki")]
-    (assoc totals
-      kw-all {:distance (+ (:distance (kw-all totals)) (get-entry result :distance))
-              :duration (+ (:duration (kw-all totals)) (get-entry result :duration))})))
+(defn accumulate [kw totals result]
+  {:sport kw :distance (+ (:distance totals) (get-entry result :distance))
+   :duration (+ (:duration totals) (get-entry result :duration))})

 (defn humanize [coll]
-  (let [key (first (keys coll))
-        val (key coll)]
-    {key {:distance (to-human-distance (:distance val)) :duration (to-human-time (:duration val))}}))
+  (assoc coll :distance (to-human-distance (:distance coll)) :duration (to-human-time (:duration coll))))

 (defn weekly-sums [results]
   (if (>= (count results) 1)
     (let [kw-all (keyword "Kaikki")
-          all (humanize (reduce (partial accumulate-all kw-all) (cons {kw-all {:distance 0 :duration 0}} results)))]
+          all (humanize (reduce (partial accumulate kw-all) (cons {:sport kw-all :distance 0 :duration 0} results)))]
       (cons all []))
     [{}]))


catch 404 for users that don't have a google plus account

--- src/pc/auth/google.clj
+++ src/pc/auth/google.clj
@@ -1,12 +1,14 @@
 (ns pc.auth.google
-  (:require [pc.profile :as profile]
+  (:require [cemerick.url :as url]
+            [cheshire.core :as json]
+            [clj-http.client :as http]
+            [clj-time.coerce]
+            [clj-time.format]
+            [clojure.tools.logging :as log]
+            [pc.profile :as profile]
             [pc.util.base64 :as base64]
             [pc.util.jwt :as jwt]
-            [cemerick.url :as url]
-            [cheshire.core :as json]
-            [clj-http.client :as http]
-            [clj-time.format]
-            [clj-time.coerce]))
+            [slingshot.slingshot :refer (try+ throw+)]))

 (def dev-google-client-secret "r5t9LYCCJA3SaHnsDNg-dRsF")
 (defn google-client-secret []
@@ -53,17 +55,22 @@
       (select-keys [:email :email_verified :sub])))

 (defn user-info-from-sub [sub]
-  (let [resp (-> (http/get (format "https://www.googleapis.com/plus/v1/people/%s" sub)
-                           {:query-params {:key (google-api-key)}})
+  (try+
+    (let [resp (-> (http/get (format "https://www.googleapis.com/plus/v1/people/%s" sub)
+                             {:query-params {:key (google-api-key)}})
                  :body
                  json/decode)]
-    {:first-name (get-in resp ["name" "givenName"])
-     :last-name (get-in resp ["name" "familyName"])
-     :birthday (some-> resp (get "birthday") clj-time.format/parse clj-time.coerce/to-date)
-     :gender (get resp "gender")
-     :occupation (get resp "occupation")
-     :avatar-url (some-> (get-in resp ["image" "url"])
-                   url/url
-                   (assoc :query {})
-                   str
-                   (java.net.URI.))}))
+      {:first-name (get-in resp ["name" "givenName"])
+       :last-name (get-in resp ["name" "familyName"])
+       :birthday (some-> resp (get "birthday") clj-time.format/parse clj-time.coerce/to-date)
+       :gender (get resp "gender")
+       :occupation (get resp "occupation")
+       :avatar-url (some-> (get-in resp ["image" "url"])
+                     url/url
+                     (assoc :query {})
+                     str
+                     (java.net.URI.))})
+    ;; some users don't have a google plus account
+    (catch [:status 404] t
+      (log/infof "No google plus info for %s" sub)
+      {})))


twosigma/jet 2021-07-14 (#1391)

twosigma/jet 2021-07-14 (#1391)

--- waiter/project.clj
+++ waiter/project.clj
@@ -45,7 +45,7 @@
                  [io.grpc/grpc-core "1.20.0"
                   :exclusions [com.google.guava/guava]
                   :scope "test"]
-                 [twosigma/jet "0.7.10-20210126_171807-gea4b804"
+                 [twosigma/jet "0.7.10-20210714_175127-g9b2f58a"
                   :exclusions [org.mortbay.jetty.alpn/alpn-boot]]
                  [twosigma/clj-http "1.0.2-20180124_201819-gcdf23e5"
                   :exclusions [commons-codec commons-io org.clojure/tools.reader potemkin slingshot]]


Refactor process-turn

Refactor process-turn

--- src/obb_rules/turn.clj
+++ src/obb_rules/turn.clj
@@ -2,11 +2,15 @@
   (:require [obb-rules.action :as action]
             [obb-rules.result :as result]))

+(defn- apply-actions
+  "Applies the actions to a board"
+  [player current-game action]
+  (let [result (action current-game player)]
+    (result/result-board result)))
+
 (defn process
   "Processes the given actions"
   [game player & raw-actions]
-  (let [actions (map action/build-action raw-actions)]
-    (reduce (fn action-merger [current-game action]
-              (let [result (action current-game player)]
-                (result/result-board result)))
-            game actions)))
+  (let [actions (map action/build-action raw-actions)
+        do-actions (partial apply-actions player)]
+    (reduce do-actions game actions)))


more robust handling of exercise imports: deleting invalid imports

--- src/ontrail/import.clj
+++ src/ontrail/import.clj
@@ -105,12 +105,16 @@
     (.info logger (str "Importing " import-file " for user " user))
     (if (not (.exists import-file))
       (do (io/copy tempfile import-file)
-          (let [res (import-user-and-file user (str "imports/" (.getName import-file)))
-                fres (frequencies res)]
-            (send-import-msg user fres)
-            (if (> (fres \+) 0)
-              (str "/#import-ok=" (fres \+))
-              "/#import-error=invalidFormat")))
+          (try
+            (let [res (import-user-and-file user (str "imports/" (.getName import-file)))
+                  fres (frequencies res)]
+              (send-import-msg user fres)
+              (if (> (fres \+) 0)
+                (str "/#import-ok=" (fres \+))
+                (do (.delete import-file) "/#import-error=invalidFormat")))
+            (catch Exception exception
+              (.error logger (str exception))
+              (do (.delete import-file) "/#import-error=invalidFormat"))))
       "/#import-error=alreadyExists")))

 (defn -main [& args]


creationdate is criteria for the most comments result

--- src/ontrail/unread.clj
+++ src/ontrail/unread.clj
@@ -37,7 +37,7 @@
 (defn most-comments-oids []
   (.info logger "Aggregating comment counts")
   (let [comments-from (time/minus (time/now) (time/days 14))]
-    (mc/aggregate "exercise" [{"$match" {:lastModifiedDate {"$gte" comments-from}}} {"$unwind" "$comments"} {"$group" {"_id" "$_id" "size" {"$sum" 1}}} {"$sort" {"size" -1}} {"$limit" 100}])))
+    (mc/aggregate "exercise" [{"$match" {:creationDate {"$gte" comments-from}}} {"$unwind" "$comments"} {"$group" {"_id" "$_id" "size" {"$sum" 1}}} {"$sort" {"size" -1}} {"$limit" 100}])))

 (defn most-comments [user]
   (ex/decorate-results user (map (comp find-exercise :_id) (most-comments-oids))))


normalize package structure. begin adding vector tests.

--- src/onyx_java/test.clj
+++ src/onyx_java/test.clj
@@ -4,8 +4,8 @@
               [clojure.test :refer [deftest is]]))

-(def input-dir "test/resources/entity_conversion_test/source/")
-(def compare-dir "test/resources/entity_conversion_test/target/")
+(def input-dir "test/resources/onyx_simple/source/")
+(def compare-dir "test/resources/onyx_simple/target/")

 (deftest entity-coercion-test
     (let [input input-dir


Weak attempt at improving a doc string.

Weak attempt at improving a doc string.

--- src/re_frame/subs.cljc
+++ src/re_frame/subs.cljc
@@ -95,7 +95,7 @@

 (defn reg-sub
-  "Register a given handler function for a given query id.
+  "Associate the given `query id` with a handler function and an optional signal function.

   There's 3 ways this function can be called


deploy test

deploy test

--- src/panpan/persona.clj
+++ src/panpan/persona.clj
@@ -43,7 +43,7 @@
   [{:keys [text message-for-me?] :as arg}]
   (when message-for-me?
     (handler/regexp arg
-      #"ping"              (constantly "pong")
+      #"ping"              (constantly "pong!!!")
       #"^set (.+?) (.+?)$" (fn [{[_ k v] :match}] (brain/set k v) "OK")
       #"^get (.+?)$"       (fn [{[_ k]   :match}] (brain/get k))
       #"^brain$"           brain-key-values


Support simultaneous consumers for virtual streams

--- src/photon/streams.clj
+++ src/photon/streams.clj
@@ -152,11 +152,14 @@
                               [this :real-streams]
                               (conj real-streams stream-name)))))))))
   (create-virtual-stream-endpoint! [this stream-name]
-    (let [ch (chan (sliding-buffer 1))]
+    (let [ch (chan (sliding-buffer 1))
+          ch-mult (mult ch)]
       (dosync (alter virtual-streams assoc stream-name ch))
       (mcc/stream-source
        {:m m} (str "projection/" stream-name)
-       (fn [params] ch))))
+       (fn [params]
+         (let [t-ch (chan)]
+           (tap ch-mult t-ch))))))
   (create-stream-endpoint! [this stream-name]
     ;; TODO: Fix this mess
     (if (not (nil? m))


Added more references.

Added more references.

--- src/simulacrum/api.clj
+++ src/simulacrum/api.clj
@@ -4,5 +4,7 @@
             [clojure.string :as string]
             [clj-http.client :as client]
             [net.cgrand.enlive-html :as html]
+            [simulacrum.bigfive :as bigfive]
+            [simulacrum.ipip :as ipip]
             [simulacrum.util :as util]
             [simulacrum.version :as version]))


Rip out output collecter, wrapper, simplify state abstraction

--- src/angelic/search/implicit/dash_astar_opt_simple.clj
+++ src/angelic/search/implicit/dash_astar_opt_simple.clj
@@ -25,6 +25,8 @@

 ;; TODO: can we factor out ri equality check?

+;; TODO: cache pairs too ?
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;       Options      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -39,6 +41,10 @@
 (declare *state-abstraction*     ) ;; Use state abstraction?  Requires *decompose-cache*
 (declare *propagate-subsumption* ) ;; Automatically propagate subsumption links to corresponding children

+(defmacro cache-under [ks body]
+  `(if-let [^HashMap dc# *decompose-cache*]
+     (util/cache-with dc# ~ks ~body)
+     ~body))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;       Utilities      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -118,19 +124,32 @@
 (defn- canonical? [sp] (identical? sp (canonicalize sp)))

+
+
+(defn list-children        [s] (channel/publications (:child-channel s)))
+
+(defn subscribe-children!  [s w] (channel/subscribe! (:child-channel s) w))
+
+(defn- connect-and-watch! [p c child-f]
+  (sg/connect! p c)
+  (subscribe-children! c child-f))
+
+(defn- connect-ts! [p c]
+  (sg/connect! p (sp-ts c)))
+
 (defn publish-child! [sp child-sp]
   (when child-sp
     (util/print-debug 2 "AC" sp child-sp)
     (util/assert-is (not (identical? sp child-sp)))
-    (when (canonical? sp)
-      (schedule-subsumption! (sp-ts sp) (sp-ts child-sp))
-      (sg/connect! (sp-ts sp) (sp-ts child-sp))
-      (schedule-increase! (sp-ts sp)))
-    (channel/publish! (:child-channel sp) child-sp)))
-
-(defn list-children        [s] (channel/publications (:child-channel s)))
-
-(defn subscribe-children!  [s w] (channel/subscribe! (:child-channel s) w))
+    (if (and *collect-equal-outputs*
+             (fs/=-state-sets (:output-set sp) (:output-set child-sp)))
+      (do (schedule-increase! sp)
+          (connect-and-watch! sp child-sp (partial publish-child! sp)))
+      (do (when (canonical? sp)
+            (schedule-subsumption! (sp-ts sp) (sp-ts child-sp))
+            (sg/connect! (sp-ts sp) (sp-ts child-sp))
+            (schedule-increase! (sp-ts sp)))
+          (channel/publish! (:child-channel sp) child-sp)))))

 (defn subsuming-sps        [s] (keys (:subsuming-sp-set s)))
@@ -171,13 +190,6 @@
        (summary/solved? (sg/summary sp))))

-(defn- connect-and-watch! [p c child-f]
-  (sg/connect! p c)
-  (subscribe-children! c child-f))
-
-(defn- connect-ts! [p c]
-  (sg/connect! p (sp-ts c)))
-

 (defmethod print-method ::Subproblem [sp o]
   (print-method (format "#<SP$%8h %s>" (System/identityHashCode sp) (:name sp)) o))
@@ -206,27 +218,34 @@

 (declare refinement-names)

+(defn get-input-key [fs inp-set]
+  (if *state-abstraction* (fs/extract-context fs inp-set) inp-set))
+
 (defn- make-atomic-subproblem [fs inp-set]
-  (let [[out-set reward status] (fs/apply-opt fs inp-set)]
-    (when out-set
-     (let [nm         (atomic-name fs)
-	   summary-fn (atom #(make-summary reward status %))
-	   set-sf!    (fn [s f] (reset! summary-fn f) (schedule-decrease! s))]
-       (make-subproblem
-	nm inp-set out-set nil
-	(fn expand! [s]
-	  (util/print-debug 1 "expand" nm)
-	  (set-sf! s sg/or-summary)
-	  (if-let [subsuming-sps (seq (remove terminal? (subsuming-sps s)))]
-	    (connect-and-watch! s (apply min-key (comp sg/get-bound sp-ts) subsuming-sps)
-	      (fn [sub-child] (publish-child! s (refine-input sub-child inp-set))))
-	    (doseq [ref-name (refinement-names fs inp-set)]
-	      (publish-child! s (get-subproblem ref-name inp-set)))))
-	(fn [s ri]  (assert (not *collect-equal-outputs*))
-	  (if (= ri inp-set) s (get-subproblem nm  ri)))
-	(fn summarize [s] (@summary-fn s)))))))
-
-(defmethod get-subproblem :Atomic [[_ fs :as n] inp-set]
+  (let [nm (atomic-name fs)]
+    (cache-under [nm (get-input-key fs inp-set)]
+     (let [[out-set reward status] (fs/apply-opt fs inp-set)]
+       (when out-set
+         (let [summary-fn (atom #(make-summary reward status %))
+               set-sf!    (fn [s f] (reset! summary-fn f) (schedule-decrease! s))]
+           (make-subproblem
+            nm inp-set out-set nil
+            (fn expand! [s]
+              (util/print-debug 1 "expand" nm)
+              (set-sf! s sg/or-summary)
+              (if-let [subsuming-sps (seq (remove terminal? (subsuming-sps s)))]
+                (connect-and-watch! s (apply min-key (comp sg/get-bound sp-ts) subsuming-sps)
+                  (fn [sub-child] (publish-child! s (refine-input sub-child inp-set))))
+                (doseq [ref-name (refinement-names fs inp-set)]
+                  (publish-child! s (get-subproblem ref-name inp-set)))))
+            (fn [s ri]  #_ (assert (not *collect-equal-outputs*))
+              (if (= ri inp-set) s (get-subproblem nm  ri)))
+            (fn summarize [s] (@summary-fn s)))))))))
+
+
+;; TODO: handle state abstraction
+;; TODO: should wrap pairs like this too?
+(defmethod get-subproblem :Atomic [[_ fs] inp-set]
   (make-atomic-subproblem fs inp-set))

@@ -299,71 +318,8 @@
   (make-half-pair-subproblem (get-subproblem left-name inp) #(get-subproblem right-name %)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Wrappers     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn make-wrapped-subproblem
-  "Make a wrapped subproblem, which modifies the behavior of a wrapped 'canonical'
-   subproblem while retaining the same semantics, tree summarizer, etc."
-  [nm inp-set out-set prefix-set inner-sp child-watch ri-fn]
-  (util/assert-is (contains? prefix-set (first (:name inner-sp))))
-  (let [ret (make-subproblem nm inp-set out-set (sp-ts inner-sp)
-                             (fn [_] (throw (RuntimeException.)))
-                             ri-fn sg/or-summary)]
-    (connect-and-watch! ret inner-sp #(child-watch ret %))
-    ret))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;     Output Collection     ;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Output Collector captures children with the same output set, and only
-;; releases new children for refined output sets.
-
-;; OutputCollector also handles decomposition and inside of state abstraction, when applicable.
-
-(defn oc-name [inner-name] [:OC inner-name])
-
-
-
-(defn log-input [fs inp-set] (if *state-abstraction* (fs/get-logger fs inp-set) inp-set))
-(defn get-input-key [fs inp-set] (if *state-abstraction* (fs/extract-context fs inp-set) inp-set))
-
-(declare get-ocs)
-
-;; Input-key caching not necessary, but speeds things up a lot on, e.g., discrete-manipulation.
-;; TODO: only :Atomic or :Pair inside, when SA off
-(defn- make-output-collecting-subproblem [fs inp-key inner-sp]
-  (when inner-sp
-   (make-wrapped-subproblem
-    (oc-name (:name inner-sp)) (:input-set inner-sp) (:output-set inner-sp)
-    #{:Atomic :Pair #_ ::TODO??? :SA :OC} inner-sp
-    (fn child-watch [sp child-sp]
-      (if (fs/=-state-sets (:output-set inner-sp) (:output-set child-sp))
-	(do (schedule-increase! sp) (connect-and-watch! sp child-sp #(child-watch sp %)))
-	(publish-child! sp (make-output-collecting-subproblem fs inp-key child-sp))))
-    (fn refine-input [s ni]
-      (let [ninp-key (get-input-key fs ni)]
-	(if (= inp-key ninp-key)
-	  s
-	  (if (#{:Atomic} (first (:name inner-sp))) ;; TODO!
-	    (when-let [ret (get-ocs (:name inner-sp) fs ninp-key ni)]
-	      (util/assert-is (not (identical? (canonicalize ret) inner-sp)) "%s" [(def *bad* [s inner-sp (:input-set s) ni])])
-	      (add-subsuming-sp! (canonicalize ret) inner-sp)
-	      ret)
-	    (make-output-collecting-subproblem fs ninp-key (refine-input inner-sp (log-input fs ni))))))))))
-
-(defn get-ocs [inner-n fs inp-key inp-set]
-  (let [make-sp #(make-output-collecting-subproblem fs inp-key (get-subproblem inner-n (log-input fs inp-set)))]
-    (if-let [^HashMap dc *decompose-cache*]
-      (util/cache-with dc [inner-n inp-key] (make-sp))
-      (make-sp))))
-
-(defmethod get-subproblem :OC [[_ inner-n :as n] inp-set]
-  (let [fs (atomic-name-fs inner-n)] (get-ocs inner-n fs (get-input-key fs inp-set) inp-set)))
-
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;     State Abstraction     ;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; State abstractor puts the output of a subproblem (and all children) in a new context.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    SA Wrapper     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+

 (defn sa-name [inner-name] [:SA inner-name])

@@ -371,14 +327,31 @@
 ;; Also note: new input can have subset of variables of old. (=-state-sets does ntthis now).
 (defn- make-state-abstracted-subproblem [fs inner-sp inp-set]
   (when inner-sp
-   (make-wrapped-subproblem
-    (sa-name (:name inner-sp)) inp-set (fs/transfer-effects inp-set (:output-set inner-sp)) #{:OC} inner-sp
-    (fn [sp child-sp] (publish-child! sp (make-state-abstracted-subproblem fs child-sp inp-set)))
-    (fn [sp ni] (if (fs/=-state-sets ni inp-set) sp (make-state-abstracted-subproblem fs (refine-input inner-sp ni) ni))))))
+    (let [ret (make-subproblem
+               (sa-name (:name inner-sp))
+               inp-set (fs/transfer-effects inp-set (:output-set inner-sp))
+               (sp-ts inner-sp)
+               (fn [_] (throw (RuntimeException.)))
+               (fn [sp ni]
+                 (if (fs/=-state-sets ni inp-set) sp
+                     (let [log-ni (fs/get-logger fs ni)]
+                       (make-state-abstracted-subproblem fs (refine-input inner-sp log-ni) ni))))
+               sg/or-summary)]
+      (connect-and-watch! ret inner-sp
+       #(publish-child! ret (make-state-abstracted-subproblem fs % inp-set)))
+      ret)))
+

 (defmethod get-subproblem :SA [[_ inner-n :as n] inp-set]
-  (let [fs (atomic-name-fs (second inner-n))]
-    (make-state-abstracted-subproblem fs (get-subproblem inner-n inp-set) inp-set)))
+  (let [fs (atomic-name-fs inner-n)]
+    (make-state-abstracted-subproblem fs
+      (get-subproblem inner-n (fs/get-logger fs inp-set))
+      inp-set)))
+
+(defn log-input [fs inp-set] (if *state-abstraction* (fs/get-logger fs inp-set) inp-set))
+
+
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -394,7 +367,7 @@

 (defn- wrapped-atomic-name [fs]
   (let [in  (atomic-name fs)
-        mid (if *collect-equal-outputs* (oc-name in) in)]
+        mid in #_ (if *collect-equal-outputs* (oc-name in) in)]
     (if *state-abstraction* (sa-name mid) mid)))

@@ -440,7 +413,9 @@

-;; (do (use 'angelic.util '[angelic env hierarchy] 'angelic.domains.nav-switch  'angelic.domains.discrete-manipulation 'angelic.search.implicit.dash-astar-opt-simple) (require '[angelic.search.summary-graphs :as sg] '[angelic.search.summary :as summary]) (defn s [x]  (sg/summarize x)) (defn sc [x] (summary/children x))  (defn src [x] (summary/source x)) (defn nc [x] (sg/child-nodes x)))
+;; (do (use 'angelic.util '[angelic env hierarchy] 'angelic.domains.nav-switch  'angelic.domains.discrete-manipulation 'angelic.search.implicit.dash-astar-opt-simple) (require '[angelic.search.summary-graphs-new :as sg] '[angelic.search.summary :as summary]) (defn s [x]  (sg/summarize x)) (defn sc [x] (summary/children x))  (defn src [x] (summary/source x)) (defn nc [x] (sg/child-nodes x)))
+
+;; (require '[angelic.search.implicit.dash-astar-opt :as dao])

 ;; (do (use 'clojure.test) (use 'angelic.test.search.implicit.dash-astar-opt-simple) (run-tests 'angelic.test.search.implicit.dash-astar-opt-simple))


Extract shuffle-board!

Extract shuffle-board!

--- src/tile_game/core.clj
+++ src/tile_game/core.clj
@@ -27,7 +27,10 @@
                                      (int (+ cx (quot scale 2)))
                                      (int (+ cy (quot scale 2)))))))

-(def board (ref (create-board 2)))
+(def board (ref (create-board 4 :shuffle)))
+
+(defn shuffle-board! [dim]
+  (dosync (ref-set board (create-board dim :shuffle))))

 (defn slide!
   [render & moves]
@@ -45,11 +48,7 @@
                          (paint [g]
                            (doseq [x (range dim) y (range dim)]
                              (render-tile g @board [x y]))))
-        render (a/chan)
-        shuffle-board!
-        (fn [dim] (dosync (ref-set board
-                                   (create-board dim :shuffle))))]
-    (shuffle-board! dim)
+        render (a/chan)]
     (doto panel
       (.setPreferredSize (Dimension. size size))
       (.setFocusable true)


fixing allocation error message

fixing allocation error message

--- src/overtone/sc/machinery/allocator.clj
+++ src/overtone/sc/machinery/allocator.clj
@@ -38,7 +38,7 @@
 (defn- find-gap
   [bs size idx gap-found limit]
   (when (> idx limit)
-    (throw (Exception. (str "No more ids! Unable to allocate a sequence of ids of length" size))))
+    (throw (Exception. (str "No more ids! Unable to allocate a sequence of ids of length: " size))))
   (if (= gap-found size)
     (- idx gap-found)
     (let [gap-found (if (not (get bs idx)) (inc gap-found) 0)]


Clean up naming and docstrings.

Clean up naming and docstrings.

--- src/riemann/server.clj
+++ src/riemann/server.clj
@@ -127,12 +127,13 @@
     (exceptionCaught [context ^ExceptionEvent exception-event]
       (warn (.getCause exception-event) "UDP handler caught"))))

-(defn channel-pipeline-factory-factory
-  "BOOM"
-  [pipeline handler]
+(defn channel-pipeline-factory
+  "Return a factory for ChannelPipelines given a wire protocol-specific
+  pipeline factory and a network protocol-specific handler."
+  [pipeline-factory handler]
   (proxy [ChannelPipelineFactory] []
     (getPipeline []
-      (doto (pipeline)
+      (doto (pipeline-factory)
         (.addLast "executor" (ExecutionHandler.
                               (OrderedMemoryAwareThreadPoolExecutor.
                                16 1048576 1048576))) ; Maaagic values!
@@ -160,7 +161,7 @@
                        (Executors/newCachedThreadPool)
                        (Executors/newCachedThreadPool)))
            all-channels (DefaultChannelGroup. (str "tcp-server " opts))
-           cpf (channel-pipeline-factory-factory
+           cpf (channel-pipeline-factory
                 (:pipeline-factory opts) (tcp-handler core all-channels))]

      ; Configure bootstrap
@@ -211,7 +212,7 @@
                      (NioDatagramChannelFactory.
                        (Executors/newCachedThreadPool)))
          all-channels (DefaultChannelGroup. (str "udp-server " opts))
-         cpf (channel-pipeline-factory-factory
+         cpf (channel-pipeline-factory
               (:pipeline-factory opts) (udp-handler core all-channels))]

      ; Configure bootstrap


adds the json and xml parsing functions to dynamic vars so they can be replaced by custom parsers

--- src/ring_curl/core.clj
+++ src/ring_curl/core.clj
@@ -4,6 +4,11 @@
             [clojure.data.json :as json]
             [clojure.xml :as xml])
   (:refer-clojure :exclude [replace]))
+
+(def ^:dynamic write-json json/write-str)
+(def ^:dynamic write-xml (fn [body] (with-out-str (xml/emit-element body))))
+
+(def escaped-quote "\\\"")

 (defn- quoted [& s]
   (str "\"" (join s) "\""))
@@ -58,9 +63,9 @@
              (escape
                (cond
                  (string? body) body
-                 (xml? request) (with-out-str (xml/emit-element body))
-                 :else (json/write-str body))
-               {\" "\\\""})
+                 (xml? request) (write-xml body)
+                 :else (write-json body))
+               {\" escaped-quote})
              )))))

 (defn- verbose [options]


bug fix

bug fix

--- src/s7p/slave/core.clj
+++ src/s7p/slave/core.clj
@@ -61,11 +61,12 @@
     1 (let [{dsp :dsp res :response} (first resps)
             fp (or floor-price (:bidPrice res))]
         {:dsp dsp :response res :second-price fp})
-    _ (let [[{dsp :dsp res :response} {second-price :response}]
-            (->> (conj {:bidPrice floor-price} resps)
-                 (shuffle)
-                 (take 2))]
-        {:dsp dsp :response res :second-price (:bidPrice second-price)})))
+    (let [[{dsp :dsp res :response} {second-price :response}]
+          (->> resps
+               (shuffle)
+               (sort-by (comp :bidPrice :response) >)
+               (take 2))]
+      {:dsp dsp :response res :second-price (:bidPrice second-price)})))

 (defn click? [result {response :response}]
   (result (.indexOf advertisers (:advertiserId response))))


lein-release plugin: bumped version from 0.1.10 to 0.1.11-SNAPSHOT for next development cycle

--- re_view_hiccup/project.clj
+++ re_view_hiccup/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view-hiccup "0.1.10"
+(defproject re-view-hiccup "0.1.11-SNAPSHOT"
   :description "Hiccup parser for re-view"

   :url "https://www.github.com/braintripping/re-view/tree/master/re_view_hiccup"


Make / an alias for /index.html when serving the client

--- src/server/handler.clj
+++ src/server/handler.clj
@@ -8,7 +8,10 @@
             [compojure.core :refer [defroutes GET OPTIONS POST]]
             [compojure.route :as route]
             [om.next.server :as om]
-            [ring.util.response :refer [content-type header response]]
+            [ring.util.response :refer [content-type
+                                        header
+                                        response
+                                        resource-response]]
             [ring.middleware.format-params
              :refer [wrap-transit-json-params]]
             [ring.middleware.format-response
@@ -20,6 +23,7 @@
 ;;;; App server

 (defroutes app-routes
+  (GET "/" [] (resource-response "index.html" {:root "public"}))
   (route/resources "/")
   (route/not-found "Not found"))


Drop comment.

Drop comment.

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -286,8 +286,6 @@
    :join probemap_sources
    :columns probemaps-columns})

-; if probemap is a file name, we probably want a separate table.
-; Should we reuse the experiments table?? Or duplicate all the fields??
 (def probemap-probes-table
   ["CREATE TABLE IF NOT EXISTS `probemap_probes` (
    `id` INT NOT NULL AUTO_INCREMENT PRIMARY KEY,