simpler and faster update

simpler and faster update

--- src/ontrail/search.clj
+++ src/ontrail/search.clj
@@ -21,9 +21,9 @@
 (defn insert-term [ex-id term]
   (let [index @inverted-index]
     (if (not (contains? index term))
-      (fst 0 (swap! inverted-index assoc term #{ex-id}))
-      (fst 1 (let [new-one (merge-with clojure.set/union index {term #{ex-id}})]
-        (swap! inverted-index assoc term (get new-one term)))))))
+      (fst 1 (swap! inverted-index assoc term #{ex-id}))
+      (fst 0 (let [new-val (clojure.set/union (get index term) #{ex-id})]
+        (swap! inverted-index assoc term new-val))))))

 (defn insert-exercise-inmem-index [ex]
   (let [terms (get-ex-terms ex)
@@ -42,7 +42,7 @@

 (defn search [& terms]
   (let [ids  (apply search-ids terms)]
-    (log "TRACE" " search result " ids)
+    (log "TRACE" " search result count: " (count ids))
     (as-ex-result-list (filter (partial not= nil) (map #(mc/find-one-as-map EXERCISE {:_id (ObjectId. %)}) ids)))))

 (defn search-wrapper [query]
@@ -50,6 +50,3 @@
     (if (= query-string nil)
       '()
       (apply search (string/split query-string #" ")))))
-
-(defn -main [& args]
-  (rebuild-index))


Set content-type for files uploaded to S3

--- src/asciinema/component/s3_file_store.clj
+++ src/asciinema/component/s3_file_store.clj
@@ -4,7 +4,8 @@
             [clj-time
              [coerce :as timec]
              [core :as time]]
-            [ring.util.http-response :as response])
+            [ring.util.http-response :as response]
+            [ring.util.mime-type :as mime-type])
   (:import com.amazonaws.auth.BasicAWSCredentials
            com.amazonaws.services.s3.AmazonS3Client
            [com.amazonaws.services.s3.model GeneratePresignedUrlRequest ResponseHeaderOverrides]))
@@ -33,8 +34,10 @@
     (file-store/put-file this file path nil))

   (put-file [this file path size]
-    (let [path (str path-prefix path)]
-      (s3/put-object cred bucket path file {:content-length size})))
+    (let [path (str path-prefix path)
+          content-type (mime-type/ext-mime-type path)]
+      (s3/put-object cred bucket path file {:content-length size
+                                            :content-type content-type})))

   (input-stream [this path]
     (let [path (str path-prefix path)]


Add docstrings to http-kit functions.

Add docstrings to http-kit functions.

--- src/containium/http_kit.clj
+++ src/containium/http_kit.clj
@@ -3,13 +3,15 @@
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.

 (ns containium.http-kit
+  "The namespace for starting and stopping HTTP Kit, and managing
+  boxes that contain ring apps."
   (:require [org.httpkit.server :refer (run-server)]
             [boxure.core :as boxure]))

 ;;; Ring app registry.

-(defrecord App [box handler-fn ring-conf])
+(defrecord RingApp [box handler-fn ring-conf])

 (def apps (atom {}))

@@ -19,6 +21,8 @@
 ;;; Overall ring handler creation.

 (defn- sort-apps
+  "Sort the RingApps for routing. Currently it sorts on the number of
+  path elements in the context path, descending."
   [apps]
   (let [non-deterministic (remove #(or (-> % :ring-conf :context-path)
                                        (-> % :ring-conf :host-regex))
@@ -35,6 +39,7 @@

 (defmacro matcher
+  "Evaluates to a match form, used by the make-app function."
   [{:keys [host-regex context-path]} uri-sym server-name-sym]
   (let [host-test `(re-matches ~host-regex ~server-name-sym)
         context-test `(.startsWith ~uri-sym ~context-path)]
@@ -43,6 +48,8 @@

 (defn- make-app
+  "Recreates the toplevel ring handler function, which routes the
+  registered RingApps."
   []
   (let [handler (if-let [apps (seq (vals @apps))]
                   (let [sorted (sort-apps apps)
@@ -62,19 +69,29 @@
 ;;; Ring app registration.

 (defn- clean-ring-conf
+  "Updates the ring-conf, in order to ensure some properties of the values."
   [ring-conf]
   (update-in ring-conf [:context-path] #(when % (if (= (last %) \/) % (str % "/")))))

 (defn upstart-box
+  "Add a box holding a ring application. The box's project definition
+  needs to have a :ring configuration inside the :boxure
+  configuration. A required key is :handler-sym, which, when evaluated
+  inside the box, should be the ring handler function. Optional keys
+  are :context-path and :host-regex. The first acts as a filter for
+  the first element(s) in the request URI, for example \"/api/v1/\".
+  The second is a regular expression, which is matched against the
+  server name of the request, for example \".*containium.com\"."
   [{:keys [name project] :as box}]
   (let [ring-conf (clean-ring-conf (-> project :boxure :ring))
         handler-fn (boxure/eval box (:handler-sym ring-conf))]
-    (swap! apps assoc name (App. box handler-fn ring-conf))
+    (swap! apps assoc name (RingApp. box handler-fn ring-conf))
     (make-app)))

 (defn remove-box
+  "Removes a box's ring handler from the ring server."
   [{name :name}]
   (swap! apps dissoc name)
   (make-app))
@@ -83,6 +100,7 @@
 ;;; Ring server management.

 (defn start
+  "Start HTTP Kit, based on the specified spec config."
   [config]
   (println "Starting HTTP Kit using config:" (:http-kit config))
   (make-app)
@@ -92,6 +110,7 @@

 (defn stop
+  "Stop HTTP Kit, using the stop function as returned by `start`."
   [stop-fn]
   (println "Stopping HTTP Kit...")
   (stop-fn)


Switched impl of map-function-on-map-vals to one I could understand ☺

--- src/leiningen/amp/impl.clj
+++ src/leiningen/amp/impl.clj
@@ -19,7 +19,7 @@
 (defn- map-function-on-map-vals
   "From http://stackoverflow.com/questions/1676891/mapping-a-function-on-the-values-of-a-map-in-clojure"
   [m f]
-  (reduce (fn [altered-map [k v]] (assoc altered-map k (f v))) {} m))
+  (into {} (for [[k v] m] [k (f v)])))

 (defn- fexists
   [file]


Allow custom web.xml, similar to leiningen-war

--- src/leiningen/ring/war.clj
+++ src/leiningen/ring/war.clj
@@ -96,18 +96,21 @@
       "/*"))

 (defn make-web-xml [project]
-  (indent-str
-   (sexp-as-element
-    [:web-app
-     (if (has-listener? project)
-       [:listener
-        [:listener-class (listener-class project)]])
-     [:servlet
-      [:servlet-name  (servlet-name project)]
-      [:servlet-class (servlet-class project)]]
-     [:servlet-mapping
-      [:servlet-name (servlet-name project)]
-      [:url-pattern (url-pattern project)]]])))
+  (let [ring-options (:ring project)]
+    (if (contains? ring-options :web-xml)
+      (slurp (:web-xml ring-options))
+      (indent-str
+        (sexp-as-element
+          [:web-app
+           (if (has-listener? project)
+             [:listener
+              [:listener-class (listener-class project)]])
+           [:servlet
+            [:servlet-name  (servlet-name project)]
+            [:servlet-class (servlet-class project)]]
+           [:servlet-mapping
+            [:servlet-name (servlet-name project)]
+            [:url-pattern (url-pattern project)]]])))))

 (defn source-file [project namespace]
   (io/file (:compile-path project)


firefox doesn't support innerText, use textContent instead

--- src/parinfer/core.cljs
+++ src/parinfer/core.cljs
@@ -25,7 +25,7 @@
       (let [e (aget elements i)]
         {:id (.. e -parentElement -id)
          :level (subs (.-tagName e) 1)
-         :text (.-innerText e)}))))
+         :text (.-textContent e)}))))

 (defn make-toc-html []
   (html


Move top of threads down to make room for "clear inbox" button

Closes #154

--- src/braid/core/client/ui/styles/misc.cljs
+++ src/braid/core/client/ui/styles/misc.cljs
@@ -29,7 +29,7 @@
   [:>.threads
    mixins/flex
    {:position "absolute"
-    :top vars/pad
+    :top "2.6rem"
     :right 0
     :bottom 0
     :left 0


Make the tempo and scale configurable via the UI

--- src/pianola/webui.cljs
+++ src/pianola/webui.cljs
@@ -13,6 +13,22 @@
    (synth/percussive 0.01 0.4)
    (synth/gain 0.1)))

+(def scales
+  {:a-major (comp scale/A scale/major)
+   :a-minor (comp scale/A scale/minor)
+   :b-major (comp scale/B scale/major)
+   :b-minor (comp scale/B scale/minor)
+   :c-major (comp scale/C scale/major)
+   :c-minor (comp scale/C scale/minor)
+   :d-major (comp scale/D scale/major)
+   :d-minor (comp scale/D scale/minor)
+   :e-major (comp scale/E scale/major)
+   :e-minor (comp scale/E scale/minor)
+   :f-major (comp scale/F scale/major)
+   :f-minor (comp scale/F scale/minor)
+   :g-major (comp scale/G scale/major)
+   :g-minor (comp scale/G scale/minor)})
+
 (defonce initial-automaton
   [[0.25 0.125 0.5 0.25 0.125 0.5 0.5]
    [1 2 0 4 5 6 3]])
@@ -25,7 +41,7 @@
   50)

 (defonce initial-scale
-  (comp scale/C scale/major))
+  :c-major)

 (defonce app-state
   (r/atom {:context (synth/audio-context)
@@ -34,18 +50,16 @@
            :playing false
            :automaton initial-automaton
            :seed initial-seed
-           :music (->>
-                   (automate-music initial-automaton initial-seed)
-                   (tempo (bpm initial-tempo))
-                   (where :pitch initial-scale))}))
+           :music (automate-music initial-automaton initial-seed)}))

 (defn play-next! [notes]
-  (let [{:keys [context playing]} @app-state
-        {:keys [time duration] :as note} (first notes)
+  (let [{:keys [context playing tempo scale]} @app-state
+        {:keys [pitch duration] :as note} (first notes)
+        duration ((bpm tempo) duration)
         remainder (rest notes)
         at (synth/current-time context)
         synth-instance (-> note
-                           (update :pitch temperament/equal)
+                           (update :pitch (comp temperament/equal (get scales scale)))
                            (dissoc :time)
                            ping)
         connected-instance (synth/connect synth-instance synth/destination)]
@@ -69,6 +83,13 @@
            :on-change (fn [e]
                         (swap! app-state assoc param (.-target.value e)))}])

+(defn selector [param value options]
+  [:select {:value value
+            :on-change (fn [e]
+                         (swap! app-state assoc param (keyword (.-target.value e))))}
+   (map (fn [v] [:option {:key v :value v} (str v)]) options)])
+
+
 (defn playback-toggle []
   (let [playing (:playing @app-state)]
     [:button {:on-click (fn [e]
@@ -83,12 +104,13 @@
      [:h1 "Pianola"]
      [slider :tempo tempo 20 160]
      [:p (str tempo " BPM")]
+     [selector :scale scale (keys scales)]
+     [:p "Scale"]
      [notation automaton]
      [notation seed]
      [playback-toggle]]))

 (defn reload []
-  (println "reloading")
   (r/render [app app-state]
             (.getElementById js/document "pianola")))


More logging.

More logging.

--- src/kixi/hecuba/data/misc.clj
+++ src/kixi/hecuba/data/misc.clj
@@ -229,5 +229,6 @@
     (doseq [batch (partition-all page measurements)]
       (let [{:keys [min-date max-date]} (min-max-dates batch)]
         (log/debugf "Inserting %s records for dates between %s and %s for batch for Sensor: %s" (count batch) min-date max-date sensor)
+        (log/debugf "Batch %s" batch)
         (insert-batch session batch)
         (update-sensor-metadata store sensor min-date max-date)))))


TITANIC accesses set-weight to often

TITANIC accesses set-weight to often

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

--- src/conexp/contrib/algorithms/titanic.clj
+++ src/conexp/contrib/algorithms/titanic.clj
@@ -59,16 +59,16 @@

   Also note that the variables «closure» and «set-weight» have to be
   rebound."
-  [X base-set keys candidates]
-  (let [X-weight (set-weight X),
-        keys     (take-while #(not= (set-weight %) X-weight) keys)]
+  [X base-set keys]
+  (let [X-weight (get set-weight X),
+        keys     (take-while #(not= (get set-weight %) X-weight) keys)]
     (loop [Y        (apply union X (map #(closure (disj X %)) X)),
            elements (difference base-set Y)]
       (if-not (empty? elements)
         (let [m    (first elements),
               X+m  (conj X m),
-              add? (if (contains? candidates X+m)
-                     (= (set-weight X+m) X-weight)
+              add? (if-let [s (get set-weight X+m)]
+                     (= s X-weight)
                      (not (first (for [K keys,
                                        :when (and (contains? K m)
                                                   (subset? K X+m))]
@@ -103,7 +103,7 @@
            keys       [#{}]]
       (set! set-weight (into set-weight (weigh candidates)))
       (doseq [X key-set]
-        (set-val! closure X (titanic-closure X base-set keys candidates)))
+        (set-val! closure X (titanic-closure X base-set keys)))
       (let [next-key-set (set-of X [X candidates,
                                     :when (not= (subset-weight X)
                                                 (get set-weight X))])]
@@ -113,13 +113,33 @@
                  (map first
                       (sort (fn [[_ a] [_ b]]
                               (weight-order a b))
-                            (map #(vector % (set-weight %))
+                            (map #(vector % (get set-weight %))
                                  (concat next-key-set keys)))))
-          (distinct (map closure keys)))))))
+          (distinct (vals closure)))))))
+
+(defn titanic-keys
+  "Nearly the same as titanic, but returns the key sets only."
+  [base-set weigh max-weight weight-order]
+  (binding [closure    {},
+            set-weight (weigh [#{}]),
+            minimum    (partial minimum weight-order max-weight)]
+
+    (loop [key-set    #{#{}},
+           candidates (set-of #{m} [m base-set]),
+           keys       [#{}]]
+      (set! set-weight (into set-weight (weigh candidates)))
+      (let [next-key-set (set-of X [X candidates,
+                                    :when (not= (subset-weight X)
+                                                (get set-weight X))])]
+        (if-not (empty? next-key-set)
+          (recur next-key-set
+                 (titanic-generate base-set next-key-set)
+                 (concat next-key-set keys))
+          keys)))))

 ;;;

-(defn- supports
+(defn supports
   "Returns a function of one argument being a collection of sets of attributes,
   returning a hash-map from those sets to their supports in the given
   context, if they have at least minsupp elements. Otherwise they are


Turned tab buttons into components

Turned tab buttons into components

--- src/day8/re_frame_10x/view/container.cljs
+++ src/day8/re_frame_10x/view/container.cljs
@@ -19,7 +19,9 @@
             [day8.re-frame-10x.common-styles :as common]))

 (def triangle-down (macros/slurp-macro "day8/re_frame_10x/images/triangle-down.svg"))
-(defn tab-button [panel-id title]
+
+(defn tab-button
+  [panel-id title]
   (let [selected-tab @(rf/subscribe [:settings/selected-tab])]
     [rc/v-box
      :style    {:margin-bottom "-8px"
@@ -182,17 +184,17 @@
                     :gap      "7px"
                     :align    :end
                     :height   "50px"
-                    :children [(tab-button :event "Event")
-                               (tab-button :fx "fx")
-                               (tab-button :app-db "app-db")
-                               (tab-button :subs "Subs")
+                    :children [[tab-button :event "Event"]
+                               [tab-button :fx "fx"]
+                               [tab-button :app-db "app-db"]
+                               [tab-button :subs "Subs"]
                                (when (:debug? opts)
-                                 (tab-button :parts "Parts"))
-                               ;(tab-button :views "Views")
-                               (tab-button :traces "Trace")
-                               (tab-button :timing "Timing")
+                                 [tab-button :parts "Parts"])
+                               ;[tab-button :views "Views"]
+                               [tab-button :traces "Trace"]
+                               [tab-button :timing "Timing"]
                                (when (:debug? opts)
-                                 (tab-button :debug "Debug"))]]
+                                 [tab-button :debug "Debug"])]]
                    [rc/h-box
                     :align    :center
                     :padding  "0px 19px 0px 7px"


DM + AB #135 - Update seed-data to include comments on draft

--- dev/user.clj
+++ dev/user.clj
@@ -102,9 +102,13 @@
 (defn seed-objective [user]
   (let [objective (sh/store-an-objective {:user user :title (str "objective created by " (:username user))})
         writer (sh/store-a-writer {:user user :objective objective})
-        comments (doall (for [x (range 120)]
-                          (sh/store-a-comment {:entity objective :comment-text (str "comment - " x)})))]
-    (doseq [comment (take 60 comments)]
+        objective-comments (doall (for [x (range 120)]
+                                    (sh/store-a-comment {:entity objective :comment-text (str "objective comment - " x)})))
+        draft (sh/store-a-draft {:objective objective :user user})
+        draft-comments (doall (for [x (range 120)]
+                                (sh/store-a-comment {:entity draft :comment-text (str "draft comment - " x)})))]
+    (doseq [comment (flatten [(take 60 objective-comments)
+                              (take 60 draft-comments)])]
       (sh/store-a-note {:note-on-entity comment
                         :writer writer
                         :note (str "note on " (:comment comment))}))))


Update cljs build settings

Update cljs build settings

The cljs.closure/Compilable protocol has two methods and right now
running `(node-repl)` from the user ns throws an error about the
missing method `find-sources`

--- dev/user.clj
+++ dev/user.clj
@@ -4,25 +4,13 @@
     [clojure.string :as str]
     clojure.tools.namespace.repl
     cljs.repl
+    cljs.closure
     cljs.build.api
     cljs.repl.node
     cljs.repl.browser))

-(defrecord Dirs [dirs]
-  cljs.closure/Inputs
-  (-paths [_]
-    (mapv clojure.java.io/file dirs))
-
-  cljs.closure/Compilable
-  (-compile [_ opts]
-    (let [out-dir (cljs.util/output-directory opts)]
-      (vec
-        (for [src-dir dirs
-              root    (cljs.compiler/compile-root src-dir out-dir opts)]
-          (cljs.closure/compiled-file root))))))
-
 (defn repl [main env & dirs]
-  (cljs.build.api/build (Dirs. (concat ["src" "test"] dirs))
+  (cljs.build.api/build (cljs.closure/compilable-input-paths (concat ["src" "test"] dirs))
     {:main       main
      :output-to  "target/datascript.js"
      :output-dir "target/none"
@@ -30,7 +18,7 @@
      :verbose    true})

   (cljs.repl/repl env
-    :watch      (Dirs. (concat ["src" "test"] dirs))
+    :watch      (cljs.closure/compilable-input-paths (concat ["src" "test"] dirs))
     :output-dir "target/none"))

 (defn browser-repl []


cleanup

cleanup

--- src/gif_to_html/convert.clj
+++ src/gif_to_html/convert.clj
@@ -29,11 +29,7 @@
       (dotimes [x width]
         (.append sb (ascii-color img y x)))
       (.append sb "\n"))
-    (.toString sb)
-    #_(apply concat
-           (for [y (range height)]
-      (conj (mapv (partial ascii-color img y) (range width)) [:br])))))
-
+    (.toString sb)))

 (defn scale [x y]
   [100 (int (* (/ 100 x) y))])


Update version to 0.2.2-SNAPSHOT.

Update version to 0.2.2-SNAPSHOT.

--- metlog-vault/project.clj
+++ metlog-vault/project.clj
@@ -1,4 +1,4 @@
-(defproject metlog-vault "0.2.1-SNAPSHOT"
+(defproject metlog-vault "0.2.2-SNAPSHOT"
   :description "Repository for long term storage of series data."

   :license {:name "Eclipse Public License"


Rethrow errors caught during try-run

Rethrow errors caught during try-run

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -335,7 +335,8 @@

 (deftype Reaction [f ^:mutable state ^:mutable ^boolean dirty? ^boolean nocache?
-                   ^:mutable watching ^:mutable watches ^:mutable auto-run]
+                   ^:mutable watching ^:mutable watches ^:mutable auto-run
+                   ^:mutable caught]
   IAtom
   IReactiveAtom

@@ -394,9 +395,8 @@
       (try
         (._run this)
         (catch :default e
-          ;; Just log error: it will most likely pop up again at deref time.
-          (error "Error in reaction:" e)
           (set! state nil)
+          (set! caught e)
           (notify-w this e nil)))))

   (_run [this]
@@ -428,6 +428,9 @@

   IDeref
   (-deref [this]
+    (when-some [e caught]
+      (set! caught nil)
+      (throw e))
     (let [non-reactive (nil? *ratom-context*)]
       (when non-reactive
         (flush!))
@@ -467,7 +470,7 @@

 (defn make-reaction [f & {:keys [auto-run on-set on-dispose]}]
-  (let [reaction (Reaction. f nil true false nil nil nil)]
+  (let [reaction (Reaction. f nil true false nil nil nil nil)]
     (._set-opts reaction {:auto-run auto-run
                           :on-set on-set
                           :on-dispose on-dispose})


Try to make RCursor a bit more efficient and flexible

It now avoids unnecessary re-renderings, by comparing equality
with all its arguments, and by using a Reaction to filter out
only the changes that affects its value.

This also adds an optional setter callback, that is called instead
updating the parent atom directly.

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -1,6 +1,7 @@
 (ns reagent.ratom
   (:refer-clojure :exclude [atom])
-  (:require-macros [reagent.debug :refer (dbg)]))
+  (:require-macros [reagent.debug :refer (dbg log dev?)])
+  (:require [reagent.impl.util :as util]))

 (declare ^:dynamic *ratom-context*)

@@ -87,33 +88,47 @@
   ([x] (RAtom. x nil nil nil))
   ([x & {:keys [meta validator]}] (RAtom. x meta validator nil)))

-(deftype RCursor [path ratom]
+(declare make-reaction)
+
+(defn peek-at [a path]
+  (binding [*ratom-context* nil]
+    (get-in @a path)))
+
+
+(deftype RCursor [path ratom setf ^:mutable reaction]
   IAtom

   IEquiv
-  (-equiv [o other] (identical? o other))
+  (-equiv [o other]
+    (and (instance? RCursor other)
+         (= path (.-path other))
+         (= ratom (.-ratom other))
+         (= setf (.-setf other))))

   IDeref
   (-deref [this]
-    (get-in @ratom path))
+    (if (nil? *ratom-context*)
+      (get-in @ratom path)
+      (do
+        (if (nil? reaction)
+          (set! reaction (make-reaction #(get-in @ratom path))))
+        @reaction)))

   IReset
   (-reset! [a new-value]
-    (swap! ratom assoc-in path new-value))
+    (if (nil? setf)
+      (swap! ratom assoc-in path new-value)
+      (setf new-value)))

   ISwap
   (-swap! [a f]
-    (swap! ratom update-in path f))
+    (-reset! a (f (peek-at ratom path))))
   (-swap! [a f x]
-    (swap! ratom update-in path f x))
+    (-reset! a (f (peek-at ratom path) x)))
   (-swap! [a f x y]
-    (swap! ratom update-in path f x y))
+    (-reset! a (f (peek-at ratom path) x y)))
   (-swap! [a f x y more]
-    (swap! ratom update-in path f x y more))
-
-  IMeta
-  (-meta [_]
-    (-meta ratom))
+    (-reset! a (apply f (peek-at ratom path) x y more)))

   IPrintWithWriter
   (-pr-writer [a writer opts]
@@ -136,11 +151,14 @@
     (-remove-watch ratom key))

   IHash
-  (-hash [this] (goog/getUid this)))
+  (-hash [this] (hash [ratom path setf])))

 (defn cursor
-  [path ra]
-  (RCursor. path ra))
+  ([path ra]
+     (RCursor. path ra nil nil))
+  ([path ra setf args]
+     (RCursor. path ra
+               (util/partial-ifn. setf args nil) nil)))

 (defprotocol IDisposable
   (dispose! [this]))


added hacer

added hacer

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -408,6 +408,24 @@
                        :sem {:pred :talk
                              :subj {:human true}}}}]

+   "hacer" {:espanol {:future-stem "har"
+                   :present {:1sing "hago"
+                             :2sing "haces"
+                             :3sing "hace"
+                             :1plur "hacemos"
+                             :2plur "hacéis"
+                             :3plur "hacen"}
+                   :preterito {:1sing "hize"
+                               :2sing "hiciste"
+                               :3sing "hize"
+                               :1plur "hicimos"
+                               :2plur "hicisteis"
+                               :3plur "hicieron"}}
+         [(merge shared-part-of-hacer
+                {:synsem {:pred :do}})
+         (merge shared-part-of-hacer
+                {:synsem {:pred :make}})]
+
    "hervir" {:espanol {:boot-stem "hierv"}
              :synsem {:cat :verb
                       :sem {:pred :boil}}}


use :generate lexicon, if available in model

--- src/babel/italiano/writer.clj
+++ src/babel/italiano/writer.clj
@@ -30,7 +30,8 @@
                     true (Integer. count))
         ;; subset of the lexicon: only verbs which are infinitives and that can be roots:
         ;; (i.e. those that have a specific (non- :top) value for [:synsem :sem :pred])
-        lexicon (:lexicon model)
+        lexicon (or (:lexicon (:generate model))
+                    (:lexicon model))
         lexemes
         (cond (nil? lexeme) (vals lexicon)
               (= "all" lexeme) (vals lexicon)


Eliminate redunant application of defaults

--- src/matross/tasks/core.clj
+++ src/matross/tasks/core.clj
@@ -42,8 +42,7 @@
          (reify
            matross.tasks.core/ITask
            (exec [_# conn#]
-             (let [spec# (merge (get (meta #'~type) :defaults {}) spec#)
-                   validator# (:validator (meta #'~type))
+             (let [validator# (:validator (meta #'~type))
                    valid# (if validator# (valid? validator# spec#) true)]

                (if valid#
@@ -51,4 +50,5 @@
                  (throw (IllegalArgumentException. (pr-str (validator# spec#))))))))))))

 (defn run-task [conn conf]
-  (exec (get-task conf) conn))
+  (let [defaults (task-defaults conf)]
+    (exec (get-task (merge defaults conf)) conn)))


Includes a few riemann.time functions in riemann.config.

Config now has access to unix-time, linear-time, once!, and every!.
Closes #120.

--- src/riemann/config.clj
+++ src/riemann/config.clj
@@ -19,6 +19,7 @@
         [clojure.java.io :only [file]]
         riemann.client
         riemann.email
+        [riemann.time :only [unix-time linear-time once! every!]]
         [riemann.pagerduty :only [pagerduty]]
         [riemann.librato :only [librato-metrics]]
         riemann.streams)


only generate SVG when necessary

only generate SVG when necessary

--- src/inspect/main/store.cljs
+++ src/inspect/main/store.cljs
@@ -75,44 +75,49 @@
          (apply str (map (fn [n] (str n "; ")) nodes))
          "} ")))

-(defn generate-svg [stats]
-  (let [{:keys [cmp-ids edges]} stats
-        active-type nil
-        edge-mapper (fn edge-mapper [{:keys [source target msg-type]}]
-                      (str (sanitize source) " -> " (sanitize target)
-                           (if (= msg-type active-type)
-                             " [color = red penwidth=4]"
-                             (when active-type
-                               " [color = lightgrey]"))
-                           "; "))
-        links (apply str (map edge-mapper edges))
-        clusters (reduce
-                   (fn [acc in]
-                     (let [{:keys [source-ns source target-ns target]} in]
-                       (-> acc
-                           (update-in [source-ns] #(set (conj % (sanitize source))))
-                           (update-in [target-ns] #(set (conj % (sanitize target)))))))
-                   {}
-                   edges)
-        sub-graphs (map sub-graph clusters)
-        digraph (str "digraph { " links (apply str sub-graphs) "}")
-        svg (Viz digraph)]
-    (writeFileSync "/tmp/inspect.dot" digraph "utf-8")
-    (writeFileSync "/tmp/inspect.svg" svg "utf-8")
-    svg))
+(defn generate-svg [state put-fn]
+  (let [stats (select-keys (:stats state) [:cmp-ids :edges])
+        prev-stats (select-keys (:prev-stats state) [:cmp-ids :edges])]
+    (when-not (= stats prev-stats)
+      (let [{:keys [cmp-ids edges]} stats
+            active-type nil
+            edge-mapper (fn edge-mapper [{:keys [source target msg-type]}]
+                          (str (sanitize source) " -> " (sanitize target)
+                               (if (= msg-type active-type)
+                                 " [color = red penwidth=4]"
+                                 (when active-type
+                                   " [color = lightgrey]"))
+                               "; "))
+            links (apply str (map edge-mapper edges))
+            clusters
+            (reduce
+              (fn [acc in]
+                (let [{:keys [source-ns source target-ns target]} in]
+                  (-> acc
+                      (update-in [source-ns] #(set (conj % (sanitize source))))
+                      (update-in [target-ns] #(set (conj % (sanitize target)))))))
+              {}
+              edges)
+            sub-graphs (map sub-graph clusters)
+            digraph (str "digraph { " links (apply str sub-graphs) "}")
+            svg (Viz digraph)]
+        (writeFileSync "/tmp/inspect.dot" digraph "utf-8")
+        (writeFileSync "/tmp/inspect.svg" svg "utf-8")
+        (put-fn [:svg/overview svg])))))

 (defn state-publish [{:keys [current-state put-fn]}]
   (let [stats (:stats current-state)
         {:keys [cnt prev-cnt]} stats
         ts (st/now)
-        new-state (assoc-in current-state [:prev-cnt] cnt)
-        svg (time (generate-svg stats))]
+        new-state (-> current-state
+                      (assoc-in [:prev-cnt] cnt)
+                      (assoc-in [:prev-stats] stats))
+        svg (time (generate-svg current-state put-fn))]
     (when (not= cnt prev-cnt)
       (debug "STORE received:" cnt)
       (put-fn (with-meta [:observer/cmps-msgs (:stats new-state)]
                          {:window-id :broadcast})))
-    {:new-state new-state
-     :emit-msg  [:svg/overview svg]}))
+    {:new-state new-state}))

 (defn subscribe [{:keys [current-state msg-payload msg-meta]}]
   (let [subscription (assoc-in msg-payload [:msg-meta] msg-meta)


more refactoring needed - but getting there

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -193,41 +193,46 @@
 ;; demonstrate reduction
 ;;----------------------------------------

-(let [metadata (class-metadata "org.dada.core.Sum" Object :key :version
-			       [:key String :version Integer :sum Number])
-      getter (.getAttributeGetter (.getMetadata heavier-whales-length) "length")
-      accessor (fn [value] (.get getter value))
-      new-value (fn [#^Update update] (accessor (.getNewValue update)))
-      old-value (fn [#^Update update] (accessor (.getOldValue update)))]
-  (def sum
-       (proxy
-	[Reducer$Strategy]
-	[]
-	(initialValue [] 0M)
-	(initialType [type] type)
-	(currentValue [key version value]
-		      (.create #^Metadata metadata #^Collection (collection key version value)))
-	(reduce [insertions updates deletions]
-		(-
-		 (+
-		  (reduce #(+ %1 (new-value %2)) 0 insertions)
-		  (reduce #(+ %1 (- (new-value %2) (old-value %2))) 0 updates))
-		 (reduce #(+ %1 (old-value %2)) 0 deletions))
-		)
-	(apply [currentValue delta]
-	       (+ currentValue delta))
-	))
-
-  (defn make-reducer [#^Model model #^Keyword key-key #^Reducer$Strategy strategy]
-    (let [key (name key-key)]
-      (Reducer. (str (.getName model) ".sum(" key ")") metadata key strategy)))
-  )
-
-(defn do-reduce [#^Model model #^Keyword key #^Reducer$Strategy reduction]
-  (connect model (make-reducer model key reduction)))
+(defn make-sum-reducer-strategy
+  [#^Keyword attribute-key #^Metadata src-metadata #^Metadata tgt-metadata]
+  (let [getter (.getAttributeGetter src-metadata (name attribute-key))
+	accessor (fn [value] (.get getter value))
+	new-value (fn [#^Update update] (accessor (.getNewValue update)))
+	old-value (fn [#^Update update] (accessor (.getOldValue update)))
+	creator (.getCreator tgt-metadata)]
+    (proxy
+     [Reducer$Strategy]
+     []
+     (initialValue [] 0)
+     (initialType [type] type)
+     (currentValue [& args] (.create creator (into-array Object args)))
+     (reduce [insertions updates deletions]
+	     (-
+	      (+
+	       (reduce #(+ %1 (new-value %2)) 0 insertions)
+	       (reduce #(+ %1 (- (new-value %2) (old-value %2))) 0 updates))
+	      (reduce #(+ %1 (old-value %2)) 0 deletions))
+	     )
+     (apply [currentValue delta] (+ currentValue delta))
+     )))
+
+;; refactor from here...
+
+(defn make-reducer
+  [#^Model src-model #^Keyword attr-key #^Reducer$Strategy strategy #^Metadata tgt-metadata]
+  (let [attr-name (name attr-key)]
+    (Reducer. (str (.getName src-model) ".sum(" attr-name ")") tgt-metadata attr-name strategy)))
+
+(defn do-reduce-sum [#^Model model #^Keyword attribute-key]
+  (let [src-metadata (.getMetadata model)
+	tgt-classname "org.dada.core.Sum"
+	tgt-metadata (class-metadata tgt-classname Object :key :version [:key String :version Integer :sum Number])
+	strategy (make-sum-reducer-strategy attribute-key src-metadata tgt-metadata)
+	reducer (make-reducer model attribute-key strategy tgt-metadata)]
+    (connect model reducer)))

 ;; sum, average, mean, mode, COUNT, minimum, maximum,...
-(def heavier-whales-length-sum (do-reduce heavier-whales-length :length sum))
+(def heavier-whales-length-sum (do-reduce-sum heavier-whales-length :length))
 (insert *metamodel* heavier-whales-length-sum)

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


Final changes to be compatible with modern compojure.

--- src/main/clojure/org/scode/httpgctest.clj
+++ src/main/clojure/org/scode/httpgctest.clj
@@ -38,7 +38,8 @@
      :frag-grendade (apply str r (repeat (* (rand) 25) "kaboom"))}))

 (defn serve-gendata [request]
-  (let [amount (let [amstr (:amount (:query-params request))]
+  (println request)
+  (let [amount (let [amstr ((:query-params request) "amount")]
                  (if amstr
                    (Integer/parseInt amstr)
                    (max 1 (count @data))))]
@@ -50,8 +51,8 @@

 (defn serve-dropdata [request]
   (let [old-size (count @data)]
-    (if (contains? (:query-params request) :ratio)
-      (let [ratio (Double/parseDouble (:ratio (:query-params request)))]
+    (if (contains? (:query-params request) "ratio")
+      (let [ratio (Double/parseDouble ((:query-params request) "ratio"))]
         (dosync (alter data (fn [old] (loop [data old
                                              tail (seq old)]
                                         (if (seq tail)
@@ -67,11 +68,11 @@
      :body (str "dropped " (- old-size (count @data)))}))

 (defroutes our-routes
-  (GET "/gengarbage"
+  (GET "/gengarbage" []
        serve-gengarbage)
-  (GET "/gendata"
+  (GET "/gendata" []
        serve-gendata)
-  (GET "/dropdata"
+  (GET "/dropdata" []
        serve-dropdata))

 (defn -main [& args]


Delete t-save-request-obj in core_test

Delete t-save-request-obj in core_test

The save-request option has been unsupported for a while now.

--- test/clj_http/test/core_test.clj
+++ test/clj_http/test/core_test.clj
@@ -251,26 +251,6 @@
     (is (= 200 (:status resp)))
     (is (re-find #"byte-test" resp-body))))

-(deftest ^:integration t-save-request-obj
-  (run-server)
-  (let [resp (request {:request-method :post :uri "/post"
-                       :body "foo bar"
-                       :save-request? true
-                       :debug-body true})]
-    (is (= 200 (:status resp)))
-    (is (= {:scheme :http
-            :http-url (localhost "/post")
-            :request-method :post
-            :save-request? true
-            :debug-body true
-            :uri "/post"
-            :server-name "localhost"
-            :server-port 18080
-            :body-content "foo bar"
-            :body-type String}
-           (dissoc (:request resp) :body :http-req)))
-    (is (instance? HttpPost (-> resp :request :http-req)))))
-
 (deftest parse-headers
   (are [headers expected]
     (let [iterator (BasicHeaderIterator.


fix embedly links to urls with fragments

--- src/braid/ui/views/embed.cljs
+++ src/braid/ui/views/embed.cljs
@@ -55,7 +55,7 @@
                          (when (some? url)
                            (edn-xhr {:method :get
                                      :uri "/extract"
-                                     :params {:url (js/encodeURI url)}
+                                     :params {:url (js/encodeURIComponent url)}
                                      :on-complete set-content!})))]
     (r/create-class
       {:component-did-mount
@@ -67,7 +67,7 @@
          [:div.embed
           (if (:type @content)
             [:div.content.loaded {:on-click (fn []
-                                              (.open js/window (:url @content)))}
+                                              (.open js/window (:original_url @content)))}
              (cond
                (= "video" (get-in @content [:media :type]))
                [video-embed-view @content]


adding env keys

adding env keys

--- src/celestial/api/systems.clj
+++ src/celestial/api/systems.clj
@@ -13,6 +13,7 @@
   "Celestial systems api"
   (:refer-clojure :exclude [type])
   (:require
+    [celestial.common :refer (get*)]
     [celestial.persistency [types :as t] [users :as u]]
     [celestial.security :refer (current-user)]
     [ring.util.codec :refer (base64-decode)]
@@ -133,6 +134,11 @@
         (success (t/get-type (:type (s/get-system id))))))

 (defroutes- environments {:path "/environments" :description "Operations on environments"}
-  (GET- "/environments" [] {:nickname "getEnvironments" :summary "Get all environments"}
+  (GET- "/environments" [] {:nickname "getEnvironments" :summary "Get sanitized environments for current user"}
      (let [{:keys [envs] :as user} (u/get-user (working-username))]
-        (success {:environments (sanitized-envs (into #{} envs))}))))
+        (success {:environments (sanitized-envs (into #{} envs))})))
+
+  (GET- "/environments/keys" [] {:nickname "getEnvironments" :summary "Get all environments"}
+     (let [{:keys [envs] :as user} (u/get-user (working-username))]
+        (success {:environments (keys (get* :hypervisor))})))
+  )


addign in memory db

addign in memory db

--- src/celestial/persistency.clj
+++ src/celestial/persistency.clj
@@ -1,2 +1,11 @@
 (ns celestial.persistency
  )
+
+(def hosts
+  {:redis-test.local {:classes {:redis {:append true}}}
+   :redis-test.home.net {:classes {:redis {:append true}}}
+   :redis {:classes {:redis {:append true}}}
+   })
+
+(defn profile [host]
+  (hosts host))


fix fs-store

fix fs-store

--- src/ceres_geschichte/core.clj
+++ src/ceres_geschichte/core.clj
@@ -19,7 +19,7 @@
 (timbre/refer-timbre)

 (defn init-log-db [dir]
-  (new-fs-store dir (atom {:commit-delays []})))
+  (<!? (new-fs-store dir)))

 (defn stop-peer [state]
   (stop (get-in @state [:geschichte :peer])))


Don't notify on slack (matrix posts to slack)

--- src/clj/mokkameister/brew.clj
+++ src/clj/mokkameister/brew.clj
@@ -49,13 +49,11 @@
         total-count  (get-in stats [:regular :total])
         starting-msg (coffee-message-starting brew today-count)
         msg          (str starting-msg " - " mokkameister-link)]
-    (matrix/notify msg)
-    (slack/notify msg :channel channel)))
+    (matrix/notify msg)))

 (defn- notify-done! [brew]
   (let [msg (coffee-message-finished)]
-    (matrix/notify msg)
-    (slack/notify msg :channel channel)))
+    (matrix/notify msg)))

 (defn- finish-brewing! [brew]
   (notify-done! brew)
@@ -77,7 +75,7 @@

 (defn- notify-already-brewing! []
   (let [msg "Ro dykk ned! Kaffien kokar allereie!!1"]
-    (slack/notify msg :channel channel)))
+    (matrix/notify msg)))

 (defn- persist-and-notify-new-brew! [in-brew]
   (let [brew     (persist-brew! in-brew)


fix issues with edit period by details

fix issues with edit period by details

fix precision and step to prevent HTML validation errors
fix error logic generating period fields

--- src/clj_money/web/budgets.clj
+++ src/clj_money/web/budgets.clj
@@ -356,8 +356,9 @@
   [:div.form-group
    [:label.control-label (period-label budget (:index period))]
    [:input.form-control {:type :number
+                         :step "0.01"
                          :name (format "period-%s" (:index period))
-                         :value (:amount period)}]])
+                         :value (format-number (:amount period) {:format :no-comma})}]])

 (defn- period-input-group
   [budget periods]
@@ -374,7 +375,9 @@
     [:div.row
      [:div.col-md-8
       (map #(period-input-group budget %)
-           (or (:periods item)
+           (or (->> item
+                    :periods
+                    (partition 3))
                (->> budget
                     :period-count
                     range


Removing todos that are done.

Removing todos that are done.

--- src/clojure/picard/client.clj
+++ src/clojure/picard/client.clj
@@ -17,11 +17,6 @@
     HttpResponse
     HttpResponseDecoder
     HttpVersion]))
-
-;; TODOS:
-;; * Requests made with no content-length or transfer-encoding
-;; * Expiring the connection pool
-;; * Handling a maximum number of open connections in the pool

 (defrecord State
     [pool


vector.clj fix and new fn

vector.clj fix and new fn

--- src/clojure2d/math/vector.clj
+++ src/clojure2d/math/vector.clj
@@ -540,6 +540,12 @@
         (>= amt 1.0) 0
         :else (m/acos amt)))))

+(defn relative-angle-between
+  "Angle between two vectors reletive to each other"
+  ^double [v1 v2]
+  (- ^double (heading v2) ^double (heading v1)))
+
+
 (defn aligned?
   "Are vectors aligned (have the same direction)?"
   [v1 v2]


test-refresh: quite true - changes-only true

--- resources/leiningen/new/closp/project.clj
+++ resources/leiningen/new/closp/project.clj
@@ -136,4 +136,8 @@
             ; migration utilities
             "migrate" ["run" "-m" "joplin.alias/migrate" "joplin.edn" "sqlite-dev-env" "sqlite-dev"]
             "rollback" ["run" "-m" "joplin.alias/rollback" "joplin.edn" "sqlite-dev-env" "sqlite-dev"]
-            "reset" ["run" "-m" "joplin.alias/reset" "joplin.edn" "sqlite-dev-env" "sqlite-dev"]})
+            "reset" ["run" "-m" "joplin.alias/reset" "joplin.edn" "sqlite-dev-env" "sqlite-dev"]}
+
+
+  :test-refresh {:quiet true
+                 :changes-only true})


Change default target version to ICS

Change default target version to ICS

--- src/leiningen/droid/new.clj
+++ src/leiningen/droid/new.clj
@@ -73,7 +73,7 @@
            "not contain hyphens (you can replace them with underscores)."))
   (let [options (apply hash-map options)
         activity (get options ":activity" "MainActivity")
-        target-sdk (get options ":target-sdk" "10")
+        target-sdk (get options ":target-sdk" "15")
         app-name (get options ":app-name" project-name)
         data {:name project-name
               :package package-name


Small tweak for Freese layout

Small tweak for Freese layout

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

--- src/conexp/layouts/freese.clj
+++ src/conexp/layouts/freese.clj
@@ -7,7 +7,8 @@
 ;; You must not remove this notice, or any other, from this software.

 (ns conexp.layouts.freese
-  (:use [conexp.fca.lattices :only (base-set lattice-upper-neighbours)]
+  (:use conexp.base
+        [conexp.fca.lattices :only (base-set lattice-upper-neighbours)]
         [conexp.layouts.util :only (edges)]
         [conexp.layouts.base :only (make-layout)])
   (:import [org.latdraw.diagram Diagram Vertex]))
@@ -29,9 +30,12 @@
     (fn [angle]
       (.project2d diag ^double angle)
       (make-layout lattice
-                   (into {} (for [^Vertex vertex (.getVertices diag)]
-                              [(.getUnderlyingObject (.getUnderlyingElem vertex)),
-                               [(.getProjectedX vertex) (.getProjectedY vertex)]]))
+                   (reduce! (fn [map, ^Vertex vertex]
+                              (assoc! map
+                                      (.. vertex getUnderlyingElem getUnderlyingObject)
+                                      [(.getProjectedX vertex) (.getProjectedY vertex)]))
+                            {}
+                            (.getVertices diag))
                    edges))))

 (defn freese-layout


RDC - Refactored transition board to take a rotate command.

--- src/icfp2015/board.clj
+++ src/icfp2015/board.clj
@@ -63,15 +63,12 @@
 (defn transition-board
   "Given a board and command, returns a new (possibly invalid) board"
   [board [command arg]]
-  (case command
-    :rotate (let [unit-fn (apply unit/rotate (unit/rotations arg))]
-             { :width (:width board)
-               :height (:height board)
-               :filled (:filled board)
-               :current-unit (unit-fn (:current-unit board)) })
-    :move (let [unit-fn (apply unit/translate (unit/translations arg))]
-             { :width (:width board)
-               :height (:height board)
-               :filled (:filled board)
-               :current-unit (unit-fn (:current-unit board)) })
-    :lock (clear-rows (lock-current-unit board))))
+  (if (= command :lock)
+    (clear-rows (lock-current-unit board))
+    (let [unit-fn (case command
+          :rotate (apply unit/rotate (unit/rotations arg))
+          :move (apply unit/translate (unit/translations arg)))]
+      { :width (:width board)
+        :height (:height board)
+        :filled (:filled board)
+        :current-unit (unit-fn (:current-unit board))})))


(maint) fix indentation

(maint) fix indentation

--- src/puppetlabs/trapperkeeper/internal.clj
+++ src/puppetlabs/trapperkeeper/internal.clj
@@ -413,24 +413,24 @@
   (let [;; this is the application context for this app instance.  its keys
         ;; will be the service ids, and values will be maps that represent the
         ;; context for each individual service
-         app-context (atom {})
-         service-refs (atom {})
-         services (conj services
-                        (config-service config-data)
-                        (initialize-shutdown-service! app-context
-                                                      shutdown-reason-promise))
-         service-map (apply merge (map s/service-map services))
-         compiled-graph (compile-graph service-map)
+        app-context (atom {})
+        service-refs (atom {})
+        services (conj services
+                       (config-service config-data)
+                       (initialize-shutdown-service! app-context
+                                                     shutdown-reason-promise))
+        service-map (apply merge (map s/service-map services))
+        compiled-graph (compile-graph service-map)
         ;; this gives us an ordered graph that we can use to call lifecycle
         ;; functions in the correct order later
-         graph (g/->graph service-map)
+        graph (g/->graph service-map)
         ;; when we instantiate the graph, we pass in the context atom.
-         graph-instance (instantiate compiled-graph {:tk-app-context app-context
-                                                     :tk-service-refs service-refs})
+        graph-instance (instantiate compiled-graph {:tk-app-context app-context
+                                                    :tk-service-refs service-refs})
         ;; dereference the atom of service references, since we don't need to update it
         ;; any further
-         services-by-id @service-refs
-         ordered-services (map (fn [[service-id _]] [service-id (services-by-id service-id)]) graph)]
+        services-by-id @service-refs
+        ordered-services (map (fn [[service-id _]] [service-id (services-by-id service-id)]) graph)]
     (swap! app-context assoc :services-by-id services-by-id)
     (swap! app-context assoc :ordered-services ordered-services)
     (doseq [svc-id (keys services-by-id)] (swap! app-context assoc svc-id {}))


CMR-2074 Updates granule spatial validation comment.

--- umm-lib/src/cmr/umm/validation/granule.clj
+++ umm-lib/src/cmr/umm/validation/granule.clj
@@ -63,7 +63,7 @@
         spatial-representation (get-in spatial-coverage [:parent :granule-spatial-representation])]
     (assoc spatial-coverage
            :geometries
-           ;; if the granule spatial representation is nil, then just ignore the geometries
+           ;; If the granule spatial representation is :no-spatial, then just ignore the geometries.
            (when (not= :no-spatial spatial-representation)
              (map #(umm-s/set-coordinate-system spatial-representation %)
                   geometries)))))


after/before: update docs

after/before: update docs

--- src/java_time/core.clj
+++ src/java_time/core.clj
@@ -152,8 +152,8 @@
   (first (sort (cons o os))))

 (defn before?
-  "Returns non-nil if time entities are ordered from the earliest to the latest
-  (same semantics as `<`):
+  "Returns a truthy value if time entities are ordered from the earliest to the
+  latest (same semantics as `<`):

     (before? (local-date 2009) (local-date 2010) (local-date 2011))
     => truthy...
@@ -171,8 +171,8 @@
      false)))

 (defn after?
-  "Returns non-nil if time entities are ordered from the latest to the earliest
-  (same semantics as `>`):
+  "Returns a truthy value if time entities are ordered from the latest to the
+  earliest (same semantics as `>`):

     (after? (local-date 2011) (local-date 2010) (local-date 2009))
     => truthy...


Pulling ssh build list into it's own component.

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -294,6 +294,19 @@
        More information " [:a {:href (routes/v1-doc-subpage {:subpage "ssh-build"})} "in our docs"] "."
      (om/build ssh-buttons build)]])

+(defrender ssh-build-list [nodes owner]
+  (html
+    [:div.build-ssh-list
+     [:dl.dl-horizontal
+      (map (fn [node i]
+             (list
+               [:dt (when (< 1 (count nodes)) [:span (str "container " i " ")])]
+               [:dd {:class (when (:ssh_enabled node) "connected")}
+                [:span (gstring/format "ssh -p %s %s@%s " (:port node) (:username node) (:public_ip_addr node))]
+                (when-not (:ssh_enabled node)
+                  [:span.loading-spinner common/spinner])]))
+           nodes (range))]]))
+
 (defn ssh-instructions
   "Instructions for SSHing into a build that you can SSH into"
   [build owner]
@@ -303,16 +316,7 @@
        [:div.build-ssh-title
         [:p "You can SSH into this build. Use the same SSH public key that you use for GitHub. SSH boxes will stay up for 30 minutes."]
         [:p "This build takes up one of your concurrent builds, so cancel it when you are done."]]
-       [:div.build-ssh-list
-        [:dl.dl-horizontal
-         (map (fn [node i]
-                (list
-                  [:dt (when (< 1 (count nodes)) [:span (str "container " i " ")])]
-                  [:dd {:class (when (:ssh_enabled node) "connected")}
-                   [:span (gstring/format "ssh -p %s %s@%s " (:port node) (:username node) (:public_ip_addr node))]
-                   (when-not (:ssh_enabled node)
-                     [:span.loading-spinner common/spinner])]))
-              nodes (range))]]
+       (om/build ssh-build-list nodes)
        [:div.build-ssh-doc
         "Debugging Selenium browser tests? "
         [:a {:href "/docs/browser-debugging#interact-with-the-browser-over-vnc"}


added history table

added history table

--- src/kmc_booking/db.clj
+++ src/kmc_booking/db.clj
@@ -51,7 +51,7 @@
 	                     (sql/drop-table-ddl table))))

-(defn create-testing-table[]
+(defn create-testing-table! []
 	(sql/db-do-commands CONN
 	                    (sql/create-table-ddl :testing [:data :text]))
 		(sql/insert! CONN
@@ -60,7 +60,7 @@

 ;; seats

-(defn create-seats-table []
+(defn create-seats-table! []
 	(sql/with-db-connection [c CONN]
 		(sql/db-do-commands c
 	                    (sql/create-table-ddl "seats"
@@ -70,7 +70,7 @@
 		(apply sql/insert! c "seats"
 			(gen-seats-data seat-schema))))

-(defn create-bookings-table []
+(defn create-bookings-table! []
 	(sql/with-db-connection [c CONN]
 		(sql/db-do-commands c
 	                    (sql/create-table-ddl "bookings"
@@ -80,37 +80,15 @@
 	                                           [:date :timestamp :default :current_timestamp]))))

-;;;;;;;;;;;;;;;
-;;
-;; migrations
-
-(defn- migrate__reinit_seats![]
+(defn create-history-table! []
 	(sql/with-db-connection [c CONN]
-		(sql/delete! c "seats" ["1 = 1"])
-		(apply sql/insert! c "seats"
-			(gen-seats-data seat-schema))))
-
-
-(defn init-db[]
-	(when-not (migrated? "testing")
-		(create-testing-table))
-
-	(when-not (migrated? "seats")
-		(create-seats-table))
-
-	(when-not (migrated? "bookings")
-		(create-bookings-table))
-
-	(migrate-live! "1_reinit_seats" migrate__reinit_seats!)
-
-)
-
-
-
-
-
-
-
+		(sql/db-do-commands c
+	                    (sql/create-table-ddl "history"
+	                                           [:booking_id "varchar(48)"]
+	                                           [:seat "varchar(10)"]
+	                                           [:status "varchar(20)"]
+	                                           [:date :timestamp :default :current_timestamp]
+	                                           ))))

 ;;;;;;;;;
 ;; DML
@@ -155,6 +133,53 @@
 )

+;;;;;;;;;;;;;;;
+;;
+;; migrations
+
+(defn- migrate__reinit_seats! []
+	(sql/with-db-connection [c CONN]
+		(sql/delete! c "seats" ["1 = 1"])
+		(apply sql/insert! c "seats"
+			(gen-seats-data seat-schema))))
+
+(defn- migrate__seats_for_judges! []
+	(create-booking "ЖУРІ" "-" [])
+	)
+
+
+(defn init-db[]
+	(when-not (migrated? "testing")
+		(create-testing-table!))
+
+	(when-not (migrated? "seats")
+		(create-seats-table!))
+
+	(when-not (migrated? "bookings")
+		(create-bookings-table!))
+
+	(when-not (migrated? "history")
+		(create-history-table!))
+
+	;(try
+	;	...
+	;	(catch Exception e
+	;		(do
+	;			(print (.getNextException e)))))
+
+	(migrate-live! "1_reinit_seats" migrate__reinit_seats!)
+
+	;(migrate-live! "2_seats_for_judges"  migrate__seats_for_judges!)
+
+)

+
+
+
+
+
+
+
+


Added option to omit-default-repositories.

--- src/leiningen/deps.clj
+++ src/leiningen/deps.clj
@@ -34,6 +34,13 @@
     (.setId id)
     (.setUrl url)))

+(defn get-repository-list [project]
+  (concat
+   (if (:omit-default-repositories project)
+     {}
+     default-repos)
+   (:repositories project)))
+
 (defn deps
   "Download and install all :dependencies listed in project.clj into the lib/
 directory. With an argument it will skip development dependencies. Dependencies
@@ -56,8 +63,7 @@
        (.setFilesetId deps-task "dependency.fileset")
        (.setProject deps-task lancet/ant-project)
        (.setPathId deps-task (:name project))
-       (doseq [r (map make-repository (concat default-repos
-                                              (:repositories project)))]
+       (doseq [r (map make-repository (get-repository-list project))]
          (.addConfiguredRemoteRepository deps-task r))
        (doseq [dep (:dependencies project)]
          (.addDependency deps-task (make-dependency dep)))


Remove usage of handler arg in test task.

--- src/leiningen/test.clj
+++ src/leiningen/test.clj
@@ -5,11 +5,6 @@
         [leiningen.util.ns :only [namespaces-in-dir]]
         [leiningen.compile :only [eval-in-project]])
   (:import [java.io File]))
-
-(defn- init-args [java & files]
-  (doseq [f files]
-    (.setValue (.createArg java) "-i")
-    (.setValue (.createArg java) f)))

 (defn- form-for-hook-selectors [selectors]
   `(when (seq ~selectors)
@@ -57,10 +52,9 @@
       (throw (Exception. "Args must be either all namespaces or keywords.")))
     (eval-in-project project (form-for-testing-namespaces
                               nses (.getAbsolutePath result) (vec selectors))
-                     #(apply init-args %
-                             (if (seq selectors)
-                               ["@clojure/test.clj" "@robert/hooke.clj"]
-                               ["@clojure/test.clj"])))
+                     nil nil `(do (require '~'clojure.test)
+                                  ~(when (seq selectors)
+                                     '(require 'robert.hooke))))
     (if (and (.exists result) (pos? (.length result)))
       (let [summary (read-string (slurp (.getAbsolutePath result)))
             success? (zero? (+ (:error summary) (:fail summary)))]


Fix 'contains-sha? to use :ok-statuses

Fix 'contains-sha? to use :ok-statuses

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -106,7 +106,7 @@
 (defn contains-sha? [d sha]
   (prn "contains-sha?" d sha)
   (->>
-   (git {:gitdir d} "rev-parse" "--verify" "--quiet" sha)
+   (git {:gitdir d :ok-statuses #{0 1}} "rev-parse" "--verify" "--quiet" sha)
    :exit
    zero?))


give possibility to call publish-events directly

--- clients/clojure/src/samsara/client.clj
+++ clients/clojure/src/samsara/client.clj
@@ -111,11 +111,11 @@
     e))

-(defn- send-events [events]
+(defn- send-events [{:keys [url send-timeout-ms]} events]
   "Send events to samsara api"
   (let [{:keys [status error] :as resp}
-        @(http/post (str (:url *config*) "/events")
-                    {:timeout (:send-timeout-ms *config*)
+        @(http/post (str url "/events")
+                    {:timeout send-timeout-ms
                      :headers {"Content-Type" "application/json"
                                "X-Samsara-publishedTimestamp" (str (System/currentTimeMillis))}
                      :body (to-json events)})]
@@ -129,10 +129,15 @@
       (throw (RuntimeException. (str "PublishFailed with status=" status))))))

-(defn publish-events [events]
+(defn publish-events
   "Takes a vector containing events and publishes to samsara immediately."
-  (validate-event events)
-  (send-events events))
+  ([events]
+   (publish-events (merge DEFAULT-CONFIG *config*) events))
+  ([url events & {:as opts}]
+   (validate-event events)
+   (send-events
+    (merge DEFAULT-CONFIG opts {:url url})
+    events)))

 (defn- flush-buffer []


replace dorun/for with doseq

replace dorun/for with doseq

--- src/tile_game/core.clj
+++ src/tile_game/core.clj
@@ -33,8 +33,8 @@
         #^JFrame frame (JFrame.)
         #^JPanel panel (proxy [JPanel] []
                          (paint [g]
-                                (dorun (for [x (range dim) y (range dim)]
-                                         (render-tile g @*board* [x y])))))
+                           (doseq [x (range dim) y (range dim)]
+                             (render-tile g @*board* [x y]))))
         slide! (fn [& moves]
                  (prn :slide! moves)
                  (send (agent moves)


added padding to the slider

added padding to the slider

--- src/nn/views/css.clj
+++ src/nn/views/css.clj
@@ -54,6 +54,8 @@

                     [(keyword "input[type='range']")
                      {:-webkit-appearance "none !important"
+                      :padding "5px"
+                      :margin "5px"
                       :background-color "#FF0DFF"
                       :outline "none"}
                      ]
@@ -61,7 +63,8 @@
                     [(keyword "input[type='range']::-webkit-slider-thumb")
                      {:-webkit-appearance "none !important"
                       :border-radius "10px"
-                      :background-color "white"
+                      :background-color "#FFF"
+                      :background-image "-webkit-gradient(linear, left top, left bottom, from(#FFFFFF), to(#39FFE))"
                       :height "44px"
                       :width "44px"}
                      ]


Rect utils

Rect utils

--- src/flatgui/util/rectmath.clj
+++ src/flatgui/util/rectmath.clj
@@ -85,35 +85,52 @@
         (< (:y a) (:y b)) (> (:h a) (:h b)))
     a))

-(defn rect+ [a b]
-  (cond
-    (fully-contains? a b)
-    a
-    (fully-contains? b a)
-    b
-    :else
-    (let [h-inter (line& (:x a) (+ (:x a) (:w a)) (:x b) (+ (:x b) (:w b)))
-          v-inter (line& (:y a) (+ (:y a) (:h a)) (:y b) (+ (:y b) (:h b)))
-          v-edge (and (nil? v-inter) (or
-                                       (= (:y b) (+ (:y a) (:h a)))
-                                       (= (:y a) (+ (:y b) (:h b)))))]
-      (if (and h-inter (or v-inter v-edge))
-        {:x (first h-inter)
-         :y (min (:y a) (:y b))
-         :w (- (nth h-inter 1) (nth h-inter 0))
-         :h (if v-edge
-              (+ (:h a) (:h b))
-              (- (+ (:h a) (:h b)) (- (nth v-inter 1) (nth v-inter 0))))}
-        (let [h-edge (and (nil? h-inter) (or
-                                           (= (:x b) (+ (:x a) (:w a)))
-                                           (= (:x a) (+ (:x b) (:w b)))))]
-          (if (and v-inter (or h-inter h-edge))
-            {:x (min (:x a) (:x b))
-             :y (nth v-inter 0)
-             :w (if h-edge
-                  (+ (:w a) (:w b))
-                  (- (+ (:w a) (:w b)) (- (nth h-inter 1) (nth h-inter 0))))
-             :h (- (nth v-inter 1) (nth v-inter 0))}))))))
+(defn rect+
+  ([a b]
+   (cond
+     (fully-contains? a b)
+     a
+     (fully-contains? b a)
+     b
+     :else
+     (let [h-inter (line& (:x a) (+ (:x a) (:w a)) (:x b) (+ (:x b) (:w b)))
+           v-inter (line& (:y a) (+ (:y a) (:h a)) (:y b) (+ (:y b) (:h b)))
+           v-edge (and (nil? v-inter) (or
+                                        (= (:y b) (+ (:y a) (:h a)))
+                                        (= (:y a) (+ (:y b) (:h b)))))]
+       (if (and h-inter (or v-inter v-edge))
+         {:x (first h-inter)
+          :y (min (:y a) (:y b))
+          :w (- (nth h-inter 1) (nth h-inter 0))
+          :h (if v-edge
+               (+ (:h a) (:h b))
+               (- (+ (:h a) (:h b)) (- (nth v-inter 1) (nth v-inter 0))))}
+         (let [h-edge (and (nil? h-inter) (or
+                                            (= (:x b) (+ (:x a) (:w a)))
+                                            (= (:x a) (+ (:x b) (:w b)))))]
+           (if (and v-inter (or h-inter h-edge))
+             {:x (min (:x a) (:x b))
+              :y (nth v-inter 0)
+              :w (if h-edge
+                   (+ (:w a) (:w b))
+                   (- (+ (:w a) (:w b)) (- (nth h-inter 1) (nth h-inter 0))))
+              :h (- (nth v-inter 1) (nth v-inter 0))}))))))
+  ([a] a)
+  ([] {:x 0 :y 0 :w 0 :h 0}))
+
+(defn rect|
+  ([a b]
+    (let [x2a (+ (:x a) (:w a))
+          y2a (+ (:y a) (:h a))
+          x2b (+ (:x b) (:w b))
+          y2b (+ (:y b) (:h b))
+          x1 (min (:x a) (:x b))
+          y1 (min (:y a) (:y b))
+          x2 (max x2a x2b)
+          y2 (max y2a y2b)]
+      {:x x1 :y y1 :w (- x2 x1) :h (- y2 y1)}))
+  ([a] a)
+  ([] {:x 0 :y 0 :w 0 :h 0}))

 (defn square [a]
   (if a


Remove incorrect (outdated) information in docstring.

--- src/overtone/gui/scope.clj
+++ src/overtone/gui/scope.clj
@@ -46,12 +46,7 @@
     (throw (Exception. (str "Sorry, it's only possible to use scopes with an internal server. Your server connection info is as follows: " (connection-info))))))

 (defn- update-scope-data
-  "Updates the scope by reading the current status of the buffer and repainting.
-  Currently only updates bus scope as there's a bug in scsynth-jna which
-  crashes the server after too many calls to buffer-data for a large
-  buffer. As buffers tend to be large, updating the scope frequently
-  will cause the crash to happen sooner. Need to remove this limitation
-  when scsynth-jna is fixed."
+  "Updates the scope by reading the current status of the buffer and repainting."
   [s]

   (let [{:keys [buf size width height panel y-arrays x-array panel]} s


no need to sync b_getn - also update buffer-read docstring

--- src/overtone/sc/buffer.clj
+++ src/overtone/sc/buffer.clj
@@ -63,8 +63,8 @@
   "Read a section of an audio buffer. Defaults to reading the full buffer if no
   start and len vals are specified. Returns a float array of vals.

-  For more efficient reading of buffer data with the internal server, see
-  buffer-data."
+  This is extremely slow for large portions of data. For more efficient reading
+  of buffer data with the internal server, see buffer-data."
   ([buf] (buffer-read buf 0 (:size buf)))
   ([buf start len]
      (assert (buffer? buf))
@@ -81,7 +81,7 @@
                                           (and (= msg-buf-id buf-id)
                                                (= msg-start offset)
                                                (= n-to-read (count m-args))))))]
-             (with-server-sync #(snd "/b_getn" buf-id offset n-to-read))
+             (snd "/b_getn" buf-id offset n-to-read)
              (let [m (deref! prom)
                    [buf-id bstart blen & samps] (:args m)]
                (dorun


Squishing references to vars in config

Squishing references to vars in config

--- src/frereth_server/system.clj
+++ src/frereth_server/system.clj
@@ -147,11 +147,13 @@

     (when-let [ctx @(:network-context universe)]
       (try
-        (let [auth-killer (mq/socket ctx mq/req)]
-          (mq/connect auth-killer (format "tcp://127.0.0.1:%d" config/auth-port))
-          (mq/send auth-killer "dieDieDIE!!")
-          ;; Wait for a response.
-          (mq/recv-str auth-killer))
+        (let [auth-killer (mq/socket ctx (mq/const :req))]
+          (when-let [ports (:ports universe)]
+            ;; Now we can start killing off the interesting shit
+            (mq/connect auth-killer (format "tcp://127.0.0.1:%d" (ports :auth)))
+            (mq/send auth-killer "dieDieDIE!!")
+            ;; Wait for a response.
+            (mq/recv-str auth-killer)))
         (when-let [sock (:clients universe)]
           (.close sock))
         (when-let [sock (:master-connection universe)]


Removed junk code.

Removed junk code.

--- src/grafter/rdf/protocols.clj
+++ src/grafter/rdf/protocols.clj
@@ -73,14 +73,6 @@
   (nth [this ^int i default]
     (destructure-quad this i default)))

-(defrecord Bar [s p o c]
-  clojure.lang.Indexed
-  (nth [this ^int i]
-    )
-
-  (nth [this ^int i default]
-    ))
-
 (extend-type clojure.lang.IPersistentVector
   IStatement
   (subject [this]


Fix idle config schema.

Fix idle config schema.

--- src/onyx/schema.cljc
+++ src/onyx/schema.cljc
@@ -626,8 +626,8 @@
    (s/optional-key :onyx.peer/coordinator-snapshot-every-n-barriers) PosInt
    (s/optional-key :onyx.peer/coordinator-max-sleep-ms) PosInt
    (s/optional-key :onyx.peer/coordinator-barrier-period-ms) PosInt
-   (s/optional-key :onyx.peer/min-idle-sleep-ns) PosInt
-   (s/optional-key :onyx.peer/max-idle-sleep-ns) PosInt
+   (s/optional-key :onyx.peer/idle-min-sleep-ns) PosInt
+   (s/optional-key :onyx.peer/idle-max-sleep-ns) PosInt
    (s/optional-key :onyx.peer/heartbeat-ms) PosInt
    (s/optional-key :onyx.peer/stop-task-timeout-ms) s/Int
    (s/optional-key :onyx.peer/inbox-capacity) s/Int


Rename routes to /multi

Rename routes to /multi

--- src/poky/protocol/http.clj
+++ src/poky/protocol/http.clj
@@ -156,7 +156,7 @@
   (GET "/" []
        (response "ok")))

-;; ======== QUERY
+;; ======== MULTI

 (defn- multi-get
   [kvstore b body]
@@ -166,7 +166,7 @@
         params (map cast-ts body)]
     (kv/mget* kvstore b nil params)))

-(defn query-routes
+(defn multi-routes
   [kvstore]
   (routes
     (POST ["/:b" :b valid-key-regex]
@@ -193,7 +193,7 @@
   [kvstore]
   (let [api-routes (routes
                      (context "/kv" [] (kv-routes kvstore))
-                     (context "/query" [] (query-routes kvstore))
+                     (context "/multi" [] (multi-routes kvstore))
                      (context "/status" [] status-routes)
                      (context "*" [] fall-back-routes))]
     (-> (handler/api api-routes)


More correct simulation, mapping better onto LLHA semantics. Remove :d stuff, it was hacky.

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -15,19 +15,19 @@
 (defn reload! [_]
   (reset-scene-a!))

-(defn quantize [v u]
-  (* u (.floor js/Math (/ v u))))
-
-(defn floor-time [t d]
-  (quantize t d))
-
-(defn ceil-time [t d]
-  (* d (.ceil js/Math (/ t d))))
-
 (def frame-length (/ 1 30))
-(def time-units-per-frame 8)
+(def time-units-per-frame 100)
 (def time-unit (/ frame-length time-units-per-frame))
 (def precision 0.25)
+
+(defn quantize [v u]
+  (* u (.round js/Math (/ v u))))
+
+(defn floor-time [t d]
+  (* d (.floor js/Math (/ (+ t (/ d 10.0)) d))))
+
+(defn ceil-time [t d]
+  (* d (.ceil js/Math (/ (- t (/ time-unit 10.0)) d))))

 (defn simple? [i]
   (if-let [[imin imax] i]
@@ -182,7 +182,6 @@
   (let [rel (first simple-guard)
         c (constant-from-expr has ha (last simple-guard))
         ;_ (println "Constant" (last simple-guard) "is" c)
-        ;_ (println ":d :x is" (constant-from-expr has ha [:d :x]))
         v1k (second simple-guard)
         v2k (if (= (count simple-guard) 4) (third simple-guard) nil)
         [v10 v1f] (get-var-and-flow has ha v1k)
@@ -213,26 +212,27 @@
             "V1 must be a valid variable reference")
     (assert (not (nil? v20))
             "V2 must be a valid variable reference")
-    (cond
-      ;if RHS is +-infinity, then the guard will never flip truth value.
-      ;that said, we need to set the minimum actuation time to be min-t.
-      (or (= rhs Infinity)
-          (= rhs -Infinity)) (if sat
-                               [min-t Infinity]
-                               [Infinity Infinity])
-      ; if t is bounded from above by a number less than time-unit, return an interval which will become empty during intersection
-      (and (< rhs min-t)
-           (#{:lt :leq} rel)) [-Infinity rhs]
-      ; being bounded from below by a number less than time-unit is no problem. all intervals are open.
-      :else (case rel
-              ;  < : t  < rhs --> guard is true until t exceeds rhs
-              :lt [min-t (- rhs (/ time-unit 16))]
-              ; <= : t <= rhs --> guard is true until t exceeds or equals rhs
-              :leq [min-t rhs]
-              ; >= : t >= rhs --> guard becomes true once t exceeds or equals rhs
-              :geq [(.max js/Math rhs min-t) Infinity]
-              ;  > : t  > rhs --> guard becomes true once t exceeds rhs
-              :gt [(.max js/Math (+ rhs (/ time-unit 16)) min-t) Infinity]))))
+    (constrain-times
+      (cond
+        ;if RHS is +-infinity, then the guard will never flip truth value.
+        ;that said, we need to set the minimum actuation time to be min-t.
+        (or (= rhs Infinity)
+            (= rhs -Infinity)) (if sat
+                                 [min-t Infinity]
+                                 [Infinity Infinity])
+        ; if t is bounded from above by a number less than time-unit, return an interval which will become empty during intersection
+        (and (< rhs min-t)
+             (#{:lt :leq} rel)) [-Infinity rhs]
+        ; being bounded from below by a number less than time-unit is no problem. all intervals are open.
+        :else (case rel
+                ;  < : t  < rhs --> guard is true until t exceeds rhs
+                :lt [min-t (- rhs (/ time-unit 16))]
+                ; <= : t <= rhs --> guard is true until t exceeds or equals rhs
+                :leq [min-t rhs]
+                ; >= : t >= rhs --> guard becomes true once t exceeds or equals rhs
+                :geq [(.max js/Math rhs min-t) Infinity]
+                ;  > : t  > rhs --> guard becomes true once t exceeds rhs
+                :gt [(.max js/Math (+ rhs (/ time-unit 16)) min-t) Infinity])))))

 (defn guard-interval [has ha g]
   (case (first g)
@@ -248,7 +248,7 @@

 (defn transition-interval [has ha transition]
   #_(println "Transition" (:id ha) "et" (:entry-time ha) (:target transition) (:guard transition))
-  (let [interval (constrain-times (merge-overlapping (guard-interval has ha (:guard transition))))]
+  (let [interval (merge-overlapping (guard-interval has ha (:guard transition)))]
     #_(println "interval:" interval)
     ; TODO: handle cases where transition is also guarded on states
     {:interval   interval
@@ -276,7 +276,7 @@
                      transitions))))

 (defn enter-state [has ha state now]
-  #_(println "enter state" (keys has) (:id ha) [(:x ha) (:y ha)] (:state ha) "->" state now)
+  ;(println "enter state" (keys has) (:id ha) [(:x ha) (:y ha)] (:state ha) "->" state now)
   (let [now (floor-time now time-unit)
         _ (assert (>= now (:entry-time ha)) "Time must be monotonic")
         ; set the current state to this state
@@ -384,13 +384,8 @@
     ; catch guards
     (and (vector? guard-term)
          (#{:gt :geq :leq :lt :and :or} (first guard-term))) (mapcat term-dependencies (rest guard-term))
-    ; catch [:d ID v]
-    (and (vector? guard-term)
-         (= (first guard-term) :d)
-         (= 3 (count guard-term))) [(second guard-term)]
     ; catch [ID v]
     (and (vector? guard-term)
-         (not= (first guard-term) :d)
          (= 2 (count guard-term))) [(first guard-term)]
     ; must be (+-*/ ...)
     (and (not (vector? guard-term))
@@ -467,37 +462,41 @@

 (defn moving-inc-c [vbl width limit]
   [:and
-   [:lt vbl (- limit width)]
-   [:geq vbl (list '- limit width [:d vbl])]])
+   [:lt vbl limit]
+   [:geq vbl (list '- limit width)]])

 (defn moving-dec-c [vbl limit]
   [:and
-   [:gt vbl limit]
-   [:leq vbl (list '- limit [:d vbl])]])
+   [:gt vbl (list '- limit 16)]
+   [:leq vbl limit]])

 (defn moving-inc [vbl width other-ha]
   [:and
-   [:lt vbl [other-ha vbl] (- width)]
-   [:geq vbl [other-ha vbl] (list '- [:d other-ha vbl] [:d vbl] width)]])
+   [:lt vbl [other-ha vbl] (+ (- width) 16)]
+   [:geq vbl [other-ha vbl] (- width)]])

 (defn moving-dec [vbl width other-ha]
   [:and
-   [:gt vbl [other-ha vbl] width]
-   [:leq vbl [other-ha vbl] (list '+ [:d other-ha vbl] width (list '- [:d vbl]))]])
+   ; vbl > o.vbl
+   ; vbl - o.vbl > 0
+   [:gt vbl [other-ha vbl] 0]
+   ; vbl <= o.vbl + ow
+   ; vbl - o.vbl <= ow
+   [:leq vbl [other-ha vbl] width]])

 (defn between-c [vbl min max]
   [:and
-   ; vbl+dvbl >= min --> vbl >= min - dvbl
-   [:geq vbl (list '- min [:d vbl])]
-   ; vbl+dvbl < max --> vbl < max - dvbl
-   [:lt vbl (list '- max [:d vbl])]])
+   ; vbl >= min --> vbl >= min
+   [:gt vbl min]
+   ; vbl <= max --> vbl <= max
+   [:lt vbl max]])

 (defn between [vbl dim other-ha other-dim]
-  ; vbl+dvbl >= other-ha.vbl + other-ha.dvbl - dim && vbl+dvbl < other-ha.vbl+other-ha.dvbl + other-dim
-  ; vbl - other-ha.vbl >= other-ha.dvbl - dvbl - dim && vbl - other-ha.vbl < other-ha.dvbl + other-dim - dvbl
+  ; vbl  >= other-ha.vbl - dim && vbl < other-ha.vbl + other-dim
+  ; vbl - other-ha.vbl >= - dim && vbl - other-ha.vbl < other-dim
   [:and
-   [:geq vbl [other-ha vbl] (list '- [:d other-ha vbl] [:d vbl] dim)]
-   [:lt vbl [other-ha vbl] (list '+ [:d other-ha vbl] other-dim (list '- [:d vbl]))]])
+   [:gt vbl [other-ha vbl] (list '- dim)]
+   [:lt vbl [other-ha vbl] other-dim]])

 (defn bumping-guard [dir other]
   (let [main-vbl (case dir (:left :right) :x (:top :bottom) :y)
@@ -524,17 +523,24 @@
       [:and (moving-dec main-vbl dim other) (between sub-vbl sub-dim other sub-odim)])))

 (defn bumping-transitions
-  ([id dir next-state walls other-has]
+  ([id dir next-state extra-guard walls other-has]
    (map (fn [other]
-          (let [guard (bumping-guard dir other)]
+          (let [bump-guard (bumping-guard dir other)
+                guard (if extra-guard
+                        [:and bump-guard extra-guard]
+                        bump-guard)]
             (println "make" id next-state dir other)
             (make-edge next-state guard #{:required [:this id] [:other other]})))
         (concat walls other-has)))
-  ([id dir1 dir2 next-state walls other-has]
+  ([id dir1 dir2 next-state extra-guard walls other-has]
    (mapcat (fn [o1 o2]
              (if (= o1 o2)
                []
-               (let [guard [:and (bumping-guard dir1 o1) (bumping-guard dir2 o2)]]
+               (let [b1 (bumping-guard dir1 o1)
+                     b2 (bumping-guard dir2 o2)
+                     guard (if extra-guard
+                             [:and b1 b2 extra-guard]
+                             [:and b1 b2])]
                  [(make-edge next-state guard #{:required [:this id] [:other o1] [:other o2]})])))
            (concat walls other-has)
            (concat walls other-has))))
@@ -550,12 +556,12 @@
                       [:or
                        ; position.x + width < other.x
                        ; i.e. x+w < ox i.e. x - ox < - w
-                       [:leq :x [other :x] (list '- w)]
+                       [:leq :x [other :x] (- w)]
                        ; position.x is > other.x + other.w
                        ; i.e. x > ox+ow i.e. x - ox > ow
                        [:geq :x [other :x] ow]
                        ; position.y + height is < other.y
-                       [:leq :y [other :y] (list '- h)]
+                       [:leq :y [other :y] (- h)]
                        ; position.y is > other.y + other.h
                        [:gt :y [other :y] oh]])
                     (let [[ox oy ow oh] other]
@@ -570,40 +576,11 @@
                        [:leq :y (- oy h)]
                        ; position.y is > other.y + other.h
                        [:gt :y (+ oy oh)]])))
-                (concat walls others))
-           ; and will be unsupported next tick
-           (map (fn [other]
-                  (if (keyword? other)
-                    (let [ow w
-                          oh h]
-                      [:or
-                       ; new position.x + width < other.x'
-                       ; i.e. x+dx+w < ox+odx i.e. x - ox < odx - w - dx
-                       [:leq :x [other :x] (list '- [:d other :x] w [:d :x])]
-                       ; new position.x is > other.x' + other.w
-                       ; i.e. x+dx > ox+odx+ow i.e. x - ox > odx + ow - dx
-                       [:geq :x [other :x] (list '+ [:d other :x] ow (list '- [:d :x]))]
-                       ; new position.y + height is < other.y'
-                       [:leq :y [other :y] (list '- [:d other :y] h [:d :y])]
-                       ; new position.y is > other.y' + other.h
-                       [:gt :y [other :y] (list '+ [:d other :y] oh (list '- [:d :y]))]])
-                    (let [[ox oy ow oh] other]
-                      [:or
-                       ; new position.x + width < other.x
-                       ; i.e. x+dx+w < ox i.e. x < ox - w - dx
-                       [:leq :x (list '- ox w [:d :x])]
-                       ; new position.x is > other.x + other.w
-                       ; i.e. x+dx > ox+ow i.e. x > ox+ow-dx
-                       [:geq :x (list '+ ox ow (list '- [:d :x]))]
-                       ; new position.y + height is < other.y
-                       [:leq :y (list '- oy h [:d :y])]
-                       ; new position.y is > other.y + other.h
-                       [:gt :y (list '+ oy oh (list '- [:d :y]))]])))
                 (concat walls others)))))

 (defn goomba [id x y speed state others walls]
   (let [others (disj others id)
-        fall-speed 8]
+        fall-speed 16]
     (make-ha id                                             ;id
              {:x     x :y y                                 ;init
               :w     16 :h 16
@@ -612,7 +589,7 @@
                :right                                       ;name
                {:x speed}                                   ;flows
                ;edges
-               (bumping-transitions id :left :left walls others)
+               (bumping-transitions id :left :left nil walls others)
                ; If nobody is under my new position, enter falling-right
                (make-edge
                  :falling-right
@@ -623,7 +600,7 @@
                :left                                        ;name
                {:x (- speed)}                               ;flows
                ;edges
-               (bumping-transitions id :right :right walls others)
+               (bumping-transitions id :right :right nil walls others)
                (make-edge
                  :falling-left
                  (unsupported-guard 16 16 walls others)
@@ -632,15 +609,15 @@
              (make-state
                :falling-right
                {:x speed :y (- fall-speed)}
-               (bumping-transitions id :left :top :left walls others)
-               (bumping-transitions id :left :falling-left walls others)
-               (bumping-transitions id :top :right walls others))
+               (bumping-transitions id :left :top :left nil walls others)
+               (bumping-transitions id :left :falling-left (unsupported-guard 16 16 walls others) walls others)
+               (bumping-transitions id :top :right nil walls others))
              (make-state
                :falling-left
                {:x (- speed) :y (- fall-speed)}
-               (bumping-transitions id :right :top :right walls others)
-               (bumping-transitions id :right :falling-right walls others)
-               (bumping-transitions id :top :left walls others)))))
+               (bumping-transitions id :right :top :right nil walls others)
+               (bumping-transitions id :right :falling-right (unsupported-guard 16 16 walls others) walls others)
+               (bumping-transitions id :top :left nil walls others)))))

 (defn make-scene-a [x] (let [ids #{:ga :gb :gc :gd :ge}
                              walls #{[0 0 164 8]
@@ -649,9 +626,9 @@
                                      [160 8 8 16]
                                      ;todo: a "waterfall staircase" for goomba fall testing.
                                      }
-                             objects [(goomba :ga x 8 16 :right ids walls)
+                             objects [(goomba :ga x 32 16 :right ids walls)
                                       (goomba :gb (+ x 18) 8 16 :left ids walls)
-                                      (goomba :gc (+ x 38) 8 16 :right ids walls)
+                                      (goomba :gc (+ x 38) 32 16 :right ids walls)
                                       (goomba :gd (+ x 58) 8 16 :left ids walls)
                                       (goomba :ge (+ x 88) 32 16 :right ids walls)
                                       ; TODO: goomba falling off of platforms. add a "staircase" to the right.
@@ -747,7 +724,7 @@
              (ha-states @scene))
            scene-a)

-(def show-transition-thresholds true)
+(def show-transition-thresholds false)

 (defn scene-widget [scene _owner]
   (let [scale 2


added some thoughts on dispatch-central

added some thoughts on dispatch-central

--- src/prais2/main.cljs
+++ src/prais2/main.cljs
@@ -105,11 +105,28 @@

     )
-
   )

 (dispatcher)

+(comment
+  (defn dispatch
+    "listen on a published event feed, handling events with the given key"
+    [event-feed event-key handle]
+    (let [in-chan (chan)]
+      (sub event-feed event-key in-chan)
+      (go-loop []
+        (let [event (<! in-chan)]
+          (handle event))
+        (recur)))
+    )
+
+  (defn dispatch-central
+    "centralised dispatch of all events"
+    []
+    (dispatch event-bus-pub :slider-axis-value
+              (fn [[key value]] (swap! core/app #(assoc % key value))))
+    ))

 ;;
 ;; optionally do something on app reload


update all Dockerrun.aws.json under eb/ when releasing containers

--- src/wb_es/eb_setup.clj
+++ src/wb_es/eb_setup.clj
@@ -8,9 +8,8 @@
                             (fn [[_ group1]]
                               (format "%s:%s" group1 tag)))))

-(defn update-eb-json! []
+(defn update-eb-json! [eb-json-path]
   (let [version (System/getProperty "wb-es.version")
-        eb-json-path "Dockerrun.aws.json"
         eb-json-str (slurp eb-json-path)]
     (->> eb-json-str
          (replace-image-tag "357210185381.dkr.ecr.us-east-1.amazonaws.com/wormbase/aws-elasticsearch" version)
@@ -18,7 +17,15 @@
          (spit eb-json-path))
     ))

+(defn find-eb-json [path]
+  (->> (clojure.java.io/file path)
+       (file-seq)
+       (filter #(= "Dockerrun.aws.json" (.getName %)))
+       (map #(.getAbsoluteFile %))))
+
 (defn -main
   "I don't do a whole lot ... yet."
   [& args]
-  (update-eb-json!))
+  (let [eb-json-paths (find-eb-json "./eb")]
+    (doseq [eb-json-path eb-json-paths]
+      (update-eb-json! eb-json-path))))


Start user-auth module in 'checking...' state

--- src/braid/client/gateway/user_auth/subs.cljs
+++ src/braid/client/gateway/user_auth/subs.cljs
@@ -12,6 +12,7 @@
   :gateway.user-auth/user-auth-mode
   (fn [state _]
     (cond
+      (nil? (get-in state [:user-auth])) :checking
       (get-in state [:user-auth :checking?]) :checking
       (get-in state [:user-auth :user]) :authed
       (get-in state [:user-auth :oauth-provider]) :oauth-in-progress


debug logging in supervisor

debug logging in supervisor

--- src/clj/backtype/storm/daemon/supervisor.clj
+++ src/clj/backtype/storm/daemon/supervisor.clj
@@ -105,7 +105,7 @@
                            :timed-out
                          true
                            :valid)]
-              (log-debug "Worker " id " is " state ": " hb)
+              (log-debug "Worker " id " is " state ": " hb " at supervisor time-secs " now)
               [id [state hb]]
               ))
      )))


Made a few fns in input-time public to avoid compiler warnings with the latest cljs as the tests use them

--- src/re_com/input_time.cljs
+++ src/re_com/input_time.cljs
@@ -47,7 +47,7 @@
        (filter (comp not nil?))))                           ;; of the 9 items, there should be only 3 non-nil matches coresponding to  H : M

-(defn- text->time
+(defn text->time
   "return as a time int, the contents of 'text'"
   [text]
   (->> text
@@ -56,14 +56,14 @@
        triple->time))                                       ;; turn the triple of values into a single int

-(defn- time->text
+(defn time->text
   "return a string of format HH:MM for 'time'"
   [time]
   (let [hrs  (time->hrs  time)
         mins (time->mins time)]
     (str (pad-zero-number hrs 2) ":" (pad-zero-number mins 2))))

-(defn- valid-text?
+(defn valid-text?
   "Return true if text passes basic time validation.
    Can't do to much validation because user input might not be finished.
    Why?  On the way to entering 6:30, you must pass through the invalid state of '63'.
@@ -71,7 +71,7 @@
   [text]
   (= 3 (count (extract-triple-from-text text))))

-(defn- valid-time?
+(defn valid-time?
   [time]
   (cond
     (nil? time) false                                       ;; can't be nil


Fixes #127 (was trying to send  two return values...doh)

--- src/re_demo/dropdowns.cljs
+++ src/re_demo/dropdowns.cljs
@@ -107,8 +107,10 @@

 (defn demo1
   []
-  [p "The dropdown above is the simple case."]
-  [p "It presents a list of choices and allows one to be selected, via mouse or keyboard."])
+  [v-box
+   :gap "10px"
+   :children [[p "The dropdown above is the simple case."]
+              [p "It presents a list of choices and allows one to be selected, via mouse or keyboard."]]])

 (defn demo2


Improve comment

Improve comment

--- src/re_com/text.cljs
+++ src/re_com/text.cljs
@@ -56,7 +56,7 @@
 ;(def title-args (extract-arg-data title-args-desc))

 (defn title
-  "A title with four preset styles"
+  "A title with four preset levels"
   [& {:keys [label level underline? margin-top margin-bottom class style attr]
       :or   {margin-top "0.4em" margin-bottom "0.1em"}
       :as   args}]


Add jetpack to madlib

Add jetpack to madlib

--- src/robinson/startgame.clj
+++ src/robinson/startgame.clj
@@ -26,7 +26,7 @@
     inventory-with-hotkeys))

 (defn start-text []
-  (let [mode-of-transport (dg/rand-nth ["boat" "airplane" "train" "blimp" "hovercraft" "bicycle"
+  (let [mode-of-transport (dg/rand-nth ["boat" "airplane" "train" "blimp" "jetpack" "hovercraft" "bicycle"
                                         "sailboat" "steamboat" "barge" "oceanliner" "ferry" "helicopter"
                                         "biplane"])
         natural-disaster  (dg/rand-nth ["hurricane" "tornado" "dark storm" "cyclone" "squall"])]


Formatting change

Formatting change

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -50,12 +50,12 @@
   "Identifies each path parameter and adds a value for it to the swagger-object at the path defined by params-key."
   [swagger-options swagger-object routing-entry params-key]
   (let [path-ids (->> routing-entry :path (filter keyword?))
-        reducer (fn [so path-id]
-                  (update-in so params-key
-                             conj {:name     path-id
-                                   :type     :string        ; may add something later to refine this
-                                   :in       :path
-                                   :required true}))]
+        reducer  (fn [so path-id]
+                   (update-in so params-key
+                              conj {:name     path-id
+                                    :type     :string       ; may add something later to refine this
+                                    :in       :path
+                                    :required true}))]
     (reduce reducer swagger-object path-ids)))

 (defn analyze-schema-key
@@ -198,8 +198,8 @@
                                      [:properties k])]
                           [acc-so' (cond-> (assoc-in acc-schema path swagger-schema)
                                            required? (update-in [:required] conj k))])))))
-        base (remove-nil-vals {:description (or (-> schema meta :description)
-                                                (-> schema meta :doc))})]
+        base    (remove-nil-vals {:description (or (-> schema meta :description)
+                                                   (-> schema meta :doc))})]
     (reduce reducer [swagger-object base] schema)))

 ;; Can we merge simple->swagger-schema and ->swagger-schema?
@@ -269,18 +269,18 @@
   "Uses the :responses metadata to identify possible responses."
   [swagger-options swagger-object routing-entry paths-key]
   (let [responses (-> routing-entry :meta :responses)
-        reducer (fn [so [status-code schema]]
-                  (t/track
-                    #(format "Describing %d response." status-code)
-                    (let [schema-meta (meta schema)
-                          description (or (:description schema-meta)
-                                          (:doc schema-meta)
-                                          ;; description is required in the Response Object, so we need some default here.
-                                          "Documentation not provided.")
-                          [so' schema-reference] (->swagger-schema swagger-options so schema)
-                          response (remove-nil-vals {:description description
-                                                     :schema      schema-reference})]
-                      (assoc-in so' (concat paths-key [:responses status-code]) response))))]
+        reducer   (fn [so [status-code schema]]
+                    (t/track
+                      #(format "Describing %d response." status-code)
+                      (let [schema-meta (meta schema)
+                            description (or (:description schema-meta)
+                                            (:doc schema-meta)
+                                            ;; description is required in the Response Object, so we need some default here.
+                                            "Documentation not provided.")
+                            [so' schema-reference] (->swagger-schema swagger-options so schema)
+                            response    (remove-nil-vals {:description description
+                                                          :schema      schema-reference})]
+                        (assoc-in so' (concat paths-key [:responses status-code]) response))))]
     (reduce reducer swagger-object responses)))

 (defn default-path-item-object-injector
@@ -291,21 +291,21 @@
   Returns the modified swagger-object."
   [swagger-options swagger-object routing-entry paths-key]
   (let [{endpoint-meta :meta} routing-entry
-        swagger-meta (:swagger endpoint-meta)
-        description (or (:description swagger-meta)
-                        (:doc endpoint-meta))
-        summary (:summary swagger-meta)
-        path-params-injector (:path-params-injector swagger-options)
+        swagger-meta          (:swagger endpoint-meta)
+        description           (or (:description swagger-meta)
+                                  (:doc endpoint-meta))
+        summary               (:summary swagger-meta)
+        path-params-injector  (:path-params-injector swagger-options)
         query-params-injector (:query-params-injector swagger-options)
-        body-params-injector (:body-params-injector swagger-options)
-        responses-injector (:responses-injector swagger-options)
-        params-key (concat paths-key ["parameters"])]
+        body-params-injector  (:body-params-injector swagger-options)
+        responses-injector    (:responses-injector swagger-options)
+        params-key            (concat paths-key ["parameters"])]
     (as-> swagger-object %
           (assoc-in % paths-key
-                    (remove-nil-vals {:description  description
-                                      :summary      summary
+                    (remove-nil-vals {:description    description
+                                      :summary        summary
                                       ;; This is required inside a Operation object:
-                                      :responses    {}
+                                      :responses      {}
                                       ;; This aligns very nicely with Rook:
                                       :operation-id (:function endpoint-meta)}))
           (path-params-injector swagger-options % routing-entry params-key)
@@ -341,9 +341,9 @@
     #(format "Describing endpoint %s `/%s'."
              (-> routing-entry :method name .toUpperCase)
              (->> routing-entry :path (str/join "/")))
-    (let [path-str (-> routing-entry :path path->str)
+    (let [path-str        (-> routing-entry :path path->str)
           ;; Ignoring :all for the moment.
-          method-str (-> routing-entry :method name)
+          method-str      (-> routing-entry :method name)
           pio-constructor (:path-item-object-injector swagger-options)]
       ;; Invoke the constructor for the path info. It may need to make changes to the :definitions, so we have
       ;; to let it modify the entire Swagger object ... but we help it out by providing the path


Add ability to do extra filtering of endpoints

This is to allow an application that has non-public internal APIs to easily hide
those from generated documentation

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -335,6 +335,7 @@
   {:template                  default-swagger-template
    ;; Name of special parameter used for the body of the request
    :body-name                 :body
+   :routing-entry-filter      (constantly false)
    :route-injector            default-route-injector
    :configurer                default-configurer
    :data-type-mappings        default-data-type-mappings
@@ -350,12 +351,13 @@
   [swagger-options routing-table]
   (t/track
     "Constructing Swagger API Description."
-    (let [{:keys [template route-injector configurer]} swagger-options
+    (let [{:keys [template route-injector configurer routing-entry-filter]} swagger-options
           routing-entries (->> routing-table
                                vals
                                (apply concat)
                                (map routing-entry->map)
                                ;; Endpoints with the :no-swagger meta data are ignored.
-                               (remove #(-> % :meta :no-swagger)))]
+                               (remove #(-> % :meta :no-swagger))
+                               (remove routing-entry-filter))]
       (as-> (reduce (partial route-injector swagger-options) template routing-entries) %
             (configurer swagger-options % routing-entries)))))


Update adoc post path

Update adoc post path

--- src/leiningen/new/cryogen.clj
+++ src/leiningen/new/cryogen.clj
@@ -42,7 +42,7 @@
                ["resources/templates/md/posts/13-11-2014-docs.md" (render "md/posts/13-11-2014-docs.md")]
                ;;Asciidoc templates
                ["resources/templates/asc/pages/adoc-page.asc" (render "asc/pages/adoc-page.asc")]
-               ["resources/templates/asc/posts/10-12-2014-adoc-post.asc" (render "asc/posts/10-12-2014-adoc-post.asc")]
+               ["resources/templates/asc/posts/10-10-2014-adoc-post.asc" (render "asc/posts/10-10-2014-adoc-post.asc")]
                ;;config
                ["resources/templates/config.edn" (render "config.edn")]
                ;;namespaces


Fixes naming so ring-server dependency gets picked up by leinjacker

--- src/leiningen/ring/server.clj
+++ src/leiningen/ring/server.clj
@@ -27,7 +27,7 @@
       (classpath-dirs project)))

 (defn add-server-dep [project]
-  (update-project project deps/add-if-missing '[ring-server "0.2.8"]))
+  (update-project project deps/add-if-missing '[ring-server/ring-server "0.2.8"]))

 (defn server-task
   "Shared logic for server and server-headless tasks."