Update docs for (smooth) and (no-smooth) to reflect the fact that they must be called from :settings only in clojure.

--- src/cljx/quil/core.cljx
+++ src/cljx/quil/core.cljx
@@ -2715,7 +2715,9 @@
     :subcategory "Attributes"
     :added "1.0"}
   no-smooth
-  "Draws all geometry with jagged (aliased) edges."
+  "Draws all geometry with jagged (aliased) edges. Clojure: must be
+  called inside :settings function. ClojureScript: can be called
+  anywhere."
   [] (.noSmooth (current-graphics)))

 (defn
@@ -3725,6 +3727,9 @@
   "Draws all geometry with smooth (anti-aliased) edges. This will slow
   down the frame rate of the application, but will enhance the visual
   refinement.
+
+  Clojure: must be called inside :settings function.
+  ClojureScript: can be called anywhere.

   The level parameter (int) increases the level of smoothness with the
   P2D and P3D renderers. This is the level of over sampling applied to


Added additional logging and better error handling to future-with-logging macro.

--- src/cmr/common/util.clj
+++ src/cmr/common/util.clj
@@ -33,9 +33,13 @@
     (info "Starting " ~taskname)
     (try
       ~@body
-      (catch Exception e#
+
+      (info ~taskname " completed without exception")
+
+      (catch Throwable e#
         (error e# "Exception in " ~taskname)
         (throw e#))
       (finally
         (info ~taskname " complete.")))))

+


CMR-5195 Addresses PR comments.

CMR-5195 Addresses PR comments.

--- src/cmr/sizing/core.clj
+++ src/cmr/sizing/core.clj
@@ -31,15 +31,17 @@
        (util/data-type->bytes data-type))))

 (defn- get-avg-gran-size
+  "Gets SizeEstimation value for AverageSizeOfGranulesSampled and parses it to a number."
   [vars]
-  (let [value (get-in (first vars) [:umm :SizeEstimation :AvgCompressionRateASCII])]
+  (let [value (get-in (first vars) [:umm :SizeEstimation :AverageSizeOfGranulesSampled])]
     (if (string? value)
       (read-string value)
       value)))

 (defn- get-avg-compression-rate
+  "Gets SizeEstimation value for AvgCompressionRateASCII and parses it to a number."
   [vars]
-  (let [value (get-in (first vars) [:umm :SizeEstimation :AverageSizeOfGranulesSampled])]
+  (let [value (get-in (first vars) [:umm :SizeEstimation :AvgCompressionRateASCII])]
     (if (string? value)
       (read-string value)
       value)))
@@ -58,6 +60,7 @@
     (+ (* granule-count compression measurements) metadata)))

 (defn- estimate-ascii-size
+  "Calculates the estimated size for ASCII format."
   [granule-count variables params]
   (let [metadata 0
         avg-gran-size (get-avg-gran-size variables)


Added more complete white space checks.

Added more complete white space checks.

--- test/fcms/unit/resources/slugify.clj
+++ test/fcms/unit/resources/slugify.clj
@@ -10,18 +10,20 @@
   (slugify "sluG" identity) => "slug"
   (slugify "sLuG" identity) => "slug")

-(fact "spaces are replaced with a single dash"
+(fact "white space is replaced with a single dash"
   (slugify "this is a slug" identity) => "this-is-a-slug"
   (slugify "this is-a slug" identity) => "this-is-a-slug"
   (slugify "this  is  a  slug" identity) => "this-is-a-slug"
-  (slugify "this is a          slug" identity) => "this-is-a-slug")
+  (slugify "this is a          slug" identity) => "this-is-a-slug"
+  (slugify "this\t\tis\r\ralso\n\na\r\n\r\nslug" identity) => "this-is-also-a-slug")

 (fact "prefixed and trailing spaces are ignored"
   (slugify " this is a slug" identity) => "this-is-a-slug"
   (slugify " this is a slug" identity) => "this-is-a-slug"
   (slugify "this is a slug " identity) => "this-is-a-slug"
   (slugify " this is a slug " identity) => "this-is-a-slug"
-  (slugify "          this is a slug          " identity) => "this-is-a-slug")
+  (slugify "          this is a slug          " identity) => "this-is-a-slug"
+  (slugify "\t\tthis is a slug\t\t\r\n\r\n" identity) => "this-is-a-slug")

 (fact "punctuation is replaced with a dash")


Repair test

Repair test

--- test/gml_to_featured/runner_test.clj
+++ test/gml_to_featured/runner_test.clj
@@ -2,7 +2,7 @@
   (:require [gml-to-featured.runner :refer :all]
             [gml-to-featured.code :refer :all]
             [clojure.test :refer :all])
-  (:import (java.io ByteArrayOutputStream)))
+  (:import (java.io StringWriter)))

 (defn translate-resource [resource element translator]
   (with-open [in (clojure.java.io/input-stream (clojure.java.io/resource resource))]
@@ -73,9 +73,16 @@
 (deftest test-translate
   (testing "translate"
     (with-open [in (clojure.java.io/input-stream (clojure.java.io/resource "nested.xml"))
-                out (ByteArrayOutputStream.)]
+                out (StringWriter.)]
       (binding [*sequence-selector* identity]
-        (translate "dataset-1" (slurp "dev-resources/nested-config.edn") "2016-01-01" in out))
+        (translate
+          "dataset-1"
+          (slurp "dev-resources/nested-config.edn")
+          "2016-01-01"
+          in
+          #(doseq [file %]
+             (doseq [fragment file]
+               (.write out fragment)))))
       (let [result (.toString out)]
         (is (= true (boolean (re-find #"\"dataset\":\"dataset-1\"" result))))
         (is (= true (boolean (re-find #"\"attr-k\":\"foo\"" result))))


Remove duplicated code

Remove duplicated code

--- src/flare/string.clj
+++ src/flare/string.clj
@@ -21,14 +21,6 @@
 (defn diff->tuple
   [diff]
   [(operation->keyword (.operation diff)) (.text diff)])
-
-(defn partition-between
-  [pred? coll]
-  (->> (map pred? coll (rest coll))
-       (reductions not= true)
-       (map list coll)
-       (partition-by second)
-       (map (partial map first))))

 (defn insert-operation?
   [[operation _]]


eval buffer action

eval buffer action

--- src/fugue/space.cljs
+++ src/fugue/space.cljs
@@ -75,48 +75,51 @@

 (defn on-eval [state result]
   (-> state
-      (hide-popup)
       (assoc-in [:files (:next-id state)] (:value result))
       (update :boxes b/insert :after (:active state) (:next-id state))
       (activate (:next-id state))
       (update :next-id inc)))

-(defn on-key [state actions key]
+(defn do-eval [eval-state state state-cb]
+  (let [[source settings] ((juxt current-buffer-text eval-settings) state)
+        eval-cb #(state-cb (on-eval state %))]
+    (cljs.js/eval-str eval-state source nil settings eval-cb)))
+
+(defn on-key [state actions key cb]
   (cond
     (and (empty (:key-seq state)) (= " " key))
-    (show-popup state)
+    (cb (show-popup state))
     (and (not-empty (:key-seq state)) (= "Escape" key))
-    (hide-popup state)
+    (cb (hide-popup state))
     :else
     (let [new-seq (conj (:key-seq state) key)]
       (if-let [action (get actions new-seq)]
-        (action (assoc state :key-seq nil))
-        (assoc state :key-seq new-seq)))))
+        (action (assoc state :key-seq nil) cb)
+        (cb (assoc state :key-seq new-seq))))))

 (defn app []
   (let [eval-state (cljs.js/empty-state)
         state (r/atom init-state)]
-    (defn eval! []
-      (let [[source settings] ((juxt current-buffer-text eval-settings) @state)
-            cb (partial swap! state on-eval)]
-        (cljs.js/eval-str eval-state source nil settings cb)))
     (defn on-keydown [e]
       (let [in-popup (some? (:key-seq @state))
             in-textbox (= "TEXTAREA" (.. js/document -activeElement -tagName))
             key (.-key e)]
         (when (or in-popup (not in-textbox))
           (.preventDefault e)
-          (swap! state on-key {} key))))
-    (.defineAction js/CodeMirror.Vim "space!" #(swap! state show-popup))
-    (.mapCommand js/CodeMirror.Vim "<Space>" "action" "space!" #js {} #js {"context" "normal"})
-    (.addEventListener js/document "keydown" on-keydown)
-    (fn []
-      [:div.boxes
-       [boxes
-        @state
-        {:on-box-click #(swap! state activate %)
-         :on-text-change (fn [id new-text]
-                           (swap! state assoc-in [:files id] new-text))
-         :on-shortcut #(swap! state show-popup)}]
-       (if-let [keys (:key-seq @state)]
-         [popup-content keys])])))
+          (on-key @state
+                  {["e" "b"] (partial do-eval eval-state)}
+                 key
+                 (partial reset! state)))))
+     (.defineAction js/CodeMirror.Vim "space!" #(swap! state show-popup))
+     (.mapCommand js/CodeMirror.Vim "<Space>" "action" "space!" #js {} #js {"context" "normal"})
+     (.addEventListener js/document "keydown" on-keydown)
+     (fn []
+       [:div.boxes
+        [boxes
+         @state
+         {:on-box-click #(swap! state activate %)
+          :on-text-change (fn [id new-text]
+                            (swap! state assoc-in [:files id] new-text))
+          :on-shortcut #(swap! state show-popup)}]
+        (if-let [keys (:key-seq @state)]
+          [popup-content keys])])))


rename fn

rename fn

--- src/gangway/util.clj
+++ src/gangway/util.clj
@@ -7,7 +7,7 @@
   (msg/start n)
   (msg/listen n (partial worker system)))

-(defn queue-definitions [qid]
+(defn attache->queues [qid]
   (let [n (name qid)]
     {:in {:name (str "queue.in." n)
           :worker gangway.worker/do-work}
@@ -16,10 +16,10 @@

 ;; TODO: handle exceptions
 (defn start-queues! [system]
-  (let [qids (get-in system [:flare :attaches])
+  (let [attaches (get-in system [:flare :attaches])
         queues (reduce (fn start-queues!- [c v]
-                         (assoc c v (queue-definitions v)))
-                       {} qids)
+                         (assoc c v (attache->queues v)))
+                       {} attaches)
         qs (flatten (for [qsys queues] (vals (second qsys))))]
     (dorun (map (partial start-queue! system) qs))
     (assoc-in system [:gangway :queues] queues)))


Get rid of separate relations storage

Get rid of separate relations storage

--- src/helda/system.clj
+++ src/helda/system.clj
@@ -9,7 +9,6 @@
       :db {
         :models-storage (atom {})
         :listeners-storage (atom {})
-        :relations-storage (atom {})
         :worlds-storage (atom {})
         :entities-storage (atom {})
         :events-storage (atom {})


fix tests failing at intended race conditions

--- test/cljc/commos/delta/compscribe_test.cljc
+++ test/cljc/commos/delta/compscribe_test.cljc
@@ -22,78 +22,89 @@
   #?(:cljs (:require-macros [cljs.core.async.macros :refer [go go-loop]])))

 (deftest compscribe-root
-  (let [[subs-fn unsubs-fn [subscriptions unsubscribable]]
+  (let [block-foo (chan)
+        [subs-fn unsubs-fn [subscriptions unsubscribable]]
         (simulate-api
          {"/foo/"
-          {:deltas {0 [[:is #{0}]]}}
+          {:deltas {0 [[:is #{0}]
+                       block-foo]}}
           "/bar/"
           {:deltas {0 [[:is :bar 42]]}}})
-        target (chan)
+        target (chan 1 delta/values)
         end-subscription (compscribe target subs-fn unsubs-fn
                                      ["/foo/" ["/bar/"]]
                                      0)]
     (test-async
      (test-within 1000
        (go
-         (let [evts (<! (a/into [] target))]
-           (is (= evts
-                  [[:is [0 :bar] 42]]))))))))
+         (is (= (<! target)
+                {0 {:bar 42}}))
+         (close! block-foo))))))

 (deftest compscribe-one
-  (let [[subs-fn unsubs-fn [subscriptions unsubscribable]]
+  (let [block-foo (chan)
+        [subs-fn unsubs-fn [subscriptions unsubscribable]]
         (simulate-api
          {"/foo/"
-          {:deltas {0 [[:is :bar 0]]}}
+          {:deltas {0 [[:is :bar 0]
+                       block-foo]}}
           "/bar/"
           {:deltas {0 [[:is :baz 42]]}}})
-        target (chan)
+        target (chan 1 delta/values)
         end-subscription (compscribe target subs-fn unsubs-fn
                                      ["/foo/" {:bar ["/bar/"]}]
                                      0)]
     (test-async
      (test-within 1000
        (go
-         (let [evts (<! (a/into [] target))]
-           (is (= evts
-                  [[:is [:bar :baz] 42]]))))))))
+         (is (= (<! target)
+                {:bar {:baz 42}}))
+         (close! block-foo))))))

 (deftest compscribe-many
-  (let [[subs-fn unsubs-fn [subscriptions unsubscribable]]
+  (let [block-foo (chan)
+        [subs-fn unsubs-fn [subscriptions unsubscribable]]
         (simulate-api
          {"/foo/"
-          {:deltas {0 [[:in :bar 0]]}}
+          {:deltas {0 [[:in :bar 0]
+                       block-foo]}}
           "/bar/"
           {:deltas {0 [[:is :baz 42]]}}})
-        target (chan)
+        target (chan 1 delta/values)
         end-subscription (compscribe target subs-fn unsubs-fn
                                      ["/foo/" {:bar ["/bar/"]}]
                                      0)]
     (test-async
      (test-within 1000
        (go
-         (let [evts (<! (a/into [] target))]
-           (is (= evts
-                  [[:is [:bar 0 :baz] 42]]))))))))
+         (is (= (<! target)
+                {:bar {0 {:baz 42}}}))
+         (close! block-foo))))))

 (deftest compscribe-nested
-  (let [[subs-fn unsubs-fn [subscriptions unsubscribable]]
+  (let [block-foo (chan)
+        block-bar (chan)
+        [subs-fn unsubs-fn [subscriptions unsubscribable]]
         (simulate-api
          {"/foo/"
-          {:deltas {0 [[:in :bar 0]]}}
+          {:deltas {0 [[:in :bar 0]
+                       block-foo]}}
           "/bar/"
-          {:deltas {0 [[:is :baz 0]]}}
+          {:deltas {0 [[:is :baz 0]
+                       block-bar]}}
           "/baz/"
           {:deltas {0 [[:is 42]]}}})
-        target (chan)
+        target (chan 1 delta/values)
         end-subscription (compscribe target subs-fn unsubs-fn
                                      ["/foo/" {:bar ["/bar/" {:baz ["/baz/"]}]}]
                                      0)]
     (test-async
      (test-within 1000
        (go
-         (let [r (reduce delta/add nil (<! (a/into [] target)))]
-           (is (= r
-                  {:bar {0 {:baz 42}}}))))))))
+         (is (= (<! target)
+                {:bar {0 {:baz 42}}}))
+         (close! block-bar)
+         (close! block-foo))))))

 (deftest uncompscribe-root
   (let [foo-complete (chan)


fix how we pull db config

fix how we pull db config

--- src/irmgard/core.clj
+++ src/irmgard/core.clj
@@ -110,16 +110,41 @@
       (process-row-changes conf conn))))

 (defn config->jdbc-url [c]
-  (format "jdbc:postgresql://%s:%s/%s"
+  (format "jdbc:postgresql://%s:%s@%s:%s/%s"
+          (c :user)
+          (c :password)
           (c :host     "localhost")
           (c :port     "5432")
-          (c :database)))
+          (or (c :database)
+              (c :subname))))
+
+(comment
+
+  (jdbc/with-connection {:connection-uri (config->jdbc-url (:conf conf))
+                         :username       (:user (:conf conf))
+                         :password       (:password (:conf conf))}
+    (jdbc/find-connection))
+
+
+  (jdbc/with-connection {:port 5432
+                         :host "127.0.0.1"
+                         :password "postgres1"
+                         :user "rails"
+                         :classname "org.postgresql.Driver"
+                         ;; :subname "relayzone_development"
+                         :subname (str "//127.0.0.1:5432/relayzone_development" )
+                         :subprotocol "postgresql"
+                         :sleep-time 2500}
+    (jdbc/find-connection))
+
+)
+

 (defn db-watcher [conf]
   ;; TODO: implement try/catch/finally to clean up:
   ;;    UNLISTEN irmgard when terminating
   ;;    close database connection, ensure we do that in a finally block
-  (jdbc/with-connection (db-conn-info (:dbconf conf))
+  (jdbc/with-connection (:conf conf)
     (jdbc/do-commands "LISTEN irmgard")
     (let [conn                (jdbc/find-connection)
           dbname              (-> conf :dbconf :subname)


Split the make-prepared atrocity into smaller bits

--- src/constraint/svg.cljs
+++ src/constraint/svg.cljs
@@ -208,8 +208,19 @@
       :stroke-width 2}]))

-(defn make-prepared-svg
-  [[width height] edges vertices editing? selected random?]
+(defn make-svg-graph
+  [{:keys [editing? selected] :as world-state}]
+  (let [edges           (prepare-edges world-state)
+        vertices        (prepare-vertices world-state)
+        make-svg-vertex (partial svg-vertex selected editing?)]
+    (list (map svg-edge edges)
+          (map make-svg-vertex vertices)
+          (if (and editing? selected)
+            (add-delete vertices selected)))))
+
+
+(defn make-svg-head
+  [[width height] editing? random?]
   [:svg:svg {:width width :height height}
    [:svg:defs
     triangle-marker-ok
@@ -223,22 +234,14 @@
      :width 1 :height 1}]

    (edit-button 10 10 100 20 editing?)
-   (auto-button 110 10 100 20 random?)
-
-
-   (map svg-edge edges)
-   (map (partial svg-vertex selected editing?) vertices)
-   (if (and editing? selected)
-     (add-delete vertices selected)
-     )])
+   (auto-button 110 10 100 20 random?)]
+  )

 (defn make-svg
   [world-state]
-  (make-prepared-svg
-   (map-size world-state)
-   (prepare-edges world-state)
-   (prepare-vertices world-state)
-   (:editing? world-state)
-   (:selected world-state)
-   (:random world-state)
-   ))
+  (let [head  (make-svg-head
+               (map-size world-state)
+               (:editing? world-state)
+               (:random world-state))
+        graph (make-svg-graph world-state)]
+    (conj head graph)))


Print thread debug information when shutdown takes too long.

--- src/containium/core.clj
+++ src/containium/core.clj
@@ -12,7 +12,8 @@
             [clojure.string :refer (split trim)]
             [boxure.core :refer (boxure) :as boxure]
             [clojure.tools.nrepl.server :as nrepl])
-  (:import [jline.console ConsoleReader]))
+  (:import [jline.console ConsoleReader]
+           [java.util Timer TimerTask]))

 ;;; Globals for nREPL access. A necessary evil.
@@ -255,6 +256,23 @@
             (recur (or new-state state) (or new-boxes boxes))))))))

