workaround quirk with passing false as a form input

--- frontend/components/shared.cljs
+++ frontend/components/shared.cljs
@@ -171,10 +171,11 @@
                                                    (om/set-state! owner [:loading?] true)
                                                    (go (let [resp (<! (ajax/managed-form-post
                                                                        "/about/contact"
-                                                                       :params {:name name
-                                                                                :email email
-                                                                                :message message
-                                                                                :enterprise enterprise?}))]
+                                                                       :params (merge {:name name
+                                                                                :email email
+                                                                                :message message}
+                                                                                (when enterprise?
+                                                                                {:enterprise enterprise?}))))]
                                                          (if (= (:status resp) :success)
                                                            (om/update-state! owner (fn [s]
                                                                                {:name ""


added some description about KVstore namespace

--- moebius/src/moebius/kv.clj
+++ moebius/src/moebius/kv.clj
@@ -1,8 +1,37 @@
 (ns moebius.kv
+  "This namespace provides the protocols for a Key/Value store
+  and the operations necessary to persist and restore its state.
+  There is also an implementation for of an in-memory store
+  which relies on Clojure immutable maps."
   (:refer-clojure :exclude [set get update]))

 ;;
 ;; TODO: force keys to string?
+;;
+
+;;
+;; The core of the state management is done via this KeyValue store.
+;; As a normal K/V store you can `set`/`get` or delete (`del`)
+;; an arbitrary key. The value will stored and persisted together
+;; with the output events in such way that if the process fail
+;; before persisting the values, the state will be restored
+;; to the value they had before processing the requests.
+;; Keeping K/V state aligned with the events to process,
+;; guarantee consistent values and high processing speed
+;; as the processing is done entirely in memory.
+;;
+;; The K/V store is distributed across all processing machines.
+;; The sharding strategy follow the same strategy of the events
+;; processing.
+;; Part of the key is the `sourceId` of the event you are processing
+;; it is required. It is really important to provide the same `sourceId`
+;; of the events in order to guarantee that the state is restored in
+;; the same place.
+;;
+;; In order worlds the Dirstibuted K/V Store will be distributed
+;; in the exact same way of the events, guaranteeing that a certain
+;; key will always be local to a the task which is processing a certain
+;; event with the same `sourceId`.
 ;;

 ;;


Rewrite calls! so it is more reliable and requires less syntax

--- src/play_clj/utils.clj
+++ src/play_clj/utils.clj
@@ -56,18 +56,22 @@
   [a]
   (Array. true (into-array a) 1 (count a)))

-(defn create-method-call
-  [[k v]]
-  (flatten (list (key->method k) (try (eval v)
-                                   (catch Exception _ v)))))
-
 (defmacro call!
   [obj k & args]
   `(~(key->method k) ~obj ~@args))

+(defn create-method-calls
+  [calls args]
+  (let [method-name (first args)
+        [my-args rest-args] (split-with #(not (keyword? %)) (rest args))]
+    (if method-name
+      (create-method-calls (conj calls `(~(key->method method-name) ~@my-args))
+                           rest-args)
+      calls)))
+
 (defmacro calls!
-  [obj & {:keys [] :as args}]
-  `(doto ~obj ~@(map create-method-call args)))
+  [obj & args]
+  `(doto ~obj ~@(create-method-calls [] args)))

 (defmulti create-entity class)


Remove subscription values for sub-create traces

--- src/re_frame/subs.cljc
+++ src/re_frame/subs.cljc
@@ -114,7 +114,6 @@
      (if-let [cached (cache-lookup query)]
        (do
          (trace/merge-trace! {:tags {:cached?  true
-                                     :value (deref cached)
                                      :reaction (reagent-id cached)}})
          cached)

@@ -124,9 +123,7 @@
          (if (nil? handler-fn)
            (do (trace/merge-trace! {:error true})
                (console :error (str "re-frame: no subscription handler registered for: \"" query-id "\". Returning a nil subscription.")))
-           (let [sub-reaction (handler-fn app-db query)]
-             (do (trace/merge-trace! {:tags {:value (deref sub-reaction)}})
-                 (cache-and-return query [] sub-reaction))))))))
+           (cache-and-return query [] (handler-fn app-db query)))))))

   ([query dynv]
    (trace/with-trace {:operation (first-in-vector query)


fix typo that slipped in with ugen metadata changes

--- src/overtone/sc/machinery/ugen/metadata/trig.clj
+++ src/overtone/sc/machinery/ugen/metadata/trig.clj
@@ -171,7 +171,7 @@
               {:name "exec-freq", :default 100.0}
               {:name "max-bins-per-octave", :default 16}
               {:name "median", :default 1}
-              {:name "ampTthreshold", :default 0.01}
+              {:name "amp-threshold", :default 0.01}
               {:name "peak-threshold", :default 0.5}
               {:name "down-sample", :default 1}]
        :rates #{:kr}


Add support for nil in byte array conversions.

--- src/buddy/core/codecs.clj
+++ src/buddy/core/codecs.clj
@@ -140,5 +140,9 @@
   (Class/forName "[B")
   (->byte-array [it] it)

+  nil
+  (->byte-array [_]
+    (byte-array 0))
+
   String
   (->byte-array [data] (str->bytes data)))


Fix syntaxis typo's

Fix syntaxis typo's

--- src/buddy/crypto/keys.clj
+++ src/buddy/crypto/keys.clj
@@ -1,7 +1,7 @@
 (ns buddy.crypto.keys
   (:import java.security.Key))

-(def make-secret-key
+(defn make-secret-key
   "Generates a Key instance from given raw string key."
   [^String skey]
   (let [rawkey (.getBytes skey "UTF-8")]


Starting to pipeline the main app.

Starting to pipeline the main app.

--- src/blutwurst/core.clj
+++ src/blutwurst/core.clj
@@ -1,23 +1,27 @@
-(ns blutwurst.core
-  (:require [clojure.tools.cli :refer [parse-opts]]
-            [clojure.pprint :refer :all])
-  (:gen-class))
-
-(def cli-options
-  [["-o" "--output OUTPUT_DIR" "Output location."
-    :default "."]
-   ["-c" "--connection-string CONNECTION" "Connection string to scan."
-     :default "jdbc:h2:mem:"]
-   ["-f" "--format FORMAT" "Format to which test data should be exported."
-    :default "csv"]
-   ["-h" "--help"]])
-
-(defn- build-spec [options] {:connection-string (:connection-string options)})
-
-(defn -main
-  "Main command line interface that will pass in arguments and kick off the data generation process."
-  [& args]
-  (let [parsed-input (parse-opts args cli-options)
-        spec (build-spec (:options parsed-input))]
-    (-> spec)
-    ))
+(ns blutwurst.core
+  (:require [clojure.tools.cli :refer [parse-opts]]
+            [clojure.pprint :refer :all]
+            [blutwurst.database]
+            [blutwurst.planner])
+  (:gen-class))
+
+(def cli-options
+  [["-o" "--output OUTPUT_DIR" "Output location."
+    :default "."]
+   ["-c" "--connection-string CONNECTION" "Connection string to scan."
+     :default "jdbc:h2:mem:"]
+   ["-f" "--format FORMAT" "Format to which test data should be exported."
+    :default "csv"]
+   ["-h" "--help"]])
+
+(defn- build-spec [options] {:connection-string (:connection-string options)})
+
+(defn -main
+  "Main command line interface that will pass in arguments and kick off the data generation process."
+  [& args]
+  (let [parsed-input (parse-opts args cli-options)
+        spec (build-spec (:options parsed-input))]
+    (-> spec
+        blutwurst.database/retrieve-table-graph
+        (partial blutwurst.planner/create-data-generation-plan spec))
+    ))


Simplified state-loop.

Simplified state-loop.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -7,23 +7,14 @@
             [cbfg.world.base]
             [cbfg.world.net]))

-(defn state-loop [actx name initial-state & {:keys [unknown-fn]}]
+(defn state-loop [actx name loop-fn initial-state]
   (let [req-ch (achan actx)]
     (act-loop state-loop actx [name name state initial-state]
               (when-let [m (atake state-loop req-ch)]
-                (case (:op m)
-                  :get (do (aput-close state-loop (:res-ch m)
-                                       (assoc m :status :ok :value state))
-                           (recur name state))
-                  :update (do (when (:res-ch m)
-                                (aput-close state-loop (:res-ch m)
-                                            (assoc m :status :ok)))
-                              (recur name ((:update-fn m) state)))
-                  (when unknown-fn
-                    (when-let [[state2 res] (unknown-fn state-loop state m)]
-                      (when (and res (:res-ch m))
-                        (aput-close state-loop (:res-ch m) res))
-                      (recur name state2))))))
+                (when-let [[state2 res] (loop-fn state-loop state m)]
+                  (when (and res (:res-ch m))
+                    (aput-close state-loop (:res-ch m) res))
+                  (recur name state2))))
     req-ch))

 ; --------------------------------------------
@@ -119,16 +110,14 @@

 (defn kv-server [server-addr & ports]
   (let [world (:world (prog-base-now))
-        server-state-ch (state-loop world :server-state
-                                    (make-initial-server-state world)
-                                    :unknown-fn server-handler)
+        server-state-ch (state-loop world :server-state server-handler
+                                    (make-initial-server-state world))
         lane-max-inflight 10
         lane-buf-size 20
         make-lane (fn [actx lane-name lane-out-ch]
                     (let [lane-in-ch (achan-buf actx lane-buf-size)
-                          lane-state-ch (state-loop actx :lane-state
-                                                    initial-lane-state
-                                                    :unknown-fn lane-handler)
+                          lane-state-ch (state-loop actx :lane-state lane-handler
+                                                    initial-lane-state)
                           lane-state-cb (fn [is-req m lane-ext-state]
                                           (if is-req
                                             (if m


Using override make-fenced-pump-lane in t2.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -1,6 +1,7 @@
 (ns cbfg.world.t2
-  (:require-macros [cbfg.act :refer [act act-loop achan achan-buf aput atake atimeout]])
-  (:require [cbfg.world.t1 :refer [prog-base-now prog-curr-now prog-evt
+  (:require-macros [cbfg.act :refer [act achan achan-buf aput atake]])
+  (:require [cbfg.fence]
+            [cbfg.world.t1 :refer [prog-base-now prog-curr-now prog-evt
                                    wait-done addr-override-xy]]
             [cbfg.world.base]
             [cbfg.world.net]))
@@ -16,9 +17,16 @@
                                   (make-t2-cmd-handlers nil) el-prefix
                                   cbfg.world.t1/ev-msg init-event-delay))

+(defn make-fenced-pump-lane [actx lane-name lane-out-ch]
+  (let [max-inflight 10
+        lane-buf-size 20
+        lane-in-ch (achan-buf actx lane-buf-size)]
+    (cbfg.fence/make-fenced-pump actx lane-name lane-in-ch lane-out-ch max-inflight false)
+    lane-in-ch))
+
 (defn server-conn-loop [actx server-send-ch server-recv-ch close-server-recv-ch]
   (cbfg.world.net/server-conn-loop actx server-send-ch server-recv-ch close-server-recv-ch
-                                   :make-lane-fn cbfg.world.lane/make-fenced-pump-lane))
+                                   :make-lane-fn make-fenced-pump-lane))

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


change '=' to 'identical?' in parser token comparison, seems to yield ~15% performance improvement across benchmarks

--- src/cheshire/parse.clj
+++ src/cheshire/parse.clj
@@ -44,7 +44,7 @@
            (persistent! coll#))))))

 (defn parse* [^JsonParser jp key-fn bd? array-coerce-fn]
-  (condp = (.getCurrentToken jp)
+  (condp identical? (.getCurrentToken jp)
     JsonToken/START_OBJECT (parse-object jp key-fn bd? array-coerce-fn)
     JsonToken/START_ARRAY (parse-array jp key-fn bd? array-coerce-fn)
     JsonToken/VALUE_STRING (.getText jp)


Small changes to resources for testing.

Small changes to resources for testing.

--- src/clj/aspire/web.clj
+++ src/clj/aspire/web.clj
@@ -29,15 +29,14 @@
 (defresource resource-api
   :available-media-types ["application/edn"]
   :handle-ok (fn [_]
-               (println :resource-api)
-               (str {:now (.getTime (java.util.Date.))})))
+               (str {:comp_tag {:name "tag name" :version "v7" :description "Herein shall be a description." :cnt-completed 9 :cnt-remaining 20}})
+               ))

 (defresource resource-comps
   ;; demo resource to select some comp records
   :available-media-types ["application/edn"]
   :handle-ok (fn [_]
-               (println :resource-comps)
-               (a-sqldb/select! {:select [:*] :from [:comp] :limit 2})))
+               (a-sqldb/select! {:select [:*] :from [:comp]})))

 (defroutes app-routes
   (ANY "/" [] resource-app)


Updated damage prevention cards.

Updated damage prevention cards.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -65,7 +65,7 @@
                  :msg "gain [Click][Click]"}]}

    "Amped Up"
-   {:effect (effect (gain :click 3) (damage :brain 1))}
+   {:effect (effect (gain :click 3) (damage :brain 1 :unpreventable))}

    "Andromeda: Dispossessed Ristie"
    {:effect (effect (gain :link 1) (draw 4)) :mulligan (effect (draw 4))}
@@ -292,7 +292,8 @@
    {:recurring 1}

    "Clone Chip"
-   {:abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
+   {:prevent [:net]
+    :abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
                  :choices (req (filter #(and (has? % :type "Program")
                                              (<= (:cost %) (:credit runner))) (:discard runner)))
                  :effect (effect (trash card) (runner-install target))}]}
@@ -360,8 +361,11 @@
                    (gain state :corp :credit 7) (lose state :corp :credit :all)))}

    "Crash Space"
-   {:recurring 2
-    :abilities [{:msg "prevent 3 meat damage" :effect (effect (trash card))}]}
+   {:prevent [:meat]
+    :recurring 2
+    :abilities [{:label "Trash to prevent up to 3 meat damage"
+                 :msg "prevent up to 3 meat damage"
+                 :effect (effect (trash card) (damage-prevent :meat 3))}]}

    "Crescentus"
    {:abilities [{:req (req current-ice) :msg (msg "derez " (:title current-ice))
@@ -628,8 +632,9 @@
                     (move target :hand) (shuffle! :deck))}

    "Feedback Filter"
-   {:abilities [{:cost [:credit 3] :msg "prevent 1 net damage"}
-                {:effect (effect (trash card)) :msg "prevent 2 brain damage"}]}
+   {:prevent [:net :brain]
+    :abilities [{:cost [:credit 3] :msg "prevent 1 net damage" :effect (effect (damage-prevent :net 1))}
+                {:msg "prevent 2 brain damage" :effect (effect (trash card) (damage-prevent :brain 2)) }]}

    "Feint"
    {:effect (effect (run :hq) (max-access 0))}
@@ -1161,6 +1166,12 @@
                                 (move state side (second (:deck runner)) :deck)
                                 (move state side (first (:deck runner)) :deck)))}]}

