Simplify managed-button

Simplify managed-button

Fixes add-projects button behaviors too.

--- frontend/components/forms.cljs
+++ frontend/components/forms.cljs
@@ -1,7 +1,5 @@
 (ns frontend.components.forms
-  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
-            [frontend.async :refer [put!]]
-            [frontend.components.common :as common]
+  (:require [frontend.components.common :as common]
             [frontend.utils :as utils :include-macros true]
             [frontend.disposable :as disposable :refer [dispose]]
             [om.core :as om :include-macros true])
@@ -21,116 +19,76 @@
 ;;         uuid frontend.async/*uuid*]
 ;;     (forms/release-button! uuid status)))

-(def registered-channels (atom {}))
+(def event-owners (atom {}))

-(defn register-channel! [owner]
-  (let [channel (chan)
-        uuid (utils/uuid)]
-    (swap! registered-channels assoc uuid channel)
-    (om/update-state! owner [:registered-channel-uuids] #(conj (set %) uuid))
-    {:channel channel :uuid uuid}))
-
-(defn deregister-channel! [owner uuid]
-  ;;XXX The `when is a hack to silently ignore updates to unmounted component state.
-  (om/update-state! owner [:registered-channel-uuids] #(when % (disj % uuid)))
-  (when-let [channel (get @registered-channels uuid)]
-    (swap! registered-channels dissoc uuid)
-    (close! channel)))
+(defn set-status!
+  "Updates the status of a managed button. Ignores updates if a new event is happening.
+  Updates to finished states (:success or :failure) are cleared back to :idle after a timeout."
+  [owner event-id status]
+  (when (.isMounted owner)
+    (om/update-state! owner (fn [state]
+                              (if (= (:event-id state) event-id)
+                                (assoc state :status status)
+                                state)))
+    (when (#{:success :failed} status)
+      (js/setTimeout #(set-status! owner event-id status :idle) 1000))))

 (defn release-button!
   "Used by the controls controller to set the button state. status should be a valid button state,
   :success, :failed, or :idle"
-  [uuid status]
-  (when-let [channel (get @registered-channels uuid)]
-    (put! channel status)))
-
-(defn append-cycle
-  "Adds the button-state to the end of the lifecycle"
-  [owner button-state]
-  (om/update-state! owner [:lifecycle] #(conj % button-state)))
+  [event-id status]
+  (when-let [owner (get @event-owners event-id)]
+    (swap! event-owners dissoc event-id)
+    (set-status! owner event-id status)))

 (defn wrap-managed-button-handler
-  "Wraps the on-click handler with a uuid binding and registers a global channel
-   so that the controls handler can communicate that it is finished with the button."
+  "Wraps the on-click handler with a uuid binding that enables release-button! to do it's thing. "
   [handler owner]
   (fn [& args]
-    (append-cycle owner :loading)
-    (let [{:keys [uuid channel]} (register-channel! owner)]
-      (binding [frontend.async/*uuid* uuid]
-        ;;XXX Async mutation of state may execute after dismount!
-        (go (append-cycle owner (<! channel))
-            (deregister-channel! owner uuid))
+    (let [event-id (utils/uuid)]
+      (swap! event-owners assoc event-id owner)
+      (om/set-state! owner {:event-id event-id :status :loading})
+      (binding [frontend.async/*uuid* event-id]
         (apply handler args)))))
-
-(defn schedule-idle
-  "Transistions the state from success/failed to idle."
-  [owner lifecycle]
-  ;; Clear timer, just in case. No harm in clearing nil or finished timers
-  (js/clearTimeout (om/get-state owner [:idle-timer]))
-  (let [cycle-count (count lifecycle)
-        t (js/setTimeout
-           ;; Careful not to transition to idle if the spinner somehow got
-           ;; back to a loading state. This shouldn't happen, but we'll be
-           ;; extra careful.
-           #(om/update-state! owner [:lifecycle]
-                              (fn [cycles]
-                                (if (= (count cycles) cycle-count)
-                                  (conj cycles :idle)
-                                  cycles)))
-           1000)]
-    (om/set-state! owner [:idle-timer] t)))

 (defn managed-button*
   "Takes an ordinary input or button hiccup form.
    Automatically disables the button until the controls handler calls release-button!"
   [hiccup-form owner]
   (reify
-    om/IDisplayName (display-name [_] "Managed button")
+
+    om/IDisplayName
+    (display-name [_] "Managed button")
+
     om/IInitState
     (init-state [_]
-      {:lifecycle [:idle]
-       :registered-channel-uuids #{}
-       :idle-timer nil})
-
-    om/IWillUnmount
-    (will-unmount [_]
-      (js/clearTimeout (om/get-state owner [:idle-timer]))
-      (doseq [uuid (om/get-state owner [:registered-channel-uuids])]
-        (deregister-channel! owner uuid)))
-
-    om/IWillUpdate
-    (will-update [_ _ {:keys [lifecycle]}]
-      (when (#{:success :failed} (last lifecycle))
-        (schedule-idle owner lifecycle)))
+      {:status :idle})

     om/IRenderState
-    (render-state [_ {:keys [lifecycle]}]
-      (let [button-state (last lifecycle)
-            [tag attrs & rest] hiccup-form
-            data-field (keyword (str "data-" (name button-state) "-text"))
+    (render-state [_ {:keys [status]}]
+      (let [[tag attrs & body] hiccup-form
+            data-field (keyword (str "data-" (name status) "-text"))
             new-value (-> (merge {:data-loading-text "..."
                                   :data-success-text "Saved"
                                   :data-failed-text "Failed"}
                                  attrs)
                           (get data-field (:value attrs)))
-            new-body (cond (= :idle button-state) rest
-                           (:data-spinner attrs) common/spinner
-                           :else new-value)
+            new-body (if (:data-spinner attrs)
+                       (if (= :loading status) common/spinner body)
+                       (if (= :idle status) body new-value))
             new-attrs (-> attrs
-                          ;; Disable the button when it's not idle
-                          ;; We're changing the value of the button, so its safer not to let
-                          ;; people click on it.
-                          (assoc :disabled (not= :idle button-state))
-                          (update-in [:class] (fn [c] (cond (= :idle button-state) c
+                          (assoc :disabled (= :loading status))
+                          (update-in [:class] (fn [c] (cond (not= :loading status) c
                                                             (string? c) (str c " disabled")
                                                             (coll? c) (conj c "disabled")
                                                             :else "disabled")))
                           (update-in [:on-click] wrap-managed-button-handler owner)
-                          (update-in [:value] (fn [v]
-                                                (or new-value v))))]
+                          (update-in [:value] #(or new-value %)))]
         (html
          (vec (concat [tag new-attrs]
-                      [new-body])))))))
+                      [new-body])))))
+
+    ))

 (defn managed-button
   "Takes an ordinary input or button hiccup form.


Test cases added

Test cases added

--- test/clinvar_submitter/core_test.clj
+++ test/clinvar_submitter/core_test.clj
@@ -1,20 +1,26 @@
 (ns clinvar-submitter.core-test
   (:require [clojure.test :refer :all]
-            [clinvar-submitter.core :refer :all]))
+            [clinvar-submitter.core :refer :all]
+            [clinvar-submitter.ld :as ld]
+            [clinvar-submitter.form :as form]))
+
+(def interp-path "data/dmwg2.json")
+(def context-path "data/context-new.jsonld")
+(def t (ld/generate-symbol-table interp-path context-path))
+(def m (vals t))
+(def interps ((ld/prop= t "VariantInterpretation" "type") m))
+(def i (first interps))
+(def variant (form/get-variant t i))
+(def expectedvalue (construct-variant t i))

 (deftest test-variant-table
   (testing "Test correctness of variant table construction"
-    (is (= '(["" "" "" "NC_000012.12" "" "" ""])
-           (construct-variant-table "data/test_interp_1.dmwg.json" "data/context-new.jsonld")))))
+    (is (= (map #(construct-variant t %) interps) (construct-variant-table interp-path context-path))
+    (println "Expectedvalue" (map #(construct-variant t %) interps)))))

-;(deftest test-xyz
-;  (testing "this is the description of what is being tested"
-;		 (is (= '([])
-;		        (functiontotest arg1 arg2 ...)))))
+(deftest test-variant-table
+  (testing "Testing correctness ovariant construction"
+    (is (= expectedvalue (construct-variant t i))
+    (println "Expectedvalue" expectedvalue))))

-
-
-
-;; (deftest a-test
-;;   (testing "FIXME, I fail."
-;;     (is (= 0 1))))
+(run-tests)


Add test for with-git-branch

Add test for with-git-branch

--- test/clj/lambdacd/steps/git_test.clj
+++ test/clj/lambdacd/steps/git_test.clj
@@ -29,6 +29,21 @@
                     "echo \"world\" > foo"
                     "git add -A"
                     "git commit -m \"some other message\"")
+    {:dir dir
+     :commits (git-commits dir)}))
+
+(defn create-test-repo-with-branch []
+  (let [dir (util/create-temp-dir)]
+    (util/bash dir
+               "git init"
+               "echo \"hello\" > foo"
+               "git add -A"
+               "git commit -m \"some message\""
+               "git branch develop"
+               "git checkout develop"
+               "echo \"world\" > bar"
+               "git add -A"
+               "git commit -m \"some other message\"")
     {:dir dir
      :commits (git-commits dir)}))

@@ -140,6 +155,29 @@
           with-git-result (with-git-function with-git-args (some-ctx))]
       (is (=  :failure (:status with-git-result)))
       (is (.contains (:out with-git-result) "some-unknown-uri" )))))
+
+(deftest with-git-branch-test
+  (testing "that it checks out the head revision for a given branch and then returns, indicating the location of the checked out repo as :cwd value and that the cloned repo is in a directory named like the repo that was cloned"
+    (let [create-output (create-test-repo-with-branch)
+          git-src-dir (:dir create-output)
+          commits (:commits create-output)
+          lastest-commit (last commits)
+          with-git-function (with-git-branch (repo-uri-for git-src-dir) "develop" [step-that-returns-the-current-cwd-head])
+          with-git-result (with-git-function {} (some-ctx))]
+      (is (= lastest-commit (:current-head (get (:outputs with-git-result ) [1 42]))))
+      (is (.startsWith (:out with-git-result) "Cloning"))))
+  (testing "that it fails when it couldn't check out a repository"
+    (let [with-git-function (with-git-branch "some-unknown-uri" "some-unknown-branch" [])
+          with-git-result (with-git-function {} (some-ctx))]
+      (is (=  :failure (:status with-git-result)))
+      (is (.contains (:out with-git-result) "some-unknown-uri" ))))
+  (testing "that it fails when it couldn't check out a branch"
+    (let [create-output (create-test-repo-with-branch)
+          git-src-dir (:dir create-output)
+          with-git-function (with-git-branch (repo-uri-for git-src-dir) "some-unknown-branch" [])
+          with-git-result (with-git-function {} (some-ctx))]
+      (is (=  :failure (:status with-git-result)))
+      (is (.contains (:out with-git-result) "some-unknown-branch" )))))

 (defn some-step-that-returns-42 [args ctx]
   {:status :success :the-number 42})


Unit tests for functions rest-api/get-building-jobs-url and rest-api/get-job-in-queue-url

--- test/emender_jenkins/config_test.clj
+++ test/emender_jenkins/config_test.clj
@@ -536,7 +536,7 @@
             (get-currently-building-view {:configuration {:jenkins {:currently-building-view nil}}}) nil
             (get-currently-building-view {:configuration {:jenkins {:currently-building-view false}}}) false
             (get-currently-building-view {:configuration {:jenkins {:currently-building-view true}}}) true
-            (get-currently-building-view {:configuration {:jenkins {:currently-building-view "Queue"}}}) "Queue")))
+            (get-currently-building-view {:configuration {:jenkins {:currently-building-view "Building"}}}) "Building")))

 (deftest test-get-currently-building-view-2
     "Check the behaviour of function emender-jenkins.config/get-currently-building-view."


Refactor for clarity

Refactor for clarity

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -174,14 +174,13 @@
   enterprise sites."
   [state parts]
   (let [ws-ch (get-in state [:comms :ws])
-        parts (assoc parts :container-index 0)]
-    (doseq [[messages channel] [[pusher/build-messages
-                                 (pusher/build-all-channel parts)]
-                                [(concat pusher/build-messages pusher/container-messages)
-                                 (pusher/obsolete-build-channel parts)]
-                                [pusher/container-messages
-                                 (pusher/build-container-channel parts)]]]
-      (put! ws-ch [:subscribe {:channel-name channel :messages messages}]))))
+        parts (assoc parts :container-index 0)
+        subscribe (fn [channel messages]
+                    (put! ws-ch [:subscribe {:channel-name channel :messages messages}]))]
+    (subscribe (pusher/build-all-channel parts) pusher/build-messages)
+    (subscribe (pusher/build-container-channel parts) pusher/container-messages)
+    (subscribe (pusher/obsolete-build-channel parts) (concat pusher/build-messages
+                                                             pusher/container-messages))))

 (defmethod post-navigated-to! :build
   [history-imp navigation-point {:keys [project-name build-num vcs_type] :as args} previous-state current-state]


Less debugging

Less debugging

--- src-shared/cljs/cljs_webrepl/repl_thread.cljs
+++ src-shared/cljs/cljs_webrepl/repl_thread.cljs
@@ -18,14 +18,7 @@
     :master))

 (defn- deserialize [reader event]
-  (let [data    (.-data event)
-        transit (aget data "transit")]
-    (debugf "Deserialize: Event:")
-    (js/console.log event)
-    (debugf "Deserialize: Data:")
-    (js/console.log data)
-    (debugf "Deserialize: Transit:")
-    (js/console.log transit)
+  (let [transit (-> event (aget "data") (aget "transit"))]
     (debugf "Deserialize: %s %s" (worker-type) transit)
     (t/read reader transit)))


Implement 2 more quests

Implement 2 more quests

--- src/braid/client/quests/list.cljs
+++ src/braid/client/quests/list.cljs
@@ -5,41 +5,59 @@

    {:id :quest/conversation-new
     :name "Start a conversation"
-    :description "Conversations are the heart of Braid. Type in the box in the bottom left corner and hit [Enter]."
+    :description "To start a new conversation, click on the left-most conversation, type your message, and hit [Enter]."
     :icon \uf0e6
     :goal 3
     :listener (fn [state [event data]]
                 (and
                   (= event :new-message)
-                  (= (data :thread-id) (:new-thread-id state))))}])
+                  (= (data :thread-id) (:new-thread-id state))))}
+
+   {:id :quest/conversation-reply
+    :name "Reply to a conversation"
+    :description "To add another message to a conversation, type in the text-area at the bottom of the conversation and hit [Enter]."
+    :icon \uf112
+    :goal 3
+    :listener (fn [state [event data]]
+                (and
+                  (= event :new-message)
+                  (not= (data :thread-id) (:new-thread-id state))))}
+
+   {:id :quest/conversation-close
+    :name "Close a conversation"
+    :description "Close a conversation by clicking the X in its top-right corner. A conversation will show up again when someone replies to it, so feel free to close them frequently."
+    :icon \uf00d
+    :goal 3
+    :listener (fn [state [event data]]
+                (and
+                  (= event :hide-thread)
+                  (not (data :local-only?))))}])

 (def disabled-quests
-  [; conversations
+  [
+   ; visit
+
+   {:id :quest/visit
+    :name "Log in on 5 different days"
+    :description "asdf"
+    :icon \uf02c
+    :goal 5
+    :listener (fn [state [event args]]
+                false)}
+
+   ; conversations

    {:id :quest/conversation-tag
     :name "Tag a conversation"
+    :description "asdf"
     :icon \uf02c
     :goal 3
     :listener (fn [state [event args]]
                 false)}
-
-   {:id :quest/conversation-reply
-    :name "Reply to a conversation"
-    :icon \uf112
-    :goal 3
-    :listener (fn [state [event args]]
-                (= event :new-message))}

    {:id :quest/conversation-private
     :name "Start a private conversation"
     :icon \uf21b
-    :goal 3
-    :listener (fn [state [event args]]
-                false)}
-
-   {:id :quest/conversation-mute
-    :name "Close a conversation"
-    :icon \uf00d
     :goal 3
     :listener (fn [state [event args]]
                 false)}


fix typo

fix typo

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -14,7 +14,7 @@
    "Ad Blitz"
    (let [abhelp (fn ab [n total]
                   {:prompt "Select an advertisement to install and rez" :show-discard true
-                   :choices {:req #(and (:side % "Corp")
+                   :choices {:req #(and (= (:side %) "Corp")
                                         (has? % :subtype "Advertisement")
                                         (or (= (:zone %) [:hand]) (= (:zone %) [:discard])))}
                    :effect (req (corp-install state side target nil {:install-state :rezzed})


Env vars are good for you so they must be good for me.

--- src/clj/onyx_dashboard/system.clj
+++ src/clj/onyx_dashboard/system.clj
@@ -14,19 +14,11 @@
             [environ.core :refer [env]]
             [ring.adapter.jetty :refer [run-jetty]]))

-(def remote? true)
-
-(def zk-addr
-  (or (env :zookeeper-addr)
-      (if remote?
-        "54.169.229.123:2181,54.169.240.52:2181"
-        "172.31.5.32:2181,172.31.5.33:2181")))
-
 (def env-config
   {:hornetq/mode :standalone
-   :hornetq.standalone/host (or (env :hornetq-host) "54.169.41.99")
-   :hornetq.standalone/port (or (env :hornetq-port) 5445)
-   :zookeeper/address zk-addr
+   :hornetq.standalone/host (env :hornetq-host)
+   :hornetq.standalone/port (env :hornetq-port)
+   :zookeeper/address (env :zookeeper-addr)
    :onyx.peer/job-scheduler :onyx.job-scheduler/round-robin})


Make the gradle heuristic more resilient

--- src/clj/runbld/results/gradle.clj
+++ src/clj/runbld/results/gradle.clj
@@ -12,7 +12,9 @@
 (defn went-wrong-line [conn idx build-id]
   (let [q {:query
            {:bool
-            {:must [{:match {:log "what went wrong"}}
+            {:must [{:match {:log "what"}}
+                    {:match {:log "went"}}
+                    {:match {:log "wrong"}}
                     {:match {:build-id build-id}}]}}
            :size 1}
         res (-> (es.doc/search conn idx T {:body q})


add several tests for Runner and Corp identities

--- src/clj/test/cards-identities.clj
+++ src/clj/test/cards-identities.clj
@@ -1,4 +1,51 @@
 (in-ns 'test.core)
+
+(deftest cerebral-imaging-max-hand-size
+  "Cerebral Imaging - Maximum hand size equal to credits"
+  (do-game
+    (new-game
+      (make-deck "Cerebral Imaging: Infinite Frontiers" [(qty "Hedge Fund" 3)])
+      (default-runner))
+    (play-from-hand state :corp "Hedge Fund")
+    (play-from-hand state :corp "Hedge Fund")
+    (is (= 13 (:credit (get-corp))) "Has 13 credits")
+    (is (= 13 (:max-hand-size (get-corp))) "Max hand size is 13")))
+
+(deftest iain-stirling-credits
+  "Iain Stirling - Gain 2 credits when behind"
+  (do-game
+    (new-game
+      (default-corp [(qty "Breaking News" 1)])
+      (make-deck "Iain Stirling: Retired Spook" [(qty "Sure Gamble" 3)]))
+    (play-from-hand state :corp "Breaking News" "New remote")
+    (let [ag1 (get-in @state [:corp :servers :remote1 :content 0])]
+      (core/advance state :corp {:card (refresh ag1)})
+      (core/advance state :corp {:card (refresh ag1)})
+      (core/score state :corp {:card (refresh ag1)})
+      (take-credits state :corp)
+      (is (= 1 (:agenda-point (get-corp))))
+      (take-credits state :runner 1)
+      (is (= 8 (:credit (get-runner))) "Gained 2 credits from being behind on points"))))
+
+(deftest industrial-genomics-trash-cost
+  "Industrial Genomics - Increase trash cost"
+  (do-game
+    (new-game
+      (make-deck "Industrial Genomics: Growing Solutions" [(qty "PAD Campaign" 3)
+                                                           (qty "Hedge Fund" 3)])
+      (default-runner))
+    (play-from-hand state :corp "PAD Campaign" "New remote")
+    (core/move state :corp (find-card "PAD Campaign" (:hand (get-corp))) :discard)
+    (core/move state :corp (find-card "PAD Campaign" (:hand (get-corp))) :discard)
+    (core/move state :corp (find-card "Hedge Fund" (:hand (get-corp))) :discard)
+    (core/move state :corp (find-card "Hedge Fund" (:hand (get-corp))) :discard)
+    (let [pad (get-in @state [:corp :servers :remote1 :content 0])]
+      (core/rez state :corp pad)
+      (take-credits state :corp)
+      (core/click-run state :runner {:server "Server 1"})
+      (core/no-action state :corp nil)
+      (core/successful-run state :runner nil)
+      (is (= 8 (core/trash-cost state :runner (refresh pad)))))))

 (deftest kate-mac-mccaffrey-discount
   "Kate 'Mac' McCaffrey - Install discount"
@@ -29,11 +76,22 @@
     (is (= 1 (count (get-in @state [:runner :rig :program]))))
     (is (= 0 (:credit (get-runner))))))

+(deftest ken-tenma-run-event-credit
+  "Ken 'Express' Tenma - Gain 1 credit when first Run event played"
+  (do-game
+    (new-game (default-corp) (make-deck "Ken \"Express\" Tenma: Disappeared Clone" [(qty "Account Siphon" 2)]))
+    (take-credits state :corp)
+    (play-run-event state (first (:hand (get-runner))) :hq)
+    (is (= 6 (:credit (get-runner))) "Gained 1 credit for first Run event")
+    (prompt-choice :runner "Run ability")
+    (play-run-event state (first (:hand (get-runner))) :hq)
+    (is (= 16 (:credit (get-runner))) "No credit gained for second Run event")))
+
 (deftest nasir-ability-basic
   "Nasir Ability - Basic"
   (do-game
-    (new-game
-      (default-corp [(qty "Ice Wall" 3)])
+    (new-game
+      (default-corp [(qty "Ice Wall" 3)])
       (make-deck "Nasir Meidan: Cyber Explorer" []))
     (play-from-hand state :corp "Ice Wall" "HQ")
     (take-credits state :corp)
@@ -49,8 +107,8 @@
 (deftest nasir-ability-xanadu
   "Nasir Ability - Xanadu"
   (do-game
-    (new-game
-      (default-corp [(qty "Ice Wall" 1)])
+    (new-game
+      (default-corp [(qty "Ice Wall" 1)])
       (make-deck "Nasir Meidan: Cyber Explorer" [(qty "Xanadu" 1)]))
     (play-from-hand state :corp "Ice Wall" "HQ")
     (take-credits state :corp)
@@ -63,4 +121,51 @@
       (core/rez state :corp iwall)
       (is (= 3 (:credit (get-runner))))
       (card-ability state :runner nasir 0)
-      (is (= 2 (:credit (get-runner)))))))+      (is (= 2 (:credit (get-runner)))))))
+
+(deftest reina-rez-cost-increase
+  "Reina Roja - Increase cost of first rezzed ICE"
+  (do-game
+    (new-game
+      (default-corp [(qty "Quandary" 3)])
+      (make-deck "Reina Roja: Freedom Fighter" []))
+    (play-from-hand state :corp "Quandary" "R&D")
+    (take-credits state :corp)
+    (is (= 7 (:credit (get-corp))))
+    (core/click-run state :runner {:server "R&D"})
+    (let [quan (get-in @state [:corp :servers :rd :ices 0])]
+      (core/rez state :corp quan)
+      (is (= 5 (:credit (get-corp))) "Rez cost increased by 1"))))
+
+(deftest spark-advertisements
+  "Spark Agency - Rezzing advertisements"
+  (do-game
+    (new-game
+      (make-deck "Spark Agency: Worldswide Reach" [(qty "Launch Campaign" 2)])
+      (default-runner))
+    (play-from-hand state :corp "Launch Campaign" "New remote")
+    (play-from-hand state :corp "Launch Campaign" "New remote")
+    (let [lc1 (get-in @state [:corp :servers :remote1 :content 0])
+          lc2 (get-in @state [:corp :servers :remote2 :content 0])]
+      (core/rez state :corp lc1)
+      (is (= 4 (:credit (get-runner))) "Runner lost 1 credit from rez of advertisement (Corp turn)")
+      (take-credits state :corp)
+      (core/click-run state :runner {:server "Server 1"})
+      (core/rez state :corp lc2)
+      (is (= 3 (:credit (get-runner))) "Runner lost 1 credit from rez of advertisement (Runner turn)"))))
+
+(deftest titan-agenda-counter
+  "Titan Transnational - Add a counter to a scored agenda"
+  (do-game
+    (new-game
+      (make-deck "Titan Transnational: Investing In Your Future" [(qty "Project Atlas" 1)])
+      (default-runner))
+    (play-from-hand state :corp "Project Atlas" "New remote")
+    (let [atl (get-in @state [:corp :servers :remote1 :content 0])]
+      (core/gain state :corp :click 1)
+      (core/advance state :corp {:card (refresh atl)})
+      (core/advance state :corp {:card (refresh atl)})
+      (core/advance state :corp {:card (refresh atl)})
+      (core/score state :corp {:card (refresh atl)})
+      (let [scored (get-in @state [:corp :scored 0])]
+        (is (= 1 (:counter scored)) "1 counter added by Titan")))))


Use node.

Use node.

--- src/clj/triangulate/memcached.clj
+++ src/clj/triangulate/memcached.clj
@@ -5,7 +5,7 @@

 (def key-mapping (atom {}))

-(def conn (c/text-connection "rush-hour.bsfnjw.cfg.usw2.cache.amazonaws.com:11211"))
+(def conn (c/text-connection "rush-hour.bsfnjw.0001.usw2.cache.amazonaws.com:11211"))

 (defn serialize-coordinates [src dst]
   (let [pair {:src src :dst dst}]


Remove unused code

Remove unused code

--- src/cljc/robinson/monstergen.cljc
+++ src/cljc/robinson/monstergen.cljc
@@ -266,19 +266,6 @@
   [id]
   (get (race->monster-map id) :name-plural))

-(defn maybe-spawn-additional-npc
-  "Spawns a new npc of the same type of the given npc near the given npc."
-  [state [x y] npc]
-  state)
-
-(defn on-death-fn
-  "Returns a function that takes [state [x y] npc] and returns a new state.
-   To be invoked when the referred to npc dies."
-   [state npc]
-   (match (get npc :race)
-     :rat  maybe-spawn-additional-npc
-     :else (fn [state & more] state)))
-
 #?(:clj
 (defn -main
   "Generate five random monsters and display them."


restructure websocket connection

restructure websocket connection

--- src/cljs/geschichte/platform.cljs
+++ src/cljs/geschichte/platform.cljs
@@ -15,29 +15,26 @@

 ;; --- WEBSOCKET CONNECTION ---

-(def websocket* (atom nil))
+(defn put! [channel data]
+  (.send channel (str data)))

-(defn put! [data]
-  (.send @websocket* (str data)))
+(defn- take! [message]
+  (log (str "data received:" (read-string message))))

-(defn- take! [message fun]
-  (fun (str "data received:" (read-string message))))
+(defn client-connect! [address]
+  (let [channel (js/WebSocket. (str "ws://" address))]
+    (log (str "establishing websocket connection with " address))
+    (doall
+     (map #(aset channel (first %) (second %))
+          [["onopen" (fn [] (log "channel opened"))]
+           ["onclose" (fn [] (log "channel closed"))]
+           ["onerror" (fn [e] (log (str "ERROR:" e)))]
+           ["onmessage" (fn [m] (let [data (.-data m)] (take! data)))]]))
+    (log "websocket loaded.")
+    channel))

-(defn client-connect! [address fun]
-  (log (str "establishing websocket connection with " address))
-  (reset! websocket* (js/WebSocket. (str "ws://" address)))
-  (doall
-   (map #(aset @websocket* (first %) (second %))
-        [["onopen" (fn [] (do
-                           (log "channel opened")))]
-         ["onclose" (fn [] (log "channel closed"))]
-         ["onerror" (fn [e] (log (str "ERROR:" e)))]
-         ["onmessage" (fn [m] (let [data (.-data m)] (take! data log)))]]))
-  (log "websocket loaded."))
-
-
-#_(client-connect! "localhost:9090" log)
-#_(put! {:type :publish
+#_(def the-channel (client-connect! "localhost:9090"))
+#_(put! the-channel {:type :publish
          :user "user@mail.com"
          :repo #uuid"22aa0537-6e66-43e4-bda2-2b4211e0e4ec"
          :meta {:causal-order {#uuid "befcadd8-eb77-4565-b9fe-a77bac179aec" #{#uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3"}, #uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3" #{}, :root #uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3"}, :last-update #inst "2013-12-05T23:36:43.320-00:00", :head "master", :public true, :branches {"master" #{#uuid "befcadd8-eb77-4565-b9fe-a77bac179aec"}}, :schema {:version 1, :type "http://github.com/ghubber/geschichte"}, :pull-requests {}, :id #uuid "22aa0537-6e66-43e4-bda2-2b4211e0e4ec", :description "test repo"}})


Revert "Only show tabs when there is more than one editor"

This reverts commit b6e23b4e4311e89841810387bbc684b232cee290.

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -107,8 +107,7 @@
                 (when (= (.getEventType e) HyperlinkEvent$EventType/ACTIVATED)
                   (binding [*reorder-tabs?* false]
                     (ui/update-project-tree! (.getDescription e))))))
-    (when (> (count @editors) 0)
-      (shortcuts/toggle-hint! @tabs @shortcuts/is-down?))))
+    (shortcuts/toggle-hint! @tabs @shortcuts/is-down?)))

 ; button bar actions


Add undo system for parinfer

Add undo system for parinfer

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -1,6 +1,7 @@
 (ns nightcode.editors
-  (:require [clojure.java.io :as io]
-            [clojure.string :refer [join split]]
+  (:require [clojure.data :refer [diff]]
+            [clojure.java.io :as io]
+            [clojure.string :refer [join split split-lines]]
             [flatland.ordered.map :as flatland]
             [nightcode.completions :as completions]
             [nightcode.dialogs :as dialogs]
@@ -305,7 +306,37 @@
         index (+ (count s) (inc col))]
     index))

-(defn run-parinfer!
+(defn custom-split-lines
+  [s]
+  (let [s (if-not (= \newline (last s))
+            (str s "\n ")
+            (str s " "))
+        lines (split-lines s)
+        last-line (last lines)
+        last-line-len (max 0 (dec (count last-line)))]
+    (conj (vec (butlast lines))
+          (subs last-line 0 last-line-len))))
+
+(defn count-lines-changed
+  [new-lines old-lines]
+  (->> (diff new-lines old-lines) first (remove nil?) count))
+
+(defn update-edit-history!
+  [edit-history state]
+  (let [{:keys [current-state states]} @edit-history
+        old-state (get states current-state)
+        old-lines (:lines old-state)
+        new-lines (:lines state)
+        old-lines-changed (:lines-changed old-state)
+        new-lines-changed (count-lines-changed new-lines old-lines)
+        state (assoc state :lines-changed new-lines-changed)]
+    ; if the last two edits only affected one line, replace the last edit instead of adding a new edit
+    (when (not= old-lines-changed new-lines-changed 1)
+      (swap! edit-history update-in [:current-state] inc))
+    (swap! edit-history update-in [:states] subvec 0 (:current-state @edit-history))
+    (swap! edit-history update-in [:states] conj state)))
+
+(defn get-state
   [^TextEditorPane text-area paren-mode?]
   (let [old-pos (.getCaretPosition text-area)
         old-x (.getCaretOffsetFromLineStart text-area)
@@ -317,47 +348,81 @@
         new-text (:text result)
         new-x (:x result)
         new-pos (row-col->index new-text old-line new-x)]
-    (.replaceRange text-area new-text 0 (count old-text))
-    (.setCaretPosition text-area new-pos)))
+    {:lines (custom-split-lines new-text)
+     :index new-pos}))
+
+(defn refresh-content!
+  [^TextEditorPane text-area state]
+  (let [old-text (.getText text-area)
+        {:keys [lines index]} state]
+    (.replaceRange text-area (join \newline lines) 0 (count old-text))
+    (.setCaretPosition text-area index)))

 (defn init-parinfer!
-  [^TextEditorPane text-area extension]
+  [^TextEditorPane text-area extension edit-history]
   (when (contains? utils/clojure-exts extension)
-    ; use paren mode to preprocess the code
     (let [old-text (.getText text-area)]
-      (run-parinfer! text-area true)
+      (reset! edit-history {:current-state -1 :states []})
+      ; use paren mode to preprocess the code
+      (let [state (get-state text-area true)]
+        (update-edit-history! edit-history state)
+        (refresh-content! text-area state))
       (.discardAllEdits text-area)
-      (.setDirty text-area (not= old-text (.getText text-area))))
-    ; add a listener to run indent mode when a key is pressed
-    (.addKeyListener text-area
-      (reify KeyListener
-        (keyReleased [this e]
-          (when-not (or (contains? #{KeyEvent/VK_DOWN KeyEvent/VK_UP
-                                     KeyEvent/VK_RIGHT KeyEvent/VK_LEFT
-                                     KeyEvent/VK_SHIFT KeyEvent/VK_CONTROL
-                                     KeyEvent/VK_ALT KeyEvent/VK_META}
-                                   (.getKeyCode e))
-                        (.isControlDown e)
-                        (.isMetaDown e))
-            (run-parinfer! text-area (= (.getKeyCode e) KeyEvent/VK_ENTER))))
-        (keyTyped [this e] nil)
-        (keyPressed [this e] nil))))
+      (.setDirty text-area (not= old-text (.getText text-area)))
+      ; add a listener to run indent mode when a key is pressed
+      (.addKeyListener text-area
+        (reify KeyListener
+          (keyReleased [this e]
+            (when-not (or (contains? #{KeyEvent/VK_DOWN KeyEvent/VK_UP
+                                       KeyEvent/VK_RIGHT KeyEvent/VK_LEFT
+                                       KeyEvent/VK_SHIFT KeyEvent/VK_CONTROL
+                                       KeyEvent/VK_ALT KeyEvent/VK_META}
+                                     (.getKeyCode e))
+                          (.isControlDown e)
+                          (.isMetaDown e))
+              (let [state (get-state text-area (= (.getKeyCode e) KeyEvent/VK_ENTER))]
+                (update-edit-history! edit-history state)
+                (refresh-content! text-area state))))
+          (keyTyped [this e] nil)
+          (keyPressed [this e] nil)))))
   text-area)

 (defn create-text-area
   ([]
+    (create-text-area (atom nil)))
+  ([edit-history]
     (doto (proxy [TextEditorPane] []
             (setMarginLineEnabled [enabled?]
               (proxy-super setMarginLineEnabled enabled?))
             (setMarginLinePosition [size]
               (proxy-super setMarginLinePosition size))
             (processKeyBinding [ks e condition pressed]
-              (proxy-super processKeyBinding ks e condition pressed)))
+              (proxy-super processKeyBinding ks e condition pressed))
+            (canUndo []
+              (if-let [{:keys [current-state states]} @edit-history]
+                (some? (get states (dec current-state)))
+                (proxy-super canUndo)))
+            (canRedo []
+              (if-let [{:keys [current-state states]} @edit-history]
+                (some? (get states (inc current-state)))
+                (proxy-super canRedo)))
+            (undoLastAction []
+              (if-let [{:keys [current-state states]} @edit-history]
+                (when-let [state (get states (dec current-state))]
+                  (swap! edit-history update-in [:current-state] dec)
+                  (refresh-content! this state))
+                (proxy-super undoLastAction)))
+            (redoLastAction []
+              (if-let [{:keys [current-state states]} @edit-history]
+                (when-let [state (get states (inc current-state))]
+                  (swap! edit-history update-in [:current-state] inc)
+                  (refresh-content! this state))
+                (proxy-super redoLastAction))))
       (.setAntiAliasingEnabled true)
       apply-settings!))
-  ([path]
+  ([path edit-history]
     (let [extension (utils/get-extension path)]
-      (doto (create-text-area)
+      (doto (create-text-area edit-history)
         (.load (FileLocation/create path) "UTF-8")
         .discardAllEdits
         (.setSyntaxEditingStyle (get utils/styles extension))
@@ -365,7 +430,7 @@
         (.setMarginLineEnabled true)
         (.setMarginLinePosition 80)
         (.setTabSize (if (contains? utils/clojure-exts extension) 2 4))
-        (init-parinfer! extension)))))
+        (init-parinfer! extension edit-history)))))

 (defn create-console
   ([path]
@@ -475,7 +540,8 @@
 (defmethod create-editor :text [_ path]
   (when (utils/valid-file? (io/file path))
     (let [; create the text editor and the pane that will hold it
-          text-area (create-text-area path)
+          edit-history (atom nil)
+          text-area (create-text-area path edit-history)
           extension (utils/get-extension path)
           clojure? (contains? utils/clojure-exts extension)
           completer (completions/create-completer text-area extension)
@@ -520,7 +586,8 @@
        :text-area text-area
        :close-fn! (fn [])
        :italicize-fn #(.isDirty text-area)
-       :should-remove-fn #(not (.exists (io/file path)))})))
+       :should-remove-fn #(not (.exists (io/file path)))
+       :edit-history edit-history})))

 (def ^:dynamic *types* [:text :logcat :git])


Use camel-snake-kebab for rendering fields and table column headings

--- src/kixi/hecuba/web/resources.clj
+++ src/kixi/hecuba/web/resources.clj
@@ -5,7 +5,9 @@
    [bidi.bidi :refer (->Redirect path-for)]
    [hiccup.core :refer (html)]
    [clojure.edn :as edn]
-   [clojure.java.io :as io]))
+   [clojure.java.io :as io]
+   [clojure.string :as string]
+   [camel-snake-kebab :as csk]))

 (def base-media-types ["text/html" "application/json" "application/edn"])

@@ -23,13 +25,13 @@
                        fields (remove #{:name :id :href :type} (keys (first projects)))]
                    (html [:body
                           [:h2 "Fields"]
-                          [:ul (for [k fields] [:li (name k)])]
+                          [:ul (for [k fields] [:li (csk/->snake_case_string (name k))])]
                           [:h2 "Items"]
                           [:table
                            [:thead
                             [:tr
                              [:th "Name"]
-                             (for [k fields] [:th k])
+                             (for [k fields] [:th (string/replace (csk/->Snake_case_string k) "_" " ")])
                              (when debug [:th "Debug"])]]
                            [:tbody
                             (for [p projects]


I need these in slim due to openshift's use of jboss-cli.sh

--- support/build-support/src/main/clojure/immutant/build/tools.clj
+++ support/build-support/src/main/clojure/immutant/build/tools.clj
@@ -517,6 +517,9 @@
                               "org.jboss.as.standalone"
                               "org.jboss.as.domain-http-error-context"
                               "com.h2database.h2"
+                              "org.jboss.as.cli"
+                              "org.fusesource.jansi"
+                              "org.jboss.aesh"
                               "javaee.api"
                               "javax.servlet.jstl.api")
                              (find-full-required-module-set all-modules))]


preliminary variation numbering

preliminary variation numbering

--- src/main/cljs/chessdojo/core.cljs
+++ src/main/cljs/chessdojo/core.cljs
@@ -72,6 +72,7 @@

 (defn variation-view [nodes current-path depth]
   [:div (when (> depth 0) {:className "variation"})
+   (when (> depth 0) [:span (str (first (:path (meta nodes))) "] ")])
    (for [node nodes]
      (if (vector? node)
        ^{:key (:path (meta node))} [variation-view node current-path (inc depth)]
@@ -89,9 +90,7 @@
 (defn game-view []
   (let [game @state current-path (cg/game-path game)]
     [:div {:className "game-view"}
-     [variation-view (rest (zip/root game)) current-path 0] ; skip the start-node
-     ])
-  )
+     [variation-view (rest (zip/root game)) current-path 0]])) ; skip the start-node

 (defn buttons []
   [:div


Fixed call-service to produce arrays of Object to pass to proxy and also to handle zero argument calls

--- src/main/clojure/naojure/core.clj
+++ src/main/clojure/naojure/core.clj
@@ -105,8 +105,12 @@

 (defn call-service
   "Call an operation on a service"
-  [robot proxy-sym operation params]
-  (.call (get-proxy robot proxy-sym) operation (into-array params)))
+  ([robot proxy-sym operation]
+     (.call (get-proxy robot proxy-sym) operation
+            (into-array Object [])))
+  ([robot proxy-sym operation params]
+     (.call (get-proxy robot proxy-sym) operation
+            (into-array Object params))))

 ;; event handling
@@ -257,25 +261,40 @@
 (defn get-memory-keys
   "List memory keys"
   [robot]
-  (call-service robot :memory "getDataListName"))
+  (->
+   (call-service robot :memory "getDataListName")
+   (.get)))

 (defn get-memory-keys-containing
   "List memory keys containing string value"
   [robot val]
-  (call-service robot :memory"getDataList"  [val]))
+  (->
+   (call-service robot :memory"getDataList"  [val])
+   (.get)))

 (defn get-memory-value
    "Get named value from memory"
    [robot key]
-   (call-service robot :memory "getData" [key]))
+   (->
+    (call-service robot :memory "getData" [key])
+    (.get)))

 (defn get-memory-values
    "Get values for list of named keys"
    [robot keys]
-   (call-service robot :memory "getData"
-             [(to-array keys)]))
+   (->
+    (call-service robot :memory "getData"
+                  [(to-array keys)])
+    (.get)))

 ; posture
+(defn get-posture-list
+  "Get list of defined postures from robot"
+  [robot]
+  (->
+   (call-service robot :posture "getPostureList")
+   (.get)))
+
 (defn go-to-posture
   "Move to the specified posture (use symbol). relative-speed is between zero and one"
   [robot posture relative-speed]
@@ -284,56 +303,56 @@
 (defn crouch
   "Crouch"
   ([robot]
-     (go-to-posture robot :crouch 1.0))
+     (go-to-posture robot :crouch (Float. 1.0)))
   ([robot speed]
      (go-to-posture robot :crouch speed)))

 (defn lie-on-back
   "Lie on back"
   ([robot]
-     (go-to-posture robot :lying-back 1.0))
+     (go-to-posture robot :lying-back (Float. 1.0)))
   ([robot speed]
      (go-to-posture robot :lying-back speed)))

 (defn lie-on-belly
   "Lie on belly"
   ([robot]
-     (go-to-posture robot :lying-belly 1.0))
+     (go-to-posture robot :lying-belly (Float. 1.0)))
   ([robot speed]
      (go-to-posture robot :lying-belly speed)))

 (defn sit
   "Sit"
   ([robot]
-     (go-to-posture robot :sit 1.0))
+     (go-to-posture robot :sit (Float. 1.0)))
   ([robot speed]
      (go-to-posture robot :sit speed)))

 (defn sit-relaxed
   "Relaxed sit"
   ([robot]
-     (go-to-posture robot :sit-relax 1.0))
+     (go-to-posture robot :sit-relax (Float. 1.0)))
   ([robot speed]
      (go-to-posture robot :sit-relax speed)))

 (defn stand
   "Stand up"
   ([robot]
-     (go-to-posture robot :stand 1.0))
+     (go-to-posture robot :stand (Float. 1.0)))
   ([robot speed]
      (go-to-posture robot :stand speed)))

 (defn stand-init
   "Stand up (init)"
   ([robot]
-     (go-to-posture robot :stand-init 1.0))
+     (go-to-posture robot :stand-init (Float. 1.0)))
   ([robot speed]
      (go-to-posture robot :stand-init speed)))

 (defn stand-zero
   "Stand up (zero)"
   ([robot]
-     (go-to-posture robot :stand-zero 1.0))
+     (go-to-posture robot :stand-zero (Float. 1.0)))
   ([robot speed]
      (go-to-posture robot :stand-zero speed)))


Test stuff in REPL they said.

Test stuff in REPL they said.

--- src/lambda_blog/templates/tags.clj
+++ src/lambda_blog/templates/tags.clj
@@ -20,8 +20,8 @@
                      :href (pathcat path-to-root (:path t))}
                     (span {:class [:label :label-info]
                            :style (format "font-size: %s%%;"
-                                          (+ min-size
-                                             (* (- max-size min-size)
+                                          (+ min
+                                             (* (- max min)
                                                 (/ c total))))}
                           (:id t))
                     " "))


Update ClojureScript version to 1.7.28.

Update ClojureScript version to 1.7.28.

--- src/leiningen/new/mies/project.clj
+++ src/leiningen/new/mies/project.clj
@@ -2,7 +2,7 @@
   :description "FIXME: write this!"
   :url "http://example.com/FIXME"
   :dependencies [[org.clojure/clojure "1.7.0"]
-                 [org.clojure/clojurescript "0.0-3308" :classifier "aot"
+                 [org.clojure/clojurescript "1.7.28" :classifier "aot"
                   :exclusion [org.clojure/data.json]]
                  [org.clojure/data.json "0.2.6" :classifier "aot"]]
   :jvm-opts ^:replace ["-Xmx1g" "-server"]


complicate test option;transient hash table for hset hget test

--- jepsen-test/src/jepsen/elasticell.clj
+++ jepsen-test/src/jepsen/elasticell.clj
@@ -1,5 +1,6 @@
 (ns jepsen.elasticell
   (:gen-class)
+  (:import [jepsen.generator Generator])
   (:import [knossos.model Model])
   (:require [clojure.tools.logging :refer :all]
             [clojure.string :as str]
@@ -25,14 +26,15 @@
   (reify db/DB
     (setup! [_ test node]
         (info node "start cell" version)
-        (c/su (c/exec :start-cell.sh :debug))
+        (info node "is pd? " (contains? (:pd test) node) )
+        ;(c/su (c/exec :start-cell.sh :debug))
         (info "start cell over!")
         (Thread/sleep 5000)
     )

     (teardown! [_ test node]
         (info node "tearing down cell")
-        (c/su (c/exec :stop.sh :cell))
+        ;(c/su (c/exec :stop.sh :cell))
          )))

 (defn parse-long
@@ -40,7 +42,7 @@
   [s]
   (when s (Long/parseLong s)))

-(def server1-conn {:pool {:max-total 8} :spec {:host "10.214.160.200" :port 6379 :timeout-ms 6000}})
+(def server1-conn {:pool {:max-total 8} :spec {:host "n9" :port 6379 :timeout-ms 3000}})	;time out shreshold for the client connection or read ops
 (defmacro wcar* [& body] `(car/wcar server1-conn ~@body))

 (defn client
@@ -48,9 +50,9 @@
   [conn]
   (reify client/Client
     (setup! [_ test node]
-      ;(client (wcar* (car/flushall))
-      (client (wcar* (car/set "start" ""))
-    ))
+      (client (wcar* (car/flushall))
+      ;(client (wcar* (car/set "start" ""))
+))

     (invoke! [this test op]
       (let [[k v] (:value op)
@@ -68,7 +70,7 @@
                     (assoc op :type (if (= res 1)
                                       :ok
                                       :fail)))
-
+              :final (assoc op :type :ok, :value (independent/tuple k nil))
               :hset (let [ [member value] v
                           _  (wcar*  (car/hset (str "hkey" k) member value))]
                           (assoc op :type, :ok))
@@ -88,22 +90,29 @@
       ; close it.
       )))

-
+(defn final   [_ _] {:type :invoke, :f :final, :value nil})
 (defn r   [_ _] {:type :invoke, :f :read, :value nil})
-(defn w   [_ _] {:type :invoke, :f :write, :value (rand-int 100)})
-(defn cas [_ _] {:type :invoke, :f :cas, :value [(rand-int 100) (rand-int 100)]})
-(defn hget [_ _] {:type :invoke, :f :hget, :value [(rand-int 100) nil]})
-(defn hset [_ _] {:type :invoke, :f :hset, :value [(rand-int 100) (rand-int 100)]})
-
-(defrecord CellRegister [value hashtable list set zset]
+(defn w   [_ _] {:type :invoke, :f :write, :value (rand-int 10)})			;generate random value for write operation
+(defn cas [_ _] {:type :invoke, :f :cas, :value [(rand-int 10) (rand-int 10)]})
+(defn hget [_ _] {:type :invoke, :f :hget, :value [(rand-int 10) nil]})
+(defn hset [_ _] {:type :invoke, :f :hset, :value [(rand-int 10) (rand-int 10000)]})
+
+(def tables (transient {}))
+
+(defn tables-get  [k]   (get tables k))
+(defn tables-set  [k v] (assoc! tables k v))
+(defn tables-count [] (count tables))
+(defn tables-print []  (prn (persistent! tables)))
+
+(defrecord CellRegister [value hashtable]
   Model
   (step [r op]
     do
         (condp = (:f op)
-          :write (CellRegister. (:value op) hashtable list set zset)
+          :write (CellRegister. (:value op) hashtable)
           :cas   (let [[cur new] (:value op)]
                   (if (= cur value)
-                    (CellRegister. new hashtable list set zset)
+                    (CellRegister. new hashtable)
                     (inconsistent (str "can't CAS " value " from " cur
                                         " to " new))))
           :read  (if (or (nil? (:value op))
@@ -111,21 +120,44 @@
                   r
                   (inconsistent (str "can't read " (:value op)
                                       " from register " value)))
-          :hset  (let [[new-member new-value] (:value op)]
-                     (CellRegister. value (assoc hashtable new-member new-value) list set zset ))
-          :hget  (let [[new-member new-value] (:value op)]
-                    (if (= (get hashtable new-member) new-value)
+          :hset  (let [ [new-member new-value] (:value op)]
+                    (do (tables-set new-member new-value)
+                        (CellRegister. value  (tables-count))))
+          :hget  (let [ [new-member new-value] (:value op)]
+                    (if  (= (tables-get new-member) new-value)
                           r
-                          (inconsistent (str "can't read " (:value op)
-                                        " from register " value))))
+                          (do ;(throw (ex-info (str "hget wrong, new-member " new-member
+                              ;         " tables-get from register: " (tables-get new-member)
+                              ;        " client get new-value " new-value) {}))
+                              (inconsistent (str "hget wrong, new-member " new-member
+                                        " tables-get from register: " (tables-get new-member)
+                                        " client get new-value " new-value)))
+                    ))
+          :final (do (def tables (transient {})) r)
                           ))
   Object
   (toString [this] (pr-str "value:" value " hashtable:" hashtable)))

 (defn elasticell-register
-  "A register"
+  "A cell register"
   ([] (elasticell-register nil))
-  ([value] (CellRegister. value {} nil nil nil)))
+  ([value] (do (info "call elasticell-register") (CellRegister. value 0)) ))
+
+(defn nemesis-gen
+  "A generator which emits a start after a t1 second delay, and then a stop
+  after a t2 second delay."
+  []
+  (gen/seq [
+	(gen/sleep 1)
+        {:type :info :f :start}
+	(gen/sleep 2)
+        {:type :info :f :paused}
+	(gen/sleep 3)
+        {:type :info :f :stop}
+	(gen/sleep 4)
+        {:type :info :f :resumed}
+       ])
+)

 (defn elasticell-test
   "Given an options map from the command-line runner (e.g. :nodes, :ssh,
@@ -136,30 +168,56 @@
          {:name "elasticell"
           :os debian/os
           :db (db "latest")
+          :pd   #{"n5" "n6" "n1" "localhost"}
           :client (client nil)
-          :nemesis (nemesis/partition-random-halves)
-          :model  (elasticell-register)
-          :checker (checker/compose
-                     {
-                      :perf     (checker/perf)
-                      :indep (independent/checker
-                               (checker/compose
-                                 {:timeline (timeline/html)
-                                  :linear   (checker/linearizable)}))})
-          :generator (->> (independent/concurrent-generator
-                            1
-                            (range)
-                            (fn [k]
-                              (->> (gen/mix [r w])
-                                   (gen/stagger 1/100)
-                                   (gen/limit 500))))
-                          (gen/nemesis
-                            (gen/seq (cycle [(gen/sleep 4)
-                                             {:type :info, :f :start}
-                                             (gen/sleep 4)
-                                             {:type :info, :f :stop}])))
-                          (gen/time-limit (:time-limit opts)))}
-         opts))
+                :nemesis (
+            nemesis/compose {
+            ;(nemesis/partition-majorities-ring)				;Every node can see a majority, but no node sees the *same* majority
+                    ;(nemesis/partition-random-halves)
+            {:start :start :stop :stop} (nemesis/partition-halves) 		;first partion is smaller
+            ;(nemesis/clock-scrambler 1)		;
+            {:paused :start :resumed :stop} (nemesis/hammer-time :redis-server)}	;pause and resume the proccess named redis-server
+            )
+                :model  (elasticell-register)
+                :checker (checker/compose
+                          {
+                            :perf     (checker/perf)
+                            :indep (independent/checker
+                                    (checker/compose
+                                      {:timeline (timeline/html)
+                                        :linear   (checker/linearizable)}))})
+                :generator (->> (independent/concurrent-generator
+                                  1
+                                  (range)		     ;generated key range from 0 to 1
+                                  (fn [k]
+                                    (gen/concat
+                                      (->> (gen/mix [hset hget])
+                                          (gen/stagger 1/100) ;average time interval between 2 client operation
+                                          (gen/limit 160)     ;total operations of a single independent key
+                                      )
+                                      ;(gen/sleep 1)	     ;sleep 1 seconds after a single independent key operation; comment it if you don't want to pause the operation
+                                      (gen/once {:type :invoke, :f :final})
+                                    )
+                                  )
+                                )
+                                (gen/nemesis
+                                  (gen/concat
+                                      (gen/start-stop 1 6) ;start network partition 1 seconds after previous nemesis stop, resume at 3 seconds later
+                                      ;(nemesis-gen)
+                                  )
+                                ;(gen/seq (cycle
+                                ;	  [(gen/sleep 1)   ;generate a nemesis loops until time limit
+                                                  ;           {:type :info, :f :start}
+                                ;	   (gen/sleep 2)
+                                ;	      {:type :info, :f :paused}
+                                ;	   (gen/sleep 3)
+                                ;	      {:type :info, :f :resumed}
+                                                  ;        (gen/sleep 4)
+                                                  ;           {:type :info, :f :stop}
+                                ;	  ]))
+                                )
+                                (gen/time-limit (:time-limit opts)))}
+          opts))

 (defn -main
   "Handles command line arguments. Can either run a test, or a web server for


fix report price fetch

fix report price fetch

--- src/clj/clj_money/reports.clj
+++ src/clj/clj_money/reports.clj
@@ -161,11 +161,6 @@
                                            as-of)
                            {}))))

-(defn- fetch-prices
-  ([commodity-ids] (fetch-prices commodity-ids (t/today)))
-  ([commodity-ids as-of]
-   (prices/batch-fetch commodity-ids as-of)))
-
 (defn- append-retained-earnings
   [mapped-accounts]
   (let [{:keys [income expense]} (->> (select-keys mapped-accounts [:income :expense])
@@ -270,10 +265,10 @@
   [{:keys [lots as-of] :as ctx}]
   (let [lot-transactions (fetch-lot-transactions ctx)
         prices (if (seq lots)
-                 (fetch-prices (->> lots
-                                    (map :commodity-id)
-                                    set)
-                               as-of)
+                 (prices/batch-fetch (->> lots
+                                          (map :commodity-id)
+                                          set)
+                                     {:as-of as-of})
                  {})]
     (update-in ctx
                [:lots]


Fix examples count and see-alsos on autocomplete results

--- src/clj/clojuredocs/pages.clj
+++ src/clj/clojuredocs/pages.clj
@@ -70,35 +70,39 @@

 (defn add-see-alsos [results]
   (let [sa-lookup (->> results
-                       (map #(select-keys % [:ns :name]))
-                       (map (fn [{:keys [ns name] :as l}]
-                              [l (->> (mon/fetch-one :see-alsos :where {:var.ns ns :var.name name})
-                                      :refs
-                                      (map (fn [{:keys [ns name]}]
-                                             {:ns ns
-                                              :name name
-                                              :href (str "/" ns "/" name)})))]))
+                       (map #(select-keys % [:ns :name :library-url]))
+                       (map (fn [{:keys [ns name library-url] :as l}]
+                              [l (->> (mon/fetch :see-alsos
+                                        :where {:from-var.ns ns
+                                                :from-var.name name
+                                                :from-var.library-url library-url})
+                                      (map (fn [{:keys [to-var]}]
+                                             {:ns (:ns to-var)
+                                              :name (:name to-var)
+                                              :library-url (:library-url to-var)})))]))
                        (into {}))]
     (->> results
-         (map #(assoc % :see-alsos (get sa-lookup (select-keys % [:ns :name])))))))
+         (map #(assoc % :see-alsos (get sa-lookup (select-keys % [:ns :name :library-url])))))))

 (defn add-examples-count [results]
   (let [examples-lookup (->> results
                              (map #(select-keys % [:ns :name :library-url]))
                              (map (fn [{:keys [ns name library-url] :as l}]
-                                    [l (mon/fetch-count :examples :where {:var.ns ns
-                                                                          :var.name name
-                                                                          :var.library-url library-url})]))
+                                    [l (mon/fetch-count :examples
+                                         :where {:var.ns ns
+                                                 :var.name name
+                                                 :var.library-url library-url
+                                                 :deleted-at nil})]))
                              (into {}))]
     (->> results
          (map #(assoc % :examples-count (get examples-lookup (select-keys % [:ns :name :library-url])))))))
-

 (defn var-search-handler [{:keys [params]}]
   {:headers {"Content-Type" "application/edn"}
    :body (pr-str (->> params
                       :query
                       search/query
+                      (take 10)
                       add-see-alsos
                       add-examples-count))})


fix broken Sealed Vault credit storage

fix broken Sealed Vault credit storage

--- src/clj/game/cards-assets.clj
+++ src/clj/game/cards-assets.clj
@@ -659,8 +659,10 @@

    "Sealed Vault"
    {:abilities [{:label "Store any number of [Credits] on Sealed Vault" :cost [:credit 1]
-                 :prompt "How many [Credits]?" :choices :credit :msg (msg "store " target " [Credits]")
-                 :effect (effect (add-prop card :counter target))}
+                 :prompt "How many [Credits]?" :choices {:number (req (- (:credit corp) 1))}
+                 :msg (msg "store " target " [Credits]")
+                 :effect (effect (lose :credit target)
+                                 (add-prop card :counter target))}
                 {:label "Move any number of [Credits] to your credit pool"
                  :cost [:click 1] :prompt "How many [Credits]?"
                  :choices :counter :msg (msg "gain " target " [Credits]")


implement commodity sale UI

implement commodity sale UI

--- src/clj_money/web/trading.clj
+++ src/clj_money/web/trading.clj
@@ -7,7 +7,9 @@
             [ring.util.response :refer :all]
             [clj-time.core :as t]
             [clj-money.web.shared :refer :all]
-            [clj-money.web.money-shared :refer [budget-monitors]]
+            [clj-money.web.money-shared :refer [budget-monitors
+                                                inventory-method-options
+                                                grouped-options-for-accounts]]
             [clj-money.coercion :as coercion]
             [clj-money.validation :as validation]
             [clj-money.models.accounts :as accounts]
@@ -86,11 +88,45 @@
   ([{params :params} sale]
    (let [account (accounts/find-by-id (env :db) (Integer. (:account-id params)))]
      (with-trading-layout "New Sale" (:entity-id account) {}
-       [:div.col-md-6
-        [:form {:action (format "/accounts/%s/sales" (:id account))
-                :method :post}
-         (form-fields account sale)]]))))
+       [:form {:action (format "/accounts/%s/sales" (:id account))
+               :method :post}
+        [:div.col-md-6
+         (form-fields account sale)]
+        [:div.col-md-6
+         (select-field sale :inventory-method (inventory-method-options))
+         (select-field sale
+                       :lt-capital-gains-account-id
+                       (grouped-options-for-accounts
+                         (:entity-id account)
+                         {:selected-id (:lt-capital-gains-account-id sale)}))
+         (select-field sale
+                       :st-capital-gains-account-id
+                       (grouped-options-for-accounts
+                         (:entity-id account)
+                         {:selected-id (:st-capital-gains-account-id sale)}))
+         (select-field sale
+                       :lt-capital-loss-account-id
+                       (grouped-options-for-accounts
+                         (:entity-id account)
+                         {:selected-id (:lt-capital-loss-account-id sale)}))
+         (select-field sale
+                       :st-capital-loss-account-id
+                       (grouped-options-for-accounts
+                         (:entity-id account)
+                         {:selected-id (:st-capital-loss-account-id sale)}))]]))))

 (defn sell
-  [req]
-  "sell")
+  [{params :params :as req}]
+  (let [result (trading/sell (env :db) (select-keys params [:account-id
+                                                            :lt-capital-gains-account-id
+                                                            :st-capital-gains-account-id
+                                                            :lt-capital-loss-account-id
+                                                            :st-capital-loss-account-id
+                                                            :inventory-method
+                                                            :commodity-id
+                                                            :shares
+                                                            :value
+                                                            :trade-date]))]
+    (if (validation/has-error? result)
+      (new-sale req result)
+      (redirect (format "/accounts/%s" (:account-id result))))))


cleanup routing regarding auth changes

cleanup routing regarding auth changes

#46

--- src/cljc/swarmpit/routes.cljc
+++ src/cljc/swarmpit/routes.cljc
@@ -8,18 +8,19 @@
        "/password"      {:post :password}
        "/distribution/" {"dockerhub"  {""  {:get  :dockerhub-users
                                             :post :dockerhub-user-create}
-                                       "/" {:get    {"list"                  :dockerhub-users-list
-                                                     "repositories"          :dockerhub-repositories
-                                                     "tags"                  :dockerhub-repository-tags
-                                                     [:user "/repositories"] :dockerhub-user-repositories
-                                                     [:id]                   :dockerhub-user}
+                                       "/" {:get    {"list"                :dockerhub-users-list
+                                                     "repositories"        :public-repositories
+                                                     "tags"                :public-repository-tags
+                                                     [:id "/repositories"] :dockerhub-user-repositories
+                                                     [:id "/tags"]         :dockerhub-user-tags
+                                                     [:id]                 :dockerhub-user}
                                             :delete {[:id] :dockerhub-user-delete}}}
                          "registries" {""  {:get  :registries
                                             :post :registry-create}
-                                       "/" {:get    {"list"                      :registries-list
-                                                     [:registry "/repositories"] :repositories
-                                                     [:registry "/tags"]         :repository-tags
-                                                     [:id]                       :registry}
+                                       "/" {:get    {"list"                :registries-list
+                                                     [:id "/repositories"] :registry-repositories
+                                                     [:id "/tags"]         :registry-repository-tags
+                                                     [:id]                 :registry}
                                             :delete {[:id] :registry-delete}}}}
        "/services"      {:get  :services
                          :post :service-create}


Display text labels on SVG rendering sliders.

--- src/cljs/mazes/web/views.cljs
+++ src/cljs/mazes/web/views.cljs
@@ -15,13 +15,13 @@
       (when (and @grid @render-env)
         (svg/render @render-env @grid)))))

-(defn slider [k {:keys [min max]}]
+(defn slider [k {:keys [label min max]}]
   (let [value (subscribe [k])]
     (fn []
       [re-com/v-box
        :children
        [[re-com/label
-         :label @value]
+         :label (str label ": " @value)]
         [re-com/slider
          :style {:width "100%"}
          :model @value
@@ -53,10 +53,10 @@
         :gap "2rem"
         :children
         [[:h2 "Left Pane"]
-         [slider :columns {:min 2 :max 20}]
-         [slider :rows {:min 2 :max 20}]
-         [slider :width {:min 100 :max 1000}]
-         [slider :height {:min 100 :max 1000}]
+         [slider :columns {:label "Columns" :min 2 :max 20}]
+         [slider :rows {:label "Rows" :min 2 :max 20}]
+         [slider :width {:label "Width" :min 100 :max 1000}]
+         [slider :height {:label "Height" :min 100 :max 1000}]
          [re-com/button
           :label "Generate Maze"
           :on-click #(dispatch [:generate-maze])]]]


FastOrganic layout

FastOrganic layout

--- src/clojure/defgraph/core.clj
+++ src/clojure/defgraph/core.clj
@@ -4,7 +4,7 @@
    [org.jgraph.graph DefaultGraphCell GraphConstants]
    [org.jgrapht ListenableGraph]
    [org.jgrapht.graph ListenableDirectedGraph]
-   com.jgraph.layout.hierarchical.JGraphHierarchicalLayout
+   com.jgraph.layout.organic.JGraphFastOrganicLayout
    com.jgraph.layout.JGraphFacade
    ExtendedConstructor
    java.io.File
@@ -38,7 +38,7 @@
           adapter (JGraphModelAdapter. g)
           jgraph (JGraph. adapter)
           facade (JGraphFacade. jgraph)
-          layout (JGraphHierarchicalLayout.)]
+          layout (JGraphFastOrganicLayout.)]
       (.run layout facade)
       (let [m (.createNestedMap facade true true)
             cache (.getGraphLayoutCache jgraph)]


more name refactoring

more name refactoring

--- src/com/rpl/specter/impl.cljc
+++ src/com/rpl/specter/impl.cljc
@@ -35,9 +35,9 @@

 (deftype ExecutorFunctions [type select-executor transform-executor])

-(def StructureValsPathExecutor
+(def RichPathExecutor
   (->ExecutorFunctions
-    :svalspath
+    :richpath
     (fn [selector structure]
       (selector [] structure
         (fn [vals structure]
@@ -122,7 +122,7 @@
         afn (fn [vals structure next-fn]
               (next-fn (conj vals (cfn this structure)) structure)
               )]
-    (->TransformFunctions StructureValsPathExecutor afn afn)))
+    (->TransformFunctions RichPathExecutor afn afn)))

 (defn coerce-structure-path [this]
@@ -142,7 +142,7 @@
         selector (:select* pimpl)
         transformer (:transform* pimpl)]
     (->TransformFunctions
-      StructureValsPathExecutor
+      RichPathExecutor
       (fn [vals structure next-fn]
         (selector this structure (fn [structure] (next-fn vals structure))))
       (fn [vals structure next-fn]
@@ -199,7 +199,7 @@
           t (.-type exs)

           combiner
-          (if (= t :svalspath)
+          (if (= t :richpath)
             (fn [curr next]
               (fn [vals structure next-fn]
                 (curr vals structure
@@ -220,12 +220,12 @@
               all))))

 (defn coerce-structure-vals [^TransformFunctions tfns]
-  (if (= (extype tfns) :svalspath)
+  (if (= (extype tfns) :richpath)
     tfns
     (let [selector (.-selector tfns)
           transformer (.-transformer tfns)]
       (->TransformFunctions
-        StructureValsPathExecutor
+        RichPathExecutor
         (fn [vals structure next-fn]
           (selector structure (fn [structure] (next-fn vals structure))))
         (fn [vals structure next-fn]


Change confusing time zone variable name

--- src/main/clojure/pdok/postgres.clj
+++ src/main/clojure/pdok/postgres.clj
@@ -15,7 +15,10 @@
 (def wkt-writer (WKTWriter.))

 (def utcCal (Calendar/getInstance (TimeZone/getTimeZone "UTC")))
-(def nlZone (DateTimeZone/getDefault)) ;; used for reading datetimes, because postgres returns Z values
+
+;; The server's time zone, not necessarily Europe/Amsterdam.
+;; Used for reading DateTimes, because PostgreSQL returns Z values and we want local ones without time zone.
+(def serverTimeZone (DateTimeZone/getDefault))

 (extend-protocol j/ISQLValue
   org.joda.time.DateTime
@@ -116,9 +119,9 @@

 (extend-protocol j/IResultSetReadColumn
   java.sql.Date
-  (result-set-read-column [v _ _] (LocalDate. ^java.sql.Date v ^DateTimeZone nlZone))
+  (result-set-read-column [v _ _] (LocalDate. ^java.sql.Date v ^DateTimeZone serverTimeZone))
   java.sql.Timestamp
-  (result-set-read-column [v _ _] (LocalDateTime. ^java.sql.Timestamp v  ^DateTimeZone nlZone))
+  (result-set-read-column [v _ _] (LocalDateTime. ^java.sql.Timestamp v ^DateTimeZone serverTimeZone))
   java.sql.Array
   (result-set-read-column [v _ _]
     (into [] (.getArray v))))


(MAINT) whitespace commit; no changes

(MAINT) whitespace commit; no changes

--- src/clj/puppetlabs/services/request_handler/request_handler_service.clj
+++ src/clj/puppetlabs/services/request_handler/request_handler_service.clj
@@ -5,10 +5,10 @@
             [puppetlabs.trapperkeeper.services :as tk-services]))

 (tk/defservice request-handler-service
-               handler/RequestHandlerService
-               [[:PuppetServerConfigService get-config]]
-               (handle-request
-                 [this request]
-                 (let [jruby-service (tk-services/get-service this :JRubyPuppetService)
-                       config (core/config->request-handler-settings (get-config))]
-                   (core/handle-request request jruby-service config))))
+  handler/RequestHandlerService
+  [[:PuppetServerConfigService get-config]]
+  (handle-request
+    [this request]
+    (let [jruby-service (tk-services/get-service this :JRubyPuppetService)
+          config (core/config->request-handler-settings (get-config))]
+      (core/handle-request request jruby-service config))))


use deraen/boot-sass for +sass

use deraen/boot-sass for +sass

the boot-sass task mirrors the sass source directory instead of having an
:output-dir configuration - therefore the sass.scss sample is now
generated in the sass/css folder

the org.slf4j/slf4j-nop noop logger is also included as per
https://github.com/Deraen/sass4clj#log-configuration

--- src/leiningen/new/tenzing.clj
+++ src/leiningen/new/tenzing.clj
@@ -82,14 +82,15 @@
           (om?      opts) (conj "org.omcljs/om \"0.8.6\"")
           (reagent? opts) (conj "reagent \"0.5.0\"")
           (garden?  opts) (conj "org.martinklepsch/boot-garden \"1.2.5-3\" :scope \"test\"")
-          (sass?    opts) (conj "mathias/boot-sassc  \"0.1.1\" :scope \"test\"")
+          (sass?    opts) (conj "deraen/boot-sass  \"0.2.1\" :scope \"test\"")
+          (sass?    opts) (conj "org.slf4j/slf4j-nop  \"1.7.13\" :scope \"test\"")
           (less?    opts) (conj "deraen/boot-less \"0.2.1\" :scope \"test\"")))

 (defn build-requires [opts]
   (cond-> []
           (test?   opts) (conj "'[crisptrutski.boot-cljs-test :refer [test-cljs]]")
           (garden? opts) (conj "'[org.martinklepsch.boot-garden :refer [garden]]")
-          (sass?   opts) (conj "'[mathias.boot-sassc  :refer [sass]]")
+          (sass?   opts) (conj "'[deraen.boot-sass    :refer [sass]]")
           (less?   opts) (conj "'[deraen.boot-less    :refer [less]]")))

 (def test-tasks
@@ -123,7 +124,7 @@
 (defn build-steps [name opts]
   (cond-> []
           (garden? opts) (conj (str "(garden :styles-var '" name ".styles/screen\n:output-to \"css/garden.css\")"))
-          (sass?   opts) (conj (str "(sass :output-dir \"css\")"))
+          (sass?   opts) (conj (str "(sass)"))
           (less?   opts) (conj (str "(less)"))
           (less?   opts) (conj (str "(sift   :move {#\"less.css\" \"css/less.css\" #\"less.main.css.map\" \"css/less.main.css.map\"})"))))

@@ -189,7 +190,7 @@
     (apply (partial ->files data)
            (remove nil?
                    (vector (if (garden? opts)  ["src/clj/{{sanitized}}/styles.clj" (render "styles.clj" data)])
-                           (if (sass? opts)    ["sass/sass.scss" (render "sass.scss" data)])
+                           (if (sass? opts)    ["sass/css/sass.scss" (render "sass.scss" data)])

                            (if (test? opts)    ["test/cljs/{{sanitized}}/app_test.cljs" (render "app_test.cljs" data)])


guards import expression in ns declaration

- so it does not get changed while other parts of the ns decl gets
  mrandersoned. neccessary as mranderson does not handle java classes in
  deps (yet) -- fixes #1

--- src/leiningen/source_deps.clj
+++ src/leiningen/source_deps.clj
@@ -8,7 +8,8 @@
             [clojure.tools.namespace.file :refer [read-file-ns-decl]]
             [clojure.pprint :as pp]
             [leiningen.core.main :refer [info debug]])
-  (:import [java.util.zip ZipFile]))
+  (:import [java.util.zip ZipFile]
+           [java.util UUID]))

 (defn- zip-target-file
   [target-dir entry-path]
@@ -79,28 +80,99 @@
     (when-not (= old new)
       (spit file new))))

-(defn- unzip&update-artifact! [srcdeps src-path dep-hierarchy dep]
+(defn- import-fragment-left [clj-source]
+  (let [index-of-import (.indexOf clj-source ":import")]
+    (when (> index-of-import -1)
+      (drop (loop [ns-decl-fragment (reverse (take index-of-import clj-source))
+                   index-of-open-bracket 1]
+              (cond (= \( (first ns-decl-fragment))
+                    (- index-of-import index-of-open-bracket)
+
+                    (not (re-matches #"\s" (-> ns-decl-fragment first str)))
+                    (count clj-source)
+
+                    :default (recur (rest ns-decl-fragment) (inc index-of-open-bracket)))) clj-source))))
+
+(defn- import-fragment [clj-source]
+  (let [import-fragment-left (import-fragment-left clj-source)]
+    (when (and import-fragment-left (> (count import-fragment-left) 0))
+      (loop [index 1
+             open-close 0]
+        (if (> open-close 0)
+          (apply str (take index import-fragment-left))
+          (recur (inc index) (cond (= \( (nth import-fragment-left index))
+                                   (dec open-close)
+
+                                   (= \) (nth import-fragment-left index))
+                                   (inc open-close)
+
+                                   :default open-close)))))))
+
+(defn- garble-import! [file-prefix file import-fragment uuid]
+  (let [old (slurp (fs/file file-prefix file))
+        new (if import-fragment
+              (str/replace old import-fragment (str "\"" uuid "\""))
+              old)]
+    (when-not (= old new)
+      (spit (fs/file file-prefix file) new))))
+
+(defn- retrieve-import [file-prefix file]
+  (let [cont (slurp (fs/file file-prefix file))
+        import-fragment (import-fragment cont)]
+    (when-not (str/blank? import-fragment)
+      [file import-fragment])))
+
+(defn- find-orig-import [imports file]
+  (or (loop [imps imports]
+        (let [imp (first imps)]
+          (if (.endsWith (str file) (str (first imp)))
+            (second imp)
+            (recur (rest imps))))) ""))
+
+(defn- degarble-imports! [imports file uuid]
+  (let [old (slurp file)
+        orig-import (find-orig-import imports file)
+        new (str/replace old (str "\"" uuid "\"") orig-import)]
+    (when-not (= old new)
+      (spit file new))))
+
+(defn- fix-reference-in-imports [srcdeps repl-prefix imps clj-file]
+  (if-let [old-ns (->> clj-file (fs/file srcdeps) read-file-ns-decl second)]
+    (map #(vector (first %) (str/replace (second %) (str " " (name old-ns)) (str " " (name (replacement repl-prefix old-ns nil))))) imps)
+    imps))
+
+(defn- unzip&update-artifact! [uuid srcdeps src-path dep-hierarchy dep]
   (let [art-name (-> dep first name (str/split #"/") last)
         art-name-cleaned (str/replace art-name #"[\.-_]" "")
         art-version (str "v" (-> dep second (str/replace "." "v")))
-        clj-files (unzip (-> dep meta :file) srcdeps)
+        clj-files (doall (unzip (-> dep meta :file) srcdeps))
         repl-prefix (replacement-prefix "srcdeps" src-path art-name-cleaned art-version nil)
-        prefixes (reduce #(assoc %1 %2 (str (replacement repl-prefix %2 nil))) {} (possible-prefixes clj-files))]
+        prefixes (reduce #(assoc %1 %2 (str (replacement repl-prefix %2 nil))) {} (possible-prefixes clj-files))
+        imports (->> clj-files
+                     (reduce #(conj %1 (retrieve-import srcdeps %2)) [])
+                     (remove nil?)
+                     doall)
+        fixed-imports (reduce (partial fix-reference-in-imports srcdeps repl-prefix) imports clj-files)]
     (info (format "retrieving %s artifact. modified dependency name: %s modified version string: %s" art-name art-name-cleaned art-version))
     (info "   modified namespace prefix: " repl-prefix)
     (doseq [clj-file clj-files]
       (when-let [old-ns (->> clj-file (fs/file srcdeps) read-file-ns-decl second)]
-        (let [new-ns (replacement repl-prefix old-ns nil)
+        (let [import (find-orig-import imports clj-file)
+              new-ns (replacement repl-prefix old-ns nil)
               new-deftype (replacement repl-prefix old-ns true)]
+          ;; garble imports
+          (when-not (str/blank? import)
+            (garble-import! srcdeps clj-file import uuid))
           ;; fixing generated classes/deftypes
           (when (.contains (name old-ns) "-")
             (doseq [file (clojure-source-files [srcdeps])]
               (update-deftypes file old-ns new-deftype)))
           ;; move actual ns-s
           (move-ns old-ns new-ns srcdeps [srcdeps]))))
-    ;; fixing prefixes
+    ;; fixing prefixes, degarble imports
     (doseq [file (clojure-source-files [srcdeps])]
-      (doall (map (partial update-file file prefixes) (keys prefixes))))
+      (doall (map (partial update-file file prefixes) (keys prefixes)))
+      (degarble-imports! fixed-imports file uuid))
     ;; recur on transitive deps, omit clojure itself
     (when-let [trans-deps (dep-hierarchy dep)]
       (info (format "resolving transitive dependencies for %s:" art-name))
@@ -108,7 +180,7 @@
       (->> trans-deps
            keys
            (remove #(= (first %) (symbol "org.clojure/clojure")))
-           (map (partial unzip&update-artifact! srcdeps (fs/file src-path (str/join "/" ["deps" art-name-cleaned art-version])) trans-deps))
+           (map (partial unzip&update-artifact! uuid srcdeps (fs/file src-path (str/join "/" ["deps" art-name-cleaned art-version])) trans-deps))
            doall))))

 (defn source-deps
@@ -120,5 +192,6 @@
   (let [source-dependencies (filter source-dep? dependencies)
         srcdeps-relative (str (apply str (drop (inc (count root)) target-path)) "/srcdeps")
         dep-hierarchy (->> (aether/resolve-dependencies :coordinates source-dependencies :repositories repositories)
-                           (aether/dependency-hierarchy source-dependencies))]
-    (doall (map (partial unzip&update-artifact! srcdeps-relative (fs/file target-path "srcdeps") dep-hierarchy) (keys dep-hierarchy)))))
+                           (aether/dependency-hierarchy source-dependencies))
+        uuid (str (UUID/randomUUID))]
+    (doall (map (partial unzip&update-artifact! uuid srcdeps-relative (fs/file target-path "srcdeps") dep-hierarchy) (keys dep-hierarchy)))))


Reset RSpec before each test, and allow for flags like "--fast-fail".

However, those flags seem to stick (run every time after specified the first
time, which sucks.

--- src/circle/ruby.clj
+++ src/circle/ruby.clj
@@ -5,6 +5,7 @@
   (:import java.io.StringWriter)
   (:import java.lang.ref.WeakReference)
   (:use [circle.util.except :only (throw-if-not)])
+  (:require [clojure.string :as string])
   (:require fs))

 (declare eval ruby get-class get-module send)
@@ -150,8 +151,10 @@
 Note that rspec will run in whatever RAILS_ENV you started in, so you
   probably want to start in RAILS_ENV=test, or rspec will clear your
   DB, or tests will fail because they assume the DB cleaner runs."
-  [& subdirs]
-  (let [subdirs (if (empty? subdirs) [""] subdirs)
+  [& args]
+  (let [options (filter #(= (get % 0) \-) args)
+        subdirs (remove #(= (get % 0) \-) args)
+        subdirs (if (empty? subdirs) [""] subdirs)
         subdirs (map #(fs/join "spec" %) subdirs)
         command (format "
 require 'rubygems'
@@ -161,9 +164,11 @@
 puts 'Reloading factories'
 FactoryGirl.factories.clear
 FactoryGirl.find_definitions
-
-RSpec::Core::Runner.run(%s)
-" (vec subdirs))]
+RSpec.world.reset
+RSpec.world.shared_example_groups.clear
+
+RSpec::Core::Runner.run([\"%s\"])
+" (string/join "\", \"" (concat options subdirs)))]
     (eval command)))

 (defn get-kernel


New table writer, using temporary files.

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -7,14 +7,12 @@
   (:require [clojure.data.json :as json])
   (:use [cavm.binner :only (calc-bin)])
   (:use [clj-time.format :only (formatter unparse)])
-  (:use [cavm.hashable :only (ahashable get-array)])
+  (:use [cavm.hashable :only (ahashable)])
   (:use [korma.core :rename {insert kcinsert}])
   (:require [cavm.query.sources :as sources])
+  (:require [me.raynes.fs :as fs])
   (:gen-class))

-;(def db {:classname "org.h2.Driver"
-;         :subprotocol "h2"
-;         :subname "file:///data/TCGA/craft/h2/cavm.h2"})

 ; Coerce this sql fn name to a keyword so we can reference it.
 (def KEY-ID (keyword "SCOPE_IDENTITY()"))
@@ -26,8 +24,30 @@
 (def float-size 4)
 (def bin-size 100)
 (def score-size (* float-size bin-size))
-
-(declare normalize-meta) ; XXX need to organize this file
+; Add 30 for gzip header
+;( def score-size (+ 30 (* float-size bin-size)))
+
+;
+; Utility functions
+;
+
+(defn- chunked-pmap [f coll]
+  (->> coll
+       (partition-all 250)
+       (pmap (fn [chunk] (doall (map f chunk))))
+       (apply concat)))
+
+(defn memoize-key
+  "Memoize with the given function of the arguments"
+  [kf f]
+  (let [mem (atom {})]
+    (fn [& args]
+      (let [k (kf args)]
+        (if-let [e (find @mem k)]
+          (val e)
+          (let [ret (apply f args)]
+            (swap! mem assoc k ret)
+            ret))))))

 ;
 ; Table models
@@ -48,14 +68,16 @@

 (declare score-decode)

+(defn- cvt-scores [{scores :EXPSCORES :as v}]
+  (if scores
+    (assoc v :EXPSCORES (float-array (score-decode scores)))
+    v))
+
 (defentity probes
   (has-one features)
   (many-to-many scores :joins  {:lfk 'pid :rfk 'sid})
   (belongs-to experiments {:fk :eid})
-  (transform (fn [{scores :EXPSCORES :as v}]
-               (if scores
-                 (assoc v :EXPSCORES (float-array (score-decode scores)))
-                 v))))
+  (transform cvt-scores))

 (defentity scores
   (many-to-many probes :joins  {:lfk 'sid :rfk 'pid}))
@@ -326,6 +348,7 @@
 (def ^:private features-defaults
   (into {} (map #(vector % nil) features-columns)))

+
 (def ^:private features-meta
   {:table features
    :defaults features-defaults
@@ -397,35 +420,51 @@
         id)
       (insert table (values normmeta)))))

-; Insert probe & return id
-(defn- insert-probe [exp name]
-  (let [pid (insert probes (values {:eid exp :name name}))]
-    pid))
-
-(defn- insert-scores [slist]
-  (let [sid (insert scores (values {:expScores slist}))]
-    sid))
-
-(defn- insert-join [pid i sid]
-  (insert joins (values {:pid pid :i i :sid sid})))
+;
+; Hex
+;
+
+(def ^:private hex-chars (char-array "0123456789ABCDEF"))
+
+(defn- bytes->hex [^bytes ba]
+  (let [c (count ba)
+        out ^chars (char-array (* 2 c))]
+    (loop [i 0]
+      (when (< i c)
+        (aset out (* 2 i)
+              (aget ^chars hex-chars
+                    (bit-shift-right
+                      (bit-and 0xF0 (aget ba i))
+                      4)))
+        (aset out (+ 1 (* 2 i))
+              (aget ^chars hex-chars
+                    (bit-and 0x0F (aget ba i))))
+        (recur (inc i))))
+    (String. out)))

 ;
 ; Binary buffer manipulation.
 ;

-(def codec-length (memoize (fn [len]
-                             (binary/repeated :float-le :length len))))
-
-(defn- codec [blob]
-  (codec-length (/ (count blob) float-size)))
-
-(defn- score-decode [blob]
-  (binary/decode (codec blob) (io/input-stream blob)))
-
-(defn- score-encode [slist]
-  (let [baos (java.io.ByteArrayOutputStream.)]
-    (binary/encode (codec-length (count slist)) baos slist)
-    (.toByteArray baos)))
+(defn- sort-float-bytes
+  "Sorts a byte array by float byte order. This makes the bytes very slightly
+  more compressable."
+  [^bytes in]
+  (let [c (count in)
+        fc (/ c 4)
+        out (byte-array c)]
+    (loop [i 0
+           b1 0
+           b2 fc
+           b3 (* fc 2)
+           b4 (* fc 3)]
+      (when (< i c)
+        (aset out b1 (aget in i))
+        (aset out b2 (aget in (+ i 1)))
+        (aset out b3 (aget in (+ i 2)))
+        (aset out b4 (aget in (+ i 3)))
+        (recur (+ i 4) (inc b1) (inc b2) (inc b3) (inc b4))))
+    out))

 ; Pick elements of float array, by index.
 (defn apick-float [^floats a idxs]
@@ -451,40 +490,196 @@
     (.array bb)))

 ;
-;
-;
-
-(defn- insert-scores-block [block]
-  (insert-scores (get-array block)))
-
-(defn- insert-unique-scores-fn []
-  (memoize insert-scores-block))
-
-(defn- load-probe [insert-scores-fn exp row]
-  (let [pid (insert-probe exp (:probe (meta row)))
-        blocks (partition-all bin-size row)]
-    (doseq [[block i] (map vector blocks (range))]
-      (let [sid (insert-scores-fn (ahashable (score-encode block)))]
-        (insert-join pid i sid)))
+; Score encoders
+;
+
+(def codec-length (memoize (fn [len]
+                             (binary/repeated :float-le :length len))))
+
+(defn- codec [blob]
+  (codec-length (/ (count blob) float-size)))
+
+;(defn- score-decode [blob]
+;  (binary/decode (codec blob) (io/input-stream blob)))
+
+(defn- score-decode [blob]
+  (bytes-to-floats blob))
+
+(defn- score-encode-orig [slist]
+  (floats-to-bytes (float-array slist)))
+
+(defn- score-encodez
+  "Experimental compressing score encoder."
+  [slist]
+  (let [baos (java.io.ByteArrayOutputStream.)
+        gzos (java.util.zip.GZIPOutputStream. baos)]
+    (binary/encode (codec-length (count slist)) gzos slist)
+    (.finish gzos)
+    (.toByteArray baos)))
+
+(defn- score-sort-encodez
+  "Experimental compressing score encoder that sorts by byte order before compressing."
+  [slist]
+  (let [fbytes (score-encode-orig slist)
+        ^bytes sorted (sort-float-bytes fbytes)
+        baos (java.io.ByteArrayOutputStream.)
+        gzos (java.util.zip.GZIPOutputStream. baos)]
+    (.write gzos sorted)
+    (.finish gzos)
+    (.toByteArray baos)))
+
+(defn- score-decodez [blob]
+  (let [bais (java.io.ByteArrayInputStream. blob)
+        gzis (java.util.zip.GZIPInputStream. bais)]
+    (binary/decode (binary/repeated :float-le :length 10) gzis)))
+
+(def score-encode score-encode-orig)
+
+;
+; Table writer that updates tables as rows are read.
+;
+
+; Insert probe & return id
+(defn- insert-probe [exp name]
+  (let [pid (insert probes (values {:eid exp :name name}))]
+    pid))
+
+(defn- insert-scores [slist]
+  (let [sid (insert scores (values {:expScores slist}))]
+    sid))
+
+(defn- insert-join [pid i sid]
+  (insert joins (values {:pid pid :i i :sid sid})))
+
+(defn- table-writer-default [dir f]
+  (f {:insert-probe insert-probe
+         :insert-score insert-scores
+         :insert-join insert-join
+         :encode score-encode
+         :key ahashable}))
+
+;
+; Table writer that updates one table at a time by writing to temporary files.
+;
+
+(defn- insert-probe-out [^java.io.BufferedWriter out seqfn eid name]
+  (let [pid (seqfn)]
+    (.write out (str pid "\t" eid "\t" name "\n"))
+    pid))
+
+; Iterators are not typical of clojure, but it's a quick way to get sequential ids
+; deep in a call stack. A more conventional way might be to return the data up
+; the stack, then zip with the sequence ids.
+(defn- seq-iterator [s]
+    (let [a (atom s)]
+    (fn []
+       (let [s @a]
+          (reset! a (next s))
+          (first s)))))
+
+(defn- sequence-seq [seqname]
+  (let [cmd (format "SELECT NEXT VALUE FOR %s AS i FROM SYSTEM_RANGE(1, 100)" seqname)]
+    (apply concat
+           (repeatedly
+             (fn [] (-> cmd str
+                        (exec-raw :results)
+                        (#(map :I %))))))))
+
+(defn- insert-scores-out [^java.io.BufferedWriter out seqfn slist]
+  (let [sid (seqfn)]
+    (.write out (str sid "\t" (:hex slist) "\n"))
+    sid))
+
+(defn- insert-joins-out [^java.io.BufferedWriter out pid i sid]
+  (.write out (str pid "\t" i "\t" sid "\n")))
+
+(defn- sequence-for-column [table column]
+  (-> (exec-raw
+        ["SELECT SEQUENCE_NAME FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME=? AND COLUMN_NAME=?"
+         [table column]]
+        :results)
+      first
+      :SEQUENCE_NAME))
+
+(defn- read-from-tsv [table file & cols]
+  (-> "INSERT INTO `%s` SELECT * FROM CSVREAD('%s', '%s', 'fieldSeparator=\t')"
+      (format table file (clojure.string/join "\t" cols))
+      (exec-raw)))
+
+(defn- table-writer [dir f]
+  (let [probes-seq (-> (sequence-for-column "PROBES" "ID") sequence-seq seq-iterator)
+        scores-seq (-> (sequence-for-column "SCORES" "ID") sequence-seq seq-iterator)
+        pfname (fs/file dir "probes.tmp")
+        sfname (fs/file dir "scores.tmp")
+        jfname (fs/file dir "joins.tmp")]
+    (try
+      (with-open
+        [probes-file (io/writer pfname)
+         scores-file (io/writer sfname)
+         joins-file (io/writer jfname)]
+        (f {:insert-probe (partial insert-probe-out probes-file probes-seq)
+               :insert-score (partial insert-scores-out scores-file scores-seq)
+               :insert-join (partial insert-joins-out joins-file)
+               :encode (fn [scores] (let [s (score-encode scores)] {:scores s :hex (bytes->hex s)}))
+               :key #(ahashable (:scores (first %)))}))
+      (time (do (read-from-tsv "probes" pfname "PID" "EID" "NAME")
+                (read-from-tsv "scores" sfname "ID" "SCORES")
+                (read-from-tsv "joins" jfname "PID" "I" "SID")))
+      (finally
+        (fs/delete pfname)
+        (fs/delete sfname)
+        (fs/delete jfname)))))
+
+;
+; Main loader routines
+;
+
+(defn- insert-scores-block [writer block]
+  ((:insert-score writer) block))
+
+(defn- insert-unique-scores-fn [writer]
+  (memoize-key (:key writer) (partial insert-scores-block writer)))
+
+(defn- load-probe [writer insert-scores-fn exp row]
+  (let [pid ((:insert-probe writer) exp (:probe row))
+        blocks (:data row)]
+    (doseq [[block i] (mapv vector blocks (range))]
+      (let [sid (insert-scores-fn block)]
+        ((:insert-join writer) pid i sid)))
     pid))

 (defn- inferred-type
   "Replace the given type with the inferred type"
   [fmeta row]
-  (assoc fmeta "valueType" (:valueType (meta row))))
-
-(defn- load-probe-feature [insert-scores-fn exp acc row]
-  (let [pid (load-probe insert-scores-fn exp row)]
-    (if-let [feature (:feature (meta row))]
+  (assoc fmeta "valueType" (:valueType row)))
+
+(defn- load-probe-feature [writer insert-scores-fn exp acc row]
+  (let [pid (load-probe writer insert-scores-fn exp row)]
+    (if-let [feature (:feature row)]
       (cons [pid (inferred-type feature row)] acc)
       acc)))

+(defn- insert-exp-sample [eid sample i]
+  (insert exp_samples (values {:experiments_id eid :name sample :i i})))
+
+(defn- load-exp-samples [exp samples]
+  (dorun (map #(apply (partial insert-exp-sample exp) %)
+              (map vector samples (range)))))
+
+(defn- encode-scores [writer row]
+  (mapv (:encode writer) (partition-all bin-size row)))
+
 ; insert matrix, updating scores, probes, and joins tables
-(defn- load-exp-matrix [exp matrix]
-  (let [scores-fn (insert-unique-scores-fn)
-        loadp (partial load-probe-feature scores-fn exp)
-        probe-meta (reduce loadp '() matrix)]
-    (load-probe-meta probe-meta)))
+(defn- load-exp-matrix [exp matrix-fn writer]
+  (let [matrix (matrix-fn)]
+    (load-exp-samples exp (:samples (meta matrix)))
+    (let [scores-fn (insert-unique-scores-fn writer)
+          loadp (partial load-probe-feature writer scores-fn exp)
+          ; XXX rework cgdata so the fields aren't in the metadata
+          matrix (chunked-pmap #(assoc (meta %) :data (encode-scores writer %)) matrix)
+          probe-meta (reduce loadp '() matrix)]
+      (load-probe-meta probe-meta))))
+

 ; XXX Update to return all samples in cohort by merging
 ; exp_samples.
@@ -510,13 +705,6 @@
 ;       (hash-by-key :SAMPLE)
 ;       (in-order sample-list)
 ;       (select-val :ID)))
-
-(defn- insert-exp-sample [eid sample i]
-  (insert exp_samples (values {:experiments_id eid :name sample :i i})))
-
-(defn- load-exp-samples [exp samples]
-  (dorun (map #(apply (partial insert-exp-sample exp) %)
-              (map vector samples (range)))))

 (let [fmtr (formatter "yyyy-MM-dd hh:mm:ss")]
   (defn- format-timestamp [timestamp]
@@ -565,16 +753,15 @@

   ([files metadata matrix-fn features force]
    (kdb/transaction
-     (let [matrix (matrix-fn)
-           exp (merge-m-ent experiments-meta metadata)
+     (let [exp (merge-m-ent experiments-meta metadata)
            files (map fmt-time files)]
        (when (or force
                  (not (= (set files) (set (related-sources experiments exp)))))
          (clear-by-exp exp)
          (load-related-sources
            experiment_sources :experiments_id exp files)
-         (load-exp-samples exp (:samples (meta matrix)))
-         (load-exp-matrix exp matrix))))))
+         (table-writer "/dev/shm" ; XXX use db dir? root dir? tmp dir?
+                       (partial load-exp-matrix exp matrix-fn)))))))

 ; XXX factor out common parts with merge, above?
 (defn del-exp [file]
@@ -629,7 +816,8 @@
 (defn create-db [file]
   (kdb/create-db  {:classname "org.h2.Driver"
                    :subprotocol "h2"
-                   :subname file}))
+                   :subname file
+                   :make-pool true}))

 (defmacro with-db [db & body]
   `(kdb/with-db ~db ~@body))
@@ -717,7 +905,25 @@
 (defn- col-arrays [columns n]
   (zipmap columns (repeatedly (partial float-array n))))

-; XXX Need to fill in NAN for unknown samples.
+(def probe-query
+  "SELECT  gene, i, expscores from
+     (SELECT  `probes`.`name` as `gene`, `probes`.`id`  FROM `probes`
+       INNER JOIN TABLE(name varchar=?) T ON T.`name`=`probes`.`name`
+       WHERE (`probes`.`eid` = ?)) P
+   LEFT JOIN `joins` on P.id = `joins`.`pid`
+   LEFT JOIN `scores` ON `sid` = `scores`.`id`
+   WHERE `joins`.`i` in (%s)")
+
+(defn select-scores-full [eid columns bins]
+  (let [q (format probe-query
+                  (clojure.string/join ","
+                                       (repeat (count bins) "?")))
+        c (to-array (map str columns))
+        i (to-array bins)]
+    (exec-raw [q (concat [c eid] i)] :results)))
+
+; Doing an inner join on a table literal, instead of a big IN clause, so it will hit
+; the index.
 (defn genomic-read-req [req]
   (let [{samples 'samples table 'table columns 'columns} req
         eid (exp-by-name table)
@@ -725,12 +931,26 @@
         bins (map :bin s-in-exp)
         bfns (pick-samples-fns samples s-in-exp)]

+    (-> (select-scores-full eid columns (distinct bins))
+        (#(map cvt-scores %))
+        (build-score-arrays bfns (col-arrays columns (count samples))))))
+
+; XXX Need to fill in NAN for unknown samples.
+; XXX call (double-array) to convert to double here, or in genomic-source
+; XXX This query is slow
+(comment (defn genomic-read-req [req]
+  (let [{samples 'samples table 'table columns 'columns} req
+        eid (exp-by-name table)
+        s-in-exp (map merge-bin-off (exp-samples-in-list eid samples))
+        bins (map :bin s-in-exp)
+        bfns (pick-samples-fns samples s-in-exp)]
+
     (-> (select-scores)
         (for-experiment eid)
         (with-genes columns)
         (with-bins bins)
         (do-select)
-        (build-score-arrays bfns (col-arrays columns (count samples))))))
+        (build-score-arrays bfns (col-arrays columns (count samples)))))))

 ; doall is required so the seq is evaluated in db context.
 ; Otherwise lazy map may not be evaluted until the context is lost.