Update lispychat.clj

Update lispychat.clj

--- src/extras/lispychat.clj
+++ src/extras/lispychat.clj
@@ -5,7 +5,9 @@
     ; This sets the correct file type for js includes used by hiccup
         (ring.middleware resource file-info)
         (hiccup core page))
-  (:require [compojure.route :as route]))
+  (:require [compojure.route :as route]
+            [iyye.ioframes :as bios]
+            [clojure.tools.logging :as log]))

 (defn page []
   "HTML page rendered using Hiccup. Includes the css and js for websockets."
@@ -25,25 +27,6 @@
      (include-js "/static/javascripts/web_socket.js")
      (include-js "/static/javascripts/app.js")]))

-; move to iyye!
-(defn chat-init [ch]
-  "register callback for receive msg"
-  ;(receive-all ch #(println "message: " % ":" ch))
-  )
-
-(def chat-channel (ref ()))
-
-(defn chat-handler [ch room]
-  "Relays messages into a chat room. If it doesn't
-  exist create a new channel"
-  (let [chat (named-channel room chat-init)]
-    (siphon chat ch)
-    (siphon ch chat)))
-
-(defn send-msg [msg]
-  (enqueue @chat-channel (str "iyye> " msg)))
-
-
 (defn sync-app [request]
   "Rendered response of the chat page"
   {:status 200
@@ -56,6 +39,24 @@
       (wrap-resource "public")
       (wrap-file-info)))

+(defn start-lispy-chat-server [& args])
+
+(def chat-channel (ref ()))
+(defn send-msg [msg]
+  (enqueue @chat-channel (str "iyye> " msg)))
+
+(def lispy-chat-IO (bios/create-IO "lispy-chat" start-lispy-chat-server (bios/create-InputSources false []) (bios/->OutputActuators false [send-msg])))
+(dosync (alter bios/AvatarsIOList conj lispy-chat-IO))
+
+(def lispy-chat-process-input (partial bios/process-input lispy-chat-IO))
+
+(defn chat-init [ch])
+(defn chat-handler [ch room]
+  "Relays messages into a chat room. If it doesn't
+  exist create a new channel"
+  (let [chat (named-channel room chat-init)]
+    (siphon chat ch)
+    (siphon ch chat)))

 (defn chat [ch request]
   "View handler that handles a chat room. If it's not
@@ -64,14 +65,12 @@
   (if (:websocket request)
     (dosync
       (ref-set chat-channel ch)
-      (chat-handler ch "iyye")
-      )
+      (chat-handler ch "iyye"))
     (enqueue ch (wrapped-sync-app request))))
-
 (defroutes app-routes
            "Routes requests to their handler function. Captures dynamic variables."
            (GET ["/chat/iyye"] {}
-                (wrap-aleph-handler chat))
+             (wrap-aleph-handler chat))
            (GET ["/"] {} "To access Iyye, go to /chat/iyye iyye chat")
            ;;Route our public resources like css and js to the static url
            (route/resources "/static")
@@ -83,3 +82,9 @@
   all the routes we specified and is websocket ready."
   (start-http-server (wrap-ring-handler app-routes)
                      {:host "localhost" :port 8080 :websocket true}))
+
+; move to iyye!
+(defn chat-init [ch]
+  "register callback for receive msg"
+  (receive-all ch lispy-chat-process-input))
+


Add palette selection to example

Add palette selection to example

--- src/examples/palette.clj
+++ src/examples/palette.clj
@@ -18,12 +18,13 @@
   [:ul-cover-bg :u-cover-bg :ur-cover-bg :ul-dark-cover-bg :u-dark-cover-bg :ur-dark-cover-bg :ul-light-cover-bg :u-light-cover-bg :ur-light-cover-bg :? :? :? :? ]
   [:l-cover-bg :cover-bg :r-cover-bg :l-dark-cover-bg :dark-cover-bg :r-dark-cover-bg :l-light-cover-bg :light-cover-bg :r-light-cover-bg :? :? :? :? ]
   [:bl-color-bg :b-cover-bg :br-cover-bg :bl-dark-cover-bg :b-dark-cover-bg :br-dark-cover-bg :bl-light-cover-bg :blight-cover-bg :br-light-cover-bg :? :? :? :? ]
-  [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
-  [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
-  [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
-  [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
-  [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
-  [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
+  [:ul-cover-rev :ur-cover-rev :ul-dark-cover-rev :ur-dark-cover-rev :ul-light-cover-rev :ur-light-cover-rev :? :? :? :? :? :? :? ]
+  [:bl-cover-rev :br-cover-rev :bl-dark-cover-rev :br-dark-cover-rev :bl-light-cover-rev :br-light-cover-rev :? :? :? :? :? :? :? ]
+  [:ul-trans :u-trans :ur-trans :ul-dark-trans :u-dark-trans :ur-dark-trans :ul-light-trans :u-light-trans :ur-light-trans :dot-trans :leaf-0-trans :leaf-1-trans :? ]
+  [:l-trans :trans :r-trans :l-dark-trans :dark-trans :r-dark-trans :l-light-trans :light-trans :r-light-trans :dot-light-trans :leaf-0-light-trans :leaf-1-light-trans :? ]
+  [:bl-trans :b-trans :br-trans :bl-dark-trans :b-dark-trans :br-dark-trans :bl-light-trans :b-light-trans :br-light-trans :dot-dark-trans :leaf-0-dark-trans :leaf-1-dark-trans :? ]
+  [:ul-rev :u-rev :ur-rev :ul-cover-rev :u-cover-trans :ur-cover-rev :ul-cover-rev :ur-cover-rev :? :? :? :? :? :? :? ]
+  [:bl-rev :br-rev :bl-cover-rev :br-cover-rev :bl-cover-rev :br-cover-rev :? :? :? :? :? :? :? ]
   [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
   [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
   [:? :? :? :? :? :? :? :? :? :? :? :? :? ]
@@ -44,6 +45,13 @@
     [156 175 131 255]
     [209 213 201 255]
     [209 213 201 255]
+    [209 213 201 255]]
+   [[ 57  29  29   0]
+    [147 103  59 255]
+    [149  65  35 255]
+    [177 157 105 255]
+    [209 213 201 255]
+    [215 215 151 255]
     [209 213 201 255]]])

 (def tileset-bw
@@ -59,12 +67,19 @@

-(def palette (for [[row line] (map-indexed vector tile-names)
-                   [col id]   (map-indexed vector line)]
-               {:c id :fg [255 255 255] :bg [0 0 0] :x col :y row :palette-index 1}))
+(defn palette
+  [palette-index]
+  (for [[row line] (map-indexed vector tile-names)
+        [col id]   (map-indexed vector line)]
+    {:c id :fg [255 255 255] :bg [0 0 0] :x col :y row :palette-index palette-index}))
+
+(def color-table-chars
+  (for [[row line] (map-indexed vector color-table)
+        [col bg]   (map-indexed vector line)]
+    {:c \space :fg [255 255 255] :bg bg :x col :y (+ row 28)}))

 (log/info font)
-(log/info "palette" (vec palette))
+;(log/info "palette" (vec palette))

 (defn -main [& _]
   ;; render in background thread
@@ -89,14 +104,16 @@
                            :2 (atom {})
                            :3 (atom {})}
             current-layer (atom :0)
-            current-tile  (atom (ffirst tile-names))]
+            current-tile  (atom (ffirst tile-names))
+            palette-index (atom 1)]
         ;; Every 33ms, draw a full frame
         (zat/do-frame terminal 33
-          (zutil/put-string terminal :ui 2 30 (format "layer: %s" (str @current-layer)))
+          (zat/put-chars! terminal :ui (palette @palette-index))
+          (zat/put-chars! terminal :ui [{:c @current-tile :fg [255 255 255] :bg [128 128 128] :x 0 :y 26 :palette-index 1}])
+          (zutil/put-string terminal :ui 2 26 (format "layer: %s" (str @current-layer)))
           (when @current-tile
-            (zutil/put-string terminal :ui 16 30 (str @current-tile)))
-          (zat/put-chars! terminal :ui palette)
-          (zat/put-chars! terminal :ui [{:c @current-tile :fg [255 255 255] :bg [128 128 128] :x 0 :y 30 :palette-index 1}])
+            (zutil/put-string terminal :ui 16 26 (str @current-tile)))
+          (zat/put-chars! terminal :ui color-table-chars)
           (zat/put-chars! terminal :0 (map (fn [[[col row] t]]
                                              {:c t :fg [255 255 255] :bg [0 0 0] :x col :y row :palette-index 1})
                                            @(get layers :0)))
@@ -132,11 +149,13 @@
           (fn [{:keys [button state col row] :as click}]
             (log/info "got click" click)
             (if (< col 12)
-              ;; select new tile
-              (do
-                (log/info "selecting tile at" [row col])
-                (when-let [tile (get-in tile-names [row col])]
-                  (reset! current-tile tile)))
+              (if (< row 27)
+                ;; select new tile
+                (do
+                  (log/info "selecting tile at" [row col])
+                  (when-let [tile (get-in tile-names [row col])]
+                    (reset! current-tile tile)))
+                (reset! palette-index (- row 27)))
               ;; draw new tile
               (do
                 (log/info "placing tile at" [row col])


support for visualization in gorrila repl

--- src/grape/visualizer.clj
+++ src/grape/visualizer.clj
@@ -1,13 +1,17 @@
 (ns grape.visualizer
   (:require
-   [clojure.data.json :as json]
-   [schema.core :as s]
-   [clojure.string :as str]
-   [clojure.set :refer :all]
-   [dorothy.core :as dorothy]
-   [clojure.data.codec.base64 :as b64]
-   [grape.util :refer :all]
-   ))
+    [clojure.data.json :as json]
+    [schema.core :as s]
+    [clojure.string :as str]
+    [clojure.set :refer :all]
+    [dorothy.core :as dorothy]
+    [clojure.data.codec.base64 :as b64]
+    [grape.util :refer :all]
+    [clojure.java.io :as io]))
+
+(import javax.imageio.ImageIO)
+
+(use 'gorilla-repl.image)

 (defn reset-ctr! []
   (intern *ns* '_ctr 0))
@@ -21,6 +25,12 @@

 (defn dot->image [g]
   (String. (b64/encode (dorothy/render g {:format :png}))))
+
+(defn show [g]
+  (image-view
+    (ImageIO/read
+      (io/input-stream
+        (dorothy/render  g {:format :png})))))

 (defn dorothy->dot [g]
   (dorothy/dot g))


Clean up code

Clean up code

--- src/cljs/elevent_client/pages/events/id/edit.cljs
+++ src/cljs/elevent_client/pages/events/id/edit.cljs
@@ -84,20 +84,18 @@
                                  @api/events-db))))

             associated-organizations
-            (doall (map #(let [organization-id (:OrganizationId %)]
-                           [(:Name (d/entity @api/organizations-db
-                                             organization-id))
-                            organization-id])
-                        (filter :AddEvent
-                                (:OrganizationPermissions
-                                  (into {}
-                                        (d/entity @api/permissions-db
-                                                  (get-in @state/session
-                                                          [:user :UserId])))))))
-
-            associated-organizations
-            (cons ["None" 0]
-                  associated-organizations)
+            (->> (-> @state/session
+                     (get-in [:user :UserId]))
+                 (d/entity @api/permissions-db)
+                 (into {})
+                 :OrganizationPermissions
+                 (filter :AddEvent)
+                 (map #(let [organization-id (:OrganizationId %)]
+                         [(:Name (d/entity @api/organizations-db
+                                           organization-id))
+                          organization-id]))
+                 doall
+                 (cons ["None" 0]))

             create-event
             (fn [form]


Fixing embedded elastic server.

Fixing embedded elastic server.

--- src/cmr/elastic_utils/embedded_elastic_server.clj
+++ src/cmr/elastic_utils/embedded_elastic_server.clj
@@ -78,10 +78,10 @@
           _ (setup-logging node-settings)
           this (assoc this :node (build-node node-settings))]
       ;; See http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/cluster-health.html
-      (info (pr-str (client/get
-                         (format
-                           "http://localhost:%s/_cluster/health?wait_for_status=yellow&timeout=50s"
-                           (:http-port this)))))
+      (client/get
+        (format
+          "http://localhost:%s/_cluster/health?wait_for_status=yellow&timeout=50s"
+          (:http-port this)))
       this))

   (stop


Fix off-by-one error in beachball mode

Fix off-by-one error in beachball mode

--- src/clojure/playasophy/wonderdome/mode/beachball.clj
+++ src/clojure/playasophy/wonderdome/mode/beachball.clj
@@ -30,10 +30,10 @@
       (assoc this :speed (second speed-bounds))

       [:button/press :X]
-      (assoc this :index (control/wrap [0 (dec (count color-lists))] (inc index)))
+      (assoc this :index (control/wrap [0 (count color-lists)] (inc index)))

       [:button/press :Y]
-      (assoc this :index (control/wrap [0 (dec (count color-lists))] (dec index)))
+      (assoc this :index (control/wrap [0 (count color-lists)] (dec index)))

       [:axis/direction :y-axis]
       (assoc this :speed (control/adjust speed event


Remove Bifrost req

Remove Bifrost req

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -1,9 +1,8 @@
 (in-ns 'game.core)

 (def cards-operations
-  {
-   "24/7 News Cycle"
-   {:req (req (> (count (filter #(not= (:title %) "Bifrost Array") (:scored corp))) 2))
+  {"24/7 News Cycle"
+   {:req (req (> (count (:scored corp)) 2))
     :additional-cost [:forfeit]
     :prompt "Choose an agenda to trigger"
     :msg (msg "trigger the score ability on " (:title target))


make that nav always available for more streamlined browsing

--- src/cljs/apollo/client/pages.cljs
+++ src/cljs/apollo/client/pages.cljs
@@ -30,33 +30,28 @@
       (nav/main-nav-partial)
       [:div.left-column
        (artists/artist-detail-partial active-artist)
-       (if (= sub-view :now-playing)
-                (om/build player/view-now-playing data)
-                (om/build player/view-current-playlist data))
        [:ul
         [:li {:on-click (fn [e]
                           (set-subview :now-playing))} "now playing"]
         [:li {:on-click (fn [e]
-                          (set-subview :playlists))} "playlists"]]]
+                          (set-subview :playlists))} "playlists"]]
+       (if (= sub-view :now-playing)
+                (om/build player/view-now-playing data)
+                (om/build player/view-current-playlist data))]
       [:div.content.pure-g
-       (cond
-         (and (nil? active-artist) (nil? active-album))
-         [:div.pure-u-1
-          [:div.middle-column
-            (nav/nav-partial)
-            (artists/artist-list-partial artists)]]
+       [:div.pure-u-1
+        [:div.middle-column
+         (nav/nav-partial)
+           (cond
+             (and (nil? active-artist) (nil? active-album))
+             (artists/artist-list-partial artists)
          (and (not (nil? active-artist)) (nil? active-album))
-         [:div.pure-u-1
-          [:div.pure-g.artist-detail
-           [:div.middle-column
-            (albums/album-list-partial active-artist albums)]
-           [:div.artist-bg {:style {:background-image artist-image-url}}]]]
+         [:div.artist-detail
+          (albums/album-list-partial active-artist albums)]
          (not (nil? active-album))
-         [:div.pure-u-1
-          [:div.middle-column
-            [:div.album-detail
-             (albums/album-detail active-artist active-album)]]
-          [:div.artist-bg {:style {:background-image artist-image-url}}]])]])))
+         [:div.album-detail
+          (albums/album-detail active-artist active-album)
+          [:div.artist-bg {:style {:background-image artist-image-url}}]])]]]])))

 (defn view-browse [data owner]
   (om/component (browse-page data owner)))


