Rolled in to basic gofor stuff

Rolled in to basic gofor stuff

--- src/dragonmark/core.cljx
+++ src/dragonmark/core.cljx
@@ -199,9 +199,9 @@

-(gofor
- [root (get-service @env-root {:service 'root})]
- [added (add root {:service 'wombat2 :channel (chan) :public true})]
- [b (list root)]
- :let [a (+ 1 1)]
- (println "dog: " a " and " b " root " root " added " added) :error (println "Got an error " &err " for frogs " &var))
+;; (gofor
+;;  [root (get-service @env-root {:service 'root})]
+;;  [added (add root {:service 'wombat2 :channel (chan) :public true})]
+;;  [b (list root)]
+;;  :let [a (+ 1 1)]
+;;  (println "dog: " a " and " b " root " root " added " added) :error (println "Got an error " &err " for frogs " &var))


PR Feedback

PR Feedback

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspaces_list.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspaces_list.cljs
@@ -114,7 +114,7 @@
          :body-style {:fontSize nil :fontWeight nil
                       :borderLeft border-style :borderRight border-style
                       :borderBottom border-style :borderRadius 4}
-         :row-style {:height 56 :borderTop border-style}
+         :row-style {:height 56 :borderTop border-style :overflow "hidden"}
          :even-row-style {:backgroundColor nil}
          :cell-content-style {:padding nil}
          :toolbar (fn [built-in]


Test more noop-changes.

Test more noop-changes.

--- src/cbfg/test/kvs.cljs
+++ src/cbfg/test/kvs.cljs
@@ -8,6 +8,9 @@
     (when (not pass)
       (println (str my-n ":") "FAIL:" result expect))
     (and pass (nil? result-nil))))
+
+(defn noop-change [kvs change-sq]
+  [kvs {:status :ok}])

 (defn test-kvs [actx]
   (act tkvs actx
@@ -127,9 +130,7 @@
                                   (dissoc (merge m3 {:status :ok})
                                           :changes)
                                   (atake tkvs res-ch3))))
-                           (let [noop-change (fn [kvs change-sq]
-                                               [kvs {:status :ok :foo :bar}])
-                                 res-ch4 (achan tkvs)
+                           (let [res-ch4 (achan tkvs)
                                  m4 {:opaque @n
                                      :res-ch res-ch4
                                      :op :multi-change
@@ -138,13 +139,38 @@
                              (aput tkvs cmd-ch m4)
                              (and
                               (e n (atake tkvs res-ch4)
-                                 (dissoc (merge m4 {:status :ok :foo :bar})
+                                 (dissoc (merge m4 {:status :ok})
                                          :changes)
                                  nil)
                               (e n (atake tkvs res-ch4)
                                  (dissoc (merge m4 {:status :ok})
                                          :changes)
-                                 (atake tkvs res-ch4))))))))
+                                 (atake tkvs res-ch4))))
+                           (let [res-ch5 (achan tkvs)
+                                 m5 {:opaque @n
+                                     :res-ch res-ch5
+                                     :op :multi-change
+                                     :kvs-ident (:kvs-ident open)
+                                     :changes [noop-change noop-change noop-change]}]
+                             (aput tkvs cmd-ch m5)
+                             (and
+                              (e n (atake tkvs res-ch5)
+                                 (dissoc (merge m5 {:status :ok})
+                                         :changes)
+                                 nil)
+                              (e n (atake tkvs res-ch5)
+                                 (dissoc (merge m5 {:status :ok})
+                                         :changes)
+                                 nil)
+                              (e n (atake tkvs res-ch5)
+                                 (dissoc (merge m5 {:status :ok})
+                                         :changes)
+                                 nil)
+                              (e n (atake tkvs res-ch5)
+                                 (dissoc (merge m5 {:status :ok})
+                                         :changes)
+                                 (atake tkvs res-ch5))))
+                           ))))
            "pass"
            (str "FAIL: on test-lane #" @n)))))


Rename to cur-user/cur-user-realm.

Rename to cur-user/cur-user-realm.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -60,11 +60,11 @@
         [server-state (assoc (dissoc m :pswd) :status :invalid)])
       [server-state (assoc (dissoc m :pswd) :status :invalid)])
     "realms-list"
-    (if-let [{:keys [lane-realm lane-user]} m]
-      (let [realm-keys (if (and (= lane-realm "_system")
-                                (= lane-user "admin"))
+    (if-let [{:keys [cur-user-realm cur-user]} m]
+      (let [realm-keys (if (and (= cur-user-realm "_system")
+                                (= cur-user "admin"))
                          (keys (:realms server-state))
-                         [lane-realm])]
+                         [cur-user-realm])]
         (act-loop realms-list actx [realm-keys realm-keys]
                   (if-let [realm-key (first realm-keys)]
                     (do (aput realms-list (:res-ch m)
@@ -86,8 +86,8 @@
     [lane-state (assoc m :status :ok :value lane-state)]
     "realms-list"
     (do (msg-put actx :server-state-ch
-                 (assoc m :lane-realm (:realm lane-state)
-                        :lane-user (:user lane-state)))
+                 (assoc m :cur-user-realm (:realm lane-state)
+                        :cur-user (:user lane-state)))
         [lane-state nil])
     nil))


Make cred update synchronous.

Make cred update synchronous.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -54,10 +54,12 @@
                    (assoc m :op :authenticate :res-ch res-ch))
            (let [res (atake rq-authenticate res-ch)]
              (when (= (:status res) :ok)
-               (aput rq-authenticate lane-state-ch
-                     (assoc m :op :update
-                            :update-fn #(assoc % :cred
-                                               {:realm realm :user user}))))
+               (let [res-ch (achan rq-authenticate)]
+                 (aput rq-authenticate lane-state-ch
+                       (assoc m :op :update :res-ch res-ch
+                              :update-fn #(assoc % :cred
+                                                 {:realm realm :user user})))
+                 (atake rq-authenticate res-ch)))
              res)
            (assoc (dissoc m :pswd)
              :status :failed :status-info [:authenticate :closed])))))


Added server-state by generifying lane-state.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -20,35 +20,40 @@
                                     cmd-handlers el-prefix
                                     cbfg.world.t1/ev-msg init-event-delay)))