+;;; Thread debug on shutdown.
+
+(defn shutdown-timer
+  "Start a timer that shows debug information, iff the JVM has not
+  shutdown yet and `wait` seconds have passed."
+  [wait]
+  (let [timer (Timer. "shutdown-timer" true)
+        task (proxy [TimerTask] []
+               (run []
+                 (let [threads (keys (Thread/getAllStackTraces))]
+                   (println (apply str "Threads still running (" (count threads) "):\n  "
+                                   (interpose "\n  " threads))))))
+        cancel-thread (Thread. #(.cancel timer))]
+    (.schedule timer task (* wait 1000))
+    (.addShutdownHook (Runtime/getRuntime) cancel-thread)))
+
+
 ;;; The coordinating functions.

 (defn run
@@ -278,4 +296,5 @@
                    [:kafka kafka/start kafka/stop]
                    [:http-kit http-kit/start http-kit/stop]]
       (:config spec) {} (partial run spec)))
-  (shutdown-agents))
+  (shutdown-agents)
+  (shutdown-timer 10))


translation skeleton

translation skeleton

--- src/docker/provider.clj
+++ src/docker/provider.clj
@@ -21,14 +21,14 @@
     [celestial.persistency :as p]
     [celestial.persistency.systems :as s]))

-
 (import-logging)

-(defconstrainedrecord Instance [docker node]
+(defconstrainedrecord Container [node container]
   "A docker container instance"
   []
   Vm
   (create [this]
+
     )

   (start [this]
@@ -43,10 +43,11 @@
   (status [this]
     ))

-(defmethod translate :proxmox [{:keys [machine docker system-id] :as spec}]
+(defmethod translate :docker [{:keys [machine docker system-id] :as spec}]
   "Convert the general model into a docker specific one"
-  )
+   (merge machine docker {:system-id system-id}))

 (defmethod vconstruct :docker [{:keys [docker] :as spec}]
   (let [{:keys [type node]} docker]
+    (apply ->Container node (translate spec))
     ))


Bugfix, count the arg not the fn

Bugfix, count the arg not the fn

--- src/grimoire/either.clj
+++ src/grimoire/either.clj
@@ -49,7 +49,7 @@
   the fail constructor."
   [x]
   {:pre [(vector? x)
-         (= 2 (count vector))]}
+         (= 2 (count x))]}
   (= :fail (first x)))

 (defn message


Refactor (if x y nil) to (when x y)

Refactor (if x y nil) to (when x y)

--- src/grimoire/things.clj
+++ src/grimoire/things.clj
@@ -361,7 +361,7 @@
   returns that value. Otherwise returns nil."
   [t]
   {:pre [(thing? t)]}
-  (if (def? t) t nil))
+  (when (def? t) t))

 ;; Bits and bats


Avoid initial trigger without delay in the pool

--- src/io/cyanite/pool.clj
+++ src/io/cyanite/pool.clj
@@ -49,7 +49,7 @@
   (join [this]
     (while (not (.awaitTermination pool 10000 secs)) nil))
   (recurring [this f delay]
-    (.scheduleAtFixedRate pool (wrapped reporter f) 0 delay secs)))
+    (.scheduleAtFixedRate pool (wrapped reporter f) delay delay secs)))

 (defn cancelled?
   [task]


Transient save suggests first workspace directory as location

When saving a new file, the Save As dialog will point to the first folder in the active workspace, if any.
If no workspace is active, the Save As dialog will point to the home folder.

--- src/lt/objs/opener.cljs
+++ src/lt/objs/opener.cljs
@@ -59,7 +59,8 @@
 (behavior ::transient-save
                   :triggers #{:save :save-as-rename!}
                   :reaction (fn [this]
-                              (let [s (save-input this (files/home))]
+                              (let [s (save-input this (or (first (:folders @workspace/current-ws))
+                                                           (files/home)))]
                                 (set! active-dialog s)
                                 (dom/trigger s :click))))


Handle nil total_time in smil-clock-value

--- src/mdr2/production.clj
+++ src/mdr2/production.clj
@@ -74,11 +74,12 @@
   "Return total_time for a `production` as a SMIL Clock Value
   according to http://www.daisy.org/z3986/2005/Z3986-2005.html#Clock,
   i.e. as \"3:22:55.91\""
-  (let [in-secs (quot total_time 1000)
+  (let [time (or total_time 0)
+        in-secs (quot time 1000)
         hours (quot in-secs 3600)
         minutes (quot (mod in-secs 3600) 60)
         seconds (mod in-secs 60)
-        millis (mod total_time 1000)]
+        millis (mod time 1000)]
     (format "%02d:%02d:%02d.%03d" hours minutes seconds millis)))

 (defn uuid


Adapt to the api change in db

Adapt to the api change in db

--- src/mdr2/production.clj
+++ src/mdr2/production.clj
@@ -52,7 +52,7 @@
         (fs/mkdirs (path (:id p)))))

 (defn update [production]
-  (db/update production))
+  (db/update! production))

 (defn find
   "Find a production given its `id`"


(maint) Require kitchensink to resolve ks/absolute-path in user_repl.clj

--- dev/user_repl.clj
+++ dev/user_repl.clj
@@ -18,7 +18,8 @@
             [clojure.pprint :as pprint]
             [puppetlabs.services.protocols.jruby-puppet :as jruby-protocol]
             [puppetlabs.services.jruby.jruby-puppet-core :as jruby-core]
-            [me.raynes.fs :as fs]))
+            [me.raynes.fs :as fs]
+            [puppetlabs.kitchensink.core :as ks]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Configuration