Proper component calling

Proper component calling

--- src/cljs/cljs_repl_web/views.cljs
+++ src/cljs/cljs_repl_web/views.cljs
@@ -53,7 +53,7 @@
       :position position
       :anchor anchor
       :popover [popover-content-wrapper
-                :showing? (:step2 tour)
+                :showing? (step-keyword tour)
                 :position position
                 :width    "250px"
                 :title    [:strong (get-in tour-steps [step-keyword :title])]
@@ -61,7 +61,7 @@
                            [make-tour-nav tour]]]
       :style  (if style
                 style
-                (align-style :align-self :end))])))
+                (align-style :align-self :center))])))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;      Buttons       ;;;
@@ -185,14 +185,16 @@
                     :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
                     :disabled? @can-dump-gist?]
          :popover  [gist-login-dialog-body]]
-        (create-tour-step 4 :below-center [md-icon-button
-                                           :md-icon-name "zmdi-github"
-                                           :on-click #(dispatch [:show-gist-login])
-                                           :class "cljs-btn"
-                                           :size (if-not (= :medium @media-query) :regular :smaller)
-                                           :tooltip "Create Gist"
-                                           :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
-                                           :disabled? @can-dump-gist?])))))
+        [create-tour-step 4
+         :below-center
+         [md-icon-button
+          :md-icon-name "zmdi-github"
+          :on-click #(dispatch [:show-gist-login])
+          :class "cljs-btn"
+          :size (if-not (= :medium @media-query) :regular :smaller)
+          :tooltip "Create Gist"
+          :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
+          :disabled? @can-dump-gist?]]))))

 (defn cljs-buttons
   "Return a vector of components containing the cljs console buttons.
@@ -211,39 +213,46 @@
                           (swap! modes rest)
                           next-mode))]
     (fn cljs-buttons-form2 []
-      (let [children [(create-tour-step 2 :below-center
-                                        [md-icon-button
-                                         :md-icon-name "zmdi-delete"
-                                         :on-click #(dispatch [:reset-console-items :cljs-console])
-                                         :class "cljs-btn"
-                                         :size (if-not (= :medium @media-query) :regular :smaller)
-                                         :tooltip "Reset"
-                                         :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
-                                         :disabled? (not @console-created?)])
-                      (create-tour-step 3 :below-center [md-icon-button
-                                                         :md-icon-name "zmdi-format-clear-all"
-                                                         :on-click #(dispatch [:clear-console-items :cljs-console])
-                                                         :class "cljs-btn"
-                                                         :size (if-not (= :medium @media-query) :regular :smaller)
-                                                         :tooltip "Clear"
-                                                         :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
-                                                         :disabled? (not @console-created?)])
+      (let [children [[create-tour-step 2
+                       :below-center
+                       [md-icon-button
+                        :md-icon-name "zmdi-delete"
+                        :on-click #(dispatch [:reset-console-items :cljs-console])
+                        :class "cljs-btn"
+                        :size (if-not (= :medium @media-query) :regular :smaller)
+                        :tooltip "Reset"
+                        :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
+                        :disabled? (not @console-created?)]]
+                      [create-tour-step 3
+                       :below-center
+                       [md-icon-button
+                        :md-icon-name "zmdi-format-clear-all"
+                        :on-click #(dispatch [:clear-console-items :cljs-console])
+                        :class "cljs-btn"
+                        :size (if-not (= :medium @media-query) :regular :smaller)
+                        :tooltip "Clear"
+                        :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
+                        :disabled? (not @console-created?)]]
                       [gist-login-dialog]
-                      (create-tour-step 5 :below-center [md-icon-button
-                                                         :md-icon-name "zmdi-stop"
-                                                         :on-click #(dispatch [:clear-console-queued-forms :cljs-console])
-                                                         :class "cljs-btn"
-                                                         :size (if-not (= :medium @media-query) :regular :smaller)
-                                                         :tooltip "Clear examples"
-                                                         :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
-                                                         :disabled? (not @example-mode?)])
-                      (create-tour-step 6 :below-center [md-icon-button
-                                                         :md-icon-name "zmdi-keyboard"
-                                                         :on-click #(dispatch [:switch-console-mode (get-next-mode)])
-                                                         :class "cljs-btn"
-                                                         :size (if-not (= :medium @media-query) :regular :smaller)
-                                                         :tooltip "Switch input mode"
-                                                         :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)])]]
+                      [create-tour-step 5
+                       :below-center
+                       [md-icon-button
+                        :md-icon-name "zmdi-stop"
+                        :on-click #(dispatch [:clear-console-queued-forms :cljs-console])
+                        :class "cljs-btn"
+                        :size (if-not (= :medium @media-query) :regular :smaller)
+                        :tooltip "Clear examples"
+                        :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)
+                        :disabled? (not @example-mode?)]]
+                      [create-tour-step 6
+                       :below-center
+                       [md-icon-button
+                        :md-icon-name "zmdi-keyboard"
+                        :on-click #(dispatch [:switch-console-mode (get-next-mode)])
+                        :class "cljs-btn"
+                        :size (if-not (= :medium @media-query) :regular :smaller)
+                        :tooltip "Switch input mode"
+                        :tooltip-position (if-not (= :narrow @media-query) :left-center :above-center)]]]]
         (if-not (= :narrow @media-query)
           [v-box
            :gap "8px"
@@ -620,23 +629,23 @@
   (let [media-query (subscribe [:media-query-size])
         console (console/console console-key opts)]
     (fn repl-component-form2 []
-      (let [children [(create-tour-step 1
-                                        :above-center
-                                        [button
-                                         :label    "Start Tour!"
-                                         :on-click #(start-tour tour)
-                                         :style    {:font-weight "bold" :color "yellow"}
-                                         :class    "btn-info"]
-                                        {:width     "34px"
-                                         :font-size "26px"
-                                         :position  "absolute"
-                                         :top       "240px"
-                                         :left      "250px"})
+      (let [children [[create-tour-step 1
+                       :above-center
+                       [button
+                        :label    "Start Tour!"
+                        :on-click #(start-tour tour)
+                        :style    {:font-weight "bold" :color "yellow"}
+                        :class    "btn-info"]
+                       {:width     "34px"
+                        :font-size "26px"
+                        :position  "absolute"
+                        :top       "240px"
+                        :left      "250px"}]
                       [cljs-buttons]
                       [box
                        :size "0 0 auto"
                        :child
-                       (create-tour-step 7 :above-center [console])]]]
+                       [create-tour-step 7 :above-center [console]]]]]
         (if (= :narrow @media-query)
           [v-box
            :size "1 1 auto"


Add action assessing functions

Add action assessing functions

--- src/cljs/love_letter_cljs/ai.cljs
+++ src/cljs/love_letter_cljs/ai.cljs
@@ -10,6 +10,13 @@
             {:face :countess :value 7 :count 1}
             {:face :princess :value 8 :count 1}])

+(def action-types [:suicide
+                   :eliminate
+                   :assist
+                   :survive
+                   :high-card
+                   :defensive :bluff])
+
 (defn generate-card [card]
   (let [{:keys [count face value]} card]
     (repeat count {:face face :value value})))
@@ -18,8 +25,6 @@
   (vec (shuffle (mapcat generate-card cards))))

 ;;; AI STUFF
-
-;;;

 (defn remove-first [face coll]
   (let [[pre post] (split-with #(not= face (:face %)) coll)]
@@ -84,10 +89,10 @@
         current-player-hand (player-hand game current-player)
         known-list (vec (map :face (concat discard-pile current-player-hand)))
         filtered-deck (filter-fresh-deck known-list)]
-
     (float (/ (count (filter #(>= value (:value %)) filtered-deck))
               (count filtered-deck)))))

+(map apply [inc dec (comp inc inc)] [1 2 3])

 ;; Game -> Id -> Card -> Float
 (defn guard-probability [game target-player guess]
@@ -103,17 +108,18 @@
                 (count filtered-deck))))))

 (guard-probability test-game 2 {:face :guard :value 3})
+(guard-probability test-game 2 {:face :baron :value 3})
 (guard-probability test-game 3 {:face :baron :value 3})

 (defn baron-probability [game player-card target-player]
   (let [{:keys [discard-pile current-player]} game
-        player-value (:value player-card)
-        current-player-hand (player-hand game current-player)
-        known-list (mapv :face (concat discard-pile current-player-hand))
-        visible-card (known-card game current-player target-player)
-        filtered-deck (filter-fresh-deck known-list)]
-    (if visible-card
-      (if (> player-value (:value card-known)) 100 0)
+        player-value        (:value player-card)
+        current-player-hand (player-hand game current-player)
+        known-list          (mapv :face (concat discard-pile current-player-hand))
+        visible-card        (known-card game current-player target-player)
+        filtered-deck       (filter-fresh-deck known-list)]
+    (if visible-card
+      (if (> player-value (:value visible-card)) 100 0)
       (float (/ (count (filter #(> player-value (:value %)) filtered-deck))
                 (count filtered-deck))))))

@@ -121,13 +127,13 @@

 (defn baron-survival-probability [game player-card target-player]
   (let [{:keys [discard-pile current-player]} game
-        player-value (:value player-card)
-        current-player-hand (player-hand game current-player)
-        known-list (mapv :face (concat discard-pile current-player-hand))
-        visible-card (known-card game current-player target-player)
-        filtered-deck (filter-fresh-deck known-list)]
-    (if visible-card
-      (if (>= player-value (:value card-known)) 100 0)
+        player-value        (:value player-card)
+        current-player-hand (player-hand game current-player)
+        known-list          (mapv :face (concat discard-pile current-player-hand))
+        visible-card        (known-card game current-player target-player)
+        filtered-deck       (filter-fresh-deck known-list)]
+    (if visible-card
+      (if (>= player-value (:value visible-card)) 100 0)
       (float (/ (count (filter #(>= player-value (:value %)) filtered-deck))
                 (count filtered-deck))))))

@@ -136,14 +142,67 @@
 (defn prince-probability [game target-player]
   (let [{:keys [discard-pile current-player]} game
         current-player-hand (player-hand game current-player)
-        visible-card (known-card game current-player target-player)
-        known-list (mapv :face (concat discard-pile current-player-hand))
-        filtered-deck (filter-fresh-deck known-list)]
-    (if visible-card
-      (if (= :princess (:face card-known)) 100 0)
+        visible-card        (known-card game current-player target-player)
+        known-list          (mapv :face (concat discard-pile current-player-hand))
+        filtered-deck       (filter-fresh-deck known-list)]
+    (if visible-card
+      (if (= :princess (:face visible-card)) 100 0)
       (float (/ (count (filter #(= :princess (:face %)) filtered-deck))
                 (count filtered-deck))))))

+(defn princess-suicide-probability [] -1)
+
+(defn get-other-card [card hand]
+  (first (remove-first card hand)))
+
+(defn king-assist-probability [game target-player]
+  (let [{:keys [current-player]} game
+        current-player-hand (player-hand game current-player)
+        visible-card        (known-card game current-player target-player)
+        players-other-card  (get-other-card :king current-player-hand)]
+    (if visible-card
+      (case (:face visible-card)
+        :guard     80
+        :priest     0
+        :baron     40
+        :handmaid 100
+        :prince    30
+        :countess  10
+        :princess   0
+        :default    0)
+      (case (:face players-other-card)
+        :guard      0
+        :priest    90
+        :baron     10
+        :handmaid   0
+        :prince    25
+        :princess 100
+        :default    0))))
+
+(defn contains-attack-card? [hand]
+  (let [faces (set (map :face hand))]
+    (some faces [:baron :guard :prince])))
+
+(defn priest-probability [game target-player]
+  (let [{:keys [current-player]} game
+        current-player-hand (player-hand game current-player)
+        visible-card        (known-card game current-player target-player)]
+    (if visible-card
+      0
+      (if (contains-attack-card? current-player-hand) 100 50))))
+
+(priest-probability test-game 4)
 (prince-probability test-game 3)

 (high-card test-game {:face :king :value 6})
+
+(defn holding-princess? [hand]
+  (= :princess (:face (get-other-card :countess hand))))
+
+(defn countess-bluff [game]
+  (let [{:keys [current-player]} game
+        current-player-hand (player-hand game current-player)]
+    (if (holding-princess? current-player-hand) 0 100)))
+
+(defn handmaid-defensive-probability [] 100)
+


Show soution in puzzle view if user solved puzzle. Close #7.

--- src/cljs/nonojure/puzzleview.cljs
+++ src/cljs/nonojure/puzzleview.cljs
@@ -336,8 +336,8 @@
       (dommy/toggle-class! el "num-clicked"))))

 (defn apply-progress [progress state]
-  (let [state (if (:solved? progress) (assoc state :solved? true) state)]
-   (if-let [saved-board (:auto progress)]
+  (let [state (if (= (keyword (:status progress)) :solved) (assoc state :solved? true) state)]
+   (if-let [saved-board (or (:auto progress) (:solution progress))]
      (let [width (count (first saved-board))
            height (count saved-board)]
        (update-cells-region-style! [0 0] [(dec width) (dec height)] (fn [x y] (get-in saved-board [y x])))


Rejigger the prepare statement for use with document index updatinc

--- src/doctopus/db.clj
+++ src/doctopus/db.clj
@@ -90,8 +90,10 @@

 (defentity documents
   (table :documents)
-  (prepare ->snake-keys)
-  (prepare add-updated)
+  ;; Because of the `raw' call used in update-document-index', this table
+  ;; specifically needs to *not* have any but its top level keys munged by
+  ;; ->snake-keys
+  (prepare ->shallow-snake-keys)
   (transform ->kebab-keys)
   (belongs-to tentacles)
   (entity-fields :name :uri :tentacle_name :body))


Set the width and height of the svg icon

- not all browsers make SVGs fill their parent container by default

--- src/datafrisk/core.cljs
+++ src/datafrisk/core.cljs
@@ -5,9 +5,10 @@

 (defn ExpandButton [{:keys [expanded? path emit-fn]}]
   [:button {:style {:border "0"
-                    :backgroundColor "transparent" :width "20px " :height "20px"}
+                    :backgroundColor "transparent" :width "20px" :height "20px"}
             :onClick #(emit-fn (if expanded? :contract :expand) path)}
-   [:svg {:viewBox "0 0 100 100"}
+   [:svg {:viewBox "0 0 100 100"
+          :width "100%" :height "100%"}
     [:polygon {:points (if expanded? "0,0 100,0 50,100"
                                      "0,0 0,100 100,50") :stroke "black"}]]])


added some docstrings

added some docstrings

--- src/datasplash/core.clj
+++ src/datasplash/core.clj
@@ -123,6 +123,8 @@
   ([kv] (make-kv (first kv) (second kv))))

 (defn dkey
+  {:doc "Returns the key part of a KV or MapEntry."
+   :added "0.1.0"}
   [elt]
   (if (instance? KV elt)
     (let [^KV kv elt]
@@ -130,6 +132,8 @@
     (key elt)))

 (defn dval
+  {:doc "Returns the value part of a KV or MapEntry."
+   :added "0.1.0"}
   [elt]
   (if (instance? KV elt)
     (let [^KV kv elt]
@@ -250,7 +254,6 @@
   [^DoFn$ProcessContext c]
   (.output c (.element c)))

-
 (defn make-nippy-coder
   {:doc "Returns an instance of a CustomCoder using nippy for serialization"
    :added "0.1.0"}
@@ -286,6 +289,7 @@
    ptransform schema))

 (defn apply-transform
+  "apply the PTransform to the given Pcoll applying options according to schema."
   [pcoll ^PTransform transform schema
    {:keys [coder coll-name] :as options}]
   (let [nam (some-> options (:name) (name))
@@ -484,9 +488,14 @@
                         (assert (instance? transform View$AsSingleton) "Default values can only be set for Singleton views")
                         (if v
                           (.withDefaultValue transform v)
-                          transform))}}))
+                          transform))}
+    :type {:docstr "One of :singleton, :iterable, :list, :map or :multi-map. Defaults to :singleton"}}))

 (defn view
+  {:doc (with-opts-docstr
+          "Produces a View out of a PColl, to be later consumed as a side-input for example. See https://cloud.google.com/dataflow/java-sdk/JavaDoc/"
+          view-schema)
+   :added "0.1.0"}
   ([{:keys [type]
      :or {type :singleton}
      :as options}
@@ -523,6 +532,7 @@
       (safe-exec (f input)))))

 (defn partition-fn
+  "Returns a Partition.PartitionFn if possible"
   ^Partition$PartitionFn
   [f]
   (if (instance? Partition$PartitionFn f)
@@ -533,6 +543,11 @@
         (f elem num)))))

 (defn dpartition-by
+  {:doc (with-opts-docstr
+          "Partions the content of pacoll according to the PartitionFn.
+See https://cloud.google.com/dataflow/java-sdk/JavaDoc/com/google/cloud/dataflow/sdk/transforms/Partition"
+          named-schema)
+   :added "0.1.0"}
   ([f num options ^PCollection pcoll]
    (let [opts (assoc options :label :partition-by)
          ptrans (Partition/of num (partition-fn f))]


Start merging blessed Dato calls with plain SS routing table, including normalizing signatures

--- src/dato/lib/server.clj
+++ src/dato/lib/server.clj
@@ -187,8 +187,9 @@
         _                (println "Message data:" (pr-str msg))
         raw-incoming     (cdc/decode (.getBytes msg) :transit)
         [event msg-data] raw-incoming
-        args             (:args msg-data)
-        ;; this will fail for e.g. (log-out!) (:args msg-data) will be nil
+        args             (or (:args msg-data) [:place-holder])
+        ;; :place-holder is to prever failure for e.g. (log-out!),
+        ;; otherwise (:args msg-data) will be nil
         rpc?             (boolean args)
         _                (println "raw-incoming ffs: " (pr-str raw-incoming))
         _                (println "\t: " (pr-str [event] :handler))
@@ -196,16 +197,14 @@
         _                (def -last-session session)
         _                (println "\targs: " args)
         handler          (get-in routing-table [[event] :handler] default-handler)
-        ;; temp hackishness
+        ;; Temp hackishness
         handler          (if (var? handler)
                            @handler
                            handler)
         data             (if rpc?
-                           (do
-                             (println "rpc")
-                             {:server/rpc-id (:rpc/id msg-data)
-                              :data          (apply (partial handler session all-sessions) args)})
-                           (handler session raw-incoming all-sessions))
+                           {:server/rpc-id (:rpc/id msg-data)
+                            :data          (apply (partial handler session all-sessions) args)}
+                           (apply (partial handler session all-sessions) (or args)))
         _                (println "data: " (pr-str data))
         encoded          (cdc/encode data :transit)]
     (when data
@@ -239,7 +238,7 @@
              :ss      ss
              :schema  (datomic-db->datomic-schema db)})))

-(defn update-session [my-session [_ data] context]
+(defn update-session [my-session _ data]
   ;; XXX update-in is dangerous here, we're allowing any key the user
   ;; encodes in transit to be inserted here and to get broadcast out
   ;; to other users. Should apply a whitelist approach.
@@ -254,7 +253,19 @@
       (let [ch (get-in session [:live :ch])]
         (async/send! ch payload)))))

-(defn r-pull [session [_ incoming] context]
+(defn r-q [session _ incoming]
+  (println "r-q" (pr-str incoming))
+  (let [q-name        (:name incoming)
+        datalog-query (:q incoming)
+        query-args    (:args incoming)
+        data          (apply d/q datalog-query
+                             (session-db (dato-session session))
+                             query-args)]
+    (ss-msg (keyword "server" (str (name q-name) "-succeeded"))
+            {:results data})))
+
+(defn r-pull [session _ incoming]
+  (println "R-pull! " (pr-str incoming))
   (let [p-name  (:name incoming)
         pattern (incoming/ensure-pull-required-fields (:pull incoming))
         data    (d/pull (session-db (dato-session session))
@@ -263,7 +274,7 @@
     (ss-msg (keyword "server" (str (name p-name) "-succeeded"))
             {:results data})))

-(defn r-qes-by [session [_ incoming] context]
+(defn r-qes-by [session _ incoming]
   (let [qes-name (:name incoming)
         data     (->> (if (:v incoming)
                         (dsu/qes-by (session-db (dato-session session))
@@ -276,14 +287,12 @@
             {:results data})))

-
-
-(defn handle-transaction [session raw context]
+(defn handle-transaction [session _ raw]
   (println "WTF handle-transaction: ")
   (println "\t " session)
   (println "\t " raw)
   (def l-raw raw)
-  (let [[_ incoming] raw
+  (let [incoming     raw
         _            (def l-incoming incoming)
         full-session (dato-session session)
         dato-server  (session-server full-session)
@@ -307,11 +316,12 @@
       )))

 (def default-routing-table
-  {[:session/updated] {:handler update-session}
-   [:ss/tx-requested] {:handler handle-transaction}
-   [:ss/r-qes-by]     {:handler r-qes-by}
-   [:ss/r-pull]       {:handler r-pull}
-   [:ss/bootstrap]    {:handler bootstrap-user}})
+  {[:session/updated] {:handler #'update-session}
+   [:ss/tx-requested] {:handler #'handle-transaction}
+   [:ss/r-q]          {:handler #'r-q}
+   [:ss/r-qes-by]     {:handler #'r-qes-by}
+   [:ss/r-pull]       {:handler #'r-pull}
+   [:ss/bootstrap]    {:handler #'bootstrap-user}})

 (defn new-routing-table [table]
   (merge default-routing-table table))


back pressure on ventilator.  admitter's puts are now blocking.

--- src/fowles/admitter.clj
+++ src/fowles/admitter.clj
@@ -4,20 +4,9 @@
    + Data:   video-ids, queries.
    + Output: Put for requester."
   (:require [zeromq.zmq :as zmq]
-            [clojure.core.async :refer [go >! chan >!!]]))
+            [clojure.core.async :refer [chan >!!]]))

 (def BUFFER_SIZE 1000)
-
-;; TODO: rename to enq-seq
-(defn enq
-  "Enqueue some fixed sequence of items to to-ch.
-   :: (chan, ISeq) -> ()"
-  [to-ch seq]
-  (doseq [i seq]
-    (>!! to-ch i)))
-;; DO NOT CLOSE.  We want the channel pipeline to remain open
-;; for "next page" urls.
-;; (close! to-ch))

 (defn- mk-connect-addr
   [host port]
@@ -37,7 +26,8 @@
       (while true
         (let [msg (zmq/receive-str puller)]
           (println "receiving:" msg)
-          (go (>! to-ch msg)))))))
+          ;; -blocking- put
+          (>!! to-ch msg))))))

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


Print total and paid amounts

Print total and paid amounts

--- src/invadm/core.clj
+++ src/invadm/core.clj
@@ -44,6 +44,21 @@
 (defn sum-payments [invoice]
   (sum (map #(get % "amount") (get invoice "payments"))))

+(defn sum-key-by-currency [invoices amount-key]
+  (reduce (fn [totals invoice]
+            (let [invoice-currency (get invoice "currency")]
+              (assoc totals
+                     invoice-currency (+ (or (get totals invoice-currency) 0)
+                                         (get invoice amount-key)))))
+          {}
+          invoices))
+
+(defn sum-amount-by-currency [invoices]
+  (sum-key-by-currency invoices "amount"))
+
+(defn sum-paid-by-currency [invoices]
+  (sum-key-by-currency invoices "paid"))
+
 (defn add-convenience-fields [invoice]
   (assoc invoice
          "paid" (sum-payments invoice)
@@ -89,6 +104,10 @@
    "Amount" (format-amount (get invoice "amount") (get invoice "currency"))
    "Paid" (format-amount (sum-payments invoice)
                          (get invoice "currency"))})
+
+(defn print-by-currency [sum]
+  (doseq [keyval sum]
+    (println (str "  " (format-amount (val keyval) (key keyval))))))

 (defn options-to-filter [options]
   (fn [invoice]
@@ -164,10 +183,15 @@
                                                    (read-all-invoices))))))))

 (defn list_ [options]
-  (pprint/print-table (map pretty-print-invoice
-                           (sort compare-invoices-by-issue-date
-                                 (filter (options-to-filter options)
-                                         (read-all-invoices))))))
+  (let [invoices (sort compare-invoices-by-issue-date
+                       (filter (options-to-filter options)
+                               (read-all-invoices)))]
+    (pprint/print-table (map pretty-print-invoice invoices))
+    (println "\nTotal:")
+    (print-by-currency (sum-amount-by-currency invoices))
+    (println "\nPaid:")
+    (print-by-currency (sum-paid-by-currency invoices))))
+

 (defn record-payment [options arguments]
   (let [id (get arguments 1)


Print issue, due and net

Print issue, due and net

--- src/invadm/core.clj
+++ src/invadm/core.clj
@@ -87,12 +87,17 @@
     (every? #(= (get options %) (get invoice (name %))) (keys options))))

 (defn pretty-print-invoice [invoice]
-  (format (->> ["Invoice #%s"
+  (format (->> ["\nInvoice #%s"
                 "Client: %s"
-                "Amount: %d %s\n"]
+                "Issue date: %s"
+                "Due date: %s (Net %d)"
+                "Amount: %d %s"]
                (string/join \newline))
           (get invoice "id")
           (get invoice "client")
+          (get invoice "issue-date")
+          (get invoice "due-date")
+          (get invoice "net")
           (get invoice "amount")
           (get invoice "currency")))


support run tidb

support run tidb

--- src/jepsen/tidb.clj
+++ src/jepsen/tidb.clj
@@ -28,15 +28,15 @@
   (info node "installing hbase + themis")
   (c/su
     (c/cd "/root"
-          (let [uri "https://archive.apache.org/dist/hbase/hbase-0.98.6/hbase-0.98.6-hadoop2-bin.tar.gz"]
+          (let [uri "https://archive.apache.org/dist/hbase/0.98.15/hbase-0.98.15-hadoop2-bin.tar.gz"]
             (when-not (cu/file? "hbase")
               (info node "installing java")
               (debian/install ["openjdk-7-jre-headless"])

               (info node "downloading hbase")
               (c/exec :wget :-c uri)
-              (c/exec :tar :xzf "hbase-0.98.6-hadoop2-bin.tar.gz")
-              (c/exec :mv :-f "hbase-0.98.6-hadoop2" "hbase"))))
+              (c/exec :tar :xzf "hbase-0.98.15-hadoop2-bin.tar.gz")
+              (c/exec :mv :-f "hbase-0.98.15-hadoop2" "hbase"))))
     (c/cd "/root/jepsen-tidb-res"
           (info node "installing tso-server")
           (c/exec :tar :xzf "tso-server.tar.gz")
@@ -99,7 +99,7 @@
             :--no-close
             :--
             (str "-addr=:1234")
-            :> tso-log
+            :>> tso-log
             (c/lit "2>&1"))
     (info node "tso server started")))

@@ -125,12 +125,12 @@
             :--exec     tidb-binary
             :--no-close
             :--
-            (str "-L=error")
+            (str "-L=debug")
             (str "-P=3306")
             (str "-lease=1")
             (str "-store=hbase")
-            (str "-path=" store-path)
-            :> tidb-log
+            (str "-path=" (c/lit store-path))
+            :>> tidb-log
             (c/lit "2>&1")
             )
     (info node "tidb server started")))
@@ -155,8 +155,13 @@
   [node]
   (c/su
     (info node "stopping hbase")
-    (c/exec "/root/hbase/bin/stop-hbase.sh")
-    (c/exec :rm :-rf "./logs/*")))
+    ;call stop-hbase.sh is very slow, so here we kill java forcely.
+    (meh (cu/grepkill "java"))
+    ;(meh (c/exec "/root/hbase/bin/stop-hbase.sh"))
+    (meh (c/exec :rm :-rf "/root/hbase/logs/*"))
+    (meh (c/exec :rm :-rf "/var/lib/hbase/*"))
+    (meh (c/exec :rm :-rf "/var/lib/hbase_zookeeper/*")))
+  (info node "hbase stopped"))

 (defn db
   "Sets up and tears down TiDB"
@@ -168,7 +173,8 @@
             (when (= node :n1)
               (install-hbase! node)
               (start-hbase! node)
-              (start-tso-server! node))
+              (start-tso-server! node)
+              (Thread/sleep 1000))

             (jepsen/synchronize test)
             (start-tidb-server! node)
@@ -186,6 +192,7 @@
   [version]
   (merge tests/noop-test
          {:os debian/os
-          :db (db version)}))
+          :db (db version)
+          :concurrency 20}))


ensure game_id is always an int

ensure game_id is always an int

--- src/greybear/server.clj
+++ src/greybear/server.clj
@@ -8,7 +8,7 @@

 (defroutes main-routes
-  (GET "/games/:id" [id :as {session :session}]
+  (GET ["/games/:id", :id #"[0-9]+"] [id :as {session :session}]
        (game session (Integer. id)))
   (GET "/login" [] login-get)
   (POST "/login" request (login-post request))


Refactoring: function finish-processing is semi-universal, get rid of rest similar functions

--- src/hurvinek/server.clj
+++ src/hurvinek/server.clj
@@ -40,32 +40,11 @@
         :server
         :url-prefix))

-(defn finish-processing-front-page
-    [request title]
-    (let [params        (:params request)
-          url-prefix    (get-url-prefix request)]
-          (-> (http-response/response (html-renderer/render-front-page url-prefix title))
-              (http-response/content-type "text/html"))))
-
-(defn finish-processing-help-page
-    [request title]
-    (let [params        (:params request)
-          url-prefix    (get-url-prefix request)]
-          (-> (http-response/response (html-renderer/render-help-page url-prefix title))
-              (http-response/content-type "text/html"))))
-
-(defn finish-processing-database-statistic-page
-    [request title db-stat]
-    (let [params        (:params request)
-          url-prefix    (get-url-prefix request)]
-          (-> (http-response/response (html-renderer/render-database-statistic-page url-prefix title db-stat))
-              (http-response/content-type "text/html"))))
-
-(defn finish-processing-export-database-page
-    [request title]
-    (let [params        (:params request)
-          url-prefix    (get-url-prefix request)]
-          (-> (http-response/response (html-renderer/render-export-database-page url-prefix title))
+(defn finish-processing
+    [render-function request title & rest-parameters]
+    (let [params        (:params request)
+          url-prefix    (get-url-prefix request)]
+          (-> (http-response/response (apply render-function url-prefix title rest-parameters))
               (http-response/content-type "text/html"))))

 (defn finish-processing-product-list
@@ -107,21 +86,21 @@
 (defn process-front-page
     "Function that prepares data for the front page."
     [request title]
-    (finish-processing-front-page request title))
+    (finish-processing html-renderer/render-front-page request title))

 (defn process-help-page
     [request title]
-    (finish-processing-help-page request title))
+    (finish-processing html-renderer/render-help-page request title))

 (defn process-database-statistic
     [request title]
     (let [db-stat (db-interface/read-database-statistic)]
         (print "DB stat:" db-stat)
-        (finish-processing-database-statistic-page request title db-stat)))
+        (finish-processing html-renderer/render-database-statistic-page request title db-stat)))

 (defn process-export-database
     [request title]
-    (finish-processing-export-database-page request title))
+    (finish-processing html-renderer/render-export-database-page request title))

 (defn process-select-product-page
     "Function that prepares data for the 'Select product' page."


image sequence

image sequence

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

--- plugins/SlideExplorer2/src/slide_explorer/display.clj
+++ plugins/SlideExplorer2/src/slide_explorer/display.clj
@@ -12,7 +12,8 @@
            (ij ImagePlus)
            (mmcorej TaggedImage)
            (org.micromanager AcqEngine MMStudioMainFrame)
-           (org.micromanager.utils GUIUpdater ImageUtils JavaUtils MDUtils))
+           (org.micromanager.utils GUIUpdater ImageUtils JavaUtils MDUtils)
+           (org.micromanager.acquisition TaggedImageQueue))
   (:use [org.micromanager.mm :only (core edt mmc load-mm json-to-data)]))

 (load-mm)
@@ -37,7 +38,7 @@

 (defn image-sequence []
   (let [q (.runSilent (AcqEngine.))]
-    (take-while #(not= % org.micromanager.acquisition.TaggedImageQueue/POISON)
+    (take-while #(not= % TaggedImageQueue/POISON)
                 (repeatedly #(.take q)))))

 ;; image properties


Update editor/set-line to CodeMirror 4 API

`lt.objs.editor/set-line` used the CodeMirror method `.setLine`, which
is deprecated as of v4.

The updated `set-line` uses `.replaceRange` instead, as suggested in
the CodeMirror v4 upgrade guide.
http://codemirror.net/doc/upgrade_v4.html#upgrade.

--- src/lt/objs/editor.cljs
+++ src/lt/objs/editor.cljs
@@ -290,7 +290,11 @@
   (.getLine (->cm-ed e) l))

 (defn set-line [e l text]
-  (.setLine (->cm-ed e) l text))
+  (let [length (line-length e l)]
+    (replace e
+             {:line l :ch 0}
+             {:line l :ch length}
+             text)))

 (defn first-line [e]
   (.firstLine (->cm-ed e)))


Add docstring to core namespace.

Add docstring to core namespace.

--- src/fhofherr/clj_db_util/core.clj
+++ src/fhofherr/clj_db_util/core.clj
@@ -1,4 +1,20 @@
 (ns fhofherr.clj-db-util.core
+  "The `core` namespace provides acces to all of `clj-db-util`'s core functionality.
+  Applications should usually not need to import any other of `clj-db-util`'s namespaces.
+
+  The `core` namespace provides access to the following features:
+
+  * Connect to a database using a connection pool ([[connect-to-db]]).
+  * Manage database schema changes using [Flyway](https://flywaydb.org/) ([[db-info]],
+    [[db-version]], [[migrate-db]], [[clean-db]]).
+  * Manage database transaction using monadic wrappers around the functions
+    provided by [`clojure.java.jdbc`](https://github.com/clojure/java.jdbc) ([[query]],
+    [[insert!]], [[update!]], [[delete!]], [[execute!]], [[rollback!]], [[with-db-transaction]]).
+    Arbitrary values can be lifted into database transactions using the [[transactional]]
+    macro. New transactional operations are defined using the [[transactional-operation]] macro.
+  * The wrappers arround database operations ([[query]], [[update!]], [[delete!]], [[execute!]])
+    support named parameters in addition to positional parameters.
+  * Put statements into resource files to avoid large statements as strings in your code ([[load-stmt]])."
   (:require [clojure.java.jdbc :as jdbc]
             [clojure.tools.logging :as log]
             [clojure.java.io :as io]
@@ -19,14 +35,24 @@
 (alter-meta! #'map->Database assoc :no-doc true)

 (defn database?
+  "Test if `db` is a database in the sense of `clj-db-util`."
+  {:added "0.2.0"}
   [db]
   (instance? Database db))

-(defn migrations-loc [{:keys [db-resource-path schema vendor]}]
+(defn migrations-loc
+  "Obtain the classpath location of schema migrations for `db`."
+  {:added    "0.2.0"
+   :arglists '([db])}
+  [{:keys [db-resource-path schema vendor]}]
   {:pre [db-resource-path schema vendor]}
   (format "%s/%s/%s/migrations" db-resource-path (name vendor) schema))

-(defn statements-loc [{:keys [db-resource-path schema vendor]}]
+(defn statements-loc
+  "Obtain the classpath location of statements to execute against `db`."
+  {:added "0.2.0"
+   :arglists '([db])}
+  [{:keys [db-resource-path schema vendor]}]
   {:pre [db-resource-path vendor schema]}
   (format "%s/%s/%s/statements" db-resource-path (name vendor) schema))

@@ -53,6 +79,8 @@
     (assoc db :migrator fw)))

 (defn connect-to-db
+  "Create a connection pool for the database identified by `url`, `user`, and `password`."
+  {:added "0.2.0"}
   [^String url ^String user ^String password]
   {:pre [url user password]}
   (let [cfg (doto (HikariConfig.)
@@ -68,11 +96,25 @@
           (map->Database)
           (add-migrator)))))

-(defn disconnect-from-db [{:keys [^HikariDataSource datasource]}]
+(defn disconnect-from-db
+  "Close the connection pool used to connect to the database."
+  {:added "0.2.0"}
+  [{:keys [^HikariDataSource datasource]}]
   {:pre [datasource]}
   (.close datasource))

 (defmacro with-database
+  "Execute the expressions in the `body` with a database bound to `db-sym`.
+  Disconnect from the database afterwards. Evaluate to whatever `body` evaluates.
+
+  Example:
+
+  ```clojure
+  (with-database [db (connect-to-db \"url\" \"user\" \"password\"]
+    ;; your code here
+    (println \"Hello World\"))
+  ```"
+  {:added "0.2.0"}
   [[db-sym connect-expr :as bnd] & body]
   {:pre [(symbol? db-sym) connect-expr]}
   `(let ~bnd
@@ -82,6 +124,8 @@
          (disconnect-from-db ~db-sym)))))

 (defn verify-connection
+  "Verify that connections to `db` can be obtained."
+  {:added "0.2.0"}
   [db]
   {:pre [db]}
   (let [c  (.getConnection ^DataSource (:datasource db))]
@@ -91,11 +135,20 @@
         (.close c)))))

 (defn ^MigrationInfoService db-info
+  "Retrieve all information about the database. This includes information
+  about applied, pending and current migrations.
+
+  See
+  [Flyway's API documenetation](http://flywaydb.org/documentation/api/javadoc/org/flywaydb/core/Flyway.html#info--)
+  for details."
+  {:added "0.2.0"}
   [{:keys [^Flyway migrator]}]
   {:pre [migrator]}
   (.info migrator))

 (defn db-version
+  "Get the database's current version"
+  {:added "0.2.0"}
   [db]
   (some-> db
           (db-info)
@@ -104,16 +157,30 @@
           (.getVersion)))

 (defn migrate-db
+  "Migrate the database to the latest version.
+
+  See
+  [Flyway's API documenetation](http://flywaydb.org/documentation/api/javadoc/org/flywaydb/core/Flyway.html#migrate--)
+  for details."
+  {:added "0.2.0"}
   [{:keys [^Flyway migrator] :as db}]
   {:pre [migrator]}
   (.migrate migrator)
   (db-version db))

 (defn clean-db
+  "Wipe all database schemas managed by Flyway.
+
+  **Attention**: This drops all tables in the affected database. Do not call from production code.
+
+  See
+  [Flyway's API documenetation](http://flywaydb.org/documentation/api/javadoc/org/flywaydb/core/Flyway.html#clean--)
+  for details."
+  {:added "0.2.0"}
   [{:keys [^Flyway migrator]}]
   (.clean migrator))

-(defn db-spec
+(defn- db-spec
   [{:keys [datasource]}]
   {:pre [datasource]}
   {:datasource datasource})
@@ -123,23 +190,30 @@
 (alter-meta! #'map->TransactionState assoc :no-doc true)

 (defn transaction-state?
+  "Test if the passed object represents an transaction state."
+  {:added "0.2.0"}
   [tx-state]
   (instance? TransactionState tx-state))

 (def err-transaction-rolled-back {:error "Transaction rolled back"})

-(defn rollback-only?
+(defn- rollback-only?
   [{:keys [t-con]}]
   {:pre [t-con]}
   (jdbc/db-is-rollback-only t-con))

-(defn set-rollback-only!
+(defn- set-rollback-only!
   [{:keys [t-con] :as tx-state}]
   {:pre [t-con (transaction-state? tx-state)]}
   (jdbc/db-set-rollback-only! t-con)
   tx-state)

 (defn ^:dynamic *exception-during-transaction*
+  "Handle exceptions that occur during a database transaction. The default implementation
+  logs the occured exception and then rolls back the transaction. As this method is
+  dynamic it may be rebound to another implementation. Implementors must then take care
+  of rolling back the transaction if necessary."
+  {:added "0.2.0"}
   [tx-state ^Exception ex]
   (log/warn ex "Exception occured during transaction")
   ;; TODO repeatedly call and log getNextException (if possible) (see java.sql.BatchUpdateException)
@@ -147,6 +221,12 @@
     [nil rolled-back]))

 (defmacro transactional-operation
+  "Create function `tx-state -> [x tx-state*]` where `tx-state*` is the
+  possibly altered transaction state and `x` is an arbitrary result. The `body` used
+  to define the transactional operation must evaluate tp `[x tx-state*]`.
+
+  In most cases it should not be necessary to call this macro directly."
+  {:added "0.2.0"}
   [[tx-state-bnd] & body]
   {:pre [(symbol? tx-state-bnd) (not-empty body)]}
   ;; TODO add meta data identifying the function as transactional operation?
@@ -154,36 +234,42 @@
      {:post [(sequential? ~'%) (transaction-state? (second ~'%))]}
      (let [tx-state# ~tx-state-bnd]
        (try
-         (if (rollback-only? tx-state#)
+         (if (#'rollback-only? tx-state#)
            [nil tx-state#]
            (io! ~@body))
          (catch Exception ex#
            (*exception-during-transaction* tx-state# ex#))))))

 (defmacro transactional
+  "Wrap `form` into a transaction. `form` will be evaluated upon transaction execution."
+  {:added "0.2.0"}
   [form]
   `(transactional-operation [tx-state#] [~form tx-state#]))

 (defn transactional-bind
-  [tx-op tx-op-factory]
+  "Combine two transactional operations. `f` is expected to be a function `x -> tx-op*`
+  where `x` is the result of `tx-op`."
+  {:added "0.2.0"}
+  [tx-op f]
   (transactional-operation
    [tx-state]
    (let [[res next-tx-state] (tx-op tx-state)
-         next-tx-op (tx-op-factory res)]
+         next-tx-op (f res)]
      (next-tx-op next-tx-state))))

-(defn- emit-tx-op-factory
-  [bnd tx-op]
-  `(fn [~bnd] ~tx-op))
-
 (defmacro transactional-let
-  [bindings & body]
-  {:pre [(not-empty bindings) (even? (count bindings)) (not-empty body)]}
-  (let [emit-binding-op-factoy (fn [[tx-op op-factory] [bnd-sym prev-tx-op]]
+  "Evaluate `body` in a lexical context in which the symbols in `bindings*` are bound to the results
+  of previous transactional operations."
+  {:added "0.2.0"}
+  [bindings* & body]
+  {:pre [(not-empty bindings*) (even? (count bindings*)) (not-empty body)]}
+  (let [emit-tx-op-factory (fn [bnd tx-op]
+                             `(fn [~bnd] ~tx-op))
+        emit-binding-op-factoy (fn [[tx-op op-factory] [bnd-sym prev-tx-op]]
                                  (let [prev-op-factory (emit-tx-op-factory bnd-sym
                                                                            `(transactional-bind ~tx-op ~op-factory))]
                                    [prev-tx-op prev-op-factory]))
-        reversed-bindings (->> bindings
+        reversed-bindings (->> bindings*
                                (partition 2)
                                (reverse))
         [innermost-bnd-sym innermost-tx-op] (first reversed-bindings)
@@ -209,11 +295,15 @@
      [res tx-state])))

 (defn insert!
+  "Insert one or more `records` into the `table`."
+  {:added "0.2.0"}
   [table & records]
   {:pre [table (not-empty records)]}
   (apply wrap-jdbc-fn jdbc/insert! table records))

 (defn update!
+  "Update a value in a table."
+  {:added "0.2.0"}
   ([table value]
    (update! table value nil))
   ([table value where-clause]
@@ -223,6 +313,8 @@
    (wrap-jdbc-fn jdbc/update! table value (prepare-params where-clause param-vals))))

 (defn delete!
+  "Delete a record from a table."
+  {:added "0.2.0"}
   ([table]
    (delete! table nil))
   ([table where-clause]
@@ -232,6 +324,9 @@
    (wrap-jdbc-fn jdbc/delete! table (prepare-params where-clause param-vals))))

 (defn query
+  "Execute a query given as a string. The query may contain either positional (e.g. `?`) or
+  named (e.g. `:param-name`) parameters."
+  {:added "0.2.0"}
   ([sql-str]
    (query sql-str nil))
   ([sql-str param-vals]
@@ -239,6 +334,9 @@
    (wrap-jdbc-fn jdbc/query (prepare-params sql-str param-vals))))

 (defn execute!
+  "Execute an arbitrary sql statement except for a query. The statement may contain either positional (e.g. `?`) or
+  named (e.g. `:param-name`) parameters."
+  {:added "0.2.0"}
   ([sql-str]
    (execute! sql-str nil))
   ([sql-str param-vals]
@@ -246,12 +344,16 @@
    (wrap-jdbc-fn jdbc/execute! (prepare-params sql-str param-vals))))

 (defn rollback!
+  "Rollback the transaction. Further transactional operations will not be executed anymore."
+  {:added "0.2.0"}
   []
   (transactional-operation
    [tx-state]
    [nil (set-rollback-only! tx-state)]))

 (defn load-stmt
+  "Load a sql statement from a resource. The statement may contain either positional or named parameters."
+  {:added "0.2.0"}
   [stmt-name]
   (transactional-operation
     [tx-state]
@@ -263,6 +365,8 @@
       [(slurp stmt-res) tx-state])))

 (defn with-db-transaction
+  "Exectue `tx-op` within a database transaction."
+  {:added "0.2.0"}
   [db tx-op]
   {:pre [(database? db)]}
   (io!
@@ -270,6 +374,6 @@
      [t-con (db-spec db)]
      (let [tx-state (map->TransactionState {:t-con t-con :db db})
            [tx-result final-tx-state] (tx-op tx-state)]
-       (if (rollback-only? final-tx-state)
+       (if (#'rollback-only? final-tx-state)
          [tx-result err-transaction-rolled-back]
          [tx-result nil])))))


Доводка разметки

Доводка разметки

--- radiolamp-6P3S/src/r6p3s/cpt/input_date_interval.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/input_date_interval.cljs
@@ -70,8 +70,10 @@
       (let [app-v @app]
         (dom/div #js {:className class-name :style style}

-                 (dom/div #js {:className "col-xs-12 col-sm-12 col-md-12 col-lg-12"}
-                          (dom/div #js {:className "col-xs-12 col-sm-6 col-md-6 col-lg-6"}
+                 (dom/div #js {:className "col-xs-12 col-sm-12 col-md-12 col-lg-12"
+                               :style     #js {:paddingRight 0 :paddingLeft 0}}
+                          (dom/div #js {:className "col-xs-12 col-sm-6 col-md-6 col-lg-6"
+                                        :style     #js {:paddingRight 0 :paddingLeft 0}}
                                    (om/build input/component-form-group (app :from-date)
                                              {:opts {:label       "с даты"
                                                      :label-style #js {:textAlign "right"}
@@ -79,7 +81,8 @@
                                                                    :placeholder               "yyyy-MM-dd"
                                                                    :onChange-valid?-fn        common-input/vldfn-not-empty-date
                                                                    :onChange-updated-valid-fn #(put! chan-update 1)}}}))
-                          (dom/div #js {:className "col-xs-12 col-sm-6 col-md-6 col-lg-6"}
+                          (dom/div #js {:className "col-xs-12 col-sm-6 col-md-6 col-lg-6"
+                                        :style     #js {:paddingRight 0 :paddingLeft 0}}
                                    (om/build input/component-form-group (app :to-date)
                                              {:opts {:label       "по дату"
                                                      :label-style #js {:textAlign "right"}


Track the last tweet id we saw, to prevent repeats

--- src/myshelf/twitter.clj
+++ src/myshelf/twitter.clj
@@ -38,18 +38,23 @@
   [channel tweet]
   (let [cmd (make-command tweet)]
     (lb/publish channel default-exchange worker-queue
-                (json/generate-string cmd))))
+                (json/generate-string cmd))
+    (:id tweet)))

 (defn check-tweets
-  [channel creds screen-name]
+  [channel creds screen-name current-id]
   (let [tweets (twitter/statuses-user-timeline
                 :oauth-creds creds
-                :params {:screen-name screen-name
-                         :count 10})]
+                :params (merge {:screen-name screen-name
+                                :count 10}
+                               (when current-id
+                                 {:since_id current-id})))]
     (->> tweets
          :body
+         (sort-by :id)
          (filter #(.contains (:text %) "myshelf-bot"))
-         (map (partial send-command channel)))))
+         (map (partial send-command channel))
+         last)))

 (defn generate-status
   [msg url cmd results]
@@ -83,7 +88,8 @@
     (lq/declare channel reply-queue {:auto-delete false})
     (lcs/subscribe channel reply-queue (partial handle-reply creds)
                    {:auto-ack true})
-    (loop [ch channel]
-      (check-tweets ch creds screen-name)
-      (Thread/sleep (* 60 1000) #_"one minute")
-      (recur ch))))
+    (loop [ch channel
+           current-id nil]
+      (let [last-id (check-tweets ch creds screen-name current-id)]
+        (Thread/sleep (* 60 1000) #_"one minute")
+        (recur ch (or last-id current-id))))))


better handling of optional abilities message

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -168,10 +168,10 @@
   (show-prompt state side card msg choices #(resolve-ability state side ability card [%])))

 (defn optional-ability [state side card msg ability targets]
-  (show-prompt state side card msg ["Yes" "No"]
-               #(if (= % "Yes")
-                  (resolve-ability state side ability card targets)
-                  (system-msg state side (:no-msg ability)))))
+  (show-prompt state side card msg ["Yes" "No"] #(if (= % "Yes")
+                                                   (resolve-ability state side ability card targets)
+                                                   (when-let [no-msg (:no-msg ability)]
+                                                     (system-msg state side (:no-msg ability))))))

 (defn resolve-ability [state side {:keys [counter-cost advance-counter-cost cost effect msg req once
                                           once-key optional prompt choices end-turn player psi


Forgot to dereferenec client config when constructing STS client.

--- src/onix/aws_common.clj
+++ src/onix/aws_common.clj
@@ -46,7 +46,7 @@

 (def sts-client
   (delay
-   (doto (AWSSecurityTokenServiceClient. amazon-client-config)
+   (doto (AWSSecurityTokenServiceClient. @amazon-client-config)
      (.setEndpoint "https://sts.amazonaws.com"))))

 (def assume-role-request


Remove comment.

Remove comment.

--- src/onyx/validation.clj
+++ src/onyx/validation.clj
@@ -203,7 +203,6 @@
                       {:entry entry})))))

 (defn validate-flow-conditions [flow-conditions-schema workflow]
-  ;; TODO: no flow conditions on output tasks allowed
   (validate-flow-structure flow-conditions-schema)
   (validate-flow-connections flow-conditions-schema workflow)
   (validate-flow-pred-all-kws flow-conditions-schema)


floating ip is per instance also

floating ip is per instance also

--- src/openstack/model.clj
+++ src/openstack/model.clj
@@ -16,7 +16,7 @@

 (def identifiers
   {:machine #{:ip :hostname :domain}
-   :openstack #{:instance-id}})
+   :openstack #{:instance-id :floating-ip}})

 (defmethod clone :openstack [spec clone-spec]
   "Clones the model replace unique identifiers in the process"


Trying to find more reasons

Trying to find more reasons

--- test/feedparser_test.clj
+++ test/feedparser_test.clj
@@ -1,5 +1,6 @@
 (import 'java.io.File)
 (require 'feedme)
+(use 'clojure.contrib.duck-streams)

 (defn file? [f]
   (.isFile f))
@@ -25,3 +26,12 @@
     (try
       (feedme/parse (str "file://" file))
     (catch Exception e (println file)))))
+
+(defn obj-ok []
+  (doseq [uri (read-lines "failed.log")]
+    (try
+      (feedme/make-feed uri)
+      (println uri)
+    (catch Exception e))))
+
+(obj-ok)


FifoBuffer remembers its seqv at creation.

--- src/rewindable/ago.cljs
+++ src/rewindable/ago.cljs
@@ -44,7 +44,7 @@
 ; CLJS/core.async's default mutable RingBuffer, so that we can easily
 ; take ago-world snapshots.  Note: we have an unused length property
 ; in order to keep ManyToManyChannel happy.
-(deftype FifoBuffer [ago-world buf-id length max-length]
+(deftype FifoBuffer [ago-world seqv buf-id length max-length]
   Object
   (pop [_]
     ; Assumes nil is not a valid buffer item.
@@ -81,7 +81,7 @@
     (count (get-in @ago-world [:bufs buf-id]))))

 (defn fifo-buffer [ago-world buf-id max-length]
-  (FifoBuffer. ago-world buf-id -123 max-length))
+  (FifoBuffer. ago-world (:seqv @ago-world) buf-id -123 max-length))

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


Ignore modifier keys during gamestate input handling

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -3598,6 +3598,8 @@
     :direction-select
     :close})

+(def modifier-keys #{:lshift :lcontrol :rshift :rcontrol})
+
 (defn update-state
   "Use the stage transtion table defined above to call the appropriate
    transition function and assign the appropriate final state value.
@@ -3623,7 +3625,8 @@
                         (translate-directions keyin)
                         keyin)]
     ;(log/debug "current-state" current-state)
-    (if (or (contains? table keyin) (contains? table :else))
+    (if (and (or (contains? table keyin) (contains? table :else))
+             (not (contains? modifier-keys keyin)))
       (let [[transition-fn new-state advance-time] (if (contains? table keyin) (get table keyin) (get table :else))
             ;; if the table contains keyin, then pass through transition-fn assuming arity-1 [state]
             ;; else the transition-fn takes [state keyin]. Bind keying so that it becomes arity-1 [state]


photo desc

photo desc

--- src/showkr/viewing.cljs
+++ src/showkr/viewing.cljs
@@ -85,7 +85,9 @@
           (d/a {:className "anchor"
                 :href (u/fmt "#%s/%s" set-id (:photo/id photo))} "#"))

-        (d/small {:rel "description"} (:description photo))
+        (d/small {:rel "description"
+                  :dangerouslySetInnerHTML
+                  (js-obj "__html" (:description photo))})

         (d/div {:className "row"}
           (d/div {:className "span8"}


Adjust margin again

Adjust margin again

--- dungeon-crawler/desktop/src-common/dungeon_crawler/entities.clj
+++ dungeon-crawler/desktop/src-common/dungeon_crawler/entities.clj
@@ -64,8 +64,8 @@
     (->> (assoc (create grid mask-size)
                 :npc? true
                 :max-velocity 2
-                :x-feet 0.25
-                :y-feet 0.25)
+                :x-feet 0.35
+                :y-feet 0.35)
          repeat
          (take n))))


Both cache clearing buttons say "Clear"

Both cache clearing buttons say "Clear"

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -441,9 +441,7 @@
                                           :project
                                           project-model/id)}])
      :kind :primary}
-    (case cache-type
-      "build" "Clear Dependencies"
-      "source" "Clear Sources")))
+    "Clear"))

 (defn clear-caches
   [project-data owner]


Use bifurcate instead of evaluating and passing over list twice

--- src/midje/checking/checkables.clj
+++ src/midje/checking/checkables.clj
@@ -9,7 +9,8 @@
             [midje.emission.boundaries :as emission-boundary]
             [midje.parsing.1-to-explicit-form.parse-background :as parse-background]
             [midje.util.exceptions :refer [captured-throwable]]
-            [midje.util.laziness :refer :all]))
+            [midje.util.laziness :refer :all]
+            [such.sequences :as seq]))

 (defn- minimal-failure-map
@@ -107,14 +108,13 @@
    and checks the checkable, reporting results through the emission interface."
   [checkable-map local-fakes]
   ((config/choice :check-recorder) checkable-map local-fakes)
-  (with-installed-fakes (concat (reverse (filter :data-fake (parse-background/background-fakes)))
-                                local-fakes
-                                (remove :data-fake (parse-background/background-fakes)))
-    (emission-boundary/around-check
-      (let [actual (try
-                     (eagerly ((:function-under-test checkable-map)))
-                    (catch Throwable ex
-                      (captured-throwable ex)))]
-        (report-incorrect-call-counts local-fakes)
-        (check-result actual checkable-map)
-        :irrelevant-return-value))))
+  (let [[data-fakes fn-fakes] (seq/bifurcate :data-fake (parse-background/background-fakes))]
+    (with-installed-fakes (concat (reverse data-fakes) local-fakes fn-fakes)
+      (emission-boundary/around-check
+        (let [actual (try
+                       (eagerly ((:function-under-test checkable-map)))
+                      (catch Throwable ex
+                        (captured-throwable ex)))]
+          (report-incorrect-call-counts local-fakes)
+          (check-result actual checkable-map)
+          :irrelevant-return-value)))))


Oops.  Broke deletions along the way...

Oops.  Broke deletions along the way...

--- src/net/dishevelled/mailindex.clj
+++ src/net/dishevelled/mailindex.clj
@@ -216,9 +216,9 @@

 (defmacro with-writer
   "Open a Lucene IndexWriter on `index' bound to `var' and evaluate `body'"
-  [index var & body]
+  [indexfile var & body]
   `(do
-     (let [dir# (FSDirectory/open (file ~index))]
+     (let [dir# (FSDirectory/open (file ~indexfile))]
        (IndexWriter/unlock dir#)
        (with-open [^IndexWriter ~var
                    (doto (IndexWriter.
@@ -231,10 +231,12 @@

 (defn do-deletes
-  "Remove any deletes messages from `index'"
-  [connection index]
-  (with-open [reader ^IndexReader (IndexReader/open index)]
-    (with-writer index writer
+  "Remove any deleted messages from `index'"
+  [connection indexfile]
+  (with-open [reader ^IndexReader (IndexReader/open
+                                   (FSDirectory/open
+                                    (file indexfile)))]
+    (with-writer indexfile writer
       (doseq [chunk (partition-all 1000 (range (.maxDoc reader)))]
         (let [doclist (into {}
                             (for [id chunk


Fix CRLF. This is what I get for originally writing the urlfetch stuff in windows.

--- src/appengine_magic/services/urlfetch.clj
+++ src/appengine_magic/services/urlfetch.clj
@@ -1,43 +1,43 @@
-(ns appengine-magic.services.urlfetch
-  (:import [com.google.appengine.api.urlfetch URLFetchServiceFactory]))
-
-(defonce *urlfetch-service* (atom nil))
-
-(defn- get-urlfetch-service []
-  (do (when (nil? @*urlfetch-service*)
-	(reset! *urlfetch-service* (URLFetchServiceFactory/getURLFetchService)))
-      @*urlfetch-service*))
-
-(defn- urlify [url]
-  (if (string? url) (java.net.URL. url) url))
-
-(defrecord HTTPResponse [content
-			 final-url
-			 headers
-			 response-code])
-
-(defn- parse-headers [headers]
-  (zipmap (map #(keyword (.getName %)) headers)
-	  (map #(.getValue %) headers)))
-
-(defn- parse-response
-  [^com.google.appengine.api.urlfetch.HTTPResponse r]
-  (HTTPResponse. (.getContent r)
-		 (.getFinalUrl r)
-		 (parse-headers (.getHeaders r))
-		 (.getResponseCode r)))
-
-(defn fetch [url]
-  (parse-response (.fetch (get-urlfetch-service) (urlify url))))
-
-(defn fetch-async [url]
-  (let [f (.fetchAsync (get-urlfetch-service) (urlify url))]
-    (reify
-     clojure.lang.IDeref
-      (deref [_] (parse-response (.get f)))
-     java.util.concurrent.Future
-      (get [_] (.get f))
-      (get [_ timeout unit] (.get f timeout unit))
-      (isCancelled [_] (.isCancelled f))
-      (isDone [_] (.isDone f))
-      (cancel [_ interrupt?] (.cancel f interrupt?)))))
+(ns appengine-magic.services.urlfetch
+  (:import [com.google.appengine.api.urlfetch URLFetchServiceFactory]))
+
+(defonce *urlfetch-service* (atom nil))
+
+(defn- get-urlfetch-service []
+  (do (when (nil? @*urlfetch-service*)
+	(reset! *urlfetch-service* (URLFetchServiceFactory/getURLFetchService)))
+      @*urlfetch-service*))
+
+(defn- urlify [url]
+  (if (string? url) (java.net.URL. url) url))
+
+(defrecord HTTPResponse [content
+			 final-url
+			 headers
+			 response-code])
+
+(defn- parse-headers [headers]
+  (zipmap (map #(keyword (.getName %)) headers)
+	  (map #(.getValue %) headers)))
+
+(defn- parse-response
+  [^com.google.appengine.api.urlfetch.HTTPResponse r]
+  (HTTPResponse. (.getContent r)
+		 (.getFinalUrl r)
+		 (parse-headers (.getHeaders r))
+		 (.getResponseCode r)))
+
+(defn fetch [url]
+  (parse-response (.fetch (get-urlfetch-service) (urlify url))))
+
+(defn fetch-async [url]
+  (let [f (.fetchAsync (get-urlfetch-service) (urlify url))]
+    (reify
+     clojure.lang.IDeref
+      (deref [_] (parse-response (.get f)))
+     java.util.concurrent.Future
+      (get [_] (.get f))
+      (get [_ timeout unit] (.get f timeout unit))
+      (isCancelled [_] (.isCancelled f))
+      (isDone [_] (.isDone f))
+      (cancel [_ interrupt?] (.cancel f interrupt?)))))


Do not force Vicki’s voice for notifications

--- boot/worker/src/boot/notify.clj
+++ boot/worker/src/boot/notify.clj
@@ -36,7 +36,7 @@
           (.exists (File. "/usr/bin/espeak"))
           (sh "espeak" "-v+f2" msg)
           (.exists (File. "/usr/bin/say"))
-          (sh "say" "-v" "Vicki" msg)
+          (sh "say" msg)
           :else (play! (or file (path-for theme "warning"))))))))

 (defn notify! [{:keys [file theme type]}]


Reduce iteration deletion cost of shutdown-ch chk Could mean a slower shutdown in order to improve general performance

--- src/onyx/state/filter/rocksdb.clj
+++ src/onyx/state/filter/rocksdb.clj
@@ -31,8 +31,7 @@
         iterator ^RocksIterator (.newIterator db)]
     (try
       (.seekToFirst iterator)
-      (while (and (.isValid iterator)
-                  (first (alts!! [shutdown-ch] :default true)))
+      (while (.isValid iterator)
         (when (= (aget ^bytes (.value iterator) 0)
                  bucket-val)
           (.remove ^RocksDB db ^bytes (.key iterator)))


Use datastax-provided values for execution

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -18,15 +18,6 @@

 (def ^:dynamic *batch* false)

-(defn maybe-stringify
-  [statement]
-  (println (.getQueryString  statement))
-  (if *batch*
-    statement
-    ;; TODO: make sure that we _CAN_ finish the query (check if it's complete)
-    ;; (.setForceNoValues)
-    (.getQueryString  statement)))
-
 (alias/alias-ns 'clojurewerkz.cassaforte.query.query-builder)
 (alias/alias-ns 'clojurewerkz.cassaforte.query.dsl)
 (alias/alias-ns 'clojurewerkz.cassaforte.query.column)
@@ -76,8 +67,7 @@
        (fn [acc [query-type column value]]
          (if-let [eq-type (query-type-map query-type)]
            (conj acc ((query-type-map query-type) (name column) value))
-           (throw (IllegalArgumentException. (str query-type " is not a valid Clause")))
-           ))
+           (throw (IllegalArgumentException. (str query-type " is not a valid Clause")))))
        []
        construct))
     clojure.lang.IPersistentMap
@@ -157,7 +147,6 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (QueryBuilder/select))
-         (maybe-stringify)
          )))

 ;;
@@ -191,7 +180,7 @@
                    ((get renderers statement-name) builder statement-args))
                  (QueryBuilder/insertInto (name table-name)))
          (#(.setForceNoValues % true)) ;; TODO: shouldn't be the case with prepared
-         (maybe-stringify))))
+)))

 ;;
 ;; Update Query
@@ -244,7 +233,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (QueryBuilder/update (name table-name)))
-         (maybe-stringify))))
+)))

 ;;
 ;; Delete Query
@@ -314,7 +303,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (QueryBuilder/delete))
-         (maybe-stringify))))
+)))

 ;;
 ;; Truncate
@@ -328,8 +317,7 @@

 (defmacro queries
   [& statements]
-  [:queries `(binding [*batch* true]
-               ~(vec statements))])
+  [:queries statements])

 (let [order
       {:queries 1
@@ -351,7 +339,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  batch-type)
-         (maybe-stringify)))
+         ))

   (defn batch
     [& statements]
@@ -444,7 +432,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (SchemaBuilder/createTable (name table-name)))
-         (maybe-stringify))))
+)))

 ;;
 ;; Alter table
@@ -511,7 +499,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (SchemaBuilder/alterTable (name table-name)))
-         (maybe-stringify))))
+)))

 (let [order
       {:if-exists 1}
@@ -525,7 +513,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (SchemaBuilder/dropTable (name table-name)))
-         (maybe-stringify))))
+)))

 (let [order
       {:ont-table          1
@@ -546,7 +534,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (SchemaBuilder/createIndex (name index-name)))
-         (maybe-stringify))))
+)))

 (defn on-table
   [table-name]
@@ -592,7 +580,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (DropKeyspace. (name keyspace-name)))
-         (maybe-stringify))))
+)))

 (def ^:private create-keyspace-options
   {:replication    (fn [opts replication] (.replication opts replication))
@@ -625,8 +613,7 @@
          (sort-by #(get order (first %)))
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
-                 (CreateKeyspace. (name keyspace-name)))
-         (maybe-stringify))))
+                 (CreateKeyspace. (name keyspace-name))))))

 (defn use-keyspace
   [keyspace-name]


Add a more clear example of escaped $ signs

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -288,51 +288,52 @@
             new-env-var-value (:new-env-var-value inputs)
             project-id (project-model/id project)]
         (html
-         [:section
-          [:article
-           [:h2 "Environment variables for " (vcs-url/project-name (:vcs_url project))]
-           [:div.environment-variables-inner
-            [:p
-             "Add environment variables to the project build.  You can add sensitive data (e.g. API keys) here, rather than placing them in the repository. "
-             "The values can be any bash expression and can reference other variables, such as setting "
-             [:code "M2_MAVEN"] " to " [:code "${HOME}/.m2)"] "."
-             " To disable string substitution you need to escape the " [:code "$"]
-             " characters by prefixing them with " [:code "\\"] "."
-             " For example, a crypt'ed password like " [:code "$1$O3JMY.Tw$AdLnLjQ/5jXF9.MTp3gHv/"]
-             " would be entered as " [:code "\\$1\\$O3JMY.Tw\\$AdLnLjQ/5jXF9.MTp3gHv/"] "."]
-            [:form
-             [:input#env-var-name
-              {:required true, :type "text", :value new-env-var-name
-               :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-name) %)}]
-             [:label {:placeholder "Name"}]
-             [:input#env-var-value
-              {:required true, :type "text", :value new-env-var-value
-               :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-value) %)}]
-             [:label {:placeholder "Value"}]
-             (forms/managed-button
-              [:input {:data-failed-text "Failed",
-                       :data-success-text "Added",
-                       :data-loading-text "Adding...",
-                       :value "Save variables",
-                       :type "submit"
-                       :on-click #(do
-                                    (raise! owner [:created-env-var {:project-id project-id}])
-                                    false)}])]
-            (when-let [env-vars (seq (:envvars project-data))]
-              [:table
-               [:thead [:tr [:th "Name"] [:th "Value"] [:th]]]
-               [:tbody
-                (for [{:keys [name value]} env-vars]
-                  [:tr
-                   [:td {:title name} name]
-                   [:td {:title value} value]
-                   [:td
-                    [:a
-                     {:title "Remove this variable?",
-                      :on-click #(raise! owner [:deleted-env-var {:project-id project-id
-                                                                  :env-var-name name}])}
-                     [:i.fa.fa-times-circle]
-                     [:span " Remove"]]]])]])]]])))))
+          [:section
+           [:article
+            [:h2 "Environment variables for " (vcs-url/project-name (:vcs_url project))]
+            [:div.environment-variables-inner
+             [:p
+              "Add environment variables to the project build.  You can add sensitive data (e.g. API keys) here, rather than placing them in the repository. "
+              "The values can be any bash expression and can reference other variables, such as setting "
+              [:code "M2_MAVEN"] " to " [:code "${HOME}/.m2)"] "."]
+
+             [:p
+              " To disable string substitution you need to escape the " [:code "$"]
+              " characters by prefixing them with " [:code "\\"] "."
+              " For example, a value like " [:code "usd$"] " would be entered as " [:code "usd\\$"] "." ]
+             [:form
+              [:input#env-var-name
+               {:required true, :type "text", :value new-env-var-name
+                :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-name) %)}]
+              [:label {:placeholder "Name"}]
+              [:input#env-var-value
+               {:required true, :type "text", :value new-env-var-value
+                :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-value) %)}]
+              [:label {:placeholder "Value"}]
+              (forms/managed-button
+                [:input {:data-failed-text "Failed",
+                         :data-success-text "Added",
+                         :data-loading-text "Adding...",
+                         :value "Save variables",
+                         :type "submit"
+                         :on-click #(do
+                                      (raise! owner [:created-env-var {:project-id project-id}])
+                                      false)}])]
+             (when-let [env-vars (seq (:envvars project-data))]
+               [:table
+                [:thead [:tr [:th "Name"] [:th "Value"] [:th]]]
+                [:tbody
+                 (for [{:keys [name value]} env-vars]
+                   [:tr
+                    [:td {:title name} name]
+                    [:td {:title value} value]
+                    [:td
+                     [:a
+                      {:title "Remove this variable?",
+                       :on-click #(raise! owner [:deleted-env-var {:project-id project-id
+                                                                   :env-var-name name}])}
+                      [:i.fa.fa-times-circle]
+                      [:span " Remove"]]]])]])]]])))))

 (defn experiments [project-data owner]
   (reify
@@ -381,7 +382,7 @@
             (describe-flag {:flag :junit
                             :title "JUnit support"
                             :blurb [:p
-                                    "This flag enables collection of test data via junit xml or cucumber json files,"
+                                    "This flag enables collection of test data via junit xml or cucumber json files,"
                                     " which we use to better display test results and make parallel builds more"
                                     " efficient.  It also adds the necessary flags for collecting this to automatically"
                                     " inferred ruby or python test commands, though for RSpec of Minitest you'll need"


Revert "Revert "Confirmation before removing environment variable [CIRCLE-302]""

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -407,6 +407,34 @@
            [:hr]
            (clear-cache-button "source" project-data owner)]]]))))

+(defn remove-env-var-button [{:keys [env-var project-id]} owner]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:show-modal? false})
+    om/IRenderState
+    (render-state [_ {:keys [show-modal?]}]
+      (html
+       [:span
+        (table/action-button
+         "Remove"
+         (icon/delete)
+         #(om/set-state! owner :show-modal? true))
+        (when show-modal?
+          (let [close-fn #(om/set-state! owner :show-modal? false)]
+            (modal/modal-dialog {:title "Are you sure?"
+                                 :body (html
+                                        [:span
+                                         "Are you sure you want to remove the environment variable \""
+                                         (:name env-var)
+                                         "\"?"])
+                                 :actions [(button/button {:on-click close-fn} "Cancel")
+                                           (button/button {:primary? true
+                                                           :on-click #(raise! owner [:deleted-env-var {:project-id project-id
+                                                                                :env-var-name (:name env-var)}])}
+                                                          "Delete")]
+                                 :close-fn close-fn})))]))))
+
 (defn env-vars [project-data owner]
   (reify
     om/IRender
@@ -417,58 +445,55 @@
             new-env-var-value (:new-env-var-value inputs)
             project-id (project-model/id project)]
         (html
-          [:section
-           [:article
-            [:h2 "Environment Variables for " (vcs-url/project-name (:vcs_url project))]
-            [:div
-             [:p
-              "Add environment variables to the project build.  You can add sensitive data (e.g. API keys) here, rather than placing them in the repository. "
-              "The values can be any bash expression and can reference other variables, such as setting "
-              [:code "M2_MAVEN"] " to " [:code "${HOME}/.m2)"] "."]
-
-             [:p
-              " To disable string substitution you need to escape the " [:code "$"]
-              " characters by prefixing them with " [:code "\\"] "."
-              " For example, a value like " [:code "usd$"] " would be entered as " [:code "usd\\$"] "." ]
-             [:form
-              [:div.form-group
-               [:label "Name"]
-               [:input.form-control#env-var-name
-                {:required true, :type "text", :value new-env-var-name
-                 :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-name) %)}]]
-              [:div.form-group
-               [:label "Value"]
-               [:input.form-control#env-var-value
-                {:required true
-                 :type "text"
-                 :value new-env-var-value
-                 :auto-complete "off"
-                 :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-value) %)}]]
-
-              [:div.form-group
-               (forms/managed-button
-                 [:input.btn.btn-primary {:data-failed-text "Failed",
-                                          :data-success-text "Added",
-                                          :data-loading-text "Adding...",
-                                          :value "Add Variable",
-                                          :type "submit"
-                                          :on-click #(raise! owner [:created-env-var {:project-id project-id}])}])]]
-             (when-let [env-vars (seq (:envvars project-data))]
-               (om/build table/table
-                         {:rows env-vars
-                          :columns [{:header "Name"
-                                     :cell-fn :name}
-                                    {:header "Value"
-                                     :cell-fn :value}
-                                    {:header "Remove"
-                                     :type #{:shrink :right}
-                                     :cell-fn
-                                     (fn [env-var]
-                                       (table/action-button
-                                        "Remove"
-                                        (icon/delete)
-                                        #(raise! owner [:deleted-env-var {:project-id project-id
-                                                                          :env-var-name (:name env-var)}])))}]}))]]])))))
+         [:section
+          [:article
+           [:h2 "Environment Variables for " (vcs-url/project-name (:vcs_url project))]
+           [:div
+            [:p
+             "Add environment variables to the project build.  You can add sensitive data (e.g. API keys) here, rather than placing them in the repository. "
+             "The values can be any bash expression and can reference other variables, such as setting "
+             [:code "M2_MAVEN"] " to " [:code "${HOME}/.m2)"] "."]
+
+            [:p
+             " To disable string substitution you need to escape the " [:code "$"]
+             " characters by prefixing them with " [:code "\\"] "."
+             " For example, a value like " [:code "usd$"] " would be entered as " [:code "usd\\$"] "." ]
+            [:form
+             [:div.form-group
+              [:label "Name"]
+              [:input.form-control#env-var-name
+               {:required true, :type "text", :value new-env-var-name
+                :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-name) %)}]]
+             [:div.form-group
+              [:label "Value"]
+              [:input.form-control#env-var-value
+               {:required true
+                :type "text"
+                :value new-env-var-value
+                :auto-complete "off"
+                :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-value) %)}]]
+
+             [:div.form-group
+              (forms/managed-button
+               [:input.btn.btn-primary {:data-failed-text "Failed",
+                                        :data-success-text "Added",
+                                        :data-loading-text "Adding...",
+                                        :value "Add Variable",
+                                        :type "submit"
+                                        :on-click #(raise! owner [:created-env-var {:project-id project-id}])}])]]
+            (when-let [env-vars (seq (:envvars project-data))]
+              (om/build table/table
+                        {:rows env-vars
+                         :columns [{:header "Name"
+                                    :cell-fn :name}
+                                   {:header "Value"
+                                    :cell-fn :value}
+                                   {:header "Remove"
+                                    :type #{:shrink :right}
+                                    :cell-fn
+                                    (fn [env-var]
+                                      (om/build remove-env-var-button {:env-var env-var
+                                                                       :project-id project-id}))}]}))]]])))))

 (defn advance [project-data owner]
   (reify


(PE-14602) Catch SQLTransientException

(PE-14602) Catch SQLTransientException

Catch all retryable sql exceptions and retry instead of just connection
exceptions.

--- src/puppetlabs/jdbc_util/pool.clj
+++ src/puppetlabs/jdbc_util/pool.clj
@@ -4,7 +4,7 @@
   (:import com.codahale.metrics.health.HealthCheckRegistry
            [com.zaxxer.hikari HikariConfig HikariDataSource]
            java.io.Closeable
-           java.sql.SQLTransientConnectionException
+           [java.sql SQLTransientConnectionException SQLTransientException]
            javax.sql.DataSource))

 (defn- set-option
@@ -71,7 +71,7 @@
                                 (swap! init-error (constantly e))
                                 (log/errorf e "%s - An error was encountered during initialization." (.getPoolName datasource))))
                          datasource)
-                       (catch SQLTransientConnectionException e
+                       (catch SQLTransientException e
                          (log/warnf e "%s - Error while attempting to connect to database, retrying." (.getPoolName datasource))
                          nil))]
               result


Generic board should use non-sanitized-div

--- frontend/src/faceboard/views/boards/generic.cljs
+++ frontend/src/faceboard/views/boards/generic.cljs
@@ -1,8 +1,8 @@
 (ns faceboard.views.boards.generic
   (:require [om-tools.core :refer-macros [defcomponent]]
-            [faceboard.logging :refer [log, log-err, log-warn]]
-            [om-tools.dom :as dom]))
+            [faceboard.helpers.utils :refer [non-sanitized-div]]
+            [faceboard.logging :refer [log, log-err, log-warn]]))

 (defcomponent generic-component [data _ _]
   (render [_]
-    (dom/div {:dangerouslySetInnerHTML #js {:__html (:content data)}})))+    (non-sanitized-div (:content data))))