Split long lines.

Split long lines.

--- src/cbfg/test/kvs.cljs
+++ src/cbfg/test/kvs.cljs
@@ -182,7 +182,8 @@
                               (let [res6 (atake tkvs res-ch6)]
                                 (and (:sq res6)
                                      (e n res6
-                                        (dissoc (merge m6 {:status :ok :key :a :sq (:sq res6)})
+                                        (dissoc (merge m6 {:status :ok :key :a
+                                                           :sq (:sq res6)})
                                                 :changes)
                                         nil)
                                      (e n (atake tkvs res-ch6)
@@ -201,7 +202,8 @@
                                           (e n res7
                                              (dissoc (merge m7 {:partial :ok
                                                                 :key :a
-                                                                :entry {:key :a :val :A :sq (:sq res6)}})
+                                                                :entry {:key :a :val :A
+                                                                        :sq (:sq res6)}})
                                                      :keys)
                                              nil)
                                           (e n (atake tkvs res-ch7)
@@ -219,19 +221,22 @@
                                         (e n (atake tkvs res-ch7)
                                            (dissoc (merge m7 {:partial :ok
                                                               :key :a
-                                                              :entry {:key :a :val :A :sq (:sq res6)}})
+                                                              :entry {:key :a :val :A
+                                                                      :sq (:sq res6)}})
                                                    :keys)
                                            nil)
                                         (e n (atake tkvs res-ch7)
                                            (dissoc (merge m7 {:partial :ok
                                                               :key :a
-                                                              :entry {:key :a :val :A :sq (:sq res6)}})
+                                                              :entry {:key :a :val :A
+                                                                      :sq (:sq res6)}})
                                                    :keys)
                                            nil)
                                         (e n (atake tkvs res-ch7)
                                            (dissoc (merge m7 {:partial :ok
                                                               :key :a
-                                                              :entry {:key :a :val :A :sq (:sq res6)}})
+                                                              :entry {:key :a :val :A
+                                                                      :sq (:sq res6)}})
                                                    :keys)
                                            nil)
                                         (e n (atake tkvs res-ch7)
@@ -285,13 +290,15 @@
                                      :res-ch res-ch9
                                      :op :multi-change
                                      :kvs-ident (:kvs-ident open)
-                                     :changes [(cbfg.kvs/mutate-entry {:key :a :deleted true})]}]
+                                     :changes [(cbfg.kvs/mutate-entry {:key :a
+                                                                       :deleted true})]}]
                              (aput tkvs cmd-ch m9)
                              (and
                               (let [res9 (atake tkvs res-ch9)]
                                 (and (:sq res9)
                                      (e n res9
-                                        (dissoc (merge m9 {:status :ok :key :a :sq (:sq res9)})
+                                        (dissoc (merge m9 {:status :ok :key :a
+                                                           :sq (:sq res9)})
                                                 :changes)
                                         nil)
                                      (e n (atake tkvs res-ch9)


Renamed to event-run-ch.

Renamed to event-run-ch.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -130,6 +130,7 @@
             agw (make-ago-world num-worlds)
             get-agw (fn [] agw)
             event-ch (ago-chan agw)
+            event-run-ch (chan)
             make-timeout-ch (fn [actx delay] (ago-timeout agw delay))
             ; Init the top actx manually to avoid act recursion.
             w [{:gen-id gen-id
@@ -146,7 +147,6 @@
                   :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
                           ;         :first-taker-actx actx-or-nil}}.
                   :gen-id gen-id})
-            delayed-event-ch (chan)
             delayed-event-cb (fn [vis-next]
                                (println :on-delayed-event-cb @last-id))]
         (reset! prog-world {:world world
@@ -156,8 +156,8 @@
                             :clients {}
                             :res-ch (achan-buf world 10)})
         (cbfg.vis/process-events vis event-delay cbfg.vis/vis-event-handlers
-                                 event-ch step-ch delayed-event-ch)
-        (cbfg.vis/process-render el-prefix world delayed-event-ch delayed-event-cb)
+                                 event-ch step-ch event-run-ch)
+        (cbfg.vis/process-render el-prefix world event-run-ch delayed-event-cb)
         (make-net world
                   (:net-listen-ch @prog-world)
                   (:net-connect-ch @prog-world))
@@ -194,14 +194,14 @@
                 (when (= actx-id (last actx))
                   (swap! vis #(assoc-in % [:actxs actx :collapsed]
                                         (not (:collapsed actx-info))))
-                  (>! delayed-event-ch [@vis nil true nil])))
+                  (>! event-run-ch [@vis nil true nil])))
               (recur)))
           (<! prog-ch)
           (close! expand-ch)
           (close! cmd-ch)
           (close! req-ch)
           (close! event-ch)
-          (close! delayed-event-ch)
+          (close! event-run-ch)
           (recur (inc num-worlds)))))))

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


Refactored out fwd-put helper func.

Refactored out fwd-put helper func.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -20,9 +20,11 @@

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

-(defn fwd [actx ch-key m]
-  (act fwd actx
-       (areq fwd (ch-key m) m)))
+(defn fwd-put [actx ch-key m]
+  (act fwd-put actx (aput fwd-put (ch-key m) m)))
+
+(defn fwd-req [actx ch-key m]
+  (act fwd-req actx (areq fwd-req (ch-key m) m)))

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

@@ -61,9 +63,8 @@
     "lane-state"
     [lane-state (assoc m :status :ok :value lane-state)]
     "realms-list"
-    (do (act fwd-realms-list actx
-             (aput fwd-realms-list (:server-state-ch m)
-                   (assoc m :realm (:realm lane-state) :user (:user lane-state))))
+    (do (fwd-put actx :server-state-ch
+                 (assoc m :realm (:realm lane-state) :user (:user lane-state)))
         [lane-state nil])
     nil))