Don't restrict macchiato requests to localhost by default

The load generator (wrk) is running on a different machine than the
HTTP server, so restricting the HTTP server to only accept requests from
localhost means all the tests fail.  This change should fix that.

--- frameworks/Clojure/macchiato/hello/src/hello/core.cljs
+++ frameworks/Clojure/macchiato/hello/src/hello/core.cljs
@@ -10,7 +10,7 @@

 (defn app []
   (mount/start)
-  (let [host (or (:host @env) "127.0.0.1")
+  (let [host (or (:host @env) "0.0.0.0")
         port (or (some-> @env :port js/parseInt) 3000)]
     (http/start
       {:handler    (wrap-defaults router)


Don't produce a no-op fake-wrapper if there are no fakes to wrap.

--- src/midje/midje_forms/translating.clj
+++ src/midje/midje_forms/translating.clj
@@ -70,16 +70,21 @@
       (second canonicalized-non-fake))
     (throw (Error. (str "Could make nothing of " canonicalized-non-fake)))))

+(defn- final-fake-wrapper [fakes]
+  (with-wrapping-target
+    `(with-pushed-namespace-values :midje/background-fakes ~fakes ~(?form))
+    :checks))
+
 ;; Collecting all the background fakes is here for historical reasons:
 ;; it made it easier to eyeball expanded forms and see what was going on.
 (defn- final-wrappers [raw-wrappers]
   (define-metaconstants raw-wrappers)
   (let [canonicalized (canonicalize-raw-wrappers raw-wrappers)
-	[fakes others] (separate-by fake? canonicalized)
-	final-fakes (with-wrapping-target
-		      `(with-pushed-namespace-values :midje/background-fakes ~fakes ~(?form))
-		      :checks)]
-    `[    ~@(eagerly (map make-final others)) ~final-fakes ]))
+	[fakes state-wrappers] (separate-by fake? canonicalized)
+	final-state-wrappers (eagerly (map make-final state-wrappers))]
+    (if (empty? fakes)
+      final-state-wrappers
+      (concat final-state-wrappers (list (final-fake-wrapper fakes))))))

 (defmacro- with-additional-wrappers [raw-wrappers form]
   `(with-pushed-namespace-values :midje/wrappers (final-wrappers ~raw-wrappers)


Cleanup and comments (!) about unfolding.

--- src/midje/midje_forms/translating.clj
+++ src/midje/midje_forms/translating.clj
@@ -174,10 +174,17 @@
  ;; Folded prerequisites

+;; General strategy is to condense fake forms into a funcall=>metaconstant
+;; mapping. These substitutions are used both to "flatten" a fake form and also
+;; to generate new fakes.
+
 (defn augment-substitutions [substitutions fake-form]
   (let [needed-keys (filter mockable-funcall?
                             (fake-form-funcall-arglist fake-form))]
     (reduce (fn [substitutions needed-key]
+              ;; Note: because I like for a function's metaconstants to be
+              ;; easily mappable to the original fake, I don't make one
+              ;; unless I'm sure I need it.
               (if (get substitutions needed-key)
                 substitutions
                 (assoc substitutions needed-key (metaconstant-for-form needed-key))))
@@ -188,11 +195,16 @@
   (let [new-args (map (fn [arg] (get substitutions arg arg)) args)]
     `(~fake (~fun ~@new-args) ~@rest)))

-(defn generate-fakes [new-substitutions overrides]
-  (map (fn [ [nested metacons] ]
-         `(midje.semi-sweet/fake ~nested midje.semi-sweet/=> ~metacons ~@overrides))
-       new-substitutions))
-
+(defn generate-fakes [substitutions overrides]
+  (map (fn [ [funcall metaconstant] ]
+         `(midje.semi-sweet/fake ~funcall midje.semi-sweet/=> ~metaconstant ~@overrides))
+       substitutions))
+
+;; This walks through a `pending` list that may contain fakes. Each element is
+;; copied to the `finished` list. If it is a suitable fake, its nested funcalls
+;; are flattened (replaced with a metaconstant). If the metaconstant was newly
+;; generated, the fake that describes it is added to the pending list. In that way,
+;; it'll in turn be processed. This allows arbitrarily deep nesting.
 (defn unfolding-step [finished pending substitutions]
   (let [target (first pending)]
     (if (fake-that-needs-unfolding? target)


Anonymize arg to make eastwood happy.

Anonymize arg to make eastwood happy.

--- src/open_company/resources/report.clj
+++ src/open_company/resources/report.clj
@@ -26,7 +26,7 @@
 (defun valid-year?
   "Return `true` if the specified period is valid, `false` if not."
   ([year :guard integer?] (and (> year 1900) (< year 3000)))
-  ([year :guard #(and (string? %) (not-a-number? %))] false)
+  ([_year :guard #(and (string? %) (not-a-number? %))] false)
   ([year :guard string?] (valid-year? (Integer. year))))

 (defn valid-period?


[Fix #44] Remove duplicate namespaces when path does not match declaration

E.g. `riddley` (at least <= 0.1.12) has two files in the package that
have the ns declaration `riddley.compiler`. Only one of them would be
loaded if you were to require that file, to we'd now remove the other
one.

--- src/mranderson/core.clj
+++ src/mranderson/core.clj
@@ -241,13 +241,45 @@
             ;; remove old file
             (fs/delete old-path)))))))

+(defn- remove-invalid-duplicates!
+  "See issue #44. Some artifacts package duplicate files in weird locations
+   (e.g. riddley has `riddley.compiler` in the root of the package) which
+   causes a mismatch of expectations when moving files, resulting in
+   exceptions."
+  [srcdeps clj-files]
+  (let [by-ns (group-by
+                #(->> (fs/file srcdeps %)
+                      (read-file-ns-decl)
+                      (second))
+                clj-files)]
+    (mapcat
+      (fn [[nspace files]]
+        (if (and nspace (next files))
+          ;; A namespace has been duplicated, so we need to find the files that
+          ;; actually exist. There might be more than one file, in case of
+          ;; CLJ/CLJS duplication.
+          (let [expected-prefix (u/sym->file-name nspace)
+                match? #{(str expected-prefix ".clj")
+                         (str expected-prefix ".cljs")
+                         (str expected-prefix ".cljc")}]
+            (doseq [to-delete (remove match? files)]
+              (u/warn "  removing duplicated file with namespace mismatch:" to-delete)
+              (.delete (fs/file srcdeps to-delete)))
+            (filter match? files))
+          ;; Only one file means nothing to do (but it might still be in the
+          ;; wrong place).
+          files))
+      by-ns)))
+
 (defn- unzip-artifact! [{:keys [srcdeps]} {:keys [src-path branch]} dep]
   (let [art-name         (-> dep first name (str/split #"/") last)
         art-name-cleaned (str/replace art-name #"[\.-_]" "")
         art-version      (str "v" (-> dep second (str/replace "." "v")))
-        clj-files        (doall (unzip (-> dep meta :file) srcdeps))
+        _                (u/info "unzipping [" art-name-cleaned " [" art-version "]]")
+        clj-files        (->> (unzip (-> dep meta :file) srcdeps)
+                              (remove-invalid-duplicates! srcdeps)
+                              (doall))
         clj-dirs         (u/clj-files->dirs srcdeps clj-files)]
-    (u/info "unzipping [" art-name-cleaned " [" art-version "]]")
     (u/debug (format "resolving transitive dependencies for %s:" art-name))
     [{:art-name-cleaned art-name-cleaned
       :art-version      art-version


crash safeguard

crash safeguard

--- src/node/game/main.cljs
+++ src/node/game/main.cljs
@@ -46,7 +46,9 @@
   (let [params (convert args)
         gameid (:gameid params)
         state (@game-states (:gameid params))]
-    (case action
-      "init" (core/init-game params)
-      "do" ((commands (:command params)) state (keyword (:side params)) (:args params)))
+    (try (case action
+           "init" (core/init-game params)
+           "do" ((commands (:command params)) state (keyword (:side params)) (:args params)))
+         (catch :default e
+           (prn e)))
     (clj->js @(@game-states gameid))))


Change default primary color from purple to green if no env var is set.

--- src/oc/email/config.clj
+++ src/oc/email/config.clj
@@ -66,10 +66,10 @@

 ;; ----- Default brand color -----

-(defonce default-brand-color {:primary {:rgb {:r (or (env :primary-brand-color-r) 104)
-                                              :g (or (env :primary-brand-color-g) 51)
-                                              :b (or (env :primary-brand-color-b) 241)}
-                                        :hex (or (env :primary-brand-color-hex) "#6833F1")}
+(defonce default-brand-color {:primary {:rgb {:r (or (env :primary-brand-color-r) 33)
+                                              :g (or (env :primary-brand-color-g) 178)
+                                              :b (or (env :primary-brand-color-b) 104)}
+                                        :hex (or (env :primary-brand-color-hex) "#21B268")}
                               :secondary {:rgb {:r (or (env :secondary-brand-color-r) 254)
                                                 :g (or (env :secondary-brand-color-g) 254)
                                                 :b (or (env :secondary-brand-color-b) 254)}


Fix bug in namespaced checkpoint key

Fix bug in namespaced checkpoint key

--- src/onyx/plugin/sql.clj
+++ src/onyx/plugin/sql.clj
@@ -101,9 +101,9 @@
                          partitions))
         ;; Attempt to write. It will fail if it's already been written. Read it back
         ;; in either case.
-        _ (extensions/write-chunk log :chunk chunk task-id)
-        content (extensions/read-chunk log :chunk task-id)
         checkpoint-key (str job-id "#" task-id)
+        _ (extensions/write-chunk log :chunk chunk checkpoint-key)
+        content (extensions/read-chunk log :chunk checkpoint-key)
         commit-go-loop (start-commit-loop! log checkpoint-key content checkpoint-ch checkpoint-ms)]
     (go
      (try


Add opts arg to public APIs

Add opts arg to public APIs

--- src/pinpointer/core.clj
+++ src/pinpointer/core.clj
@@ -19,27 +19,32 @@
   (apply str (concat (repeat start \space)
                      (repeat (- end start) \^))))

-(defn pinpoint-out [ed & {:keys [root]}]
-  (when-let [problems (::s/problems ed)]
-    (doseq [[i probs] (->> problems
-                           (group-by #(select-keys % [:val :in]))
-                           (map-indexed vector))
-            :let [[{:keys [val in]} probs] probs
-                  val (or root val)
-                  [start end] (extract val in)]]
-      (when (not= i 0)
-        (newline))
-      #_(print " Problem: ")
-      #_(prn (assoc problem :val val))
-      (println "   Input:" (pr-str val))
-      (printf  "        :%s\n" (wavy-line start end))
-      (print "Expected: ")
-      (doseq [[j {:keys [pred reason]}] (map-indexed vector probs)]
-        (when (not= j 0)
-          (print "          "))
-        (prn pred)
-        (when reason
-          (printf "(%s)\n" reason))))))
+(defn pinpoint-out
+  ([ed] (pinpoint-out ed {}))
+  ([ed {:keys [root]}]
+   (when-let [problems (::s/problems ed)]
+     (doseq [[i probs] (->> problems
+                            (group-by #(select-keys % [:val :in]))
+                            (map-indexed vector))
+             :let [[{:keys [val in]} probs] probs
+                   val (or root val)
+                   [start end] (extract val in)]]
+       (when (not= i 0)
+         (newline))
+       #_(print " Problem: ")
+       #_(prn (assoc problem :val val))
+       (println "   Input:" (pr-str val))
+       (printf  "        :%s\n" (wavy-line start end))
+       (print "Expected: ")
+       (doseq [[j {:keys [pred reason]}] (map-indexed vector probs)]
+         (when (not= j 0)
+           (print "          "))
+         (prn pred)
+         (when reason
+           (printf "(%s)\n" reason)))))))

-(defn pinpoint [spec x]
-  (pinpoint-out (s/explain-data spec x) :root x))
+(defn pinpoint
+  ([spec x] (pinpoint spec x {}))
+  ([spec x opts]
+   (pinpoint-out (s/explain-data spec x)
+                 (merge {:root x} opts))))


Update selection to take care of handlers, lines and zoom

--- frontend/src/uxbox/main/ui/shapes/selection.cljs
+++ frontend/src/uxbox/main/ui/shapes/selection.cljs
@@ -76,19 +76,19 @@
                           :stroke-opacity "1"}}]]))

 (mx/defc single-not-editable-selection-handlers
-  [{:keys [id] :as shape}]
+  [{:keys [id] :as shape} zoom]
   (let [{:keys [width height x y]} (geom/outer-rect shape)]
     [:g.controls
      [:rect.main {:x x :y y
                   :width width
                   :height height
-                  :stroke-dasharray "5,5"
+                  :stroke-dasharray (str (/ 5.0 zoom) "," (/ 5.0 zoom))
                   :style {:stroke "#333"
                           :fill "transparent"
                           :stroke-opacity "1"}}]]))

 (mx/defc single-selection-handlers
-  [{:keys [id] :as shape}]
+  [{:keys [id] :as shape} zoom]
   (letfn [(on-mouse-down [vid event]
             (dom/stop-propagation event)
             (start-resize vid id))]
@@ -97,48 +97,56 @@
        [:rect.main {:x x :y y
                     :width width
                     :height height
-                    :stroke-dasharray "5,5"
+                    :stroke-dasharray (str (/ 5.0 zoom) "," (/ 5.0 zoom))
                     :style {:stroke "#333"
                             :fill "transparent"
                             :stroke-opacity "1"}}]
        [:circle.top
         (merge +circle-props+
                {:on-mouse-down #(on-mouse-down :top %)
+                :r (/ 6.0 zoom)
                 :cx (+ x (/ width 2))
                 :cy (- y 2)})]
        [:circle.right
         (merge +circle-props+
                {:on-mouse-down #(on-mouse-down :right %)
+                :r (/ 6.0 zoom)
                 :cy (+ y (/ height 2))
                 :cx (+ x width 1)})]
        [:circle.bottom
         (merge +circle-props+
                {:on-mouse-down #(on-mouse-down :bottom %)
+                :r (/ 6.0 zoom)
                 :cx (+ x (/ width 2))
                 :cy (+ y height 2)})]
        [:circle.left
         (merge +circle-props+
                {:on-mouse-down #(on-mouse-down :left %)
+                :r (/ 6.0 zoom)
                 :cy (+ y (/ height 2))
                 :cx (- x 3)})]
        [:circle.top-left
         (merge +circle-props+
                {:on-mouse-down #(on-mouse-down :top-left %)
+                :r (/ 6.0 zoom)
                 :cx x
                 :cy y})]
        [:circle.top-right
         (merge +circle-props+
                {:on-mouse-down #(on-mouse-down :top-right %)
+                :r (/ 6.0 zoom)
                 :cx (+ x width)
                 :cy y})]
        [:circle.bottom-left
         (merge +circle-props+
                {:on-mouse-down #(on-mouse-down :bottom-left %)
+                :r (/ 6.0 zoom)
                 :cx x
                 :cy (+ y height)})]
        [:circle.bottom-right
         (merge +circle-props+
                {:on-mouse-down #(on-mouse-down :bottom-right %)
+                :r (/ 6.0 zoom)
                 :cx (+ x width)
                 :cy (+ y height)})]])))

@@ -159,14 +167,15 @@
       (rx/subscribe stream on-move nil on-end))))

 (mx/defc path-edition-selection-handlers
-  [{:keys [id points] :as shape}]
+  [{:keys [id points] :as shape} zoom]
   (letfn [(on-mouse-down [index event]
             (dom/stop-propagation event)
             (rlocks/acquire! :shape/resize)
             (start-path-edition id index))]
     [:g.controls
      (for [[index {:keys [x y]}] (map-indexed vector points)]
-       [:circle {:cx x :cy y :r 6
+       [:circle {:cx x :cy y
+                 :r (/ 6.0 zoom)
                  :on-mouse-down (partial on-mouse-down index)
                  :fill "#31e6e0"
                  :stroke "#28c4d4"
@@ -177,6 +186,7 @@
   []
   (let [shapes (mx/react selected-shapes-ref)
         edition (mx/react scommon/edition-ref)
+        zoom (mx/react wb/zoom-ref)
         shapes-num (count shapes)
         shape (first shapes)]
     (cond
@@ -184,22 +194,22 @@
       nil

       (> shapes-num 1)
-      (multiple-selection-handlers shapes)
+      (multiple-selection-handlers shapes zoom)

       :else
       (cond
         (= :path (:type shape))
         (if (= @edition-ref (:id shape))
-          (path-edition-selection-handlers shape)
-          (single-not-editable-selection-handlers shape))
+          (path-edition-selection-handlers shape zoom)
+          (single-not-editable-selection-handlers shape zoom))

         (= :text (:type shape))
         (if (= @edition-ref (:id shape))
-          (single-not-editable-selection-handlers shape)
-          (single-selection-handlers (first shapes)))
+          (single-not-editable-selection-handlers shape zoom)
+          (single-selection-handlers (first shapes) zoom))

         (= :group (:type shape))
-        (single-not-editable-selection-handlers shape)
+        (single-not-editable-selection-handlers shape zoom)

         :else
-        (single-selection-handlers (first shapes))))))
+        (single-selection-handlers (first shapes) zoom)))))


Extract future function lists to defs

Extract future function lists to defs

--- test/beehive/future_test.clj
+++ test/beehive/future_test.clj
@@ -17,7 +17,10 @@
             [beehive.future :as f])
   (:import (net.uncontended.precipice.concurrent Eventual)))

-(defn remove-false [f & ks]
+(def pending [:success? :error? :timeout? :rejected? :cancelled? :result :error])
+(def success [:pending? :error? :timeout? :rejected? :cancelled? :error])
+
+(defn- remove-false [f ks]
   (filter (fn [func] (func f)) ks))

 (deftest future-status
@@ -26,21 +29,8 @@
           future (f/->BeehiveFuture eventual)]
       (is (= :pending (:status future)))
       (is (:pending? future))
-      (is (= [] (remove-false future
-                              :success?
-                              :error?
-                              :timeout?
-                              :rejected?
-                              :cancelled?
-                              :result
-                              :error)))
+      (is (= [] (remove-false future pending)))
       (.complete eventual 4)
       (is (= :success (:status future)))
       (is (:success? future))
-      (is (= [] (remove-false future
-                              :pending?
-                              :error?
-                              :timeout?
-                              :rejected?
-                              :cancelled?
-                              :error))))))
+      (is (= [] (remove-false future success))))))


Hook up movement policy

Hook up movement policy

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -1926,6 +1926,32 @@
         ]
       [{:x (first new-pos) :y (second new-pos)} new-npc npc]))

+(defn move-random
+  [state npc]
+  (let [npc-pos  (get npc :pos)
+        navigable-types (if (mg/can-move-in-water? (get npc :race))
+                          #{:water :surf}
+                          #{:floor
+                            :corridor
+                            :open-door
+                            :sand
+                            :dirt
+                            :gravel
+                            :tall-grass
+                            :short-grass})]
+    ;; move randomly into an adjacent cell
+    (let [target (first
+                   (dg/shuffle
+                     (adjacent-navigable-pos state
+                                             npc-pos
+                                             navigable-types)))]
+      ;(debug "distance > threshold, move randomly. target" target)
+      [target
+       (-> npc
+         (assoc-in [:pos :x] (get target :x))
+         (assoc-in [:pos :y] (get target :y)))
+       npc])))
+
 (defn move-to-target-in-range-or-random
   [state npc target]
   (let [threshold (get npc :range-threshold)
@@ -1990,9 +2016,9 @@

 (defn calc-npc-next-step
   "Returns the moved npc and not the updated state. New npc pos will depend on
-   the npc's `:movement-policy which is one of `:constant` `:entourage` `:follow-player` `:follow-player-in-range-or-random`."
+   the npc's `:movement-policy which is one of `:constant` `:entourage` `:follow-player` `:random` `:follow-player-in-range-or-random` `:hide-from-player-in-range-or-random`."
   [state npc]
-  {:pre  [(contains? #{:constant :entourage :follow-player :follow-player-in-range-or-random :hide-from-player-in-range-or-random} (get npc :movement-policy))]
+  {:pre  [(contains? #{:constant :entourage :follow-player :random :follow-player-in-range-or-random :hide-from-player-in-range-or-random} (get npc :movement-policy))]
    :post [(= (count %) 3)]}
   (let [policy (get npc :movement-policy)
         pos    (-> state :world :player :pos)
@@ -2008,16 +2034,17 @@
                             :short-grass})]
         ;_ (info "moving npc@" (get npc :pos) "with policy" policy)]
     (case policy
-      :constant [nil nil npc]
-      :entourage (move-to-target state
-                                 npc
-                                 (first
-                                   (dg/shuffle
-                                     (adjacent-navigable-pos state
-                                                             pos
-                                                             navigable-types))))
-      :follow-player (move-to-target state npc pos)
-      :follow-player-in-range-or-random (move-to-target-in-range-or-random state npc pos)
+      :constant                            [nil nil npc]
+      :entourage                           (move-to-target state
+                                                           npc
+                                                           (first
+                                                             (dg/shuffle
+                                                               (adjacent-navigable-pos state
+                                                                                pos
+                                                                                navigable-types))))
+      :follow-player                       (move-to-target state npc pos)
+      :random                              (move-random state npc)
+      :follow-player-in-range-or-random    (move-to-target-in-range-or-random state npc pos)
       :hide-from-player-in-range-or-random (move-away-from-target-in-range-or-random state npc pos)
       [nil nil npc])))


Improves generated tests

Improves generated tests

--- test/expound/alpha_test.cljc
+++ test/expound/alpha_test.cljc
@@ -2671,6 +2671,7 @@
           :args (s/cat :x int?))
   (testing "no-fn failure"
     (is (= "== Checked expound.alpha-test/results-str-missing-fn
+
   (expound.alpha-test/results-str-missing-fn)

  threw error
@@ -2693,23 +2694,27 @@
     (f 1))
   (require '[clojure.spec.alpha :as s])
   (require '[clojure.spec.test.alpha :as st])
-  (st/check `results-str-fn6))
-
-#?(:clj
-   (deftest explain-results-gen
-     (checking
-      "all functions can be checked and printed"
-      10 ;; TODO - try 100
-      [sym-to-check (gen/elements (st/checkable-syms))]
-      ;; Just confirm an error is not thrown
-      (try
-        (orch.st/with-instrument-disabled
-          (is (string?
-               (expound/explain-results-str (st/check sym-to-check
-                                                      {:clojure.spec.test.check/opts {:num-tests 1}})))))
-        (catch Exception e
-          (is (= "foobar"
-                 (.getMessage e))))))))
+  (st/check `results-str-fn6)
+
+  (require '[expound.paths])
+  (require '[expound.alpha :as expound])
+  (require '[orchestra.spec.test :as orch.st])
+  (expound/explain-results
+   (orch.st/with-instrument-disabled (st/check `expound.paths/prefix-path?
+                                               {:clojure.spec.test.check/opts {:num-tests 10}}))))
+
+(deftest explain-results-gen
+  (checking
+   "all functions can be checked and printed"
+   200 ;; TODO - put to num-tests
+   [sym-to-check (gen/elements (st/checkable-syms))]
+    ;; Just confirm an error is not thrown
+   (is (string?
+        (expound/explain-results-str
+         (orch.st/with-instrument-disabled
+           (with-out-str
+             (st/check sym-to-check
+                       {:clojure.spec.test.check/opts {:num-tests 10}}))))))))

 (def inverted-ansi-codes
   (reduce


Resolve all tags in the :value of a tag wrapper

Fix #40. Fix #41.

--- src/aero/core.cljc
+++ src/aero/core.cljc
@@ -315,7 +315,10 @@
           (tag-wrapper-of-ref? b)
           (assoc-in acc resolved-ks (get-in acc (ref-dependency b)))
           (tag-wrapper? b)
-          (assoc-in acc resolved-ks (resolve-fn (:tag b) (:value b)))
+          (assoc-in acc
+                    resolved-ks
+                    (resolve-fn (:tag b)
+                                (resolve-tag-wrappers (:value b) resolve-fn)))
           :else
           acc)))
     config


Exercise 3.24

Exercise 3.24

--- src/sicp/chapter3_3.clj
+++ src/sicp/chapter3_3.clj
@@ -790,8 +790,122 @@

 ;;; 3.3.3  Representing Tables

+(defn assok [key records]
+  (cond
+    (nil? records) false
+    (= key (car (car records))) (car records)
+    :else (recur key (cdr records))))
+
+(defn lookup [key table]
+  (let [record (assok key (cdr table))]
+    (if record
+      (cdr record)
+      false)))
+
+(defn insert! [key value table]
+  (let [record (assok key (cdr table))]
+    (if record
+      (set-cdr! record value)
+      (set-cdr! table
+                (kons (kons key value) (cdr table)))))
+  :ok)
+
+(defn make-table []
+  (scheme-like-list '*table*))
+
+(defn lookup' [key-1 key-2 table]
+  (let [subtable (assok key-1 (cdr table))]
+    (if subtable
+      (let [record (assok key-2 (cdr subtable))]
+        (if record
+          (cdr record)
+          false))
+      false)))
+
+(defn insert!' [key-1 key-2 value table]
+  (let [subtable (assok key-1 (cdr table))]
+    (if subtable
+      (let [record (assok key-2 (cdr subtable))]
+        (if record
+          (set-cdr! record value)
+          (set-cdr! subtable
+                    (kons (kons key-2 value)
+                          (cdr subtable)))))
+      (set-cdr! table
+                (kons (scheme-like-list key-1
+                                        (kons key-2 value))
+                      (cdr table)))))
+  :ok)
+
+(defn make-table' []
+  (let [local-table (scheme-like-list '*table*)
+        lookup (fn [key-1 key-2]
+                 (let [subtable (assok key-1 (cdr local-table))]
+                   (if subtable
+                     (let [record (assok key-2 (cdr subtable))]
+                       (if record
+                         (cdr record)
+                         false))
+                     false)))
+        insert! (fn [key-1 key-2 value]
+                  (let [subtable (assok key-1 (cdr local-table))]
+                    (if subtable
+                      (let [record (assok key-2 (cdr subtable))]
+                        (if record
+                          (set-cdr! record value)
+                          (set-cdr! subtable
+                                    (kons (kons key-2 value)
+                                          (cdr subtable)))))
+                      (set-cdr! local-table
+                                (kons (scheme-like-list key-1
+                                                        (kons key-2 value))
+                                      (cdr local-table)))))
+                  :ok)
+        dispatch (fn [m]
+                   (case m
+                     :lookup-proc lookup
+                     :insert-proc! insert!
+                     (throw (IllegalArgumentException.
+                             (str "Unknown operation -- TABLE " m)))))]
+    dispatch))
+
 ;; Exercise 3.24
-;; TODO
+(defn make-table'' [& {:keys [same-key?] :or {same-key? =}}]
+  (let [local-table (scheme-like-list '*table*)
+        assok (fn [key records]
+                (cond
+                  (nil? records) false
+                  (same-key? key (car (car records))) (car records)
+                  :else (recur key (cdr records))))
+        lookup (fn [key-1 key-2]
+                 (let [subtable (assok key-1 (cdr local-table))]
+                   (if subtable
+                     (let [record (assok key-2 (cdr subtable))]
+                       (if record
+                         (cdr record)
+                         false))
+                     false)))
+        insert! (fn [key-1 key-2 value]
+                  (let [subtable (assok key-1 (cdr local-table))]
+                    (if subtable
+                      (let [record (assok key-2 (cdr subtable))]
+                        (if record
+                          (set-cdr! record value)
+                          (set-cdr! subtable
+                                    (kons (kons key-2 value)
+                                          (cdr subtable)))))
+                      (set-cdr! local-table
+                                (kons (scheme-like-list key-1
+                                                        (kons key-2 value))
+                                      (cdr local-table)))))
+                  :ok)
+        dispatch (fn [m]
+                   (case m
+                     :lookup-proc lookup
+                     :insert-proc! insert!
+                     (throw (IllegalArgumentException.
+                             (str "Unknown operation -- TABLE " m)))))]
+    dispatch))

 ;; Exercise 3.25
 ;; TODO


curse of repl development

curse of repl development

--- src/syncserver/core.clj
+++ src/syncserver/core.clj
@@ -44,6 +44,19 @@
     0 (.call cls)
     1 (.call cls x)
     2 (.call cls [x s])))
+
+(defn- primitive-array? [o]
+  (.isArray (class o)))
+
+
+(defn- immutable [b]
+  (cond
+   (or (instance? java.util.Map b)
+       (map? b)) (into {} b)
+   (or  (instance? java.util.List b)
+        (primitive-array? b)
+        (coll? b)) (into [] b)
+   :otherwise b))

 (defn transform [[p e]]
   (let [t (type e)]
@@ -93,17 +106,6 @@
         d3 (if (seq new-in-b) (conj d2 [:merge path new-in-b]) d2)]
     d3))

-(defn- primitive-array? [o]
-  (.isArray (class o)))
-
-(defn immutable [b]
-  (cond
-   (or (instance? java.util.Map b)
-       (map? b)) (into {} b)
-   (or  (instance? java.util.List b)
-        (primitive-array? b)
-        (coll? b)) (into [] b)
-   :otherwise b))

 (defn ddiff [path a b diffs]


Remove doubled navigation on start

Remove doubled navigation on start

--- src/bide/core.cljs
+++ src/bide/core.cljs
@@ -176,7 +176,6 @@
             lkey (e/listen history EventType.NAVIGATE -on-navigate)]

         (.replaceToken history initial-token)
-        (apply on-navigate initial-loc)

         (specify! router
           Object


added unit test for the fake call to PRS function.

--- jar-prslib/test/clj/sixsq/slipstream/prs/core_test.clj
+++ jar-prslib/test/clj/sixsq/slipstream/prs/core_test.clj
@@ -18,3 +18,14 @@
       (is (= 2 (count components))))
     ))

+(def components {:components      [{:module "module/comp1"}
+                                   {:module "module/comp2"}]
+                 :user-connectors ["c1" "c2"]})
+
+(deftest test-call-prs
+  (is (contains? (call-prs "" components) :components))
+  (is (= 2 (count (:components (call-prs "" components)))))
+  (is (contains? (first (:components (call-prs "" components))) :module))
+  (is (= "module/comp1" (:module (first (:components (call-prs "" components))))))
+  (is (= "c1" (:name (first (:connectors (first (:components (call-prs "" components))))))))
+  )


close old listener when port number changes

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -87,11 +87,14 @@

 (defn update-listener [listener config]
   (if-let [req-addr (get-in config [:config :listen-address])]
-    (let [req-port (:port (parse-address req-addr))]
+    (let [req-port (:port (parse-address req-addr))
+          old-port (and listener (get-port listener))]
       (if (and listener
-               (= (get-port listener) req-port))
+               (= old-port req-port))
         listener
-        (doto (ServerSocketChannel/open) (.bind (InetSocketAddress. req-port)))))
+        (let [new-l (ServerSocketChannel/open)]
+          (and listener (.close listener))
+          (doto new-l (.bind (InetSocketAddress. req-port))))))
     nil))

 (defn combined-config-watcher [prefix]


Add demo of chunked sequences

Add demo of chunked sequences

--- test/com/nomistech/clojure_the_language/c_200_clojure_basics/s_370_chunked_sequences.clj
+++ test/com/nomistech/clojure_the_language/c_200_clojure_basics/s_370_chunked_sequences.clj
@@ -1,5 +1,7 @@
 (ns com.nomistech.clojure-the-language.c-200-clojure-basics.s-370-chunked-sequences
-  (:require [midje.sweet :refer :all]))
+  (:require [clojure.core.reducers :as r]
+            [com.nomistech.clj-utils :as u]
+            [midje.sweet :refer :all]))

 ;;;; ___________________________________________________________________________
 ;;;; Chunked sequences
@@ -65,3 +67,45 @@
 ;;           (chunk-cons (chunk b)
 ;;                       (when (comp i end)
 ;;                         (range i end step)))))))))
+
+
+(defmacro with-discard-output
+  [& body]
+  `(let [s# (new java.io.StringWriter)]
+     (binding [*out* s#]
+       ~@body)))
+
+
+(fact "Demo of chunked sequences"
+
+  (fact "The clojure.core chunking"
+    (letfn [(do-it []
+              (into [] (->> (range 10)
+                            (map (fn [x] (pr x) x))
+                            (take 3))))]
+
+      (fact "value" (with-discard-output (do-it)) => [0 1 2])
+      (fact "side effects" (with-out-str (do-it)) => "0123456789")))
+
+  (fact "`u/unchunk` gives laziness)"
+    (letfn [(do-it []
+              (into [] (->> (range 10)
+                            u/unchunk
+                            (map (fn [x] (pr x) x))
+                            (take 3))))]
+
+      (fact "value" (with-discard-output (do-it)) => [0 1 2])
+      (fact "side effects" (with-out-str (do-it)) => "012")))
+
+  (fact "Can unchunk with reducers -- but this is less lazy than `u/unchunk"
+    ;; You can use `reduce` (or other things) to get rid of chunking:
+    ;; - https://stuartsierra.com/2015/08/25/clojure-donts-lazy-effects
+    ;; But note that with reducers, at least, you get one more item processed
+    ;; than you need!
+    (letfn [(do-it []
+              (into [] (->> (range 10)
+                            (r/map (fn [x] (pr x) x))
+                            (r/take 3))))]
+
+      (fact "value" (with-discard-output (do-it)) => [0 1 2])
+      (fact "side effects" (with-out-str (do-it)) => "0123"))))


fix show-settings-link logic

fix show-settings-link logic

--- frontend/controllers/navigation.cljs
+++ frontend/controllers/navigation.cljs
@@ -54,7 +54,7 @@
   (-> state
       (assoc :navigation-point navigation-point
              :navigation-data args
-             :navigation-settings {:show-settings-link (boolean (:repo args))})
+             :navigation-settings {:show-settings-link (boolean (:org args))})
       (state-utils/set-dashboard-crumbs args)
       state-utils/reset-current-build))


Change app-state structure

Change app-state structure

--- frontend/src/cruncher/utils/lib.cljs
+++ frontend/src/cruncher/utils/lib.cljs
@@ -183,11 +183,6 @@

 ;;;; Status information
-(defn get-progress-status
-  "Return map containing progress information."
-  []
-  (get-in @app-state [:app :progress]))
-
 (defn update-progress-status!
   "Receives a map containing information about the progress status, which are then stored in the app-state."
   [response]


can click on marbles

can click on marbles

--- src/nonaga/draw.cljs
+++ src/nonaga/draw.cljs
@@ -91,7 +91,10 @@
 (defn draw-marbles [svg-node coords color]
   (->> coords
        (map hex-coord->svg-coord)
-       (mapv (fn [[x y]] (dommy/append! svg-node (marble x y color))))))
+       (mapv (fn [[x y]]
+               (let [marble (marble x y color)]
+                 (aset marble "onclick" (fn [e] (log color)))
+                 (dommy/append! svg-node marble))))))

 (defn draw-coords [svg-node coords]
   (letfn [(draw [coord [x y]]
@@ -101,9 +104,9 @@
          (map hex-coord->svg-coord)
          (mapv draw coords))))

+(draw-rings svg rings)
 (draw-marbles svg reds "red")
 (draw-marbles svg blues "blue")
-(draw-rings svg rings)

 ; (draw-coords svg rings)


Reduce download size for presentation list

--- src/qcast/server.clj
+++ src/qcast/server.clj
@@ -87,9 +87,16 @@
 (defroutes api-routes
   "Routes for client API"
   (GET "/api/v1/presentations" []
-    (respond (map :data (cache/latest 10))))
+    (->> (cache/latest 10)
+         (map :data)
+         (map #(dissoc % :slides :times :video :audio :pdf))
+         respond))
   (GET "/api/v1/presentations/:id" [id]
-    (respond (map :data (cache/lookup (str "/presentations/" id))))))
+    (->> id
+         (str "/presentations/")
+         cache/lookup
+         (map :data)
+         respond)))

 (defroutes feed-routes
   "Routes for RSS Feeds"


defconstrainedtype now usable

defconstrainedtype now usable

--- src/trammel/core.clj
+++ src/trammel/core.clj
@@ -281,7 +281,7 @@
            (= t# (type r#))))

        (let [chk# (contract ~(symbol (str "chk-" name))
-                            (str "Invariant contract for " (str ~name))
+                            ~(str "Invariant contract for " name)
                             [{:keys ~fields :as m#}] ~invariants)]
          (defconstrainedfn ~factory-name
            ([] [] (~ctor-name ~@defaults))


Comment clean-up: indices are now automatically created by neo4j

--- src/tropefest/db.clj
+++ src/tropefest/db.clj
@@ -159,9 +159,6 @@
   (let [node (nn/create conn (timestamp-create data-items))]
     (do
       (nl/add conn node label)
-      ; TODO Create indexes only if we don' know the node
-      ; (nri/create conn label "id")
-      ; (nri/create conn label "nextupdate")
       node)))

 (defn merge-node!


set some variables instead of using constants everywhere

--- test/greybear/model_test.clj
+++ test/greybear/model_test.clj
@@ -69,9 +69,10 @@
   (fact "saves a new move in the database"
     (create-user "user1" "foo")
     (create-user "user2" "bar")
-    (new-game 1 2)
-    (new-move 1 "4-5") => truthy
-    (select moves) => [{:game_id 1, :ordinal 1, :move "4-5"}])
+    (let [game_id (new-game 1 2)
+          move "4-5"]
+      (new-move game_id move) => truthy
+      (select moves) => [{:game_id game_id, :ordinal 1, :move move}]))

   (fact "new moves have correct ordinals"
     (create-user "user1" "foo")


Add tests for pattern/def->var

Add tests for pattern/def->var

--- test/oxcart/pattern_test.clj
+++ test/oxcart/pattern_test.clj
@@ -31,6 +31,12 @@
   (is (= 'foo (p/def->symbol foo)))
   (is (= 'bar (p/def->symbol bar)))
   (is (nil? (p/def->symbol fail))))
+
+
+(deftest def->var-tests
+  (is (var? (p/def->var foo)))
+  (is (var? (p/def->var bar)))
+  (is-not (var? (p/def->var fail))))

 (def private-defn


Improved random tests.

Improved random tests.

--- test/paragon/random_test.clj
+++ test/paragon/random_test.clj
@@ -3,8 +3,11 @@
             [paragon.core :refer :all]
             [clojure.java.io :as io]
             [clojure.data.csv :as csv]
-            [loom.graph :as graph])
-  (:require [taoensso.timbre.profiling :refer (profile defnp)]))
+            [loom.graph :as graph]
+            [loom.alg :as alg]
+            [clojure.math.combinatorics :as combo])
+  (:require [taoensso.timbre.profiling :refer (profile defnp)]
+            [clojure.set :as set]))

 (defnp split-vec
   [v chance-split]
@@ -43,8 +46,10 @@
         node-groups (split-vec nodes chance-split)
         node-groups-squared (mapcat (fn [[ns1 ns2]] (split-vec (vec (concat ns1 ns2)) chance-split))
                                     node-groups)
+        node-groups-cubed (mapcat (fn [[ns1 ns2]] (split-vec (vec (concat ns1 ns2)) chance-split))
+                                  node-groups-squared)
         paired (map (fn [ng] (concat ng (if (> chance-and (rand)) [:forall-just] [:exists-just])))
-                    node-groups-squared)
+                    node-groups-cubed)
         jg (new-just-graph)
         jg2 (reduce (fn [jg [node-group1 node-group2 linktype]]
                       #_(prn node-group1 node-group2 linktype)
@@ -65,30 +70,29 @@
         ;; find strokes that fail axiom 7
         jg-fixed (loop [jg jg-premises]
                    (if-let [jg2 (remove-bad-stroke jg)]
-                     (recur jg2) jg))]
+                     (recur jg2) jg))
+        accessible (alg/pre-traverse (graph/graph (:graph jg-fixed)) (first (shuffle (graph/nodes (:graph jg-fixed)))))]
+    #_(prn "accessible:" accessible)
+    #_(prn "not-accessible:" (set/difference (set (graph/nodes (:graph jg-fixed)))
+                                           (set accessible)))
     #_(prn "nodes" nodes)
     #_(prn "node-groups" (doall node-groups))
     #_(prn "node-groups-squared" (doall node-groups-squared))
-    jg-fixed))
+    (reduce remove-node-or-stroke
+            jg-fixed
+            (set/difference (set (graph/nodes (:graph jg-fixed)))
+                            (set accessible)))))

 (defn count-changes
-  [jg1 jg2]
+  [jg1 jg2 ignore]
   (assert (= (:graph jg1) (:graph jg2)))
   (let [bel1 (set (believed jg1))
-        bel2 (set (believed jg2))]
-    (count (filter (fn [n] (or (and (bel1 n) (not (bel2 n)))
-                               (and (not (bel1 n)) (bel2 n))))
+        bel2 (set (believed jg2))
+        ignore-set (set ignore)]
+    (count (filter (fn [n] (and (or (and (bel1 n) (not (bel2 n)))
+                                    (and (not (bel1 n)) (bel2 n)))
+                                (not (ignore-set n))))
                    (nodes jg1)))))
-
-(defn expand-random
-  [jg chance-expand black-strategy white-strategy]
-  (let [expandable (filter (fn [_] (> chance-expand (rand))) (nodes jg))]
-    (expand jg expandable :black-strategy black-strategy :white-strategy white-strategy)))
-
-(defn contract-random
-  [jg chance-contract black-strategy white-strategy]
-  (let [contractable (filter (fn [_] (> chance-contract (rand))) (nodes jg))]
-    (contract jg contractable :black-strategy black-strategy :white-strategy white-strategy)))

 (defn strategy-rand
   [_ bad-strokes bad-nodes]
@@ -102,60 +106,110 @@
   [_ bad-strokes bad-nodes]
   (if (empty? bad-nodes) (rand-nth bad-strokes) (rand-nth bad-nodes)))

+(defn strategy-pref-fewest-links
+  [jg bad-strokes bad-nodes]
+  (first (sort-by #(graph/degree (:graph jg) %) (concat bad-strokes bad-nodes))))
+
+(defn strategy-pref-fewest-links-2
+  [jg bad-strokes bad-nodes]
+  (first (sort-by (fn [s-or-n] (reduce + (map #(graph/degree (:graph jg) %)
+                                              (concat (graph/incoming (:graph jg) s-or-n)
+                                                      (graph/neighbors (:graph jg) s-or-n)))))
+                  (concat bad-strokes bad-nodes))))
+
+(defn strategy-pref-most-links
+  [jg bad-strokes bad-nodes]
+  (last (sort-by #(graph/degree (:graph jg) %) (concat bad-strokes bad-nodes))))
+
+(defn strategy-pref-most-links-2
+  [jg bad-strokes bad-nodes]
+  (last (sort-by (fn [s-or-n] (reduce + (map #(graph/degree (:graph jg) %)
+                                              (concat (graph/incoming (:graph jg) s-or-n)
+                                                      (graph/neighbors (:graph jg) s-or-n)))))
+                  (concat bad-strokes bad-nodes))))
+
 (defn find-black-strategy
   [strat-name]
   (case strat-name
-    "default" strategy-rand
+    "rand" strategy-rand
     "pref-stroke" strategy-pref-stroke
-    "pref-node" strategy-pref-node))
+    "pref-node" strategy-pref-node
+    "degree" strategy-pref-fewest-links
+    "degree2" strategy-pref-fewest-links-2))

 (defn find-white-strategy
   [strat-name]
   (case strat-name
-    "default" strategy-rand
+    "rand" strategy-rand
     "pref-stroke" strategy-pref-stroke
-    "pref-node" strategy-pref-node))
-
-(defn compare-expand-strategies
+    "pref-node" strategy-pref-node
+    "degree" strategy-pref-most-links
+    "degree2" strategy-pref-most-links-2))
+
+(defn compare-contract-strategies
   []
-  (let [strategies ["default" "pref-stroke" "pref-node"]
-        chances-split [0.25 0.50 0.75]
-        chances-expand-contract [0.02 0.04 0.06 0.08 0.10]
-        chances-and [0.0 0.25 0.5 0.75 1.0]
-        cases 100
+  (let [strategies ["rand" "pref-stroke" "pref-node" "degree" "degree2"]
+        chances-split [0.7]
+        chances-and [0.5]
+        cases 1000
         i (atom 0)
-        total (* (count chances-split) (count chances-expand-contract) (count chances-and) cases)]
+        total (* (count chances-split) (count chances-and) cases)]
     (profile
-      :debug :compare-expand-strategies
+      :debug :compare-contract-strategies
       (doall (apply concat
                     (for [chance-split chances-split
-                          chance-expand-contract chances-expand-contract
                           chance-and chances-and
                           case (range cases)]
-                      (let [jg (gen-random-andor-graph (+ 2 (rand-int 100)) chance-split chance-and)]
+                      (let [jg (gen-random-andor-graph (+ 2 (rand-int 20)) chance-split chance-and)]
                         (swap! i inc)
-                        (prn (format "%d/%d" @i total))
-                        (if (empty? (nodes jg))
+                        (if (or (empty? (nodes jg)) (> (count (concat (nodes jg) (strokes jg))) 19))
                           []
-                          (for [strategy strategies
-                                change-type [:expand :contract]]
-                            (let [time-start (System/nanoTime)
-                                  changes (if (= :expand change-type)
-                                            (let [jg-new (expand-random jg chance-expand-contract
-                                                                        (find-black-strategy strategy)
-                                                                        (find-white-strategy strategy))]
-                                              (count-changes jg jg-new))
-                                            (let [jg-black (reduce assert-black jg (concat (strokes jg) (nodes jg)))
-                                                  jg-new (contract-random jg-black chance-expand-contract
-                                                                          (find-black-strategy strategy)
-                                                                          (find-white-strategy strategy))]
-                                              (count-changes jg-black jg-new)))
-                                  change-pct (double (* 100.0 (/ changes (count (nodes jg)))))
-                                  time-diff (- (System/nanoTime) time-start)]
-                              {:ChanceSplit  chance-split :ChanceExpandContract chance-expand-contract :ChanceAnd chance-and
-                               :Strategy     strategy :ChangeType (name change-type)
-                               :Case         case :ChangePct change-pct :Nodes (count (nodes jg)) :Strokes (count (strokes jg))
-                               :Microseconds time-diff}))))))))))
+                          (let [jg-black (reduce (fn [jg n-or-s] (assert-color jg n-or-s :black))
+                                                 jg (concat (nodes jg) (strokes jg)))
+                                contract-ns [(first (shuffle (nodes jg)))]
+                                undecided (filter #(not ((set contract-ns) %)) (concat (nodes jg) (strokes jg)))
+                                total-colorings (for [c (combo/selections [:black :white] (count undecided))]
+                                                  (partition 2 (interleave undecided c)))
+                                _ (if (not-empty (nodes jg)) (println "Colorings:" (count total-colorings)))
+                                ;; only works for contraction:
+                                total-variations (filter identity
+                                                         (for [coloring total-colorings]
+                                                           (let [jg-start (reduce (fn [jg n] (assert-color jg n :white))
+                                                                                jg-black contract-ns)
+                                                                 jg-new (reduce (fn [jg [n-or-s c]] (assert-color jg n-or-s c))
+                                                                                jg-start coloring)]
+                                                             (if (check-color-axioms jg-new)
+                                                               [jg-new (count-changes jg-black jg-new contract-ns)]))))
+                                min-changes (if (not-empty total-variations) (apply min (map second total-variations)))]
+                            (println (format "%d/%d" @i total) "contract:" contract-ns "min:" min-changes)
+                            (doall (filter
+                                     (fn [row] (not= 0 (:Changes row)))
+                                     (for [change-type [:contract]
+                                           strategy strategies]
+                                       (let [time-start (System/nanoTime)
+                                             black-strategy (find-black-strategy strategy)
+                                             white-strategy (find-white-strategy strategy)
+                                             jg-final (contract jg-black
+                                                                contract-ns
+                                                                :black-strategy black-strategy
+                                                                :white-strategy white-strategy)
+                                             changes (count-changes jg-black jg-final contract-ns)
+                                             change-pct (double (* 100.0 (/ changes (count (nodes jg)))))
+                                             time-diff (- (System/nanoTime) time-start)
+                                             results {:Strategy     strategy
+                                                      :ChangeType   (name change-type)
+                                                      :Changes      changes
+                                                      :ChangePct    change-pct
+                                                      :ChanceAnd    chance-and
+                                                      :ChanceSplit  chance-split
+                                                      :Case         case
+                                                      ;; (changes+1)/(min+1)
+                                                      :RatioMin     (double (/ (inc changes) (inc min-changes)))
+                                                      :Nodes        (count (nodes jg))
+                                                      :Strokes      (count (strokes jg))
+                                                      :Microseconds time-diff}]
+                                         (println "RatioMin:" (:RatioMin results))
+                                         results)))))))))))))

 (defn dump-csv
   [results fname]


Update tests.

Update tests.


add the negative test for logins

add the negative test for logins

--- test/smallblog/test/data.clj
+++ test/smallblog/test/data.clj
@@ -122,4 +122,6 @@
 			(binding [*sandbar-current-user*
 					(data/login-for-session email password)]
 				(is (not (nil? (data/get-current-user)))))
+			(binding [*sandbar-current-user* nil]
+				(is (nil? (data/get-current-user))))
 			(finally (data/delete-login loginid)))))


:origin in h1, :received in div, pretty-printed payload in pre code

--- src/cljs/core.cljs
+++ src/cljs/core.cljs
@@ -17,7 +17,11 @@
 (defn lister [items]
   [:div
    (for [item items]
-     [:pre [:code (:pp item)]])])
+     [:div
+      [:h4 (str (:origin item))]
+      [:p (:received item)]
+      [:pre [:code (:payload item)]]
+      [:br]])])

 (defn lister-user []
   [:div


Use :empty to represent the empty tile

Use :empty to represent the empty tile

--- src/tile_game/grid.cljs
+++ src/tile_game/grid.cljs
@@ -9,16 +9,17 @@
              "#000080" "#0000FF" "#800080" "#FF00FF"])

 (defonce app-state
-  (r/atom {:board (range 0 16)
+  (r/atom {:board (cons :empty (range 1 16))
            :dim 4}))

 (defn render-tile [[x y] tile]
-  (let [fill-color (colors tile)]
-    [:g {:key (str "tile-" tile)}
-     [:rect {:x (+ x 0.05) :y (+ y 0.05) :width 0.9 :height 0.9 :fill fill-color}]
-     [:text {:x (+ 0.5 x) :y (+ 0.65 y)
-             :font-family "Verdana" :font-size 0.4 :text-anchor "middle"}
-      (str tile)]]))
+  (if-not (= tile :empty)
+    (let [fill-color (colors tile)]
+      [:g {:key (str "tile-" tile)}
+       [:rect {:x (+ x 0.05) :y (+ y 0.05) :width 0.9 :height 0.9 :fill fill-color}]
+       [:text {:x (+ 0.5 x) :y (+ 0.65 y)
+               :font-family "Verdana" :font-size 0.4 :text-anchor "middle"}
+        (str tile)]])))

 (defn tile-grid []
   (let [{:keys [board dim]} @app-state]


Back to using zero? for empty tile and verify on-click works

--- src/tile_game/grid.cljs
+++ src/tile_game/grid.cljs
@@ -9,13 +9,13 @@
              "#000080" "#0000FF" "#800080" "#FF00FF"])

 (defonce app-state
-  (r/atom {:board (cons :empty (range 1 16))
+  (r/atom {:board (range 0 16)
            :dim 4}))

 (defn render-tile [[x y] tile]
-  (if-not (= tile :empty)
+  (if-not (zero? tile)
     (let [fill-color (colors tile)]
-      [:g {:key (str "tile-" tile)}
+      [:g {:key (str "tile-" tile) :on-click #(println tile)}
        [:rect {:x (+ x 0.05) :y (+ y 0.05) :width 0.9 :height 0.9 :fill fill-color}]
        [:text {:x (+ 0.5 x) :y (+ 0.65 y)
                :font-family "Verdana" :font-size 0.4 :text-anchor "middle"}


Rename New Game to Reset and default the board to shuffled

--- src/tile_game/grid.cljs
+++ src/tile_game/grid.cljs
@@ -11,7 +11,7 @@
           "#0000C0" "#3030FF" "#800080" "#FF00FF"]))

 (defonce app-state
-  (r/atom {:board (b/create-board 4)
+  (r/atom {:board (b/create-board 4 :shuffle)
            :size 4
            :analysis-mode false}))

@@ -23,7 +23,7 @@

 (defn board-size-slider [size]
   [:div
-   [:button {:on-click (new-board! size)} "New Game"]
+   [:button {:on-click (new-board! size)} "Reset"]
    [:button {:on-click (new-board! size :shuffle)} "Shuffle"]
    [:label (str "Board size: " size)]
    [:input {:type "range" :style {:width "25%"}


reformating docs

reformating docs

--- src/timsg/scene_var.clj
+++ src/timsg/scene_var.clj
@@ -93,9 +93,21 @@
      (set! (.rotation tr) (arcadia.linear/aa 90 0 1 0))
      car)))

-The 0-ary body, if supplied, runs if the var bound by this def form ('car', in the example above) is currently unbound, and should return a GameObject. Use this to either find an object in the scene graph, or create a new object if there currently is none. This arity typically only runs once per session, it will be ignored on subsequent redefs.
+The 0-ary body, if supplied, runs if the var bound by this def
+  form ('car', in the example above) is currently unbound, and should
+  return a GameObject. Use this to either find an object in the scene
+  graph, or create a new object if there currently is none. This arity
+  typically only runs once per session, it will be ignored on
+  subsequent redefs.

-The 1-ary body, if supplied, mutates or replaces an existing value, and is where most of the work of redefinition should take place. If the var bound by this def form is currently unbound, the argument of the 1-ary body will be the return of the 0-ary body, if that is supplied, or nil if it is not. If, on the other hand, the var bound by this def form *is* currently bound, the argument to the 1-ary body will be set to whatever that value is. The var will then be rebound to the return of the 1-ary body.
+The 1-ary body, if supplied, mutates or replaces an existing value,
+  and is where most of the work of redefinition should take place. If
+  the var bound by this def form is currently unbound, the argument of
+  the 1-ary body will be the return of the 0-ary body, if that is
+  supplied, or nil if it is not. If, on the other hand, the var bound
+  by this def form *is* currently bound, the argument to the 1-ary
+  body will be set to whatever that value is. The var will then be
+  rebound to the return of the 1-ary body.

 Another example:


core.async-ify translators

core.async-ify translators

--- src/tranjlator/bing.clj
+++ src/tranjlator/bing.clj
@@ -5,7 +5,8 @@
             [clojure.data.xml :as xml]
             [taoensso.timbre  :as log]
             [com.stuartsierra.component :as component]
-            [clojure.core.async :as a :refer [<! go go-loop chan >!]]))
+            [clojure.core.async :as a :refer [<! go go-loop chan >!]]
+            [clojure.core.async.impl.protocols :as impl]))

 (def +creds+
   {:client-id "clojure-cup-tranjlator"
@@ -24,38 +25,42 @@
   "creds contains keys: [:client-id :client-secret]"
   ([] (request-access-token +creds+))
   ([creds]
-   (http/post "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13"
-              {:headers {"content-type" "application/x-www-form-urlencoded"}
-               :form-params {:scope "http://api.microsofttranslator.com"
-                             :grant_type "client_credentials"
-                             :client_id     (:client-id     creds)
-                             :client_secret (:client-secret creds)}})))
+     (let [result-chan (chan 1 (map (fn [{:keys [status body] :as res}]
+                                      (json/parse-string body true))))]
+       (http/post "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13"
+                  {:headers {"content-type" "application/x-www-form-urlencoded"}
+                   :form-params {:scope "http://api.microsofttranslator.com"
+                                 :grant_type "client_credentials"
+                                 :client_id     (:client-id     creds)
+                                 :client_secret (:client-secret creds)}}
+                  #(a/put! result-chan %))
+       result-chan)))

 (defn access-token
   ([] (access-token +creds+))
   ([creds]
-     (let [{:keys [access_token expires_in] :as token}
-           (-> @(request-access-token creds)
-               :body
-               (json/parse-string true))]
-
-       {:token access_token
-        :expires (+ (now) (sec->msec (Long/parseLong expires_in)))})))
+     (go (let [{:keys [access_token expires_in] :as token} (<! (request-access-token creds))]
+           {:token access_token
+            :expires (+ (now) (sec->msec (Long/parseLong expires_in)))}))))

 (defn translate!
   ([text from to]
-   (translate! (:token (access-token)) text from to))
+     (translate! (access-token) text from to))
   ([access-token text from to]
-     (let [{:keys [status body] :as res}
-           @(http/get "http://api.microsofttranslator.com/v2/Http.svc/Translate"
-                      {:headers {"Authorization" (str "Bearer " access-token)}
-                       :query-params {:text text
-                                      :from (name from)
-                                      :to   (name to)}})]
-    (do (log/info "status:" status)
-     (case status
-       400 res
-       200 (-> body xml/parse-str :content first))))))
+     (log/info "here")
+     (let [result-chan (chan 1 (map (fn [{:keys [status body] :as res}]
+                                      (case status
+                                        400 res
+                                        200 (-> body xml/parse-str :content first)))))]
+       (go (http/get "http://api.microsofttranslator.com/v2/Http.svc/Translate"
+                     {:headers {"Authorization" (str "Bearer " (if (extends? impl/ReadPort (type access-token))
+                                                                 (:token (<! access-token))
+                                                                 access-token))}
+                      :query-params {:text text
+                                     :from (name from)
+                                     :to   (name to)}}
+                     #(a/put! result-chan %)))
+       result-chan)))

@@ -67,30 +72,43 @@
     (let [ctrl-chan (chan 1000)]
       (assoc this
         :ctrl-chan ctrl-chan
-        :work-chan (go-loop [token (access-token api-creds)]
+        :work-chan (go-loop [token (<! (access-token api-creds))]
                      (when-some [msg (<! ctrl-chan)]
-                       (log/info "msg:" msg)
-                       (let [token (if (expired? token) (access-token api-creds) token)]
-                         (a/put! out-chan (translate! (:token token)
+                       (let [token (if (expired? token) (<! (access-token api-creds)) token)]
+                         (>! out-chan (<! (translate! (:token token)
                                                       (:content msg)
                                                       (:language msg)
-                                                      (:language this)))
+                                                      (:language this))))
                          (recur token)))))))

   (stop [this]
     (a/close! ctrl-chan)
     (a/<!!    work-chan)
-    (dissoc this :ctrl-chan :work-chan)))
+    (dissoc this :ctrl-chan :work-chan :out-chan)))

-(declare +langs+)
 (defn ->translator
   ([language out-chan]
      (->translator +creds+ language out-chan))
   ([api-creds language out-chan]
-     (component/start (->Translator api-creds (name language) nil nil out-chan))))
+     (->Translator api-creds (name language) nil nil out-chan)))

 (comment
-  (translate! "Hello, World." :en :de))
+  (a/<!! (access-token))
+  (a/<!! (translate! "Hello, World." :en :de))
+
+  (def translator (-> (->translator :de out-chan) component/start))
+
+  (do
+    (let [out-chan (chan 1)]
+      (a/>!! (:ctrl-chan translator) {:topic "original"
+                                      :language :en
+                                      :content "Hello, World!"
+                                      :content-sha "foo"
+                                      :original-sha "foo"
+                                      :user-name "bar"})
+      (a/<!! out-chan)))
+
+  )

 ;; unused
 (def +langs+


Add parse-with-accumulator test

Add parse-with-accumulator test

--- test/clj/precept/tuple_rule_test.cljc
+++ test/clj/precept/tuple_rule_test.cljc
@@ -15,7 +15,8 @@
                                       value-expr?
                                       parse-as-tuple
                                       parse-with-fact-expression
-                                      rewrite-lhs] :as macros]))
+                                      rewrite-lhs] :as macros]
+              [precept.macros :as macros]))

 (deftest tuple-bindings-test
   (let [e1    '[?e :ns/foo 42]
@@ -58,6 +59,14 @@
         (parse-as-tuple '[[_ :ns/attr _ ?tx-id]])))
   (is (= '[:ns/attr (= -1 (:t this))]
         (parse-as-tuple '[[_ :ns/attr _ -1]]))))
+
+(deftest parse-with-accumulator-test
+  (is (= (macros/parse-with-accumulator '[?entity <- (acc/all) :from [?e :all]])
+         '[?entity <- (acc/all) :from [:all (= ?e (:e this))]]))
+  (is (= (macros/parse-with-accumulator '[?entity <- (acc/all :e) :from [?e :all]])
+        '[?entity <- (acc/all :e) :from [:all (= ?e (:e this))]]))
+  (is (= (macros/parse-with-accumulator '[?entity <- (acc/all) :from [(:e ?v) :all]])
+        '[?entity <- (acc/all) :from [:all (= (:e ?v) (:e this))]])))

 (deftest rewrite-lhs-test
   (testing "Ops - :exists, :not, :and, :or"


Fix next test.

Fix next test.

--- test/onyx/log/peer_rebalance_test.clj
+++ test/onyx/log/peer_rebalance_test.clj
@@ -89,7 +89,7 @@
     :catalog catalog-2
     :task-scheduler :onyx.task-scheduler/round-robin}))

-(def n-peers 6)
+(def n-peers 12)

 (def v-peers (onyx.api/start-peers n-peers peer-config))

@@ -148,17 +148,3 @@

 (onyx.api/shutdown-env env)

-(comment
-  (require '[clojure.core.async :refer [chan <!!]])
-
-  (def ch (chan 1000))
-
-  (def replica
-    (loop [replica (onyx.extensions/subscribe-to-log (:log env) ch)]
-      (let [position (<!! ch)
-            entry (onyx.extensions/read-log-entry (:log env) position)
-            new-replica (onyx.extensions/apply-log-entry entry replica)]
-        (prn "===")
-        (prn entry)
-        (clojure.pprint/pprint new-replica)
-        (recur new-replica)))))


web/start has to be async at deploy time.

--- modules/web/src/main/clojure/immutant/web/internal.clj
+++ modules/web/src/main/clojure/immutant/web/internal.clj
@@ -61,14 +61,16 @@
   `(if (.getAvailable ~context)
      (do
        ~@body)
-     (.addPropertyChangeListener
-       ~context
-       (proxy [java.beans.PropertyChangeListener] []
-         (propertyChange [evt#]
-           (when (and (= "available" (.getPropertyName evt#))
-                      (.getNewValue evt#)
-                      (not (.getOldValue evt#)))
-             ~@body))))))
+     (do
+       (.addPropertyChangeListener
+        ~context
+        (proxy [java.beans.PropertyChangeListener] []
+          (propertyChange [evt#]
+            (when (and (= "available" (.getPropertyName evt#))
+                       (.getNewValue evt#)
+                       (not (.getOldValue evt#)))
+              ~@body))))
+       nil)))

 (defn virtual-hosts []
   (let [vh (or (:virtual-host (reg/fetch :config)) ["default-host"])]
@@ -86,23 +88,25 @@
                    (.getService)
                    (.getMapper))
         complete (promise)]
-    (when-context-available
-     context
-     (doto wrapper
-       (.setName name)
-       (.setServletClass servlet-class)
-       (.setEnabled true)
-       (.setDynamic true)
-       (.setLoadOnStartup -1))
-     (doto context
-       (.addChild wrapper)
-       (.addServletMapping sub-context-path name))
-     (doseq [host (virtual-hosts)]
-       (.addWrapper mapper host (.getPath context) sub-context-path wrapper))
-     (deliver complete true))
-    (if (deref complete 5000 nil)
-      wrapper
-      (log/error "Failed to install servlet for" context))))
+    (if (and
+         (when-context-available
+          context
+          (doto wrapper
+            (.setName name)
+            (.setServletClass servlet-class)
+            (.setEnabled true)
+            (.setDynamic true)
+            (.setLoadOnStartup -1))
+          (doto context
+            (.addChild wrapper)
+            (.addServletMapping sub-context-path name))
+          (doseq [host (virtual-hosts)]
+            (.addWrapper mapper host (.getPath context) sub-context-path wrapper))
+          (deliver complete true)
+          true)
+         (not (deref complete 5000 nil)))
+      (log/error "Failed to install servlet for" sub-context-path)
+      wrapper)))

 (try-defn reqs remove-servlet [sub-context-path wrapper]
   (let [context (reg/fetch "web-context")


Inner Rage

Inner Rage

--- src/cards.clj
+++ src/cards.clj
@@ -81,7 +81,7 @@
   :quality :free
   :set :basic
   :cost 2
-  :spell ;...
+  :spell #(println "Yes?")
 }
 {
   :id 717
@@ -2932,7 +2932,7 @@
   :set :expert
   :class :warrior
   :cost 0
-  :spell ;...
+  :spell (target [:minion] #(-> % (damage-target 1) (buff-target 2 0)))
 }
 {
   :id 500
@@ -5061,7 +5061,7 @@
   :quality :common
   :set :missions
   :cost 1
-  :spell #(println "Kill minions or something") ; Yeah, no.F
+  :spell #(println "Kill minions or something") ; Yeah, no.
 }
 {
   :id 293


Add shape type hierarchy.

Add shape type hierarchy.


Add :wrap-render hook (like rum)

Add :wrap-render hook (like rum)

--- src/quiescent.cljs
+++ src/quiescent.cljs
@@ -48,9 +48,11 @@
                                                 (default-shouldComponentUpdate
                                                   (aget args 0) (aget args 1)))
                        :render                (wrapped-lifecycle-method
-                                                (apply renderer
-                                                   (aget (. *component* -props) "value")
-                                                   (aget (. *component* -props) "statics")))}]
+                                                (apply (if-some [wrap-render (:wrap-render m)]
+                                                         (wrap-render renderer)
+                                                         renderer)
+                                                  (aget (. *component* -props) "value")
+                                                  (aget (. *component* -props) "statics")))}]
     (when-some [n (or (:displayName m) (not-empty (.-name renderer)))]
       (set! (.-displayName react-map) n))
     (when-some [f (:getInitialState m)]


supporting start/stop workflow and fixing hostname setup

--- src/aws/provider.clj
+++ src/aws/provider.clj
@@ -14,6 +14,7 @@
     [celestial.persistency.systems :as s]
     [aws.sdk.ec2 :as ec2]
     [aws.sdk.ebs :as ebs]
+    [aws.sdk.eip :as eip]
     [clojure.string :refer (join)]
     [aws.validations :refer (provider-validation)]
     [celestial.persistency :as p]
@@ -68,19 +69,22 @@
    [pubdns]
     (join "." (rest (re-find #"ec2\-(\d+)-(\d+)-(\d+)-(\d+).*" pubdns))))

-(defn update-pubdns [spec endpoint instance-id]
+(defn update-ip [spec endpoint instance-id]
   "updates public dns in the machine persisted data"
   (when (s/system-exists? (spec :system-id))
     (let [ec2-host (pub-dns endpoint instance-id)]
-      (s/partial-system (spec :system-id) {:machine {:ssh-host ec2-host :ip (pubdns-to-ip ec2-host)}}))))
+      (s/partial-system (spec :system-id)
+        {:machine {:ip (pubdns-to-ip ec2-host)}}))))

 (defn set-hostname [spec endpoint instance-id user]
-  "Uses a generic method of setting hostname in Linux, not that in ec2 both Centos and Ubuntu use sudo!"
+  "Uses a generic method of setting hostname in Linux (see http://www.debianadmin.com/manpages/sysctlmanpage.txt)
+   Note that in ec2 both Centos and Ubuntu use sudo!"
   (let [{:keys [hostname domain]} (spec :machine)
         remote {:host (pub-dns endpoint instance-id) :user user}]
     (execute (<< "echo kernel.hostname=~{hostname} | sudo tee -a /etc/sysctl.conf") remote )
     (execute (<< "echo kernel.domainname=\"~{hostname}.~{domain}\" | sudo tee -a /etc/sysctl.conf") remote )
     (execute (<< "echo 127.0.1.1 ~{hostname}.~{domain} ~{hostname} | sudo tee -a /etc/hosts") remote )
+    (execute (<< "echo ~{hostname} | sudo tee /etc/hostname") remote )
     (execute "sudo sysctl -e -p" remote)
     (with-ctx ec2/create-tags [(instance-desc endpoint instance-id :id)] {:Name hostname})
     ))
@@ -130,8 +134,8 @@
        (handle-volumes aws endpoint instance-id)
        (when-let [ip (get-in spec [:machine :ip])]
          (debug (<<  "Associating existing ip ~{ip} to instance-id"))
-       (with-ctx ec2/assoc-pub-ip instance-id ip))
-       (update-pubdns spec endpoint instance-id)
+          (with-ctx eip/assoc-pub-ip instance-id ip))
+       (update-ip spec endpoint instance-id)
        (wait-for-ssh endpoint instance-id user [5 :minute])
        (set-hostname spec endpoint instance-id user)
         this))
@@ -141,7 +145,12 @@
       (debug "starting" instance-id)
       (with-ctx ec2/start-instances instance-id)
       (wait-for-status this "running" [5 :minute])
-      (update-pubdns spec endpoint instance-id)))
+      (when-let [ip (get-in spec [:machine :ip])]
+        (debug (<<  "Associating existing ip ~{ip} to instance-id"))
+        (with-ctx eip/assoc-pub-ip instance-id ip))
+      (update-ip spec endpoint instance-id)
+      (wait-for-ssh endpoint instance-id user [5 :minute])
+      ))

   (delete [this]
     (with-instance-id
@@ -153,6 +162,10 @@
   (stop [this]
     (with-instance-id
        (debug "stopping" instance-id)
+       (when-not (first (:addresses (with-ctx eip/describe-eip instance-id)))
+         (debug "clearing dynamic ip from system")
+         (s/update-system (spec :system-id)
+           (dissoc-in* (s/get-system (spec :system-id)) [:machine :ip])))
        (with-ctx ec2/stop-instances instance-id)
        (wait-for-status this "stopped" [5 :minute])))

@@ -161,7 +174,7 @@
       (with-instance-id
          (instance-desc endpoint instance-id :state :name))
       (catch [:type ::aws:missing-id] e
-        (info "No AWS instance id, most chances this instance hasn't been created yet") false))))
+        (debug "No AWS instance id, most chances this instance hasn't been created yet") false))))

 (def defaults {:aws {:min-count 1 :max-count 1}})

@@ -182,11 +195,13 @@
   (:endpoint m )
   (.status m)
   (.start m)
-  (clojure.pprint/pprint (celestial.model/set-env :dev
-      (-> (instance-desc "ec2.eu-west-1.amazonaws.com" "i-395e1d76") :block-device-mappings rest)))
-
-
-
+  (clojure.pprint/pprint
+    (celestial.model/set-env :dev
+      (instance-desc  "i-cdd59781") ))
+
+  (clojure.pprint/pprint
+    (celestial.model/set-env :dev
+     (first (:addresses (eip/describe-eip (assoc (creds) :endpoint "ec2.eu-west-1.amazonaws.com") "i-cdd59781")))))
   )


truncate by default

truncate by default

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -13,7 +13,7 @@

 ;; for now, using a language-independent tokenizer.
 (def tokenizer #"[ ']")
-(def map-fn (if true map #?(:clj pmap) #?(:cljs map)))
+(def map-fn #?(:clj pmap) #?(:cljs map))

 ;; thanks to http://tobiasbayer.com/post/2014-11-12-using-clojures-core-dot-cache/
 (defn deal-with-cache [k if-miss-do lexical-cache]
@@ -242,7 +242,7 @@
   the entire tree costs about 20% time than truncating it."
   ([input model & {:keys [parse-with-truncate original-input]}]
    (let [parse-with-truncate
-         (cond true false (= parse-with-truncate false)
+         (cond (= parse-with-truncate false)
                false
                true true)
          original-input (if original-input original-input input)