+   "Muresh Bodysuit"
+   {:events {:pre-damage {:once :per-turn :once-key :muresh-bodysuit
+                          :req (req (= target :meat))
+                          :msg "prevent the first meat damage this turn"
+                          :effect (effect (damage-prevent :meat 1))}}}
+
    "Mushin No Shin"
    {:prompt "Choose a card to install"
     :choices (req (filter #(#{"Asset" "Agenda" "Upgrade"} (:type %)) (:hand corp)))
@@ -1193,7 +1204,9 @@
    {:recurring 1}

    "Net Shield"
-   {:abilities [{:cost [:credit 1] :once :per-turn :msg "prevent the first net damage this turn"}]}
+   {:prevent [:net]
+    :abilities [{:cost [:credit 1] :once :per-turn :msg "prevent the first net damage this turn"
+                 :effect (effect (damage-prevent :net 1))}]}

    "Networking"
    {:effect (effect (lose :tag 1))
@@ -1340,29 +1353,8 @@

    "Plascrete Carapace"
    {:data [:counter 4]
-    :events
-          {:pre-damage
-           {:req (req (and (= target :meat) (> (:counter card) 0)))
-            :effect (req (let [plasc card]
-                              (prompt! state :runner card "Use Plascrete Carapace tokens to prevent meat damage?"
-                                  (take (inc (:counter plasc)) ["0" "1" "2" "3" "4"])
-                                  {:effect (req (let [c (Integer/parseInt target)]
-                                                     (damage-bonus state side :meat (- c))
-                                                     (add-prop state :runner plasc :counter (- c))))
-                                   :msg (msg "prevent " target " meat damage")
-                                   })))
-            }}}
-                 ;(req (let [plasc card]
-                 ;             (resolve-ability
-                 ;               state :runner
-                 ;               {:prompt "Use Plascrete Carapace tokens to prevent meat damage?"
-                 ;                :choices (take (inc (:counter plasc)) ["0" "1" "2" "3" "4"])
-                 ;                :effect (req (let [c (Integer/parseInt target)]
-                 ;                                  (damage-bonus state side :meat (- c))
-                 ;                                  (add-prop state :runner plasc :counter (- c))))
-                 ;                :msg (msg "prevent " target " meat damage")
-                 ;                } card nil)))}}}
-    ;:abilities [{:counter-cost 1 :msg "prevent 1 meat damage"}]}
+    :prevent [:meat]
+    :abilities [{:counter-cost 1 :effect (effect (damage-prevent :meat 1))}]}

    "Priority Requisition"
    {:choices {:req #(and (= (:type %) "ICE") (not (:rezzed %)))}
@@ -1715,7 +1707,8 @@
    {:effect (effect (lose :runner :max-hand-size 1))}

    "Self-modifying Code"
-   {:abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
+   {:prevent [:net]
+    :abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
                  :choices (req (filter #(has? % :type "Program") (:deck runner)))
                  :cost [:credit 2]
                  :effect (effect (trash card) (runner-install target) (shuffle! :deck))}]}
@@ -1866,7 +1859,7 @@
    {:events {:runner-turn-begins
              {:effect #(if (>= (:counter %3) 2)
                          (do (set-prop %1 %2 %3 :counter 0)
-                             (damage %1 %2 :brain 1)
+                             (damage %1 %2 :brain 1 :unpreventable)
                              (system-msg %1 %2 "takes 1 brain damage from Stim Dealer"))
                          (do (add-prop %1 %2 %3 :counter 1)
                              (gain %1 %2 :click 1)
@@ -1875,7 +1868,7 @@
    "Stimhack"
    {:prompt "Choose a server" :choices (req servers) :msg " take 1 brain damage"
     :effect (effect (gain :credit 9)
-                    (run target {:end-run {:effect (effect (damage :brain 1))}} card))}
+                    (run target {:end-run {:effect (effect (damage :brain 1 :unpreventable))}} card))}

    "Subliminal Messaging"
    {:effect (effect (gain :credit 1)
@@ -2255,8 +2248,10 @@
     :abilities [{:cost [:credit 2] :msg "break ICE subroutine"}]}

    "Deus X"
-   {:abilities [{:msg "break any number of AP subroutines" :effect (effect (trash card))}
-                {:msg "prevent any amount of net damage" :effect (effect (trash card))}]}
+   {:prevent [:net]
+    :abilities [{:msg "break any number of AP subroutines" :effect (effect (trash card))}
+                {:msg "prevent any amount of net damage"
+                 :effect (effect (trash card) (damage-prevent :net Integer/MAX_VALUE))}]}

    "Eater"
    {:abilities [{:cost [:credit 1] :msg "break ICE subroutine and access 0 cards this run"
@@ -2534,7 +2529,7 @@
                  :msg (msg "trash " (:title target)) :label "Trash a piece of hardware"
                  :choices (req (get-in runner [:rig :hardware])) :effect (effect (trash target))}
                 {:msg "do 2 meat damage and end the run"
-                 :effect (effect (damage :meat 2) (end-run))}]}
+                 :effect (effect (damage :meat 2 :unpreventable) (end-run))}]}

    "Galahad"
    {:abilities [{:msg "end the run" :effect (effect (end-run))}]}


session name size fix

session name size fix

--- src/clojure2d/core.clj
+++ src/clojure2d/core.clj
@@ -1311,7 +1311,7 @@
   "Create unique session name based on current time. Result is a vector with date and hash represented as hexadecimary number."
   []
   (let [date (java.util.Date.)]
-    [(.format simple-date-format date) (to-hex (hash date))]))
+    [(.format simple-date-format date) (to-hex (hash date) 8)]))

 (defn- make-session-fn
   "Create session"


Fix typo in sync

Fix typo in sync

--- src/braid/server/sync.clj
+++ src/braid/server/sync.clj
@@ -31,7 +31,7 @@
                          (set (:any @connected-uids)))
                        (set ids-to-skip)))
         thread (db/thread-by-id thread-id)]
