Specialized t1 world-cmd-loop implementation.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -1,6 +1,7 @@
 (ns cbfg.world.t1
   (:require-macros [cljs.core.async.macros :refer [go-loop]]
-                   [cbfg.act :refer [act act-loop actx-top achan achan-buf aput atake]])
+                   [cbfg.act :refer [act act-loop actx-top achan achan-buf
+                                     aalts aput atake]])
   (:require [cljs.core.async :refer [<! >! close! chan map< merge timeout dropping-buffer]]
             [goog.dom :as gdom]
             [om.core :as om :include-macros true]
@@ -24,9 +25,14 @@
                      :net-connect-ch (achan-buf world 10)
                      :res-ch (achan-buf world 10)})
   (reset! prog-curr {:servers {}   ; { server-addr => ports }.
-                     :clients {}}) ; { client-addr => client-info }.
+                     :clients {}   ; { client-addr => client-info }.
+                     :reqs    {}}) ; { opaque-ts => [req, [[reply-ts reply] ...] }.
   (reset! prog-hover nil)
   (reset! prog-history []))
+
+(defn prog-event [label fn]
+  (let [pc (swap! prog-curr fn)]
+    (swap! prog-history #(conj % [(count %) label pc]))))

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

@@ -75,10 +81,8 @@

 (defn world-vis-init [el-prefix init-event-delay]
   (init-roots)
-  (let [event-delay (atom init-event-delay)
-        step-ch (chan (dropping-buffer 1))
-        prog-ch (listen-el (gdom/getElement "prog-go") "click")
-        cmd-ch (map< (fn [ev] {:op (.-id (.-target ev))
+  (let [req-handlers cbfg.world.lane/cmd-handlers
+        req-ch (map< (fn [ev] {:op (.-id (.-target ev))
                                :x (js/parseInt (get-el-value "x"))
                                :y (js/parseInt (get-el-value "y"))
                                :delay (js/parseInt (get-el-value "delay"))
@@ -88,7 +92,10 @@
                                :color (get-el-value "color")
                                :sleep (js/parseInt (get-el-value "sleep"))})
                      (merge (map #(listen-el (gdom/getElement %) "click")
-                                 (keys cbfg.world.lane/cmd-handlers))))
+                                 (keys req-handlers))))
+        event-delay (atom init-event-delay)
+        step-ch (chan (dropping-buffer 1))
+        prog-ch (listen-el (gdom/getElement "prog-go") "click")
         run-controls-ch (cbfg.vis/vis-run-controls event-delay step-ch "header")]
     (go-loop [num-worlds 0]
       (let [last-id (atom 0)
@@ -122,22 +129,31 @@
         (make-net world
                   (:net-listen-ch @prog-base)
                   (:net-connect-ch @prog-base))
-        (let [vis-chs {}
-              req-ch (achan world)
+        (let [res-ch (:res-ch @prog-base)
               expand-ch (listen-el (gdom/getElement (str el-prefix "-html")) "click")
               prog-in (get-el-value "prog-in")
               prog-js (str "with (cbfg.world.t1) {" prog-in "}")
               prog-res (try (js/eval prog-js) (catch js/Object ex ex))]
           (println :prog-res prog-res)
-          (world-cmd-loop world cbfg.world.lane/cmd-handlers cmd-ch
-                          req-ch (:res-ch @prog-base)
-                          vis-chs world-vis-init el-prefix)
-          (act-loop cmd-dispatch-loop world [num-dispatches 0]
-                    (when-let [msg (atake cmd-dispatch-loop req-ch)]
-                      (when-let [client-req-ch
-                                 (get-in @prog-curr [:clients (:client msg) :req-ch])]
-                        (aput cmd-dispatch-loop client-req-ch msg))
-                      (recur (inc num-dispatches))))
+          (act-loop main-loop world [num-requests 0 num-responses 0]
+                    (let [[v ch] (aalts main-loop [req-ch res-ch])
+                          ts (+ num-requests num-responses)]
+                      (when v
+                        (if (= ch req-ch)
+                          (if (= (:op v) "replay")
+                            (println "TODO-REPLAY-IMPL")
+                            (let [req ((get req-handlers (:op v)) (assoc v :opaque ts))]
+                              (when-let [client-req-ch
+                                         (get-in @prog-curr
+                                                 [:clients (:client req) :req-ch])]
+                                (prog-event [:req] #(assoc-in % [:reqs ts] [req nil]))
+                                (cbfg.world.base/render-client-hist (:reqs @prog-curr))
+                                (aput main-loop client-req-ch req)
+                                (recur (inc num-requests) num-responses))))
+                          (do (prog-event [:res] #(update-in % [:reqs (:opaque v) 1]
+                                                             conj [ts v]))
+                              (cbfg.world.base/render-client-hist (:reqs @prog-curr))
+                              (recur num-requests (inc num-responses)))))))
           (go-loop [] ; Process expand/collapse UI events.
             (when-let [ev (<! expand-ch)]
               (let [actx-id (cbfg.vis/no-prefix (.-id (.-target ev)))]
@@ -148,11 +164,10 @@
                     (>! event-run-ch [@vis nil true nil])))
                 (recur))))
           (<! prog-ch)
-          (close! req-ch)
           (close! expand-ch)
           (close! event-run-ch)
           (close! event-ch)
-          (close! (:res-ch @prog-base))
+          (close! res-ch)
           (recur (inc num-worlds)))))))

 ; --------------------------------------------
@@ -164,10 +179,6 @@
       (recur))))

 ; --------------------------------------------
-
-(defn prog-event [label fn]
-  (let [pc (swap! prog-curr fn)]
-    (swap! prog-history #(conj % [(count %) label pc]))))

 (defn kv-server [server-addr & ports]
   (let [world (:world @prog-base)


figwheel.main: fix helper so that it only uses the element when available

--- figwheel-main/src/figwheel/main/helper.cljc
+++ figwheel-main/src/figwheel/main/helper.cljc
@@ -2,7 +2,8 @@
   (:require
    #?@(:cljs
        [[goog.dom :as gdom]
-       [goog.net.XhrIo :as xhr]
+        [goog.dom.classlist :as classlist]
+        [goog.net.XhrIo :as xhr]
         [goog.object :as gobj]]
        :clj [[clojure.java.io :as io]
              [figwheel.server.ring :refer [best-guess-script-path]]])
@@ -17,17 +18,13 @@
 (def sidebar-link-class "figwheel_main_content_link")
 (def sidebar-focus-class "figwheel_main_content_link_focus")

-(defn add-class [el klass]
-  (.add (gobj/get el "classList") klass))
-
-(defn remove-class [el klass]
-  (.remove (gobj/get el "classList") klass))
-
 (defn connected-signal []
-  (add-class (gdom/getElement "connect-status") "connected"))
+  (some-> (gdom/getElement "connect-status")
+          (classlist/add "connected")))

 (defn on-disconnect []
-  (remove-class (gdom/getElement "connect-status") "connected"))
+  (some-> (gdom/getElement "connect-status")
+          (classlist/remove "connected")))

 (defonce resource-atom (atom {}))

@@ -55,9 +52,9 @@
 (defn focus-anchor! [anchor-tag]
   (.forEach (gdom/getElementsByTagNameAndClass "a" sidebar-link-class)
             (fn [a]
-              (remove-class a sidebar-focus-class)
+              (classlist/remove a sidebar-focus-class)
               (when (= a anchor-tag)
-                (add-class a sidebar-focus-class)))))
+                (classlist/add a sidebar-focus-class)))))

 (defn init-sidebar-link-actions! []
   (.forEach (gdom/getElementsByTagNameAndClass "a" sidebar-link-class)


Jinteki Biotech.

Jinteki Biotech.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -1224,6 +1224,34 @@
    {:events {:agenda-scored {:msg "do 1 net damage" :effect (effect (damage :net 1 {:card card}))}
              :agenda-stolen {:msg "do 1 net damage" :effect (effect (damage :net 1 {:card card}))}}}

+   "Jinteki Biotech: Life Imagined"
+   {:events {:pre-first-turn {:req (req (= side :corp))
+                              :prompt "Choose a copy of Jinteki Biotech to use this game"
+                              :choices ["The Brewery" "The Tank" "The Greenhouse"]
+                              :effect (effect (update! (assoc card :biotech-target target))
+                                              (system-msg (str "has chosen a copy of Jinteki Biotech for this game ")))}}
+    :abilities [{:cost [:click 3]
+                 :req (req (not (:biotech-used card)))
+                 :effect (req (let [flip (:biotech-target card)]
+                                (update! state side (assoc card :biotech-used true))
+                                (case flip
+                                  "The Brewery"
+                                  (do (system-msg state side "uses The Brewery to do 2 net damage")
+                                      (damage state side :net 2))
+                                  "The Tank"
+                                  (do (system-msg state side "uses The Tank to shuffle Archives into R&D")
+                                      (shuffle-into-deck state side :discard))
+                                  "The Greenhouse"
+                                  (do (system-msg state side (str "uses The Greenhouse to place 4 advancement tokens "
+                                                                  "on a card that can be advanced"))
+                                      (resolve-ability
+                                        state side
+                                        {:prompt "Choose a card that can be advanced"
+                                         :choices {:req #(or (= (:advanceable %) "always")
+                                                             (and (= (:advanceable %) "while-rezzed") (:rezzed %))
+                                                             (= (:type %) "Agenda"))}
+                                         :effect (effect (add-prop target :advance-counter 4))} card nil)))))}]}
+
    "John Masanori"
    {:events {:successful-run {:msg "draw 1 card" :once :per-turn :once-key :john-masanori-draw
                               :effect (effect (draw))}
@@ -2802,7 +2830,7 @@
                  :choices {:req #(and (= (:type %) "ICE")
                                       (= (last (:zone %)) :ices)
                                       (not (some (fn [c] (has? c :subtype "Caïssa")) (:hosted %))))}
-                 :msg (msg "host it on " (if (:rezzed target) (:title target) "a piece of ICE"))
+                 :msg (msg "host it on " (if (:rezzed target) (:title target) "a piece of ICE"))
                  :effect (effect (host target card))}
                 {:cost [:credit 2] :msg "break 1 subroutine on the host ICE"}]}


order on parse-meta

order on parse-meta

--- src/clj/inky/entry.clj
+++ src/clj/inky/entry.clj
@@ -53,22 +53,6 @@
       (slurp s)
       (catch java.io.FileNotFoundException e nil))))

