New test for function start-server-on-regular-machine

--- test/emender_jenkins/core_test.clj
+++ test/emender_jenkins/core_test.clj
@@ -11,7 +11,8 @@
 ;

 (ns emender-jenkins.core-test
-  (:require [clojure.test :refer :all]
+  (:require [clojure.test         :refer :all]
+            [ring.adapter.jetty   :as jetty]
             [emender-jenkins.core :refer :all]))

 (require '[clojure.tools.cli       :as cli])
@@ -161,6 +162,16 @@
         (is (thrown? AssertionError (get-and-check-port "65536")))
         (is (thrown? AssertionError (get-and-check-port "65537")))
         (is (thrown? AssertionError (get-and-check-port "1000000")))))
+
+(deftest test-start-server-on-regular-machine-positive-1
+    (testing "jenkinscat.core/start-server"
+        ; use mock instead of jetty/run-jetty
+        (with-redefs [jetty/run-jetty (fn [app port] port)]
+            (is (= {:port 1}     (start-server-on-regular-machine app "1")))
+            (is (= {:port 2}     (start-server-on-regular-machine app "2")))
+            (is (= {:port 1000}  (start-server-on-regular-machine app "1000")))
+            (is (= {:port 65534} (start-server-on-regular-machine app "65534")))
+            (is (= {:port 65535} (start-server-on-regular-machine app "65535"))))))

 (deftest test-show-help
     "Check the function emender-jenkins.core/show-help."


workaround austin repl *out* binding bug

--- frontend/core.cljs
+++ frontend/core.cljs
@@ -153,8 +153,9 @@
   (when-let [repl-url (aget js/window "browser_connected_repl_url")]
     (try
       (repl/connect repl-url)
-      ;; the repl tries to take over *out*
-      (enable-console-print!)
+      ;; the repl tries to take over *out*, workaround for
+      ;; https://github.com/cemerick/austin/issues/49
+      (js/setInterval #(enable-console-print!) 1000)
       (catch js/Error e
         (merror e)))))


Revert "Clean up channel handling code"

Revert "Clean up channel handling code"

This reverts commit 35cbb869c5bf5ce663683bb85c4bd16756311cdc.

--- frontend/core.cljs
+++ frontend/core.cljs
@@ -24,7 +24,7 @@
             [frontend.utils :as utils :refer [mlog merror third]]
             [secretary.core :as sec])
   (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]
-                   [frontend.utils :refer [inspect timing swallow-errors]])
+                   [frontend.utils :refer [inspect timing]])
   (:use-macros [dommy.macros :only [node sel sel1]]))

 (enable-console-print!)
@@ -80,43 +80,6 @@
                   :mouse-up {:ch mouse-up-ch
                              :mult (async/mult mouse-up-ch)}})))

-(defn controls-handler
-  [value state container]
-  (when true (:log-channels? utils/initial-query-map)
-        (mlog "Controls Verbose: " value))
-  (swallow-errors
-   (let [previous-state @state]
-     (swap! state (partial controls-con/control-event container (first value) (second value)))
-     (controls-pcon/post-control-event! container (first value) (second value) previous-state @state))))
-
-(defn nav-handler
-  [value state history]
-  (when true (:log-channels? utils/initial-query-map)
-        (mlog "Navigation Verbose: " value))
-  (swallow-errors
-   (let [previous-state @state]
-     (swap! state (partial nav-con/navigated-to history (first value) (second value)))
-     (nav-pcon/post-navigated-to! history (first value) (second value) previous-state @state))))
-
-(defn api-handler
-  [value state container]
-  (when true (:log-channels? utils/initial-query-map)
-        (mlog "API Verbose: " (first value) (second value) (utils/third value)))
-  (swallow-errors
-    (let [previous-state @state]
-      (swap! state (partial api-con/api-event container (first value) (second value) (utils/third value)))
-      (api-pcon/post-api-event! container (first value) (second value) (utils/third value) previous-state @state))))
-
-(defn ws-handler
-  [value state pusher]
-  (when true (:log-channels? utils/initial-query-map)
-        (mlog "websocket Verbose: " (pr-str (first value)) (second value) (utils/third value)))
-  (swallow-errors
-    (let [previous-state @state]
-      ;; XXX: should these take the container like the rest of the controllers?
-      (swap! state (partial ws-con/ws-event pusher (first value) (second value)))
-      (ws-pcon/post-ws-event! pusher (first value) (second value) previous-state @state))))
-
 (defn main [state top-level-node]
   (let [comms       (:comms @state)
         target-name "app"
@@ -133,10 +96,51 @@
       :opts {:comms comms}})
     (go (while true
           (alt!
-           (:controls comms) #(controls-handler % state container)
-           (:nav comms) #(nav-handler % state history-imp)
-           (:api comms) #(api-handler % state container)
-           (:ws comms) #(ws-handler % state pusher-imp)
+           (:controls comms) ([v]
+                                (when true (:log-channels? utils/initial-query-map)
+                                      (mlog "Controls Verbose: " v))
+                                (try
+                                  (let [previous-state @state]
+                                    (swap! state (partial controls-con/control-event container (first v) (second v)))
+                                    (controls-pcon/post-control-event! container (first v) (second v) previous-state @state))
+                                  (catch js/Error e
+                                    (merror e)
+                                    (when (:rethrow-errors? utils/initial-query-map)
+                                      (throw e)))))
+           (:nav comms) ([v]
+                           (when true (:log-channels? utils/initial-query-map)
+                                 (mlog "Navigation Verbose: " v))
+                           (try
+                             (let [previous-state @state]
+                               (swap! state (partial nav-con/navigated-to history-imp (first v) (second v)))
+                               (nav-pcon/post-navigated-to! history-imp (first v) (second v) previous-state @state))
+                             (catch js/Error e
+                               (merror e)
+                               (when (:rethrow-errors? utils/initial-query-map)
+                                 (throw e)))))
+           (:api comms) ([v]
+                           (when true (:log-channels? utils/initial-query-map)
+                                 (mlog "API Verbose: " (first v) (second v) (drop 2 v)))
+                           (try
+                             (let [previous-state @state]
+                               (swap! state (partial api-con/api-event container (first v) (second v) (utils/third v)))
+                               (api-pcon/post-api-event! container (first v) (second v) (utils/third v) previous-state @state))
+                             (catch js/Error e
+                               (merror e)
+                               (when (:rethrow-errors? utils/initial-query-map)
+                                 (throw e)))))
+           (:ws comms) ([v]
+                           (when true (:log-channels? utils/initial-query-map)
+                                 (mlog "websocket Verbose: " (pr-str (first v)) (second v) (drop 2 v)))
+                           (try
+                             (let [previous-state @state]
+                               ;; XXX: should these take the container like the rest of the controllers?
+                               (swap! state (partial ws-con/ws-event pusher-imp (first v) (second v)))
+                               (ws-pcon/post-ws-event! pusher-imp (first v) (second v) previous-state @state))
+                             (catch js/Error e
+                               (merror e)
+                               (when (:rethrow-errors? utils/initial-query-map)
+                                 (throw e)))))
            ;; Capture the current history for playback in the absence
            ;; of a server to store it
            (async/timeout 10000) (do (print "TODO: print out history: ")))))))


Change testing to :simple since :whitespace is rarely used

--- example/project.clj
+++ example/project.clj
@@ -27,7 +27,7 @@
             :test {:source-paths ["src" "test"]
                    :compiler {:output-to "target/testable.js"
                               :main 'example.runner
-                              :optimizations :whitespace}}
+                              :optimizations :simple}}
             :advanced {:source-paths ["src" "test"]
                        :compiler {:output-to "target/testable.js"
                                   :main "example.runner"


style

style

--- src/pc/render.clj
+++ src/pc/render.clj
@@ -37,8 +37,7 @@
 (def fonts (memoize fonts*))

 (defn svg-props [layers & {:keys [size-limit padding]
-                           :or {padding 100}
-                           }]
+                           :or {padding 100}}]
   (let [start-xs (remove nan? (map :layer/start-x layers))
         start-ys (remove nan? (map :layer/start-y layers))
         end-xs (remove nan? (map :layer/end-x layers))


api for retrieving all layers for a document

--- src/pc/server.clj
+++ src/pc/server.clj
@@ -3,7 +3,9 @@
             [compojure.handler :refer (site)]
             [compojure.route]
             [clojure.tools.reader.edn :as edn]
+            [pc.datomic :as pcd]
             [pc.http.datomic :as datomic]
+            [pc.models.layer :as layer]
             [pc.less :as less]
             [pc.views.content :as content]
             [pc.stefon]
@@ -15,6 +17,11 @@
         (datomic/entity-id-request (-> request :body slurp edn/read-string :count)))
   (POST "/api/transact" request
         (datomic/transact! (-> request :body slurp edn/read-string :datoms)))
+  (GET "/api/document/:id" [id]
+       ;; TODO: should probably verify document exists
+       ;; TODO: take tx-date as a param
+       {:status 200
+        :body (pr-str {:layers (layer/find-by-document (pcd/default-db) {:db/id (Long/parseLong id)})})})
   (GET "/" [] (content/app))
   (compojure.route/resources "/" {:root "public"
                                   :mime-types {:svg "image/svg"}})


Template version 0.3.0-SNAPSHOT

Template version 0.3.0-SNAPSHOT

--- template/project.clj
+++ template/project.clj
@@ -1,4 +1,4 @@
-(defproject friboo/lein-template "0.2.0"
+(defproject friboo/lein-template "0.3.0-SNAPSHOT"
   :description "Leiningen template for Friboo library"
   :url "https://github.com/dryewo/friboo-template"
   :license {:name "Apache License"


Avoid running matrix-multiply-test performance tests during testing

--- test/cortex/performance_test.clj
+++ test/cortex/performance_test.clj
@@ -52,7 +52,7 @@
          (.mmuli left-m right-m result-m))))))