-    (doseq [uid user-ids-to-send-to]
+    (doseq [uid user-ids]
       (let [user-tags (db/tag-ids-for-user uid)
             filtered-thread (update-in thread [:tag-ids]
                                        (partial into #{} (filter user-tags)))


Make the blockly editor fit better

Make the blockly editor fit better

800 x 500 fits good now!

--- idecode/myappshare/mainapp.cljs
+++ idecode/myappshare/mainapp.cljs
@@ -487,8 +487,8 @@
          (div {:id "blocklyDiv" :style {:verticalAlign "text-top"
                                         :background     "white"
                                         :color          "white"
-                                        :height         "800px"
-                                        :width          "500px"
+                                        :height         "600px"
+                                        :width          "800px"
                                         :display        "inline-block"}} "")

          (div nil


make it work minus any sort of upload/send

--- src/cap_and_send/core.clj
+++ src/cap_and_send/core.clj
@@ -4,7 +4,15 @@
              :as a
              :refer [>! <! >!! <!! go go-loop chan buffer close! thread
                      alts! alts!! timeout]]
-            [me.raynes.fs :as fs]))
+            [me.raynes.fs :as fs]
+            [clojure.string :as str]))
+
+(defn- move-file [src-file dest-dir] ""
+  (println "copying " src-file " to " dest-dir)
+  (fs/copy+ src-file dest-dir))
+
+(defn- delete-file [file] ""
+  (fs/delete file))

 (defn- do-cap [cap-frame-cnt fps frame-dir] ""
   (println "doing capture with total frames: " cap-frame-cnt
@@ -27,24 +35,56 @@
       (catch Throwable t
         (println "error: " (.getMessage t))))))

-(defn- do-clip [fps frame-dir clip-path] ""
-  (let [out (:out (sh "ffmpeg"
-                      "-r"
-                      fps
-                      "-f"
-                      "image2"
-                      "-s"
-                      "1920x1080"
-                      "-i"
-                      (str frame-dir "/\\%06d")
-                      "-vcodec"
-                      "libx264"
-                      "-crf"
-                      "25"
-                      "-pix_fmt"
-                      "yuv420p"
-                      clip-path))]
-    out))
+(defn- get-clip-number [frame-file] ""
+  (let [name (.getName frame-file)
+        stuff (Integer/parseInt (first (str/split name #"\.")))
+
+        ]
+    stuff))
+
+(defn- do-clip [fps frame-dir clip-dir clip-path] ""
+
+
+
+  (let [
+        the-frames (fs/list-dir frame-dir)
+        the-frames-ordered (sort-by #(get-clip-number %) the-frames)
+        with-abs(map-indexed (fn [idx itm] (hash-map :idx idx
+                                                     :file itm
+                                                     :new-file (str clip-dir "/" (format "%06d" idx) ".jpeg"))) the-frames-ordered)
+        ]
+    (do
+      (println "the-frames: " (count the-frames))
+      (doseq [f with-abs]
+          (move-file (:file f) (:new-file f)))
+      (println "moved to clip dir")
+      (let [the-new-frames (fs/list-dir clip-dir)
+            in ["ffmpeg"
+                ;"-pattern_type glob"
+                "-r"
+                fps
+                "-f"
+                "image2"
+                "-s"
+                "1920x1080"
+                "-i"
+                (str clip-dir "/%6d.jpeg")
+                "-vcodec"
+                "libx264"
+                "-crf"
+                "25"
+                "-pix_fmt"
+                "yuv420p"
+                clip-path]
+            _ (println "in: " in)
+            out (apply sh in)]
+        (println "did clip: " out)
+        (doseq [f the-new-frames]
+            (delete-file f))
+        (doseq [f the-frames]
+            (delete-file f))
+        (println "the new frames: " (count the-new-frames))
+        out))))

 (defn- clear-dir [dir]
   (fs/delete-dir dir)
@@ -52,15 +92,16 @@

 (defn -main
   "I don't do a whole lot ... yet."
-  [cap-frame-cnt clip-interval fps frame-dir clip-dir intermediate-dir]
+  [cap-frame-cnt clip-interval fps frame-dir clip-dir intermediate-dir s3-upload-dir]
   (do (clear-dir frame-dir)
       (clear-dir clip-dir)
       (clear-dir intermediate-dir)
+      (clear-dir s3-upload-dir)

       (future (do-cap cap-frame-cnt fps frame-dir))
-      (dotimes [i 10]
+      (dotimes [i 100]
         (do
           (Thread/sleep (read-string clip-interval))
-          (println "make clip")
+          (do-clip fps frame-dir clip-dir (str s3-upload-dir "/" i ".mp4"))
           ))
       ))


Extract the download wells into a function

--- src/catalog/web/views.clj
+++ src/catalog/web/views.clj
@@ -26,6 +26,13 @@
   [:a.btn.btn-default {:href href :role "button" :aria-label label}
    [:span.glyphicon {:class (str "glyphicon-" icon) :aria-hidden "true"}] (str " " label)])

+
+(defn- download-well
+  [title url]
+  [:div.well
+   [:h2 title]
+   (icon-button url "download" "Download")])
+
 (defn home
   ([request]
    (home request 2016 3)) ;; FIXME: hard coded for now
@@ -36,18 +43,15 @@
       year issue
       [:div.row
        [:div.col-md-6
-        [:div.well
-         [:h2 (translations :catalog-all)]
-         (icon-button (format "/%s/%s/neu-im-sortiment.pdf" year issue) "download" "Download")]]
-       [:div.col-md-6
-        [:div.well
-         [:h2 (translations :catalog-grossdruck)]
-         (icon-button (format "/%s/%s/neu-in-grossdruck.pdf" year issue) "download" "Download")]]]
+        (download-well (translations :catalog-all)
+                       (format "/%s/%s/neu-im-sortiment.pdf" year issue))]
+       [:div.col-md-6
+        (download-well (translations :catalog-grossdruck)
+                       (format "/%s/%s/neu-in-grossdruck.pdf" year issue))]]
       [:div.row
        [:div.col-md-6
-        [:div.well
-         [:h2 (translations :catalog-braille)]
-         (icon-button (format "/%s/%s/neu-in-braille.xml" year issue) "download" "Download")]]
+        (download-well (translations :catalog-braille)
+                       (format "/%s/%s/neu-in-braille.xml" year issue))]
        [:div.col-md-6
         [:div.well
          [:h2 (translations :catalog-hörbuch)]


fix set null color

fix set null color

--- src/chessground/data.cljs
+++ src/chessground/data.cljs
@@ -78,12 +78,10 @@
       (assoc-in [:movable :free?] false)))

 (defn set-turn-color [state color]
-  (cond-> state
-    (common/seq-contains? chess/colors color) (assoc :turn-color color)))
+  (assoc state :turn-color color))

 (defn set-movable-color [state color]
-  (cond-> state
-    (common/seq-contains? (conj chess/colors "both") color) (assoc-in [:movable :color] color)))
+  (assoc-in state [:movable :color] color))

 (defn set-premovable-enabled? [state enabled?]
   (assoc-in state [:premovable :enabled?] (boolean enabled?)))


Even lower time SM settings; they go pretty low in logs

--- src/chicken_coop/core.clj
+++ src/chicken_coop/core.clj
@@ -59,8 +59,8 @@

 (defn time-sm [state day-fn! night-fn!]
-  (let [dusk 0.08
-        dawn 0.16]
+  (let [dusk 0.04
+        dawn 0.13]
     {:state state
      :trans
         {:day


* src/clj/cljs/compiler.clj: direct invoke all js/foo fns

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -612,6 +612,7 @@
   [{:keys [f args env]}]
   (let [fn? (and (not (-> f :info :dynamic))
                  (-> f :info :fn-var))
+        js? (= (-> f :info :ns) 'js)
         f (if fn?
             (let [info (-> f :info :info)
                   arity (count args)
@@ -626,9 +627,9 @@
                     f))))
             f)]
     (emit-wrap env
-               (print (str (emits f) (when-not fn? ".call") "("
+               (print (str (emits f) (when-not (or fn? js?) ".call") "("
                            (let [args (map emits args)
-                                 args (if-not fn?
+                                 args (if-not (or fn? js?)
                                         (cons "null" args)
                                         args)]
                              (comma-sep args))


require auth for config page

require auth for config page

--- src/clj/tictag/server.clj
+++ src/clj/tictag/server.clj
@@ -141,17 +141,23 @@
       {:status 200 :headers {} :body token}
       {:status 401 :headers {} :body nil})))

+(defn config [component req]
+  (if-let [user-id (:user-id req)]
+    {:headers {"Content-Type" "application/edn"}
+     :status 200
+     :body (pr-str {:tagtime-seed (-> component :tagtime :seed)
+                    :tagtime-gap  (-> component :tagtime :gap)})}
+    {:status 401
+     :body "unauthorized"}))
+
 (defn routes [component]
   (compojure.core/routes
    (POST "/slack" _ (partial slack component))
    (PUT "/time/:timestamp" _ (partial timestamp component))
    (POST "/token" _ (partial token component))
    (GET "/pings" _ (partial pings component))
+   (GET "/config" _ (partial config component))
    (GET "/" _ index)
-   (GET "/config" _ {:headers {"Content-Type" "application/edn"}
-                     :status 200
-                     :body (pr-str {:tagtime-seed (-> component :tagtime :seed)
-                                    :tagtime-gap  (-> component :tagtime :gap)})})
    (GET "/healthcheck" _ (health-check component))))

 (defn wrap-user [handler jwt]


Do the layer sweep more idiomatically

Do the layer sweep more idiomatically

--- src/cljs/fatlip/core.cljs
+++ src/cljs/fatlip/core.cljs
@@ -569,25 +569,25 @@
   "Performs one layer-by-layer sweep of the graph using ESK's algorithm"
   [sparse-graph]
   (loop [graph sparse-graph
-         layer-idx 0
-         next-layer-idx (inc layer-idx)]
-    (if (>= next-layer-idx (-> graph :layers count))
+         layer (-> graph :layers first)
+         layers (-> graph :layers rest)]
+    (if (empty? layers)
       graph
-      (let [layer (->> (-> graph :layers (get layer-idx))
-                       (replace-ps graph)
-                       set-positions)
-            next-layer (->> (-> graph :layers (get next-layer-idx))
-                            (set-qs-non-qs graph)
-                            (set-measures graph layer)
-                            (order-next-layer layer)
-                            add-qs)
-            [marked-graph crossings] (count-crossings graph layer next-layer)
+      (let [l (->> layer
+                   (replace-ps graph)
+                   set-positions)
+            next-l (->> (first layers)
+                        (set-qs-non-qs graph)
+                        (set-measures graph l)
+                        (order-next-layer l)
+                        add-qs)
+            [marked-graph crossings] (count-crossings graph l next-l)
             g (-> marked-graph
                   (update-in [:crossings] + crossings)
-                  (update-in [:layers] assoc layer-idx layer)
-                  (update-in [:layers] assoc next-layer-idx next-layer)
-                  (map-aboves-belows next-layer))]
-        (recur g next-layer-idx (inc next-layer-idx))))))
+                  (update-in [:layers] assoc (:id l) l)
+                  (update-in [:layers] assoc (:id next-l) next-l)
+                  (map-aboves-belows next-l))]
+        (recur g next-l (rest layers))))))

 (defn seed-graph


Rename fd to handle in native.clj

Rename fd to handle in native.clj

--- src/clojure_pf/native.clj
+++ src/clojure_pf/native.clj
@@ -10,34 +10,34 @@
   "Returns a file descriptor pointing to a socket or BPF device
   that is configured with the given interface, read buffer size,
   data link type, header complete -flag and immediate read -flag."
-  (let [fd (jna/invoke Integer
-                       clojure_pf/pf_open
-                       interface
-                       read-buffer-size
-                       data-link-type
-                       header-complete
-                       immediate)]
-    (if-not (= fd -1)
-      fd)))
+  (let [handle (jna/invoke Integer
+                           clojure_pf/pf_open
+                           interface
+                           read-buffer-size
+                           data-link-type
+                           header-complete
+                           immediate)]
+    (if-not (= handle -1)
+      handle)))

-(defn set-filter [fd instructions]
+(defn set-filter [handle instructions]
   "Sets the filter program to be used by a socket/device."
   ; TODO
   nil)

-(defn read [fd size]
+(defn read [handle size]
   "Reads at most size bytes from a socket/device.
   Returns a data buffer on success."
   (let [data  (byte-array size)
         nr    (jna/invoke Integer
                           clojure_pf/pf_read
-                          fd
+                          handle
                           data
                          (count data))]
     (if-not (= nr -1)
       data)))

-(defn write [fd data]
+(defn write [handle data]
   "Writes data to a socket/device.
   Returns the number of bytes written on success."
   (let [nw (jna/invoke Integer
@@ -47,6 +47,8 @@
     (if-not (= nw -1)
       nw)))

-(defn close [fd]
+(defn close [handle]
   "Closes a socket/device associated with the given file descriptor."
-  (jna/invoke Void clojure_pf/pf_close fd))
+  (jna/invoke Void
+              clojure_pf/pf_close
+              handle))


Removed test_utils.clj

Removed test_utils.clj

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

--- src/conexp/test_utils.clj
+++ src/conexp/test_utils.clj
@@ -1,14 +0,0 @@
-;;;
-
-(defmacro tests-to-run
-  "Defines tests to run when the namespace in which this macro is
-  called is tested by test-ns."
-  [& namespaces]
-  `(defn test-ns-hook []
-     (dosync
-      (ref-set ~'*report-counters*
-	       (merge-with + ~@(map (fn [ns] `(test-ns '~ns)) namespaces))))))
-
-;;;
-
-nil


RDC - Clean up gameplay require.

RDC - Clean up gameplay require.

--- src/icfp2015/gameplay.clj
+++ src/icfp2015/gameplay.clj
@@ -1,5 +1,5 @@
 (ns icfp2015.gameplay
-  (:require [icfp2015.board :refer [board->str make-board spawn-unit transition-board valid-position?]]))
+  (:require [icfp2015.board :as board]))

 (def DEBUG false)

@@ -8,18 +8,18 @@
   (let [f (fn [[board commands]]
             (if DEBUG
               (do
-                (println (board->str board))
+                (println (board/board->str board))
                 (println)
                 (Thread/sleep 100)))
             (let [new-command (ai board)
-                  new-board (transition-board board new-command)]
+                  new-board (board/transition-board board new-command)]
               [new-board (conj commands new-command)]))
         has-current-unit (fn [[{:keys [current-unit]} _]] current-unit)
         while-unit-active (fn [coll]
                             (let [[left right] (split-with has-current-unit coll)]
                               (conj (vec left) (first right))))
-        board-with-spawn (spawn-unit initial-board unit)]
-    (if (valid-position? board-with-spawn)
+        board-with-spawn (board/spawn-unit initial-board unit)]
+    (if (board/valid-position? board-with-spawn)
       (-> (iterate f [board-with-spawn '()])
           (rest)
           (while-unit-active)
@@ -29,12 +29,12 @@
 (defn get-commands
   "Yields a seq of commands given a game and an AI"
   [ai {:keys [width height filled units]}]
-  (loop [board (make-board width height filled)
+  (loop [board (board/make-board width height filled)
          commands '() ; TODO: use vector
          remaining-units units]
     (if DEBUG
       (do
-        (println (board->str board))
+        (println (board/board->str board))
         (println)))
     (if (empty? remaining-units)
       commands


reporting waiting state only after the initial revision was pulled. makes more sense from a user perspective and also should prevent test race conditions

--- src/lambdacd_git/core.clj
+++ src/lambdacd_git/core.clj
@@ -42,7 +42,11 @@
      :old-revision   (:old-revision changes)
      :all-revisions  current-revisions}))

+(defn- report-waiting-status [ctx]
+  (async/>!! (:result-channel ctx) [:status :waiting]))
+
 (defn- wait-for-revision-changed [last-seen-revisions remote ref ctx ms-between-polls]
+  (report-waiting-status ctx)
   (println "Last seen revisions:" (or last-seen-revisions "None") ". Waiting for new commit...")
   (loop [last-seen-revisions last-seen-revisions]
     (support/if-not-killed ctx
@@ -79,16 +83,12 @@
     (regex? ref-spec) (git/match-ref-by-regex ref-spec)
     :else ref-spec))

-(defn- report-waiting-status [ctx]
-  (async/>!! (:result-channel ctx) [:status :waiting]))
-
 (defn wait-for-git
   "step that waits for the head of a ref to change"
   [ctx remote & {:keys [ref ms-between-polls]
                  :or   {ms-between-polls (* 10 1000)
                         ref              "refs/heads/master"}}]
   (support/capture-output ctx
-    (report-waiting-status ctx)
     (let [ref-pred          (to-ref-pred ref)
           initial-revisions (initial-revisions ctx remote ref-pred)
           wait-for-result   (wait-for-revision-changed initial-revisions remote ref-pred ctx ms-between-polls)]


Beautify macroexpand-do

Beautify macroexpand-do

--- src/shuriken/macro.clj
+++ src/shuriken/macro.clj
@@ -8,11 +8,11 @@
                      nil  'macroexpand
                      1    'macroexpand-1
                      :all 'clojure.walk/macroexpand-all)]
-     `(do (println "-- Macro expansion -- ")
+     `(do (println "-- Macro expansion --")
           (clojure.pprint/pprint (~macro-sym (quote ~expr)))
           (newline)

-          (println "-- Running macro --")
+          (println "--  Running macro  --")
           (let [result# ~expr]
             (clojure.pprint/pprint result#)
             (newline)


Add task for full comparison

Add task for full comparison

--- src/spellcast/core.clj
+++ src/spellcast/core.clj
@@ -386,24 +386,22 @@
         (mk-graph 1.0 1.1 1.2 ;; "standard" t-range, i-range, s-range
           (shuffle-with test-rng (take n (rand-walk))))))))

-(defn run-tests
+
+(defn run-test
   "evalulate selector inside greedy algorithm, compared to lower bound (bfs-depth).
   For most graphs, bfs-depth is too low, so programs can't be perfect (0 vector).
   But otherwise, it's a decent function with forgiving slope."
-  [selector]
-  (vec (for [graph test-graphs]
-         (double (/ (HCABS/run graph selector)
-                    (.depth graph))))))
+  [selector graph]
+    (double (/ (HCABS/run graph selector) (.depth graph))))
+
+(defn run-tests
+  [selector test-graphs]
+  (vec (for [graph test-graphs] (run-test selector graph))))

 (defn error-function
   "evalulate push program."
   [program]
-  (run-tests (push-based-selector program)))
-
-(comment (defn -main [& args]
-           (println
-             "test run:"
-             (HCABS/run (test-graphs 0) Selector/NUM_UNINFORMED))))
+  (run-tests (push-based-selector program) test-graphs))

 (def atoms '(
              exec_y
@@ -543,6 +541,7 @@
   [coll]
   (/ (apply + coll) (count coll)))

+
 (defn -main
   ([arg & [file]]
    (case arg
@@ -552,12 +551,40 @@
      (let [input (slurp file)
            code (read-string input)
            input-errors (error-function code)
-           paper-errors (run-tests Selector/NUM_UNINFORMED)]
+           paper-errors (run-tests Selector/NUM_UNINFORMED test-graphs)]
        (println "input errors: " input-errors)
        (println "sum " (apply + input-errors))
        (println "paper errors: " paper-errors)
        (println "sum " (apply + paper-errors))
-       )))
+       )
+     "full-test" ;; generate larger test set, write graphs
+     (let [input (slurp file)
+           code (read-string input)
+           selector (push-based-selector code)
+           tests (for [n (range 10 500 10)
+                       i (range 0 20)]
+                   [n (mk-graph 1.0 1.1 1.2 ;; "standard" t-range, i-range, s-range
+                                (shuffle-with test-rng (take n (rand-walk))))])
+           input-errors (for [[n t] tests]
+                          [n (run-test selector t)])
+           paper-errors (for [[n t] tests]
+                          [n (run-test Selector/NUM_UNINFORMED t)])
+           ]
+       (spit (str "test-results.svg")
+             (chart/emit-svg
+               (-> (chart/xy-plot :width 500 :height 500
+                                  :xmin 0 :xmax 500
+                                  :ymin 0 :ymax
+                                  (apply max (for [[n t] input-errors] t))
+                                  )
+                   (chart/add-points input-errors
+                                     :fill "rgba(255,0,0,1)"
+                                     :size 3)
+                   (chart/add-points paper-errors
+                                     :fill "rgba(0,0,255,1)"
+                                     :size 2))))
+       )
+     ))
   ([]
    (pushgp
      {:error-function error-function


insights: fix tests -> initialize [:timer-atom]

--- test-cljs/frontend/components/test_insights.cljs
+++ test-cljs/frontend/components/test_insights.cljs
@@ -4,6 +4,7 @@
             [frontend.utils :as utils :refer [sel1 sel]]
             [frontend.utils.docs :as doc-utils]
             [frontend.stefon :as stefon]
+            [frontend.timer :as timer]
             [goog.dom]
             [frontend.components.insights :as insights]
             [om.core :as om :include-macros true])
@@ -71,7 +72,8 @@

 (deftest can-render-project-block
   (let [test-node (goog.dom/htmlToDocumentFragment "

")]
-    (om/root insights/project-insights (first test-projects-data) {:target test-node})
+    (om/root insights/project-insights (first test-projects-data) {:target test-node
+                                                                   :shared {:timer-atom (timer/initialize)}})
     (testing "Simple render of feature container.")))


Try eth0

Try eth0

--- src/lazubot/worker.clj
+++ src/lazubot/worker.clj
@@ -6,7 +6,7 @@
 (def sb (sandbox [])) ;; sandbox without any testers, only using timeout capability

 (defn -main []
-  (let [addr "tcp://docker0:8080"
+  (let [addr "tcp://eth0:8080"
         [reply-in reply-out] (repeatedly 2 #(chan (sliding-buffer 64)))]
     (register-socket! {:in reply-in :out reply-out :socket-type :rep
                        :configurator (fn [socket] (.bind socket addr))})


Thread-safe print

Thread-safe print

--- src/chronograph/mdapi.clj
+++ src/chronograph/mdapi.clj
@@ -93,7 +93,7 @@

 (defn process-member [member-id]
   ; Do each member in background concurrently
-  (prn "Member id" member-id)
+  (locking *out* (prn "Member id" member-id))
   (let [works-url (str members-endpoint "/" member-id "/works" \? (client/generate-query-string {:sample sample-size :rows sample-size}))
         works-results (try-try-again {:sleep 5000 :tries :unlimited}
                #(client/get works-url {:as :json}))
@@ -115,7 +115,7 @@
                       all-domains))
                   dois)
         unique-domains (into #{} domains)]
-    (prn "Domains for member" member-id "original" (count domains) "unique:" unique-domains)
+    (locking *out* (prn "Domains for member" member-id "original" (count domains) "unique:" unique-domains "from" dois))
     (data/insert-member-domains member-id unique-domains)))

 (dotimes [w-id 50] ; 50 seems to be a good value


move quit-chan to file scope var (special var that all go-blocks need to see)

--- src/client/game/core.cljs
+++ src/client/game/core.cljs
@@ -86,9 +86,13 @@
                  :soft-drop false

                  :quit false
-                 :quit-chan (chan)

                  :history []}))
+
+; This channel is closed when we want to shutdown all go-blocks
+; in order to exit the game.
+; It must be initialized to a new channel on init.
+(def quit-chan nil)

 ; required for pausing/resuming the gravity routine
 (def stop-grav (chan))
@@ -161,7 +165,7 @@
   (let [redraw-chan (make-redraw-chan)]
     (go
       (loop [board nil theme nil]
-        (let [[_ c] (alts! [(:quit-chan @state) redraw-chan])]
+        (let [[_ c] (alts! [quit-chan redraw-chan])]
           (if (= c redraw-chan)
             (let [new-board (drawable-board)
                   new-theme (:theme @state)
@@ -187,7 +191,7 @@
           (socket/emit "update-player" {:theme (:theme @state) :board (drawable-board)}))

         ; quit or schedule another update
-        (let [quit (:quit-chan @state)
+        (let [quit quit-chan
               [_ ch] (alts! [quit (timeout 16)])]
           (when-not (= ch quit)
             (recur data)))))))
@@ -358,8 +362,7 @@
   (go-loop []
     (let [speed (grav-speed (:level @state) (:soft-drop @state))
           time- (timeout speed)
-          quit (:quit-chan @state)
-          [_ c] (alts! [time- stop-grav quit])]
+          [_ c] (alts! [time- stop-grav quit-chan])]
       (when (= c time-)
         (apply-gravity!)
         (recur)))))
@@ -526,23 +529,9 @@
     (.addEventListener js/window "keydown" key-down)
     (.addEventListener js/window "keyup" key-up)

-    ; Prevent the player from holding the down-key
-    ; for more than one piece-drop.
-    ;
-    ; The soft-drop state is set to:
-    ;   = the state of the down-key when it CHANGES
-    ;   = off, after a piece is locked
-    (let [uc (unique down-chan)]
-      (go-loop []
-        (let [[value c] (alts! [(:quit-chan @state) uc])]
-          (when (= c uc)
-            (swap! state assoc :soft-drop value)
-            (refresh-gravity!)
-            (recur)))))
-
     ; Remove key events when quitting
     (go
-      (<! (:quit-chan @state))
+      (<! quit-chan)
       (.removeEventListener js/window "keydown" key-down)
       (.removeEventListener js/window "keyup" key-up))))

@@ -556,8 +545,8 @@
   (let [new-state (read-string data-str)]

     ; Freeze the game.
-    (if (:quit-chan @state)
-      (close! (:quit-chan @state)))
+    (if quit-chan
+      (close! quit-chan))

     ; Merge state with new state data.
     (swap! state merge new-state)
@@ -574,6 +563,9 @@

 (defn init []

+  ; Create new quit channel that all go-blocks will monitor for closing.
+  (set! quit-chan (chan))
+
   (init-state!)
   (load-theme!)

@@ -596,7 +588,7 @@

 (defn cleanup []
   (swap! state assoc :quit true)
-  (if (:quit-chan @state)
-    (close! (:quit-chan @state)))
+  (if quit-chan
+    (close! quit-chan))

   (socket/removeListener "set-state"))


stop making left/right keys restart gravity

--- src/client/game/core.cljs
+++ src/client/game/core.cljs
@@ -529,12 +529,7 @@
                    (case (key-name e)
                      :down  (put! down-chan false)
                      ;:shift (toggle-record!)
-                     nil)
-                   (when (#{:left :right} (key-name e))
-                     ; force gravity to reset
-                     (put! pause-grav 0)
-                     (put! resume-grav 0))
-                   ))]
+                     nil)))]

     ; Add key events
     (.addEventListener js/window "keydown" key-down)


docstrings

docstrings

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -298,6 +298,8 @@
   (or (-> x meta :column) (:column env)))

 (defn intern-macros
+  "Given a Clojure namespace intern all macros into the ambient ClojureScript
+   analysis environment."
   ([ns] (intern-macros ns false))
   ([ns reload]
     (when (or (nil? (get-in @env/*compiler* [::namespaces ns :macros]))
@@ -338,7 +340,9 @@
                *cljs-macros-is-classpath* false]
        ~@body)))

-(defn empty-env []
+(defn empty-env
+  "Construct an empty analysis environment. Required to analyze forms."
+  []
   (env/ensure
     {:ns (get-namespace *cljs-ns*)
      :context :statement
@@ -427,7 +431,10 @@
   (let [sym (symbol name)]
     (get (:require-macros (:ns env)) sym sym)))

-(defn confirm-ns [env ns-sym]
+(defn confirm-ns
+  "Given env, an analysis environment, and ns-sym, a symbol identifying a
+   namespace, confirm that the namespace exists. Warn if not found."
+  [env ns-sym]
   (when (and (nil? (get '#{cljs.core goog Math goog.string} ns-sym))
              (nil? (get (-> env :ns :requires) ns-sym))
              ;; something else may have loaded the namespace, i.e. load-file
@@ -512,19 +519,27 @@
                {:name (symbol (str full-ns) (str sym))
                 :ns full-ns})))))))

-(defn resolve-existing-var [env sym]
+(defn resolve-existing-var
+  "Given env, an analysis environment, and sym, a symbol, resolve an existing var.
+   Emits a warning if no such var exists."
+  [env sym]
   (if-not (-> sym meta ::no-resolve)
     (resolve-var env sym confirm-var-exists)
     (resolve-var env sym)))

-(defn confirm-bindings [env names]
+(defn confirm-bindings
+  "Given env, an analysis environment env, and names, a list of symbols, confirm
+   that all correspond to declared dynamic vars."
+  [env names]
   (doseq [name names]
     (let [env (assoc env :ns (get-namespace *cljs-ns*))
           ev (resolve-existing-var env name)]
       (when (and ev (not (-> ev :dynamic)))
         (warning :dynamic env {:ev ev :name (:name ev)})))))

-(defn resolve-macro-var [env sym]
+(defn resolve-macro-var
+  "Given env, an analysis environment, and sym, a symbol, resolve a macro."
+  [env sym]
   (let [ns (-> env :ns :name)
         namespaces (get @env/*compiler* ::namespaces)]
     (cond
@@ -619,7 +634,10 @@
           ('#{cljs.core/PersistentHashMap
               cljs.core/List} t)))))

-(defn infer-tag [env e]
+(defn infer-tag
+  "Given env, an analysis environment, and e, an AST node, return the inferred
+   type of the node"
+  [env e]
   (if-let [tag (get-tag e)]
     tag
     (case (:op e)
@@ -1249,6 +1267,9 @@
       false)))

 (defn analyze-deps
+  "Given a lib, a namespace, deps, its dependencies, env, an analysis environment
+   and opts, compiler options - analyze all of the dependencies. Required to
+   correctly analyze usage of other namespaces."
   ([lib deps env] (analyze-deps lib deps env nil))
   ([lib deps env opts]
    (let [compiler @env/*compiler*]
@@ -1793,7 +1814,10 @@
               (resolve-var env sym)))
           (assoc ret :op :var :info (resolve-var env sym)))))))

-(defn get-expander [sym env]
+(defn get-expander
+  "Given a sym, a symbol identifying a macro, and env, an analysis environment
+   return the corresponding Clojure macroexpander."
+  [sym env]
   (let [mvar
         (when-not (or (-> env :locals sym)        ;locals hide macros
                       (and (or (-> env :ns :excludes sym)
@@ -1814,7 +1838,10 @@
     (when (and mvar (.isMacro ^clojure.lang.Var mvar))
       (with-meta @mvar (meta mvar)))))

-(defn macroexpand-1 [env form]
+(defn macroexpand-1
+  "Given a env, an analysis environment, and form, a ClojureScript form,
+   macroexpand the form once."
+  [env form]
   (env/ensure
     (wrapping-errors env
       (let [op (first form)]
@@ -2121,6 +2148,9 @@
        (io/file (str target-file ".cache.edn"))))))

 (defn requires-analysis?
+  "Given a src, a resource, and output-dir, a compilation output directory
+   return true or false depending on whether src needs to be (re-)analyzed.
+   Can optionally pass cache, the analysis cache file."
   ([src] (requires-analysis? src "out"))
   ([src output-dir]
     (let [cache (cache-file src output-dir)]


don't call resolve-existing-var on an ::analyzed var, we've already analyzed and emitted a warning about it on the first pass

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -1384,7 +1384,10 @@
       (if lb
         (assoc ret :op :var :info lb)
         (if-not (:def-var env)
-          (assoc ret :op :var :info (resolve-existing-var env sym))
+          (assoc ret :op :var :info
+            (if-not (contains? (meta sym) ::analyzed)
+              (resolve-existing-var env sym)
+              (resolve-var env sym)))
           (assoc ret :op :var :info (resolve-var env sym)))))))

 (defn get-expander [sym env]


CLJS-1080: Analysis cache should keep constants in visit order

Maintain constant visit order by tracking both seen and order

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -217,7 +217,12 @@
                  table
                  (assoc table val (gen-constant-id val))))))
          env (update-in [::namespaces (-> env :ns :name) ::constants]
-               (fnil conj #{}) val))))))
+               (fn [{:keys [seen order] :or {seen #{} order []} :as constants}]
+                 (cond-> constants
+                   (not (contains? seen val))
+                   (assoc
+                     :seen (conj seen val)
+                     :order (conj order val))))))))))

 (def default-namespaces '{cljs.core {:name cljs.core}
                           cljs.user {:name cljs.user}})
@@ -2005,7 +2010,7 @@
                  (swap! env/*compiler*
                    (fn [cenv]
                      (let [cached-ns (edn/read-string (slurp cache))]
-                       (doseq [x (::constants cached-ns)]
+                       (doseq [x (get-in cached-ns [::constants :order])]
                          (register-constant! x))
                        (-> cenv
                          (assoc-in [::analyzed-cljs path] true)


CLJS-687: error/warning when deftype/record constructor used as a function

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -43,7 +43,8 @@
    :multiple-variadic-overloads true
    :variadic-max-arity true
    :overload-arity true
-   :extending-base-js-type true})
+   :extending-base-js-type true
+   :invoke-ctor true})

 (declare message namespaces)

@@ -113,6 +114,10 @@
   [warning-type info]
   (str "Extending an existing JavaScript type - use a different symbol name "
        "instead of " (:current-symbol info) " e.g " (:suggested-symbol info)))
+
+(defmethod error-message :invoke-ctor
+  [warning-type info]
+  (str "Cannot invoke type constructor " (-> info :fexpr :info :name) " as function "))

 (defn ^:private default-warning-handler [warning-type env extra]
   (when (warning-type *cljs-warnings*)
@@ -1086,16 +1091,19 @@
          fexpr (analyze enve f)
          argexprs (vec (map #(analyze enve %) args))
          argc (count args)]
-     (if (and (:fn-arity *cljs-warnings*) (-> fexpr :info :fn-var))
+     (when (and (:fn-arity *cljs-warnings*) (-> fexpr :info :fn-var))
        (let [{:keys [variadic max-fixed-arity method-params name]} (:info fexpr)]
          (when (and (not (some #{argc} (map count method-params)))
                     (or (not variadic)
                         (and variadic (< argc max-fixed-arity))))
            (warning :fn-arity env {:name name
                                    :argc argc}))))
-     (if (and (:fn-deprecated *cljs-warnings*) (-> fexpr :info :deprecated)
-              (not (-> form meta :deprecation-nowarn)))
+     (when (and (:fn-deprecated *cljs-warnings*) (-> fexpr :info :deprecated)
+                (not (-> form meta :deprecation-nowarn)))
        (warning :fn-deprecated env {:fexpr fexpr}))
+     (when (and (:invoke-ctor *cljs-warnings*)
+                (-> fexpr :info :type))
+       (warning :invoke-ctor env {:fexpr fexpr}))
      {:env env :op :invoke :form form :f fexpr :args argexprs
       :tag (or (-> fexpr :info :tag) (-> form meta :tag)) :children (into [fexpr] argexprs)})))


* src/clj/cljs/compiler.clj: make namespaces flatter

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -645,13 +645,13 @@
                  (-> f :info :fn-var))
         js? (= (-> f :info :ns) 'js)
         f (if fn?
-            (let [info (-> f :info :info)
+            (let [info (-> f :info)
                   arity (count args)
-                  methods (:methods info)]
+                  mps (:method-params info)]
               (if (or (> arity (:max-fixed-arity info))
-                      (= (count methods) 1))
+                      (= (count mps) 1))
                 f
-                (let [arities (map #(-> % :params count) methods)]
+                (let [arities (map count mps)]
                   (if (some #{arity} arities)
                     (update-in f [:info :name]
                                (fn [name] (symbol (str name ".cljs$lang$arity$" arity))))
@@ -860,10 +860,10 @@
                      {:file *cljs-file* :line line})
                    (when fn-var?
                      {:fn-var true
-                      :info {:max-fixed-arity (:max-fixed-arity init-expr)
-                             :methods (map (fn [m]
-                                             {:params (:params m)})
-                                           (:methods init-expr))}})))))
+                      :max-fixed-arity (:max-fixed-arity init-expr)
+                      :method-params (map (fn [m]
+                                            (:params m))
+                                          (:methods init-expr))})))))
       (merge {:env env :op :def :form form
               :name name :doc doc :init init-expr}
              (when tag {:tag tag})


* src/clj/cljs/compiler.clj: CLJS-119: uniqify function parameters to avoid google closure errors from (fn [_ _] ...) idioms

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -679,20 +679,24 @@
              (when export-as {:export export-as})))))

 (defn- analyze-fn-method [env locals meth]
-  (let [params (first meth)
-        fields (-> params meta ::fields)
-        variadic (boolean (some '#{&} params))
-        params (remove '#{&} params)
-        fixed-arity (count (if variadic (butlast params) params))
-        body (next meth)
-        gthis (and fields (gensym "this__"))
-        locals (reduce (fn [m fld] (assoc m fld {:name (symbol (str gthis "." (munge fld)))})) locals fields)
-        locals (reduce (fn [m name] (assoc m name {:name (munge name)})) locals params)
-        recur-frame {:names (vec (map munge params)) :flag (atom nil)}
-        block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
-                (analyze-block (assoc env :context :return :locals locals) body))]
-
-    (merge {:env env :variadic variadic :params (map munge params) :max-fixed-arity fixed-arity :gthis gthis :recurs @(:flag recur-frame)} block)))
+  (letfn [(uniqify [[p & r]]
+            (when p
+              (cons (if (some #{p} r) (gensym (str p)) p)
+                    (uniqify r))))]
+   (let [params (first meth)
+         fields (-> params meta ::fields)
+         variadic (boolean (some '#{&} params))
+         params (uniqify (remove '#{&} params))
+         fixed-arity (count (if variadic (butlast params) params))
+         body (next meth)
+         gthis (and fields (gensym "this__"))
+         locals (reduce (fn [m fld] (assoc m fld {:name (symbol (str gthis "." (munge fld)))})) locals fields)
+         locals (reduce (fn [m name] (assoc m name {:name (munge name)})) locals params)
+         recur-frame {:names (vec (map munge params)) :flag (atom nil)}
+         block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
+                 (analyze-block (assoc env :context :return :locals locals) body))]
+
+     (merge {:env env :variadic variadic :params (map munge params) :max-fixed-arity fixed-arity :gthis gthis :recurs @(:flag recur-frame)} block))))

 (defmethod parse 'fn*
   [op env [_ & args] name]


return error response headers #157

return error response headers
#157

--- src/clj/swarmpit/http.clj
+++ src/clj/swarmpit/http.clj
@@ -56,7 +56,9 @@
         (throw
           (let [data (some-> exception (ex-data))
                 status (:status data)
+                headers (:headers data)
                 error (error-response data error-handler)]
             (ex-info (str scope " error: " error)
-                     {:status status
-                      :body   {:error error}})))))))+                     {:status  status
+                      :headers headers
+                      :body    {:error error}})))))))


Removing old comments

Removing old comments

--- src/clj/zetawar/game.cljs
+++ src/clj/zetawar/game.cljs
@@ -386,12 +386,6 @@
     (catch :default ex
       false)))

-;; Get moves
-;; - get adjacent coordinates
-;; - get move costs
-;; - add legal moves to frontier
-;; - repeat with updated movement points + frontier
-
 (defn teleport-tx [db game from-q from-r to-q to-r]
   (let [unit (checked-unit-at db game from-q from-r)]
     [{:db/id (e unit)


add missing transaction-date param

add missing transaction-date param

--- src/clj_money/reports.clj
+++ src/clj_money/reports.clj
@@ -422,7 +422,10 @@
   [storage-spec lot]
   (assoc lot
          :transactions
-         (->> {:lot-id (:id lot)}
+         (->> {:lot-id (:id lot)
+               :transaction-date [:between
+                                  (:purchase-date lot)
+                                  (t/today)]}
               (transactions/search storage-spec)
               (mapcat transform-lot-transactions))))


asset-manager won't be dynamic

asset-manager won't be dynamic

--- src/maqueta/assets.clj
+++ src/maqueta/assets.clj
@@ -7,16 +7,16 @@
                    .getContextClassLoader
                    (.getResource "com/jme3/asset/Desktop.cfg")))

-(def ^:dynamic *asset-manager* (JmeSystem/newAssetManager desktop-cfg))
+(def asset-manager (JmeSystem/newAssetManager desktop-cfg))

 (defn load-model [model-name]
-  (.loadModel *asset-manager* model-name))
+  (.loadModel asset-manager model-name))

 (defn load-texture [texture-name]
-  (.loadTexture *asset-manager* texture-name))
+  (.loadTexture asset-manager texture-name))

 (defn load-font [font-name]
-  (.loadFont *asset-manager* font-name))
+  (.loadFont asset-manager font-name))

 (defn load-material [material-name]
-  (Material. *asset-manager* material-name))
+  (Material. asset-manager material-name))


Refactoring of route names

Refactoring of route names

--- src/cylon/impl/oauth2.clj
+++ src/cylon/impl/oauth2.clj
@@ -33,7 +33,7 @@

   WebService
   (request-handlers [this]
-    {::authorize-form
+    {::get-authenticate-form
      (->
       (fn [req]
         {:status 200
@@ -43,7 +43,7 @@
                  [:p "The application with client id " (-> req :query-params (get "client_id"))
                   " is requesting access to the Azondi API on your behalf. Please login if you are happy to authorize this application."]
                  [:form {:method :post
-                         :action (path-for (:modular.bidi/routes req) ::authorize)}
+                         :action (path-for (:modular.bidi/routes req) ::post-authenticate-form)}
                   [:p
                    [:label {:for "user"} "User"]
                    [:input {:name "user" :id "user" :type "text" :value "juan"}]]
@@ -66,7 +66,7 @@
                   [:p [:a {:href (path-for (:modular.bidi/routes req) :cylon.impl.signup/signup-form)} "Signup"]]]])})
       wrap-params)

-     ::authorize
+     ::post-authenticate-form
      (-> (fn [req]
            (let [params (-> req :form-params)
                  identity (get params "user")
@@ -106,7 +106,7 @@
                                      :state state)

                      {:status 302
-                      :headers {"Location" (path-for (:modular.bidi/routes req) ::second-authenticator-form)}
+                      :headers {"Location" (path-for (:modular.bidi/routes req) ::get-totp-code)}
                       :cookies {"session-id" (->cookie session)}})

                    ;; So it's not 2FA, continue with OAuth exchange
@@ -136,7 +136,7 @@
            )
          wrap-params wrap-cookies)

-     ::second-authenticator-form
+     ::get-totp-code
      (fn [req]
        {:status 200
         :body (html
@@ -148,10 +148,10 @@

                [:form {:method :post
                        :action (path-for (:modular.bidi/routes req)
-                                         ::process-authenticator-code)}
+                                         ::post-totp-code)}
                 [:input {:type "text" :id "code" :name "code"}]])})

-     ::process-authenticator-code
+     ::post-totp-code
      (-> (fn [req]
            (let [code (-> req :form-params (get "code"))
                  secret (get-session-value req "session-id" (:session-store this) :totp-secret)]
@@ -180,7 +180,7 @@
                ;; Failed, have another go!
                {:status 302
                 :headers {"Location"
-                          (path-for (:modular.bidi/routes req) ::second-authenticator-form)}
+                          (path-for (:modular.bidi/routes req) ::get-totp-code)}
                 }

                )))
@@ -224,10 +224,10 @@
          wrap-params)})

   (routes [this]
-    ["/" {"authorize" {:get ::authorize-form
-                       :post ::authorize}
-          "second-authenticator" {:get ::second-authenticator-form
-                                  :post ::process-authenticator-code}
+    ["/" {"authorize" {:get ::get-authenticate-form
+                       :post ::post-authenticate-form}
+          "totp" {:get ::get-totp-code
+                  :post ::post-totp-code}
           "access_token" {:post ::exchange-code-for-access-token}}])

   (uri-context [this] "/login/oauth"))


Refactor.

Refactor.

--- src/datascript/query.cljs
+++ src/datascript/query.cljs
@@ -163,12 +163,6 @@

 ;;

-(defn prop->index [prop]
-  (get {"e" 0 "a" 1 "v" 2} prop))
-
-(defn get-from-tuple [tuple prop]
-  (get tuple (prop->index prop)))
-
 (defn tuple-key-fn [idxs]
   (if (== (count idxs) 1)
     (let [idx (first idxs)]
@@ -218,10 +212,10 @@
 (defn lookup-pattern-db [db pattern callback]
   ;; TODO optimize with bound attrs min/max values here
   (let [search-pattern (mapv #(if (symbol? %) nil %) pattern)
-        attr->prop     (->> (map vector pattern ["e" "a" "v"])
-                            (filter (fn [[s _]] (free-var? s)))
-                            (into {}))]
-    (dc/-search db search-pattern (fn [datoms] (callback (Relation. attr->prop datoms))))))
+        attr->idx  (->> (map vector pattern (range))
+                        (filter (fn [[s _]] (free-var? s)))
+                        (into {}))]
+    (dc/-search db search-pattern (fn [datoms] (callback (Relation. attr->idx datoms))))))

 (defn matches-pattern? [pattern tuple]
   (loop [tuple   tuple
@@ -461,7 +455,7 @@
                          t2 (:tuples rel)]
                      (let [res (aclone t1)]
                        (dotimes [i len]
-                         (when-let [idx (prop->index (aget copy-map i))]
+                         (when-let [idx (aget copy-map i)]
                            (aset res i (nth t2 idx))))
                        res))
                    (next rels)


increased limit for most-comments to 100

--- src/ontrail/unread.clj
+++ src/ontrail/unread.clj
@@ -33,7 +33,7 @@

 (defn most-comments-oids []
   (let [four-weeks-ago (time/minus (time/now) (time/days 30))]
-    (mc/aggregate "exercise" [{"$match" {:lastModifiedDate {"$gte" four-weeks-ago}}} {"$unwind" "$comments"} {"$group" {"_id" "$_id" "size" {"$sum" 1}}} {"$sort" {"size" -1}} {"$limit" 50}])))
+    (mc/aggregate "exercise" [{"$match" {:lastModifiedDate {"$gte" four-weeks-ago}}} {"$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))))


fix admins

fix admins

--- src/pc/models/cust.clj
+++ src/pc/models/cust.clj
@@ -21,7 +21,7 @@
                                      ;; probably a uuid type
                                      :cust/http-sesion-key String}))

-(defn admin-emails [] (set (map :email (pc.profile/admins))))
+(defn admin-emails [] (set (map :admin/email (pc.profile/admins))))

 (defn all [db]
   (map #(d/entity db (:e %))


update

update

--- template.clj
+++ template.clj
@@ -1,4 +1,19 @@
-(defn hello-world [username]
-  (println (format "Hello, %s" username)))
+;java -jar clojure-1.8.0.jar template.clj
+(def infile "A-small.in")
+(def outfile "A-small.out")

-(hello-world "world")+(java.util.Locale/setDefault (java.util.Locale/US))
+
+(defn solve [a]
+  (let [cmd (first a)
+        s (sort (map #(Double/parseDouble %) (next (next a))))
+        len (count s)]
+    (if (= "median" cmd)
+      (nth s (quot len 2))
+      (/ (reduce + s) len))))
+
+(with-open [reader (clojure.java.io/reader infile)
+            writer (clojure.java.io/writer outfile)]
+  (binding [*in* reader]
+    (doseq [test-case (range 1 (inc (Integer/parseInt (read-line))))]
+      (.write writer (format "Case #%d: %.10f\n" test-case (solve (clojure.string/split (read-line) #" ")))))))


core: macroexpand

core: macroexpand

--- data/core.clj
+++ data/core.clj
@@ -1848,3 +1848,14 @@
   {:added "1.0"}
   [form]
   (macroexpand-1* form))
+
+(defn macroexpand
+  "Repeatedly calls macroexpand-1 on form until it no longer
+  represents a macro form, then returns it.  Note neither
+  macroexpand-1 nor macroexpand expand macros in subforms."
+  {:added "1.0"}
+  [form]
+  (let [ex (macroexpand-1 form)]
+    (if (identical? ex form)
+      form
+      (macroexpand ex))))


We should use the username/password options for this connection as well.

--- modules/messaging/src/main/clojure/immutant/messaging.clj
+++ modules/messaging/src/main/clojure/immutant/messaging.clj
@@ -89,7 +89,9 @@
     :username      the username to use to auth the connection (requires :password to be set) [nil]
     :password      the password to use to auth the connection (requires :username to be set) [nil]"
   [dest-name f & {:keys [concurrency selector] :or {concurrency 1} :as opts}]
-  (let [connection (.createXAConnection (connection-factory opts))]
+  (let [connection (.createXAConnection (connection-factory opts)
+                                        (:username opts)
+                                        (:password opts))]
     (try
       (dotimes [_ concurrency]
         (let [session (create-session connection)


Removed debug print

Removed debug print

--- src/sdos_site/user.clj
+++ src/sdos_site/user.clj
@@ -38,7 +38,6 @@
 (defn do-login
   [req]
   (do
-    (println req)
     (let [username (-> req :params :username)
           password (-> req :params :password)]
       (if-let [user (db/check-login (:db req) username password)]


updated version

updated version

--- src/speclj/version.clj
+++ src/speclj/version.clj
@@ -4,7 +4,7 @@

 (def major 1)
 (def minor 5)
-(def tiny 2)
+(def tiny 2git)
 (def snapshot false)
 (def string
   (str


Put wait for init user touch code in main loop

--- src/musicbox/one.cljs
+++ src/musicbox/one.cljs
@@ -117,17 +117,9 @@
           (util/listen (dom/getElement canvas-id) :touchend)]))

 (let [canvas-id "canvas"
-      c-app-state (chan)
       c-instrument (chan)
       c-orientation-change (util/listen js/window :orientation-change)
       c-input (create-input-channel canvas-id)]
-
-  (go
-   ;; start after input so don't break sound
-   (let [c-start (create-input-channel canvas-id)]
-     (<! c-start)
-     (close! c-start)
-     (>! c-app-state "start")))

   (go
    (let [draw-ctx (util/get-ctx canvas-id)]
@@ -140,14 +132,18 @@
                (recur instrument)))))))

   (go
-   (loop [instrument (update-size (create-instrument (scales/c-minor)) canvas-id)]
-     (>! c-instrument instrument)
-     (let [[data c] (alts! [c-input c-orientation-change c-app-state])]
-       (condp = c
-         c-app-state (recur (add-synths-to-instrument instrument))
-         c-orientation-change (recur (update-size instrument canvas-id))
-         (recur (reduce fire-event-on-instrument
-                        instrument
-                        (touch-data->touches data)))))))
+   (let [display-instrument (update-size (create-instrument (scales/c-minor)) canvas-id)]
+     (>! c-instrument display-instrument)

-  )+     (<! (create-input-channel canvas-id)) ;; wait for first touch before creating synths
+     (let [play-instrument (add-synths-to-instrument display-instrument)]
+
+       (loop [instrument play-instrument]
+         (let [[data c] (alts! [c-input c-orientation-change])]
+           (condp = c
+             c-orientation-change (recur (update-size instrument canvas-id))
+             c-input (recur (reduce fire-event-on-instrument
+                                    instrument
+                                    (touch-data->touches data)))))))))
+
+  )


Revert not using host in redirects.

Revert not using host in redirects.

--- src/ontrail/pages.clj
+++ src/ontrail/pages.clj
@@ -321,12 +321,10 @@
          (form-group "password" "Salasana" {:type "password"})
          [:button.btn.btn-default {:type "submit"} "Kirjaudu"]]]]]]])

-(def host "http://ontrail.net")
-
 (defmacro require-auth [cookies form]
   `(if (and (auth/valid-auth-token? (:value (~cookies "authToken"))) (not= "nobody" (auth/user-from-cookie ~cookies)))
      ~form
-     (redirect (str host "/sp/login.html"))))
+     (redirect "/sp/login.html")))

 (defroutes templates

@@ -377,8 +375,8 @@
                            with-body (assoc params :body (md/md-to-html-string (params :mdbody)))]
                        (do
                          (mutate/comment-ex user with-body)
-                         (redirect (str host (url "/ex/" (:id params))))))
-                     (redirect (str host "/sp/login.html")))))
+                         (redirect (url "/ex/" (:id params)))))
+                     (redirect "/sp/login.html"))))

            (GET "/sp/addex" {params :params cookies :cookies} ;;addex
                 (require-auth cookies
@@ -390,11 +388,11 @@
                  (if (auth/valid-auth-token? (:value (cookies "authToken")))
                    (let [params-with-dur (assoc params :duration (to-dur-str params) :body (params :mdbody))
                          posted (mutate/create-ex (auth/user-from-cookie cookies) params-with-dur)]
-                     (redirect (str host (url "/ex/" (:id posted)))))
-                   (redirect (str host "/sp/login.html"))))
+                     (redirect (url "/ex/" (:id posted))))
+                   (redirect "/sp/login.html")))

            (GET "/sp" {cookies :cookies}
                 (if (not= "nobody" (auth/user-from-cookie cookies))
-                  (redirect (str host "/sp/latest/1"))
-                  (redirect (str host "/sp/login.html")))))
+                  (redirect "/sp/latest/1")
+                  (redirect "/sp/login.html"))))


newline at the end of the line

newline at the end of the line

--- src/ontrail/stats.clj
+++ src/ontrail/stats.clj
@@ -58,4 +58,4 @@
         stats (get-stats monger-filter sport)]
       (.info logger (str monger-filter " " " for sport " sport " for user " user))
       {:action "other" :target sport :stats stats})
-    {:action "other" :target sport}))+    {:action "other" :target sport}))


helper fn for cleaning out stale subs

helper fn for cleaning out stale subs

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -1020,6 +1020,19 @@
   [client-id]
   ((:send-fn @sente-state) client-id [:frontend/stats]))

+(defn cleanup-stale [doc-id]
+  (let [subs @document-subs
+        now (pc.utils/inspect (time/now))
+        doc-uids (keys (get subs doc-id))]
+    (doseq [uid doc-uids]
+      (fetch-stats uid))
+    (Thread/sleep 3000)
+    (doseq [[uid stats] (remove (fn [[_ s]]
+                                  (and (:last-update s)
+                                       (time/after? (:last-update s) now)))
+                                (select-keys @client-stats doc-uids))]
+      (close-ws uid))))
+
 (defn init []
   (let [{:keys [ch-recv send-fn ajax-post-fn connected-uids
                 ajax-get-or-ws-handshake-fn] :as fns} (sente/make-channel-socket!


Changed demo to be compatible with Date and Dropdown. Still a WIP.

--- src/re_demo/time.cljs
+++ src/re_demo/time.cljs
@@ -1,9 +1,10 @@
 (ns re-demo.time
   (:require [re-demo.util    :refer  [title]]
-            [re-com.core     :refer [label]]
+            [re-com.core     :refer  [label]]
             [re-com.util     :refer  [pad-zero-number]]
             [re-com.time     :refer  [time-input]]
             [re-com.box      :refer  [h-box v-box box gap line]]
+            [re-com.dropdown :refer  [single-dropdown]]
             [reagent.core    :as     reagent]))

 (defn display-time
@@ -15,50 +16,159 @@
          ":"
          (pad-zero-number min 2))))

-(defn time-examples []
-  (let [model1 (reagent/atom 900)
-        model2 (reagent/atom 2030)]
-    [v-box
-     :gap "0px"
-     :children [[title "Time"]
-                [:p "Accepts input of a time. Model does not update until input loses focus. If the entered value is invalid it will be ignored."]
-                [:p "Required parameters are -"]
+(def demos [{:id "1" :label "Time input, empty model"}
+            {:id "2" :label "Time input, no border"}
+            {:id "3" :label "Disabled time input"}
+            {:id "4" :label "Time with icon"}
+            {:id "5" :label "Time with range 06:00-21:59"}])
+
+(defn notes
+  []
+  [v-box
+   :width    "500px"
+   :children [[:div.h4 "General notes:"]
+              [:div {:style {:font-size "small"}}
+               [:p "Accepts input of a time. The callback is triggered when the input loses focus. If the entered value is invalid it will be ignored."]
+               [:p "If invalid data is provided, an exception will be thrown."]
+               [:div.h4 "Parameters"]
+               [:label {:style {:font-variant "small-caps"}} "required"]
                 [:ul
-                  [:li "model - an integer time e.g. 930"]]
-                [:p "Optional parameters are -"]
+                 [:li.spacer [:strong ":model"] " - an integer time e.g. 930"]]
+               [:label {:style {:font-variant "small-caps"}} "optional"]
                 [:ul
-                  [:li "minimum - min time as an integer e.g.  930 - will not allow input less than this time - default 0."]
-                  [:li "maximum - max time as an integer e.g. 1400 - will not allow input more than this time - default 2359."]
-                  [:li "on-change - function to call upon change."]
-                  [:li "disabled - true if the component should be disabled - default false"]
-                  [:li "show-time-icon - true if the clock icon should be displayed - default false"]
-                  [:li "style - css style"]]
-                [label :label "Examples" :style {:font-weight "bold"}]
-                [label :label "Basic time input, empty model"]
-                [time-input
-                  :model (reagent/atom nil)
-                  :style {}]
-                [label :label "Basic time input, with model, no border"]
-                [time-input
-                  :model (reagent/atom 0)
-                  :style {:border "none"}]
-                [label :label "Disabled time input"]
-                [time-input
-                 :model (reagent/atom nil)
-                  :disabled true]
-                [label :label "Time with default range and icon:"]
-                [time-input :model model1 :on-change #(reset! model1 %) :show-time-icon true]
-                [label :label "Time with range 06:00-21:59"]
-                [time-input
-                  :model model2
-                  :minimum 600
-                  :maximum 2159
-                  :on-change #(reset! model2 %)]]]))
+                  [:li.spacer [:strong ":minimum"] " - min time as an integer e.g.  930 - will not allow input less than this time - default 0."]
+                  [:li.spacer [:strong ":maximum"] " - max time as an integer e.g. 1400 - will not allow input more than this time - default 2359."]
+                  [:li.spacer [:strong ":on-change"] " - function to call upon change."]
+                  [:li.spacer [:strong ":disabled"] " - true if the component should be disabled - default false"]
+                  [:li.spacer [:strong ":show-time-icon"] " - true if the clock icon should be displayed - default false"]
+                  [:li.spacer [:strong ":style"] " - css style"]]]]])
+
+(defn demo1
+  []
+  (let [model (reagent/atom nil)]
+    (fn []
+      [v-box
+        :style {:font-size "small"}
+        :children [[:div.h4 "Time input - empty model"]
+                   [:label "Usage -"]
+                   [:code "[time-input :model (reagent/atom nil) :on-change #(reset! model %)]"]
+                   [:ul
+                     [:li [:strong ":model"] " - atom on nil"]
+                     [:li [:strong ":minimum"] " - nil - (default 0)"]
+                     [:li [:strong ":maximum"] " - nil - (default 2359)"]]
+                   [:label "Demo -"]
+                   [time-input :model model]]])))
+
+(defn demo2
+  []
+  (let [model  (reagent/atom 600)]
+    (fn []
+      [v-box
+        :style {:font-size "small"}
+        :children [[:div.h4 "Time input - model 600"]
+                   [:label "Usage -"]
+                   [:code "[time-input
+                      :model (reagent/atom 600)
+                      :on-change #(reset! model %)
+                      :style {:border \"none\"}]"]
+                   [:ul
+                     [:li [:strong ":model"] " - atom on 600"]
+                     [:li [:strong ":on-change"] " - update the model with the new value"]
+                     [:li [:strong ":minimum"] " - nil - (default 0)"]
+                     [:li [:strong ":maximum"] " - nil - (default 2359)"]]
+                   [:label "Demo -"]
+                   [time-input :model model :style {:border "none"}]]])))
+
+(defn demo3
+  []
+  (let [model  (reagent/atom 0)]
+    (fn []
+      [v-box
+        :style {:font-size "small"}
+        :children [[:div.h4 "Disabled time input - model 0"]
+                   [:label "Usage -"]
+                   [:code "[time-input :model (reagent/atom 0) :disabled true]"]
+                   [:ul
+                     [:li [:strong ":model"] " - atom on nil"]
+                     [:li [:strong ":minimum"] " - nil -(default 0)"]
+                     [:li [:strong ":maximum"] " - nil - (default 2359)"]]
+                   [:label "Demo -"]
+                   [time-input :model model :disabled true]]])))
+
+(defn demo4
+  []
+  (let [model  (reagent/atom 900)]
+    (fn []
+      [v-box
+        :style {:font-size "small"}
+        :children [[:div.h4 "Time input with icon - model 900"]
+                   [:label "Usage -"]
+                   [:code "[time-input
+                             :model (reagent/atom 900)
+                             :on-change #(reset! model %)
+                             :show-time-icon true]"]
+                   [:ul
+                     [:li [:strong ":model"] " - atom on 900"]
+                     [:li [:strong ":on-change"] " - update the model with the new value"]
+                     [:li [:strong ":minimum"] " - (default) 0"]
+                     [:li [:strong ":maximum"] " - (default) 2359"]]
+                   [:label "Demo -"]
+                   [time-input :model model :on-change #(reset! model %) :show-time-icon true]]])))
+
+(defn demo5
+  []
+  (let [model  (reagent/atom 900)]
+    (fn []
+      [v-box
+        :style {:font-size "small"}
+        :children [[:div.h4 "Time input - model 900 - range 06:00-21:59"]
+                   [:label "Usage -"]
+                   [:code "[time-input
+                             :model (reagent/atom 900)
+                             :on-change #(reset! model %)
+                             :minimum 600
+                             :maximum 2159]"]
+                   [:ul
+                     [:li [:strong ":model"] " - atom on 900"]
+                     [:li [:strong ":on-change"] " - update the model with the new value"]
+                     [:li [:strong ":minimum"] " - 600"]
+                     [:li [:strong ":maximum"] " - 2159"]]
+                   [:label "Demo -"]
+                   [:p "Try typing a value outside the range."]
+                   [time-input
+                     :model model
+                     :on-change #(reset! model %)
+                     :minimum 600
+                     :maximum 2159]]])))

 (defn panel
   []
-  [v-box
-   :children [[time-examples]]])
+  (let [selected-demo-id (reagent/atom "1")]
+    (fn [] [v-box
+            :children [[:h3.page-header "Time Input"]
+                       [h-box
+                        :gap      "50px"
+                        :children [[notes]
+                                   [v-box
+                                    :gap       "15px"
+                                    :size      "auto"
+                                    :min-width "500px"
+                                    :children  [[h-box
+                                                :gap      "10px"
+                                                :align    :center
+                                                :children [[label :label "Select a demo"]
+                                                           [single-dropdown
+                                                            :options   demos
+                                                            :model     selected-demo-id
+                                                            :width     "300px"
+                                                            :on-select #(reset! selected-demo-id %)]]]
+                                               [gap :size "0px"] ;; Force a bit more space here
+                                               (case @selected-demo-id
+                                                 "1" [demo1]
+                                                 "2" [demo2]
+                                                 "3" [demo3]
+                                                 "4" [demo4]
+                                                 "5" [demo5])]]]]]])))


remove obsolete comment

remove obsolete comment

--- src/seathree/data.clj
+++ src/seathree/data.clj
@@ -154,8 +154,6 @@
                (str/replace restored-text (mk-sigil c) (first ss))
                (rest ss)))))

-;; TODO TEST SIGILS, USE SIGILS
-
 (defn translate
   "Given a user-data map and a single tweet's text, make a GET request
    to the google translate API."


Use local images

Use local images

--- src/sojoban/core.cljs
+++ src/sojoban/core.cljs
@@ -16,8 +16,7 @@
        #{:block :goal} "bag_goal"
        #{:player :goal} "man_goal"
        #{:wall} "block"}
-      (as-> x (str "http://www.ne.jp/asahi/ai/yoshio/sokoban/image/p_"
-                   x ".gif"))))
+      (as-> x (str "images/p_" x ".gif"))))

 (defn find-player
   "Return [row col] coordinates of the player on the board."


Move schema path normalization into its own function.

--- src/sql_file/core.clj
+++ src/sql_file/core.clj
@@ -30,12 +30,9 @@

 (defn- locate-schema-script [ conn basename ]
   (or (some identity
-            (map (fn [ prefix ]
-                   (let [ script-path (format "%s%s" prefix basename)]
-                     (log/debug "Checking for script:" script-path)
-                     (clojure.java.io/resource script-path)))
-                 (conj (get conn :schema-path []) "")))
-      (fail "Cannot find resource script: " basename)))
+            (map #(clojure.java.io/resource (format "%s%s" % basename))
+                 (:schema-path conn)))
+      (fail "Cannot find resource script: " basename " in search path " (:schema-path conn))))

 (defn- schema-install-script [ conn schema ]
   "Locate the schema script to install the given schema name and
@@ -144,17 +141,20 @@
         (fail "Cannot downgrade schema " req-schema-name " from version " cur-schema-version " to " req-schema-version))
       conn))

+(defn normalize-schema-path [ conn ]
+  (assoc conn :schema-path
+         (conj (get conn :schema-path []) "")))

 ;; Public Entry points

 (defn open-sql-file [ conn schema ]
   "Open a database file with the given connection map, and ensure that
 the specified schema is available within that database."
-  (let [ conn (conn-assoc-schema conn schema) ]
-    (log/info "Opening sql-file:" conn)
-    (-> conn
-        (ensure-schema [ "sql-file" 0])
-        (ensure-schema schema))))
+  (log/info "Opening sql-file:" conn "with schema:" schema)
+  (-> conn
+      normalize-schema-path
+      (ensure-schema [ "sql-file" 0 ])
+      (ensure-schema schema)))

 ;; HSQLDB Specific


Suggested refinements

Suggested refinements

--- strain/strain_test.clj
+++ strain/strain_test.clj
@@ -32,10 +32,10 @@
 (deftest discard-several
   (is (= [0 2 4] (discard odd? (range 6)))))

-(deftest doesn't-use-existing-implementations
-  (with-redefs [filter (fn [& _] (throw (Exception. "Implement without filter!")))
-                remove (fn [& _] (throw (Exception. "Implement without remove!")))
-                filterv (fn [& _] (throw (Exception. "Implement without filterv!")))]
+(deftest does-not-use-existing-implementations
+  (with-redefs [filter (constantly (throw (Exception. "Implement without filter!")))
+                remove (constantly (throw (Exception. "Implement without remove!")))
+                filterv (constantly (throw (Exception. "Implement without filterv!")))]
     (dorun (retain even? (range 10)))
     (dorun (discard even? (range 10)))))


Add improvements to form helpers.

Add improvements to form helpers.

--- src/uxbox/ui/form.cljs
+++ src/uxbox/ui/form.cljs
@@ -4,17 +4,21 @@

 (defn validate!
   [local schema]
-  (if-let [errors (sc/validate schema @local)]
-    (swap! local assoc :errors errors)
-    (swap! local assoc :errors nil)))
+  (let [[errors data] (sc/validate (:form @local) schema)]
+    (if errors
+      (do
+        (swap! local assoc :errors errors)
+        nil)
+      (do
+        (swap! local assoc :errors nil)
+        data))))

 (defn input-error
   [local name]
   (when-let [errors (get-in @local [:errors name])]
-     [:div.errors
-      [:ul {}
-       (for [error errors]
-         [:li error])]]))
+    [:ul.form-errors
+     (for [error errors]
+       [:li {:key error} error])]))

 (defn error-class
   [local name]


fix edge case in is-double-column-line?

fix edge case in is-double-column-line?

--- cljs/src/main/plastic/cogs/editor/render/code.cljs
+++ cljs/src/main/plastic/cogs/editor/render/code.cljs
@@ -52,7 +52,7 @@
   (or (nil? node) (= (:tag node) :newline)))

 (defn is-double-column-line? [line]
-  (and (is-simple? (first line)) (is-newline? (nth line 2 nil))))
+  (and (is-simple? (first line)) (not (is-newline? (second line))) (is-newline? (nth line 2 nil))))

 (defn elements-table [nodes]
   (let [lines (reduce break-nodes-into-lines [[]] nodes)]


Switch to thread local random uuid

Switch to thread local random uuid

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -8,6 +8,7 @@
             [zookeeper :as zk]
             [onyx.static.default-vals :refer [arg-or-default]]
             [onyx.types :as t]
+            [onyx.static.uuid :refer [random-uuid]]
             [onyx.peer.pipeline-extensions :as p-ext]
             [onyx.peer.function :as function]
             [onyx.peer.operation :refer [kw->fn]]
@@ -104,8 +105,7 @@
                 (let [message ^KafkaMessage (first ms)
                       next-offset ^int (.offset message)
                       dm (deserializer-fn (.value message))]
-                  (>!! ch (assoc (t/input (java.util.UUID/randomUUID)
-                                          dm)
+                  (>!! ch (assoc (t/input (random-uuid) dm)
                                  :offset next-offset))
                   (recur (rest ms) (inc next-offset)))))
             (finally
@@ -176,7 +176,7 @@
                        (map (fn [_]
                               (let [result (first (alts!! [read-ch timeout-ch] :priority true))]
                                 (if (= (:message result) :done)
-                                  (t/input (java.util.UUID/randomUUID) :done)
+                                  (t/input (random-uuid) :done)
                                   result))))
                        (filter :message)))]
       (doseq [m batch]
@@ -202,8 +202,7 @@
   (retry-segment
     [_ _ segment-id]
     (when-let [msg (get @pending-messages segment-id)]
-      (>!! read-ch (t/input (java.util.UUID/randomUUID)
-                            (:message msg)))
+      (>!! read-ch (t/input (random-uuid) (:message msg)))
       (swap! pending-messages dissoc segment-id)))

   (pending?


Re-order clock bus channels - now [small-tick big-tick]

--- src/overtone/sc/clock.clj
+++ src/overtone/sc/clock.clj
@@ -11,18 +11,24 @@

 ;; should only be modified by a 'singleton' wall-clock synth
 ;; global shared state FTW!
-(defonce server-clock-b (control-bus 2 "Server Clock Buses"))
+(defonce ^{:doc (str "2 Channel server clock bus.
+
+ First channel is the small tick, second is big tick. Every
+ SC-MAX-FLOAT-VAL ticks, small tick resets back to 0 and big tick
+ increments by one.")}
+  server-clock-b
+  (control-bus 2 "Server Clock Buses"))

 ;; Only one of these should ever be created...
 (defonce __SERVER-CLOCK-SYNTH__
   (defsynth __internal-wall-clock__ [tick-bus-2c 0]
-    (let [[b-tick s-tick] (in:kr tick-bus-2c 2)
+    (let [[s-tick b-tick] (in:kr tick-bus-2c 2)
           maxed?          (= defaults/SC-MAX-FLOAT-VAL s-tick)
           small-tick      (select:kr maxed?
                                      [(+ s-tick 1)
                                       0])
           big-tick        (pulse-count maxed?)]
-      (replace-out:kr tick-bus-2c [big-tick small-tick]))))
+      (replace-out:kr tick-bus-2c [small-tick big-tick]))))

 (defn- server-clock-reset-tick-b
   []
@@ -47,7 +53,7 @@
    See server-clock-uptime and server-clock-time for functions that
    return time in milliseconds."
   []
-  (let [[b-t s-t] (control-bus-get-range server-clock-b 2)]
+  (let [[s-t b-t] (control-bus-get-range server-clock-b 2)]
     (+ (* b-t defaults/SC-MAX-FLOAT-VAL)
        s-t)))


rename #'start-recording and #'stop-recording to give them consistent initial chars #'recording-*

--- src/overtone/sc/mixer.clj
+++ src/overtone/sc/mixer.clj
@@ -103,7 +103,7 @@

 (defonce recorder-info* (ref nil))

-(defn start-recording
+(defn recording-start
   "Start recording a wav file to a new file at wav-path. Be careful - may
   generate very large files."
   [wav-path]
@@ -119,7 +119,7 @@
                               :buf-stream bs}))
     :recording-started))

-(defn stop-recording
+(defn recording-stop
   "Stop system-wide recording. This frees the file and writes the wav headers.
   Returns the path of the file created."
   []


better use guids for the schema so they can sync from the frontend

--- src/pc/datomic/schema.clj
+++ src/pc/datomic/schema.clj
@@ -20,6 +20,11 @@
               :db.type/string
               :db/doc "Layer name")

+   (attribute :layer/guid
+              :db.type/guid
+              :db/index true
+              :db/doc "Guid set on the frontend when it creates the layer")
+
    (attribute :layer/type
               :db.type/ref
               :db/doc "Layer type")
@@ -31,11 +36,12 @@
               :db.type/bytes
               :db/doc "Fill, should be an array of ints, has to be converted to and from bytes")

-   ;; I think that this is how you define relationships between entities
+   ;; Use the layer's guid so that the frontend can track children
    ;; Wonder what happens if we make a layer a child of one of its children...
    (attribute :layer/child
-              :db.type/ref
-              :db/cardinality :db.cardinality/many)
+              :db.type/guid
+              :db/cardinality :db.cardinality/many
+              :db/doc "Layer's children")
    ])

 (defn ensure-schema


Middleware wrap-base-url now supports request context

--- src/hiccup/middleware.clj
+++ src/hiccup/middleware.clj
@@ -3,8 +3,10 @@
   (:use hiccup.core))

 (defn wrap-base-url
-  "Ring middleware that wraps the handler in the with-base-url function."
-  [handler url]
+  "Ring middleware that wraps the handler in the with-base-url function. The
+  base URL may be specified as an argument. Otherwise, the :context key on the
+  request map is used."
+  [handler & [base-url]]
   (fn [request]
-    (with-base-url url
+    (with-base-url (or base-url (:context request))
       (handler request))))


Allow nested bundles

Allow nested bundles

--- src/play_clj/entities.clj
+++ src/play_clj/entities.clj
@@ -113,4 +113,4 @@
 (defrecord BundleEntity [entities] Entity
   (draw-entity! [{:keys [entities] :as entity} screen batch]
     (doseq [e entities]
-      (draw-entity! (merge e entity) screen batch))))
+      (draw-entity! (merge e (dissoc entity :entities)) screen batch))))


Fix the close button on Catalog Wizard

Fix the close button on Catalog Wizard

--- src/cljs/main/broadfcui/page/workspace/summary/catalog/wizard.cljs
+++ src/cljs/main/broadfcui/page/workspace/summary/catalog/wizard.cljs
@@ -122,10 +122,12 @@
        [:div {}
         (when (:submitting? @state)
           [comps/Blocker {:banner "Submitting..."}])
-        [:div {:style {:borderBottom style/standard-line
+        [:div {:style {:display "flex"
+                       :borderBottom style/standard-line
                        :padding "20px 48px 18px"
                        :fontSize "137%" :fontWeight 400 :lineHeight 1}}
          "Catalog Dataset"
+         flex/spring
          (buttons/x-button modal/pop-modal)]
         [:div {:style {:padding "22px 24px 40px" :backgroundColor (:background-light style/colors)}}
          [:div {:style {:display "flex" :width 850 :height 400}}