-(defn guess-gist-ns [root-path]
-  (->> (file-seq (java.io.File. root-path))
-       (map #(.getAbsolutePath %))
-       (filter #(.endsWith % ".cljs"))
-       first
-       safe-slurp
-       parse-meta
-       :ns))
-
-(defn format-doc [s]
-  (when s
-    (-> s
-        (str/replace link-re (fn [[href & rest]]
-                               (str "" href "")))
-        (str/replace #"\n\n" "

"))))
-
 (defn parse-meta [source]
   (let [forms (read-string (str "[" source "]"))
         ns (->> forms
@@ -80,6 +64,22 @@
                  (nth ns 2))]
     {:ns (second ns)
      :doc doc}))
+
+(defn guess-gist-ns [root-path]
+  (->> (file-seq (java.io.File. root-path))
+       (map #(.getAbsolutePath %))
+       (filter #(.endsWith % ".cljs"))
+       first
+       safe-slurp
+       parse-meta
+       :ns))
+
+(defn format-doc [s]
+  (when s
+    (-> s
+        (str/replace link-re (fn [[href & rest]]
+                               (str "" href "")))
+        (str/replace #"\n\n" "

"))))

 (defn url-encode [s]
   (when s


add commodity-price number format

add commodity-price number format

--- src/clj_money/util.clj
+++ src/clj_money/util.clj
@@ -10,7 +10,8 @@
 (def number-formats
   {:standard (DecimalFormat. "#,##0.00")
    :no-comma (DecimalFormat. "0.00")
-   :integer  (DecimalFormat. "0")})
+   :integer  (DecimalFormat. "0")
+   :commodity-price (DecimalFormat. "#,##0.000")})

 (defn format-number
   "Format a number with 2 decimal places and groups separated with commas"


Preserve state

Preserve state

--- src/ui/core.cljs
+++ src/ui/core.cljs
@@ -8,7 +8,7 @@
   :websocket-url   "ws://localhost:3449/figwheel-ws"
   :jsload-callback (fn [] (print "reloaded")))

-(def state (atom 0))
+(defonce state (atom 0))

 (defn root-component []
   [:div


sse: avoid failed PUTs taking warp down entirely

--- src/warp/api.clj
+++ src/warp/api.clj
@@ -30,7 +30,10 @@

 (defn sse-event
   [body e]
-  (a/put! body (format "data: %s\n\n" (json/generate-string e))))
+  (try
+    (a/put! body (format "data: %s\n\n" (json/generate-string e)))
+    (catch Exception e
+      (error e "could not send SSE event, dropping silently"))))

 (defn execution-stream-listener
   [body]


CMR-1296: Remove OBE comment

CMR-1296: Remove OBE comment

--- message-queue-lib/project.clj
+++ message-queue-lib/project.clj
@@ -8,7 +8,6 @@
                  [nasa-cmr/cmr-acl-lib "0.1.0-SNAPSHOT"]
                  [com.novemberain/langohr "3.0.1"]]

-  ;; Uncomment once we add unit tests
   :plugins [[lein-test-out "0.3.1"]]

   :profiles


Revert "Chunked seqs made the Clojure dumb fib version a lot worse. Adding this as a record for showing that it can be efficient. This commit is meant to be reverted."

This reverts commit c81c1fe251b47b0c8280a803b1a01347f107b888.

--- clojure-functional/src/test/clojure/no/knowit/clojure_functional/euler_two.clj
+++ clojure-functional/src/test/clojure/no/knowit/clojure_functional/euler_two.clj
@@ -25,14 +25,8 @@
          (f b (+ a b)))))
     0N 1N))

-(defn unchunk [s]
-  (when (seq s)
-    (lazy-seq
-      (cons (first s)
-        (unchunk (next s))))))
-
 (defn fib-range [f]
-  (map f (unchunk (range))))
+  (map f (range)))

 (defn even-nums [coll]
   (filter even? coll))
@@ -46,7 +40,7 @@
       (even-nums (f)))))

 (deftest euler-two-fibonacci-sum
-  (is (= (euler-two 4000000 #(fib-range fib)) 4613732))
+  (is (= (euler-two 40 #(fib-range fib)) 44))
   (is (= (euler-two 4000000 #(fib-range fib-mem)) 4613732))
   (is (= (euler-two 4000000 #(fib-range fib-tail)) 4613732))
   (is (= (euler-two 4000000 fib-lazy) 4613732))


Bumps version to 1.38.4-SNAPSHOT

Bumps version to 1.38.4-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.38.3"
+(defproject cook "1.38.4-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Bumps version to 1.51.12-SNAPSHOT

Bumps version to 1.51.12-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.51.11"
+(defproject cook "1.51.12-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Fixing test

Fixing test

--- test/celestial/test/jobs.clj
+++ test/celestial/test/jobs.clj
@@ -19,7 +19,7 @@
     ))

 (fact "with-lock used if :identity key was provided"
-   (job-exec identity {:identity "red1" :args {:machine {:hostname "red1"}}}) => {:status :success}
+   (job-exec identity {:message {:identity "red1" :args {:machine {:hostname "red1"}}} :attempt 1}) => {:status :success}
    (provided
      (server-conn) => {}
      (acquire-lock {} "red1" 300000 1800000) => nil :times 1))


be more specific about exceptions

be more specific about exceptions

--- test/chat/test/server/db.clj
+++ test/chat/test/server/db.clj
@@ -32,7 +32,7 @@
       (is (= "ol' fooy" (db/get-nickname (user :id)))))

     (testing "user email must be unique"
-      (is (thrown? Exception
+      (is (thrown? java.util.concurrent.ExecutionException
                    (db/create-user! {:id (db/uuid)
                                      :email (data :email)
                                      :password "zzz"
@@ -43,7 +43,7 @@
                    :password "foobar"
                    :avatar "foo@bar.com"}]
         (is (some? (db/create-user! other)))
-        (is (thrown? Exception @(db/set-nickname! (other :id)  "ol' fooy")))))))
+        (is (thrown? java.util.concurrent.ExecutionException @(db/set-nickname! (other :id)  "ol' fooy")))))))

 (deftest fetch-users
   (let [user-1-data {:id (db/uuid)


Added better handling for {:class nil}.

Added better handling for {:class nil}.

--- src/freactive/dom.cljs
+++ src/freactive/dom.cljs
@@ -255,7 +255,7 @@
                  (set-data-state! element state)
                  state)
    :class (fn [element cls]
-            (set! (.-className element) cls)
+            (set! (.-className element) (if (nil? cls) "" cls))
             cls)})

 ;; attributes to set directly


username

username

--- src/freenas/remote.clj
+++ src/freenas/remote.clj
@@ -25,7 +25,7 @@

 (defn auth
    []
-  [(hypervisor :freenas :user) (hypervisor :freenas :password)]
+  [(hypervisor :freenas :username) (hypervisor :freenas :password)]
   )

 (defn call [verb api args]


Use radial fisheye

Use radial fisheye

The feel is smoother now, but points at the edges are not handled well.

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -28,10 +28,8 @@
 (def swipe-damping-factor 1)
 (def min-slide-speed-sq 16)

-(def safe-zone-size 0.2)
 (def max-radius 32)
 (def min-radius 2)
-(def min-size-distance 2000)
 (def edge-buffer (+ min-radius 3))

@@ -79,14 +77,17 @@

 ;; D3 magic

-(defn project-displacement [d safe-distance max-distance]
+(defn project-displacement [d view-length]
   (let [project-positive-displacement
         (fn [d]
-          (if (< d safe-distance)
-            d
-            (+ safe-distance
-               (* (/ (- max-distance safe-distance) pi2)
-                  (atan (- d safe-distance))))))]
+          (let [t (/ d view-length)]
+            (* view-length
+               (cond
+                 (<= t 0.5) t
+                 (<= 0.5 t 1) (+ 0.5 (/ (- t 0.5) 2))
+                 (<= 1 t 1.5) (+ 0.75 (/ (- t 1) 4))
+                 (<= 1.5 t 2) (+ 0.875 (/ (- t 1.5) 8))
+                 (<= 2 t) 1))))]
     (if (pos? d)
       (project-positive-displacement d)
       (- (project-positive-displacement (- d))))))
@@ -98,22 +99,29 @@
   (let [{:keys [view-width view-height camera-x camera-y]} state
         view-center-x (/ view-width 2)
         view-center-y (/ view-height 2)
-        safe-distance-x (* safe-zone-size view-center-x)
-        safe-distance-y (* safe-zone-size view-center-y)
-        max-distance-x (- view-center-x edge-buffer)
-        max-distance-y (- view-center-y edge-buffer)
-        true-x-displacement (- x camera-x)
-        true-y-displacement (- y camera-y)
-        projected-x-displacement (project-displacement true-x-displacement
-                                                       safe-distance-x
-                                                       max-distance-x)
-        projected-y-displacement (project-displacement true-y-displacement
-                                                       safe-distance-y
-                                                       max-distance-y)]
-    {:x (+ view-center-x projected-x-displacement)
-     :y (+ view-center-y projected-y-displacement)}))
-
-(defn view-radius [state x y] 32)
+        view-radius (dist view-center-x view-center-y)
+        x-displacement (- x camera-x)
+        y-displacement (- y camera-y)
+        r (dist x-displacement y-displacement)
+        projected-r (project-displacement r view-radius)
+        projected-x (* x-displacement (/ projected-r r))
+        projected-y (* y-displacement (/ projected-r r))]
+    {:x (+ view-center-x projected-x)
+     :y (+ view-center-y projected-y)}))
+
+(defn view-radius [state x y]
+  (let [{:keys [view-width view-height camera-x camera-y]} state
+        view-center-x (/ view-width 2)
+        view-center-y (/ view-height 2)
+        view-radius (dist view-center-x view-center-y)
+        r (dist (- x camera-x) (- y camera-y))
+        t (/ r view-radius)]
+    (+ min-radius (* (- max-radius min-radius)
+                     (cond
+                       (<= t 0.5) 1
+                       (<= 0.5 t 1.5) (- 1 (/ (- t 0.5) 2))
+                       (<= 1.5 t 2) (- 0.5 (- t 1.5))
+                       (<= 2 t) 0)))))

 (defn sync-graph! [state]
   (let [{:keys [svg nodes]} state
@@ -126,13 +134,13 @@
         (.data (apply array nodes))
         (.attr "cx" view-x)
         (.attr "cy" view-y)
-        (.attr "r" view-radius)
+        (.attr "r" _view-radius)
         .enter
         (.append "circle")
         (.attr "class" "node")
         (.attr "cx" (comp view-x))
         (.attr "cy" (comp view-y))
-        (.attr "r" view-radius))))
+        (.attr "r" _view-radius))))

 ;; State management


Add IMultiFn to make reagent happy. (Isn't used anywhere)

--- lib/shin/cljs/cljs/core.cljs
+++ lib/shin/cljs/cljs/core.cljs
@@ -40,6 +40,15 @@
     [_ a b c d e f g h i j k l m n o p q r s]
     [_ a b c d e f g h i j k l m n o p q r s t]
     [_ a b c d e f g h i j k l m n o p q r s t rest]))
+
+(defprotocol IMultiFn
+  (-reset  [mf])
+  (-add-method  [mf dispatch-val method])
+  (-remove-method  [mf dispatch-val])
+  (-prefer-method  [mf dispatch-val dispatch-val-y])
+  (-get-method  [mf dispatch-val])
+  (-methods  [mf])
+  (-prefers  [mf]))

 (defprotocol ICollection
   (-conj  [rng o]))


Move 'git-trees function before 'import-db so it can be used.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1004,6 +1004,15 @@
         all-shas (concat pack-shas obj-shas)]
     all-shas))

+(defn git-trees
+  [gitdir tree-shas]
+  (for [s tree-shas]
+    {s (into {}
+             (for [e (:lines (git {:gitdir gitdir} "cat-file" "-p" s))
+                   :let [[_ ftype sha fname] (s/split (s/trim e) #"\s" 4)]]
+               [fname {:sha sha
+                       :ftype ftype}]))}))
+
 (defn import-db
   [gitdir]
   (let [uri "datomic:mem://voom"
@@ -1035,15 +1044,6 @@
     @(d/transact conn txn)
     :done))

-(defn git-trees
-  [gitdir tree-shas]
-  (for [s tree-shas]
-    {s (into {}
-             (for [e (:lines (git {:gitdir gitdir} "cat-file" "-p" s))
-                   :let [[_ ftype sha fname] (s/split (s/trim e) #"\s" 4)]]
-               [fname {:sha sha
-                       :ftype ftype}]))}))
-
 (def subtasks [#'build-deps #'deploy #'find-box #'freshen #'install
                #'retag-all-repos #'ver-parse #'wrap])


refactoring for getting other sports

refactoring for getting other sports

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

-(defn accumulate [totals result]
+(defn accumulate-all [kw totals result]
   (let [kw-all (keyword "Kaikki")]
     (assoc totals
       kw-all {:distance (+ (:distance (kw-all totals)) (get-entry result :distance))
@@ -70,8 +70,10 @@

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

 (defn interval-as-exlist [user week-interval]
     (let [start (.getStart week-interval) end (.getEnd week-interval)


Add dynamic *tag-map* var for default tag-map

--- src/palletops/hyde.clj
+++ src/palletops/hyde.clj
@@ -108,6 +108,8 @@
   (let [splices (splice-all s)]
     (glue splices (partial render-tag tag-reader-map))))

+(def ^:dynamic *tag-map* {})
+
 ;;; JEKYLL

 (def clean-target fs/delete-dir)
@@ -173,7 +175,7 @@
   {:sig [[s/Str Site-Config :- s/Bool]
          [s/Str Site-Config Tag-Map :- s/Bool]]}
   ([root site-config]
-     (copy-resources! root site-config {}))
+     (copy-resources! root site-config *tag-map*))
   ([root {:keys [template] :as site-config} tag-map]
      (let [template (if (keyword? template) (name template) template)
            resources (template-resources template)
@@ -198,9 +200,8 @@
   {:sig [[s/Str Doc :- s/Bool]
          [s/Str Doc Tag-Map :- s/Bool]]}
   ([root doc]
-     (write-document! root doc {}))
+     (write-document! root doc *tag-map*))
   ([root {:keys [path content front-matter] :as doc} tag-map]
-
      (let [content (if (empty? tag-map)
                      content
                      (render-content tag-map content))
@@ -219,7 +220,7 @@
   {:sig [[s/Str s/Str Collection :- s/Bool]
          [s/Str s/Str Collection Tag-Map :- s/Bool]]}
   ([root name coll]
-     (write-collection! root name coll {}))
+     (write-collection! root name coll *tag-map*))
   ([root
     name
     {:keys [index-key index? docs]
@@ -239,11 +240,11 @@
   {:sig [[s/Str s/Str s/Any :- s/Bool]
          [s/Str s/Str s/Any Tag-Map :- s/Bool]]}
   ([root name data]
-     (write-data! root name data {}))
+     (write-data! root name data *tag-map*))
   ([root name data tag-map]
      (let [target (format "%s/_data/%s.yaml" root name)
            content (yaml/generate-string data)
-           content (if (empty? tag-map)
+           content (if (empty? tag-map)
                      content
                      (render-content tag-map content))]
        (spit target content)


Fix CLJS tests

Fix CLJS tests

--- test/expound/alpha_test.cljc
+++ test/expound/alpha_test.cljc
@@ -110,7 +110,7 @@
            (expound/expound-str :set-based-spec/tag :baz))))

   (testing "prints combined options for various specs"
-    (is (= "-- Spec failed --------------------
+    (is (= (pf "-- Spec failed --------------------

   [:three]
    ^^^^^^
@@ -120,14 +120,14 @@
 -- Relevant specs -------

 :set-based-spec/one-or-two:
-  (clojure.spec.alpha/or
+  (pf.spec.alpha/or
    :one
-   (clojure.spec.alpha/cat :a #{:one})
+   (pf.spec.alpha/cat :a #{:one})
    :two
-   (clojure.spec.alpha/cat :b #{:two}))
-
--------------------------
-Detected 1 error\n"
+   (pf.spec.alpha/cat :b #{:two}))
+
+-------------------------
+Detected 1 error\n")
            (expound/expound-str :set-based-spec/one-or-two [:three]))))

   ;; FIXME - we should fix nilable and or specs better so they are clearly grouped


New tests: test-ends-with and test-ends-with-NPE

--- test/hurvinek/utils_test.clj
+++ test/hurvinek/utils_test.clj
@@ -204,8 +204,8 @@
             true  (contains "Hello world!" "world!"))))

 (deftest test-starts-with-1
-    "Check the function clouseau.utils/starts-with."
-    (testing "the function clouseau.utils/starts-with."
+    "Check the function hurvinek.utils/starts-with."
+    (testing "the function hurvinek.utils/starts-with."
         (are [x y] (= x y)
             false (startsWith "Hello world!" "hello")
             true  (startsWith "Hello world!" "Hello")
@@ -213,9 +213,25 @@
             true  (startsWith "Hello world!" ""))))

 (deftest test-starts-with-NPE
-    "Check the function clouseau.utils/starts-with."
-    (testing "the function clouseau.utils/starts-with."
+    "Check the function hurvinek.utils/starts-with."
+    (testing "the function hurvinek.utils/starts-with."
         (is (thrown? NullPointerException (startsWith nil nil)))
         (is (thrown? NullPointerException (startsWith "text" nil)))
         (is (thrown? NullPointerException (startsWith nil "text")))))

+(deftest test-ends-with-1 "Check the function hurvinek.utils/ends-with."
+    (testing "the function hurvinek.utils/ends-with."
+        (are [x y] (= x y)
+            true  (endsWith "Hello world!" "Hello world!")
+            false (endsWith "Hello world!" "hello world!")
+            true  (endsWith "Hello world!" "world!")
+            true  (endsWith "Hello world!" "!")
+            true  (endsWith "Hello world!" ""))))
+
+(deftest test-ends-with-NPE
+    "Check the function hurvinek.utils/ends-with."
+    (testing "the function hurvinek.utils/ends-with."
+        (is (thrown? NullPointerException (endsWith nil nil)))
+        (is (thrown? NullPointerException (endsWith "text" nil)))
+        (is (thrown? NullPointerException (endsWith nil "text")))))
+


Do not wait activity handler.

Do not wait activity handler.


adding test for draw 2

adding test for draw 2

--- test/cartagena/core_test.clj
+++ test/cartagena/core_test.clj
@@ -194,7 +194,21 @@
     (testing "Does not allow moving back to jail"
       (let [board (assoc board 3 {:icon :bottle :pirates [:black :black :black]}
                                1 {:icon :bottle :pirates []})]
-        (is (nil? (move-back player from-space board draw-pile discard-pile)))))))
+        (is (nil? (move-back player from-space board draw-pile discard-pile)))))
+    (testing "Draws two cards for landing on space with two pirates"
+      (let [board (assoc board 3 {:icon :bottle :pirates [:black :black]})
+            updated-spaces [{:icon :jail :pirates []}
+                            {:icon :bottle :pirates [:orange]}
+                            {:icon :knife :pirates []}
+                            {:icon :bottle :pirates [:black :black :orange]}
+                            {:icon :skull :pirates []}
+                            {:icon :hat :pirates [:black]}
+                            {:icon :skull :pirates [:black]}]
+            expected {:player (assoc player :cards [:hat :skull :knife :gun :key])
+                      :board-spaces updated-spaces
+                      :draw-pile []
+                      :discard-pile [:knife]}]
+        (is (= expected (move-back player from-space board draw-pile discard-pile)))))))

 ;(deftest discard-card-test
 ;  (testing "Discarding a card adds it to the discard pile"


Fixed variable number of tests

Fixed variable number of tests

--- test/littlepot/core_test.clj
+++ test/littlepot/core_test.clj
@@ -45,10 +45,11 @@
                                  :else (throw (IllegalArgumentException.)))))
                            ones))))
           ;; track no more then 1 active batch
+          invalid-active-batches (atom 0)
           _ (add-watch batches-active :no-more-than-one
                        (fn [_ _ _ new-value]
-                         ;; FIXME wararge test cases is bad
-                         (is (<= new-value 1))))
+                         (when (> new-value 1)
+                           (swap! invalid-active-batches inc))))
           ;; start consumers
           consumers (doall (take number-of-consumers (repeatedly consumer)))]
       ;; wait 10 seconds for consumers to work
@@ -58,6 +59,8 @@
       ;; wait batches in progress become 0
       (Thread/sleep batch-latency)
       (is (zero? (:batches-in-progress @pot)))
+      ;; no parallel batches detected
+      (is (zero? @invalid-active-batches))
       (let [consumer-ones (reduce + (map deref consumers))
             total-produced (* 1000 (:batches-done @pot))
             left-in-pot (count (:queue @pot))]


Add tests for pattern/let?

Add tests for pattern/let?

--- test/oxcart/pattern_test.clj
+++ test/oxcart/pattern_test.clj
@@ -68,6 +68,15 @@
   (is-not (p/fn->name addition)))

+(deftest let?-tests
+  (is-not (p/let? foo))
+  (is-not (p/let? (:init foo)))
+  (is-not (p/let? bar))
+  (is-not (p/let? (:init bar)))
+  (is (p/let? addition))
+  (is (p/let? {:op :let})))
+
+
 (def private-defn
   (ast
    (defn ^:private baz [x]


, is only separator for tags

, is only separator for tags

--- src/ontrail/mutate.clj
+++ src/ontrail/mutate.clj
@@ -63,13 +63,6 @@
 (defn parse-date [date-str]
   (time/plus (format/parse multi-parser date-str) (time/hours 12)))

-(defn date-ok? [date]
-  (not-nil? (try (parse-date date)
-                 (catch Exception e (.debug logger (str "ex in parse date" date e))))))
-
-(defn sport-ok? [sport]
-  (not-nil? (mc/find-one-as-map ONSPORT {:_id sport})))
-
 (def distance-regexps
   [{:re #"^([0-9]+)$" :conv as-number}
    {:re #"^([0-9]+) *m *$" :conv as-number}
@@ -83,9 +76,9 @@
 (defn parse-tags
   ([] '())
   ([tags]
-     (let [trim-tag #(-> % .toLowerCase string/trim)]
+     (let [trim-tag #(-> % string/trim)]
        (if (string? tags)
-         (string/split (trim-tag tags) #"[, ;\.\^\*\/]+")
+         (string/split (trim-tag tags) #",")
          '()))))

 (defn parse-natural [hr]


flash logo on successful reload

flash logo on successful reload

--- src/adzerk/boot_reload/display.cljs
+++ src/adzerk/boot_reload/display.cljs
@@ -46,6 +46,7 @@
            :flex-c    [:-webkit-box-align "center" :-webkit-align-items "center" :-ms-flex-align "center" :align-items "center"]
            :bg-red    [:background-color "#FF4136"]
            :bg-yellow [:background-color "#FFDC00"]
+           :bg-clear  [:background-color "none"]
            :mr10      [:margin-right "10px"]
            :pad       [:padding "12px"]
            :container [:color "black"
@@ -74,27 +75,36 @@
                   (mk-node :span (style :mr10) file)])
     (events/listen EventType.CLICK #(open-file data))))

+(defn reloaded-node []
+  (mk-node :div nil nil))
+
 (defn warnings-node [warnings]
   (mk-node :div nil (map warning-node warnings)))

 (defn construct-hud-node [{:keys [warnings exception] :as messages}]
-  (doto (mk-node :div (style :pad :flex :flex-c (if exception :bg-red :bg-yellow)))
+  (doto (mk-node :div (style :pad :flex :flex-c (cond exception      :bg-red
+                                                      (seq warnings) :bg-yellow
+                                                      :else          :bg-clear)))
     (dom/append (mk-node :div (style :logo :mr10) (dom/htmlToDocumentFragment cljs-logo)))
-    (dom/append (if exception
-                  (exception-node exception)
-                  (warnings-node warnings)))))
+    (dom/append (cond exception      (exception-node exception)
+                      (seq warnings) (warnings-node warnings)
+                      :else          (reloaded-node)))))

 (defn remove-container! [id]
   (let [el (dom/getElement id)]
     (dom/setProperties el (clj->js (update (style :container :hide) :style ->css)))
     (timer/callOnce #(dom/removeNode el) transition-duration)))

-(defn insert-container! [id messages]
-  (let [hud   (construct-hud-node messages)
-        el    (mk-node :div (merge (style :container :hide) {:id id}) hud)
-        show! #(dom/setProperties el (clj->js (update (style :container) :style ->css)))]
+(defn insert-container! [id {:keys [warnings exception] :as messages}]
+  (let [hud      (construct-hud-node messages)
+        el       (mk-node :div (merge (style :container :hide) {:id id}) hud)
+        show!    #(dom/setProperties el (clj->js (update (style :container) :style ->css)))
+        no-prob? (and (not exception) (not (seq warnings)))
+        hide!    #(dom/setProperties el (clj->js (update (style :container :hide) :style ->css)))]
     (dom/appendChild js/document.body el)
-    (timer/callOnce show! transition-duration)))
+    (timer/callOnce show! transition-duration)
+    (when no-prob?
+      (timer/callOnce hide! (* transition-duration 3)))))

 (defn gen-id []
   (str "boot-reload-hud-" (name (gensym))))
@@ -105,7 +115,6 @@
   (swap! current-container
          (fn [container]
            (when container (remove-container! container))
-           (when (or (:exception messages) (seq (:warnings messages)))
-             (let [id (gen-id)]
-               (insert-container! id messages)
-               id)))))
+           (let [id (gen-id)]
+             (insert-container! id messages)
+             id))))


adding doc

adding doc

--- src/celestial/puppet_standalone.clj
+++ src/celestial/puppet_standalone.clj
@@ -37,9 +37,7 @@
   (doseq [line (line-seq (clojure.java.io/reader out))] (debug line) ))

 (defn execute [{:keys [host]} & batches]
-  "Executes remotly using ssh for example:
-    (execute {:host \"192.168.20.171\"} [\"ls\"])
-  "
+  "Executes remotly using ssh for example: (execute {:host \"192.168.20.171\"} [\"ls\"])"
   (with-session host
     (fn [session]
       (doseq [b batches]
@@ -48,7 +46,6 @@
           (let [exit (.getExitStatus channel)]
             (when-not (= exit 0)
               (throw+ (merge res {:type ::provision-failed :exit exit} (meta b))))))))))
-

 (defn step [n & steps] ^{:step n} steps)


small logic change

small logic change

--- src/clj/org/openforis/ceo/views.clj
+++ src/clj/org/openforis/ceo/views.clj
@@ -48,7 +48,7 @@
        (map #(str "/js/" (.getName %)))
        (filter #(and (or (str/includes? % page)
                          (str/includes? % "common"))
-                     (not (str/ends-with? % ".map"))))
+                     (str/ends-with? % "bundle.js")))
        (sort-by #(cond
                    (str/includes? % "common") -1
                    (str/includes? % "~")      0


Improve error message

Improve error message

--- src/clj_simple_chart/csv/csvmap.clj
+++ src/clj_simple_chart/csv/csvmap.clj
@@ -1,6 +1,7 @@
 (ns clj-simple-chart.csv.csvmap
   (:require [clojure.data.csv :as csv]
-            [clojure.java.io :as io]))
+            [clojure.java.io :as io]
+            [clojure.string :as string]))

 (defn- debomify
   [^String line]
@@ -32,7 +33,7 @@
                              (remove nil?))]
     (when (pos? (count missing-columns))
       (println "missing columns: " (str missing-columns))
-      (throw (Exception. (str "missing columns: " (str missing-columns)))))
+      (throw (Exception. (str "missing columns: " (string/join ", " missing-columns)))))
     {:columns columns
      :data    (mapv #(produce-row columns %) data)}))


Unignore sub request events

Unignore sub request events

--- src/cljc/precept/serialize/dto.cljc
+++ src/cljc/precept/serialize/dto.cljc
@@ -88,11 +88,13 @@
          non-rulegen-facts (util/remove-rulegen-facts facts)]
      (cond
        (sub-registration? facts)
-       {:state-number state-number
+       {:id (util/guid)
+        :type event
+        :facts (util/record->map facts)
+        :state-number state-number
         :event-number event-number
         :state-id state-id
-        :encoding encoding
-        :impl? true}
+        :encoding encoding}

        (= 0 (count non-rulegen-facts))
        {:id (util/guid)


refactored with a new file, tests pass

refactored with a new file, tests pass

--- src/cljs/lisp_interpreter/core.cljs
+++ src/cljs/lisp_interpreter/core.cljs
@@ -4,204 +4,14 @@
   (:require [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
             [cljs.reader :as reader]
-            [cljs.core.async :refer [put! chan <!]]))
+            [cljs.core.async :refer [put! chan <!]]
+            [lisp-interpreter.interpreter :as l]))

 (enable-console-print!)

-(declare my-eval)
-
-(defonce app-state (atom {:text "\" give me some in\""
-                          :result "nil"}))
-
-(defonce global-env (atom {:frames {}
-                           :#f (list 'primitive false)
-                           :#t (list 'primitive false)
-                           :car (list 'primitive first)
-                           :cdr (list 'primitive rest)
-                           :cons (list 'primitive cons)
-                           :null? (list 'primitive nil?)
-                           := (list 'primitive =)
-                           :+ (list 'primitive +)
-                           :- (list 'primitive -)
-                           :* (list 'primitive *)
-                           :/ (list 'primitive /)}))
-
-(defn tagged-list?
-  [exp tag]
-  (if (list? exp)
-    (= (first exp) tag)
-    false))
-
-(defn definition?
-  [exp]
-  (if (list? exp)
-    (tagged-list? exp 'define)
-    false))
-
-(defn lambda?
-  [exp]
-  (tagged-list? exp 'fn))
-
-(defn make-proc
-  [params body env]
-  (list 'proc params (list body) env))
-
-(defn compound-proc?
-  [p]
-  (tagged-list? p 'proc))
-
-(defn procedure-params
-  [proc]
-  (first (rest proc)))
-
-(defn procedure-body
-  [proc]
-  (first (rest (rest proc))))
-
-(defn proc-env
-  [proc]
-  (-> proc
-      last))
-
-(defn lookup?
-  [exp]
-  (tagged-list? exp 'lookup))
-
-(defn eval-definition
-  [exp env]
-  (swap! env assoc (keyword (first (rest exp))) (my-eval (last exp) env)))
-
-(defn lookup-variable
-  ;[var]
-  ;(lookup-variable var global-env)
-  [var env]
-  (let [new-var (keyword var)]
-    (or (new-var (:frames @env))
-        (new-var @env))))
-
-(defn eval-lookup
-  [exp env]
-  (let [lookup-var (keyword (last exp))]
-    (lookup-variable lookup-var env)))
-
-(defn self-evaluating?
-  [exp]
-  (cond (number? exp) true
-        (string? exp) true
-        :else false))
-
-(defn variable?
-  [exp]
-  (symbol? exp))
-
-(defn quoted?
-  [exp]
-  (tagged-list? exp 'quote))
-
-(defn primitive-implementation
-  [proc]
-  (first (rest proc)))
-
-(defn primitive-proc?
-  [proc]
-  (tagged-list? proc 'primitive))
-
-(defn apply-primitive-proc
-  [proc args]
-  (apply (primitive-implementation proc) args))
-
-(defn extend-environment
-  [variable value env]
-  ;(js/console.log "the env is " @env)
-  (cond (or (empty? (rest variable)) (empty? (rest value)))
-          (swap! env assoc-in [:frames (keyword (first variable))] (first value))
-        :else (do (swap! env assoc-in [:frames (keyword (first variable))] (first value))
-                  (extend-environment (rest variable) (rest value) env))))
-
-(defn eval-sequence
-  [exps env]
-  (cond (empty? (rest exps)) (my-eval (first exps) env)
-        :else (do (my-eval (first exps) env)
-                  (eval-sequence (rest exps) env))))
-
-(defn my-apply
-  [proc args]
-  ;(js/console.log "the proc is " proc)
-  ;(js/console.log "the args are " args)
-  (cond (primitive-proc? proc) (apply-primitive-proc proc args)
-        (compound-proc? proc)  (do (extend-environment (procedure-params proc)
-                                                       args
-                                                       (proc-env proc))
-                                 #_(my-eval (procedure-body proc) (proc-env proc))
-                                  (eval-sequence
-                                      (procedure-body proc)
-                                      (proc-env proc)))
-        :else "ERROR: unknown procedure type"))
-
-(defn application? [exp]
-  (list? exp))
-
-(defn operator [exp]
-  (first exp))
-
-(defn operands [exp]
-  (rest exp))
-
-(defn lambda-params
-  [exp]
-  (first (rest exp)))
-
-(defn lambda-body
-  [exp]
-  (first (rest (rest exp))))
-
-(defn eval-sub-exps
-  [exps env]
-  (map #(my-eval % env) exps))
-
-(defn content-of-quoted
-  [exp]
-  (first (rest exp)))
-
-(defn my-eval
-  [exp env]
-  #_(js/console.log "the exp is " exp)
-  (cond (self-evaluating? exp) exp
-        (definition? exp)  (do (eval-definition exp env)
-                               :ok #_((keyword (first (rest exp))) @env))
-        (variable? exp) (lookup-variable exp env)
-        (quoted? exp) (content-of-quoted exp)
-        (lookup? exp) (eval-lookup exp env)
-        (lambda? exp) (do
-                        (make-proc (lambda-params exp) (lambda-body exp) env))
-        (application? exp) (my-apply (my-eval (operator exp) env)
-                                     (eval-sub-exps (operands exp) env))
-        :else "ERROR ---- unknown exp"))
-
-;; (defn list-of-values
-;;   [exps env]
-;;   (loop [expressions exps environment env]
-;;     (if (nil? expressions)
-;;       nil
-;;       (cons (my-eval (first expressions) environment)
-;;             (recur (rest expressions) environment)))))
-
-#_(defn list-of-values
-  [exps env]
-  (if (empty? exps)
-    nil
-    (cons (my-eval (first exps) env)
-          (list-of-values (rest exps) env))))
-
-(defn do-s []
-  (js/console.log "yo"))
-
-(defn thing[]
-  :foo)
-
 (defn handle-change [param]
   (js/console.log "is string in handle-change? " (string? param)) ;; true
-  (swap! app-state assoc :text param))
+  (swap! l/app-state assoc :text param))

 #_(defn is-first-char-quote? [str]
   (let [ch (js/charAt str 0)]


Fix issue with identity display

Fix issue with identity display

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -103,28 +103,28 @@

           [:div.decklist
            (when-let [deck (:deck state)]
-             [:div
-              (if (:edit state)
-                [:span
-                 [:button {:on-click #(end-edit owner)} "Cancel"]
-                 [:button {:on-click #(save-deck owner)} "Save"]]
-                [:span
-                 [:button {:on-click #(handle-delete cursor owner)} "Delete"]
-                 [:button {:on-click #(edit-deck owner)} "Edit"]])
-              [:h3 (:name deck)]
-              (let [identity (:identity deck)]
+             (let [identity (:identity deck)]
+               [:div
+                (if (:edit state)
+                  [:span
+                   [:button {:on-click #(end-edit owner)} "Cancel"]
+                   [:button {:on-click #(save-deck owner)} "Save"]]
+                  [:span
+                   [:button {:on-click #(handle-delete cursor owner)} "Delete"]
+                   [:button {:on-click #(edit-deck owner)} "Edit"]])
+                [:h3 (:name deck)]
                 [:h4 (:title identity)]
                 [:div
-                 (str "Influence: " (compute-influence deck)"/" (:influencelimit identity))])
-              [:div.cards
-               (for [group (group-by #(get-in % [:card :type]) (:cards deck))]
-                 [:div.group
-                  [:h4 (str (or (first group) "Unknown") " (" (count (last group)) ")") ]
-                  (for [line (last group)]
-                    [:div.line (:qty line) " "
-                     (if-let [name (get-in line [:card :title])]
-                       [:a {:href ""} name]
-                       (:card line))])])]])]
+                 (str "Influence: " (compute-influence deck)"/" (:influencelimit identity))]
+                [:div.cards
+                 (for [group (group-by #(get-in % [:card :type]) (:cards deck))]
+                   [:div.group
+                    [:h4 (str (or (first group) "Unknown") " (" (count (last group)) ")") ]
+                    (for [line (last group)]
+                      [:div.line (:qty line) " "
+                       (if-let [name (get-in line [:card :title])]
+                         [:a {:href ""} name]
+                         (:card line))])])]]))]

           [:div.deckedit
            [:div
@@ -135,7 +135,7 @@
                                :on-change #(om/set-state! owner [:deck :name] (.. % -target -value))}]]
             [:p
              [:h4 "Identity"]
-             [:select.identity {:value (get-in state [:deck :identity])
+             [:select.identity {:value (get-in state [:deck :identity :title])
                                 :on-change #(om/set-state! owner [:deck :identity] (get-card (.. % -target -value)))}
               (for [card (side-identities (get-in state [:deck :side]))]
                 [:option (:title card)])]]


Remove orphaned facts on unique conflict in todomvc

--- src/cljs/precept/todomvc/rules.cljs
+++ src/cljs/precept/todomvc/rules.cljs
@@ -108,11 +108,13 @@
    :visibility-filter ?visibility-filter})

 ;; Error handling
-(def-tuple-rule print-errors
-  [[?e ::err/type ?v]]
-  [(<- ?error (entity ?e))]
+(def-tuple-rule remove-orphaned-when-unique-conflict
+  [[?e ::err/type :unique-conflict]]
+  [[?e ::err/failed-insert ?v]]
+  [?orphaned <- [(:e ?v) :all]]
   =>
-  (println (str "[error] " ?v) ?error))
+  (trace "[error] :unique conflict. Removing orphaned fact" ?orphaned)
+  (retract! ?orphaned))

 ;;TODO. Lib?
 ;; TODO. Investigate why sexpr in first position (:id ?v) fails


Use the origin's content as statement if an origin has been selected

--- src/discuss/communication/main.cljs
+++ src/discuss/communication/main.cljs
@@ -71,7 +71,8 @@
 (defn dispatch-add-action
   "Check which action needs to be performed based on the type previously stored in the app-state."
   ([statement reference origin]
-   (let [action (get-in @lib/app-state [:layout :add-type])]
+   (let [action (get-in @lib/app-state [:layout :add-type])
+         statement (or (:content origin) statement)]
      (case action
        :add-start-statement (post-statement statement reference origin :add-start-statement)
        :add-start-premise (post-statement [statement] reference origin :add-start-premise)
@@ -79,12 +80,8 @@
        (println "Action not found:" action))))
   ([statement reference] (dispatch-add-action statement reference nil)))

-(comment
-  (do
-    (lib/update-state-item! :layout :add-type (fn [_] :add-start-statement))
-    (dispatch-add-action "something cool" nil {:author "kangaroo", :content "you have to take the dog for a walk every day, which is tedious", :aggregate-id "huepfer.verlag", :entity-id "42", :version 100})
-    )
-  )
+(s/fdef dispatch-add-action
+        :args (s/cat :statement string? :reference string? :origin map?))

 (defn prepare-add
   "Save current add-method and show add form."


Update words.clj

Update words.clj

--- src/iyye/subcon/knowledge/words.clj
+++ src/iyye/subcon/knowledge/words.clj
@@ -25,7 +25,7 @@

 (def builtin-words (ref {}))

-(defrecord Iyye_ModalPredicate [AccordingTo When Time Prob ])
+(defrecord Iyye_ModalPredicate [AccordingTo When Time Prob])
 (defrecord Iyye_Name [Name Uname Type Word2vec Tags])
 (defrecord Iyye_Type [name Relations toString])
 (defrecord Iyye_Verb [name Types Result Function Complexity])
@@ -103,15 +103,18 @@

 (defn get-supertypes [atype]
   "gets types: self, type, immediate parents"               ; FIXME Yumzia:0 get all parents
-  (if-not (:UNKNOWN atype)
-    (if-not (and (= "type" (:Name (:name atype))) (not= "relation" (:Type (:name atype))))
-      (let [rels (:Relations atype)]
-       (conj (for [supertype rels :when (:super (:Data supertype))]
-                {:Name (:super (:Data supertype)) :Predicate (:Predicate supertype)})
-             {:Name (:Type (:name atype)) :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}
-             {:Name (:Name (:name atype)) :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}))
-      (list {:Name "type" :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}))
-    {:UNKNOWN (:UNKNOWN atype)}))
+  (cond
+    (:UNKNOWN atype) (list {:UNKNOWN (:UNKNOWN atype)})
+    (and (= "type" (:Name (:name atype))) (not= "relation" (:Type (:name atype))))
+    (list {:Name "type" :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)})
+
+    (:AccordingTo atype) (list {:Name "predicate" :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)})
+    :else
+    (let [rels (:Relations atype)]
+      (conj (for [supertype rels :when (:super (:Data supertype))]
+              {:Name (:super (:Data supertype)) :Predicate (:Predicate supertype)})
+            {:Name (:Type (:name atype)) :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}
+            {:Name (:Name (:name atype)) :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}))))

 (defn create-iyye-instance [values])

@@ -193,47 +196,68 @@
         (save-iyye-type-to-db type)
         (save-iyye-builtin-type-to-db type)))))

-(defn check-params [action params]
+(defn check-select-params [action params]
   "true if params matches action, false other ways"
   (let [act-params (:Types action)
         check-params-count
         (fn [p1 p2]
           (if (= "*" (last p2))
             (>= (count p1) (count p2))
-            (= (count p1) (count p2))))]
+            (= (count p1) (count p2))))
+        expand-params (fn [p] (map #(map (fn [stype] (assoc stype :Param %)) (get-supertypes %))
+                                   p))]
     (when (check-params-count params act-params)
-      (let [params-types (map #(get-supertypes %) (flatten params))
+      (let [params-types (for [cur params] (expand-params cur))
             act-params2 (take (count params-types) act-params)
             ;   vec-params (vec (map #(:Name (:name %)) params))
-            pairs (map vector act-params2 params-types)
+            pairs (map #(vector %1 (flatten  %2)) act-params2 params-types)
             check-pair (fn [t check]
                          (case t
                              :UNKNOWN (= :UNKNOWN check)
                              "*" true
+                             "?" true
                              (some true?
-                                   (map #(= t %) (map :Name check)))))]
-        (every? true? (for [cur pairs] (check-pair (first cur) (flatten (second cur)))))))))    ; FIXME Yumzya context aware compare/tags
+                                   (map #(= t %) (map :Name check)))))
+            select-pair (fn [t check]
+                         (case t
+                           :UNKNOWN (first check)
+                           "*" (first check)
+                           "?" (first check)
+                           (if (some true?
+                                     (map #(= t %) (map :Name check)))
+                             (first check))))]
+        (if-not (every? true? (for [cur pairs] (check-pair (first cur) (flatten (second cur)))))
+          false
+          (flatten (for [cur pairs] (:Param (select-pair (first cur) (second cur))))))))))    ; FIXME Yumzya context aware compare/tags

 ; (defn apply-relation [relation params]
 ; (when (check-params relation params)
 ;  ((:Function relation) params)) )

+(defn action-function [action params-list pred]
+  (if (and (= (:type (:name (first params-list)))  "relation")
+           (= (:Result action) "predicate"))
+    ((:Function action) (conj params-list pred))
+    ((:Function action) params-list)))
+
 (defn run-action [cmd params IO]
   (let [actions-list (get-iyye-verbs cmd)
         params-list (if (map? (first params))               ; map? is a check for non-string but resolved type
-                      params (map get-iyye-words params))]
+                      params (map get-iyye-words params))
+        pred (->Iyye_ModalPredicate :YUMZIA :INSTRUCTION (persistence/local-time-to-string) :ALWAYS)]
     (case (count actions-list)
       0 (->Iyye_Error (str "failed to parse: no matching action to " cmd) pr-str)
-      1 (let [action (first actions-list)]
-          (if (check-params action params-list)
-            ((:Function action) params-list)
+      1 (let [action (first actions-list)
+              plist (check-select-params action params-list)]
+          (if plist
+            (action-function action plist pred)
             (->Iyye_Error (pr-str "Params invalid for " cmd " : " params) pr-str)))
       (let [matching-actions
-            (for [action actions-list :when (check-params action params-list)] action)]
+            (for [action actions-list :when (check-select-params action params-list)] action)]
         (case (count matching-actions)
           0 (->Iyye_Error (pr-str "Cant find " cmd " " params) pr-str)
-          1 ((:Function (first matching-actions)) params-list)
-          (->Iyye_Error (pr-str "Too many actions " cmd " " params) pr-str))))))
+          1 (action-function (first matching-actions) (check-select-params (first matching-actions) params-list) pred)
+          (->Iyye_Error (pr-str "Too many actions " cmd " " params) pr-str)))))) ; FIXME probabilities

 (defn action [cmd params IO]
   "Params are either text or objects from previous evaluations"


Fix valid-attrs? so that it doesn't return true when input is nil, changes to make-job multimethod

--- src/main/clojure/clj_print/core.clj
+++ src/main/clojure/clj_print/core.clj
@@ -112,6 +112,24 @@
       :request (HashPrintRequestAttributeSet. (into-array PrintRequestAttribute s))
       nil)))

+(defn- valid-attrs?
+  "Returns true if all of the Attribute objects in
+   attrs are bounded by the type specified by k.
+   Valid keywords for k are:
+     :doc
+     :job
+     :request,
+     :service"
+  {:since "0.0.1"}
+  [attrs k]
+  (if (seq attrs)
+    (let [mappings {:doc DocAttribute
+                    :job PrintJobAttribute
+                    :request PrintRequestAttribute
+                    :service PrintServiceAttribute}]
+      (every? (fn [attr] (instance? (k mappings) attr)) attrs))))
+
+
 (defn- make-doc
   "Returns a javax.print.Doc object for the print data in this
    job map. SimpleDoc will throw an IllegalArgumentException if
@@ -129,22 +147,6 @@
                          nil)]
     (if (valid-attrs? attrs :doc)
       (SimpleDoc. resource flavor (-> attrs (make-set :doc))))))
-
-(defn- valid-attrs?
-  "Returns true if all of the Attribute objects in
-   attrs are bounded by the type specified by k.
-   Valid keywords for k are:
-     :doc
-     :job
-     :request,
-     :service"
-  {:since "0.0.1"}
-  [attrs k]
-  (condp = k
-    :doc (every? #(instance? DocAttribute %) attrs)
-    :job (every? #(instance? PrintJobAttribute %) attrs)
-    :request (every? #(instance? PrintRequestAttribute %) attrs)
-    :service (every? #(instance? PrintServiceAttribute %) attrs)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Job ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -192,7 +194,7 @@
   (submit [this]
     (let [{:keys [docs jobs]} this
           doc-objs (map :obj docs)]
-      (map (fn [d j] (.. j (print @d (make-set attrs :request)))) doc-objs jobs)))
+      (map (fn [d j] (.. j (print @d (make-set attrs :request)))) doc-objs jobs))) ;; TODO: reflection
   ;; (add-listener [this listener]
   ;;   (if-let [{^DocPrintJob job :job} this]
   ;;     (do (doto job (.addPrintJobListener listener))
@@ -212,7 +214,7 @@
          :or {printer (printer :default)
               attrs #{MediaTray/MAIN}}} spec
               maybe-listen #(if listener (add-listener % listener) %)]
-    (if (and (valid-attrs? doc-attrs :doc)
+    (if  (and (valid-attrs? doc-attrs :doc)
              (valid-attrs? attrs :job))
       (-> (map->JobSpec {:doc doc
                          :printer printer
@@ -221,19 +223,18 @@
           maybe-listen))))

 (defmethod make-job :docs [spec]
-  (let [{docs :docs} spec
-        {:keys [doc ^PrintService printer attrs ^PrintJobtListener listener]
-         :or {printer (printer :default)
-              attrs #{MediaTray/MAIN}}} spec
-              maybe-listen #(if listener (add-listener % listener) %)]
-    (if (and (every? #(valid-attrs? (:attrs %) :doc) docs)
+  (let [{:keys [^PrintService printer
+                ^PrintJobListener listener
+                docs attrs]} spec]
+    (if (and (every? (fn [d] (valid-attrs? d :doc)) (map :attrs docs))
              (valid-attrs? attrs :job))
-      (map->MultiJobSpec {:docs (map #(assoc % :obj (make-doc %)) docs)
-                          :printer printer
-                          :attrs attrs
-                          :jobs (map maybe-listen
-                                     (for [d docs]
-                                       (.. printer createPrintJob)))}))))
+      (letfn [(add-doc [doc-map]
+                (assoc-in doc-map [:obj] (delay (make-doc doc-map))))
+              (add-docs [m]
+                (update-in m [:docs] (fn [doc-list] (map add-doc  doc-list))))
+              (add-jobs [m]
+                (assoc-in m [:jobs] (for [d docs] (.. printer createPrintJob))))]
+        (-> spec add-docs add-jobs)))))

 ;; (defn make-job
 ;;   "Returns a JobSpec map that is the result of


AST passes need to take opts, add ns-side-effects pass fn

--- src/main/clojure/cljs/analyzer.cljc
+++ src/main/clojure/cljs/analyzer.cljc
@@ -2444,7 +2444,7 @@
          :meta meta-expr :expr expr :children [meta-expr expr]})
       expr)))

-(defn infer-type [env ast]
+(defn infer-type [env ast _]
   (let [tag (:tag ast)]
     (if (nil? tag)
       (let [tag (infer-tag env ast)]
@@ -2452,6 +2452,35 @@
           (assoc ast :tag tag)
           ast))
       ast)))
+
+(defn ns-side-effects
+  [env {:keys [op] :as ast} opts]
+  (if (= :ns op)
+    (let [{:keys [deps require-macros use-macros reload reloads]} ast]
+      (when (and *analyze-deps* (seq deps))
+        (analyze-deps name deps env (dissoc opts :macros-ns)))
+      (when *load-macros*
+        (load-core)
+        (doseq [nsym (vals use-macros)]
+          (let [k (or (:use-macros reload)
+                      (get-in reloads [:use-macros nsym])
+                      (and (= nsym name) *reload-macros* :reload))]
+            (if k
+              (clojure.core/require nsym k)
+              (clojure.core/require nsym))
+            (intern-macros nsym k)))
+        (doseq [nsym (vals require-macros)]
+          (let [k (or (:require-macros reload)
+                      (get-in reloads [:require-macros nsym])
+                      (and (= nsym name) *reload-macros* :reload))]
+            (if k
+              (clojure.core/require nsym k)
+              (clojure.core/require nsym))
+            (intern-macros nsym k)))
+        (when (seq use-macros)
+          (check-use-macros use-macros env)))
+      ast)
+    ast))

 (def ^:dynamic *passes* nil)

@@ -2505,7 +2534,7 @@
                  (if (seq form) form ())
                  form)
         ast    (analyze-form env form name opts)]
-    (reduce (fn [ast pass] (pass env ast)) ast passes)))
+    (reduce (fn [ast pass] (pass env ast opts)) ast passes)))

 (defn analyze
   "Given an environment, a map containing {:locals (mapping of names to bindings), :context


Fix issue with empty lines throwing exception when processing tags.

--- src/palletops/hyde.clj
+++ src/palletops/hyde.clj
@@ -102,15 +102,16 @@
     (format "http://%s" (:url l))))

 (defn render-tag [tag-reader-map s]
-  (let [form (try (clojure.edn/read-string {:readers tag-reader-map} s)
-                  (catch Exception e
-                    (println "Cannot parse tag:" s)
-                    nil))]
-    (if form
-      (render form)
-      (let [output (str "[*" s "*]")]
-        (printf "failed to parse %s, outputintg %s instead\n" s output)
-        output) )))
+  (when s
+    (let [form (try (clojure.edn/read-string {:readers tag-reader-map} s)
+                    (catch Exception e
+                      (println "Cannot parse tag:" s)
+                      nil))]
+      (if form
+        (render form)
+        (let [output (str "[*" s "*]")]
+          (printf "failed to parse %s, outputintg %s instead\n" s output)
+          output) ))))

 (defn render-content [tag-reader-map s]
   (let [splices (splice-all s)


Ensure first trigger of until/limit takes priority

--- modules/scheduling/src/test/clojure/wunderboss/scheduling_tests.clj
+++ modules/scheduling/src/test/clojure/wunderboss/scheduling_tests.clj
@@ -152,7 +152,7 @@
           (Thread/sleep (if (zero? i) 520 100))
           (is (= (inc i) @q))))))

-  (deftest until-overrides-limit
+  (deftest short-until-overrides-limit
     (let [q (atom 0)
           step 222]
       (with-job #(swap! q inc) {:until (Date. (+ 1000 (System/currentTimeMillis)))
@@ -164,6 +164,18 @@
         (Thread/sleep step)
         (is (= 5 @q)))))

+  (deftest short-limit-overrides-until
+    (let [q (atom 0)
+          step 222]
+      (with-job #(swap! q inc) {:until (Date. (+ 1000 (System/currentTimeMillis)))
+                                :every step
+                                :limit 1}
+        (dotimes [i 3]
+          (Thread/sleep (if (zero? i) 20 step))
+          (is (= 1 @q)))
+        (Thread/sleep step)
+        (is (= 1 @q)))))
+
   (deftest until-with-every-should-repeat-until-until
     (let [q (atom 0)
           step 222]


Add 'FOREIGN TABLE' to the types of tables we sync in order to support Postgres foreign data wrappers. Resolves #1468

--- src/metabase/driver/generic_sql.clj
+++ src/metabase/driver/generic_sql.clj
@@ -318,7 +318,7 @@
   (let [all-schemas (set (map :table_schem (jdbc/result-set-seq (.getSchemas metadata))))
         schemas     (set/difference all-schemas (excluded-schemas driver))]
     (set (for [schema     schemas
-               table-name (mapv :table_name (jdbc/result-set-seq (.getTables metadata nil schema "%" (into-array String ["TABLE", "VIEW"]))))] ; tablePattern "%" = match all tables
+               table-name (mapv :table_name (jdbc/result-set-seq (.getTables metadata nil schema "%" (into-array String ["TABLE", "VIEW", "FOREIGN TABLE"]))))] ; tablePattern "%" = match all tables
            {:name   table-name
             :schema schema}))))

@@ -327,7 +327,7 @@
    Fetch *all* Tables, then filter out ones whose schema is in `excluded-schemas` Clojure-side."
   [driver, ^DatabaseMetaData metadata]
   (set (for [table (filter #(not (contains? (excluded-schemas driver) (:table_schem %)))
-                           (jdbc/result-set-seq (.getTables metadata nil nil "%" (into-array String ["TABLE", "VIEW"]))))] ; tablePattern "%" = match all tables
+                           (jdbc/result-set-seq (.getTables metadata nil nil "%" (into-array String ["TABLE", "VIEW", "FOREIGN TABLE"]))))] ; tablePattern "%" = match all tables
          {:name   (:table_name table)
           :schema (:table_schem table)})))


Print traces

Print traces

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -151,11 +151,11 @@

 ;; FLOW STATE

-(defrecord FlowState [node->state node->out-nodes node->facts node->update! trace])
+(defrecord FlowState [node->state node->out-nodes node->facts node->update! trace plan])

 (def trace? true)

-(defn fixpoint! [{:keys [node->state node->out-nodes node->facts node->update! trace] :as flow-state}]
+(defn fixpoint! [{:keys [node->state node->out-nodes node->facts node->update! trace plan] :as flow-state}]
   (loop [node 0]
     (when (< node (alength node->facts))
       (let [in-facts (aget node->facts node)]
@@ -165,6 +165,7 @@
             (.call (aget node->update! node) nil node node->state in-facts out-facts)
             (aset node->facts node #js [])
             (when trace? (.push trace #js [node in-facts out-facts]))
+            ;; (prn node in-facts out-facts (nth (:node->flow plan) node))
             (if (> (alength out-facts) 0)
               (let [out-nodes (aget node->out-nodes node)
                     min-out-node (areduce out-nodes i min-out-node (+ node 1)
@@ -282,7 +283,7 @@
                 FilterMap (filter-map-update! (apply (resolve (first (:fun&args flow))) (rest (:fun&args flow))))
                 Index (index-update! (:key-ixes flow))
                 Lookup (lookup-update! (:index-node flow) (:key-ixes flow) (:val-ixes flow))))))
-    (FlowState. node->state node->out-nodes node->facts node->update! trace)))
+    (FlowState. node->state node->out-nodes node->facts node->update! trace plan)))

 (defn memory->node [memory]
   (case memory


improve logging

improve logging

--- src/babel/lexiconfn.cljc
+++ src/babel/lexiconfn.cljc
@@ -97,10 +97,12 @@
     (if (not (fail? retval))
       retval
       ;; TODO: log message is too long to read.
-      (let [message (str "Failed to unify args; (#args=" (count args) "):"
-                         (string/join " // " (map str args)) ";types:"
-                         (string/join " // " (map type args)) ";null?"
-                         (string/join " // " (map nil? args)) ";"
+      (let [message (str "Failed to unify args:"
+                         (string/join ";  "
+                                      (map (fn [arg]
+                                             (dissoc (strip-refs arg)
+                                                     :serialized))
+                                           args))

                          (cond (= 2 (count args))
                                (let [fail-path (get-fail-path (first args) (second args))]


Use core codecs from messaging

Use core codecs from messaging

--- modules/messaging/src/main/clojure/immutant/messaging/codecs.clj
+++ modules/messaging/src/main/clojure/immutant/messaging/codecs.clj
@@ -16,7 +16,7 @@
 ;; 02110-1301 USA, or see the FSF site: http://www.fsf.org.

 (ns immutant.messaging.codecs
-  (:require [clojure.data.json :as json]))
+  (:require [immutant.codecs :as core]))

 (def encoding-header-name "__ContentEncoding__")

@@ -27,7 +27,6 @@
 (defn ^{:private true} get-encoding [^javax.jms.Message msg]
   (keyword (.getStringProperty msg encoding-header-name)))

-
 ;; Encode

 (defmulti encode (fn [_ _ {encoding :encoding}] (or encoding :clojure)))
@@ -35,15 +34,13 @@
 (defmethod encode :clojure [session message options]
   "Stringify a clojure data structure"
   (set-encoding
-   (.createTextMessage session (with-out-str
-                                 (binding [*print-dup* true]
-                                   (pr message))))
+   (.createTextMessage session (core/encode message))
    :clojure))

 (defmethod encode :json [session message options]
   "Stringify a json data structure"
   (set-encoding
-   (.createTextMessage session (json/json-str message))
+   (.createTextMessage session (core/encode message :json))
    :json))

 (defmethod encode :text [session message options]
@@ -58,11 +55,11 @@

 (defmethod decode :clojure [message]
   "Turn a string into a clojure data structure"
-  (load-string (.getText message)))
+  (core/decode (.getText message)))

 (defmethod decode :json [message]
   "Turn a string into a json data structure"
-  (json/read-json (.getText message)))
+  (core/decode (.getText message) :json))

 (defmethod decode :text [message]
   "Treats the message payload as a raw string. No decoding is done."
@@ -70,23 +67,3 @@

 (defmethod decode :default [message]
   (throw (RuntimeException. (str "Received unknown message encoding: " (get-encoding message)))))
-
-
-;; Fallback to Java serialization for undefined print-dup methods
-
-(defn serialize [object]
-  (with-open [baos (java.io.ByteArrayOutputStream.)
-              oos (java.io.ObjectOutputStream. baos)]
-    (.writeObject oos object)
-    (.toString baos "ISO-8859-1")))
-
-(defn deserialize [s]
-  (with-open [bais (java.io.ByteArrayInputStream. (.getBytes s "ISO-8859-1"))
-              ois (java.io.ObjectInputStream. bais)]
-    (.readObject ois)))
-
-(defmethod print-dup :default [o w]
-  (.println System/out (str "WARN: using Java serialization for " (.getName (class o))))
-  (.write w "#=(immutant.messaging.codecs/deserialize ")
-  (print-dup (serialize o) w)
-  (.write w ")"))


CLJS-506: expose more Closure minification knobs

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -60,7 +60,8 @@
            com.google.javascript.jscomp.JSError
            com.google.javascript.jscomp.CheckLevel
            com.google.javascript.jscomp.DiagnosticGroups
-           com.google.javascript.jscomp.CommandLineRunner))
+           com.google.javascript.jscomp.CommandLineRunner
+           com.google.javascript.jscomp.AnonymousFunctionNamingPolicy))

 (defmacro ^:private debug-prn
   [& args]
@@ -96,6 +97,15 @@

   (when (contains? opts :pseudo-names)
     (set! (.generatePseudoNames compiler-options) (:pseudo-names opts)))
+
+  (when (contains? opts :anon-fn-naming-policy)
+    (let [policy (:anon-fn-naming-policy opts)]
+      (set! (.anonymousFunctionNaming compiler-options)
+        (case policy
+          :off AnonymousFunctionNamingPolicy/OFF
+          :unmapped AnonymousFunctionNamingPolicy/UNMAPPED
+          :mapped AnonymousFunctionNamingPolicy/MAPPED
+          (throw (IllegalArgumentException. (str "Invalid :anon-fn-naming-policy value " policy " - only :off, :unmapped, :mapped permitted")))))))

   (when (contains? opts :language-in)
     (case (:language-in opts)


fix deep lazy recursion

fix deep lazy recursion

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -392,7 +392,7 @@
            deps []]
       (if (seq requires)
         (let [node (get index (first requires))]
-          (recur (concat (rest requires) (:requires node)) (conj deps node)))
+          (recur (into (next requires) (:requires node)) (conj deps node)))
         (cons (get index "goog/base.js") (dependency-order deps))))))

 (comment


Generate first request and scenario line

--- src/clj_gatling/core.clj
+++ src/clj_gatling/core.clj
@@ -7,18 +7,23 @@
   (:gen-class))

 (defn process [id]
-  (println (str "executing" id))
-  (str "processed " id))
+  (let [start (System/currentTimeMillis)]
+    (println (str "Doing some heavy calculation for " id))
+    (Thread/sleep (rand 1000))
+    {:id id :start start :end (System/currentTimeMillis)}))
+

 (defn run-simulation [threads]
   (println (str "Run simulation with " threads " threads"))
   (let [cs (repeatedly threads async/chan)
         ps (map vector (iterate inc 1) cs)]
     (doseq [[i c] ps] (go (>! c (process i))))
-    (dotimes [i threads]
+    (let [result (for [i (range threads)]
       (let [[v c] (async/alts!! cs)]
-        (println v)))
-    (doseq [c cs] (async/close! c))))
+        v))]
+      (println result)
+      (doseq [c cs] (async/close! c))
+      result)))

 (defn create-chart [dir]
   (let [conf (scala.collection.mutable.HashMap.)]
@@ -26,14 +31,23 @@
     (GatlingConfiguration/setUp conf)
     (ReportsGenerator/generateFor "out" (FileDataReader. "23"))))

+(defn map-request [line]
+  (let [start (.toString (:start line))
+        end (.toString (:end line))]
+    ["REQUEST" "Scenario name" "0" "" "request_1" start start "1390591841245" end "OK" "\u0020"]))
+
+(defn map-scenario [line]
+  (let [start (.toString (:start line))
+        end (.toString (:end line))]
+    ["SCENARIO"	"Scenario name"	"0"	start end]))
+
+(defn create-result [times]
+  (let [header ["RUN" "20140124213040" "basicexamplesimulation" "\u0020"]]
+    [header (map-request (first times)) (map-scenario (first times))]))
+
 (defn -main [threads]
-  (run-simulation (read-string threads))
-  (let [result (csv/write-csv [
-    ["RUN" "20140124213040" "basicexamplesimulation" "\u0020"]
-    ["REQUEST" "Scenario name" "0" "" "request_1" "1390591841187" "1390591841187" "1390591841245" "1390591841338" "OK" "\u0020"]
-    ["SCENARIO"	"Scenario name"	"0"	"1390591841156"	"1390591841393"]
-                               ]
-    :delimiter "\t" :end-of-line "\n")]
-    (println result)
-    (spit "results/23/simulation.log" result)
+  (let [result (run-simulation (read-string threads))
+        csv (csv/write-csv (create-result result) :delimiter "\t" :end-of-line "\n")]
+    (println csv)
+    (spit "results/23/simulation.log" csv)
     (create-chart "results")))


backlog

backlog

--- src/cljs/app/pubnub.cljs
+++ src/cljs/app/pubnub.cljs
@@ -41,10 +41,6 @@
                     :subscribe_key subscribe-key
                     })

-;; ## need to block when channel is full!!
-;; ## Also make sure tap doesn't drain the initial stream values
-;; ## Should use different names for the different directions!
-
 (defn pubnub-bidir [pubnub name {:keys [restore backlog] :as options}]
   (.unsubscribe pubnub (clj->js {:channel name}))
   (let [out-chan (chan)
@@ -84,7 +80,7 @@
   (put! (:out-chan bidir) msg))

 (defn browser-bidir []
-  (pubnub-bidir (open-pubnub bidir-options) "arrive" {}))
+  (pubnub-bidir (open-pubnub bidir-options) "arrive" {:backlog 300}))

 (def tunnel
   (memoize #(pubnub-bidir (open-pubnub bidir-options) "arrive" {})))


We're going to start opting for overrides instead of trying to emulate JS too much

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -190,6 +190,7 @@
                     cljs.core/object?
                     cljs.core/is_proto_
                     cljs.core/type
+                    cljs.core/array
                     cljs.core/make-array
                     cljs.core/nil-iter})


Move line number at the end of keyword

Move line number at the end of keyword

--- src/cljs/klang/core.cljs
+++ src/cljs/klang/core.cljs
@@ -220,10 +220,12 @@
   [lg-ev]
   (.group js/console
           (gstring/format ;; firefox can't deal with format style stuff
-           "%s%s%s -- %s"
+           "%s%s%s%s -- %s"
            (:ns lg-ev)
            (if (empty? (:ns lg-ev)) "" "/")
            (name (:type lg-ev))
+           ;; The line number if we have one:
+           (if-let [lnum (:line (:meta lg-ev))] (str ":" lnum) "")
            ;; We can't dered DB here to get the formatter
            ;; or reagent will re-render everything always
            (time-formatter (:time lg-ev))))
@@ -231,7 +233,7 @@
   ;; log call. It might also catch the local bindings so we print them here.
   (when-let [meta (:meta lg-ev)]
     (.group js/console "Meta Data")
-    (some->> (:line meta) (.log js/console "Line-num: %d"))
+    ;;(some->> (:line meta) (.log js/console "Line-num: %d"))
     (some->> (:file meta) (.log js/console "Filename: %s"))
     (when-let [env (seq (:env meta))]
       ;; 3rd level nested group. Oh yeah


Fix wording in test descriptions

Fix wording in test descriptions

Refer to the keywords used and not the js method names.

--- src/cljs/tests/main.cljs
+++ src/cljs/tests/main.cljs
@@ -12,20 +12,20 @@
       (let [a true]
         (expect a :to-be true))))

-(describe "The toBe matcher compares with ==="
-  (it "and has a positive case"
+(describe "expect"
+  (it "has a positive case"
       (expect true :to-be true))
-  (it "and can have a negative case"
+  (it "and a negative case"
       (dont-expect false :to-be true)))

 (describe "Included matchers:"
-  (it "The 'toBe' matcher compares with ==="
+  (it "The :to-be matcher compares with ==="
       (let [a 12
             b a]
         (expect a :to-be b)
         (dont-expect a :to-be nil)))

-  (describe "The 'toEqual' matcher"
+  (describe "The :to-equal matcher"
     (it "works for simple literals and variables"
         (let [a 12]
           (expect a :to-equal 12)))
@@ -34,18 +34,18 @@
               bar (js-obj "a" 12 "b" 34)]
           (expect foo :to-equal bar))))

-  (it "The 'toMatch' matcher is for regular expressions"
+  (it "The :to-match matcher is for regular expressions"
       (let [message "foo bar baz"]
         (expect message :to-match (re-pattern "bar"))
         (expect message :to-match "bar")
         (dont-expect message :to-match (re-pattern "quux"))))

-  (it "The 'toBeDefined' matcher compares against 'undefined'"
+  (it "The :to-be-defined matcher compares against 'undefined'"
       (let [a (js-obj "foo" "foo")]
         (expect (aget a "foo") :to-be-defined)
         (expect (aget a "bar") :to-be-undefined)))

-  (it "The 'toBeNull' matcher compares against null"
+  (it "The :to-be-nil matcher compares against null"
       (let [a nil
             foo "foo"]
         (expect nil :to-be-nil)
@@ -64,12 +64,12 @@
         (expect a :to-be-falsy)
         (dont-expect foo :to-be-falsy)))

-  (it "The 'toContain' matcher is for finding an item in an Array"
+  (it "The :to-contain matcher is for finding an item in an Array"
       (let [a (array "foo" "bar" "baz")]
         (expect a :to-contain "bar")
         (dont-expect a :to-contain "quux")))

-  (it "The 'toBeLessThan' matcher is for mathematical comparisons"
+  (it "The :to-be-less-than matcher is for mathematical comparisons"
       (let [pi 3.1415926
             e 2.78]
         (expect e :to-be-less-than pi)
@@ -81,13 +81,13 @@
         (expect pi :to-be-greater-than e)
         (dont-expect e :to-be-greater-than pi)))

-  (it "The 'toBeCloseTo' matcher is for precision math comparison"
+  (it "The :to-be-close-to matcher is for precision math comparison"
       (let [pi 3.1415926
             e 2.78]
         (dont-expect pi :to-be-close-to e 2)
         (expect pi :to-be-close-to e 0)))

-  (it "The 'toThrow' matcher is for testing if a function throws an expection"
+  (it "The :to-throw matcher is for testing if a function throws an expection"
       (let [foo (fn [] (+ 1 2))
             bar (fn [] (throw "exception"))]
         (dont-expect foo :to-throw)


Prevent overflows in :case-scaled-error-plus-change

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -386,13 +386,13 @@
                                              (:errors ind)
                                              (:parent1-errors ind)
                                              (:parent2-errors ind))]
-                       (+ (* e 1000000)
-                          (#(cond
-                              (neg? %) -1
-                              (pos? %) 1
-                              :else 0)
-                            (- e (min p1e p2e))))))
-                (mapv #(* % 1000000) (:errors ind)))
+                       (+' (*' e 1000000)
+                           (#(cond
+                               (neg? %) -1
+                               (pos? %) 1
+                               :else 0)
+                             (- e (min p1e p2e))))))
+                (mapv #(*' % 1000000) (:errors ind)))
               ;
               (= cat :case-family-non-improvement)
               (if (not (:print-history argmap))


add check for Mac installer in nightly builds

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@11226 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -106,6 +106,11 @@
         pattern (re-pattern (str "MMSetup" bits "BIT_[^\\s]+?_" date-token ".exe"))]
     (re-find pattern txt)))

+(defn mac-build-on-server? [date-token]
+  (let [txt (slurp "http://valelab.ucsf.edu/~MM/nightlyBuilds/1.4/Mac/")
+        pattern (re-pattern (str date-token ".dmg"))]
+    (re-find pattern txt)))
+
 (def device-adapter-parent-dirs [(File. micromanager "/DeviceAdapters")
                                  (File. micromanager "/SecretDeviceAdapters")])

@@ -229,6 +234,7 @@
         outdated-jars (map #(.getName %)
                            (old-jars (File. micromanager "Install_AllPlatforms") 24))
         installer-ok (exe-on-server? bits today-token)
+        mac-ok (mac-build-on-server? today-token)
         missing-vcproj-files (missing-vcproj)]
     (when-not (and (not test)
                    (empty? svn-confs)
@@ -239,7 +245,8 @@
                    (empty? outdated-jars)
                    (empty? missing-vcproj-files)
                    (empty? missing-device-links)
-                   installer-ok)
+                   installer-ok
+                   mac-ok)
       (str
         "\n\nMICROMANAGER " bits "-bit "
           ({:inc "INCREMENTAL" :full "FULL"} mode)
@@ -258,8 +265,10 @@
           (report-segment "Missing device links" (missing-device-links)))
         (when report-missing?
           (report-segment "Missing device pages" (missing-device-pages)))
-        "\n\nIs installer download available on website?\n"
-        (if installer-ok "Yes." "No. (build missing)\n")))))
+        "\n\nIs Windows installer download available on website?\n"
+        (if installer-ok "Yes." "No. (build missing)\n")
+        "\n\nIs Mac installer download available on website?\n"
+        (if mac-ok "Yes." "No. (build missing)\n")))))

 (defn make-full-report [mode send?]
   (let [report


typo

typo

create consistent capitalization of "interceptor"

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -653,7 +653,7 @@
   (apply std-interceptors/path args))

 (defn enrich
-  "Returns an Interceptor which will run the given function `f` in the `:after`
+  "Returns an interceptor which will run the given function `f` in the `:after`
   position.

   `f` is called with two arguments: `db` and `v`, and is expected to
@@ -786,7 +786,7 @@
            ...))

-  If you put this Interceptor on handlers which might change paths `:a` or `:b`,
+  If you put this interceptor on handlers which might change paths `:a` or `:b`,
   it will:

     - call `f` each time the value at path `[:a]` or `[:b]` changes
@@ -918,7 +918,7 @@
   Adds the given collection of `interceptors` to those already in `context's`
   execution `:queue`. It returns the updated `context`.

-  So, it provides a way for one Interceptor to add more interceptors to the
+  So, it provides a way for one interceptor to add more interceptors to the
   currently executing interceptor chain.
   "
   {:api-docs/heading "Writing Interceptors"}


Improve re-sub error messages

Improve re-sub error messages

--- src/re_frame/subs.cljc
+++ src/re_frame/subs.cljc
@@ -94,15 +94,18 @@

 (defn- deref-input-signals
-  [sigs]
+  [sigs query-id]
   (cond
-    (sequential? sigs) (map deref sigs)
-    (map? sigs)  (map-vals deref sigs)
-    :else @sigs))     ;; XXX should we test this satifies? Isomething?
+    (sequential? sigs)       (map deref sigs)
+    (map? sigs)              (map-vals deref sigs)
+    (satisfies? IDeref sigs) @sigs
+    :else (console :error "re-frame: in reg-sub for " query-id ", input signal function returns a non-reactive input. Got: " sigs))

 (defn reg-sub
-  "There's 3 ways this function can be called
+  "Register a given handler function for a given query id.
+
+  There's 3 ways this function can be called

   1. (reg-sub
        :test-sub
@@ -169,8 +172,8 @@
         ([db query-vec]
          (let [subscriptions (inputs-fn query-vec)]
            (make-reaction
-             (fn [] (computation-fn (deref-input-signals subscriptions) query-vec)))))
+             (fn [] (computation-fn (deref-input-signals subscriptions query-id) query-vec)))))
         ([db query-vec dyn-vec]
          (let [subscriptions (inputs-fn query-vec dyn-vec)]
            (make-reaction
-             (fn [] (computation-fn (deref-input-signals subscriptions) query-vec dyn-vec)))))))))
+             (fn [] (computation-fn (deref-input-signals subscriptions query-id) query-vec dyn-vec)))))))))


clojure: added functions for mapping nodes signatures

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -78,6 +78,12 @@
                  (vec (map vec (take (inc dia) (shell-positions net pos v)))))]
     (classify-recursively (zipmap nodes shells))))

+(defn map-vv [f vv]
+  (into (vector) (map #(into (vector) (map f %)) vv)))
+
+(defn map-sig [M sig]
+  (map-vv #(.times % M) sig))
+
 (defn extend-matrix [M]
   (let [n (.numberOfRows M)
         m (.numberOfColumns M)


remove no more valid comment

remove no more valid comment

--- src/s7p/slave/core.clj
+++ src/s7p/slave/core.clj
@@ -27,7 +27,6 @@
     true))

 (defn validate [request {dsp :dsp status :status body :body}]
-  ;; TODO: validate status before parse json
   (let [ret (cond
               (= status 204)
               {:status :no-bid}


video processing with core.async

video processing with core.async

--- src/sormilla/video.clj
+++ src/sormilla/video.clj
@@ -1,50 +1,37 @@
 (ns sormilla.video
   (:import [com.twilight.h264.decoder AVFrame AVPacket H264Decoder MpegEncContext]
            [com.twilight.h264.player FrameUtils]
-           [java.awt RenderingHints Image]
            [java.awt.image BufferedImage]
-           [java.net Socket InetSocketAddress]
-           [javax.imageio ImageIO]
-           [java.io InputStream OutputStream ByteArrayInputStream BufferedInputStream]
-           [java.net InetAddress]
-           [org.apache.commons.io IOUtils])
+           [java.io InputStream BufferedInputStream]
+           [java.net Socket InetAddress])
   (:require [clojure.java.io :as io]
+            [clojure.core.async :as async :refer [>!! <!! alts!! go]]
             [metosin.system :as system]
-            [sormilla.task :as task]
             [sormilla.world :refer [world]]
             [sormilla.bin :as bin :refer [ba->ia]]
+            [sormilla.io-utils :as io-utils]
             [sormilla.drone :as drone]
             [sormilla.drone-comm :as comm]))

 (set! *warn-on-reflection* true)

-(defmacro while-let [[l r] & body]
-  `(loop [~l ~r]
-     (when ~l
-       ~@body
-       (recur ~r))))
+(defn make-frame-reader [^InputStream in]
+  (fn []
+    (try
+      (let [header       (io-utils/read-fully in (byte-array 12) 0 12)
+            signature    (bin/get-int header 0)
+            header-size  (bin/get-short header 6)
+            payload-size (bin/get-int header 8)
+            payload      (byte-array payload-size)]
+        (when-not (= signature 0x45566150) (throw (java.io.IOException. (format "out of sync (0x%08X)" signature))))
+        (io-utils/skip-fully in (- header-size 12))
+        (io-utils/read-fully in payload 0 payload-size))
+      (catch java.io.IOException _
+        nil)
+      (catch InterruptedException _
+        nil))))

-(defn read-fully [^InputStream in ^bytes buffer ^long offset ^long size]
-  (IOUtils/readFully in buffer offset size)
-  buffer)
-
-(defn make-reader [^InputStream in]
-  (fn []
-    (let [header   (byte-array 256)
-          payload  (byte-array (+ 65535 MpegEncContext/FF_INPUT_BUFFER_PADDING_SIZE))]
-      (try
-        (read-fully in header 0 12)
-        (let [signature    (bin/get-int header 0)
-              header-size  (bin/get-short header 6)
-              payload-size (bin/get-int header 8)
-              payload      (byte-array payload-size)]
-          (when-not (= signature 0x45566150) (throw (java.io.IOException. (format "out of sync (0x%08X)" signature))))
-          (read-fully in header 12 (- header-size 12))
-          (read-fully in payload 0 payload-size))
-        (catch java.io.EOFException _
-          nil)))))
-
-(defn make-decoder []
+(defn make-frame-decoder []
   (let [codec           (H264Decoder.)
         context         (MpegEncContext/avcodec_alloc_context)
         packet          (AVPacket.)
@@ -62,49 +49,65 @@
         (set! (.data_base packet) (ba->ia buffer ibuffer size))
         (set! (.data_offset packet) 0)
         (.avcodec_decode_video2 context frame got-picture? packet)
-        (when (zero? (first got-picture?)) (throw (java.io.IOException. "Could not decode frame")))
-        (let [picture         (.displayPicture (.priv_data context))
-              width           (.imageWidth picture)
-              height          (.imageHeight picture)
-              picture-buffer  (int-array (* width height))
-              image           (BufferedImage. width height BufferedImage/TYPE_INT_RGB)]
-          (FrameUtils/YUV2RGB picture picture-buffer)
-          (.setRGB image 0 0 width height picture-buffer 0 width)
-          image)))))
+        ;(when (zero? (first got-picture?)) (throw (java.io.IOException. "Could not decode frame")))
+        (when-not (zero? (first got-picture?))
+          (let [picture         (.displayPicture (.priv_data context))
+                width           (.imageWidth picture)
+                height          (.imageHeight picture)
+                picture-buffer  (int-array (* width height))
+                image           (BufferedImage. width height BufferedImage/TYPE_INT_RGB)]
+            (FrameUtils/YUV2RGB picture picture-buffer)
+            (.setRGB image 0 0 width height picture-buffer 0 width)
+            image))))))

-(def video-source (atom nil))
+(defmacro while-let [[l r] & body]
+  `(loop [~l ~r]
+     (when ~l
+       ~@body
+       (recur ~r))))

-(defn open-socket ^Socket []
-  (println "Connecting to video stream:" (str @video-source))
-  (doto (Socket.)
-    (.setSoTimeout 2000)
-    (.connect (InetSocketAddress. ^InetAddress @video-source 5555))))
+(defmacro thread* [& body]
+  `(async/thread
+     (try
+       ~@body
+       (catch Throwable e#
+         (println "exception in thread:")
+         (.printStackTrace e#)
+         nil))))

-(def run (atom false))
+(defn read-frame-task [^Socket socket frame-ch]
+  (let [frame-reader (-> socket .getInputStream BufferedInputStream. make-frame-reader)]
+    (while-let [frame (frame-reader)]
+      (>!! frame-ch frame))))

-(defn send-init-video [^Socket socket]
-  (doto (.getOutputStream socket)
-    (.write (byte-array (map bin/ubyte [1 0 0 0])))
-    (.flush)))
+(defn decode-frame-task [frame-ch image-ch]
+  (let [frame-decoder (make-frame-decoder)]
+    (while-let [frame (<!! frame-ch)]
+      (when-let [image (frame-decoder frame)]
+        (>!! image-ch image)))))

-(defn video-streaming-task []
-  (try
-    (while @run
-      (let [socket      (open-socket)
-            reader      (make-reader (-> socket .getInputStream BufferedInputStream.))
-            decoder     (make-decoder)]
-        (try
-          (send-init-video socket)
-          (while @run
-            (->> (reader) (decoder) (swap! world assoc :image)))
-          (catch java.io.IOException e
-            (println "I/O error:" e ": reconnecting...")
-            (Thread/sleep 1000))
-          (finally
-            (try (.close socket) (catch Exception _))))))
-    (catch Throwable e
-      (println "exception while processing video stream" e)
-      (.printStackTrace e))))
+(defn update-image-task [image-ch]
+  (while-let [image (<!! image-ch)]
+    (swap! world assoc :image image)))
+
+(defn video-streaming-task [cancel-ch]
+  (loop []
+    (println "video: connecting...")
+    (let [socket   (io-utils/open-video-socket #_ comm/drone-ip (InetAddress/getByName nil))
+          frame-ch (async/chan (async/sliding-buffer 10))
+          image-ch (async/chan (async/sliding-buffer 10))
+          [v ch]   (alts!! [cancel-ch
+                            (thread* (read-frame-task socket frame-ch))
+                            (thread* (decode-frame-task frame-ch image-ch))
+                            (thread* (update-image-task image-ch))])]
+      (println "video: cleanup..." (= ch cancel-ch))
+      (async/close! frame-ch)
+      (async/close! image-ch)
+      (try (.close ^Socket socket) (catch Exception _))
+      (when-not (= ch cancel-ch)
+        (Thread/sleep 1000)
+        (println "video: reconnecting...")
+        (recur)))))

 ;;
 ;; ============================================================================
@@ -112,16 +115,17 @@
 ;; ============================================================================
 ;;

+(def cancel-ch (atom nil))
+
 (def service (reify system/Service
                (start! [this config]
-                 (reset! run true)
-                 (reset! video-source (if (:video-sim config)
-                                        (InetAddress/getByName nil)
-                                        comm/drone-ip))
-                 (task/submit :video video-streaming-task)
+                 (let [ch (async/chan)]
+                   (thread* (video-streaming-task ch))
+                   (reset! cancel-ch ch))
                  config)
                (stop! [this]
-                 (reset! run false)
-                 (task/cancel :video))))
+                 (when-let [ch @cancel-ch]
+                   (async/close! ch)
+                   (reset! cancel-ch nil)))))

 ; ffmpeg -f h264 -an -i capture.h264 stream.m4v


Change file tests to use valid response map

--- ring-core/test/ring/middleware/test/file.clj
+++ ring-core/test/ring/middleware/test/file.clj
@@ -3,24 +3,27 @@
             [ring.middleware.file :refer :all])
   (:import [java.io File]))

+(def test-response
+  {:status 200, :headers {}, :body "test"})
+
 (deftest wrap-file-no-directory
   (is (thrown-with-msg? Exception #".*Directory does not exist.*"
-    (wrap-file (constantly :response) "not_here"))))
+    (wrap-file (constantly test-response) "not_here"))))

 (def public-dir "test/ring/assets")
 (def index-html (File. ^String public-dir "index.html"))
 (def foo-html   (File. ^String public-dir "foo.html"))

-(def app (wrap-file (constantly :response) public-dir))
+(def app (wrap-file (constantly test-response) public-dir))

 (deftest test-wrap-file-unsafe-method
-  (is (= :response (app {:request-method :post :uri "/foo"}))))
+  (is (= test-response (app {:request-method :post :uri "/foo"}))))

 (deftest test-wrap-file-forbidden-url
-  (is (= :response (app {:request-method :get :uri "/../foo"}))))
+  (is (= test-response (app {:request-method :get :uri "/../foo"}))))

 (deftest test-wrap-file-no-file
-  (is (= :response (app {:request-method :get :uri "/dynamic"}))))
+  (is (= test-response (app {:request-method :get :uri "/dynamic"}))))

 (deftest test-wrap-file-directory
   (let [{:keys [status headers body]} (app {:request-method :get :uri "/"})]
@@ -35,9 +38,9 @@
     (is (= foo-html body))))

 (deftest test-wrap-file-no-index
-  (let [app  (wrap-file (constantly :response) public-dir {:index-files? false})
+  (let [app  (wrap-file (constantly test-response) public-dir {:index-files? false})
         resp (app {:request-method :get :uri "/"})]
-    (is (= :response resp))))
+    (is (= test-response resp))))

 (deftest test-wrap-file-path-info
   (let [request {:request-method :get


Refactoring

Refactoring

--- src/tictactoe/core.clj
+++ src/tictactoe/core.clj
@@ -63,24 +63,27 @@
   (filter #(= (get board (- %1 1)) "")
     [1 2 3 4 5 6 7 8 9]))

+(defn player-would-win?
+  [board move player]
+  (winning-board? (game-board board move player) player))
+
+(defn possible-game-weightings
+  [best-case-fn player board move depth is-current-player]
+  (map
+    #(best-case-fn (opponent player) %1 (game-board board move player) (not is-current-player) (+ 1 depth))
+    (valid-moves (game-board board move player))))
+
 (defn best-case
   [player move board is-current-player depth]
   (cond
-    (and (winning-board? (game-board board move player) player) is-current-player) (- 10 depth)
-    (and (winning-board? (game-board board move player) player) (not is-current-player)) (- depth 10)
+    (and (player-would-win? board move player) is-current-player) (- 10 depth)
+    (and (player-would-win? board move player) (not is-current-player)) (- depth 10)
     (= [] (valid-moves board)) 0
     :else
-      (cond
-        is-current-player
-          (apply min
-            (map
-              #(best-case (opponent player) %1 (game-board board move player) (not is-current-player) (+ 1 depth))
-              (valid-moves (game-board board move player))))
-        :else
-          (apply max
-            (map
-              #(best-case (opponent player) %1 (game-board board move player) (not is-current-player) (+ 1 depth))
-              (valid-moves (game-board board move player)))))))
+      (let [weightings (possible-game-weightings best-case player board move depth is-current-player)]
+        (cond
+          is-current-player (apply min weightings)
+          :else (apply max weightings)))))

 (defn cpu-move
   [board current-player]