-(deftest matrix-multiply-test
+(defn matrix-multiply-test []
   (doseq [image-dim image-dims]
     (println "###" image-dim)
     (doseq [impl implementations]


Add simple random moves.

Add simple random moves.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -153,11 +153,32 @@
   (merge state {:editing? false
                 :selected nil}))

+(def interval 20)
+
+(def ticker (atom interval))
+
+(defn random-move
+  [_ world-state]
+  (swap! ticker dec)
+  (if (neg? @ticker)
+    (do
+      (reset! ticker interval)
+      (let [a (first  (rand-nth
+                       (filter
+                        #(ok-to-flip? world-state (second %))
+                        (world-state :edges))))]
+        (.log js/console a)
+        (flip-update-edge a world-state)))
+    world-state
+    )
+  )
+
 (go
   (let [read-state (reader/read-string (<! (GET "./state.edn")))]
     (big-bang!
       :initial-state (reset-edit read-state)
       :to-draw draw-world
+      :on-tick random-move
       :on-click update-state))
   )


init fn must also be used for reload task

--- resources/leiningen/new/tenzing/build.boot
+++ resources/leiningen/new/tenzing/build.boot
@@ -36,7 +36,8 @@
 (deftask development []
   (task-options! cljs {:optimizations :none
                        :unified-mode true
-                       :source-map true}{{{development-task-opts}}})
+                       :source-map true}
+                 reload {:on-jsload '{{name}}.app/init}{{{development-task-opts}}})
   identity)

 (deftask dev


adds a handy select-in function

adds a handy select-in function

--- frontend/utils/seq.cljs
+++ frontend/utils/seq.cljs
@@ -4,3 +4,17 @@
   "Finds index of first item in coll that returns truthy for filter-fn"
   [filter-fn coll]
   (first (keep-indexed (fn [i x] (when (filter-fn x) i)) coll)))
+
+(defn select-in
+  "Returns a map containing only those entries in map whose keypath is in keypaths
+   (select-in {:a {:b 1 :c 2}} [[:a :b]]) => {:a {:b 1}} "
+  [map keypathseq]
+    (loop [ret {} keypaths (seq keypathseq)]
+      (if keypaths
+        (let [entry (get-in map (first keypaths))]
+          (recur
+           (if entry
+             (assoc-in ret (first keypaths) entry)
+             ret)
+           (next keypaths)))
+        (with-meta ret (meta map)))))


Finally perfect updating and no need for an ident in follow on read

--- src/demo/checkboxes.cljs
+++ src/demo/checkboxes.cljs
@@ -14,12 +14,17 @@
   (om/parser {:read   read
               :mutate mutate}))

-(defmethod read :graph/lines
+(defmethod read :graph/graph-lines
   [{:keys [state query]} key _]
   (let [st @state]
     {:value (om/db->tree query (get st key) st)}))

-(defmethod read :graph/selected-lines
+(defmethod read :graph/fake-graph
+  [{:keys [state query]} key _]
+  (let [st @state]
+    {:value (om/db->tree query (get st key) st)}))
+
+(defmethod read :app/app-lines
   [{:keys [state query]} key _]
   (let [st @state]
     {:value (om/db->tree query (get st key) st)}))
@@ -29,31 +34,44 @@
   (let [st @state]
     {:value (om/db->tree query (get st key) st)}))

-;;
-;; "Only need to add or remove from the :graph/selected-lines refs mapentry"
-;; (pprint (get @state :graph/selected-lines))
-;;
+(comment
+  (defmethod read :fake-graph/by-id
+    [{:keys [state query]} key _]
+    (let [st @state]
+      {:value (om/db->tree query (get st key) st)})))
+
+(defn update-graph-lines [st want-to-select? id]
+  (let [graph-lines [:fake-graph/by-id 1000 :graph/graph-lines]]
+    (if want-to-select?
+      (update-in st graph-lines (fn [v] (vec (conj v [:line/by-id id]))))
+      (update-in st graph-lines (fn [v] (vec (remove #{[:line/by-id id]} v)))))))
+
+(defn update-lines
+  [last-state {:keys [want-to-select? id]}]
+  (-> last-state
+      (update-in [:line/by-id id] assoc :selected? want-to-select?)
+      (update-graph-lines want-to-select? id)))
+
 (defmethod mutate 'graph/select-line
-  [{:keys [state]} _ {:keys [want-to-select? id]}]
-  {:action #(let [ident [:line/by-id id]]
-             (if want-to-select?
-               (swap! state update :graph/selected-lines (fn [st] (-> st
-                                                                      (conj ident))))
-               (swap! state update :graph/selected-lines (fn [lines] (vec (remove #{ident} lines))))))})
+  [{:keys [state]} _ params]
+  {:action #(swap! state update-lines params)})

 (def init-state
-  {:graph/selected-lines
-   [{:id 100}
-    {:id 101}]
-   :graph/lines
+  {:graph/fake-graph {:id 1000
+                      :graph/graph-lines [{:id 100}]}
+   :app/app-lines
    [{:id   100
-     :line-name "Methane"}
+     :line-name "Methane"
+     :selected? true}
     {:id   101
-     :line-name "Oxygen"}
+     :line-name "Oxygen"
+     :selected? false}
     {:id   102
-     :line-name "Carbon Dioxide"}
+     :line-name "Carbon Dioxide"
+     :selected? false}
     {:id   103
-     :line-name "Carbon Monoxide"}
+     :line-name "Carbon Monoxide"
+     :selected? false}
     ]
    :app/customers
    [{:id 200
@@ -79,14 +97,14 @@
       (pprint st)
       (db-format/show-hud check-result))))

-(defui FakeGraph
-  Object
-  (render [this]
-    (println "Rendering the FakeGraph")
-    (let [props (om/props this)
-          selected-names (map :line-name props)]
-      (dom/h2 #js{:className "fake-graph"} (apply str "GRAPH: " (interpose ", " selected-names))))))
-(def fake-graph (om/factory FakeGraph))
+(comment
+  (defui Line
+    static om/Ident
+    (ident [this props]
+      [:line/by-id (:id props)])
+    static om/IQuery
+    (query [this]
+      [:id :line-name])))

 (defui Checkbox
   static om/Ident
@@ -94,22 +112,35 @@
     [:line/by-id (:id props)])
   static om/IQuery
   (query [this]
-    [:id :line-name])
+    [:id :line-name :selected?])
   Object
   (render [this]
-    (let [{:keys [id line-name]} (om/props this)
-          {:keys [selected?]} (om/get-computed this)
+    (let [{:keys [id line-name selected?]} (om/props this)
           _ (println "Rendering cb:" id "when selected is:" selected?)]
       (dom/div nil
-               (dom/input #js{:type    "checkbox"
+               (dom/input #js{:type      "checkbox"
                               :className "xlarge"
-                              :checked selected?
-                              :onClick (fn [e]
-                                         (let [action (.. e -target -checked)]
-                                           (println "Pressed so attempting to set to:" action)
-                                           (om/transact! this `[(graph/select-line {:want-to-select? ~action :id ~id}) :app/customers])))})
-               (dom/label #js{:className "xlarge"} (dom/h2 #js{:className "side higher-text"} "Some text"))))))
+                              :checked   (boolean selected?)
+                              :onClick   (fn [e]
+                                           (let [action (.. e -target -checked)]
+                                             (println "Pressed so attempting to set to:" action)
+                                             (om/transact! this `[(graph/select-line {:want-to-select? ~action :id ~id}) :graph/graph-lines])))})
+               (dom/label #js{:className "xlarge"} (dom/h2 #js{:className "side higher-text"} line-name))))))
 (def checkbox (om/factory Checkbox {:keyfn :id}))
+
+(defui FakeGraph
+  static om/Ident
+  (ident [this props]
+    [:fake-graph/by-id (:id props)])
+  static om/IQuery
+  (query [this]
+    [:id {:graph/graph-lines (om/get-query Checkbox)}])
+  Object
+  (render [this]
+    (let [{:keys [graph/graph-lines]} (om/props this)
+          _ (println (str "Rendering the FakeGraph with " (count graph-lines)))]
+      (dom/h2 #js{:className "fake-graph"} (apply str "GRAPH: " (interpose ", " (map :line-name graph-lines)))))))
+(def fake-graph-component (om/factory FakeGraph))

 (defui Customer
   static om/Ident
@@ -127,30 +158,31 @@
 (defui Root
   static om/IQuery
   (query [this]
-    [{:graph/lines (om/get-query Checkbox)}
-     {:graph/selected-lines (om/get-query Checkbox)}
+    [{:app/app-lines (om/get-query Checkbox)}
+     {:graph/fake-graph (om/get-query FakeGraph)}
+     {:graph/graph-lines (om/get-query Checkbox)}
      {:app/customers (om/get-query Customer)}
      ])
   Object
   (render [this]
     (println "Rendering 'demo.checkboxes' from Root")
-    (let [{:keys [graph/lines graph/selected-lines]} (om/props this)]
-      (dom/div #js{:className "container"}
-               (check-default-db @my-reconciler)
-               (dom/div nil
-                        (for [line lines
-                              :let [selected? (boolean (some #{line} selected-lines))]]
-                          (checkbox (om/computed line {:selected? selected?}))))
-               (dom/div nil
-                        (dom/br nil)
-                        (fake-graph selected-lines)
-                        #_(dom/br nil)
-                        #_(dom/br nil)
-                        #_(help/any-action {:text "Show State" :action #(pprint @my-reconciler)})
-                        #_(dom/br nil))
-               #_(help/any-action {:text "Add Selection" :action #(help/mutate help/norm-state true 102)})
-               #_(help/any-action {:text "Remove Selection" :action #(help/mutate help/norm-state false 100)})
-               ))))
+    (let [{:keys [app/app-lines graph/fake-graph]} (om/props this)]
+      (dom/div nil
+               (println (str "fake graph: " fake-graph))
+               (dom/div #js{:className "container"}
+                        (check-default-db @my-reconciler)
+                        (dom/div nil
+                                 (map checkbox app-lines))
+                        (dom/div nil
+                                 (dom/br nil)
+                                 (fake-graph-component fake-graph)
+                                 #_(dom/br nil)
+                                 #_(dom/br nil)
+                                 (help/any-action {:text "Show State" :action #(pprint @my-reconciler)})
+                                 #_(dom/br nil))
+                        #_(help/any-action {:text "Add Selection" :action #(help/mutate help/norm-state true 102)})
+                        #_(help/any-action {:text "Remove Selection" :action #(help/mutate help/norm-state false 100)})
+                        )))))

 (defn run []
   (om/add-root! my-reconciler


Langohr 2.11

Langohr 2.11

--- clojure/project.clj
+++ clojure/project.clj
@@ -4,4 +4,4 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure     "1.6.0"]
-                 [com.novemberain/langohr "2.10.1"]])
+                 [com.novemberain/langohr "2.11.0"]])


fix did-catch mixin

fix did-catch mixin

--- src/rum/core.cljs
+++ src/rum/core.cljs
@@ -111,7 +111,7 @@
       (gobj/set prototype "componentDidCatch"
         (fn [error info]
           (this-as this
-            (vswap! (state this) #(call-all %1 %2 error info) did-update)))))
+            (vswap! (state this) call-all did-catch error info)))))

     (gobj/set prototype "componentWillUnmount"
       (fn []


changed crate input paramters so it’s possible to connect to multiple hosts

--- src/metabase/driver/crate.clj
+++ src/metabase/driver/crate.clj
@@ -49,13 +49,13 @@
   (getName [_] "Crate"))

 (defn- crate-spec
-  [{:keys [host port]
-    :or {host "localhost", port 4300}
+  [{:keys [hosts]
+    :or {hosts "//localhost:4300"}
     :as opts}]
   (merge {:classname "io.crate.client.jdbc.CrateDriver" ; must be in classpath
           :subprotocol "crate"
-          :subname (str "//" host ":" port)}
-         (dissoc opts :host :port)))
+          :subname (str hosts)}
+         (dissoc opts :hosts)))

 (defn- connection-details->spec [_ details]
   (-> details crate-spec))
@@ -81,13 +81,9 @@
 (extend CrateDriver
   driver/IDriver
   (merge (sql/IDriverSQLDefaultsMixin)
-         {:details-fields (constantly [{:name         "host"
-                                        :display-name "Host"
-                                        :default      "localhost"}
-                                       {:name         "port"
-                                        :display-name "Port"
-                                        :type         :integer
-                                        :default      4300}])
+         {:details-fields (constantly [{:name         "hosts"
+                                        :display-name "Hosts"
+                                        :default      "//localhost:4300"}])
           :can-connect?       can-connect
           :date-interval      u/date-interval
           :analyze-table      gs/analyze-table


Add sequence protocol

Add sequence protocol

--- src/micro_logic/protocols.clj
+++ src/micro_logic/protocols.clj
@@ -16,3 +16,7 @@

 (defprotocol IReifySubstitution
   (reify-s* [v s]))
+
+(defprotocol ILList
+  (lfirst [l])
+  (lrest [l]))


Some balance to early-game monsters

Some balance to early-game monsters


Don't root the prefix

Don't root the prefix

This is what's causing the double /#.  The problem is that sometimes I'm
setting the history token, so I don't want a rooted path, but sometimes
I'm setting a link href, in which case it should be rooted.


Use 100% ackers

Use 100% ackers

--- src/onyx_benchmark/submit.clj
+++ src/onyx_benchmark/submit.clj
@@ -92,7 +92,7 @@
       {:catalog catalog
        :workflow workflow
        :lifecycles lifecycles
-       :acker/percentage 20
+       :acker/percentage 100
        :acker/exempt-input-tasks? true
        :task-scheduler :onyx.task-scheduler/balanced})))


Use a workflow with a longer chain of segments.

--- src/onyx_benchmark/submit.clj
+++ src/onyx_benchmark/submit.clj
@@ -11,7 +11,13 @@
 (def lifecycles
   [{:lifecycle/task :in
     :lifecycle/calls :onyx-benchmark.peer/measurement-calls}
-   {:lifecycle/task :inc
+   {:lifecycle/task :inc1
+    :lifecycle/calls :onyx-benchmark.peer/measurement-calls}
+   {:lifecycle/task :inc2
+    :lifecycle/calls :onyx-benchmark.peer/measurement-calls}
+   {:lifecycle/task :inc3
+    :lifecycle/calls :onyx-benchmark.peer/measurement-calls}
+   {:lifecycle/task :inc4
     :lifecycle/calls :onyx-benchmark.peer/measurement-calls}
    {:lifecycle/task :no-op
     :lifecycle/calls :onyx.plugin.core-async/writer-calls}
@@ -40,7 +46,25 @@
         :onyx/consumption :concurrent
         :onyx/batch-size batch-size}

-       {:onyx/name :inc
+       {:onyx/name :inc1
+        :onyx/fn :onyx-benchmark.peer/my-inc
+        :onyx/type :function
+        :onyx/consumption :concurrent
+        :onyx/batch-size batch-size}
+
+       {:onyx/name :inc2
+        :onyx/fn :onyx-benchmark.peer/my-inc
+        :onyx/type :function
+        :onyx/consumption :concurrent
+        :onyx/batch-size batch-size}
+
+       {:onyx/name :inc3
+        :onyx/fn :onyx-benchmark.peer/my-inc
+        :onyx/type :function
+        :onyx/consumption :concurrent
+        :onyx/batch-size batch-size}
+
+       {:onyx/name :inc4
         :onyx/fn :onyx-benchmark.peer/my-inc
         :onyx/type :function
         :onyx/consumption :concurrent
@@ -54,7 +78,11 @@
         :onyx/batch-size batch-size
         :onyx/doc "Drops messages on the floor"}])

-    (def workflow [[:in :inc] [:inc :no-op]])
+    (def workflow [[:in :inc1]
+                   [:inc1 :inc2]
+                   [:inc2 :inc3]
+                   [:inc3 :inc4]
+                   [:inc4 :no-op]])

     (onyx.api/submit-job
      peer-config


Make mv! work on accross filesystem boundaries.

* use clojure.java.io/copy and delete-file if .renameTo fails.
* copy and delete-file will throw an exception on failure.
* Fixes errors related to #'asset-path and #'asset-bundle-dir
  when /tmp and ~/.overtone are on separate partitions.

--- src/overtone/helpers/file.clj
+++ src/overtone/helpers/file.clj
@@ -317,7 +317,9 @@
         dest   (resolve-tilde-path dest)
         f-src  (file src)
         f-dest (file dest)]
-    (.renameTo f-src f-dest)))
+    (when-not (.renameTo f-src f-dest)
+      (copy f-src f-dest)
+      (delete-file f-src))))

 (defn path-exists?
   "Returns true if file or dir specified by path exists"


Yet another Quarter-comma meantone implementation

--- src/overtone/music/tuning.clj
+++ src/overtone/music/tuning.clj
@@ -60,7 +60,7 @@
          (* 4/5 (sqrt 5))
          (* 5/4 x))))

-(def qcmeantone
+(def qcmeantone-hack
     (let [x (expt 5 1/4)]
         (sort
             (map #(if (< % 1) (* 2 %) %) ; Dear DAemon. What the hell. Love DAemon.
@@ -68,10 +68,28 @@
                      (* (expt x expnt)
                         (expt 2 (ceil (* expnt -0.5)))))))))

+(defn collapse-to-ntave [number ntave]
+    (condp > number
+             1 (recur (* number ntave) ntave)
+             ntave number
+             (recur (/ number ntave) ntave)))
+
+(defn notesetfromgenerator [generator initpower finpower ntave]
+    (let [tempset (for [exponent (range initpower finpower)] (expt generator exponent))]
+        (sort (map #(collapse-to-ntave % ntave) tempset))))
+
+(def qcmeantone
+    (notesetfromgenerator (expt 5 1/4) -5 7 2))
+
+(defn perfmap [note initial freq notemap]
+    (let [pos (mod (- note initial) (count notemap))
+          octave (quot (- note initial (- (count notemap) 1 )) (count notemap))]
+        (* freq (nth notemap pos) (expt (ceil (reduce max notemap)) octave))))
+
 (defmethod perfn :qcmeantone [[symb initial freq]]
     (fn [note]
-        (let [pos (mod (- note initial) 12)
-             octave (quot (- note initial 11) 12)] ; There's a hack in here, but it makes my tests pass. More thought is needed.
-            (* freq (nth qcmeantone pos) (expt 2 octave)))))
+        (perfmap note initial freq qcmeantone)))
+
+

 (defn perform [[opts & notes]] (map (perfn (flatten (list opts))) notes))


tidy docstring

tidy docstring

--- src/overtone/studio/mixer.clj
+++ src/overtone/studio/mixer.clj
@@ -140,8 +140,8 @@

 (defn recording-start
   "Start recording a wav file to a new file at wav-path. Be careful -
-  may generate very large files. See buffer-stream for a list of
-  output options.
+  may generate very large files. See buffer-stream for a list of output
+  options.

   Note, due to the size of the buffer used for transferring the audio
   from the audio server to the file, there will be 1.5s of silence at


Add missing `storage?` predicate.

Add missing `storage?` predicate.

--- vendor/storages/core.clj
+++ vendor/storages/core.clj
@@ -48,3 +48,8 @@
 (defn public-url
   [storage path]
   (pt/-public-uri storage path))
+
+(defn storage?
+  "Return `true` if `v` implements IStorage protocol"
+  [v]
+  (satisfies? pt/IStorage v))


improve

improve


Replace the use of cursors with values and functions

--- src/reabledit/components.cljs
+++ src/reabledit/components.cljs
@@ -26,65 +26,64 @@

 (defn string-editor
   []
-  (fn [cursor _]
+  (fn [v change-fn _]
     [:input {:type "text"
              :auto-focus true
              :on-focus util/move-cursor-to-end!
-             :value @cursor
-             :on-change #(reset! cursor (-> % .-target .-value))}]))
+             :value v
+             :on-change #(change-fn (-> % .-target .-value))}]))

 (defn int-editor
   []
-  (fn [cursor _]
+  (fn [v change-fn _]
     [:input {:type "text"
              :auto-focus true
              :on-focus util/move-cursor-to-end!
-             :value @cursor
+             :value v
              :on-change (fn [e]
                           (let [new-value (js/parseInt (-> e .-target .-value))
                                 int? (not (js/isNaN new-value))]
                             (if int?
-                              (reset! cursor new-value))))}]))
+                              (change-fn new-value))))}]))

 (defn- dropdown-editor-on-key-down
-  [e cursor options]
+  [e v change-fn options]
   (let [keycode (.-keyCode e)
-        position (first (keep-indexed #(if (= %2 @cursor) %1)
+        position (first (keep-indexed #(if (= %2 v) %1)
                                       (map :key options)))]
     (case keycode
       38 (do
            (.preventDefault e)
            (if (zero? position)
-             (reset! cursor (-> options last :key))
-             (reset! cursor (:key (nth options (dec position))))))
+             (change-fn (-> options last :key))
+             (change-fn (:key (nth options (dec position))))))
       40 (do
            (.preventDefault e)
            (if (= position (-> options count dec))
-             (reset! cursor (-> options first :key))
-             (reset! cursor (:key (nth options (inc position))))))
+             (change-fn (-> options first :key))
+             (change-fn (:key (nth options (inc position))))))
       nil)))

 (defn dropdown-editor
   [options]
   (with-meta
-    (fn [cursor disable-edit!]
-      (let [chosen-key @cursor]
-        [:div.reabledit-dropdown
-         {:tabIndex 0
-          :on-key-down #(dropdown-editor-on-key-down % cursor options)}
-         [:span (-> (filter #(= (:key %) chosen-key) options)
-                    first
-                    :value)]
-         [:div.reabledit-dropdown-items
-          (for [{:keys [key value]} options]
-            ^{:key key}
-            [:div.reabledit-dropdown-item
-             {:class (if (= key chosen-key) "selected")
-              :on-click (fn [e]
-                          (.stopPropagation e)
-                          (reset! cursor key)
-                          (disable-edit!))}
-             [:span value]])]]))
+    (fn [v change-fn disable-edit!]
+      [:div.reabledit-dropdown
+       {:tabIndex 0
+        :on-key-down #(dropdown-editor-on-key-down % v change-fn options)}
+       [:span (-> (filter #(= (:key %) v) options)
+                  first
+                  :value)]
+       [:div.reabledit-dropdown-items
+        (for [{:keys [key value]} options]
+          ^{:key key}
+          [:div.reabledit-dropdown-item
+           {:class (if (= key v) "selected")
+            :on-click (fn [e]
+                        (.stopPropagation e)
+                        (change-fn key)
+                        (disable-edit!))}
+           [:span value]])]])
     {:component-did-mount
      (fn [this]
        (.focus (reagent/dom-node this)))}))
@@ -101,13 +100,15 @@
     (fn [columns data v nth-row nth-col state
          enable-edit! disable-edit! set-selected!]
       (let [column (nth columns nth-col)
-            cursor (reagent/cursor state [:edit :updated (:key column)])
             view (or (:view column) (span-view))
             editor (or (:editor column) (string-editor))]
         [:div.reabledit-cell {:class (if @selected? "selected")
                               :on-click #(set-selected! nth-row nth-col)}
          (if (and @selected? @edit?)
-           [editor cursor disable-edit!]
+           (let [path [:edit :updated (:key column)]
+                 value-in-state (get-in @state path)
+                 change-fn #(swap! state assoc-in path %)]
+             [editor value-in-state change-fn disable-edit!])
            [view v enable-edit!])]))))

 (defn data-table-row


Warn and disable when not in project

Warn and disable when not in project

--- src/refactor_nrepl/plugin.clj
+++ src/refactor_nrepl/plugin.clj
@@ -14,28 +14,32 @@

 (defn middleware
   [{:keys [dependencies exclusions] :as project}]
-  (let [clojure-excluded? (some #(= % 'org.clojure/clojure) exclusions)
-        clojure-version (when-not clojure-excluded?
-                          (find-clojure-version dependencies))
-        clojure-version-ok?
-        (cond clojure-excluded? true ; up to the user
+  (if (core/project-root)
+    (let [clojure-excluded? (some #(= % 'org.clojure/clojure) exclusions)
+          clojure-version (when-not clojure-excluded?
+                            (find-clojure-version dependencies))
+          clojure-version-ok?
+          (cond clojure-excluded? true ; up to the user

-              (nil? clojure-version)
-              ;; Lein 2.5.2+ uses Clojure 1.7 by default
-              (lein/version-satisfies? (lein/leiningen-version) "2.5.2")
+                (nil? clojure-version)
+                ;; Lein 2.5.2+ uses Clojure 1.7 by default
+                (lein/version-satisfies? (lein/leiningen-version) "2.5.2")

-              :else
-              (lein/version-satisfies? clojure-version min-clojure-version))]
-    (if clojure-version-ok?
-      (-> project
-          (update-in [:dependencies]
-                     (fnil into [])
-                     [['refactor-nrepl (core/version)]])
-          (update-in [:repl-options :nrepl-middleware]
-                     (fnil into [])
-                     '[refactor-nrepl.middleware/wrap-refactor]))
-      (do
-        (lein/warn "Warning: refactor-nrepl requires Clojure version"
-                   min-clojure-version "or later.")
-        (lein/warn "Warning: refactor-nrepl middleware won't be activated." )
-        project))))
+                :else
+                (lein/version-satisfies? clojure-version min-clojure-version))]
+      (if clojure-version-ok?
+        (-> project
+            (update-in [:dependencies]
+                       (fnil into [])
+                       [['refactor-nrepl (core/version)]])
+            (update-in [:repl-options :nrepl-middleware]
+                       (fnil into [])
+                       '[refactor-nrepl.middleware/wrap-refactor]))
+        (do
+          (lein/warn "Warning: refactor-nrepl requires Clojure version"
+                     min-clojure-version "or later.")
+          (lein/warn "Warning: refactor-nrepl middleware won't be activated." )
+          project)))
+    (do
+      (lein/warn "Warning: refactor-nrepl needs to run in the context of a project.")
+      (lein/warn "Warning: refactor-nrepl middleware won't be activated." ))))


Clearer test assertion

Clearer test assertion

--- transactions/test/immutant/transactions_test.clj
+++ transactions/test/immutant/transactions_test.clj
@@ -160,7 +160,5 @@
                   (:deliveries cache)
                   (recur (inc i))))))
     (is (= 1 (:a cache)))
-    (is (= (take 10 (repeat "kiwi"))
-          (loop [i 10, v []] (if (zero? i) v (recur (dec i) (conj v (msg/receive queue :timeout 1000)))))))
-    (is (= (take 10 (repeat "starfruit"))
-          (loop [i 10, v []] (if (zero? i) v (recur (dec i) (conj v (msg/receive local-remote-queue :timeout 1000)))))))))
+    (is (= (repeat 10 "kiwi")      (repeatedly 10 #(msg/receive queue))))
+    (is (= (repeat 10 "starfruit") (repeatedly 10 #(msg/receive local-remote-queue))))))


Removes debug print

Removes debug print


allow nodejs >= 4

allow nodejs >= 4


Added a ctor metadata used as the construction hook

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -219,9 +219,25 @@
          ~fields
          ~@etc)
        (defconstrainedfn ~(symbol (str "new-" name))
-         ([] [] (~(symbol (str name \.)) ~@defaults))
+         ([] [] (with-meta
+                  (~(symbol (str name \.)) ~@defaults)
+                  {:ctor ~(symbol (str "new-" name))}))
          ([& {:keys ~fields :as kwargs# :or ~(apply hash-map slots)}]
             ~invariants
-            (-> (~(symbol (str name \.)) ~@defaults)
-                (merge kwargs#))))
+            (with-meta
+              (-> (~(symbol (str name \.)) ~@defaults)
+                  (merge kwargs#))
+              {:ctor ~(symbol (str "new-" name))})))
        ~name)))
+
+(comment
+  (defconstrainedrecord Foo [a 1 b 2]
+    [(every? number? [a b])]
+    Object
+    (toString [this] (str "record Foo has " a " and " b)))
+
+  (meta (new-Foo :a 2))
+  ((:ctor (meta (new-Foo))) :c :b)
+)
+
+


Use plain cond function for format-answer

Signed-off-by: Njagi Mwaniki <b6a4ba60ad861b9c9afb6daea7294be4be68f44c@urbanslug.com>

--- src/hatti/ona/forms.cljs
+++ src/hatti/ona/forms.cljs
@@ -162,76 +162,54 @@
   ([field answer] (format-answer field answer nil))
   ([field answer language] (format-answer field answer language false))
   ([field answer language compact?]
-   (let [which (cond
-                 (image? field) :img
-                 (video? field) :vid
-                 (osm? field) :osm
-                 (repeat? field) :rpt
-                 (select-one? field) :sel1
-                 (select-all? field) :selm
-                 :else :else)]
-     (case which
-       :sel1 (if-not answer
-               no-answer
-               (let [option (->> (:children field)
-                                 (filter #(= answer (:name %)))
-                                 first)
-                     formatted (get-label option language)]
-                 (or formatted answer)))
-       :selm (if (string/blank? answer)
-               no-answer
-               (let [names (set (string/split answer #" "))]
-                 (->> (:children field)
-                      (filter #(contains? names (:name %)))
-                      (map #(str "☑ "
-                                 (get-label % language) " "))
-                      string/join)))
-       :img (let [image (:download_url answer)
-                  thumb (or (:small_download_url answer) image)
-                  fname (last-url-param (:filename answer))]
-              (cond
-                (or (nil? answer)
-                    (string? answer)) answer
-                compact?              (format
-                                       "
+   (cond
+     (select-one? field) (if-not answer
+                           no-answer
+                           (let [option (->> (:children field)
+                                             (filter #(= answer (:name %)))
+                                             first)
+                                 formatted (get-label option language)]
+                             (or formatted answer)))
+     (select-all? field) (if (string/blank? answer)
+                           no-answer
+                           (let [names (set (string/split answer #" "))]
+                             (->> (:children field)
+                                  (filter #(contains? names (:name %)))
+                                  (map #(str "☑ " (get-label % language) " "))
+                                  string/join)))
+
+     (or (image? field)
+         (video? field)) (let [image (:download_url answer)
+                               thumb (or (:small_download_url answer) image)
+                               fname (last-url-param (:filename answer))]
+                           (cond
+                             (or (nil? answer) (string? answer)) answer
+                             compact? (format "

-                                      %s " image fname)
-                (nil? thumb)          answer
-                :else                 [:a {:href image :target "_blank"}
-                                       [:img {:width "80px" :src thumb}]]))
-       :vid (let [image (:download_url answer)
-                  thumb (or (:small_download_url answer) image)
-                  fname (last-url-param (:filename answer))]
-              (cond
-                (or (nil? answer)
-                    (string? answer)) answer
-                compact?              (format
-                                       "
-
-                                      %s " image fname)
-                (nil? thumb)          answer
-                :else                 [:a {:href image :target "_blank"}
-                                       [:img {:width "80px" :src thumb}]]))
-       :osm (when answer
-              (let [kw->name name ; aliasing before overriding name
-                    {:keys [name type osm-id]} answer
-                    type-cap (when type (string/capitalize type))
-                    title (str "OSM " type-cap ": " name " (" osm-id ")")]
-                (if compact?
-                  title
-                  [:table.osm-data
-                   [:thead [:th {:col-span 2} title]]
-                   [:tbody
-                    (map (fn [[tk tv]]
-                           (when-not (string/blank? tv)
-                             [:tr
-                              [:td.question (kw->name tk)]
-                              [:td.answer tv]]))
-                         (:tags answer))]])))
-       :rpt (if (empty? answer)
-              ""
-              (str "Repeated data with " (count answer) " answers."))
-       :else answer))))
+                                     %s " image fname)
+                             (nil? thumb) answer
+                             :else [:a {:href image :target "_blank"}
+                                    [:img {:width "80px" :src thumb}]]))
+     (osm? field) (when answer
+                    (let [kw->name name ; aliasing before overriding name
+                          {:keys [name type osm-id]} answer
+                          type-cap (when type (string/capitalize type))
+                          title (str "OSM " type-cap ": " name " (" osm-id ")")]
+                      (if compact?
+                        title
+                        [:table.osm-data
+                         [:thead [:th {:col-span 2} title]]
+                         [:tbody
+                          (map (fn [[tk tv]]
+                                 (when-not (string/blank? tv)
+                                   [:tr
+                                    [:td.question (kw->name tk)]
+                                    [:td.answer tv]]))
+                               (:tags answer))]])))
+     (repeat? field) (if (empty? answer)
+                       ""
+                       (str "Repeated data with " (count answer) " answers."))
+     :else answer)))

 (defn relabel-meta-field
   "Try and produce a label for meta field if non-existent."


added a TODO in ea

added a TODO in ea

--- src/forex/ea.clj
+++ src/forex/ea.clj
@@ -3,6 +3,8 @@
 ;;TODO: make convenient macros for ea function; do on bar, intra bar, etc.
 ;;TODO: integrate mmemail to send email alerts
 ;;TODO: make debugging simple: statuses, etc.
+					;TODO: multiple connections, and this means no indicator serving and that it automatically manages any scalping trades
+
 (defonce *ea* (atom {}))
 (defn bar-id [] (open))


Fix typo

Fix typo

--- src/squelch/audio_buffer.cljs
+++ src/squelch/audio_buffer.cljs
@@ -46,13 +46,10 @@
   "Copies the samples from the specified channel of the AudioBuffer to the
   destination array."
   ([buffer destination channel-number]
-   (.copyFromChannelbbuffer buffer destination channel-number))
+   (.copyFromChannel buffer destination channel-number))

   ([buffer destination channel-number start-in-channel]
-   (.copyFromChannelbbuffer buffer
-                            destination
-                            channel-number
-                            start-in-channel)))
+   (.copyFromChannel buffer destination channel-number start-in-channel)))

 (defn copy-to-channel
   "Copies the samples to the specified channel of the AudioBuffer, from the


look for .markdown extension in task

look for .markdown extension in task

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -42,7 +42,7 @@
         tmp (boot/tmp-dir!)
         options (merge +markdown-defaults+ *opts*)]
     (boot/with-pre-wrap fileset
-      (let [markdown-files (->> fileset boot/user-files (boot/by-ext [".md"]) (map #(.getPath (boot/tmp-file %))))]
+      (let [markdown-files (->> fileset boot/user-files (boot/by-ext ["md" "markdown"]) (map #(.getPath (boot/tmp-file %))))]
         (pod/with-call-in @pod
           (io.perun.markdown/parse-markdown
             ~(.getPath tmp)


Minor chanes on ducksboard service.

Minor chanes on ducksboard service.

--- src/subprocess/ducksboard.clj
+++ src/subprocess/ducksboard.clj
@@ -32,25 +32,30 @@
   []
   (binding [*token*       (util/system-property "ducksboard.token")
             *sleep-time*  (util/system-property "ducksboard.interval" "60000")]
-    (if (nil? *token*)
-      (println "Ducksboard token is not set, disabling service.")
-      (let [options {:basic-auth [*token* "unused"]}]
-        (println (format "Ducksboard service enabled with interval of %s msecs." *sleep-time*))
-        (loop []
-          (let [data      (deref pf/hosts-data)
-                data-in   (data->ducksboard data :in)
-                data-out  (data->ducksboard data :out)]
+    (let [options {:basic-auth [*token* "unused"]}]
+      (loop []
+        (let [data      (deref pf/hosts-data)
+              data-in   (data->ducksboard data :in)
+              data-out  (data->ducksboard data :out)]

-            ;; (http/post "https://push.ducksboard.com/v/266990"
-            ;;            (assoc options :body (json/write-str data-in)))
-            ;; (http/post "https://push.ducksboard.com/v/268310"
-            ;;            (assoc options :body (json/write-str data-out)))
-            (http/post "https://push.ducksboard.com/v/268401"
-                       (assoc options :body (json/write-str data-in)))
-            (http/post "https://push.ducksboard.com/v/268402"
-                       (assoc options :body (json/write-str data-out)))
-            (util/sleep (Integer/parseInt *sleep-time*)))
-          (recur))))))
+          (util/sleep (Integer/parseInt *sleep-time*))
+
+          (if (nil? *token*)
+            (do
+              (println "Ducksboard token is not set, disabling service.")
+              (println :in (json/write-str data-in))
+              (println :out (json/write-str data-out)))
+
+            (do
+              ;; (http/post "https://push.ducksboard.com/v/266990"
+              ;;            (assoc options :body (json/write-str data-in)))
+              ;; (http/post "https://push.ducksboard.com/v/268310"
+              ;;            (assoc options :body (json/write-str data-out)))
+              (http/post "https://push.ducksboard.com/v/268401"
+                         (assoc options :body (json/write-str data-in)))
+              (http/post "https://push.ducksboard.com/v/268402"
+                         (assoc options :body (json/write-str data-out))))))
+        (recur)))))

 (defn start-ducksboard
   []


Revert "CMR-688: Added personnel to UMM collections and initial DIF support. Mistakenly used upcoming DIF schema for Personnel. Need to revert to old schema."

This reverts commit ceb2acc6d48d2fb93a1b65282bced188ba4a6fb6.

--- umm-lib/src/cmr/umm/dif/collection/personnel.clj
+++ umm-lib/src/cmr/umm/dif/collection/personnel.clj
@@ -1,99 +0,0 @@
-(ns cmr.umm.dif.collection.personnel
-  "Provides functions to parse and generate DIF Personnel elements."
-  (:require [clojure.data.xml :as x]
-            [cmr.common.xml :as cx]
-            [cmr.umm.collection :as c]))
-
-(defn xml-elem->Phone
-  [phone-element]
-  (let [number (cx/string-at-path phone-element [:Number])
-        num-type (cx/string-at-path phone-element [:Type])]
-    (c/map->Phone {:number number
-                   :number-type num-type})))
-
-(defn xml-elem->Address
-  [addr-element]
-  (let [city (cx/string-at-path addr-element [:City])
-        state-province (cx/string-at-path addr-element [:State_Province])
-        country (cx/string-at-path addr-element [:Country])
-        postal-code (cx/string-at-path addr-element [:Postal_Code])
-        street-address-lines (cx/strings-at-path addr-element [:Street_Address])]
-    (c/map->Address {:city city
-                     :state-province state-province
-                     :country country
-                     :postal-code postal-code
-                     :street-address-lines street-address-lines})))
-
-(defn xml-elem->ContactPerson
-  [person-element]
-  (let [first-name (cx/string-at-path person-element [:First_Name])
-        middle-name (cx/string-at-path person-element [:Middle_Name])
-        last-name (cx/string-at-path person-element [:Last_Name])
-        addresses (map xml-elem->Address
-                       (cx/elements-at-path
-                         person-element
-                         [:Address]))
-        phones (map xml-elem->Phone
-                    (cx/elements-at-path
-                      person-element
-                      [:Phone]))
-        emails (cx/strings-at-path person-element [:Email])]
-    (c/map->ContactPerson {:first-name first-name
-                           :middle-name middle-name
-                           :last-name last-name
-                           :addresses addresses
-                           :phones phones
-                           :emails emails})))
-
-(defn xml-elem->personnel
-  [collection-element]
-  (let [personnel-element (cx/element-at-path collection-element [:Personnel])
-        roles (cx/strings-at-path personnel-element [:Role])
-        contacts (map xml-elem->ContactPerson
-                      (cx/elements-at-path
-                        personnel-element
-                        [:Contact_Person]))
-        contacts (for [index (range (count contacts))]
-                   (assoc (nth contacts index) :role (nth roles index)))]
-    (not-empty contacts)))
-
-(defn generate-phone
-  [phone]
-  (let [{:keys [number number-type]} phone]
-    (x/element :Phone {}
-               (x/element :Number {} number)
-               (x/element :Type {} number-type))))
-
-(defn generate-address
-  [address]
-  (let [{:keys [city state-province country postal-code street-address-lines]} address]
-    (x/element :Address {}
-               (x/element :City {} city)
-               (for [line street-address-lines]
-                 (x/element :Street_Address {} line))
-               (x/element :State_Province {} state-province)
-               (x/element :Postal_Code {} postal-code)
-               (x/element :Country {} country))))
-
-(defn generate-contact-person
-  [contact-person]
-  (let [{:keys [first-name middle-name last-name addresses phones emails]} contact-person]
-    (x/element :Contact_Person {}
-               (when first-name
-                 (x/element :First_Name {} first-name))
-               (when middle-name
-                 (x/element :Middle_Name {} middle-name))
-               (x/element :Last_Name {} last-name)
-               (map generate-address addresses)
-               (map generate-phone phones)
-               (for [email emails]
-                 (x/element :Email {} email)))))
-
-(defn generate-personnel
-  [personnel]
-  (when (not-empty personnel)
-    (x/element :Personnel {}
-               (for [contact-person personnel]
-                 (x/element :Role {} (:role contact-person)))
-               (for [contact-person personnel]
-                 (generate-contact-person contact-person)))))


add random integration

add random integration

--- src/wb_es/web/integration.clj
+++ src/wb_es/web/integration.clj
@@ -64,4 +64,8 @@
       (assoc response :body {:count count}))))

 (defn wrap-random [handler]
-  handler)
+  (fn [request]
+    (let [response (handler request)]
+      (assoc response :body (->> (get-in response [:body :hits :hits])
+                                 (first)
+                                 (get-obj))))))


remove error from metadata print

remove error from metadata print

--- kafka-clj/src/kafka_clj/metadata.clj
+++ kafka-clj/src/kafka_clj/metadata.clj
@@ -169,7 +169,7 @@
                            (try
                              (send-recv-metadata-request conn conf)
                              (catch IndexOutOfBoundsException ie (do
-                                                                   (warn "Error in reading medata from producer " conn " error: " ie)
+                                                                   (warn "Error in reading medata from producer " (dissoc conn :error) " error: " ie)
                                                                    nil))
                              (catch Exception e (do
                                                   (error "Error retreiving metadata " e)


Improve error-boundary test

Improve error-boundary test


Fix docstring

Fix docstring

--- src/str/core.clj
+++ src/str/core.clj
@@ -241,7 +241,7 @@
           s)))))

 (defn ^String contains?
-  "Retuns s if s contains needle."
+  "Return s if s contains needle."
   ([^String s ^String needle]
    (case-sensitive-contains s needle))
   ([^String s ^String needle ignore-case]


getter

getter

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -935,3 +935,7 @@
   (let [l (count (Integer/toString (apply max b) 2))
         frm (str "~" l ",'0B")]
     (map #(clojure.pprint/cl-format nil frm %) b)))
+
+(defn f [b line cnt]
+  (for (i (range (/ (- (count line) cnt) 2) (count line))) [i line]))
+


Fix spacing in runtests

Fix spacing in runtests

--- src/test/clojure/lazytest/runtests.clj
+++ src/test/clojure/lazytest/runtests.clj
@@ -7,7 +7,7 @@
 	      lazytest.stub-asserts
 	      lazytest.describe-asserts
 	      lazytest.readme-examples]]
-  (println "Running assertions in " sym)
+  (println "Running assertions in" sym)
   (require sym))

 (println "All assertions passed.")


include timing for JSON.stringify, not completely fair as transit write does a lot more, but still somewhat informative

--- bench/transit/bench.cljs
+++ bench/transit/bench.cljs
@@ -9,24 +9,30 @@
 (def r (t/reader :json))
 (def w (t/writer :json))

-(println "100 iters, transit read seattle file")
-(println (. r (read json)))
+(println "100 iters, transit read seattle data")
+(println (.read r json))
 (time
   (dotimes [_ 100]
     (.read r json)))

-(println "100 iters, JSON.parse seattle file")
+(println "100 iters, JSON.parse seattle ata")
 (time
   (dotimes [_ 100]
     (.parse js/JSON json)))

-(println "100 iters, transit write seattle file")
-(let [seattle (. r (read json))]
+(println "100 iters, transit write seattle data")
+(let [seattle (.read r json)]
   (time
     (dotimes [_ 100]
       (.write w seattle))))

-(println "10 iters, cljs.reader/read-string seattle file")
+(println "100 iters, JSON.stringify seattle data")
+(let [seattle (.parse js/JSON json)]
+  (time
+    (dotimes [_ 100]
+      (.stringify js/JSON seattle))))
+
+(println "10 iters, cljs.reader/read-string seattle data")
 (def edn (pr-str (.read r json)))
 (time
   (dotimes [_ 10]


Read deps.edn directly

Read deps.edn directly

--- build.boot
+++ build.boot
@@ -1,19 +1,38 @@
-(set-env!
-  :dependencies '[[adzerk/boot-cljs "2.1.4" :scope "test"]
-                  [javax.xml.bind/jaxb-api "2.3.0" :scope "test"]
-                  [seancorfield/boot-tools-deps "0.1.4" :scope "test"]
-                  [orchestra "2017.11.12-1" :scope "test"]]
-  :repositories (conj (get-env :repositories)
-                  ["clojars" {:url "https://clojars.org/repo/"
-                              :username (System/getenv "CLOJARS_USER")
-                              :password (System/getenv "CLOJARS_PASS")}]))
+(defn read-deps-edn [aliases-to-include]
+  (let [{:keys [paths deps aliases]} (-> "deps.edn" slurp clojure.edn/read-string)
+        deps (->> (select-keys aliases aliases-to-include)
+                  vals
+                  (mapcat :extra-deps)
+                  (into deps)
+                  (reduce
+                    (fn [deps [artifact info]]
+                      (if-let [version (:mvn/version info)]
+                        (conj deps
+                          (transduce cat conj [artifact version]
+                            (select-keys info [:scope :exclusions])))
+                        deps))
+                    []))]
+    {:dependencies deps
+     :source-paths (set paths)
+     :resource-paths (set paths)}))
+
+(let [{:keys [source-paths resource-paths dependencies]} (read-deps-edn [])]
+  (set-env!
+    :source-paths source-paths
+    :resource-paths resource-paths
+    :dependencies (into '[[adzerk/boot-cljs "2.1.4" :scope "test"]
+                          [javax.xml.bind/jaxb-api "2.3.0" :scope "test"]
+                          [orchestra "2017.11.12-1" :scope "test"]]
+                        dependencies)
+    :repositories (conj (get-env :repositories)
+                    ["clojars" {:url "https://clojars.org/repo/"
+                                :username (System/getenv "CLOJARS_USER")
+                                :password (System/getenv "CLOJARS_PASS")}])))

 (require
   '[orchestra.spec.test :refer [instrument]]
-  '[clojure.edn :as edn]
   '[adzerk.boot-cljs :refer [cljs]]
-  '[clojure.java.io :as io]
-  '[boot-tools-deps.core :refer [deps]])
+  '[clojure.java.io :as io])

 (task-options!
   sift {:include #{#"\.jar$"}}
@@ -21,19 +40,7 @@
        :version "2.5.8-SNAPSHOT"
        :description "An IDE for Clojure"
        :url "https://github.com/oakes/Nightcode"
-       :license {"Public Domain" "http://unlicense.org/UNLICENSE"}
-       :dependencies (->> "deps.edn"
-                          slurp
-                          edn/read-string
-                          :deps
-                          (reduce
-                            (fn [deps [artifact info]]
-                              (if-let [version (:mvn/version info)]
-                                (conj deps
-                                  (transduce cat conj [artifact version]
-                                    (select-keys info [:scope :exclusions])))
-                                deps))
-                            []))}
+       :license {"Public Domain" "http://unlicense.org/UNLICENSE"}}
   push {:repo "clojars"}
   aot {:namespace '#{nightcode.core
                      nightcode.lein}}
@@ -44,7 +51,6 @@

 (deftask run []
   (comp
-    (deps)
     (aot)
     (with-pass-thru _
       (require '[nightcode.core :refer [dev-main]])
@@ -59,11 +65,11 @@
     #"(?i)^META-INF\\INDEX.LIST$"))

 (deftask build []
-  (comp (deps) (aot) (pom) (uber :exclude jar-exclusions) (jar) (sift) (target)))
+  (comp (aot) (pom) (uber :exclude jar-exclusions) (jar) (sift) (target)))

 (deftask build-cljs []
+  (set-env! :dependencies #(into (set %) (:dependencies (read-deps-edn [:cljs]))))
   (comp
-    (deps :aliases [:cljs])
     (cljs :optimizations :advanced)
     (target)
     (with-pass-thru _
@@ -71,10 +77,8 @@
       (.renameTo (io/file "target/public/codemirror.js") (io/file "resources/public/codemirror.js")))))

 (deftask local []
-  (set-env! :resource-paths #{"src/clj" "src/cljs"})
   (comp (pom) (jar) (install)))

 (deftask deploy []
-  (set-env! :resource-paths #{"src/clj" "src/cljs"})
   (comp (pom) (jar) (push)))


Fix typo.

Fix typo.

--- src/oc/storage/representations/org.clj
+++ src/oc/storage/representations/org.clj
@@ -67,8 +67,8 @@
   [orgs authed?]
   (let [links [(hateoas/self-link "/" {:accept mt/org-collection-media-type})]
         full-links (if authed?
-                      (conj self-link (hateoas/create-link "/orgs/" {:content-type mt/org-media-type
-                                                                     :accept mt/org-media-type}))
+                      (conj links (hateoas/create-link "/orgs/" {:content-type mt/org-media-type
+                                                                 :accept mt/org-media-type}))
                 links)]
     (json/generate-string
       {:collection {:version hateoas/json-collection-version


Compensating for multiline inputs

Compensating for multiline inputs

This is a hack; the correct line numbers should be coming out of the
API, but it's easier to fix here than further up

--- src/org/knotation/editor/line_map.cljs
+++ src/org/knotation/editor/line_map.cljs
@@ -10,17 +10,21 @@
   (:map
    (reduce
     (fn [memo elem]
+
       (let [ed (if (= ::st/graph-end (::st/event elem)) (+ 1 (:ed memo)) (:ed memo))
             in (::st/line-number (::st/input elem))
             out (::st/line-number (::st/output elem))
+            lns (count (::st/lines (::st/input elem)))
+            comp (:compensate memo)
             m (:map memo)]
         {:ed ed
+         :compensate (if (> lns 1) (+ (dec lns) comp) comp)
          :map (if (and in out)
                 (update-in
-                 (update-in m [ed (dec in)] #(conj (or % #{}) [:out (dec out)]))
-                 [:out (dec out)] #(conj (or % #{})  [ed (dec in)]))
+                 (update-in m [ed (dec in)] #(conj (or % #{}) [:out (+ comp (dec out))]))
+                 [:out (+ comp (dec out))] #(conj (or % #{})  [ed (dec in)]))
                 m)}))
-    {:ed 0 :map {}}
+    {:ed 0 :compensate 0 :map {}}
     compiled)))

 (defn lookup


JSON should be prefixed with js/

JSON should be prefixed with js/

--- src/lt/objs/plugins.cljs
+++ src/lt/objs/plugins.cljs
@@ -216,7 +216,7 @@
     cache))

 (defn save-cache [cache]
-  (files/save metadata-cache (JSON/stringify (clj->js cache))))
+  (files/save metadata-cache (js/JSON.stringify (clj->js cache))))

 (defn latest-metadata-sha []
   (fetch/xhr [:get metadata-commits] {}
@@ -252,7 +252,7 @@
   (if (files/exists? metadata-cache)
     (-> (files/open-sync metadata-cache)
         (:content)
-        (JSON/parse)
+        (js/JSON.parse)
         (js->clj :keywordize-keys true))))

 (defn search-plugins [plugins search]


Add insertR* tests.

Add insertR* tests.


Tundra: fix bad test setup fn

Tundra: fix bad test setup fn

--- test/taoensso/carmine/tests/tundra.clj
+++ test/taoensso/carmine/tests/tundra.clj
@@ -26,10 +26,10 @@

 (defn- before-run {:expectations-options :before-run} []
   (println "Setting up testing environment...")
-  (tfar/ensure-table creds
-    {:name        ttable
-     :throughput  {:read 1 :write 1}
-     :block?      false})
+  (tfar/ensure-table creds ttable [:key-ns :s]
+    {:range-keydef [:redis-key :s]
+     :throughput   {:read 1 :write 1}
+     :block?       true})
   (cleanup)
   (println "Ready to roll..."))

@@ -64,4 +64,4 @@
                  (car/mget :k1 :k2 :k3)))

 (expect Exception (wcar {} (ensure-ks tstore :kinvalid)))
-(expect Exception (wcar {} (dirty     tstore :kinvalid)))+(expect Exception (wcar {} (dirty     tstore :kinvalid)))


Use optional param in test-operation fn

Use optional param in test-operation fn

--- test/app/test/interactive.clj
+++ test/app/test/interactive.clj
@@ -51,7 +51,7 @@
 ;; the operations that require one).

 ;; All the operations can be tested in the same way.
-(defn- test-operation [op-command operation threshold]
+(defn- test-operation [op-command operation & [threshold]]
   (let [javaparser-cus {:cus (take 2 (cus javaparser-cus-path))}
         first-command (if threshold
                         (str op-command " th " threshold)
@@ -73,7 +73,7 @@
   (test-operation "mcp" constructorsWithManyParametersOp 3))

 (deftest can-execute-f-operation
-  (test-operation "f" finalizersOp nil))
+  (test-operation "f" finalizersOp))

 (deftest can-execute-st-operation
-  (test-operation "st" classesAndSingletonTypeOp nil))
+  (test-operation "st" classesAndSingletonTypeOp))


Namespace-qualify

Namespace-qualify

--- modules/core/src/main/clojure/immutant/codecs.clj
+++ modules/core/src/main/clojure/immutant/codecs.clj
@@ -71,7 +71,7 @@
               ois (java.io.ObjectInputStream. bais)]
     (.readObject ois)))

-(defmethod print-dup :default [o ^java.io.Writer w]
+(defmethod clojure.core/print-dup :default [o ^java.io.Writer w]
   (.println System/out (str "WARN: using Java serialization for " (.getName (class o))))
   (.write w "#=(immutant.codecs/deserialize ")
   (print-dup (serialize o) w)


om -> cellophane

om -> cellophane

--- test/cellophane/next_test.clj
+++ test/cellophane/next_test.clj
@@ -1,6 +1,6 @@
 (ns cellophane.next-test
   (:require [clojure.test :refer [deftest testing is are]]
-            [cellophane.next :as om :refer [defui]]))
+            [cellophane.next :as cellophane :refer [defui]]))

 (defui SimpleComponent
   Object
@@ -10,10 +10,10 @@
     (dom/div nil "Hello World")))

 (defui ComponentWithStatics
-  static om/Ident
+  static cellophane/Ident
   (ident [this props]
     [:by-id 42])
-  static om/IQuery
+  static cellophane/IQuery
   (query [this]
     [:foo]))


eq between 2 fn calls & literal for infix->dsl


CW + AB | 22 | add logout functional test link

--- src/stonecutter_client/view/voting.clj
+++ src/stonecutter_client/view/voting.clj
@@ -7,7 +7,7 @@
   (let [user-email (get-in request [:session :user])]
     (html/at enlive-m
              [:.clj-user] (html/content user-email)
-             [:.clj-logout] (html/html-content "logout"))))
+             [:.clj-logout] (html/html-content "logout"))))

 (defn voting-page [request]
   (->> (vh/load-template "public/poll.html")


Channel item edit on click

Channel item edit on click

--- src/app/ctl.cljs
+++ src/app/ctl.cljs
@@ -53,11 +53,25 @@
     "hidden"))

-(defn data-item [items channel]
-  (for [item items]
-    [:div
-     [:span item]
-     [:button {:on-click #(dispatch-sync [:delete item channel])} "D"]]))
+(defn data-item [item channel]
+  (let [editing (atom true)
+        channels (subscribe [:channels])]
+    (fn []
+      @channels
+      [:div
+       (if @editing
+         [title-edit {:title item
+                      :on-save #(dispatch-sync [:channel-update-item @channel item %])
+                      :on-stop #(reset! editing false)}]
+         [:span {:on-click #(reset! editing (not @editing))} item])
+       [:button {:on-click #(dispatch-sync [:delete item @channel])} "D"]])))
+
+(defn data-items [items channel]
+  (let [items (reaction (:items @channel))] ;;items update but not on the screen for some reason
+    (fn []
+      [:ul
+       (for [item @items]
+         [data-item item channel])])))

 (defn channel-title [{:keys [title i channels]}]
   (let [editing (atom false)]
@@ -93,7 +107,7 @@
                        :on-drop (fn [e] (.preventDefault e)
                                   (let [tree (.getData (.-dataTransfer e) "text")]
                                     (dispatch-sync [:import tree @active-channel])))}]
-         [".datalist li" :* (data-item (:items @active-channel) @active-channel) ]
+         [".datalist" [data-items (:items @active-channel) active-channel] ]
          [".nav-tabs li" :* (data-tab-item channels @active-list-idx) ]
          [".nav-tabs a"
           ]


remove cake.ant

remove cake.ant

--- src/cake/ant.clj
+++ src/cake/ant.clj
@@ -1,139 +0,0 @@
-(ns cake.ant
-  "Lancet-inspired ant helpers."
-  (:use cake
-        [cake.file :only [file]]
-        [bake.core :only [debug?]]
-        [clojure.string :only [join]])
-  (:import [org.apache.tools.ant Project NoBannerLogger]
-           [org.apache.tools.ant.types Path FileSet ZipFileSet EnumeratedAttribute Environment$Variable]
-           [org.apache.tools.ant.taskdefs Echo Javac Manifest Manifest$Attribute]
-           [java.beans Introspector]
-           [java.io PrintStream]))
-
-
-(def #^{:dynamic true} *ant-project* nil)
-
-(defmulti coerce (fn [type val] [type (class val)]))
-
-(defn- property-key [property]
-  (keyword (.. (re-matcher #"\B([A-Z])" (.getName property))
-               (replaceAll "-$1")
-               toLowerCase)))
-
-(defn- property-setters [class]
-  (reduce
-   (fn [map property]
-     (assoc map (property-key property) (.getWriteMethod property)))
-   {} (.getPropertyDescriptors (Introspector/getBeanInfo class)))  )
-
-(defn- set-attributes! [instance attrs]
-  (let [setters (property-setters (class instance))]
-    (doseq [[key val] attrs]
-      (if-let [setter (setters key)]
-        (when-not (nil? val)
-          (let [type (first (.getParameterTypes setter))]
-            (.invoke setter instance (into-array [(coerce type val)]))))
-        (throw (Exception. (str "property not found for " key)))))))
-
-(def defaults
-  {Javac {:includeantruntime false}})
-
-(defn make*
-  ([class attrs]
-     (let [attrs (merge (defaults class) attrs)]
-       (doto (make* class)
-         (set-attributes! attrs))))
-  ([class]
-     (let [signature (into-array Class [Project])]
-       (try (.newInstance (.getConstructor class signature)
-              (into-array [*ant-project*]))
-            (catch NoSuchMethodException e
-              (let [instance (.newInstance class)]
-                (try (.invoke (.getMethod class "setProject" signature)
-                              instance (into-array [*ant-project*]))
-                     (catch NoSuchMethodException e))
-                instance))))))
-
-(defmacro make [task attrs & forms]
-  `(doto (make* ~task ~attrs)
-     ~@forms))
-
-(defmacro ant [task attrs & forms]
-  `(doto (make* ~task ~attrs)
-     ~@forms
-     (.setTaskName (if *current-task* (name *current-task*) "null"))
-     (.execute)))
-
-(defn get-reference [ref-id]
-  (.getReference *ant-project* ref-id))
-
-(defn add-fileset [task attrs]
-  (let [attrs (merge {:error-on-missing-dir false} attrs)]
-    (.addFileset task (make FileSet attrs))))
-
-(defn add-zipfileset [task attrs]
-  (let [attrs (merge {:error-on-missing-dir false} attrs)]
-    (.addFileset task (make ZipFileSet attrs))))
-
-(defn fileset-seq [fileset]
-  (if (map? fileset)
-    (fileset-seq (make FileSet (merge fileset {:error-on-missing-dir false})))
-    (map #(.getFile %) (iterator-seq (.iterator fileset)))))
-
-(defn add-manifest [task attrs]
-  (let [manifest (Manifest.)]
-    (doseq [[key val] attrs :when (seq val)]
-      (.addConfiguredAttribute manifest (Manifest$Attribute. key val)))
-    (.addConfiguredManifest task manifest)))
-
-(defn path [& paths]
-  (let [path (Path. *ant-project*)]
-    (doseq [p paths]
-      (let [p (if (instance? java.io.File p) (.getPath p) p)]
-        (if (.endsWith p "*")
-          (add-fileset path {:includes "*.jar" :dir (subs p 0 (dec (count p)))})
-          (.. path createPathElement (setPath p)))))
-    path))
-
-(defn classpath [& paths]
-  (apply path "src" "lib/*" "dev" "lib/dev/*" paths))
-
-(defn args [task & args]
-  (doseq [a (remove nil? (flatten args))]
-    (.. task createArg (setValue a))))
-
-(defn argline [task args]
-  (.. task createArg (setLine args)))
-
-(defn sys [task map]
-  (doseq [[key val] map]
-    (.addSysproperty task
-     (make Environment$Variable {:key (name key) :value val}))))
-
-(defn env [task map]
-  (doseq [[key val] map]
-    (.addEnv task
-     (make Environment$Variable {:key (name key) :value val}))))
-
-(defn init-project [outs]
-  (make Project {:basedir *root*}
-        (.init)
-        (.addBuildListener
-         (make NoBannerLogger
-               {:message-output-level (if (debug?) Project/MSG_VERBOSE Project/MSG_INFO)
-                :output-print-stream  outs
-                :error-print-stream   outs}))))
-
-(defmacro in-project [outs & forms]
-  `(binding [*ant-project* (init-project (PrintStream. ~outs))]
-     ~@forms))
-
-(defmethod coerce [java.io.File String] [_ str] (file str))
-(defmethod coerce :default [type val]
-  (if (= String type)
-    (str val)
-    (if (= EnumeratedAttribute (.getSuperclass type))
-      (make type {:value val})
-      (try (cast type val)
-           (catch ClassCastException e
-             val)))))


Minor refactor.

Minor refactor.

--- Spraff/src/spraff/core.clj
+++ Spraff/src/spraff/core.clj
@@ -23,14 +23,18 @@
 (def prefix-length 3)
 (def retries 3)

+(defn compare-mixed [a b]
+    "Can compare strings with keywords"
+    (let [r (compare (keyword? a) (keyword? b))]
+        (if (zero? r)
+            (compare a b)
+            r)))
+
 (defn compare-mixed-seqs [[a & as] [b & bs]]
     "Can compare sequences containing keyword or strings"
-    (let [r (compare (keyword? a) (keyword? b))]
-        (if (zero? r)
-            (let [r (compare a b)]
-                (if (and (zero? r) (not (and (empty? as) (empty? bs))))
-                    (recur as bs)
-                    r))
+    (let [r (compare-mixed a b)]
+        (if (and (zero? r) (not (and (empty? as) (empty? bs))))
+            (recur as bs)
             r)))

 (def empty-state {


refine extended trading actions tests

refine extended trading actions tests

--- test/clj_money/import/gnucash_test.clj
+++ test/clj_money/import/gnucash_test.clj
@@ -303,8 +303,9 @@
                                 :description "Transfer shares of AAPL"
                                 :action :transfer
                                 :shares 100M
+                                :value 1000M
                                 :from-account-id (:apple-401k ids)
-                                :to-account-id (:ira ids) ; or maybe :apple-ira?
+                                :to-account-id (:apple-ira ids)
                                 :items [{:action :debit
                                          :account-id (:apple-ira ids)
                                          :amount 1000M
@@ -321,13 +322,16 @@
                                 :items [{:action :debit
                                          :account-id (:apple-ira ids)
                                          ; TODO add some shares here
-                                         :amount 0M}
+                                         :amount 0M
+                                         :reconciled false}
                                         {:action :debit
                                          :account-id (:ira ids)
-                                         :amount 1M}
+                                         :amount 1M
+                                         :reconciled false}
                                         {:action :credit
                                          :account-id (:other-inc ids)
-                                         :amount 1M}]}]
+                                         :amount 1M
+                                         :reconciled false}]}]
         inv-account-ids (->> [:ira :apple-ira :401k :apple-401k]
                              (map #(% ids))
                              set)


Balancing population: creating villages

Balancing population: creating villages

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -15,6 +15,7 @@
 ; --------------------------------------

 (defrecord Tribe [id name language settlements])
+(defrecord Settlement [id name pop owner pos])
 (defrecord Game [next-id tribes settlements])

 ; --------------------------------------
@@ -33,13 +34,20 @@
 ; --------------------------------------

 (defn- create-tribe-in-game [game]
-  (let [next-id (.next-id game)
-        game (assoc game :next-id (inc next-id))
+  (let [id-tribe (.next-id game)
+        game (assoc game :next-id (inc id-tribe))
+        id-settlement (.next-id game)
+        game (assoc game :next-id (inc id-settlement))
         language nil
-        name nil
-        tribe (Tribe. next-id nil nil [])
-        game (assoc-in game [:tribes next-id] tribe)]
-      (println "Creating tribe [id " next-id "] name: " name)
+        name-tribe nil
+        name-settlement nil
+        pos {:x 0 :y 0}
+        settlement (Settlement. id-settlement name-settlement 100 id-tribe pos)
+        tribe (Tribe. id-tribe nil nil [id-settlement])
+        game (assoc-in game [:tribes id-tribe] tribe)
+        game (assoc-in game [:settlements id-settlement] settlement)]
+      (println "Creating tribe " tribe)
+      (println "Creating settlement " settlement)
     game))

 (defn create-tribe []
@@ -50,10 +58,14 @@
 ; --------------------------------------

 (defn total-pop []
-  0)
+  (reduce + (map :pop (vals (.settlements @game)))))

 (defn pop-balancer []
-  (println "Balancing population"))
+  (let [pop (total-pop)]
+    (println "Balancing population, total pop: " pop)
+    (if (< pop 1000)
+      (create-tribe)
+      (println "...nothing to do"))))

 (defn run-every-second [f]
   (future (Thread/sleep 1000)


notes

notes

--- src/angelic/search/action_set/gasplan2.clj
+++ src/angelic/search/action_set/gasplan2.clj
@@ -60,31 +60,94 @@
 ;; Last question, how to handle blind side effects
 ;; Skip it for now.

+
+;; MAYBE: do all the splitting and choosing at once?
+
+
+;; TODO: if there are side-effecting actions, might not want to choose a value just yet,
+;;       since we're not really goal directed anyway. -- except, fired actions encodes path?
+
+;; NOTE: directed doesn't work, e.g., for package in transport because of side effects...
+;;       this is as it should be -- suppose cap-1 truck.  May need to put down & re-pick.
+
+
+;; How auxilary works:
+;; Clearly, should prefer to pick canonical var child first,
+;;   and this should determine the child of auxiliary vars.
+;; This happens when listing possible children,
+;;   and when finding parents (consider as part of block edge).
+;; If we're greedily OK with canonical, not clear what to do. -- TODO: figure out
+
+
+
+;;;;;;;;;;;;;;;;;;;;; Misc TODOs
 ;; TODO: add clusters -- leave out for now.
 ;; TODO: add top-down, leave out for now.
-
-;; TODO: do all the splitting and choosing at once?
-
-
-;; TODO TODO: if children need same value, don't need to choose ?
+;; TODO: we can generate cyclic plans -- figure out how to avoid this.
+;; TODO: heuristic costs for commitments.  At minimum, heuristic is sum of min costs of action intentions.
+;; TODO: identify superflous resources -- i.e., over-capacity trucks.
+;; TODO: state abstraction / teleportation / generalized goal.
+
+
+;;;;;;;;;;;;;;;;;;;;; Partition ordering
+;; ** TODO: only work on preconditions of blocked actions if they can resolve
+;;       blocking of blocker
+;; TODO: consider depth-first ordering instead.  Tension between greedy and intention space size.
+
+
+;;;;;;;;;;;;;;;;;;;;; Child pruning
 ;; TODO: don't choose dead var as child?
-;; TODO: don't choose as child if current action will kill (i.e., final drop).
-
-;; TODO: if there are side-effecting actions, might not want to choose a value just yet,
-;; since we're not really goal directed anyway.
-;; TODO: ordering of prevail is funkified by hanging vars.
-;; TODO: we can generate cyclic plans -- figure out how to avoid this.
-
-;; TODO: directed doesn't work, e.g., for package in transport because of side effects...
-
-;; TODO: what if there are multiple actions on a var; some ready to fire, and some blocked?
-;; this will be a source, but we cannot proceed.
-;; need to split on this!
-;; Worse, can have none greedy and ones blocked on various things.
-;; Options are to split when blocking happens, always, or greedily execute just those that can.
-;; Wors
-
-;; TODO: think about if we should split when blocking happens
+;;       further: don't choose as child if current action will kill (i.e., final drop).
+;; TODO: prune children based on which values can actually be used next.  I.e., gripper in blocks world.
+;;       if all next actions require a variable p, plus
+;;       a different value on some other variable s.t. acheiving requires p,
+;;       this variable cannot be next child of p.
+;; TODO: additional child pruning.  If action has multiple prevails:
+;;    if p reserved for v with action a, a also needs u,
+;;    when selecting child for u, skip children where all
+;;    next actions that need u also need v.
+;;    Can be implemented with implied edges in VPG.
+;;     (this generalizes auxiliary notion?)
+;; TODO: if children need same value, don't need to choose ?
+
+
+;;;;;;;;;;;;;;;;;;;;; Auxiliary
+;; TODO: auxiliary -- use in selecting variables, not just children
+;;   note: if multiple auxiliaries for single canonical, don't necessarily want to
+;;         choose for canonical -- screws up greedy.
+;; TODO: don't allow reserving truck for capacity (??)
+;;       note: seems we must allow, since if t1 on p1, p1 wants t2 first,
+;;             prevail rules don't allow making tc1 parent of p1.
+;; TODO: should not even allow actions on capacity ?
+;; TODO: auxiliary -- don't even allow reservation of auxiliary?  Or actions on aux, if no self actions.
+;;      (sometimes need it, i.e., gas-up only at gas stations).
+
+;; How can we get around auxiliary reservation problem in nice way?
+;;  Can say, no reservy unless you own canonical.
+;;  This means you must be able to reserve canonical even if want value greedily.
+;;  If you don't own canonical, we don't generate the edge?  Or we remove it.
+;; This also prevents actions on capacity, since they need truck, which ....
+;; And auxiliary as child of canonical should be prevented by child pruning, based on this fact.
+
+
+
+;;;;;;;;;;;;;;;;;;;;; Action pruning
+;; TODO: object symmetries?
+;;       if parents are symmetric, don't need to choose between them...
+
+
+
+;; Suppose t1 reserved for p1, p1 wants t2 next.
+;; If we try to reserve capacity for p2, we fail.
+;; Notes: we actually should allow reserve capacity for p2,
+;;        since we could generate action for p1-t1 from p2?  Nope, can't.
+;; Case is covered by reserving t1 for tc1?  Seems OK.
+
+
+
+
+
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; States, (meta)primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -224,7 +287,8 @@
   (util/map-vals (partial map second) (group-by first (for [x s, k (f x)] [k x]))))

 ;; NOTE: could be much more efficient...
-;; TODO: possible block ...
+;; TODO: possible block?
+;; TODO: when part? is true, this can be much more efficient?
 (defn vpg-edge-map [s vars]
   (util/for-map [v vars]
    v
@@ -331,16 +395,18 @@
     (and (not (#{#{} :wait} actions ))
          (every? #(contains? (:effect-map %) v) actions))))

-
-
-(defn possible-children [s p child-map prevail-map]
-  (let [children (filter #(or (get-in prevail-map [p %]) (possible-scheduled-side-effector? s p %))
-                         (child-map p))
-        child (state/get-var s (child-var p))]
-    (if child
-      (do (assert (some #{child} children))
-          [child])
-      children)))
+;; TODO TODO TODO: must allow reserving for FUTURE action on other var.? blech.
+;; Idea was that we'd just add the action here directly.
+
+;; TODO: look at other precondition variables too?
+(defn possible-children [s p child-map prevail-map auxiliary-map]
+  (let [potential-children (or (when-let [c (state/get-var s (child-var p))] [c]) (child-map p))]
+    (filter #(or (get-in prevail-map [p %]) (possible-scheduled-side-effector? s p %))
+            (let [aux (when-let [av (auxiliary-map p)] (state/get-var s (child-var av)))]
+              (if (and aux (not (= aux p)))
+                (do (util/assert-is (some #{aux} potential-children))
+                    [aux])
+                potential-children)))))

 (defn var-at-target? [s v]
   (= (state/get-var s v) (target-value s v)))
@@ -366,6 +432,9 @@
   (some #(guaranteed-scheduled-side-effector? s v %)
         (keys (dissoc (:effect-map a) v))))

+
+(defn structural-partitions [actions]
+  (map set (vals (group-by (comp util/keyset :precond-map) actions))))

 ;; Here, need to worry about side effects.
 ;; If there are cycles that do not effect the reserving action
@@ -373,7 +442,7 @@
 ;; NOTE: we require that possible-actions-var is correct for vars other than v,
 ;;  but state may be otherwise inconsistent.
 ;;  (must take care, this happens in future state currently...)
-(defn make-possible-actions-fn [dtgs effect-cluster-map]
+(defn make-possible-actions-fn [dtgs effect-cluster-map pre-partition?]
   (let [simple-dtgs   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
         acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
     (fn [s v cur-val dst-val]
@@ -384,30 +453,41 @@
                               (apply concat (vals dtg))))]
         (concat
          (when (= cur-val dst-val) [#{}])
-         (when (seq actions) [(set actions)]))))))
+         (when (seq actions) (if pre-partition? (structural-partitions actions) [(set actions)])))))))

 (comment (util/singleton? (get effect-cluster-map v)))

 ;; TODO: where do happy belong?
-(defn bottom-up-expand-actions [s p c child-map prevail-map possible-actions-fn]
-  (assert (= :wait (state/get-var s (possible-actions-var p))))
-  (when-let [cur-c (state/get-var s (child-var p))] (assert (= cur-c c)))
-  (let [actions (state/get-var s (possible-actions-var c))
+;; TODO: better choice of unhappy child?
+(defn bottom-up-expand-actions [s p unhappy-children child-map prevail-map auxiliary-map possible-actions-fn]
+  (let [children                (possible-children s p child-map prevail-map auxiliary-map)
+        c                       (first (util/intersection (set children) (set unhappy-children)))
+        _ (util/assert-is (identity c) "%s" [s p unhappy-children children (do (clojure.inspector/inspect-tree (sort-by key s)) nil)])
+        actions (state/get-var s (possible-actions-var c))
         [concerned indifferent] (util/separate #(contains? (:precond-map %) p) actions)
         [happy unhappy]         (util/separate #(can-greedily-use? s % p c) concerned)
         lazy-set                (set (concat happy indifferent))]
-    (assert (seq unhappy))
+    (assert (= :wait (state/get-var s (possible-actions-var p))))
+    (when-let [cur-c (state/get-var s (child-var p))] (assert (= cur-c c)))
+    (assert (seq unhappy))
     (concat
      (when (seq lazy-set)
        [(make-set-actions-action c lazy-set)])
-     (for [other-c (remove #{c} (possible-children s p child-map prevail-map))]
+     (for [other-c (remove #{c} children)]
        (make-set-child-action p other-c))
      (for [[p-val wanting-actions] (prune-and-group-actions s p c unhappy)
            possible-next-actions (possible-actions-fn (state/set-var s (possible-actions-var c) (set wanting-actions))
                                                       p (state/get-var s p) p-val)]
        (make-bottom-up-expand-action s p c (set wanting-actions) possible-next-actions)))))

+;; NOTE: what if there are multiple actions on a var; some ready to fire, and some blocked?
+;; this will be a source, but we cannot proceed.
+;; need to split on this!
+;; Worse, can have none greedy and ones blocked on various things.
+;; Options are to split when blocking happens, always, or greedily execute just those that can.
+;; TODO: think about if we should split when blocking happens
+;; With part?, this is no longer an issue.
 (defn greedy-fire-actions [s v possible-actions-fn]
   (let [actions-by-block (group-by #(blocking-set s % v) (state/get-var s (possible-actions-var v)))]
     (assert (or (seq (actions-by-block #{})) (> (count actions-by-block) 1)))
@@ -418,8 +498,6 @@
            possible-next-actions (possible-actions-fn s v (util/safe-get (:effect-map a) v) (target-value s v))]
        (make-greedy-fire-action s a v possible-next-actions)))))

-(comment      (when (var-at-target? s v)
-       [(make-set-actions-action v #{})]))

 ;; TODO: auxiliary vars.

@@ -441,6 +519,7 @@
 #_  (println s))

+;; Hack to deal with hanging vars -- shouldn't be needed much when auxiliary handling added.
 (defn rejigger-prevail-cg [prevail-cg]
   (let [sinks (util/difference (set (map second prevail-cg)) (set (map first prevail-cg)))
         bad-sinks (disj sinks sas/goal-var-name)]
@@ -449,6 +528,16 @@
         [t f]
         [f t]))))

+;; TODO: fix auxiliary var mapping.
+
+;; TODO: improve
+(defn get-auxiliary-map [sas-problem]
+  (let [auxiliary-map (util/map-vals first (sas-analysis/auxiliary-vars sas-problem))]
+    (assert (graphs/dag? auxiliary-map))
+    auxiliary-map))
+
+
+

 ;; TODO: add assertions on precond var = effect var
 ;; Recall: greedy helps the most when, e.g., lots of passengers and not much room.
@@ -456,13 +545,9 @@
   "Make an actino-set planning environment.  Switches are:
     check-deadlock?: check for cycles in precedence graph above and beyond lack of sources
     check-components?: check for disconnected components, rule out sources outside of goal comp
-    edge-rule: :naive, :greedy, :sloppy, or :extra-sloppy.
-       Naive means we stick exactly to the simple semantics of the vanilla actions.
-       Greedy means we forget about reserving preconditions when free and we can fire right now (less branching).
-       Sloppy means we ignore if preconditions are free, but require no action on them.
-       Extra-sloppy means anything goes -- if you can execute ignoring commitments, go for it."
-  ([sas-problem & {:keys [directed? greedy? deadlock? dead-vars? components?] :as m
-                   :or   {directed? true greedy? true deadlock? true dead-vars? true components? false}}]
+    part?: initiall partition actions based on precondition variable set."
+  ([sas-problem & {:keys [directed? greedy? deadlock? dead-vars? components? part? aux?] :as m
+                   :or   {directed? true greedy? true deadlock? true dead-vars? true components? false part? true aux? true}}]
      (assert (every? #{:directed? :greedy? :deadlock? :dead-vars? :components?} (keys m)))
      (assert (= greedy? true))
      (let [edge-rule     (if greedy? :greedy :naive)
@@ -477,12 +562,21 @@
            tsi           (graphs/df-topological-sort-indices (rejigger-prevail-cg prevail-cg)) ;; way worse.
            prevail-cvm   (util/map-vals #(util/intersection (set %) vars)
                                         (graphs/edge-list->outgoing-map prevail-cg))
+
            dtgs          (sas-analysis/domain-transition-graphs sas-problem)
            effect-cluster-map (into {} (for [cluster (sas-analysis/effect-clusters sas-problem), v cluster] [v cluster]))
-           possible-actions-fn (make-possible-actions-fn dtgs effect-cluster-map)]
+           possible-actions-fn (make-possible-actions-fn dtgs effect-cluster-map part?)
+
+           auxiliary-map (if aux? (get-auxiliary-map sas-problem) {})
+           canonicalize  (fn [bu-map]
+                           (reduce (fn [bum k]
+                                     (if-let [nk (auxiliary-map k)]
+                                       (assoc (dissoc bum k) nk (util/union (get bum k) (get bum nk #{})))
+                                       bum))
+                                   (util/map-vals set bu-map) (keys bu-map)))]
 ;       (assert (graphs/dag? causal-graph))
                                         ;       (assert (sas-analysis/unary? sas-problem))
-       (println tsi)
+       (println tsi "\n" auxiliary-map)
        (doseq [a (:actions sas-problem)]
          (when-not (every? (partial contains? (:precond-map a)) (keys (:effect-map a)))
            (println (:name a) (apply dissoc (:effect-map a) (keys (:precond-map a))))))
@@ -498,7 +592,7 @@
           (if (and dead-vars? (uses-dead-vars? s av-map ))
             (do (util/print-debug 1 "Pruning due to dead vars") nil)
             (let [sources-by-type (source-vars-by-type s vars deadlock? components? )]
- ;;           (println sources-by-type)
+;              (println sources-by-type)
               (if sources-by-type
                 (util/prln-debug 2
                  (util/cond-let [sources]
@@ -506,8 +600,8 @@
                   (greedy-fire-actions s (first sources) possible-actions-fn)

                   (seq (get sources-by-type :bottom-up))
-                  (let [[p-var children] (apply max-key (comp tsi first) sources)] ;; min?
-                    (bottom-up-expand-actions s p-var (first children) child-var-map prevail-cvm possible-actions-fn))
+                  (let [[p-var children] (apply max-key (comp tsi first) (identity #_ canonicalize sources))]
+                    (bottom-up-expand-actions s p-var children child-var-map prevail-cvm auxiliary-map possible-actions-fn))

                   :else (do (util/assert-is (empty? sources-by-type) "%s" [(do (print-state s) (clojure.inspector/inspect-tree (state/as-map s))
                                                                                s)])
@@ -529,7 +623,7 @@

-;; (do (use 'angelic.env 'angelic.hierarchy 'angelic.search.textbook 'angelic.domains.taxi-infinite 'angelic.domains.sas-problems 'angelic.sas 'angelic.sas.analysis 'angelic.util 'angelic.sas.hm-heuristic 'angelic.search.interactive) (require '[angelic.search.action-set.gasplan2 :as gap2]))
+;; (do (use 'angelic.env 'angelic.hierarchy 'angelic.search.textbook 'angelic.domains.taxi-infinite 'angelic.domains.sas-problems 'angelic.sas 'angelic.sas.analysis 'angelic.util 'angelic.sas.hm-heuristic 'angelic.search.interactive) (require '[angelic.search.action-set.gasplan2 :as gap2] '[angelic.search.action-set.asplan-r :as rap]))

 ;; (let [e (force (nth ipc2-logistics 5)) ]  (println (time (run-counted #(ap/asplan-solution-pair-name (uniform-cost-search (ap/make-asplan-env e ))))))  (println (time (run-counted #(ap2/asplan-solution-pair-name (uniform-cost-search (ap2/make-asplan-env e )))))) (println (time (run-counted #(gap2/asplan-solution-pair-name (uniform-cost-search (gap2/make-asplan-env e )))))))

@@ -537,4 +631,6 @@

 ;; (let [e (force (nth ipc2-logistics 5)) ]  (println (time (run-counted #(uniform-cost-search e ))))  (println (time (run-counted #(gap/asplan-solution-pair-name (uniform-cost-search (gap/make-asplan-env e )))))) (println (time (run-counted #(gap2/asplan-solution-pair-name (uniform-cost-search (gap2/make-asplan-env e )))))))

-;; (let [e (second  (nth (sas-sample-problems 0) 11)) ] (println (time (debug 0 (run-counted #(gap2/asplan-solution-pair-name (interactive-search (gap2/make-asplan-env e ))))))))+;; (let [e (second  (nth (sas-sample-problems 0) 11)) ] (println (time (debug 0 (run-counted #(gap2/asplan-solution-pair-name (interactive-search (gap2/make-asplan-env e ))))))))
+
+;; (let [e (second  (nth (sas-sample-problems 0) 11)) ]  (println (time (run-counted #(uniform-cost-search e ))))   (println (time (run-counted #(rap/asplan-solution-pair-name (uniform-cost-search (rap/make-asplan-env e (fn [v] (= (first v) :capacity)) #{:drop} ))))))  (println (time (debug 0 (run-counted #(gap2/asplan-solution-pair-name (uniform-cost-search (gap2/make-asplan-env e ))))))))


Add notes on new impl

Add notes on new impl

--- src/angelic/search/implicit/dash_astar.clj
+++ src/angelic/search/implicit/dash_astar.clj
@@ -17,7 +17,7 @@
 ;; TODO: SP has hash table from (state-abstracted context) input set to stub (?).
 ;; TODO: stub has link back to parent SP
 ;; TODO: How are subsumption links handled?
-;;
+;; What if we create tree summarizer with stub ? ? ?   ?  ?? ? ?  ?  ? ?

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

@@ -148,7 +148,34 @@
 ;; TODO: we need to make sure tree sums get called on add-output! first to ensure
 ;;       consistency with top-down-bounds ?
 ;; TODO: top-down bound business does not actually help at all
+
 ;;  (except ensuring consistency if we're asserting it...)
+;; When we create a stub, we also get: tree summarizer, subsumption-thing.
+;; (subsumption-children are parent tree-summarizers).
+;; Subsumption-thing is subsumption-child of stub, summarizer, tree-summarizer.
+;; Tree-summarizers also remember best bound, this gives us consistency
+;; How do they pass to children, though?
+;; Apparent cycle -- tree summarizer has children that are child tree-summarizers,
+;; And, these children should have the parent TS as a subsumption child.
+;; Key: this is only to preserve info from original SP, subsumption..
+;; This info should go into subsumption-thing.
+;; Subsumption-thing is just ordinary max over children, + self, + TS?
+;; ->>(We rely on eager updates to make sure it gets updated?)
+
+;; TDB should not actually go into TS, children should be directly bounded?
+;; All children, including inner SP, should do it fine.
+;; This means that every thing has exactly one subsumption parent ... which is nice.
+;; How does consistency get approached ?
+;; We just have the cycle, but would be great if we didn't have to go in child --> ts --> st --> children
+;; cycle every time things to up -- maybe ST just doesn't update ord. parents.
+;; TODO: figure this out later.
+
+
+;; Can goall the way down to nearest sum, I guess...
+;; Subsumer gets attached to subsumer of any child (or inner child?)
+
+;; What do we do about multiple ways to express a given plan ? ? ? ?
+;; Can normalize or not, interesting question... start without.

 (defprotocol TreeSummarizer
   (top-down-bound    [s])


fix digest/from-file so it works from a jar

--- src/chat/server/digest.clj
+++ src/chat/server/digest.clj
@@ -11,10 +11,9 @@

 (defn from-file
   [f]
-  (let [file (io/file (io/resource f))]
-    (when (.exists file)
-      (-> file
-          slurp
-          sha256
-          Base64/encodeBase64
-          String.))))
+  (when-let [file (io/resource f)]
+    (-> file
+        slurp
+        sha256
+        Base64/encodeBase64
+        String.)))