@@ -81,8 +82,8 @@

 (def rq-handlers
   {"authenticate" rq-authenticate
-   "lane-state" #(fwd %1 :lane-state-ch %2)
-   "realms-list" #(fwd %1 :lane-state-ch %2)
+   "lane-state" #(fwd-req %1 :lane-state-ch %2)
+   "realms-list" #(fwd-req %1 :lane-state-ch %2)
    "add" cbfg.world.base/example-add
    "sub" cbfg.world.base/example-add
    "count" cbfg.world.base/example-count


First stab at main function for program

First stab at main function for program

Unfortunately, samples are not actually recorded -- something is
wrong!

--- src/chameleon/core.clj
+++ src/chameleon/core.clj
@@ -1,7 +1,9 @@
 (ns chameleon.core
+  (:require [chameleon.users :as users]
+            [chameleon.crawler :as crawler])
   (:gen-class))

-(defn -main
-  "I don't do a whole lot ... yet."
-  [& args]
-  (println "Hello, World!"))
+(defn -main [& args]
+  (let [user-maps (crawler/crawl-users users/subject-ids)]
+    (crawler/update-users! user-maps)
+    (crawler/insert-samples! user-maps)))


fix input radius firefox

fix input radius firefox

--- frontend/src/uxbox/main/ui/workspace/sidebar/options/stroke.cljs
+++ frontend/src/uxbox/main/ui/workspace/sidebar/options/stroke.cljs
@@ -89,20 +89,22 @@

       [:span "Radius"]
       [:div.row-flex
-       [:input.input-text
-        {:placeholder "rx"
-         :type "number"
-         :value (precision-or-0 (:rx shape 0) 2)
-         :on-change #(on-border-change % :rx)}]
+       [:div.input-element.pixels
+        [:input.input-text
+         {:placeholder "rx"
+          :type "number"
+          :value (precision-or-0 (:rx shape 0) 2)
+          :on-change #(on-border-change % :rx)}]]
        [:div.lock-size
         {:class (when (:border-lock @local) "selected")
          :on-click on-border-proportion-lock}
         i/lock]
-       [:input.input-text
-        {:placeholder "ry"
-         :type "number"
-         :value (precision-or-0 (:ry shape 0) 2)
-         :on-change #(on-border-change % :ry)}]]
+       [:div.input-element.pixels
+        [:input.input-text
+         {:placeholder "ry"
+          :type "number"
+          :value (precision-or-0 (:ry shape 0) 2)
+          :on-change #(on-border-change % :ry)}]]]

       [:span "Opacity"]
       [:div.row-flex


remove chart apis

remove chart apis

--- src/clj/ceres/core.clj
+++ src/clj/ceres/core.clj
@@ -8,9 +8,9 @@
             [org.httpkit.server :refer [with-channel on-close on-receive run-server send!]]
             [net.cgrand.enlive-html :refer [deftemplate set-attr append html substitute content]]
             [ceres.collector :refer [store set-db] :as collector]
-            [ceres.curator :refer [get-articles-count get-news-diffusion get-news-frequencies] :as curator]
+            [ceres.curator :refer [get-articles-count] :as curator]
             [ceres.executor :refer [start-executor]]
-            [gezwitscher.core :refer [start-filter-stream]]
+            [gezwitscher.core :refer [start-filter-stream gezwitscher]]
             [clojure.java.io :as io]
             [clojure.core.async :refer [close! put! timeout sub chan <!! >!! <! >! go go-loop] :as async]
             [taoensso.timbre :as timbre]))
@@ -57,8 +57,6 @@
   "Dispatch incoming websocket-requests"
   [{:keys [topic data] :as package}]
   (case topic
-    :news-frequencies (assoc package :data (get-news-frequencies))
-    :news-diffusion (assoc package :data (get-news-diffusion))
     :tweets-count (assoc package :data (curator/get-tweet-count))
     :init (assoc package :data
                  {:recent-articles (-> @server-state :app :recent-articles)
@@ -98,7 +96,6 @@
     (swap! state update-in [:app :recent-tweets] (fn [old new] (vec (take 100 (into [new] old)))) tweet)))

-
 (defn initialize
   "Initialize the server state using a given config file"
   [state path]
@@ -106,11 +103,22 @@
     (reset!
      state
      (-> path slurp read-string
-         (assoc-in [:app :handler] (partial stream-handler state))
          (assoc-in [:app :out-chans] [])
          (assoc-in [:app :recent-tweets] [])
          (assoc-in [:app :recent-articles] [])))
     (set-db (-> @state :app :db))))
+
+
+(defn start-stream [state]
+  (let [{:keys [follow track credentials]} (:app @state)
+        [in out] (gezwitscher credentials)]
+    (>!! in {:topic :start-stream :track track :follow follow})
+    (let [output (<!! out)]
+      (go-loop [status (<! (:status-ch output))]
+        (when status
+          (stream-handler state status)
+          (recur (<! (:status-ch output))))))
+    [in out]))

 (defroutes all-routes
@@ -133,8 +141,7 @@
   (info @server-state)
   (when (:http-server? @server-state)
     (run-server (site #'all-routes) {:port (:port @server-state) :join? false}))
-  (let [{:keys [follow track handler credentials]} (:app @server-state)]
-    (start-filter-stream follow track handler credentials))
+  (start-stream server-state)
   (when (:backup? @server-state)
     (start-executor (:backup-folder @server-state))))

@@ -143,11 +150,9 @@

   (initialize server-state "opt/server-config-1.edn")

-  (def stop-stream
-    (let [{:keys [follow track handler credentials]} (:app @server-state)]
-      (start-filter-stream follow track handler credentials)))
+  (def g (start-stream server-state))

-  (stop-stream)
+  (>!! (first g) {:topic :stop-stream})

   (def stop-server
     (do
@@ -155,4 +160,6 @@
       (timbre/set-config! [:shared-appender-config :spit-filename] (:logfile @server-state))
       (run-server (site #'all-routes) {:port (:port @server-state) :join? false})))

+  (stop-server)
+
   )


Adding Bioroid Efficiency Research

Adding Bioroid Efficiency Research

Since it plays almost like the newly improved Oversight AI, I guess we can also put this :)

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -2613,4 +2613,9 @@

    "The Source"
    {:events {:agenda-scored (effect (trash card)) :agenda-stolen (effect (trash card))}}
+
+   "Bioroid Efficiency Research"
+   {:choices {:req #(and (= (:type %) "ICE") (has? % :subtype "Bioroid") (not (:rezzed %)))}
+    :msg (msg "rez " (:title target) " at not cost")
+    :effect (effect (rez target {:no-cost true}))}
 })


fix Stimhack log message

fix Stimhack log message

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -2203,9 +2203,12 @@
                                  (system-msg state side "uses Stim Dealer to gain [Click]"))))}}}

    "Stimhack"
-   {:prompt "Choose a server" :choices (req servers) :msg " take 1 brain damage"
+   {:prompt "Choose a server" :choices (req servers)
     :effect (effect (gain :credit 9)
-                    (run target {:end-run {:effect (effect (damage :brain 1 {:unpreventable true :card card}))}} card))}
+                    (run target {:end-run
+                                 {:msg " take 1 brain damage"
+                                  :effect (effect (damage :brain 1 {:unpreventable true :card card}))}}
+                      card))}

    "Sub Boost"
    {:choices {:req #(and (= (:type %) "ICE") (:rezzed %))}


code formating

code formating

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -131,7 +131,7 @@
     :abilities [{:label "Take any number of [Credits] on Bank Job"
                  :prompt "How many [Credits]?" :choices :counter :msg (msg "gain " target " [Credits]")
                  :effect (req (gain state side :credit target)
-                                 (when (= target (:counter card)) (trash state :runner card)))}]}
+                              (when (= target (:counter card)) (trash state :runner card)))}]}

    "Beach Party"
    {:effect (effect (gain :max-hand-size 5)) :leave-play (effect (lose :max-hand-size 5))
@@ -348,7 +348,8 @@
    {:abilities [{:label "Add strength to a rezzed ICE protecting this server" :choices :credit
                  :prompt "How many credits?"
                  :effect (req (let [boost target]
-                                (resolve-ability state side
+                                (resolve-ability
+                                 state side
                                  {:choices {:req #(and (has? % :type "ICE") (:rezzed %))}
                                   :msg (msg "add " boost " strength to " (:title target))
                                   :effect (effect (trash card))} card nil)))}]}
@@ -393,7 +394,8 @@
    {:events {:corp-draw
              {:msg "draw 1 additional card" :once :per-turn
               :effect (req (let [c (move state side (first (:deck corp)) :hand)]
-                             (resolve-ability state side
+                             (resolve-ability
+                              state side
                               {:prompt "Choose a card to add to the bottom of R&D"
                                :choices [(last (:hand corp)) c]
                                :msg (msg "add 1 card to bottom of R&D" )
@@ -573,14 +575,14 @@

    "Encrypted Portals"
    {:msg (msg "gain " (reduce (fn [c server]
-                                    (+ c (count (filter (fn [ice] (and (has? ice :subtype "Code Gate")
-                                                                      (:rezzed ice))) (:ices server)))))
+                                (+ c (count (filter (fn [ice] (and (has? ice :subtype "Code Gate")
+                                                                   (:rezzed ice))) (:ices server)))))
                               0 (flatten (seq (:servers corp))))
               " [Credits]")
     :effect (effect (gain :credit
                           (reduce (fn [c server]
                                     (+ c (count (filter (fn [ice] (and (has? ice :subtype "Code Gate")
-                                                                      (:rezzed ice))) (:ices server)))))
+                                                                       (:rezzed ice))) (:ices server)))))
                                   0 (flatten (seq (:servers corp))))))}

    "Enhanced Vision"
@@ -650,7 +652,8 @@
    "Forged Activation Orders"
    {:choices {:req #(and (has? % :type "ICE") (not (:rezzed %)))}
     :effect (req (let [ice target]
-                   (resolve-ability state :corp
+                   (resolve-ability
+                    state :corp
                     {:prompt (msg "Rez " (:title ice) " or trash it?") :choices ["Rez" "Trash"]
                      :effect (effect (resolve-ability
                                       (if (and (= target "Rez") (<= (:cost ice) (:credit corp)))
@@ -1323,7 +1326,7 @@

    "Project Beale"
    {:effect (effect (set-prop card :counter (quot (- (:advance-counter card) 3) 2)
-                                   :agendapoints (+ 2 (quot (- (:advance-counter card) 3) 2))))}
+                              :agendapoints (+ 2 (quot (- (:advance-counter card) 3) 2))))}

    "Project Junebug"
    {:advanceable :always
@@ -1401,7 +1404,8 @@
    {:player :corp :prompt "Guess the amount the Runner will spend on Push the Luck"
     :choices ["Even" "Odd"] :msg "make the Corp choose a guess"
     :effect (req (let [guess target]
-                   (resolve-ability state :runner
+                   (resolve-ability
+                    state :runner
                     {:choices :credit :prompt "How many credits?"
                      :msg (msg "spend " target " [Credits]. The Corp guessed " guess)
                      :effect (req (when (or (and (= guess "Even") (odd? target))
@@ -1420,7 +1424,8 @@
    "Queens Gambit"
    {:choices ["0", "1", "2", "3"] :prompt "How many advancement tokens?"
     :effect (req (let [c (Integer/parseInt target)]
-                   (resolve-ability state side
+                   (resolve-ability
+                    state side
                     {:choices {:req #(= (last (:zone %)) :content)}
                      :msg (msg "add " c " advancement tokens on a card and gain " (* 2 c) " [Credits]")
                      :effect (effect (gain :credit (* 2 c)) (add-prop :corp target :advance-counter c))}
@@ -1468,7 +1473,7 @@
    {:prompt "Choose a card from Archives" :msg (msg "add copies of " (:title target) " to HQ")
     :choices (req (filter #(not= (:title %) "Reclamation Order") (:discard corp)))
     :effect (req (doseq [c (filter #(= (:title target) (:title %)) (:discard corp))]
-               (move state side c :hand)))}
+                   (move state side c :hand)))}

    "Replicator"
    {:events {:runner-install
@@ -1582,23 +1587,24 @@

    "Scavenge"
    {:choices {:req #(= (:type %) "Program")}
-    :effect  (req (let [trashed target]
-                       (trash state side trashed)
-                       (resolve-ability state side
-                                        {:prompt  "Install a card from Grip or Heap?" :choices ["Grip" "Heap"]
-                                         :effect  (req (let [fr target]
-                                                            (system-msg state side (str "trashes " (:title trashed)
-                                                                                " to install a card from " fr))
-                                                            (resolve-ability state side
-                                                              {:prompt "Choose a program to install"
-                                                               :choices (req (filter #(and (= (:type %) "Program")
-                                                                                (<= (:cost %) (+ (:credit runner) (:cost trashed))))
-                                                                                ((if (= fr "Grip") :hand :discard ) runner)))
-                                                               :effect (effect (gain :credit (min (:cost target) (:cost trashed)))
-                                                                               (runner-install target))
-
-                                                               } card nil)))
-                                         } card nil)))}
+    :effect
+    (req (let [trashed target]
+           (trash state side trashed)
+           (resolve-ability
+            state side
+            {:prompt "Install a card from Grip or Heap?" :choices ["Grip" "Heap"]
+             :effect (req (let [fr target]
+                            (system-msg state side (str "trashes " (:title trashed) " to install a card from " fr))
+                            (resolve-ability
+                             state side
+                             {:prompt "Choose a program to install"
+                              :choices (req (filter #(and (= (:type %) "Program")
+                                                          (<= (:cost %) (+ (:credit runner) (:cost trashed))))
+                                                    ((if (= fr "Grip") :hand :discard ) runner)))
+                              :effect (effect (gain :credit (min (:cost target) (:cost trashed)))
+                                              (runner-install target))}
+                             card nil)))}
+            card nil)))}

    "Scorched Earth"
    {:req (req tagged) :effect (effect (damage :meat 4))}
@@ -1702,7 +1708,8 @@
    "Shipment from SanSan"
    {:choices ["0", "1", "2"] :prompt "How many advancement tokens?"
     :effect (req (let [c (Integer/parseInt target)]
-                   (resolve-ability state side
+                   (resolve-ability
+                    state side
                     {:choices {:req #(or (= (:advanceable %) "always")
                                          (and (= (:advanceable %) "while-rezzed") (:rezzed %))
                                          (= (:type %) "Agenda"))}
@@ -1737,7 +1744,8 @@
    {:trace {:base 3 :choices {:req #(has? % :subtype "Connection")}
             :msg (msg "attempt to trash " (:title target))
             :effect (req (let [c target]
-                           (resolve-ability state side
+                           (resolve-ability
+                            state side
                             {:prompt (msg "Take 1 tag to prevent " (:title c) " from being trashed?")
                              :choices ["Yes" "No"] :player :runner
                              :effect (effect (resolve-ability
@@ -1822,14 +1830,14 @@

    "Superior Cyberwalls"
    {:msg (msg "gain " (reduce (fn [c server]
-                                    (+ c (count (filter (fn [ice] (and (has? ice :subtype "Barrier")
-                                                                      (:rezzed ice))) (:ices server)))))
+                                (+ c (count (filter (fn [ice] (and (has? ice :subtype "Barrier")
+                                                                   (:rezzed ice))) (:ices server)))))
                               0 (flatten (seq (:servers corp))))
               " [Credits]")
     :effect (effect (gain :credit
                           (reduce (fn [c server]
                                     (+ c (count (filter (fn [ice] (and (has? ice :subtype "Barrier")
-                                                                      (:rezzed ice))) (:ices server)))))
+                                                                       (:rezzed ice))) (:ices server)))))
                                   0 (flatten (seq (:servers corp))))))}

    "Sure Gamble"
@@ -1951,32 +1959,34 @@

    "Trick of Light"
    {:choices {:req #(and (contains? % :advance-counter) (> (:advance-counter %) 0))}
-    :effect  (req (let [fr target tol card]
-                       (resolve-ability state side
-                         {:prompt  "Move how many advancement tokens?"
-                          :choices (take (inc (:advance-counter fr)) ["0" "1" "2"])
-                          :effect  (req (let [c (Integer/parseInt target)]
-                                             (resolve-ability state side
-                                               {:prompt  "Move to where?"
-                                                :choices {:req #(and (not= (:cid fr) (:cid %))
-                                                                     (or (= (:advanceable %) "always")
-                                                                         (and (= (:advanceable %) "while-rezzed") (:rezzed %))
-                                                                         (= (:type %) "Agenda")))}
-                                                :effect  (effect (add-prop :corp target :advance-counter c)
-                                                                 (add-prop :corp fr :advance-counter (- c))
-                                                                 (system-msg (str "moves " c " advancement tokens from "
-                                                                                (if (:rezzed fr) (:title fr) "a card") " to "
-                                                                                (if (:rezzed target) (:title target) "a card"))))
-                                                } tol nil)))
-                          } card nil)))}
+    :effect
+    (req (let [fr target tol card]
+           (resolve-ability
+            state side
+            {:prompt "Move how many advancement tokens?"
+             :choices (take (inc (:advance-counter fr)) ["0" "1" "2"])
+             :effect (req (let [c (Integer/parseInt target)]
+                            (resolve-ability
+                             state side
+                             {:prompt  "Move to where?"
+                              :choices {:req #(and (not= (:cid fr) (:cid %))
+                                                   (or (= (:advanceable %) "always")
+                                                       (and (= (:advanceable %) "while-rezzed") (:rezzed %))
+                                                       (= (:type %) "Agenda")))}
+                              :effect  (effect (add-prop :corp target :advance-counter c)
+                                               (add-prop :corp fr :advance-counter (- c))
+                                               (system-msg (str "moves " c " advancement tokens from "
+                                                                (if (:rezzed fr) (:title fr) "a card") " to "
+                                                                (if (:rezzed target) (:title target) "a card"))))}
+                             tol nil)))}
+            card nil)))}

    "Turtlebacks"
    {:events {:server-created {:msg "gain 1 [Credits]" :effect (effect (gain :credit 1))}}}

    "Tyrs Hand"
    {:abilities [{:label "Prevent a subroutine on a Bioroid from being broken"
-                 :req (req (prn "tyr" (:zone current-ice) (:zone card))
-                       (and (= (butlast (:zone current-ice)) (butlast (:zone card)))
+                 :req (req (and (= (butlast (:zone current-ice)) (butlast (:zone card)))
                                 (has? current-ice :subtype "Bioroid"))) :effect (effect (trash card))
                  :msg (msg "prevent a subroutine on " (:title current-ice) " from being broken")}]}

@@ -2262,7 +2272,7 @@
    "Snowball"
    {:abilities [{:cost [:credit 1] :msg "break 1 barrier subroutine"}
                 {:cost [:credit 1] :msg "add 1 strength for the remainder of the run"
-                  :effect (effect (pump card 1 true))}]}
+                 :effect (effect (pump card 1 true))}]}

    "Sharpshooter"
    {:abilities [{:msg "break any number of destroyer subroutines" :effect (effect (trash card))}
@@ -2341,7 +2351,7 @@
                         :effect (req (let [dest (server->zone state target)]
                                        (swap! state update-in [:run]
                                               #(assoc % :position (count (get-in corp (conj dest :ices)))
-                                                        :server (rest dest))))
+                                                      :server (rest dest))))
                                      (move state side card (conj (server->zone state target) :ices)))}}}]}

    "Burke Bugs"
@@ -2734,7 +2744,7 @@
                  :msg "make the Runner continue the run on Archives"
                  :effect (req (swap! state update-in [:run]
                                      #(assoc % :position (count (get-in corp [:servers :archives :ices]))
-                                               :server [:archives])))}]}
+                                             :server [:archives])))}]}

    "Swarm"
    {:advanceable :always
@@ -2771,8 +2781,8 @@
    {:abilities [{:player :runner :prompt "Choose one" :choices ["Lose [Click]" "End the run"]
                  :label "Force the Runner to lose [Click] or end the run"
                  :effect (req (if-not (and (= target "Lose [Click]") (pay state side card :click 1))
-                             (do (end-run state side) (system-msg state side "ends the run"))
-                             (system-msg state side "loses [Click]")))}]}
+                                (do (end-run state side) (system-msg state side "ends the run"))
+                                (system-msg state side "loses [Click]")))}]}

    "Tsurugi"
    {:abilities [{:msg "end the run" :effect (effect (end-run))}


sample websocket client code

sample websocket client code

--- src/cljs/greybear.cljs
+++ src/cljs/greybear.cljs
@@ -1,2 +1,12 @@
 (ns greybear
-  (:require [goboard]))
+  (:require [goog.events]
+            [goog.net.WebSocket]
+            [goboard]))
+
+(defn on-open
+  [event]
+  (.log js/console "Opened!" event))
+
+(doto (goog.net.WebSocket.)
+  (goog.events/listen (.-OPENED goog.net.WebSocket/EventType) on-open)
+  (.open "ws://localhost:8080/websocket"))


add 'maybe-create-loaders' to facade.

add 'maybe-create-loaders' to facade.

--- src/ancient_clj/core.clj
+++ src/ancient_clj/core.clj
@@ -1,7 +1,7 @@
 (ns ancient-clj.core
   (:require [ancient-clj
              [artifact :as artifact]
-             [io :refer [loader-for]]
+             [io :as io]
              [load :refer [load-versions!]]]
             [version-clj.core :as v]
             [potemkin :refer [import-vars]]))
@@ -25,7 +25,18 @@
    `wrap` will be called on each loader function."
   [m & {:keys [wrap] :or {wrap identity}}]
   (->> (for [[id v] m]
-         [id (wrap (loader-for v))])
+         [id (wrap (io/loader-for v))])
+       (into {})))
+
+(defn ^{:added "0.3.12"} maybe-create-loaders
+  "Create loader map for a seq of ID/settings pairs representing
+   different repositories. Will contain `nil` values for unknown
+   loaders.
+
+   `wrap` will be called on each loader function."
+  [m & {:keys [wrap] :or {wrap identity}}]
+  (->> (for [[id v] m]
+         [id (some-> v io/maybe-loader-for wrap)])
        (into {})))

 ;; ## Result Handling


Update test

Update test

--- test/server/clojure_template/api_todos_test.clj
+++ test/server/clojure_template/api_todos_test.clj
@@ -4,10 +4,8 @@
             [clojure-template.helpers :refer [parse-body]]
             [clojure-template.server :refer [http-handler]]))

-(def response (http-handler (mock/request :get "/api/v1/todos")))
-
-(def body (parse-body response))
-
 (deftest get-todos
-  (is (= (:status response) 200))
-  (is (= 10 (count body))))
+  (let [response (http-handler (mock/request :get "/api/v1/todos"))
+        body (parse-body response)]
+    (is (= (:status response) 200))
+    (is (= 10 (count body)))))


remove debugging printlns

remove debugging printlns

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

--- acqEngine/src/org/micromanager/sequence_generator.clj
+++ acqEngine/src/org/micromanager/sequence_generator.clj
@@ -356,7 +356,6 @@
                                       channels slices default-exposure
                                       property-triggers position-index
                                       relative-slices]
-  (println "simple")
   (let [numChannels (max 1 (count channels))
         numSlices (max 1 (count slices))
         numFrames (max 1 numFrames)
@@ -424,7 +423,6 @@
                                  (sequence-fits-stage? (.getFocusDevice mmc) n-slices))
         no-channel-skips-frames (all-equal? 0 (map :skip-frames channels))
         all-channels-do-z-stack (all-equal? true (map :use-z-stack channels))]
-    (println slices-first)
     (if
       (and
         (or


CMR-2365: Added more comments.

CMR-2365: Added more comments.

--- metadata-db-app/src/cmr/metadata_db/services/concept_service.clj
+++ metadata-db-app/src/cmr/metadata_db/services/concept_service.clj
@@ -381,6 +381,13 @@
             ;; skip publication flag is only set for tag association when its associated collection
             ;; revision is force deleted. In this case, the tag association is no longer needed to
             ;; be indexed, so we don't publish the deletion event.
+            ;; We can't let the message get publish because by the time indexer get the message,
+            ;; the associated collection revision is gone and indexer won't be able to find it.
+            ;; The tag association is potentially created by a different user than the provider,
+            ;; so a collection revision is force deleted doesn't necessarily mean that the tag
+            ;; association is no longer needed. People might want to see what is in the old tag
+            ;; association potentially and force deleting it seems to run against the rationale
+            ;; that we introduced revisions in the first place.
             (when-not skip-publication
               (ingest-events/publish-event
                 context (ingest-events/concept-delete-event revisioned-tombstone)))


Refactor

Refactor

--- backend/src/akvo/lumen/lib/transformation/split_column.clj
+++ backend/src/akvo/lumen/lib/transformation/split_column.clj
@@ -64,7 +64,7 @@

 (defn- update-row [conn table-name row-id vals-map]
   (let [r (string/join "," (doall (map (fn [[k v]]
-                                         (str (name k) "=" (postgres/adapt-string-value v))) vals-map)))
+                                         (str k "=" (postgres/adapt-string-value v))) vals-map)))
         sql (str  "update " table-name " SET "  r " where rnum=" row-id)]
     (log/debug :sql sql)
     (jdbc/execute! conn sql)))


CMR-1699 Cleans up code.

CMR-1699 Cleans up code.

--- bootstrap-app/src/cmr/bootstrap/embedded_system_helper.clj
+++ bootstrap-app/src/cmr/bootstrap/embedded_system_helper.clj
@@ -1,9 +1,5 @@
 (ns cmr.bootstrap.embedded-system-helper
   "Contains general helper functions")
-
-(defn get-embedded
-  [system k]
-  (get-in system [:embedded-systems k]))

 (defn get-metadata-db
   "Returns the embedded metadata-db from the given bootstrap system"
@@ -22,4 +18,4 @@

 (defn get-virtual-products
   [system]
-  (get-embedded system :virtual-products))
+  (get-in system [:embedded-systems :virtual-products]))


Breaking out some of the functions for identifying types

--- src/doctopus/files.clj
+++ src/doctopus/files.clj
@@ -5,13 +5,27 @@
 ;; THIS IS TOTALLY DATABASS
 ;; (pprint (fs/walk vector "/Users/rossdonaldson/Code/doctopus/src/"))

+(defn is-type?
+  "Returns true if the type of the file matches the type given."
+  [file-handle type-regex]
+  (if (re-find type-regex (.getPath file-handle))
+    true
+    false
+    ))
+
+
 (defn markdown-type
   "returns true only for type files. Expects a Java.Util.FileHandle"
   [file-handle]
-  (if (re-find #"(?i)md|markdown|mdown$" (.getPath file-handle))
-    true
-    false
-    ))
+  (is-type? #"(?i)md|markdown|mdown$" (.getpath file-handle)
+            ))
+
+
+(defn restructured-type
+  "returns true only for type files. Expects a Java.Util.FileHandle"
+  [file-handle]
+  (is-type? #"(?i)rst|rest$" (.getPath file-handle)
+            ))

 (defn filter-the-docs
@@ -42,7 +56,7 @@

 (defn walk-the-docs
-  "Walk the docs"
+  "Walk the docs; currently only looks for Markdown Documents."
   [doc-root]
   (let [docs-all (fs/walk vector doc-root) ;; Triple of directory path, directory name, file name
         filtered-docs (filter-the-docs docs-all markdown-type)


Print out newlines so exception messages are easier to read

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -551,7 +551,9 @@
 with args:

 %s"
-     (printer/indent (pr-str (:reason problem)))
+     (printer/indent (if (string? (:reason problem))
+                       (str "\"" (:reason problem) "\"")
+                       (pr-str (:reason problem))))
      (printer/indent (string/join ", " (:val problem))))))

 (defmethod problem-group-str :expound.problem/fspec-exception-failure [type spec-name val path problems opts]


Allow nil category-path.

Allow nil category-path.

--- src/haystack/query.clj
+++ src/haystack/query.clj
@@ -93,12 +93,14 @@

 (defn build-zero-ancestor
   [path]
-  (if-let [ids (drop 1 (string/split path #"/"))]
+  (if-let [ids (drop 1 (string/split (or path "") #"/"))]
     (let [path-history (atom [])]
       (map (fn [x]
              (swap! path-history conj x)
              {:key (str "/" (string/join "/" @path-history)) :doc_count 0})
            ids))))
+;; (build-zero-ancestor "")
+;; (build-zero-ancestor nil)
 ;; (build-zero-ancestor "/a/bc/d")

 (defn extract-aggregations
@@ -110,8 +112,8 @@
         cat-path (:category-path query-map)
         cat-path-level (inc (slash-count cat-path))
         ;; cat-ancestors (flatten (map #(categories-at-level cats %) (range 0 cat-path-level)))
-        cat-ancestors (if (< 0 cat-path-level)
-                        (if-let [ancestors (flatten (map #(categories-at-level cats %) (range 1 cat-path-level)))]
+        cat-ancestors (when (< 0 cat-path-level)
+                        (when-let [ancestors (flatten (map #(categories-at-level cats %) (range 1 cat-path-level)))]
                           (if (empty? ancestors)
                             (build-zero-ancestor cat-path)
                             ancestors


first booking!

first booking!

--- src/kmc_booking/db.clj
+++ src/kmc_booking/db.clj
@@ -66,7 +66,7 @@
 	                    (sql/create-table-ddl "seats"
 	                                           [:id "varchar(10)" :primary :key]
 	                                           [:status "varchar(20)"]
-	                                           [:booking_id "varchar(32)"]))
+	                                           [:booking_id "varchar(48)"]))
 		(apply sql/insert! c "seats"
 			(gen-seats-data seat-schema))))

@@ -85,7 +85,7 @@
 		(sql/db-do-commands c
 	                    (sql/create-table-ddl "history"
 	                                           [:booking_id "varchar(48)"]
-	                                           [:seat "varchar(10)"]
+	                                           [:id "varchar(10)"]
 	                                           [:status "varchar(20)"]
 	                                           [:date :timestamp :default :current_timestamp]
 	                                           ))))
@@ -114,21 +114,32 @@

-;; TODO: Ideally in one trasaction
+;; TODO: trasaction
 ;; TODO: Check seats availability
-;; TODO: Apdate seats with status
+;; TODO: Update seats with status
 (defn create-booking [name phone seats]
-	(let [booking-id (gen-id)]
+	(let [booking-id (gen-id)
+		  records (for [rows (range 3 4)
+                 	  cols (range 1 40)]
+                      {:id (str rows "-" cols)
+                       :status "paid"
+                       :booking_id booking-id})]
+
 		(sql/with-db-connection [c CONN]
 			(sql/insert! c "bookings"
 	                  {
 	                  	:id booking-id
 	                  	:name name
 	                  	:phone phone
-	                  }
-			)
+	                  })
+
+			(apply sql/insert! c "history" records)
+
+			(doseq [r records]
+				(sql/update! c "seats" r ["id = ?" (get r :id)]))
 		)
-		booking-id
+
+
 	)
 )

@@ -143,7 +154,7 @@
 		(apply sql/insert! c "seats"
 			(gen-seats-data seat-schema))))

-(defn- migrate__seats_for_judges! []
+(defn migrate__seats_for_judges! []
 	(create-booking "ЖУРІ" "-" [])
 	)

@@ -169,7 +180,7 @@

 	(migrate-live! "1_reinit_seats" migrate__reinit_seats!)

-	;(migrate-live! "2_seats_for_judges"  migrate__seats_for_judges!)
+	(migrate-live! "2_seats_for_judges"  migrate__seats_for_judges!)

 )


Fix 'get-voom-version for root paths

Fix 'get-voom-version for root paths

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -90,6 +90,7 @@
   [path & {:keys [long-sha? gitdir]}]
   (let [shafmt (if long-sha? "%H" "%h")
         fmt (str "--pretty=" shafmt ",%cd")
+        path (get {"" "."} path path)
         {:keys [out]} (git {:gitdir gitdir} "log" "-1" fmt path)
         [sha, datestr] (-> out s/trim (s/split #"," 2))
         ctime (Date. ^String datestr)]


Prefer HTTPS for github repos is VOOM_GH_USER and VOOM_GH_PASS present

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -147,13 +147,31 @@
    {}
    (:lines (git {:gitdir gitdir} "remote" "-v"))))

+(defn https-credentials []
+  (let [creds (keep #(System/getenv %) ["VOOM_GH_USER" "VOOM_GH_PASS"])]
+    (when (seq creds) (vec creds))))
+
+(defn github-ssh-repo? [^String repo]
+  (.startsWith repo "git@github.com"))
+
+(defn github-ssh-path [^String ssh-repo]
+  (second (first (re-seq #"git@github.com:(.*)" ssh-repo))))
+
+(defn https-url-for [[user pass :as creds] ^String repo-path]
+  (str "https://" user ":" pass "@github.com/" repo-path))
+
 (defn ensure-repo
   "Makes sure the task-dir contains the specified repo, cloning it if not found."
   [^String repo]
   (let [repo-dir (->> repo .getBytes ^bytes b64/encode String. (io/file voom-repos))]
     (if (.exists repo-dir)
       true
-      (:bool (git {} "clone" repo repo-dir)))))
+      (let [clone-repo (if (and (github-ssh-repo? repo) (https-credentials))
+                         (let [https-repo (https-url-for (https-credentials) (github-ssh-path repo))]
+                           (println (format "Using %s instead of %s to clone" https-repo repo))
+                           https-repo)
+                         repo)]
+        (:bool (git {} "clone" clone-repo repo-dir))))))

 (defn ancestor?
   [gitdir old new]


wip - more script extraction, naming work, next - dirs? extra scripts

--- src/mirthsync/apis.clj
+++ src/mirthsync/apis.clj
@@ -2,13 +2,12 @@
   (:require [clojure.data.xml :as cdx]
             [clojure.data.zip :as cdz]
             [clojure.data.zip.xml :as cdzx]
-            [clojure.string :as cs]
             [clojure.tools.logging :as log]
             [clojure.zip :as cz]
             [mirthsync.actions :as ma]
             [mirthsync.files :as mf]
             [mirthsync.interfaces :as mi]
-            [clojure.data.xml :as xml])
+            [clojure.string :as cs])
   (:import java.io.File))

 (defn- api-element-id
@@ -330,6 +329,7 @@
   (let [base-path (mf/remove-extension file-path)]
     (loop [el-loc el-loc
            deconstruction []]
+      ;; (log/info (str "tag: " (:tag (cz/node el-loc))))
       (if (cz/end? el-loc)
         (conj deconstruction [file-path (cdx/indent-str (cz/root el-loc))])
         (let [[script-name script] (find-name-val el-loc)
@@ -341,13 +341,8 @@

           (recur next-el-loc deconstruction))))))

-(defn whole-node
-  "No deconstruction performed"
-  [file-path el-loc]
-  [[file-path (cdx/indent-str (cz/node el-loc))]])
-
 (defmethod mi/deconstruct-node :default [_ file-path el-loc]
-  (whole-node file-path el-loc))
+  [[file-path (cdx/indent-str (cz/node el-loc))]]) ;; just return whole node

 (defmethod mi/deconstruct-node :global-scripts [_ file-path el-loc]
   (deconstruct-node
@@ -357,19 +352,79 @@
      (when-let [name-loc (cdzx/xml1-> el-loc :entry :string)]
        [(cdzx/text name-loc) (cz/right name-loc)]))))

+(defn name-script-sequence
+  "Take a script loc to find and build the script name."
+  [prefix loc]
+  (str prefix
+       (cdzx/xml1-> loc cz/up :sequenceNumber cdzx/text)
+       (cdzx/xml1-> loc cz/up :name cdzx/text (fn [x]
+                                                (if (= x "")
+                                                  nil
+                                                  (str "-" x))))))
+
+(defn this-tag=
+  "Returns a query predicate that matches if the current exact node is a tag named
+  tagname."
+  [tagname]
+  (fn [loc]
+    (when (= tagname (:tag (cz/node loc)))
+      loc)))
+
 (def channel-deconstructors
-  [[#(cdzx/xml1-> % :connector :name cdzx/text)
-    #(cdzx/xml1-> % :connector :properties :script)]
-   [#(cdzx/xml1-> % :sourceConnector :name cdzx/text)
-    #(cdzx/xml1-> % :sourceConnector :properties :script)]
+  [[(partial name-script-sequence "destinationConnector-filter-step-")
+    #(cdzx/xml1-> %
+                  (this-tag= :com.mirth.connect.plugins.javascriptrule.JavaScriptRule)
+                  :script
+                  [cz/up cz/up cz/up :filter cz/up :destinationConnectors])]
+
+   [(fn [loc] (let [destname (apply cdzx/xml1-> loc (flatten [(repeat 4 cz/up) :name cdzx/text]))]
+                (str "destinationConnector-" destname "-" (name-script-sequence "transformer-step-" loc))))
+    #(cdzx/xml1-> %
+                  (this-tag= :com.mirth.connect.plugins.javascriptstep.JavaScriptStep)
+                  :script
+                  [cz/up cz/up cz/up :transformer cz/up :connector cz/up :destinationConnectors])]
+
+   [(fn [loc] (let [destname (apply cdzx/xml1-> loc (flatten [(repeat 4 cz/up) :name cdzx/text]))]
+                (str "destinationConnector-" destname "-" (name-script-sequence "responseTransformer-step-" loc))))
+    #(cdzx/xml1-> %
+                  (this-tag= :com.mirth.connect.plugins.javascriptstep.JavaScriptStep)
+                  :script
+                  [cz/up cz/up cz/up :responseTransformer cz/up :connector cz/up :destinationConnectors])]
+
+   [(partial name-script-sequence "sourceConnector-transformer-step-")
+    #(cdzx/xml1-> %
+                  (this-tag= :com.mirth.connect.plugins.javascriptstep.JavaScriptStep)
+                  :script
+                  [cz/up cz/up cz/up :transformer cz/up :sourceConnector])]
+
+   [(partial name-script-sequence "sourceConnector-filter-step-")
+    #(cdzx/xml1-> %
+                  (this-tag= :com.mirth.connect.plugins.javascriptrule.JavaScriptRule)
+                  :script
+                  [cz/up cz/up cz/up :filter cz/up :sourceConnector])]
+
+   [(fn [loc] (let [name (cdzx/xml1-> loc cz/up cz/up :name cdzx/text)]
+                (str "sourceConnector" (when-not (cs/blank? name)
+                                         (str "-" name)))))
+    #(cdzx/xml1-> % (this-tag= :script) [cz/up :properties cz/up :sourceConnector])]
+
+   [(fn [loc] (let [name (cdzx/xml1-> loc cz/up cz/up :name cdzx/text)]
+                (str "connector" (when-not (cs/blank? name)
+                                         (str "-" name)))))
+    #(cdzx/xml1-> % (this-tag= :script) [cz/up :properties cz/up :connector])]
+
    [(fn [_] "PreprocessingScript")
-    #(cdzx/xml1-> % :preprocessingScript)]
+    #(cdzx/xml1-> % (this-tag= :preprocessingScript))]
+
    [(fn [_] "PostprocessingScript")
-    #(cdzx/xml1-> % :postprocessingScript)]
+    #(cdzx/xml1-> % (this-tag= :postprocessingScript))]
+
    [(fn [_] "DeployScript")
-    #(cdzx/xml1-> % :deployScript)]
+    #(cdzx/xml1-> % (this-tag= :deployScript))]
+
    [(fn [_] "UndeployScript")
-    #(cdzx/xml1-> % :undeployScript)]])
+    #(cdzx/xml1-> % (this-tag= :undeployScript))]])
+

 (defmethod mi/deconstruct-node :channels [_ file-path el-loc]
   (deconstruct-node
@@ -378,38 +433,28 @@
    (fn [el-loc]
      (some (fn [[name script]]
              (when-let [script-loc (script el-loc)]
-               [(name el-loc) script-loc]))
+               [(name script-loc) script-loc]))
            channel-deconstructors))))

 (comment
-  (deconstruct-node (mi/file-path :global-scripts mirthsync.xml/app-conf1)
-                    (:el-loc mirthsync.xml/app-conf1))
-
-  (deconstruct-node (mi/file-path mirthsync.xml/api1 mirthsync.xml/app-conf1)
-                    mirthsync.xml/el-loc1)
-
-  (loop [el-loc mirthsync.xml/el-loc1]
-    (if (cz/end? el-loc)
-      (cz/root el-loc)
-      (let [script-name (cdzx/xml1-> el-loc :connector :name)
-            script (cdzx/xml1-> el-loc :connector :properties :script)
-            ]
-        ;; (log/infof "script-name: %s" script-name)
-        ;; (log/infof "script: %s" script)
-        (println (type script))
-        (when script
-          (printf "Found a script named %s\n" (cdzx/text script-name)))
-        (recur (cz/next el-loc))))
-    )
-
-  (def all-locs (take-while (complement cz/end?) (iterate cz/next mirthsync.xml/el-loc1)))
-  (def all-branches (filter cz/branch? all-locs))
-  (map #(:tag (cz/node %)) all-locs)
-
-  (reduce (fn [result el-loc]
-            (let [script-name (cdzx/xml1-> el-loc :connector :name)
-                  script (cdzx/xml1-> el-loc :connector :properties :script)]
-              (if script
-                (conj result [(cdzx/text script-name) (cdzx/text script) (:tag (cz/node el-loc))] )
-                result))) [] all-locs)
+
+  ;; pull
+  (mirthsync.core/main-func "-s" "https://localhost:8443/api"
+                            "-u" "admin" "-p" "admin" "-t" "target/tmp"
+                            "-i" "-f" "pull")
+
+  ;; load a channel for repl work
+  (def el-loc2 (cz/xml-zip (cdx/parse-str (slurp "target/tmp/Channels/This is a group/Hello DB Writer.xml"))))
+
+  ;; select first transformer elements
+  (cdzx/xml1-> el-loc2 :sourceConnector :transformer :elements cz/node)
+
+  (def first-transformer-jscript-step
+    (cdzx/xml1-> el-loc2
+                 :sourceConnector
+                 :transformer
+                 :elements
+                 :com.mirth.connect.plugins.javascriptstep.JavaScriptStep
+                 :script
+                 [cz/up cz/up cz/up :transformer cz/up :sourceConnector]))
 )


cleanup

cleanup

--- src/sormilla/video.clj
+++ src/sormilla/video.clj
@@ -23,12 +23,7 @@
     (when (< (inc i) size) (recur (inc i))))
   target)

-(defn buffer->image ^BufferedImage [^Long w ^Long h ^ints buffer]
-  (let [image (BufferedImage. w h BufferedImage/TYPE_INT_RGB)]
-    (.setRGB image 0 0 w h buffer 0 w)
-    image))
-
-(defn read-buffer [^InputStream in ^bytes buffer ^long offset ^long size]
+(defn read-fully [^InputStream in ^bytes buffer ^long offset ^long size]
   (IOUtils/readFully in buffer offset size))

 (defn make-reader [^InputStream in]
@@ -36,13 +31,13 @@
     (let [header   (byte-array 256)
           payload  (byte-array (+ 65535 MpegEncContext/FF_INPUT_BUFFER_PADDING_SIZE))]
       (try
-        (read-buffer in header 0 12)
+        (read-fully in header 0 12)
         (let [signature    (bin/get-int header 0)
               header-size  (bin/get-short header 6)
               payload-size (bin/get-int header 8)]
           (when-not (= signature 0x45566150) (throw (java.io.IOException. (format "out of sync (0x%08X)" signature))))
-          (read-buffer in header 12 (- header-size 12))
-          (read-buffer in payload 0 payload-size)
+          (read-fully in header 12 (- header-size 12))
+          (read-fully in payload 0 payload-size)
           [[header header-size] [payload payload-size]])
         (catch java.io.EOFException _
           nil)))))
@@ -70,14 +65,16 @@
       (let [picture         (.displayPicture (.priv_data context))
             width           (.imageWidth picture)
             height          (.imageHeight picture)
-            picture-buffer  (int-array (* width height))]
+            picture-buffer  (int-array (* width height))
+            image           (BufferedImage. width height BufferedImage/TYPE_INT_RGB)]
         (FrameUtils/YUV2RGB picture picture-buffer)
-        (buffer->image width height picture-buffer)))))
+        (.setRGB image 0 0 width height picture-buffer 0 width)
+        image))))

 (defn open-socket ^Socket []
   (doto (Socket.)
     (.setSoTimeout 2000)
-    (.connect (InetSocketAddress. "localhost" #_ comm/drone-ip 5555))))
+    (.connect (InetSocketAddress. #_ "localhost" comm/drone-ip 5555))))

 (defn save [^OutputStream out data]
   (doseq [[buffer size] data]
@@ -112,7 +109,7 @@
               (Thread/sleep 1000))
             (finally
               (try (.close socket) (catch Exception _))
-              (try (.close ^OutputStream @out) (catch Exception _))))))
+              (try (.close ^OutputStream out) (catch Exception _))))))
       (catch Throwable e
         (println "exception while processing video stream" e)
         (.printStackTrace e))


Minor change on docstrings on core functions.

--- src/suricatta/core.clj
+++ src/suricatta/core.clj
@@ -51,12 +51,22 @@
   ([ctx q] (proto/execute q ctx)))

 (defn fetch
-  "Fetch eagerly results executing a query."
+  "Fetch eagerly results executing a query.
+
+  This function returns a vector of records (default) or
+  rows (depending on specified opts). Resources are relased
+  inmediatelly without specific explicit action for it."
   ([q] (proto/fetch q nil {}))
   ([ctx q] (proto/fetch q ctx {}))
   ([ctx q opts] (proto/fetch q ctx opts)))

 (defn query
+  "Mark a query for reuse the prepared statement.
+
+  This function should be used with precaution and
+  close method should be called when query is not
+  longer needed. In almost all cases you should not
+  need use this function."
   [ctx querylike]
   (proto/query querylike ctx))


changed order slightly to fix dependencies and moved can-move? into move itself

--- src/tile_game/core.clj
+++ src/tile_game/core.clj
@@ -7,6 +7,10 @@
 (set! *warn-on-reflection* true)

 (def scale 150)
+(def dir-delta {:up [0 -1]
+                :down [0 1]
+                :left [-1 0]
+                :right [1 0]})

 (def colors [Color/RED Color/ORANGE Color/YELLOW Color/GREEN
              Color/BLUE Color/CYAN Color/GRAY Color/PINK])
@@ -35,31 +39,6 @@
         pos (position board piece)]
     [(rem pos dim) (quot pos dim)]))

-(defn move [board piece]
-  (let [empty-pos (position board 0)
-        pos (position board piece)]
-    (assoc board
-      empty-pos piece
-      pos 0)))
-
-(def dir-delta {:up [0 -1]
-                :down [0 1]
-                :left [-1 0]
-                :right [1 0]})
-
-(defn slide [board arg]
-  (move board (if (contains? dir-delta arg)
-                (move-direction board arg)
-                arg)))
-
-(defn move-direction [board direction]
-  (let [[x y] (coords board 0)
-        [dx dy] (dir-delta direction)
-        coords [(+ x dx) (+ y dy)]]
-    (if (bounded-coords? board coords)
-      (location board coords)
-      0)))
-
 (defn adjacent-coords [board [x y]]
   (let [adj-loc (map (fn [[dx dy]] [(+ x dx) (+ y dy)])
                      (vals dir-delta))]
@@ -80,6 +59,28 @@

 (defn solved? [board]
   (= (concat (range 1 (count board)) '(0)) board))
+
+(defn move [board piece]
+  (let [empty-pos (position board 0)
+        pos (position board piece)]
+    (if (can-move? board piece)
+      (assoc board
+        empty-pos piece
+        pos 0)
+      board)))
+
+(defn move-direction [board direction]
+  (let [[x y] (coords board 0)
+        [dx dy] (dir-delta direction)
+        coords [(+ x dx) (+ y dy)]]
+    (if (bounded-coords? board coords)
+      (location board coords)
+      0)))
+
+(defn slide [board arg]
+  (move board (if (contains? dir-delta arg)
+                (move-direction board arg)
+                arg)))

 (defn path-to [board goal]
   (let [current (coords board 0)]
@@ -114,16 +115,17 @@
                                 (dorun (for [x (range dim) y (range dim)]
                                          (render-tile g @*board* [x y])))))
         move! (fn ([piece]
-                    (dosync (when (can-move? @*board* piece)
-                              (alter *board* move piece)))
+                    (dosync (alter *board* move piece))
                     (.repaint panel)))
         mover! (fn [& moves]
                 (send (agent moves)
                       (fn [moves]
                         (doseq [m moves]
                           (move! m)
-                          (Thread/sleep 500)))))]
-    (dosync (ref-set *board* (vec (shuffle (range (* dim dim))))))
+                          (Thread/sleep 300)))))]
+    (dosync (ref-set *board* (vec (concat (range 1 (* dim dim)) '(0))))
+            (when (> dim 2)
+              (alter *board* shuffle)))
     (doto panel
       (.setPreferredSize (Dimension. size size))
       (.setFocusable true)
@@ -143,4 +145,4 @@
     mover!))

 (comment
-  (def move! (main 5)))
+  (def move! (main 3)))


Cleaned up new command arg parser a little.

--- src/carmine/commands.clj
+++ src/carmine/commands.clj
@@ -15,8 +15,12 @@
   [args]
   (let [num-non-optional (count (take-while #(not (:optional %)) args))
         num-non-multiple (count (take-while #(not (:multiple %)) args))
-        fixed-args       (->> args (take (min num-non-optional
-                                              (inc num-non-multiple)))
+
+        ;; Stop explicit naming on the 1st optional arg (exclusive) or 1st
+        ;; multiple arg (inclusive)
+        num-fixed        (min num-non-optional (inc num-non-multiple))
+
+        fixed-args       (->> args (take num-fixed)
                               (map :name) flatten (map symbol) vec)
         has-more? (seq (filter #(or (:optional %) (:multiple %)) args))]
     (if has-more? (conj fixed-args '& 'args) fixed-args)))


adding envs

adding envs

--- src/celestial/common.clj
+++ src/celestial/common.clj
@@ -43,6 +43,11 @@
   "nil on missing version of get!"
   [& keys]
    (get-in config keys))
+
+(defn envs
+   "get all currently defined env keys"
+   []
+  (keys (get* :hypervisor)))

 (defn slurp-edn [file] (read-string (slurp file)))


CLJS-634: do not call getPath on a null value.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -734,8 +734,8 @@
                   (recur (next sources)
                     (if-let [url (:url source)]
                       (let [path (.getPath ^URL url)]
-                        (if-let [compiled (get @compiled-cljs path)]
-                          (assoc merged (.getPath ^URL (:source-url source))
+                        (if-let [compiled (get @compiled-cljs path)]
+                          (assoc merged (when-let [source-url (:source-url source)] (.getPath ^URL source-url))
                             (sm/merge-source-maps
                               (:source-map compiled)
                               (get closure-source-map path)))


fix gen override by name, use in fspec ret gen

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -221,9 +221,10 @@
 (defn- gensub
   [spec overrides path rmap form]
   ;;(prn {:spec spec :over overrides :path path :form form})
-  (let [spec (c/or (get overrides spec) spec)
-        spec (specize spec)]
-    (if-let [g (c/or (get overrides path) (gen* spec overrides path rmap))]
+  (let [spec (specize spec)]
+    (if-let [g (c/or (get overrides (c/or (spec-name spec) spec))
+                     (get overrides path)
+                     (gen* spec overrides path rmap))]
       (gen/such-that #(valid? spec %) g 100)
       (let [abbr (abbrev form)]
         (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr)
@@ -1634,12 +1635,12 @@
                                (let [cargs (conform argspec args)]
                                  (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret})))))))))
                  {path {:pred 'ifn? :val f :via via :in in}}))
-     (gen* [_ _ _ _] (if gfn
+     (gen* [_ overrides _ _] (if gfn
              (gfn)
              (gen/return
               (fn [& args]
                 (assert (valid? argspec args) (with-out-str (explain argspec args)))
-                (gen/generate (gen retspec))))))
+                (gen/generate (gen retspec overrides))))))
      (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn))
      (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform)))))


add assertion for location-page

add assertion for location-page

--- src/cljs/ohds/pages.cljs
+++ src/cljs/ohds/pages.cljs
@@ -36,11 +36,13 @@
     options))

 (defn location-page [app-state]
+  {:pre [(not (nil? (:fieldworker-id app-state)))]}
   (let [location-id (atom "External ID")
         name (atom "Name")
         parents (atom nil)
         loctype (atom "URB")
-        parent (atom nil)]
+        parent (atom nil)
+        fw-id (:fieldworker-id app-state)]
     (go (let [result (<! (http/get
                           "/api/v1/locationHierarchy"
                           {:as :clojure}))
@@ -62,5 +64,5 @@
        [:div @parent]
        [:div
         [:button {:class "btn btn-lg btn-primary btn-block" :type "submit"
-                  :on-click (fn [])}
+                  :on-click (fn [] (println location-id))}
          "Submit"]]])))


Items EDN specs

Items EDN specs

--- src/clojure/yaw/spec.clj
+++ src/clojure/yaw/spec.clj
@@ -60,9 +60,17 @@

 ;; GLOBAL PARAMETERS
 (s/def :params/pos :vector/gen)
+(s/def :params/rot :vector/gen)
+(s/def :params/scale :vector/gen)
+(s/def :params/color (s/or :kw #{:red :blue :yellow :white :black} ;;more?
+                           :rgb :vector/norm))
+
 (s/def :params/target (s/or :item qualified-keyword?
                             :vec :vector/gen))
 (s/def :params/fov number?)
+
+;; mesh
+(s/def :params/mesh #{:mesh/box :mesh/cone :mesh/pyramid}) ;; exhaustive list?

 ;; CAMERAS
 (s/def :scene/camera (s/cat :tag #{:camera}
@@ -74,3 +82,15 @@

 ;; (s/conform :scene/camera [:camera :test/cam2 {:pos [0 2 -3] :target :test/item}])
 ;; => {:tag :camera, :id-kw :test/cam2, :params {:pos [0 2 -3], :target [:item :test/item]}}
+
+;; OBJECTS
+(s/def :scene/item (s/cat :tag #{:item}
+                          :id-kw qualified-keyword?
+                          :params (s/keys :req-un [:params/mesh :params/pos]
+                                          :opt-un [:params/rot :params/scale :params/color])))
+
+;; (s/conform :scene/item [:item :test/item {:mesh :mesh/box :pos [0 0 0] :rot [20 0 20] :color :red}])
+;; => {:tag :item, :id-kw :test/item, :params {:mesh :mesh/box, :pos [0 0 0], :rot [20 0 20], :color [:kw :red]}}
+
+;; (s/conform :scene/item [:item :test/item2 {:mesh :mesh/cone :pos [0 2 0] :scale [1 2 1] :color [0 1 0.9]}])
+;; => {:tag :item, :id-kw :test/item2, :params {:mesh :mesh/cone, :pos [0 2 0], :scale [1 2 1], :color [:rgb [0 1 0.9]]}}


Hack more

Hack more

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -581,7 +581,7 @@
                                              sum (reduce + (mapv * improvements weights))]
                                          (- sum)))))))
                           ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;HACKED STABILITY
-                          (if (not (:print-history argmap))
+                          #_(if (not (:print-history argmap))
                             (throw
                               (Exception.
                                 ":print-history must be true for :case-stagnation"))
@@ -599,6 +599,48 @@
                                                                 (partition 2 1 case-history))
                                              weights (take (count improvements)
                                                            (iterate (partial * (- 1 improvement-discount)) 0.5))
+                                             sum (reduce + (mapv * improvements weights))]
+                                         (- sum)))))))
+                          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;HACKED STABILITY
+                          #_(if (not (:print-history argmap))
+                            (throw
+                              (Exception.
+                                ":print-history must be true for :case-stagnation"))
+                            (if (empty? (rest (:history ind)))
+                              (vec (repeat (count (:errors ind)) 1000000))
+                              (vec (for [case-history (apply map list (:history ind))]
+                                     (if (zero? (first case-history))
+                                       -100000  ;; solved, improvement doesn't matter
+                                       (let [improvements (mapv (fn [[newer-error older-error]]
+                                                                  (if (< newer-error older-error)
+                                                                    1.0
+                                                                    (if (= newer-error older-error)
+                                                                      -1.0
+                                                                      0.0)))
+                                                                (partition 2 1 case-history))
+                                             weights (take (count improvements)
+                                                           (iterate (partial * (- 1 improvement-discount)) 0.5))
+                                             sum (reduce + (mapv * improvements weights))]
+                                         (- sum)))))))
+                          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;HACKED STABILITY
+                          (if (not (:print-history argmap))
+                            (throw
+                              (Exception.
+                                ":print-history must be true for :case-stagnation"))
+                            (if (empty? (rest (:history ind)))
+                              (vec (repeat (count (:errors ind)) 1000000))
+                              (vec (for [case-history (apply map list (:history ind))]
+                                     (if (zero? (first case-history))
+                                       -100000  ;; solved, improvement doesn't matter
+                                       (let [improvements (mapv (fn [[newer-error older-error]]
+                                                                  (if (< newer-error older-error)
+                                                                    1.0
+                                                                    (if (= newer-error older-error)
+                                                                      0.0
+                                                                      -1.0)))
+                                                                (partition 2 1 case-history))
+                                             weights (take (count improvements)
+                                                           (iterate (partial * (- 1 improvement-discount)) 1))
                                              sum (reduce + (mapv * improvements weights))]
                                          (- sum)))))))
                           (= cat :reproductive-infidelity)


CMR-183: Removed debug output.

CMR-183: Removed debug output.

--- src/cmr/common/cache.clj
+++ src/cmr/common/cache.clj
@@ -12,7 +12,6 @@
   "Looks up the value of the cached item using the key. If there is a cache miss it will invoke
   the function given with no arguments, save the value in the cache and return the value."
   [cmr-cache key f]
-  (debug "CMR-CACHE" cmr-cache)
   (-> (swap! (:atom cmr-cache)
              (fn [cache]
                (if (cc/has? cache key)


CMR-1788: Addressing Chris's comment.

CMR-1788: Addressing Chris's comment.

--- common-lib/src/cmr/common/util.clj
+++ common-lib/src/cmr/common/util.clj
@@ -519,7 +519,7 @@
             ;; Neither is in the map so compare them directly
             :else (compare k1 k2)))))))

-;; Copied from clojure.core.incubator. We were having issues referring to this after updating Clojure.
+;; Copied from clojure.core.incubator. We were having issues referring to this after updating to Clojure 1.7.
 (defn dissoc-in
   "Dissociates an entry from a nested associative structure returning a new
   nested structure. keys is a sequence of keys. Any empty maps that result


added rule to make hgnc-symbol to hgnc-integer-id skos:exactMatch mappings

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/id_mapping/skos_exact/hgnc_download_file_rules.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/id_mapping/skos_exact/hgnc_download_file_rules.clj
@@ -1,4 +1,17 @@
-
+`{:name "hgnc-symbol-hgnc-id-exact-mapping"
+  :description "HGNC has two unique identifiers for each record,
+  an approved gene symbol and a unique integer identifer. In the id-typing
+  rules we declare that both types kiao/denotesSubClassOf obo/SO_0000352. In
+  doing so, the bioentity generation machinery will create bio-entities for each
+  type. This particular rule is required to ensure that only a single bio-entity
+  gets created for each HGNC record. If the HGNC approved symbol and integer
+  identifier for a given HGNC record are not declared as skos/exactMatch then
+  two distinct bio-entities will be erroneously generated instead of just one."
+  :head ((?/hgncSymbolIce skos/exactMatch ?/hgncIntegerIdIce))
+  :body
+  (~@(kabob/rtv _/record
+        iaohgnc/HgncDownloadFileData_hgncGeneSymbolDataField1 ?/hgncSymbolIce
+        iaohgnc/HgncDownloadFileData_hgncIDDataField1  ?/hgncIntegerIdIce))}

 `{:name "hgnc-symbol-eg-id-exact-mapping"
   :head ((?/hgncSymbolIce skos/exactMatch ?/egIce))
@@ -39,4 +52,3 @@

-


Modified some scratch code that compares holdings.

--- dev-system/scratch.clj
+++ dev-system/scratch.clj
@@ -25,4 +25,45 @@
                     reverse
                     (take 10))

+(defn holdings->nested-map
+  [holdings]
+  (reduce (fn [pic {:keys [provider-id granule-count concept-id]}]
+            (assoc-in pic [provider-id concept-id] granule-count))
+          {}
+          holdings))

+(defn holdings-map->total
+  [holdings-map]
+  (reduce + (for [[_ concept-id-map] holdings-map
+                  [_ num-granules] concept-id-map]
+              num-granules)))
+
+(def testbed-holdings
+  (->> (decode (slurp "testbed_holdings.json") true)
+       (map #(update-in % [:granule_count] (fn [v] (Long. v))))
+       (map (fn [{:keys [dataset_id echo_collection_id granule_count provider_id]}]
+              {:granule-count granule_count
+               :provider-id provider_id
+               :entry-title dataset_id
+               :concept-id echo_collection_id}))
+       holdings->nested-map))
+
+
+(def sit-holdings
+  (holdings->nested-map (decode (slurp "sit_holdings.json") true)))
+
+(holdings-map->total sit-holdings)
+(holdings-map->total testbed-holdings)
+
+(let [[sit-extra tb-extra _] (clojure.data/diff sit-holdings testbed-holdings)]
+  {:sit-extra sit-extra
+   :tb-extra tb-extra})
+
+(get-in sit-holdings ["EDF_OPS" "C1000000261-EDF_OPS"])
+(get-in testbed-holdings ["EDF_OPS" "C1000000261-EDF_OPS"])
+
+(get-in sit-holdings ["EDF_OPS" "C1000000104-EDF_OPS"])
+(get-in testbed-holdings ["EDF_OPS" "C1000000104-EDF_OPS"])
+
+
+


Kill unused jgit dependency

Kill unused jgit dependency

--- backend/project.clj
+++ backend/project.clj
@@ -47,7 +47,6 @@
                  [doric "0.5.0"]
                  [robert/bruce "0.7.1"]
                  [com.jcraft/jsch  "0.1.45"] ; try to fix "Packet corrupt" errors.
-                 [org.eclipse.jgit/org.eclipse.jgit "1.1.0.201109151100-r"]
                  [com.cemerick/pomegranate "0.0.1"]

                  ;; Pallet/jClouds


Update io.prometheus/simpleclient_hotspot to "0.6.0"

--- backend/project.clj
+++ backend/project.clj
@@ -48,7 +48,7 @@
                  [selmer "1.12.12" :exclusions [com.fasterxml.jackson.dataformat/jackson-dataformat-smile com.fasterxml.jackson.dataformat/jackson-dataformat-cbor cheshire]]
                  [net.postgis/postgis-jdbc "2.2.1" :exclusions [org.postgresql/postgresql]]
                  [iapetos "0.1.8" :exclusions [io.prometheus/simpleclient]]
-                 [io.prometheus/simpleclient_hotspot "0.5.0"]
+                 [io.prometheus/simpleclient_hotspot "0.6.0"]
                  [io.prometheus/simpleclient_dropwizard "0.5.0"]
                  [org.clojure/test.check "0.10.0-alpha3"]]
   :source-paths   ["src" "specs"]


CMR-2911: Adding test-out alias so tests will work

--- collection-renderer-lib/project.clj
+++ collection-renderer-lib/project.clj
@@ -60,6 +60,8 @@
          :injections [(require 'pjstadig.humane-test-output)
                       (pjstadig.humane-test-output/activate!)]}}
   :aliases {"install-gems" ~(install-gems-command gem-versions)
-            "clean-gems" ["shell" "rm" "-rf" ~gem-install-path]})
+            "clean-gems" ["shell" "rm" "-rf" ~gem-install-path]
+            ;; Alias to test2junit for consistency with lein-test-out
+            "test-out" ["test2junit"]})


CMR-4095: MMT updated preview gem again. The new commit is 6983be7.

--- collection-renderer-lib/project.clj
+++ collection-renderer-lib/project.clj
@@ -14,7 +14,7 @@
    the hardcoded commit id during dev integration with cmr_metadata_preview project.
    The hardcoded commit id should be updated when MMT releases a new version of the gem."
   (or (System/getenv "CMR_METADATA_PREVIEW_COMMIT")
-      "2f3acec"))
+      "6983be7"))

 (def gem-install-path
   "The directory within this library where Ruby gems are installed."


Add 2 placeholder slides

Add 2 placeholder slides

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -71,13 +71,11 @@
 (defrecord TimeoutSlide [opts]
   Slide
   (init-slide-state [_]
-    {:status "READY"})
+    {:default-font (:font-size opts)
+     :status "READY"})

   (render-slide [_ data owner]
-    (let [bufsize (om/get-state owner :buffer-size)
-          buf (om/get-state owner :buf)
-          default-font (om/get-state owner :default-font)
-          radius (om/get-state owner :radius)]
+    (let [default-font (om/get-state owner :default-font)]
       [:div
        [:svg {:version "1.1" :width 800 :height 600}
         [:text {:x 30 :y 120 :style {:font-size default-font :stroke "white" :fill "white"}} (om/get-state owner :status)]
@@ -90,8 +88,41 @@
          [:rect {:x 0 :y 0 :width 280 :height 100 :fill "red"}]
          [:text {:x 30 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}} "(timeout 2000)"]]]])))