+(defn start-state-loop [actx name]
+  (let [req-ch (achan actx)]
+    (act-loop state-loop actx [name name state {}]
+              (let [m (atake state-loop req-ch)]
+                (case (:op m)
+                  :get (do (aput state-loop (:res-ch m)
+                                 (assoc m :status :ok :value state))
+                           (recur name state))
+                  :update (do (aput state-loop (:res-ch m)
+                                    (assoc m :status :ok))
+                              (recur name ((:update-fn m) state)))
+                  :unknown-op)))
+    req-ch))
+
 ; --------------------------------------------

 (defn kv-server [server-addr & ports]
-  (let [lane-max-inflight 10
+  (let [world (:world (prog-base-now))
+        server-state-ch (start-state-loop world :server-state)
+        lane-max-inflight 10
         lane-buf-size 20
         make-lane (fn [actx lane-name lane-out-ch]
                     (let [lane-in-ch (achan-buf actx lane-buf-size)
-                          lane-state-ch (achan actx)
+                          lane-state-ch (start-state-loop actx :lane-state)
                           lane-state-cb (fn [is-req m lane-ext-state]
                                           (if is-req
                                             (if m
-                                              [(assoc m :lane-state-ch lane-state-ch)
+                                              [(assoc m :lane-state-ch lane-state-ch
+                                                      :server-state-ch server-state-ch)
                                                lane-ext-state]
                                               (do (act closer actx
                                                        (aclose closer lane-state-ch))
                                                   [m lane-ext-state]))
                                             [m lane-ext-state]))]
-                      (act-loop lane-state-loop actx [lane-state nil]
-                                (let [m (atake lane-state-loop lane-state-ch)]
-                                  (case (:op m)
-                                    :get-lane-state
-                                    (do (aput lane-state-loop (:res-ch m)
-                                              (assoc m :status :ok :value lane-state))
-                                        (recur lane-state))
-                                    :update-lane-state
-                                    (do (aput lane-state-loop (:res-ch m)
-                                              (assoc m :status :ok))
-                                        (recur ((:update-fn m) lane-state)))
-                                    :unknown-op)))
                       (cbfg.fence/make-fenced-pump actx lane-name
                                                    lane-in-ch lane-out-ch
                                                    lane-max-inflight false
@@ -61,14 +66,13 @@
                                                      close-server-recv-ch
                                                      :make-lane-fn make-lane))]
     (doseq [port ports]
-      (let [world (:world (prog-base-now))
-            done (atom false)]
-        (act server-init world
-             (when-let [listen-result-ch (achan server-init)]
-               (aput server-init (:net-listen-ch (prog-base-now))
+      (let [done (atom false)]
+        (act port-init world
+             (when-let [listen-result-ch (achan port-init)]
+               (aput port-init (:net-listen-ch (prog-base-now))
                      [server-addr port listen-result-ch])
                (when-let [[accept-ch close-accept-ch]
-                          (atake server-init listen-result-ch)]
+                          (atake port-init listen-result-ch)]
                  (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch
                                                     :server-conn-loop conn-loop)))
              (reset! done true))


Add the license and some more docs

Add the license and some more docs

--- src/oxcart/pattern.clj
+++ src/oxcart/pattern.clj
@@ -1,5 +1,23 @@
-(ns oxcart.pattern)
+;;   Copyright (c) Reid McKenzie, Rich Hickey & contributors. The use
+;;   and distribution terms for this software are covered by the
+;;   Eclipse Public License 1.0
+;;   (http://opensource.org/licenses/eclipse-1.0.php) which can be
+;;   found in the file epl-v10.html at the root of this distribution.
+;;   By using this software in any fashion, you are agreeing to be
+;;   bound by the terms of this license.  You must not remove this
+;;   notice, or any other, from this software.

+(ns oxcart.pattern
+  {:doc "Implements a number of pattern matching predicates and utility
+        functions over the clojure.tools.analyzer.jvm AST structure."
+   :added "0.0.1"
+   :author "Reid McKenzie"})
+
+
+;; TODO:
+;;  Depending on benchmarking and API changes it may make sense to
+;;  make core.match a dependency of this project rather than hard
+;;  coding datastructure dependant paths and equality checks.

 (defn def?
   "λ AST -> Boolean
@@ -19,4 +37,3 @@
   [ast]
   (when (def? ast)
     (:name ast)))
-


group all db->* fns together

group all db->* fns together

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -202,6 +202,26 @@
    :invitee-email (:invite/to e)
    :group-id (get-in e [:invite/group :group/id])
    :group-name (get-in e [:invite/group :group/name])})
+
+(defn- db->tag
+  [e]
+  {:id (:tag/id e)
+   :name (:tag/name e)
+   :group-id (get-in e [:tag/group :group/id])
+   :group-name (get-in e [:tag/group :group/name])})
+
+(defn- db->thread
+  [thread]
+  {:id (thread :thread/id)
+   :messages (map (fn [msg]
+                    {:id (msg :message/id)
+                     :content (msg :message/content)
+                     :user-id (get-in msg [:message/user :user/id])
+                     :created-at (msg :message/created-at)})
+                  (thread :message/_thread))
+   :tag-ids (map (fn [tag]
+                   (tag :tag/id))
+                 (thread :thread/tag))})

 (defmacro with-conn
   "Execute the body with *conn* dynamically bound to a new connection."
@@ -407,19 +427,6 @@
        (map (comp db->user first))
        set))

-(defn- db->thread
-  [thread]
-  {:id (thread :thread/id)
-   :messages (map (fn [msg]
-                    {:id (msg :message/id)
-                     :content (msg :message/content)
-                     :user-id (get-in msg [:message/user :user/id])
-                     :created-at (msg :message/created-at)})
-                  (thread :message/_thread))
-   :tag-ids (map (fn [tag]
-                   (tag :tag/id))
-                 (thread :thread/tag))})
-
 (defn get-open-threads-for-user
   [user-id]
   (->> (d/q '[:find (pull ?thread [:thread/id
@@ -470,13 +477,6 @@
   (d/transact
     *conn*
     [[:db/retract [:user/id user-id] :user/open-thread [:thread/id thread-id]]]))
-
-(defn- db->tag
-  [e]
-  {:id (:tag/id e)
-   :name (:tag/name e)
-   :group-id (get-in e [:tag/group :group/id])
-   :group-name (get-in e [:tag/group :group/name])})

 (defn create-tag! [attrs]
   (-> {:tag/id (attrs :id)


rename instances of clock => clock-atom to make atom vs. not atom more obvious

--- src/chronoid/core.cljs
+++ src/chronoid/core.cljs
@@ -119,12 +119,12 @@

 (defn- create-event!
   "Create an event and insert into a clock's event queue."
-  [clock f deadline & [{:as opts}]]
+  [clock-atom f deadline & [{:as opts}]]
   (let [event (event* (merge {:action   f
-                              :clock    clock
+                              :clock    clock-atom
                               :deadline deadline}
                              opts))]
-    (swap! clock update :events insert-event event)
+    (swap! clock-atom update :events insert-event event)
     event))

 (defn- schedule*
@@ -136,8 +136,8 @@
 (defn- schedule!
   "Schedule a copy of an event with a new deadline."
   [{:keys [clock-id] :as event} new-deadline]
-  (let [clock (get *clocks* clock-id)]
-    (swap! clock update :events schedule* event new-deadline)
+  (let [clock-atom (get *clocks* clock-id)]
+    (swap! clock-atom update :events schedule* event new-deadline)
     (event* (assoc event :deadline new-deadline))))

 (declare repeat!)
@@ -157,24 +157,24 @@

    `opts` may contain :tolerance-early and :tolerance-late for optionally
    overriding the clock's timing window for events."
-  [clock f delay & {:as opts}]
-  (create-event! clock f (absolute-time @clock delay) opts))
+  [clock-atom f delay & {:as opts}]
+  (create-event! clock-atom f (absolute-time @clock-atom delay) opts))

 (defn callback-at-time!
   "Schedules `f` to run before `deadline`. Returns the event.

    `opts` may contain :tolerance-early and :tolerance-late for optionally
    overriding the clock's timing window for events."
-  [clock f deadline & {:as opts}]
-  (create-event! clock f deadline opts))
+  [clock-atom f deadline & {:as opts}]
+  (create-event! clock-atom f deadline opts))

 (defn clear!
   "Unschedules an event by removing it from its clock's event queue."
   [{:keys [clock-id] :as event}]
-  (let [clock (get *clocks* clock-id)]
-    (swap! clock update :events #(filter (fn [{:keys [id]}]
-                                           (not= id (:id event)))
-                                         %))
+  (let [clock-atom (get *clocks* clock-id)]
+    (swap! clock-atom update :events #(filter (fn [{:keys [id]}]
+                                                (not= id (:id event)))
+                                              %))
     event))

 (defn repeat!


Handling of forgotten :regex special case for chimera with tokens-view

--- src/paredit/parser.clj
+++ src/paredit/parser.clj
@@ -197,6 +197,8 @@
     (= :chimera t) (cond
                      (= "\"" ((get abstract-children 0) parse-tree-view))
                        (token :string count)
+                     (= "#\"" ((get abstract-children 0) parse-tree-view))
+                       (token :regex count)
                      :else
                        (concat (token :nest 0) (balanced :open-chimera :close-chimera abstract-children) (token :unnest 0)))
     (= :comment t) (token :comment count)


Generating random position for new settlements

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -33,6 +33,23 @@
 ; Tribe functions
 ; --------------------------------------

+(defn land? [pos]
+  (let [ b (-> @world .getBiome)
+         biome (.get b (:x pos) (:y pos))]
+    (not (= (.name biome) "OCEAN"))))
+
+(defn random-pos []
+  (let [w (-> @world .getDimension .getWidth)
+        h (-> @world .getDimension .getHeight)]
+    {:x (rand-int w) :y (rand-int h)}))
+
+; TODO check if there is a village there
+(defn free-random-land []
+  (let [rp (random-pos)]
+    (if (land? rp)
+      rp
+      (free-random-land))))
+
 (defn- create-tribe-in-game [game]
   (let [id-tribe (.next-id game)
         game (assoc game :next-id (inc id-tribe))
@@ -41,7 +58,7 @@
         language nil
         name-tribe nil
         name-settlement nil
-        pos {:x 0 :y 0}
+        pos (free-random-land)
         settlement (Settlement. id-settlement name-settlement 100 id-tribe pos)
         tribe (Tribe. id-tribe nil nil [id-settlement])
         game (assoc-in game [:tribes id-tribe] tribe)


Remove experimental Gordian Blade change.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -2786,7 +2786,7 @@
    "Gordian Blade"
    {:abilities [{:cost [:credit 1] :msg "break 1 code gate subroutine"}
                 {:cost [:credit 1] :msg "add 1 strength for the remainder of this run"
-                 :effect (effect (pump card 1 {:pump-duration :per-run}))}]}
+                 :effect (effect (pump card 1 true))}]}

    "Gingerbread"
    {:abilities [{:cost [:credit 1] :msg "break 1 tracer subroutine"}


added maps for the tick object

added maps for the tick object

--- src/clj/ibclj/core.clj
+++ src/clj/ibclj/core.clj
@@ -48,15 +48,15 @@
     com.ib.controller.ApiController$ITopMktDataHandler
     (tickPrice [this tick-type p auto-execute?]
       ;(println (.name tick-type) "price: " p)
-      (>!! c [(.symbol contract) (.name tick-type) p])
+      (>!! c {:sym (.symbol contract) :type (.name tick-type) :price p})
       )
     (tickSize [this tick-type size]
       ;(println (.name tick-type) "size: " size)
-      (>!! c [(.symbol contract) (.name tick-type) size])
+      (>!! c {:sym (.symbol contract) :type (.name tick-type) :size size})
       )
     (tickString [this tick-type val]
       ;(println (.name tick-type) "LastTime: " val)
-      (>!! c [(.symbol contract) (.name tick-type) val])
+      (>!! c {:sym (.symbol contract) :type (.name tick-type) :val val})
       )
     (marketDataType [this data-type]
       (println "Frozen? " (= data-type com.ib.controller.Types$MktDataType/Frozen)))
@@ -87,8 +87,12 @@
     (subscribe! api spy-ctx c)

     (go-loop []
-             (println (<! c))
-             (recur))
+      (let [{:keys [sym] :as msg} (<! c)]
+        (println msg)
+        (if (= sym "VXX")
+          (println "********VXX")
+          (println "********SPY"))
+        (recur)))

     (Thread/sleep 100000)


green

green

--- src/cloogling/core.clj
+++ src/cloogling/core.clj
@@ -5,16 +5,27 @@

 (defn create-entry
-  "create an entry record"
-  [x]
+(  [x]
   (try
     (->entry (x "Url" ) (x "Title") (x "Description"))
     (catch IllegalArgumentException e nil)
     )
+)
+
+(  [x y]
+  (try
+    (->entry (x "link" ) (x "title") (x "snippet"))
+    (catch IllegalArgumentException e nil)
+    )
+)
+
+
+
+
   )

 (defn get-entries
-  "Get results from json data retrieved from engine"
+  (
   [x]
   (remove nil? (map create-entry (try
                                    (-> x
@@ -22,7 +33,16 @@
                                        (get-in ["d" "results"]))
                                    (catch Exception e (empty nil))
                                    )
-                    ))
+                    )))
+  (
+  [x y]
+  (remove nil? (map create-entry (try
+                                   (-> x
+                                       json/read-str
+                                       (get-in ["items"]))
+                                   (catch Exception e (empty nil))
+                                   )
+                    )))
   )


Forgot create-wish remote

Forgot create-wish remote

--- src/wishlistd/views/wishlist.clj
+++ src/wishlistd/views/wishlist.clj
@@ -20,6 +20,10 @@
 (defremote read-wishlist [code] ; doesn't need dissoc date
   (model/read-wishlist code))

+(defremote create-wish [wish]
+  (dissoc-date
+    (model/create-wish wish)))
+
 (defremote update-wish [wish]
   (dissoc-date
     (model/update-wish wish)))


cleared up flavour list

cleared up flavour list

--- src/error_codes/core.clj
+++ src/error_codes/core.clj
@@ -350,56 +350,19 @@

 (def flavour-list
-  {"stichwortsuche" [[]  stichwortsuche]
-   "case-sensitive-stichwortsuche" [[] case-sensitive-stickwortsuche]
-   "phrasensuche" [[] phrasensuche]
-   "no-insertions-or-deletions" [[] no-insertions-or-deletions]
-   "stichwortsuche ohne erste und letzte Zeile" [[strip-first-and-last-lines]  stichwortsuche]
-   "case-sensitive-stichwortsuche ohne erste und letzte Zeile" [[strip-first-and-last-lines] case-sensitive-stickwortsuche]
-   "phrasensuche ohne erste und letzte Zeile" [[strip-first-and-last-lines] phrasensuche]
-   "no-insertions-or-deletions ohne erste und letzte Zeile" [[strip-first-and-last-lines] no-insertions-or-deletions]
-   "stichwortsuche ohne Fehler am Anfang und Ende" [[strip-start-and-end-errors]  stichwortsuche]
-   "case-sensitive-stichwortsuche ohne Fehler am Anfang und Ende" [[strip-start-and-end-errors] case-sensitive-stickwortsuche]
-   "phrasensuche ohne Fehler am Anfang und Ende" [[strip-start-and-end-errors] phrasensuche]
-   "no-insertions-or-deletions ohne Fehler am Anfang und Ende" [[strip-start-and-end-errors] no-insertions-or-deletions]
-   "kein flavour" [[] (constantly true)]
-   "kein flavour ohne erste und letzte Zeile" [[strip-first-and-last-lines] (constantly true)]
-   "kein flavour ohne Fehler am Anfang und Ende" [[strip-start-and-end-errors] (constantly true)]
-   "kein flavour ohne newlines" [[strip-newline-errors] (constantly true)]
-   "stichwortsuche ohne newlines" [[strip-newline-errors]
-                                   stichwortsuche]
-   "case-sensitive-stichwortsuche ohne newlines" [[strip-newline-errors]
-                                                  case-sensitive-stickwortsuche]
-   "phrasensuche ohne newlines" [[strip-newline-errors]
-                                 phrasensuche]
-   "no-insertions-or-deletions ohne newlines" [[strip-newline-errors]
-                                               no-insertions-or-deletions]
-
-   "stichwortsuche ohne newlines ohne erste und letzte Zeile" [[strip-newline-errors strip-first-and-last-lines]
-                                   stichwortsuche]
-   "case-sensitive-stichwortsuche ohne newlines ohne erste und letzte Zeile" [[strip-newline-errors strip-first-and-last-lines]
-                                                  case-sensitive-stickwortsuche]
-   "phrasensuche ohne newlines ohne erste und letzte Zeile" [[strip-newline-errors strip-first-and-last-lines]
-                                 phrasensuche]
-   "no-insertions-or-deletions ohne newlines ohne erste und letzte Zeile" [[strip-newline-errors strip-first-and-last-lines]
-                                                                           no-insertions-or-deletions]
-   "stichwortsuche ohne newlines ohne Fehler am Anfang und Ende" [[strip-newline-errors strip-start-and-end-errors]
-                                   stichwortsuche]
-   "case-sensitive-stichwortsuche ohne newlines ohne Fehler am Anfang und Ende" [[strip-newline-errors strip-start-and-end-errors]
-                                                  case-sensitive-stickwortsuche]
-   "phrasensuche ohne newlines ohne Fehler am Anfang und Ende" [[strip-newline-errors strip-start-and-end-errors]
-                                 phrasensuche]
-   "no-insertions-or-deletions ohne newlines ohne Fehler am Anfang und Ende" [[strip-newline-errors strip-start-and-end-errors]
-                                               no-insertions-or-deletions]
-})
-
+  {"stichwortsuche" [[strip-newline-errors strip-start-and-end-errors]
+                     stichwortsuche]
+   "case-sensitive-stichwortsuche" [[strip-newline-errors strip-start-and-end-errors] case-sensitive-stickwortsuche]
+   "phrasensuche" [[strip-newline-errors strip-start-and-end-errors] phrasensuche]
+   "alle Fehler" [[strip-newline-errors strip-start-and-end-errors]
+                   (constantly true)]})

 (defn run-filters [filters errors ground-truth ocr-results]
   (reduce (fn [errors filter]
             (filter errors ground-truth ocr-results))
           errors filters))

-(defn generate-statistics
+(defn generate-statistics ;;setze vereinbarte standartwerte
   ([base-directory] (generate-statistics base-directory [] identity))
   ([base-directory flavour] (generate-statistics base-directory [] flavour))
   ([base-directory filters flavour]
@@ -426,5 +389,36 @@
                                 [n (apply generate-statistics d f)])))]))))

+(defn correction-statistic [gt ocr-unverbessert ocr-verbessert error-codes-unverbessert error-codes-verbessert]
+  ;;todo wenn korrektur zeichen löscht oder einfügt dann ist difference hier nicht mehr korrekt
+  ;;es müsste dann gefiltert werden wobei die position im ground truth als kennzeichnung dient
+  (let [false-positives (set/difference (into #{} error-codes-verbessert) (into #{} error-codes-unverbessert))
+        false-negatives (set/difference  (into #{} error-codes-verbessert) false-positives)
+        true-positives (set/difference (into #{} error-codes-unverbessert) (into #{} error-codes-verbessert))]
+    {:false-positives (map (partial augment-error-code gt ocr-verbessert) false-positives)
+     :false-negatives (map (partial augment-error-code gt ocr-verbessert) false-negatives)
+     :true-positives (map (partial augment-error-code gt ocr-unverbessert) true-positives )}))
+
+(defn run-filters [filters errors ground-truth ocr-results]
+  (reduce (fn [errors filter]
+            (filter errors ground-truth ocr-results))
+          errors filters))
+
+(defn generate-correction-statistics
+  ([base-directory-unverbessert base-directory-verbessert]
+     (generate-correction-statistics base-directory-unverbessert base-directory-verbessert [strip-newline-errors strip-start-and-end-errors]))
+  ([base-directory-unverbessert base-directory-verbessert filters]
+     (let [gts (get-files-sorted (file base-directory-unverbessert "ground-truth/"))
+           gt-text (map slurp gts)
+           ocr-res-unverb (map slurp (get-files-sorted (file base-directory-unverbessert "ocr-results/")))
+           ocr-res-verb (map slurp (get-files-sorted (file base-directory-verbessert "ocr-results/")))
+           error-codes-verb (map (comp read-string slurp) (get-files-sorted (file base-directory-verbessert "edits/")))
+           error-codes-unverb (map (comp read-string slurp) (get-files-sorted (file base-directory-unverbessert "edits/")))
+           error-codes-verb (map (partial run-filters filters) error-codes-verb gt-text ocr-res-verb)
+           error-codes-unverb (map (partial run-filters filters) error-codes-unverb gt-text ocr-res-unverb)]
+       (pmap (fn [gt ocr-unverb ocr-verb ec-verb ec-unverb page]
+               (assoc (correction-statistic gt ocr-unverb ocr-verb ec-unverb ec-verb) :pages [page]))
+             gt-text ocr-res-unverb ocr-res-verb error-codes-verb error-codes-unverb (map (memfn getName) gts)))))
+

 (edits "a" "b")


PDOK-2420: Add TODO with edge cases

PDOK-2420: Add TODO with edge cases

--- src/featured_gml/api.clj
+++ src/featured_gml/api.clj
@@ -34,6 +34,7 @@
             (.closeEntry zipstream)))
         (translate-stream dataset mapping body (zip/target-file tmpdir uri))))))

+; TODO add edge cases (file cannot be downloaded, server not running, zip with failure, etc.)
 (defn process-xml2json [req dataset mapping uri]
   "Proces the request, zip the result in a zip on the filesystem and return a reference to this zip-file"
   (log/info "Going to transform \""dataset"\" using url" uri)


Minor bugfix.

Minor bugfix.

--- src/postal/client.cljs
+++ src/postal/client.cljs
@@ -40,7 +40,7 @@

 (defn- prepare-request
   [client data]
-  (let [req {:headers (merge +default-headers+ (:headers client))
+  (let [req {:headers (merge +default-headers+ @(:headers client))
              :method (:method client)
              :url (:url client)}]
     (if (= :method :get)


remove [:head :phrasal] = false from vp-present21 so that vp-present21 -> vp32 works

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -374,7 +374,6 @@
                    (unify-check h21
                            root-is-head
                            {:rule "vp-present"
-                            :head {:phrasal false}
                             :synsem {:aux false
                                      :infl :present
                                      :sem {:tense :present}


+at, +beach

+at, +beach

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -98,6 +98,12 @@

    "assure" {:synsem {:cat :verb
                       :sem {:pred :assure}}}
+
+   "at" (let [obj (atom {:location true})]
+          {:synsem {:cat :prep
+                    :subcat {:1 {:sem obj}}
+                    :sem {:obj obj
+                          :pred :at}}})

    "attend" {:synsem {:cat :verb
                       :sem {:pred :attend}}}
@@ -263,6 +269,12 @@
                                   :3plur "were missing"}}
                  :synsem {:cat :verb
                           :sem {:pred :to-be-missing}}}
+
+   "beach" {:synsem {:cat :noun
+                     :sem {:place true
+                           :pred :beach
+                           :buyable false
+                           :artifact false}}}

    "become" {:synsem {:cat :verb
                     :sem {:pred :become}}


add some default common-noun lexical rules

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -142,6 +142,32 @@
               :agr {:number :sing
                     :person :3rd}}})

+   (default
+    ;; a propernoun is agr=3rd singular, though in British English,
+    ;; a propernoun can be 3rd plur, e.g.: "Manchester have won the final".
+    {:synsem {:cat :noun
+              :pronoun false
+              :propernoun true
+              :agr {:number :sing
+                    :person :3rd}}})
+
+   (default ;; a common-noun is agr=3rd person.
+    {:synsem {:cat :noun
+              :pronoun false
+              :propernoun false
+              :agr {:person :3rd}}})
+
+   ;; common nouns' articles agree with their articles:
+   ;; e.g. "a dog" but *"a dogs".
+   (default
+    (let [agr (atom {:person :3rd})]
+      {:synsem {:cat :noun
+                :pronoun false
+                :propernoun false
+                :agr agr
+                :subcat {:1 {:cat :det
+                             :agr agr}}}}))
+
    ;; </noun default rules>

    ;; <verb default rules>
@@ -353,7 +379,8 @@
    ;; are the same compared to Italian.
    (default
     (let [subject-semantics (atom :top)]
-      {:synsem {:sem {:reflexive true
+      {:synsem {:cat :verb
+                :sem {:reflexive true
                       :subj subject-semantics
                       :obj subject-semantics}
                 :subcat {:2 '()}}}))
@@ -645,7 +672,6 @@
          [{:synsem {:sem {:pred (keyword pred)}
                     :propernoun false
                     :pronoun false
-                    :subcat {:1 {:agr {:person :3rd}
-                                 :cat :det}}
+                    :subcat {:1 {:cat :det}}
                     :cat :noun}}]}
         true {}))


added pouvoir

added pouvoir

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -415,6 +415,27 @@
 ;  "profiter (de)" {:synsem {:cat :verb
 ;                            :sem {:pred :take-advantage-of}}}

+  "pouvoir"
+   (let [shared-part-of-pouvoir
+         {:synsem {:essere false
+                   :cat :verb}
+          :français {:futuro-stem "pourr"
+                     :drop-e true
+                     :past-participle "pu"
+                     :imperfect-stem "pouv"
+                     :present {:1sing "peux"
+                               :2sing "peux"
+                               :3sing "peut"
+                               :1plur "pouvons"
+                               :2plur "pouvez"
+                               :3plur "peuvent"}}}]
+     [(merge shared-part-of-pouvoir
+             {:synsem {:pred :can}})
+      (merge shared-part-of-pouvoir
+             {:synsem {:pred :may}})
+      (merge shared-part-of-pouvoir
+             {:synsem {:pred :be-able-to}})])
+
   "regarder" [{:synsem {:cat :verb
                         :sem {:pred :look}}}
               {:synsem {:cat :verb


Don't recompile clout routes in closures

--- src/compojure/core.clj
+++ src/compojure/core.clj
@@ -40,10 +40,19 @@
     (if-let [params (clout/route-matches route request)]
       (handler (assoc-route-params request (decode-route-params params))))))

+(defn- literal? [x]
+  (if (coll? x)
+    (every? literal? x)
+    (not (or (symbol? x) (list? x)))))
+
 (defn- prepare-route [route]
   (cond
     (string? route)
-      `(clout/route-compile ~route)
+      (clout/route-compile route)
+    (and (vector? route) (literal? route))
+      (clout/route-compile
+       (first route)
+       (apply hash-map (rest route)))
     (vector? route)
       `(clout/route-compile
         ~(first route)
@@ -192,7 +201,11 @@
   (let [re-context {:__path-info #"|/.*"}]
     (cond
       (string? route)
-       `(clout/route-compile ~(str route ":__path-info") ~re-context)
+        (clout/route-compile (str route ":__path-info") re-context)
+      (and (vector? route) (literal? route))
+        (clout/route-compile
+         (str (first route) ":__path-info")
+         (merge (apply hash-map (rest route)) re-context))
       (vector? route)
        `(clout/route-compile
          (str ~(first route) ":__path-info")


Wasn't as simple as I'd hoped

Wasn't as simple as I'd hoped

Stopping here for the evening. At least I think I've narrowed down where
it's broken horribly.

--- src/clj/frereth_web/system.clj
+++ src/clj/frereth_web/system.clj
@@ -123,20 +123,27 @@
            [name instance]))
        descr))

-(s/defn system-map! :- SystemMap
+(s/defn ^:always-validate system-map! :- SystemMap
   [descr :- InitializationMap
    config-options :- {s/Any s/Any}]
   (let [inited-pairs (initialize! descr config-options)
         inited (concat inited-pairs)]
     (apply component/system-map inited)))

-(s/defn dependencies :- SystemMap
+(s/defn ^:always-validate dependencies :- SystemMap
   [inited :- SystemMap
    descr :- {s/Keyword s/Any}]
-  (comment (log/debug "Preparing to build dependency tree for\n"
-                      (common/pretty inited)
-                      "based on the dependency description\n"
-                      (common/pretty descr)))
+  (comment)
+  (let [ks (keys inited)]
+    (log/debug "Preparing to build dependency tree for\n"
+               (common/pretty inited)
+               "with" (count ks) "keys\n"
+               (common/pretty ks)
+               "\nbased on the dependency description\n"
+               (common/pretty descr)))
+  ;;; This is going to fail. inited is hosed.
+  ;;; TODO: Start here
+
   (component/system-using inited descr))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -200,7 +207,7 @@
                      :initialization-map
                      (system-map! options))]
     (dependencies pre-init (:dependencies system-description))
-    (component/system-using dependencies)))
+    #_(component/system-using dependencies)))

 ;; TODO: This needs to be a unit test
 (comment


pass ldb parameter down in defentity macro

--- src/clj/ow/factum/entities.clj
+++ src/clj/ow/factum/entities.clj
@@ -49,8 +49,8 @@
         getsym (-> (str "get-" name) symbol)
         getsymm (-> (str "get-" name "s") symbol)
         transform #(if transform
-                     `(~transform ~%)
-                     %)]
+                     `(~transform ~%1 ~%2)
+                     %2)]
     `(do (defrecord ~recsym [~@fields])

          (defmethod print-method ~recsym [v# ^java.io.Writer w#]
@@ -58,10 +58,10 @@

          (defn ~getsym [~'ldb ~'eid]
            (let [~'e (get-entity ~'ldb ~'eid)]
-             (~mapctorsym ~(transform `~'e))))
+             (~mapctorsym ~(transform `~'ldb `~'e))))

          (defn ~getsymm [~'ldb ~'attribute ~'value]
            (let [es# (get-entities ~'ldb ~'attribute ~'value)]
              (sequence (map (fn [~'e]
-                              (~mapctorsym ~(transform `~'e))))
+                              (~mapctorsym ~(transform `~'ldb `~'e))))
                        es#))))))


Use double quotes

Use double quotes

--- src/clj/salava/oembed/core.clj
+++ src/clj/salava/oembed/core.clj
@@ -7,7 +7,7 @@
 (defqueries "sql/oembed/queries.sql")

 (def iframe
-  "")
+  "")

 (defn- url->id [url]
   (when-let [[_ id] (re-find #"/badge/info/([0-9]+)$" url)]


deps name change

deps name change

--- src/clj_hypergraph_db/core.clj
+++ src/clj_hypergraph_db/core.clj
@@ -1,4 +1,4 @@
-(ns hgdbt.core
+(ns clj_hypergraph_db.core
   (:import [org.hypergraphdb HGEnvironment])
   (:gen-class :main true))


grow-cylinder and a nicer looking koch curve

--- src/cljs/geometer/lsystem.cljs
+++ src/cljs/geometer/lsystem.cljs
@@ -4,6 +4,8 @@
             [thi.ng.geom.core.matrix :refer [M44]]
             [thi.ng.geom.aabb        :refer [aabb]]
             [thi.ng.geom.basicmesh   :as bm]
+            [thi.ng.geom.circle      :refer [circle]]
+            [thi.ng.geom.sphere      :refer [sphere]]
             [thi.ng.math.core        :as m]))

 (defn expand-l-system
@@ -18,13 +20,26 @@
   [[M44] (bm/basic-mesh)])

 (defn grow-cuboid
-  "Add a cuboid branch of `length` to `mesh` from `position` with `rotation`."
+  "Add a cuboid branch of `length` to `mesh` using position and rotation in the 4x4 matrix `mat`."
   [length mat mesh]
   (let [curr-mat (last mat)]
     [(conj (pop mat) (g/translate curr-mat 0 0 length))
      (g/into mesh (-> (aabb (vec3 -0.25 -0.25 0) (vec3 0.5 0.5 length))
                       (g/transform curr-mat)
                       (g/as-mesh)))]))
+
+(defn grow-cylinder
+  "Add a cylinder branch of `length` to `mesh` using position and rotation in the 4x4 matrix `mat`."
+  [thickness length mat mesh]
+  (let [curr-mat (last mat)]
+    [(conj (pop mat) (g/translate curr-mat 0 0 length))
+     (let [tube (-> (circle thickness)
+                    (g/center)
+                    (g/extrude {:depth length}))
+           ball (-> (sphere thickness) ;; for nicer joins
+                    (g/center)
+                    (g/as-mesh))]
+       (g/into mesh (g/transform (g/into tube ball) curr-mat)))]))

 (defn- execute-op
   "Execute a single L-System operation and return the new state of the system. The `angle-fn` is used to determine angle changes and the `grow-fn` to extend a branch."
@@ -66,8 +81,8 @@
   "Returns a mesh generated by an L-System that produces 3D version of a Koch curve."
   []
   (build-lsystem (constantly (m/radians 90))
-                 (partial grow-cuboid 3)
-                 (expand-l-system {\F "FF-F-F&F-F-F+F"} "F" 3)))
+                 (partial grow-cylinder 1.5 6)
+                 (expand-l-system {\F "FF-F-F&F-F-F+F"} "F" 2)))

 (defn toroid
   "Generates a toroid using the L-System support functions."


Force multiple vals to be vector

Force multiple vals to be vector

--- src/compojure/http/request.clj
+++ src/compojure/http/request.clj
@@ -22,7 +22,7 @@
   "Parse key/value strings to make them more Clojure-friendly."
   [key val]
   [(keyword key)
-   (if (next val) val (first val))])
+   (if (next val) (vec val) (first val))])

 (defn get-params
   "Retrieve a map of parameters from the request map."


row-but-diag useful for Math.concaM.r_...

--- src/conj_2016/core.clj
+++ src/conj_2016/core.clj
@@ -87,16 +87,22 @@
                 (/ sum-p)))]
     [h (m/div p sum-p)]))

-;>>> for i in range(0,3):
-;...   print D[i, Math.concatenate((Math.r_[0:i], Math.r_[i+1:3]))];
-;...
-;[2 3]
-;[4 6]
-;[7 8]
-;>>> D
-;array ([[1, 2, 3],
-;  [4, 5, 6],
-;  [7, 8, 9] ])
+(defn row-but-diag
+  "Return the nth row of the matrix except for the nth element"
+  [^Matrix matrix n]
+  ;>>> D = Math.array([[1, 2, 3],[4, 5, 6],[7, 8, 9]]);
+  ;>>> D
+  ;array ([[1, 2, 3],
+  ;  [4, 5, 6],
+  ;  [7, 8, 9]])
+  ;>>> for i in range(0,3):
+  ;...   print D[i, Math.concatenate((Math.r_[0:i], Math.r_[i+1:3]))];
+  ;...
+  ;[2 3]
+  ;[4 6]
+  ;[7 8]
+  (m/select matrix n (remove (partial = n)
+                             (range (m/column-count matrix)))))

 ;43 def x2p(X = Math.array([]), tol = 1e-5, perplexity = 30.0):
 ;44     """Performs a binary search to get P-values in such a way that each conditional Gaussian has the same perplexity."""


Remove example from code.  It is already present in the docs.

--- src/re_frame/cofx.cljc
+++ src/re_frame/cofx.cljc
@@ -66,23 +66,3 @@
 (def inject-db (inject-cofx :db))

-;; -- Further Example  --------------------------------------------------------
-
-;; An example coeffect handler, which adds the current datetime under
-;; the `:now` key.
-;;
-;; Example Usage:
-;;   (reg-event-fx                    ;;  `-fx` variant used in registration
-;;     :some-id
-;;     [(coeffect :now) debug]        ;; notice (coeffect :now) is in interceptors
-;;       (fn [coeffects event]        ;; -fx handlers are given the entire coeffect as 1st argument
-;;         (let [dt (:now coeffects)] ;; `:now` is available
-;;            ...)))
-;;
-;; As a further exercise, consider how you would write a `random` interceptor which adds a random
-;; number into a handler's coeffect?
-#_(register
-    :now
-    (fn now-coeffects-handler
-      [coeffects]
-      (assoc coeffects :now (js/Date.))))


minor: fix typo in docs

minor: fix typo in docs

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -215,7 +215,7 @@

   The `computation function` is expected to take two arguments:

-    - `input-values` - the values which flow into this node (how is it wierd into the graph?)
+    - `input-values` - the values which flow into this node (how is it wired into the graph?)
     - `query-vector` - the vector given to `subscribe`

   and it returns a computed value (which then becomes the output of the node)


Fix behavior with large undo lists

Fix behavior with large undo lists

--- src/re_frame/undo.cljs
+++ src/re_frame/undo.cljs
@@ -53,10 +53,10 @@
   "Stores the value currently in app-db, so the user can later undo"
   [explanation]
   (clear-redos!)
-  (reset! undo-list (vec (take
+  (reset! undo-list (vec (take-last
                            @max-undos
                            (conj @undo-list @app-db))))
-  (reset! undo-explain-list (vec (take
+  (reset! undo-explain-list (vec (take-last
                                    @max-undos
                                    (conj @undo-explain-list @app-explain))))
   (reset! app-explain explanation))


Add defcard to add new eden statement

Add defcard to add new eden statement

--- src/devcards/discuss/eden.cljs
+++ src/devcards/discuss/eden.cljs
@@ -8,8 +8,6 @@
             [discuss.communication.auth :as auth]
             [discuss.utils.common :as lib]
             [discuss.utils.views :as vlib]
-            [discuss.references.main :as ref]
-            [discuss.references.lib :as rlib]
             [discuss.utils.faker :as faker]))

 (defcard-om-next connection-browser
@@ -26,6 +24,10 @@
   eviews/EDENArgumentForm
   parser/reconciler)

+(defcard-om-next new-eden-statement
+  eviews/StatementForm
+  parser/reconciler)
+
 (defcard-om-next overview-menu
   eviews/OverviewMenu
   parser/reconciler)


Increase proxy timeout for api and auth passthrough

--- src/frontend/proxy.clj
+++ src/frontend/proxy.clj
@@ -16,7 +16,7 @@
                (:host backend)
                (:uri req)
                (query-string-with-om-build-id req))
-     :timeout 30000 ;ms
+     :timeout 120000 ;ms
      :method (:request-method req)
      :headers (assoc (:headers req)
                      "host" (:host backend)


Add selection behavior

Add selection behavior

Buttons can now be clicked to select them. Selection is lost if moving
away from the button while zoomed in.

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -40,6 +40,14 @@
 (def label-font-size 24)
 (def hitbox-size 96)

+(def deselection-distance 0.4)
+
+(def background-color "#EDF0F2")
+(def link-color "#C9CBCB")
+(def node-color "#777A7A")
+(def node-label-color node-color)
+(def selected-node-color "#FE9F51")
+
 (def label-y 42)
 (def label-y-transform (str "translate(0," label-y ")"))
 (def label-visible-threshold 1.5)
@@ -48,7 +56,7 @@

 (def resize-delay-ms 100)

-;; SVG setup
+;; DOM setup

 (defn disable-touchmove! [container]
   (.on container "touchmove" #(-> d3 .-event .preventDefault)))
@@ -57,7 +65,7 @@
   (-> svg
       (.append "rect")
       (.attr "class" "background")
-      (.attr "fill" "#EDF0F2")
+      (.attr "fill" background-color)
       (.attr "stroke" 0)))

 (defn setup-svg! [selector]
@@ -67,6 +75,10 @@
     (disable-touchmove! container)
     (add-background! svg)
     svg))
+
+(defn center-detail-button! [detail-button]
+  (let [width (-> detail-button .node .-offsetWidth)]
+    (.style detail-button "margin-left" (str (/ width -2) "px"))))

 ;; Geometry

@@ -156,10 +168,13 @@

 (defn sync-graph! [state & {:keys [animate?]}]
   (let [{:keys [svg
+                detail-button
                 nodes
                 links
+                selected-node
                 camera-pos
                 view-size
+                projection
                 animation-subject]} state
         {:keys [project-displacement
                 project-scale
@@ -182,7 +197,7 @@
       (-> link-selection .enter
           (.append "line")
           (.attr "class" "link")
-          (.style "stroke" "#C9CBCB")
+          (.style "stroke" link-color)
           (.style "stroke-width" 3))
       (-> link-selection
           maybe-transition
@@ -197,7 +212,6 @@
                                  (.attr "class" "node"))]
       (-> new-node-selection (.append "circle")
           (.attr "class" "node-dot")
-          (.style "fill" "#777A7A")
           (.attr "r" max-radius))
       ; Having too many labels at once hurts performance. Add/remove labels as
       ; they move in and out of view.
@@ -213,6 +227,7 @@
           (.style "font-family" label-font)
           (.style "font-size" (str label-font-size))
           (.style "text-anchor" "middle")
+          (.style "fill" node-label-color)
           (.attr "y" label-y))
       (-> node-selection
           ; Nodes beyond a distance threshold which do have labels
@@ -220,6 +235,8 @@
           (.selectAll ".node-label")
           (.remove))
       (-> node-selection
+          (.style "fill"
+                  #(if (= % selected-node) selected-node-color node-color))
           maybe-transition
           (.attr "transform"
                  (fn [node]
@@ -233,6 +250,8 @@
           (.attr "opacity" (fn [node]
                              (project-label-opacity (distance-for-node node))))
           (.text #(:title %))))
+    (.classed detail-button "invisible" (or (nil? selected-node)
+                                            (= projection :zoom-out)))
     (when animate?
       (.onNext animation-subject :animation-start)
       (js/setTimeout
@@ -249,26 +268,35 @@
    :camera-pos (v/zero)
    :nodes []
    :edges []
+   :selected-node nil
    :projection :fisheye ; Can be :fisheye or :zoom-out
    ; Subject is part of state because it is needed to render the graph.
    :animation-subject animation-subject})

+(defn deselect-node-if-away! [current-state]
+  (when-let [selected-node (:selected-node @current-state)]
+    (when (and (> (scaled-distance-from-camera @current-state (:pos selected-node))
+                   deselection-distance)
+               (= (:projection @current-state) :fisheye))
+      (swap! current-state assoc :selected-node nil))))
+
+(defn enforce-state-invariants! [current-state]
+  (deselect-node-if-away! current-state)) ; The only invariant for now
+
 (defn swap-state! [current-state f & args]
   (apply swap! current-state f args)
+  (enforce-state-invariants! current-state)
   (sync-graph! @current-state))

 (defn swap-state-animated! [current-state f & args]
   (apply swap! current-state f args)
+  (enforce-state-invariants! current-state)
   (sync-graph! @current-state :animate? true))

-(defn update-state! [current-state k f & args]
-  (apply swap! current-state update k f args)
-  (sync-graph! @current-state))
-
 (defn move-camera! [current-state d]
-  (update-state! current-state :camera-pos v/add
-                 (-> d v/copy (v/multiply
-                                (/ (scroll-scale-for-state @current-state))))))
+  (swap-state! current-state update :camera-pos v/add
+               (-> d v/copy (v/multiply
+                              (/ (scroll-scale-for-state @current-state))))))

 (defn set-projection! [current-state projection]
   (swap-state-animated! current-state assoc :projection projection))
@@ -283,6 +311,12 @@
   (swap-state-animated! current-state assoc
                         :projection :fisheye
                         :camera-pos (v/copy pos)))
+
+(defn select-and-zoom-to-node! [current-state node]
+  (swap-state-animated! current-state assoc
+                        :projection :fisheye
+                        :camera-pos (v/copy (:pos node))
+                        :selected-node node))

 ;; Layout

@@ -358,18 +392,11 @@

 ;; Resize

-(defn fix-detail-button-position! [state]
-  (let [{:keys [detail-button]} state
-        button-width (-> detail-button .node .-offsetWidth)]
-    (-> detail-button
-        (.style "margin-left" (str (/ button-width -2) "px")))))
-
 (defn set-size! [current-state width height]
   (let [svg (:svg @current-state)
         background (.select svg ".background")]
     (-> svg (.attr "width" width) (.attr "height" height))
-    (swap-state! current-state assoc :view-size (v/create width height))
-    (fix-detail-button-position! @current-state)))
+    (swap-state! current-state assoc :view-size (v/create width height))))

 ; Syncing on window size rather than the size of the surrounding container
 ; avoids a layout bug on iOS in which the new container size's height is larger
@@ -600,7 +627,7 @@
     {:node @closest-node
      :distance (js/Math.sqrt @closest-distance-sq)}))

-(defn focus-node-on-tap! [manager current-state animation-observable]
+(defn select-node-on-tap! [manager current-state animation-observable]
   (let [taps (tap-observable manager)]
     (-> taps
         (suppress-while-animating animation-observable)
@@ -608,7 +635,7 @@
         (.filter #(< (:distance %) (/ hitbox-size 2)))
         (.subscribe (fn [{:keys [node]}]
                       (if (= (:projection @current-state) :fisheye)
-                        (zoom-in-to-pos! current-state (:pos node))))))))
+                        (select-and-zoom-to-node! current-state node)))))))

 ;; Exported function to do magic

@@ -620,6 +647,7 @@
         current-state (atom (initial-state svg
                                            detail-button
                                            animation-subject))]
+    (center-detail-button! detail-button)
     (sync-on-window-size! current-state)
     (load-graph "miserables.json"
                 (fn [graph]
@@ -632,4 +660,4 @@
     (switch-zoom-on-spacebar! current-state animation-subject)
     (zoom-on-pinch! gesture-manager current-state animation-subject)
     (zoom-in-on-tap! gesture-manager current-state animation-subject)
-    (focus-node-on-tap! gesture-manager current-state animation-subject)))
+    (select-node-on-tap! gesture-manager current-state animation-subject)))


cjl - Update docstring for transition board

--- src/icfp2015/board.clj
+++ src/icfp2015/board.clj
@@ -45,8 +45,7 @@
 ; [ [:move :west] [:move :east] [:move :southwest] [:move :southeast]
 ;   [:rotate :clockwise] [:rotate :counterclockwise] ]
 (defn transition-board
-  "Given a board and command, returns a new board. Raises if performing
-  the command puts the board into an illegal state"
+  "Given a board and command, returns a new (possibly invalid board)"
   [board [command direction]]
   (if (= command :move)
     (let [unit-fn (apply translate (translations direction))]


:fish_cake:

--- src/main/clj/agency/irl/instagrammer/core.clj
+++ src/main/clj/agency/irl/instagrammer/core.clj
@@ -20,7 +20,7 @@
    :client-secret (env :ig-client-secret)
    :redirect-uri  (env :ig-redirect-uri)
    :website-url   (env :ig-website-url)
-   :callback-url  "https://fierce-retreat-1705.herokuapp.com/callback-url"})
+   :callback-url  "http://fierce-retreat-1705.herokuapp.com/callback-url"})

 (defn handle-websocket
@@ -53,6 +53,8 @@
   (println)
   (println "***")
   (println)
+  (println "PORT: " (env :port))
+  (println)
   (println (style "client-id ....... " :yellow) (style (:client-id client-options)     :red))
   (println (style "client-secret ... " :yellow) (style (:client-secret client-options) :red))
   (println (style "redirect-uri .... " :yellow) (style (:redirect-uri client-options)  :red))
@@ -61,18 +63,18 @@
   (println "***")
   (println)

-  (run-server app {:port 5000})
+  (run-server app {:port (env :port)})

   ;; Bing all that jazz
-  (binding [subscribe/*client-id*     (:client-id client-options)
-            subscribe/*client-secret* (:client-secret client-options)
-            subscribe/*callback-url*  (:callback-url client-options)]
+; (binding [subscribe/*client-id*     (:client-id client-options)
+;           subscribe/*client-secret* (:client-secret client-options)
+;           subscribe/*callback-url*  (:callback-url client-options)]

-    (let [sub-geo (subscribe/geo :lat 40.7903 :lng 73.9597 :radius 25)]
-      (println "<<<<<")
-      (println @sub-geo)
-      (println ">>>>>")
-      ))
+;   (let [sub-geo (subscribe/geo :lat 40.7903 :lng 73.9597 :radius 25)]
+;     (println "<<<<<")
+;     (println @sub-geo)
+;     (println ">>>>>")
+;     ))

 ; (with-instagram client-options
 ;   (let [geo-sub (subscribe/geo :lng 0 :lat 0 :radius 100)


tweak devtools-info helper for browser ext

--- src/main/shadow/cljs/devtools/client/env.cljs
+++ src/main/shadow/cljs/devtools/client/env.cljs
@@ -49,11 +49,12 @@
 (goog-define log-style "font-weight: bold;")

 (defn devtools-info []
-  #js {:server-port server-port
-       :server-host server-host
-       :build-id build-id
-       :proc-id proc-id
-       :runtime-id runtime-id})
+  #js {:server_port server-port
+       :server_host server-host
+       :build_id build-id
+       :proc_id proc-id
+       :runtime_id runtime-id
+       :ssl ssl})

 (defn get-server-host []
   (cond


delaney3d.clj: a bit more work on pseudo toroidal cover

--- clojure/org/gavrog/clojure/delaney3d.clj
+++ clojure/org/gavrog/clojure/delaney3d.clj
@@ -32,11 +32,10 @@
         cones2 (filter (fn [[wd deg]] (= deg 2)) cones)
         cones3 (filter (fn [[wd deg]] (= deg 3)) cones)
         base (map core-table (results (table-generator nr-gens relators 4)))
-        good (for [ct base
-                   :when (flattens-all? ct cones)
-                   index (count ct)
-                   type (if (= index 4)
+        good (for [ct base :when (flattens-all? ct cones)
+                   type (if (= (count ct) 4)
                           (if (not (fully-involutive? ct)) :z4 :v4)
-                          (map core-type index))]
+                          (map core-type (count ct)))]
                [type ct])
+        candidates (reduce (fn [m [k v]] (massoc m k v)) {} good)
         ]))


reset on a button

reset on a button

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -130,9 +130,9 @@
   ;; all the expanded, patched fixtures in it.
   '*show*)

-(use-my-show)
-
-;(use-london-show)
+;(use-my-show)
+
+(use-london-show)

 ; Logging level set to :info
 (core/init-logging)
@@ -245,6 +245,9 @@
         "Automap MIDI" 10 24 :lightness-min-general :min 0 :max 100
           :transform-fn (fn [v] (- 0 v)))

+      ; Reset beat
+      (show/add-midi-control-to-cue-mapping "Automap MIDI" 10 :control 58 7 7)
+
       ; Defaults
       (afterglow.show/set-variable! :lightness-min-general 0)
       (afterglow.show/set-variable! :lightness-max-front 50)
@@ -443,14 +446,35 @@
         :short-name "Sparkle scene"
         ))

-
-  (ct/set-cue! (:cue-grid *show*) 0 8
+  (ct/set-cue! (:cue-grid *show*) 7 7
+    (cues/cue :reset-beat
+      (fn [_] (afterglow.rhythm/metro-start (:metronome *show*) 1)
+              (afterglow.effects/blank))
+        :held true))
+
+  (ct/set-cue! (:cue-grid *show*) 0 3
     (cues/cue :color  (fn [_] (afterglow.effects/scene
-      "Blue and red"
+      "All drums"
         (afterglow.effects.color/color-effect
-          "Plain red" (create-color "red") (show/fixtures-named "back-odd"))
+          "Drums" (params/build-color-param :h :main-hue :s 100 :l :audio-drums) (show/fixtures-named "back"))
         (afterglow.effects.color/color-effect
-          "Plain Blue" (create-color "blue") (show/fixtures-named "back-even"))
+          "Bass" (params/build-color-param :h :main-hue :s 100 :l :audio-drums) (show/fixtures-named "front"))
+    ))))
+  (ct/set-cue! (:cue-grid *show*) 1 3
+    (cues/cue :color  (fn [_] (afterglow.effects/scene
+      "All bass"
+        (afterglow.effects.color/color-effect
+          "Bass" (params/build-color-param :h :main-hue :s 100 :l :audio-bass) (show/fixtures-named "back"))
+        (afterglow.effects.color/color-effect
+          "Bass" (params/build-color-param :h :main-hue :s 100 :l :audio-bass) (show/fixtures-named "front"))
+    ))))
+  (ct/set-cue! (:cue-grid *show*) 2 3
+    (cues/cue :color  (fn [_] (afterglow.effects/scene
+      "Drums back, bass front"
+        (afterglow.effects.color/color-effect
+          "Drums" (params/build-color-param :h :main-hue :s 100 :l :audio-drums) (show/fixtures-named "back"))
+        (afterglow.effects.color/color-effect
+          "Bass" (params/build-color-param :h :main-hue :s 100 :l :audio-bass) (show/fixtures-named "front"))
     ))))

   (ct/set-cue! (:cue-grid *show*) 0 1


main color started

main color started

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -159,6 +159,11 @@
     (params/build-color-param :h 60 :s 100 :l light-param)))
   )

+(def main-color
+  "Main color of the show"
+  (afterglow.effects.params/build-color-param :h 120))
+
+
 (def light-beat (params/build-oscillated-param
                  (oscillators/square-beat) :max 20))

@@ -168,8 +173,6 @@
   (show/sync-to-external-clock
     (afterglow.midi/sync-to-midi-clock "Network midi-net"))
   )
-
-

 (fiat-lux)


Be sure to complete when n-peers is 0

Be sure to complete when n-peers is 0

--- src/onyx/coordinator/async.clj
+++ src/onyx/coordinator/async.clj
@@ -123,7 +123,7 @@
    #(let [nodes (:nodes (extensions/read-node sync complete-node))
           cooldown-node (:node/cooldown nodes)]
       (if-let [result (extensions/complete sync complete-node cooldown-node cb)]
-        (when (= (:n-peers result) 1)
+        (when (<= (:n-peers result) 1)
           (extensions/delete sync complete-node)
           result)
         false))))


Fix ns

Fix ns

--- src/onyx_benchmark/riemann.clj
+++ src/onyx_benchmark/riemann.clj
@@ -1,6 +1,6 @@
 (ns onyx-benchmark.riemann
   (:require [clojure.core.async :refer [chan >!! <!!]]
-            [taoensso.timbre :refer [warn]]
+            [taoensso.timbre :refer [warn info]]
             [riemann.client :as r]))

 (defn zookeeper-write-log-entry [ch config {:keys [latency bytes]}]


freesound-sample takes an id not a path.

--- src/overtone/samples/piano.clj
+++ src/overtone/samples/piano.clj
@@ -25,26 +25,13 @@
    148520 :DB4 148521 :E7  148522 :E6  148523 :E5  148524 :E4  148525 :E3  148526 :E2
    148527 :E1  148528 :DB7 148529 :DB6 148530 :DB5})

-(defn- download-samples
-  "Download piano samples from freesound and store them in the asset
-  store."
-  []
-  (map freesound-path (keys FREESOUND-PIANO-SAMPLES)))
-
-(defn- get-samples
-  "Either fetch samples from the registered store or download them if
-  necessary"
-  []
-  (let [samples (registered-samples)]
-    (if (empty? samples)
-      (download-samples)
-      samples)))
+(def PIANO-SAMPLE-IDS (keys FREESOUND-PIANO-SAMPLES))

 (defonce piano-samples
-  (doall (map freesound-sample (get-samples))))
+  (doall (map freesound-sample PIANO-SAMPLE-IDS)))

 (defn- buffer->midi-note [buf]
-  (-> buf :freesound-id FREESOUND-PIANO-SAMPLES match-note :midi-note))
+  (-> buf :freesound-id FREESOUND-PIANO-SAMPLES name match-note :midi-note))

 (defn- note-index
   "Returns a map of midi-note values [0-127] to buffer ids."


clarity

clarity

--- src/cljs/just_married/home/accommodation.cljs
+++ src/cljs/just_married/home/accommodation.cljs
@@ -15,14 +15,14 @@
 (def ^:private accommodation-dict
   {:en {:title    "Accommodation"
         :suggest  "We suggest booking at the Hotel Villa Immacolata."
-        :code     "The code to get a 10% discount is: \"matrimonio Verrucci\" and prices range from 58 € for the single to the 89 € for the triple room, breakfast included."
+        :code     "The code to get a 10% discount is: \"matrimonio Verrucci\" and prices range from 58 € (per night) for the single to the 89 € for the triple room, breakfast included."
         :distance "As you can see from the map from Villa Immacolata you can even walk to the party venue, and we will organise a Bus from there to the place of the ceremony."
         :contact  "Contact the hotel at %s for booking and more information."}

    :it {:title   "Dove Dormire"
         :suggest "Suggeriamo di pernottare all'Hotel Villa Immacolata."
         ;;TODO: verify if the code can be used directly on booking.com or how else
-        :code    "Il codice per ottenere uno sconto del 10% è: \"matrimonio Verrucci\", e i prezzi variano dai 58 € per la singola ai 89 € per la tripla, colazione inclusa."
+        :code    "Il codice per ottenere uno sconto del 10% è: \"matrimonio Verrucci\", e i prezzi variano dai 58 € (a notte) per la singola ai 89 € per la tripla, colazione inclusa."

         :distance "Come si puó vedere dalla mappa Villa Immacolata é a soli 5 minuti a piedi dal Parco dei Principi (dove si svolge la festa), e ci sarà un Pullman organizzato che porta dall'Hotel al luogo della cerimonia."
         :contact  "Potete contattare l'hotel alla mail %s per prenotare e per ulteriori informazioni"}})


general code cleanup

general code cleanup

* saner var names
* restructure code in servlets, appstats, etc.

Signed-off-by: Gregg Reynolds <d0f77bc71a9867acdcb4f62f012b858edad79160@norc.org>

--- src/migae/boot_gae.clj
+++ src/migae/boot_gae.clj
@@ -273,7 +273,7 @@
   "generate gae appengine-web.xml"
   [c config-syms SYMS #{sym} "namespaced symbols bound to meta-config data"
    d dir DIR str "output dir"
-   k keep bool str "keep intermediate .clj files"
+   k keep bool "keep intermediate .clj files"
    m module MODULE str "module dirpath"
    v verbose bool "Print trace messages."]
   ;; boolean hasUppercase = !password.equals(password.toLowerCase());
@@ -362,19 +362,18 @@
              ;; (boot/by-name [boot-config-edn]))
              boot-config-edn-f (condp = (count boot-config-edn-files)
                                  0 (do (util/info (str "Creating " boot-config-edn "\n"))
-                                       ;; this creates a java.io.File
-                                       (io/file boot-config-edn))
-                                 1 ;; this is a boot.tmpdir.TmpFile
-                                 (first boot-config-edn-files)
+                                       (io/file boot-config-edn)) ;; this creates a java.io.File
+                                 1 (first boot-config-edn-files)  ;; this is a boot.tmpdir.TmpFile
                                  (throw (Exception. "only one _boot_config.edn file allowed")))
-             ;; _ (println "boot-config-edn-f: " boot-config-edn-f)
              boot-config-edn-map (if (instance? boot.tmpdir.TmpFile boot-config-edn-f)
                                    (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
                                    {})]
          ;; (println "boot-config-edn-map: " boot-config-edn-map)
+
          (if (:appstats boot-config-edn-map)
            fileset
            (do
+             ;; step 1: read the edn config file
              (let [appstats-fs (->> (boot/input-files fileset)
                                     (boot/by-name [appstats-edn]))]
                (if (= (count appstats-fs) 0)
@@ -383,7 +382,9 @@
                  (throw (Exception. (str "only one " appstats-edn " file allowed"))))
                (let [appstats-edn-f (first appstats-fs)
                      appstats-config (-> (boot/tmp-file appstats-edn-f) slurp read-string)]
-                 (util/info (str "Elaborating " boot-config-edn " with :appstats stanza\n"))
+
+                 ;; step 2: inject appstats config map into master config map
+                 (if verbose (util/info (str "Elaborating " boot-config-edn " with :appstats stanza\n")))
                  (let [m (-> boot-config-edn-map
                              (assoc-in [:appstats] (:appstats appstats-config)))
                        boot-config-edn-s (with-out-str (pp/pprint m))
@@ -396,8 +397,13 @@
                    (spit boot-config-edn-out-file boot-config-edn-s)))))))
        (reset! prev-pre
                (-> fileset
-                   (boot/add-source workspace)
-                   boot/commit!))))))
+                   (boot/add-resource workspace)
+                   boot/commit!)))
+     (if keep
+       (comp
+        (builtin/sift :to-resource #{(re-pattern boot-config-edn)})
+       identity)
+     ))))

 (declare earxml filters install-sdk libs logging reloader servlets target webxml)

@@ -439,7 +445,7 @@
      )))

 (boot/deftask build
-  "assemble, configure, and build app"
+  "Configure and build servlet or service app"
   [k keep bool "keep intermediate .clj and .edn files"
    p prod bool "production build, without reloader"
    s service bool "build a service"
@@ -531,7 +537,7 @@
   "generate xml config files for microservices app"
   [d dir DIR str "output dir"
    c config-syms SYMS #{sym} "namespaced symbols bound to meta-config data"
-   k keep bool str "keep intermediate .clj files"
+   k keep bool "keep intermediate .clj files"
    v verbose bool "Print trace messages."]
   (let [edn-tmp (boot/tmp-dir!)
         prev-pre (atom nil)
@@ -651,7 +657,7 @@
     (. method invoke nil invoke-args)))

 (boot/deftask filters
-  "generate filters; update _boot_config.edn with filter config data"
+  "generate filters class files"

   [k keep bool "keep intermediate .clj files"
    n gen-filters-ns NS str "namespace to generate and aot; default: 'filters"
@@ -815,7 +821,7 @@

 ;; FIXME:  for dev phase, we want to include deps in test scope
 (boot/deftask libs
-  ""
+  "Install dependency jars in WEB-INF/lib"
   [v verbose bool "Print trace messages."]
   (let [checkout-vec (-> (boot/get-env) :checkouts)
         cos (map #(assoc (apply hash-map %) :coords [(first %) (second %)]) checkout-vec)
@@ -999,7 +1005,7 @@
    s service bool "build as service"
    w web-inf WEB-INF str "WEB-INF dir, default: WEB-INF"
    v verbose bool "Print trace messages."]
-  (let [edn-tmp (boot/tmp-dir!)
+  (let [workspace (boot/tmp-dir!)
         prev-pre (atom nil)
         web-inf (if web-inf web-inf web-inf-dir)

@@ -1014,35 +1020,38 @@
         ]
     (comp
      (boot/with-pre-wrap [fileset]
-       (let [webapp-edn-files (->> (boot/fileset-diff @prev-pre fileset)
-                                   boot/input-files
-                                   (boot/by-name [webapp-edn]))
-             webapp-edn-f (condp = (count webapp-edn-files)
-                            0 nil
-                            1 (first webapp-edn-files)
-                            (throw (Exception. "only one webapp.edn file allowed")))
-             webapp-edn-map (if webapp-edn-f (-> (boot/tmp-file webapp-edn-f) slurp read-string) {})
+       (let [
+             ;; webapp-edn-files (->> (boot/fileset-diff @prev-pre fileset)
+             ;;                       boot/input-files
+             ;;                       (boot/by-name [webapp-edn]))
+             ;; webapp-edn-f (condp = (count webapp-edn-files)
+             ;;                0 nil
+             ;;                1 (first webapp-edn-files)
+             ;;                (throw (Exception. "only one webapp.edn file allowed")))
+             ;; webapp-edn-map (if webapp-edn-f (-> (boot/tmp-file webapp-edn-f) slurp read-string) {})
              boot-config-edn-files (->> (boot/fileset-diff @prev-pre fileset)
                                     boot/input-files
                                     (boot/by-re [(re-pattern (str boot-config-edn "$"))]))
                                     ;; (boot/by-name [boot-config-edn]))
              boot-config-edn-f (condp = (count boot-config-edn-files)
                              0 (do (util/info (str "Creating " boot-config-edn "\n"))
-                                   nil)
-                             1 (first boot-config-edn-files)
+                                   (io/file boot-config-edn)) ;; this creates a java.io.File
+                             1 (first boot-config-edn-files)  ;; this is a boot.tmpdir.TmpFile
                              (throw (Exception.
-                                     (str "only one _boot_config.edn file allowed, found " (count boot-config-edn-files)))))
-             boot-config-edn-map (if boot-config-edn-f
-                                 (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
-                                 {})
-             boot-config-edn-map (merge boot-config-edn-map webapp-edn-map)]
-         ;; (println "boot-config-edn-map: " boot-config-edn-map)
+                                     (str "only one _boot_config.edn file allowed, found "
+                                          (count boot-config-edn-files)))))
+             boot-config-edn-map (if (instance? boot.tmpdir.TmpFile boot-config-edn-f)
+                                   (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
+                                   {})
+             ;; boot-config-edn-map (merge boot-config-edn-map webapp-edn-map)
+             ]
+         (println "boot-config-edn-map: " boot-config-edn-map)

          (if (:reloader boot-config-edn-map)
            fileset
            (do
-             ;; step 1: inject :reloader stanza into _boot_config.edn
              ;; (add-reloader! reloader-impl-ns urls in-file out-file)
+             ;; step 1: create config map for reloader, inject into master config file
              (let [urls (flatten (concat (map #(% :urls) (:servlets boot-config-edn-map))))
                    m (-> boot-config-edn-map (assoc-in [:reloader]
                                                  {:ns reloader-impl-ns
@@ -1052,7 +1061,10 @@
                                                             (vec urls))
                                                   :desc {:text "Clojure reload filter"}}))
                    boot-config-edn-s (with-out-str (pp/pprint m))
-                   boot-config-edn-out-file (io/file edn-tmp (boot/tmp-path boot-config-edn-f))]
+                   boot-config-edn-out-file (io/file workspace
+                                                     (if (instance? boot.tmpdir.TmpFile boot-config-edn-f)
+                                                       (boot/tmp-path boot-config-edn-f)
+                                                       boot-config-edn-f))]
                (io/make-parents boot-config-edn-out-file)
                (spit boot-config-edn-out-file boot-config-edn-s))

@@ -1077,7 +1089,7 @@
                (util/info "Configuring reloader\n")
                (reset! prev-pre
                        (-> fileset
-                           (boot/add-source edn-tmp)
+                           (boot/add-source workspace)
                            (boot/add-source aot-tmp-dir)
                            (boot/add-asset impl-tmp-dir)
                            boot/commit!)))))))
@@ -1212,18 +1224,14 @@
                            :ns ns})))))})

 (boot/deftask servlets
-  "generate servlets; update _boot_config.edn with servlet config data"
-
-  ;; both subtasks require reading of servlets.edn
-  ;; read from resources if avail, otherwise input
-
+  "generate servlets class files"
   [k keep bool "keep intermediate .clj files"
    ;; d odir DIR str "output dir for generated class files"
    ;; c config-sym SYM sym "namespaced symbol bound to meta-config data"
    n gen-servlets-ns NS str "namespace to generate and aot; default: 'servlets"
    w web-inf WEB-INF str "WEB-INF dir, default: WEB-INF"
    v verbose bool "Print trace messages."]
-  (let [edn-tmp-dir (boot/tmp-dir!)
+  (let [workspace (boot/tmp-dir!)
         prev-pre (atom nil)
         ;; config-sym (if config-sym config-sym 'servlets/config)
         ;; config-ns (symbol (namespace config-sym))
@@ -1238,58 +1246,67 @@
                                     boot/input-files
                                     (boot/by-re [(re-pattern (str boot-config-edn "$"))]))
              boot-config-edn-f (condp = (count boot-config-edn-files)
-                             0 (do (util/info (str "Creating " boot-config-edn "\n"))
-                                   nil)
-                             1 (first boot-config-edn-files)
-                             (throw (Exception. "only one _boot_config.edn file allowed; found " (count boot-config-edn-files))))
-             boot-config-edn-map (if boot-config-edn-f
-                                 (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
-                                 {})]
+                             0 (do (if verbose (util/info (str "Creating " boot-config-edn "\n")))
+                                   (io/file boot-config-edn)) ;; this creates a java.io.File
+                             1 (first boot-config-edn-files)  ;; this is a boot.tmpdir.TmpFile
+                             (throw (Exception.
+                                     (str "only one " boot-config-edn " file allowed; found "
+                                          (count boot-config-edn-files)))))
+             boot-config-edn-map (if (instance? boot.tmpdir.TmpFile boot-config-edn-f)
+                                   (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
+                                   {})]
          ;; (println "boot-config-edn-map: " boot-config-edn-map)
+
          (if (:servlets boot-config-edn-map)
              fileset
              (do
-               ;; step 0: read the edn files
+               ;; step 1: read the edn config file and construct map
                (let [servlets-edn-files (->> (boot/input-files fileset)
-                                             (boot/by-name [servlets-edn]))]
-                 (if (> (count servlets-edn-files) 1)
-                   (throw (Exception. "only one servlets.edn file allowed")))
-                 (if (= (count servlets-edn-files) 0)
-                   (throw (Exception. "cannot find servlets.edn")))
-
-                 (let [edn-servlets-f (first servlets-edn-files)
-                       servlet-configs (-> (boot/tmp-file edn-servlets-f) slurp read-string)
-                       servlet-configs (normalize-servlet-configs servlet-configs)
-                       clj-servlets {:servlets (filter #(nil? (:class %)) (:servlets servlet-configs))}
-                       smap (-> boot-config-edn-map (assoc-in [:servlets]
-                                                        (:servlets servlet-configs)))
-                       boot-config-edn-s (with-out-str (pp/pprint smap))]
-                   ;; (println "new boot-config-edn: " boot-config-edn-s)
-                   ;; step 1:  inject servlet config stanza to _boot_config.edn
-                   (let [boot-config-edn-out-file (io/file edn-tmp-dir (boot/tmp-path boot-config-edn-f))]
-                     ;; (println "edn out: " boot-config-edn-out-file)
-                     (io/make-parents boot-config-edn-out-file)
-                     (spit boot-config-edn-out-file boot-config-edn-s))
-
-                   ;; step 2: gen servlets
-                   (let [gen-servlets-content (stencil/render-file "migae/templates/gen-servlets.mustache"
-                                                                   (assoc clj-servlets
-                                                                          :gen-servlets-ns
-                                                                          gen-servlets-ns))
-                         gen-servlets-out-file (doto
-                                                   (io/file gen-servlets-tmp-dir gen-servlets-path)
-                                                 io/make-parents)]
-                     (spit gen-servlets-out-file gen-servlets-content)))))))
-       (util/info "Configuring servlets...\n")
-
-       ;; step 3: commit files to fileset
+                                             (boot/by-name [servlets-edn]))
+                     servlets-edn-f (condp = (count servlets-edn-files)
+                                        0 (throw (Exception. (str "Cannot find " servlets-edn " file.")))
+                                        1 (first servlets-edn-files)
+                                        ;; > 1
+                                        (throw (Exception.
+                                                (str "Only one " servlets-edn "file allowed; found "
+                                                     (count servlets-edn-files)))))
+                     servlets-edn-map (-> (boot/tmp-file servlets-edn-f) slurp read-string)
+                     servlets-config-map (normalize-servlet-configs servlets-edn-map)
+                     servlets-config-map {:servlets (filter #(nil? (:class %))
+                                                            (:servlets servlets-config-map))}
+
+                     ;; step 2: inject servlets config map into master config map
+                     master-config (-> boot-config-edn-map (assoc-in [:servlets]
+                                                                     (:servlets servlets-config-map)))
+                     master-config (with-out-str (pp/pprint master-config))
+                     ;; step 3: create new master config file
+                     boot-config-edn-out-file (io/file workspace
+                                                       (if (instance? boot.tmpdir.TmpFile boot-config-edn-f)
+                                                         (boot/tmp-path boot-config-edn-f)
+                                                         boot-config-edn-f))
+                     ;; step 4: create servlet generator
+                     gen-servlets-content (stencil/render-file "migae/templates/gen-servlets.mustache"
+                                                               (assoc servlets-config-map
+                                                                      :gen-servlets-ns
+                                                                      gen-servlets-ns))
+                     gen-servlets-out-file (doto (io/file gen-servlets-tmp-dir gen-servlets-path)
+                                             io/make-parents)]
+                 ;; step 5: write new files
+                 (io/make-parents boot-config-edn-out-file)
+                 (spit boot-config-edn-out-file master-config)
+                 (spit gen-servlets-out-file gen-servlets-content)))))
+
+       (if verbose (util/info "Configuring servlets...\n"))
+
+       ;; step 6: commit files to fileset
        (reset! prev-pre
                (-> fileset
-                   (boot/add-source edn-tmp-dir)
+                   (boot/add-source workspace)
                    (boot/add-source gen-servlets-tmp-dir)
                    boot/commit!)))
-     (builtin/aot :namespace #{gen-servlets-ns}) ;; :dir (str web-inf "/classes"))
-     ;; (builtin/sift :move {#"(.*class$)" (str web-inf "/classes/$1")})
+
+     (builtin/aot :namespace #{gen-servlets-ns})
+
      (if keep
        identity
        (builtin/sift :include #{(re-pattern (str gen-servlets-ns ".*.class"))}
@@ -1305,7 +1322,7 @@
   "generate gae web.xml"
   [d dir DIR str "output dir"
    c config-syms SYMS #{sym} "namespaced symbols bound to meta-config data"
-   k keep bool str "keep intermediate .clj files"
+   k keep bool "keep intermediate .clj files"
    r reloader bool "install reloader filter"
    v verbose bool "Print trace messages."]
 ;;  (println "TASK: config-webapp")


shittiest bar chart in the world

shittiest bar chart in the world

--- src/mortgage/core.cljs
+++ src/mortgage/core.cljs
@@ -154,18 +154,22 @@
 (sm/defn draw-bar-graph [y-axis-label :- s/Str
                          data-points :- [s/Num]]
   [:svg {:width 400 :height 300}
-   [:line {:x1 100 :y1 20
-           :x2 100 :y2 280
-           :stroke "black"
+   [:line {:x1           100 :y1 20
+           :x2           100 :y2 280
+           :stroke       "black"
            :stroke-width 1}]
-   [:line {:x1 100 :y1 280
-           :x2 400 :y2 280
-           :stroke "black"
+   [:line {:x1           100 :y1 280
+           :x2           400 :y2 280
+           :stroke       "black"
            :stroke-width 1}]
    [:text {:x 70 :y 235 :transform "rotate(270 75 230)"} y-axis-label]
    [:text {:x 90 :y 30 :text-anchor "end"} (str "$" (.toLocaleString (int (apply max data-points))))]
-   ]
-  )
+   (for [[index point] (map-indexed vector data-points)]
+     ^{:key (str "rect-" point)} [:rect {:x         (+ 110 (* index 50))
+                                         :y         30
+                                         :width     40
+                                         :height    (* 250
+                                                       (/ point (apply max data-points)))}])])

 (sm/defn draw-money-wasted [state :- UIState]
   [draw-bar-graph "Money Wasted On Interest" (map (comp :interest total-price-breakdown) (:mortgages state))]


Correct typo; formatting changes

Correct typo; formatting changes

--- src/io/aviso/twixt/tracker.clj
+++ src/io/aviso/twixt/tracker.clj
@@ -17,9 +17,9 @@
   "Checks to see if an exception (or any of the exception's causes) is an IExceptionInfo containing an :exception-trace."
   [^Throwable e]
   (cond
-   (nil? e) false
-   (some-> e ex-data :exception-trace) true
-   :else (recur (.getCause e))))
+    (nil? e) false
+    (some-> e ex-data :exception-trace) true
+    :else (recur (.getCause e))))

 (defn- log-trace [logger trace-messages message e]
   (.error logger "An exception has occurred:")
@@ -29,10 +29,10 @@

 (defn trace-function
   "Traces the execution of a function of no arguments. The trace macro converts into a call to track-function.
-
-   logger - SLF4J Logger where logging should occur
-   trace-message - String, object, or function. Function evaulation is deferred until an exception is actually thrown.
-   f - function to invoke."
+
+  logger - SLF4J Logger where logging should occur
+  trace-message - String, object, or function. Function evaulation is deferred until an exception is actually thrown.
+  f - function to invoke."
   [logger trace-message f]
   (binding [trace-messages (conj trace-messages trace-message)]
     (try
@@ -56,9 +56,9 @@

 (defmacro trace
   "Traces the execution of its body. trace-message may be a string, or a function that returns a string; execution of
-the function is deferred until needed. If an exception occurs inside the body, then all trace messages leading up to the
-point of exception will be logged (the logger is determined from the current namespace); this logging only occurs at the
-most deeply nested trace."
+  the function is deferred until needed. If an exception occurs inside the body, then all trace messages leading up to the
+  point of exception will be logged (the logger is determined from the current namespace); thus logging only occurs at the
+  most deeply nested trace."
   [trace-message & body]
   `(trace-function (get-logger ~*ns*) ~trace-message #(do ~@body)))

@@ -73,6 +73,6 @@

 (defmacro log-time
   "Executes the body, timing the result. The elapsed time in milliseconds (as a double) is passed to the formatter function, which returns
-a string. The resulting string is logged at INFO priority."
+  a string. The resulting string is logged at INFO priority."
   [formatter & body]
   `(time-function #(do ~@body) #(l/info (~formatter %))))


less groups

less groups

--- src/polismath/conversation.clj
+++ src/polismath/conversation.clj
@@ -16,10 +16,8 @@
                   (cond
                    (< len 3) 1
                    (< len 5) 2
-                   (< len 7) 3
-                   (< len 15) 4
-                   (< len 30) 5
-                   :else 6
+                   (< len 99) 3
+                   :else 4
                   )))

 (defn agg-bucket-votes-for-tid [bid-to-pid rating-mat filter-cond tid]


Remove unnecessary code

Remove unnecessary code

--- src/elfeed_cljsrn/android/scenes/entries.cljs
+++ src/elfeed_cljsrn/android/scenes/entries.cljs
@@ -88,15 +88,11 @@
        [icon {:style (:icon styles) :name "archive" :size 22}]]]]))

 (defn no-entries-component []
-  (let [loading? (subscribe [:loading?])
-        styles {:wrapper {:height 300
+  (let [styles {:wrapper {:height 300
                           :align-items "center"}}]
-    (fn []
-      (let [label (if @loading? "LOADING..." "REFRESH")
-            on-press-fn (when-not @loading? #(dispatch [:fetch-content]))]
-        [rn/view {:style (:wrapper styles)}
-         [icon {:style {} :name "rss-feed" :size 84}]
-         [rn/text "There are no entries"]]))))
+    [rn/view {:style (:wrapper styles)}
+     [icon {:style {} :name "rss-feed" :size 84}]
+     [rn/text "There are no entries"]]))

 (defn entries-scene []
   (let [loading (subscribe [:loading?])


mega-insert for trie!

mega-insert for trie!

--- modules/reitit-core/src/reitit/trie.cljc
+++ modules/reitit-core/src/reitit/trie.cljc
@@ -89,8 +89,16 @@
           (update :children dissoc ""))
       node')))

-(defn insert [node path data]
-  (-insert (or node (-node {})) (-split path) data))
+(defn insert
+  ([routes]
+    (insert nil routes))
+  ([node routes]
+   (reduce
+     (fn [acc [p d]]
+       (insert acc p d))
+     node routes))
+  ([node path data]
+   (-insert (or node (-node {})) (-split path) data)))

 (defn ^Trie$Matcher compile [{:keys [data children wilds catch-all]}]
   (let [matchers (cond-> []


Fix --cljx replace {{sanitize}} in path

Fix --cljx replace {{sanitize}} in path

--- src/leiningen/new/chestnut.clj
+++ src/leiningen/new/chestnut.clj
@@ -134,7 +134,7 @@
           (less? opts) (conj "src/less/style.less")
           (sass? opts) (conj "src/scss/style.scss")
           (not (or (less? opts) (sass? opts))) (conj "resources/public/css/style.css")
-          (cljx? opts) (conj "src/cljx/{{sanitized}}/core.cljx")
+          (cljx? opts) (conj "src/cljx/chestnut/core.cljx")
           (speclj? opts) (conj "bin/speclj"
                              "spec/clj/chestnut/server_spec.clj"
                              "spec/cljs/chestnut/core_spec.cljs"


Added note about EDSC parsing of leading wild card validation error message.

--- search-app/src/cmr/search/validators/leading_wildcard_validation.clj
+++ search-app/src/cmr/search/validators/leading_wildcard_validation.clj
@@ -28,6 +28,7 @@
   "Returns an error message to explain that there are too many wildcard patterns in the query."
   [num-conditions]
   (format
+   ;; NOTE: EDSC parses this error message. Do not change without coordinating with edsc developers.
    (str "The query contained [%d] conditions which used a leading wildcard. This is more than the "
         "maximum allowed amount of [%d]. The CMR allows searching with patterns containing the "
         "wildcards * and ?. Patterns which start with a wildcard are expensive to execute so the "


worked out how to get live reload working

--- src/one_route/core.clj
+++ src/one_route/core.clj
@@ -1,4 +1,5 @@
 (ns one-route.core
+  (:use [ring.middleware.reload])
   (:require [compojure.handler :as handler]
             [compojure.core
              :as c-core
@@ -11,11 +12,14 @@
   (GET "/" [] (slurp "resources/public/html/index.html"))
   (c-route/resources "/"))

-(defn app []
-  (-> (handler/api api)
-    (ring-json/wrap-json-body {:keywords? true})
-    (ring-json/wrap-json-response)))
+(def app
+  (-> (var api)
+      (handler/api)
+      (wrap-reload '(one-route.core))
+      (ring-json/wrap-json-body {:keywords? true})
+      (ring-json/wrap-json-response)))

 (defn start-server []
-  (server/serve (app) {:port 8070
-                       :open-browser? false}))+  (server/serve #'app {:port 8070
+                       :join? false
+                       :open-browser? false}))


wrap-params encoding now an optional argument

--- src/ring/middleware/params.clj
+++ src/ring/middleware/params.clj
@@ -4,14 +4,10 @@
   (:use clojure.contrib.str-utils)
   (:import java.net.URLDecoder))

-(defvar *encoding* "UTF-8"
-  "The encoding to use to decode urlencoded parameters. Defaults to
-  UTF-8.")
-
 (defn- urldecode
   "Decode a urlencoded string using the *encoding* var."
-  [s]
-  (URLDecoder/decode s *encoding*))
+  [text encoding]
+  (URLDecoder/decode text encoding))

 (defn- assoc-vec
   "Associate a key with a value. If the key already exists in the map,
@@ -24,24 +20,24 @@
         [cur val])
       val)))

-(defn parse-params
+(defn- parse-params
   "Parse parameters from a string into a map."
-  [#^String param-string]
+  [#^String param-string encoding]
   (reduce
     (fn [param-map encoded-param]
       (if-let [[_ key val] (re-matches #"([^=]+)=(.*)" encoded-param)]
         (assoc-vec param-map
-          (urldecode key)
-          (urldecode (or val "")))
+          (urldecode key encoding)
+          (urldecode (or val "") encoding))
          param-map))
     {}
     (re-split #"&" param-string)))

 (defn- assoc-query-params
   "Parse and assoc parameters from the query string with the request."
-  [request]
+  [request encoding]
   (if-let [query-string (:query-string request)]
-    (let [params (parse-params query-string)]
+    (let [params (parse-params query-string encoding)]
       (merge-with merge request {:query-params params, :params params}))
     request))

@@ -53,9 +49,9 @@

 (defn- assoc-form-params
   "Parse and assoc parameters from the request body with the request."
-  [request]
+  [request encoding]
   (if-let [body (and (urlencoded-form? request) (:body request))]
-    (let [params (parse-params (slurp* body))]
+    (let [params (parse-params (slurp* body) encoding)]
       (merge-with merge request {:form-params params, :params params}))
     request))

@@ -65,10 +61,14 @@
   the request map:
     :query-params - a map of parameters from the query string
     :form-params  - a map of parameters from the body
-    :params       - a merged map of both query and form parameters"
-  [handler]
-  (fn [request]
-    (-> request
-      assoc-form-params
-      assoc-query-params
-      handler)))
+    :params       - a merged map of both query and form parameters
+  Takes an optional argument to specify the encoding of the parameters.
+  Defaults to UTF-8."
+  ([handler]
+    (wrap-params handler "UTF-8"))
+  ([handler encoding]
+    (fn [request]
+      (-> request
+        (assoc-form-params encoding)
+        (assoc-query-params encoding)
+        handler))))


JC | #27 | Log stacktrace as well as exception name

--- src/stonecutter/middleware.clj
+++ src/stonecutter/middleware.clj
@@ -15,7 +15,7 @@
       (try
         (handler request)
         (catch Exception e
-          (log/error e)
+          (log/error e e)
           (err-handler request))))
     handler))


Remove defn cruft for -test.

Remove defn cruft for -test.


fixed bad error-message

fixed bad error-message

--- src/strictly_specking/core.clj
+++ src/strictly_specking/core.clj
@@ -659,9 +659,10 @@
   (str "Found unrecognized key " (color (pr-str (::unknown-key e)) :error-key)
        " at path " (color (pr-str (error-path-parent e)) :focus-path) "\n"
        ;; doesn't work when there is only one key
-       (if (= 1 (count pred))
-         (str "The only allowed key is: " (pr-str (first pred)) )
-         (str "Must be one of: " (ep/format-seq-with-or pred)))))
+       (let [pred (second pred)]
+         (if (= 1 (count pred))
+           (str "The only allowed key is: " (pr-str (first pred)))
+           (str "Must be one of: " (ep/format-seq-with-or pred))))))

 (defmethod inline-message ::unknown-key [e]
   (str "The key " (::unknown-key e) " is unrecognized"))


task aot: add option -d compile-path-sfx

This option allows the user to set *compile-path*, which is
where compiled .class files go.  The specified path will be
relativized if necessary and suffixed to the build root dir.

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -549,9 +549,13 @@
   "Perform AOT compilation of Clojure namespaces."

   [a all          bool   "Compile all namespaces."
-   n namespace NS #{sym} "The set of namespaces to compile."]
+   n namespace NS #{sym} "The set of namespaces to compile."
+   d compile-path-sfx PATH str "*compile-path* suffix"]

   (let [tgt         (core/tmp-dir!)
+        sfx (if compile-path-sfx (clojure.string/replace compile-path-sfx #"^/" "") nil)
+        sfx (if (empty? sfx) nil sfx) ;; handle pathological case -d "/"
+        compile-path (if sfx (str (.getPath tgt) "/" sfx) (.getPath tgt))
         pod-env     (update-in (core/get-env) [:directories] conj (.getPath tgt))
         compile-pod (future (pod/make-pod pod-env))]
     (core/with-pre-wrap [fs]
@@ -559,7 +563,9 @@
       (let [all-nses (->> fs core/fileset-namespaces)
             nses     (->> all-nses (set/intersection (if all all-nses namespace)) sort)]
         (pod/with-eval-in @compile-pod
-          (binding [*compile-path* ~(.getPath tgt)]
+          ~(io/make-parents (io/file tgt (if sfx (str sfx "/dummy") "")))
+          (boot.pod/add-classpath ~compile-path)
+          (binding [*compile-path* ~compile-path] ;; ~(.getPath tgt)]
             (doseq [[idx ns] (map-indexed vector '~nses)]
               (boot.util/info "Compiling %s/%s %s...\n" (inc idx) (count '~nses) ns)
               (compile ns)))))


Warn if aot task is called but nothing to compile has been specified (#576)

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -788,6 +788,8 @@
   [a all          bool   "Compile all namespaces."
    n namespace NS #{sym} "The set of namespaces to compile."]

+  (when (empty? *opts*)
+    (util/warn "No flags specified for aot task, skipping...\n"))
   (let [tgt         (core/tmp-dir!)
         pod-env     (update-in (core/get-env) [:directories] conj (.getPath tgt))
         compile-pod (future (pod/make-pod pod-env))]


Add `utils/repeatedly*` and `utils/mapv*`

--- src/taoensso/carmine/utils.clj
+++ src/taoensso/carmine/utils.clj
@@ -75,4 +75,18 @@
 ;; TODO Waiting for Clojure 1.5 support
 ;; (defn keywordize-map [m] (reduce-kv (fn [m k v] (assoc m (keyword k) v)) {}
 ;;                                     (or m nil) ; For < 1.5.0-RC3 (CLJ-1098)
-;;                                     ))+;;                                     ))
+
+(defn repeatedly* "Like `repeatedly` but faster and returns a vector."
+  [n f]
+  (loop [v (transient []) idx 0]
+    (if (>= idx n)
+      (persistent! v)
+      (recur (conj! v (f)) (inc idx)))))
+
+(defn mapv* ; Imported from Clojure 1.4
+  ([f coll] (-> (reduce (fn [v o] (conj! v (f o))) (transient []) coll)
+                persistent!))
+  ([f c1 c2]            (into [] (map f c1 c2)))
+  ([f c1 c2 c3]         (into [] (map f c1 c2 c3)))
+  ([f c1 c2 c3 & colls] (into [] (apply map f c1 c2 c3 colls))))