+
+(defrecord AltsSlide [opts]
+  Slide
+  (init-slide-state [_]
+    {:default-font (:font-size opts)
+     :status "READY"})
+  (render-slide [_ data owner]
+    (let [default-font (om/get-state owner :default-font)]
+      [:div
+       [:svg {:version "1.1" :width 800 :height 600}
+        [:text {:x 30 :y 120 :style {:font-size default-font :stroke "white" :fill "white"}} (om/get-state owner :status)]
+        [:g {:transform "translate(70,150)"
+             :onClick (fn [_]
+                        (om/set-state! owner :status "WAITING")
+                        (go
+                          (<! (timeout 2000))
+                          (om/set-state! owner :status "CLOSED")))}
+         [:rect {:x 0 :y 0 :width 280 :height 100 :fill "red"}]
+         [:text {:x 30 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}}
+          "(alts! ch (time-out 2000))"]]]])))
+
+(defrecord GoBlockSlide [opts]
+  Slide
+  (init-slide-state [_]
+    {:default-font (:font-size opts)})
+  (render-slide [_ data owner]
+    (let [default-font (om/get-state owner :default-font)]
+      [:div
+       [:svg {:version "1.1" :width 600 :height 600}
+        [:g {:transform "translate(70,150)"}
+         [:rect {:x 0 :y 0 :width 600 :height 600 :fill "red"}]
+         ]]])))
+
 (def app-model
-  (atom {:current-slide 4
+  (atom {:current-slide 8
          :slides
          [{:title "core.async"
            :event "QCon 2014"
@@ -117,10 +148,19 @@
            :custom (PutAndTakeSlide. {:buffer-size 7 :font-size "72pt" :radius 50})}

           {:subtitle "timeouts"
-           :custom (TimeoutSlide. {:buffer-size 5 :font-size "72pt" :radius 70})}
-
-          {:title "Buffers"
+           :custom (TimeoutSlide. {:font-size "72pt"})}
+
+          {:subtitle "buffers (TODO)"
            :code "(<! (chan))"}
+
+          {:subtitle "alts!"
+           :custom (AltsSlide. {:font-size "30pt"})}
+
+          {:subtitle "go blocks"
+           :custom (GoBlockSlide. {:font-size "30pt"})}
+          ;; Show result of race in alts! between a channel and a timeout
+
+          ;; Go blocks

           {:title "When?"}]}))


Fixed files getter.

Fixed files getter.

--- src/dragon/blog/core.clj
+++ src/dragon/blog/core.clj
@@ -138,7 +138,7 @@
     (->> posts-path
          (get-files)
          ((fn [x] (log/debugf "Found %s files ..." (count x)) x))
-         (map :file))))
+         (map #(hash-map :file %)))))

 (defn ingest-posts
   [system processor data]
@@ -150,6 +150,7 @@
   (let [raw-posts (get-posts system)
         processor-type (config/processor-type system)
         processor (post/new-processor-fn system)]
+    (log/trace "Posts:" (into [] raw-posts))
     (log/debug "Processor type:" processor-type)
     (log/debug "Processor constructor key:"
                (config/processor-constructor system))


Add ec2 to repl requires

Add ec2 to repl requires

--- backend/src/circle/repl.clj
+++ backend/src/circle/repl.clj
@@ -7,7 +7,8 @@
     (use 'clojure.repl)
     (use '[clojure.contrib.ns-utils :only (docs)])
     (use '[clojure.contrib.repl-utils :exclude (apropos source)])
-    (use '[circle.backend.ec2 :only (instances print-instances)])
+    (use '[circle.backend.ec2 :only (print-instances)])
+    (require '[circle.backend.ec2 :as ec2])
     (require '[somnium.congomongo :as mongo]))
   (println "repl/init done"))


The item-list starts its life as an empty list

--- re-frame-todo/src/cljs/re_frame_todo/db.cljs
+++ re-frame-todo/src/cljs/re_frame_todo/db.cljs
@@ -2,6 +2,6 @@

 (def default-db
   {:items-by-added-at {}
-   :item-list []
+   :item-list '()
    :input-value ""
    :sort-by-desc-added-at? true})


add type hints

add type hints

--- dada-core/src/main/clojure/org/dada/dsl.clj
+++ dada-core/src/main/clojure/org/dada/dsl.clj
@@ -117,8 +117,8 @@
   [#^IFn src-name-fn #^Model src-model key #^IFn value-to-keys #^IFn key-to-value #^IFn view-hook]
   (let [src-metadata (.getMetadata src-model)
 	src-attributes (.getAttributes src-metadata)
-	src-key  (.getKey (first src-attributes))	;TODO
-	src-version (.getKey (second src-attributes))	;TODO
+	src-key  (.getKey #^Attribute (first src-attributes))	;TODO
+	src-version (.getKey #^Attribute (second src-attributes))	;TODO
 	mutable (.getMutable (.getAttribute src-metadata key))
 	map (new ConcurrentHashMap)
 	view-factory (proxy


[#2212] Clean up

[#2212] Clean up

--- backend/src/akvo/lumen/endpoint/commons/taxa.clj
+++ backend/src/akvo/lumen/endpoint/commons/taxa.clj
@@ -1,99 +0,0 @@
-(ns akvo.lumen.endpoint.commons.taxa
-  "An experiment of taxonomic variants with the goal to express business logic
-  via variants and hierarchies.
-
-  A taxon is a variant with a classified key
-
-  taxon taxa")
-
-(defn taxon? [t]
-  (and
-   (map? t)
-   (= 1 (count t))
-   (let [tag (-> t keys first)]
-     (and (keyword? tag)
-          (boolean (namespace tag))))))
-
-(defn tag [t]
-  #_{:pre [(taxon? t)]}
-  (-> t keys first))
-
-(defn value [t]
-  #_{:pre [(taxon? t)]}
-  (-> t vals first))
-
-(defn ok? [t]
-  (isa? (tag t) ::ok))
-
-(comment
-  (taxon? {::a {}}) ;; true
-  (tag {::a {:k "V"}}) ;; :akvo.lumen.endpoint.commons.taxa/a
-  (value {::a {:k "V"}}) ;; {:k "V"}
-  (ok? {::ok {}}) ;; true
-  )
-
-(derive ::okish ::ok)
-
-(defn f1 [t]
-  (let [v (value t)]
-    {::okish (assoc v :f1 "f1")}))
-
-(defn f2
-  ([t]
-   (f2 t "f2"))
-  ([t a]
-   (let [v (value t)]
-     {::ok (assoc v :f2 a)}))
-  ([t a b]
-   (let [v (value t)]
-     {::ok (-> v
-               (assoc :f2a a)
-               (assoc :f2b b))})))
-
-(defn f3 [t]
-  {::err (-> {}
-             (assoc :stack (value t))
-             (assoc :f3 "f3"))})
-
-
-(defn cond-thread
-  [expr clauses]
-  (reduce (fn [previous {:keys [f args]}]
-            (if (ok? previous)
-              (if args
-                (apply f previous args)
-                (f previous))
-              previous))
-          {::ok expr}
-          clauses))
-
-(defmacro ?>
-  "Takes a value and thread trough forms. Short circut if taxon returned from
-  forms is not a child of ::ok"
-  [expr & forms]
-  (loop [clauses []
-         forms forms]
-    (if forms
-      (let [form (first forms)
-            clause (if (seq? form)
-                     (hash-map :f (resolve (first form))
-                               :args (next form))
-                     (hash-map :f (resolve form)))]
-        (recur (conj clauses clause) (next forms)))
-      (cond-thread expr clauses))))
-
-(comment
-  (?> nil) ;; #:akvo.lumen.endpoint.commons.taxa{:ok nil}
-  (?> {:k :v}) ;; #:akvo.lumen.endpoint.commons.taxa{:ok {:k :v}}
-  (?> {:k :v} f1);; #:akvo.lumen.endpoint.commons.taxa{:ok {:k :v}, :okish {:f1 "f1"}}
-
-  (?> {:k :v}
-      f1
-      (f2 "F2" "F22")) ;; #:akvo.lumen.endpoint.commons.taxa{:ok {:k :v, :f1 "f1", :f2a "F2", :f2b "F22"}}
-
-  (?> {:k :v}
-      f1
-      f3
-      (f2 "F2" "F22")) ;; #:akvo.lumen.endpoint.commons.taxa{:err {:stack {:k :v, :f1 "f1"}, :f3 "f3"}}
-
-  )


[#2835] Adapt pivot chart to OPTION column

--- backend/src/akvo/lumen/lib/aggregation/pivot.clj
+++ backend/src/akvo/lumen/lib/aggregation/pivot.clj
@@ -1,7 +1,7 @@
 (ns akvo.lumen.lib.aggregation.pivot
   (:require [akvo.commons.psql-util]
             [akvo.lumen.lib :as lib]
-            [akvo.lumen.lib.aggregation.commons :refer (run-query) :as commons]
+            [akvo.lumen.lib.aggregation.commons :refer (run-query sql-option-bucket-column) :as commons]
             [akvo.lumen.lib.dataset.utils :refer (find-column)]
             [akvo.lumen.postgres.filter :refer (sql-str)]
             [clojure.java.jdbc :as jdbc]
@@ -13,10 +13,12 @@
    `NULL = NULL` is `NULL`. To work around this, we must use another value to represent the
    empty value. For dates, we use 1001-01-01 01:00:00"
   [column]
-  (format "COALESCE(%s, %s)" (:columnName column) (case (:type column)
-                                                    "text" "''"
-                                                    "date" "'1001-01-01 01:00:00'::timestamptz"
-                                                    "'NaN'::double precision")))
+  (if (= "option" (:type column))
+    (sql-option-bucket-column column)
+    (format "COALESCE(%s, %s)" (:columnName column) (case (:type column)
+                                                      "text" "''"
+                                                      "date" "'1001-01-01 01:00:00'::timestamptz"
+                                                      "'NaN'::double precision"))))

 (defn unique-values-sql [table-name filter-str category-column]
   (let [select (format "SELECT DISTINCT %s%s"


extract start index + int val from regex seq matches

--- ohack/src/ohack/core.clj
+++ ohack/src/ohack/core.clj
@@ -222,7 +222,10 @@
   ;; filter out everything before the actual guitar line "- ..." part
   ;; note: drop-while predicate needs a char (\-), not a string ("-")!
   (let [tab-string (apply str (drop-while #(not= % \-) line))]
-    (re-seq-pos #"\d+" tab-string)))
+    ;; now we will have a seq of [index value] pairs
+    (map
+     (fn [m] [(:start m) (Integer/parseInt (:group m))])
+     (re-seq-pos #"\d+" tab-string))))

 ;; first, filter out all lines that don't look like guitar lines
 ;; use map-index because we need to keep ordering information


handle generation failure

handle generation failure

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -89,8 +89,12 @@
     (repeatedly #(println (str (let [expr (generate spec
                                                     :model model)
                                      fo (fo expr :show-notes false)]
-                                 (str (string/capitalize (nth fo 0))
-                                      (string/join "" (rest (vec fo)))
-                                      ".")))))))
+                                 (cond
+                                   (empty? fo) (str "(failed)")
+                                   true
+                                   (str (string/capitalize (nth fo 0))
+                                        (string/join "" (rest (vec fo)))
+                                        "."))))))))

+


[#183] Fix extends? implementation

[#183] Fix extends? implementation


home route redirects to jekyll site on github

--- src/aristotle/server.clj
+++ src/aristotle/server.clj
@@ -20,18 +20,12 @@
    req
    daemon-name))

-(def legacy-urls
-  {"elliot.daemon.life" "/elliott-hulse"
-   "elliott.daemon.life" "/elliott-hulse"
-   "collin.daemon.life" "/collin-bell"
-   "localhost:8080" "/collin-bell"})
-
 (defn home-route [req]
   (let [host (get-in req [:headers "host"])]
     (println (str host (get legacy-urls host)))
     (if (contains? legacy-urls host)
       {:status 301
-       :headers {"Location" (str "http://" host (get legacy-urls host))}})))
+       :headers {"Location" "https://slightlycyborg.github.io/daemon.life/"}})))

 (defn daemon-route
   "Returns the full html page with search results included"


More convenient assert-json that requires a map for expectations,
implemented as a regular fn.

Previous macro is still there, but with a new name: `assert-json-values`.

--- src/assert_json/core.clj
+++ src/assert_json/core.clj
@@ -1,5 +1,5 @@
 (ns assert-json.core
-  (:use [cheshire.core :as json :only [parse-string]]
+  (:use [cheshire.core :as cheshire :only [parse-string]]
         [assert-json.exceptions :only [property-not-found
                                        wrong-property-type
                                        wrong-property-value]]))
@@ -18,7 +18,7 @@
           (not= value m-val) (throw (wrong-property-value property m-val value))
           :default true)))

-(defmacro assert-json
+(defmacro assert-json-values
   "Assert JSON properties (and corresponding values) in a convenient form.

   Example:
@@ -31,4 +31,13 @@
      (map (fn [c#] (assert-property m# (first c#) (second c#)))
           (partition 2 (vector ~@body)))))

+(defn assert-json
+  "Assert JSON properties on a `json-string`, setting expectations via an `expected` map.
+
+  Properties are asserted for presence, and their values for type and equality."
+  [json-string expected]
+  (let [json (parse-string json-string)]
+    (map #(assert-property json (first %) (second %))
+         expected)))

+


Delete confirmation for removing users from organization

--- src/cljs/elevent_client/pages/organizations/id/edit.cljs
+++ src/cljs/elevent_client/pages/organizations/id/edit.cljs
@@ -123,8 +123,11 @@
                                                            (routes/organizations-owned))))))))
                                             callback)))
             delete-member
-            (fn [member-id]
-              (api/memberships-endpoint :delete {:MembershipId member-id} nil))
+            (fn [member-id first-name last-name]
+              (when (js/window.confirm (str "Are you sure you want to remove "
+                                          (str first-name " " last-name)
+                                          " from this organization?"))
+                (api/memberships-endpoint :delete {:MembershipId member-id} nil)))
             organization-members
             (when organization-id
               (d/q '[:find ?a ?user-id ?first-name ?last-name ?email
@@ -276,7 +279,7 @@
                   [:td (str first-name " " last-name)]
                   [:td email]
                   [:td [:i.red.remove.icon.link
-                        {:on-click #(delete-member member-id)}]]])]]])
+                        {:on-click #(delete-member member-id first-name last-name)}]]])]]])
           (when organization-id
             [:div.ui.vertical.segment
              [:h2.ui.dividing.header


Adds rest of the navigation page's copy.

--- src/cljs/reagent_toolbox_docs/components/navigation.cljs
+++ src/cljs/reagent_toolbox_docs/components/navigation.cljs
@@ -16,13 +16,73 @@
       "(defn navigation-test
          []
          (let [actions [{:label \"Alarm\" :raised true :icon \"access_alarm\"}
-                        {:label \"Location\" :raised true :accent true :icon \"room\"}]]
+                        {:label \"Location\" :raised true :accent true :icon \"room\"}]
+               routes [{:href \"/navigation\" :label \"Inbox\" :icon \"inbox\"}
+                       {:href \"/naviation\" :active true :label \"Profile\" :icon \"person\"}]]
            (fn []
              [:div
               [reagent-toolbox.core/navigation {:type \"horizontal\" :actions actions}]
-])))
+              [reagent-toolbox.core/navigation {:type \"vertical\" :routes routes}]])))
+
        [navigation-test]"]
-     ]))

-(defmethod layout/pages :checkbox [_]
+     [:p "If you want to provide a theme via context, the component key RTCheckbox."]
+
+     [:section
+      [:h2 "Properties"]
+
+      [:table
+       [:thead
+        [:tr
+         [:th "Name"]
+         [:th "Type"]
+         [:th "Default"]
+         [:th "Description"]]]
+       [:tbody
+        [:tr
+         [:td [:code "actions"]]
+         [:td [:code "vector"]]
+         [:td [:code ""]]
+         [:td "Vector of maps that will be represented as buttons so the keys will be "
+          "transferred as properties the button component."]]
+        [:tr
+         [:td [:code "class-name"]]
+         [:td [:code "string"]]
+         [:td]
+         [:td "Set a custom class styles to style the navigation."]]
+        [:tr
+         [:td [:code "routes"]]
+         [:td [:code "vector"]]
+         [:td]
+         [:td "Vector of maps similar to actions but that will be rendered as link "
+          "component definition."]]
+        [:tr
+         [:td [:code "type"]]
+         [:td [:code "String"]]
+         [:td [:code "horizontal"]]
+         [:td "Type of the navigation, it can be vertical or horizontal."]]]]]
+
+     [:section
+      [:h2 "Theme"]
+
+      [:table
+       [:thead
+        [:tr
+         [:th "Name"]
+         [:th "Description"]]]
+       [:tbody
+        [:tr
+         [:td [:code "button"]]
+         [:td "Used for buttons provided in the component."]]
+        [:tr
+         [:td [:code "horizontal"]]
+         [:td "Used for the root element if the layout is horizontal."]]
+        [:tr
+         [:td [:code "link"]]
+         [:td "Used for links provided in the component."]]
+        [:tr
+         [:td [:code "vertical"]]
+         [:td "Used for the root element if the layout is vertical."]]]]]]))
+
+(defmethod layout/pages :navigation [_]
   [view])


restructuring build step information

restructuring build step information

--- backend/src/lambdaui/api_legacy.clj
+++ backend/src/lambdaui/api_legacy.clj
@@ -31,6 +31,20 @@
 (defn- step-id-str [step-id]
   (clojure.string/join "-" step-id))

+(defn get-type [step]
+  (when-let [type (:type step)]
+    (case type
+      :manual-trigger :trigger
+      type)
+    )
+  )
+
+(defn get-trigger-data [step]
+  (when (= :trigger (get-type step))
+    {}
+    )
+  )
+
 (defn to-output-format [step]
   (let [status (:status (:result step))
         base {:stepId    (step-id-str (:step-id step))
@@ -38,13 +52,11 @@
               :state     (or status :pending)
               :startTime (to-iso-string (:first-updated-at (:result step)))
               :endTime   (when (finished? status) (to-iso-string (:most-recent-update-at (:result step))))}
-        type (if (:type step) (:type step) "normal")
-        base-with-type (assoc base :type type)
-        children (:children step)]
-    (if (and children
-             (not (empty? children)))
-      (assoc base-with-type :steps (map to-output-format (:children step)))
-      base)))
+        type {:type (get-type step)}
+        children (if-let [children (:children step)] {:steps (map to-output-format children)} {})
+        trigger-data (or (get-trigger-data step) {})
+        ]
+    (merge base type children trigger-data)))

 (defn build-details-from-pipeline [pipeline-def pipeline-state build-id]


cleanup

cleanup

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -48,7 +48,6 @@
      #(not (nil? %))
      (take 100
            (repeatedly function))))))
-

 (defn subpath? [path1 path2]
   "return true if path1 is subpath of path2."


remove get-lex (old-style indexing)

remove get-lex (old-style indexing)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -1,7 +1,6 @@
 (ns babel.generate
   (:refer-clojure :exclude [get-in deref resolve find parents])
   (:require
-   [babel.index :refer [get-lex]]
    [babel.over :as over :refer [show-bolt truncate truncate-expressions]]
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
@@ -118,7 +117,7 @@
                        true
                        (do
                          (log/warn (str "no index found for spec: " (spec-info spec)))
-                         (get-lex parent :head (:index language-model))))]
+                         (vals (:lexicon language-model))))]
                  (log/debug (str "lightning-bolts: (optimizeme) size of subset of candidate heads: " (count subset) " with spec: " (strip-refs spec) " and parent:  " (get-in parent [:rule])))
                  (let [result (over/overh parent (lazy-shuffle subset))]
                    (log/debug (str "lightning-bolts: (optimizeme) surviving candidate heads: " (count result)))
@@ -208,13 +207,7 @@
                       (intersection-with-identity pred-set cat-set))]
             (if (not (empty? subset))
               subset
-              (let [index (:index language-model)
-                    indexed (if index (get-lex immediate-parent :comp index))]
-                (if (not (empty? indexed))
-                  indexed
-                  (do
-                    (log/warn (str "no candidate lexemes were found as a complement."))
-                    nil))))))
+              (vals (:lexicon language-model)))))
         bolt-child-synsem (strip-refs (get-in bolt (concat path [:synsem]) :top))
         lexical-complements (lazy-shuffle
                              (filter (fn [lexeme]
@@ -295,9 +288,7 @@
                       (intersection-with-identity pred-set cat-set))]
             (if (not (empty? subset))
               subset
-              (let [index (:index language-model)
-                    indexed (if index (get-lex immediate-parent :comp index))]
-                indexed))))
+              (vals (:lexicon language-model)))))
         bolt-child-synsem (strip-refs (get-in bolt (concat path [:synsem]) :top))
         lexical-complements (filter (fn [lexeme]
                                       (and (not-fail? (unify (strip-refs (get-in lexeme [:synsem] :top))


Shorter lane-close cmd, with no :rq.

Shorter lane-close cmd, with no :rq.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -133,7 +133,7 @@
 (defn cmd-handler [c] (assoc c :rq rq-handler))

 (def cmd-handlers (merge (into {} (map (fn [k] [k cmd-handler]) (keys rq-handlers)))
-                         {"lane-close" #(assoc % :rq rq-handler :op :lane-close)}))
+                         {"lane-close" #(assoc % :op :lane-close)}))

 (defn ev-msg [ev]
   (assoc (cbfg.world.t1/ev-msg ev)


avoid audio context starting on load

avoid audio context starting on load

--- src/chronoid/core.cljs
+++ src/chronoid/core.cljs
@@ -1,17 +1,12 @@
 (ns chronoid.core)

-(def ^:dynamic *audio-context*
-  (let [ctx (or js/window.AudioContext
-                js/window.webkitAudioContext)]
-    (ctx.)))
-
 (def default-options
-  {:context *audio-context*
+  {;:context *audio-context*
    :tolerance-late  100 ; ms
    :tolerance-early 1}) ; ms

 (def ^:dynamic *clocks* {})
-
+(def audio-context (atom nil))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ; For all of the public functions, the `clock` arguments are atom references to
@@ -20,10 +15,15 @@

 (defn clock
   [& {:as attrs}]
-  (let [id           (gensym "clock")
+  (let [ctx (if @audio-context @audio-context
+              (let [ct (or js/window.AudioContext js/window.webkitAudioContext)
+                    inst (ct.)]
+                (reset! audio-context inst)))
+        id           (gensym "clock")
         clock        (merge default-options
                             attrs
-                            {:id      id
+                            {:context ctx
+                             :id      id
                              :events  []
                              :started false})
         atomic-clock (atom clock)]