Починка кнопок промотки диалога. пропадали на в диалогах на карте

--- radiolamp-6P3S/src/r6p3s/cpt/modal.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/modal.cljs
@@ -98,70 +98,78 @@
         ;;(println "modal id:" id)
         (let [show? (:show app)]
           (swap! modals-status (if show? conj disj) id)
-          (dom/div #js {:id              id
-                        :aria-hidden     "true"
-                        :aria-labelledby label
-                        ;; Данное решение пораждает нехорошее поведение
-                        ;; например при клике на полноэкранную штуку диалог тоже закрывается
-                        ;; вместе с открытыми поддиалогами
-                        ;;:onClick         (c/on-click-com-fn close)
-                        :style           (if show?
-                                           #js {:display         "block"
-                                                :paddingLeft     0
-                                                :backgroundColor "rgba(0, 0, 0, 0.2)"}
-                                           #js {:display "none" })
-                        :className       (if show? "modal in" "modal")
-                        :role            "dialog"
-                        :tabIndex        "-1"}
+          (dom/div
+           #js {:style (if show?
+                         #js {:display     "block"
+                              :paddingLeft 0}
+                         #js {:display "none" })}
+
+           (button/render {:style #js {:position     "fixed"
+                                       :top          "15%"
+                                       :right        25
+                                       :zIndex       2000
+                                       :borderRadius 25
+                                       :width        50
+                                       :height       50}
+                           :size  :lg
+                           :on-click
+                           (fn []
+                             (set! (.-scrollTop (.getElementById js/document (om/get-state owner :id))) 0))
+                           :text  (glyphicon/render "chevron-up")})
+
+           (button/render {:style #js {:position     "fixed"
+                                       :bottom       "15%"
+                                       :right        25
+                                       :zIndex       2000
+                                       :borderRadius 25
+                                       :width        50
+                                       :height       50}
+                           :size  :lg
+                           :on-click
+                           (fn []
+                             (let [e (.getElementById js/document (om/get-state owner :id))]
+                               (set! (.-scrollTop e) (.-scrollHeight e))))
+                           :text  (glyphicon/render "chevron-down")})
+
+           (dom/div #js {:id              id
+                         :aria-hidden     "true"
+                         :aria-labelledby label
+                         ;; Данное решение пораждает нехорошее поведение
+                         ;; например при клике на полноэкранную штуку диалог тоже закрывается
+                         ;; вместе с открытыми поддиалогами
+                         ;;:onClick         (c/on-click-com-fn close)
+                         :style           (if show?
+                                            #js {:display         "block"
+                                                 :paddingLeft     0
+                                                 :backgroundColor "rgba(0, 0, 0, 0.2)"}
+                                            #js {:display "none" })
+                         :className       (if show? "modal in" "modal")
+                         :role            "dialog"
+                         :tabIndex        "-1"}

-                   (button/render {:style #js {:position     "fixed"
-                                               :top          "15%"
-                                               :right        25
-                                               :zIndex       5
-                                               :borderRadius 25
-                                               :width        40
-                                               :height       40}
-                                   :on-click
-                                   (fn []
-                                     (set! (.-scrollTop (.getElementById js/document (om/get-state owner :id))) 0))
-                                   :text  (glyphicon/render "chevron-up")})
-
-                   (button/render {:style #js {:position     "fixed"
-                                               :bottom       "15%"
-                                               :right        25
-                                               :zIndex       5
-                                               :borderRadius 25
-                                               :width        40
-                                               :height       40}
-                                   :on-click
-                                   (fn []
-                                     (let [e (.getElementById js/document (om/get-state owner :id))]
-                                       (set! (.-scrollTop e) (.-scrollHeight e))))
-                                   :text  (glyphicon/render "chevron-down")})
+                    (dom/div #js {:className (str "modal-dialog"
+                                                  (condp = modal-size
+                                                    :sm " modal-sm"
+                                                    :lg " modal-lg"
+                                                    "")
+                                                  " " class+)}
+                             (dom/div #js {:className "modal-content"}
+                                      (dom/div #js {:className "modal-header"}
+                                               (dom/button #js {:type         "button" :className  "close"
+                                                                :data-dismiss "modal"  :aria-label "Close"
+                                                                :onClick      close}
+                                                           (glyphicon/render "remove"))

-                   (dom/div #js {:className (str "modal-dialog"
-                                                 (condp = modal-size
-                                                   :sm " modal-sm"
-                                                   :lg " modal-lg"
-                                                   "")
-                                                 " " class+)}
-                            (dom/div #js {:className "modal-content"}
-                                     (dom/div #js {:className "modal-header"}
-                                              (dom/button #js {:type         "button" :className  "close"
-                                                               :data-dismiss "modal"  :aria-label "Close"
-                                                               :onClick      close}
-                                                          (glyphicon/render "remove"))
+                                               (or header (dom/h4 #js {:className "modal-title"} label)))
+                                      (dom/div #js {:className "modal-body"
+                                                    :style     #js {:marginRight 40}}

-                                              (or header (dom/h4 #js {:className "modal-title"} label)))
-                                     (dom/div #js {:className "modal-body"
-                                                   :style     #js {:marginRight 40}}
+                                               (or body (dom/p #js {:className "text-info"}
+                                                               "Пустое пространство диалога. Можно наполнить элементами"))

-                                              (or body (dom/p #js {:className "text-info"}
-                                                              "Пустое пространство диалога. Можно наполнить элементами"))
-
-                                              )
-                                     (dom/div #js {:className "modal-footer"}
-                                              (or footer (button/render {:type     :default
-                                                                         :on-click close
-                                                                         :text     "Закрыть"})))))))))))
+                                               )
+                                      (dom/div #js {:className "modal-footer"}
+                                               (or footer (button/render {:type     :default
+                                                                          :on-click close
+                                                                          :text     "Закрыть"}))))))))))))


Updating the matrix library to match brevis.vector again

--- src/brevis/matrix.clj
+++ src/brevis/matrix.clj
@@ -18,19 +18,32 @@

 (ns brevis.matrix
   (:use [brevis vector])
-  (:import [javax.vecmath Vector3d Vector4d Matrix4d]))
+  (:import [org.lwjgl.util.vector Vector3f Vector4f Matrix4f]
+           [java.nio FloatBuffer]
+           [org.lwjgl BufferUtils])
+  #_(:import [javax.vecmath Vector3d Vector4d Matrix4d]))

 (defonce x-axis (vec3 1 0 0))
 (defonce y-axis (vec3 0 1 0))
 (defonce z-axis (vec3 0 0 1))
 (defonce origin (vec4 0 0 0 1))

+#_(defn mat4
+   "Create a 4x4 matrix."
+   ([ v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 ]
+     (Matrix4f.  v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15))
+   ([]
+     (mat4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
+
 (defn mat4
-  "Create a 4x4 matrix."
-  ([ v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 ]
-    (Matrix4d.  v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15))
-  ([]
-    (mat4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
+   "Create a 4x4 matrix."
+   ([float-buffer]
+     (let [mat (Matrix4f.)]
+       (.load mat float-buffer)))
+   ([ v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 ]
+     (mat4 (FloatBuffer/wrap (float-array [v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15]))))
+   ([]
+     (mat4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))

 #_(defonce identity4 (.setIdentity (mat4)))

@@ -43,7 +56,7 @@
 (defn translate
   "Translate xform by vector"
   [xform v]
-  (println xform v (position xform))
+  #_(println xform v (position xform))
   (.setTranslation xform (add v (position xform)))
   xform)

@@ -56,29 +69,30 @@
 (defn rotate-x
   "Rotate xform about x-axis by angle."
   [xform angle]
-  #_(rotate xform x-axis angle)
-  (.rotX xform angle)
+  (rotate xform x-axis angle)
+  #_(.rotX xform angle)
   xform)

 (defn rotate-y
   "rotate xform about y-axis by angle."
   [xform angle]
-  #_(rotate xform y-axis angle)
-  (.rotY xform angle)
+  (rotate xform y-axis angle)
+  #_(.rotY xform angle)
   xform)

 (defn rotate-z
   "Rotate xform about z-axis by angle."
   [xform angle]
-  #_(rotate xform z-axis angle)
-  (.rotZ xform angle)
+  (rotate xform z-axis angle)
+  #_(.rotZ xform angle)
   xform)

 (defn transform
   "Transform a vector."
   [xform v]
   (let [outv (vec4 0 0 0 0)]
-    (.transform xform v outv)
+    (def tmp001 {:xform xform :v v :outv outv})
+    (Matrix4f/transform xform v outv)
     outv))

 (defn identity-mat


refactored game loop to give ignore reasons

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -104,21 +104,30 @@
                 (notify ch-out0)
                 (put! ch-out0 {:type "disconnected"})
                 (initial-loop player0))
-              (do (cond
-                    (= type "state_request")
-                    (notify ch-out)
-                    (and (= type "move")
-                         (= @turn actor)
-                         (process-move move))
-                    (doseq [ch-out ch-outs]
-                      (notify ch-out))
-                    :else (put! ch-out {:type :ignored :msg msg}))
-                  (if-not @winner
-                    (recur)
-                    ;; Cleanup
-                    (doseq [{ch-out0 :ch-out :as player0} players]
-                      (put! ch-out0 {:type "end"})
-                      (initial-loop player0)))))))))))
+              (let [reason (cond
+                             (not (#{"state_request" "move"} type))
+                             "Unknown message type"
+                             (= type "state_request") nil
+                             (not= @turn actor)
+                             "Not your turn"
+                             ;; Move gets processed here via
+                             ;; side-effect (boo!)
+                             (not (process-move move))
+                             "Invalid move")]
+                (cond
+                  reason
+                  (put! ch-out {:type :ignored :msg msg :reason reason})
+                  (= type "state_request")
+                  (notify ch-out)
+                  :else
+                  (doseq [ch-out ch-outs]
+                    (notify ch-out)))
+                (if-not @winner
+                  (recur)
+                  ;; Cleanup
+                  (doseq [{ch-out0 :ch-out :as player0} players]
+                    (put! ch-out0 {:type "end"})
+                    (initial-loop player0)))))))))))

 (defn await-loop [{:keys [waiter] :as player}]
   (go-loop []
@@ -136,7 +145,7 @@
          (swap! awaiting dissoc (:uid player))
          ;; Otherwise ignore all messages of the client
          (do (put! (:ch-out player)
-                   {:type :ignored :msg msg :reason "waiting for match"})
+                   {:type :ignored :msg msg :reason "Waiting for match"})
              (recur)))))))

 (defn match-once [{:keys [id] :as player0}]


Updates browser repl config for piggieback update, see https://github.com/reagent-project/reagent-template/issues/50

--- src/clj/chess/dev.clj
+++ src/clj/chess/dev.clj
@@ -15,7 +15,7 @@
      (append  (html [:script {:type "text/javascript"} "goog.require('chess.dev')"]))))

 (defn browser-repl []
-  (piggieback/cljs-repl :repl-env (weasel/repl-env :ip "0.0.0.0" :port 9001)))
+  (piggieback/cljs-repl (weasel/repl-env :ip "0.0.0.0" :port 9001)))

 (defn start-figwheel []
   (future


CLJS-83: Added deftype methods capability.

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -181,19 +181,26 @@
           ~@impls))
       (new ~t ~@locals))))

+(defmacro this-as
+  "Defines a scope where JavaScript's implicit \"this\" is bound to the name provided."
+  [name & body]
+  `(let [~name (~'js* "this")]
+     ~@body))
+
 (defmacro extend-type [tsym & impls]
   (let [resolve #(let [ret (:name (cljs.compiler/resolve-var (dissoc &env :locals) %))]
                    (assert ret (str "Can't resolve: " %))
                    ret)
         impl-map (loop [ret {} s impls]
                    (if (seq s)
-                     (recur (assoc ret (resolve (first s)) (take-while seq? (next s)))
+                     (recur (assoc ret (first s) (take-while seq? (next s)))
                             (drop-while seq? (next s)))
                      ret))]
     (if (base-type tsym)
       (let [t (base-type tsym)
-            assign-impls (fn [[psym sigs]]
-                           (let [pfn-prefix (subs (str psym) 0 (clojure.core/inc (.lastIndexOf (str psym) ".")))]
+            assign-impls (fn [[p sigs]]
+                           (let [psym (resolve p)
+				 pfn-prefix (subs (str psym) 0 (clojure.core/inc (.lastIndexOf (str psym) ".")))]
                              (cons `(aset ~psym ~t true)
                                    (map (fn [[f & meths]]
                                           `(aset ~(symbol (str pfn-prefix f)) ~t (fn* ~@meths)))
@@ -201,13 +208,22 @@
         `(do ~@(mapcat assign-impls impl-map)))
       (let [t (resolve tsym)
             prototype-prefix (str t ".prototype.")
-
-            assign-impls (fn [[psym sigs]]
-                           (let [pprefix (protocol-prefix psym)]
-                             (cons `(set! ~(symbol (str prototype-prefix pprefix)) true)
-                                   (map (fn [[f & meths]]
-                                          `(set! ~(symbol (str prototype-prefix pprefix f)) (fn* ~@meths)))
-                                        sigs))))]
+            assign-impls (fn [[p sigs]]
+                           (let [psym (resolve p)
+				 pprefix (protocol-prefix psym)]
+			     (if (= p 'Object)
+			       (let [adapt-params (fn [[sig & body]]
+						    (let [[tname & args] sig]
+						      (list (with-meta (vec args)
+							      (assoc (meta sig) :cljs.compiler/this-as tname))
+							    (list* 'this-as tname body))))]
+				 (map (fn [[f & meths]]
+					`(set! ~(symbol (str prototype-prefix f)) (fn* ~@(map adapt-params meths))))
+				      sigs))
+			       (cons `(set! ~(symbol (str prototype-prefix pprefix)) true)
+				     (map (fn [[f & meths]]
+					    `(set! ~(symbol (str prototype-prefix pprefix f)) (fn* ~@meths)))
+					  sigs)))))]
         `(do ~@(mapcat assign-impls impl-map))))))

 (defmacro deftype [t fields & impls]
@@ -685,9 +701,3 @@
          ret# ~expr]
      (prn (str "Elapsed time: " (- (.getTime (js/Date.) ()) start#) " msecs"))
      ret#))
-
-(defmacro this-as
-  "Defines a scope where JavaScript's implicit \"this\" is bound to the name provided."
-  [name & body]
-  `(let [~name (~'js* "this")]
-     ~@body))


cond -> core/cond, prep for cond in CLJS that doesn't return null as final case when there is a provided default

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -79,7 +79,7 @@
                                      seen-rest? false]
                            (if (seq bs)
                              (core/let [firstb (first bs)]
-                               (cond
+                               (core/cond
                                  (= firstb '&) (recur (pb ret (second bs) (core/list `nthnext gvec n))
                                                       n
                                                       (nnext bs)
@@ -118,7 +118,7 @@
                                                    (core/list `get gmap bk)))
                                       (next bes)))
                              ret))))]
-                    (cond
+                    (core/cond
                       (core/symbol? b) (-> bvec (conj b) (conj v))
                       (vector? b) (pvec bvec b v)
                       (map? b) (pmap bvec b v)
@@ -1082,7 +1082,7 @@
                (let [[[a b c :as clause] more]
                        (split-at (if (= :>> (second args)) 3 2) args)
                        n (count clause)]
-                 (cond
+                 (core/cond
                   (= 0 n) `(throw (js/Error. (core/str "No matching clause: " ~expr)))
                   (= 1 n) a
                   (= 2 n) `(if (~pred ~a ~expr)
@@ -1110,7 +1110,7 @@
                                                          cljs.analyzer/*cljs-file*)))))
                            (assoc m test expr)))
         pairs (reduce (fn [m [test expr]]
-                        (cond
+                        (core/cond
                          (seq? test) (reduce (fn [m test]
                                                (let [test (if (core/symbol? test)
                                                             (core/list 'quote test)
@@ -1166,7 +1166,7 @@
                     (let [giter (gensym "iter__")
                           gxs (gensym "s__")
                           do-mod (fn do-mod [[[k v :as pair] & etc]]
-                                   (cond
+                                   (core/cond
                                      (= k :let) `(let ~v ~(do-mod etc))
                                      (= k :while) `(when ~v ~(do-mod etc))
                                      (= k :when) `(if ~v
@@ -1192,7 +1192,7 @@
                         (let [gi (gensym "i__")
                               gb (gensym "b__")
                               do-cmod (fn do-cmod [[[k v :as pair] & etc]]
-                                        (cond
+                                        (core/cond
                                           (= k :let) `(let ~v ~(do-cmod etc))
                                           (= k :while) `(when ~v ~(do-cmod etc))
                                           (= k :when) `(if ~v
@@ -1247,7 +1247,7 @@
                        steppair (step recform (nnext exprs))
                        needrec (steppair 0)
                        subform (steppair 1)]
-                   (cond
+                   (core/cond
                      (= k :let) [needrec `(let ~v ~subform)]
                      (= k :while) [false `(when ~v
                                             ~subform
@@ -1316,7 +1316,7 @@
 (defmacro array-map
   ([] `cljs.core.PersistentArrayMap.EMPTY)
   ([& kvs]
-    (cond
+    (core/cond
       (core/> (count kvs) 16)
       `(hash-map ~@kvs)


fire :agenda-scored effects before trashing a Runner current

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -886,10 +886,10 @@
         (swap! state update-in [:corp :register :scored-agenda] #(+ (or % 0) (:agendapoints c)))
         (gain-agenda-point state :corp (:agendapoints c))
         (set-prop state :corp c :advance-counter 0)
+        (trigger-event state :corp :agenda-scored (assoc c :advance-counter 0))
         (when-let [current (first (get-in @state [:runner :current]))]
           (say state side {:user "__system__" :text (str (:title current) " is trashed.")})
-          (trash state side current))
-        (trigger-event state :corp :agenda-scored (assoc c :advance-counter 0))))))
+          (trash state side current))))))

 (defn as-agenda [state side card n]
   (move state side (assoc card :agendapoints n) :scored)


Another db url

Another db url

--- src/clj_crud/main.clj
+++ src/clj_crud/main.clj
@@ -1,7 +1,9 @@
 (ns clj-crud.main
   (:require [clojure.tools.logging :refer [info debug]]
             [com.stuartsierra.component :as component]
-            [clj-crud.core :as core])
+            [clj-crud.core :as core]
+            [clojure.string :as string])
+  (:import [java.net.URI])
   (:gen-class))

 (defn -main [& args]
@@ -11,7 +13,12 @@
         database-url (let [db-url (second args)]
                        (assert (.startsWith db-url "postgres:")
                                (str "Something is wrong with the database argument: " (second args)))
-                       db-url)
+                       (let [db-uri (URI. db-url)
+                             host (.getHost db-uri)
+                             port (.getPort db-uri)
+                             path (.getPath db-uri)
+                             [user password] (string/split (.getUserInfo db-uri) #":")]
+                         (str "jdbc:postgresql://" host ":" port path "?user=" user "&password=" password "&ssl=true&sslfactory=org.postgresql.ssl.NonValidatingFactory")))
         system (core/crud-system (core/production-config port database-url))]
     (component/start system)
     (.addShutdownHook (Runtime/getRuntime)


Tentatively get last night's work written. Realized on the drive home from work that this is really testing the socket communication, rather than the authentication.

--- spec/frereth_server/authentication_spec.clj
+++ spec/frereth_server/authentication_spec.clj
@@ -61,13 +61,27 @@
                 ;; this evil. And worse.
                 ;; Skip reading the response...this is really a regression
                 ;; test case. Should test the normal flow control first.
+
+                ;; Basic authorization exchange
+                (mq/send client 'hai)
+                (let [resp (mq/recv-obj client)]
+                  (should (= resp 'ohai)))
+
+                (mq/send client ['me-speekz nil])
+                (let [resp (mq/recv-obj client)]
+                  (should (= 'lolz resp)))

-                (mq/send client ["ib" "test"])
-                ;; r-s == response-string
+                (mq/send client '(ib test))
                 (let [resp (mq/recv-obj client)]
                   (should (= resp 'prove-it)))

-                (mq/send client))
+                (mq/send client "Really secure signature")
+
+                ;; This is a different layer
+                (let [resp (mq/recv-obj client)]
+                  (should (= resp 'wachu-wants?)))
+
+                (mq/send client 'me-wantz-play))

             (it "Basic Login Sequence"
                 ;; This is trickier than I realized.
@@ -87,27 +101,20 @@
                 ;;
                 ;; c.f. http://rfc.zeromq.org/spec:27
                 ;; (the 0mq Authentication Protocol)
-                (let [login-sequence [["ib" "test"]
-                                      ["me-wantz-play"
-                                       ;; Can I make a client dumber than this?
-                                       [:youre-kidding nil "login-id" nil]
-                                       ;; These represent multiple frames
-                                       ;; that would be received over the wire.
-                                       ;; And, of course, any decent server
-                                       ;; should reject crap like this.
-                                       ["Really secure signature"]]]
+                (let [login-sequence ["hai"
+                                      ;; Q: Can I make a client dumber than this?
+                                      ;; A: I really shouldn't challenge
+                                      ;; myself that way.
+                                      ["me-speekz"
+                                       [:youre-kidding nil "login-id" nil]]
+                                      ["ib" "test"]
+                                      "Really secure signature"
+                                      "me-wantz-play"]
                       client @client-atom]
                   ;; client is now an mq/req socket, that should be
                   ;; connected to the server we're testing
-
-                  ;; We're interested in the side-effects
-                  ;; This actually looks like the painful version
-                  ;; Aside from the fact that it's horribly broken
-                  (doseq [message-pair login-sequence]
-                    (mq/send client (first message-pair) 0)
-                    (let [response-string (mq/recv-str client)
-                          ;; FIXME: *Never* trust external data!
-                          response (read response-string)]
-                      (should (= response (rest message-pair)))))))))
+                  (mq/send client login-sequence 0)
+                  (let [response (mq/recv client)
+                        (should (= response "What?"))])))))

 (run-specs)


Always adding `` markers makes testing some predicates harder

--- src/structural_typing/assist/testutil.clj
+++ src/structural_typing/assist/testutil.clj
@@ -92,8 +92,12 @@
 (defn err:shouldbe
   "Produces the same error messsage produced when a predicate not altered by [[explain-with]]
    fails."
-  [path should-be is]
-  (format "%s should be `%s`; it is `%s`" path should-be is))
+  ([path should-be is]
+     (err:shouldbe path should-be is false))
+
+  ([path should-be is omit-quotes]
+     (let [should-be (if omit-quotes should-be (str "`" should-be "`"))]
+       (format "%s should be %s; it is `%s`" path should-be is))))

 (defn err:notpath
   "Produces the same error messsage produced when the whole value is not the same \"shape\" as the path requires."


Extend test-case for concept stability

Extend test-case for concept stability

Signed-off-by: Daniel Borchmann <3d0f3b9ddcacec30c4008c5e030e6c13a478cb4f@algebra20.de>

--- src/test/clojure/conexp/fca/misc_test.clj
+++ src/test/clojure/conexp/fca/misc_test.clj
@@ -131,5 +131,11 @@
     (is (= (concept-stability context concept) 1/4))
     (is (every? #(<= % 1)
                 (let [ctx (random-context 10 0.5)]
-                  (map #(concept-stability ctx %) (concepts ctx)))))))
+                  (map #(concept-stability ctx %) (concepts ctx)))))
+    (with-testing-data [context (random-contexts 10 (rand-int 13))]
+      (= (reduce + (map (fn [[A B]]
+                          (* (concept-stability context [A B])
+                             (expt 2 (count A))))
+                        (concepts context)))
+         (expt 2 (count (attributes context)))))))


Remove obsolete line in test case on concept stability

Signed-off-by: Daniel Borchmann <3d0f3b9ddcacec30c4008c5e030e6c13a478cb4f@algebra20.de>


Versionumero

Versionumero

--- mtg-pairings-server/project.clj
+++ mtg-pairings-server/project.clj
@@ -1,4 +1,4 @@
-(defproject mtg-pairings-server "2.1.1"
+(defproject mtg-pairings-server "2.2.0"
   :license {:name "MIT License"
             :url  "http://www.opensource.org/licenses/mit-license.php"}
   :dependencies [[org.clojure/clojure "1.9.0"]


Shift the melody into 5s.

Shift the melody into 5s.

--- src/overtunes/songs/before.clj
+++ src/overtunes/songs/before.clj
@@ -4,7 +4,7 @@
 )

 (def melody
-  [:C3 :Bb3 :Eb3 :G3]
+  [:C3 :Bb3 :Eb3 :G3 :Eb3]
 )

 (def start [
@@ -49,7 +49,7 @@
 ])

 (defn play-chord [notes duration] ( do
-  (defn play-note [note] (organ-cornet note (/ duration 1000) 0.6))
+  (defn play-note [note] (organ-cornet note (/ duration 1000) 0.7))
   (if (not (empty? notes))
     (let [
       root (first notes)
@@ -96,7 +96,7 @@
       variation
     )
   )
-  (play-melody (concat (n-times (/ (count chords) 2) melody) [:Eb4]) metro (metro))
+  (play-melody (n-times (/ (count chords) 2.5) melody) metro (metro))
   (play-progression
     chords
     metro


save corpus to file

save corpus to file

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -6,6 +6,7 @@
             [crawler.dom :as dom]
             [crawler.rich-extractor :as rich-extractor]
             [crawler.rich-char-extractor :as rich-char-extractor]
+            [crawler.shingles :as shingles]
             [crawler.template-removal :as template-removal]
             [crawler.utils :as utils]
             [clj-http.cookies :as cookies]
@@ -360,7 +361,8 @@
                           blacklist
                           old-corpus
                           (merge corpus {(-> content-q first :url)
-                                         body}))))
+                                         {:body body
+                                          :shingles (shingles/html-doc-4-grams body)}}))))

                ;; there is some pagination left that
                ;; you can pick up


models annotated with pagination

models annotated with pagination

--- src/crawler/model.clj
+++ src/crawler/model.clj
@@ -2,6 +2,7 @@
   "Contains code to read and process a
    sampled model"
   (:require [clojure.java.io :as io]
+            [crawler.corpus :as corpus]
             [crawler.dom :as dom]
             [structural-similarity.xpath-text :as similarity])
   (:use [clojure.pprint :only [pprint]])
@@ -17,109 +18,37 @@
   (with-open [rdr (io/reader a-corpus-file)]
     (-> rdr PushbackReader. read)))

-(defn plan
-  "Plan of execution for the model"
-  [a-model]
-  (let [total (apply + (map second a-model))]
-    (sort-by (juxt
-              #(-> % first count)
-              #(- total (second %))) a-model)))
+(defn not-paginated
+  [an-action-seq pagination]
+  (not
+   (some
+    (fn [[src-xpath actions]]
+      (some
+       (fn [action]
+         (let [paging-action (cons action src-xpath)]
+           (some
+            (fn [[x y]]
+              (= x y))
+            (map vector paging-action (reverse an-action-seq)))))
+       actions))
+    pagination)))

-(defn cluster-actions
-  [infos]
-  (let [state-actions (map (fn [x] [(first x) (-> x second :state-action)]) infos)
-        action-sets   (map
-                       (fn [[u s]]
-                         [u (set (map :xpath s))])
-                       (map (fn [[u x]] [u (-> x :xpath-nav-info)]) state-actions))]
-    (reduce
-     (fn [acc [u x]]
-       (let [assign (.indexOf
-                     (map
-                      (fn [acc-x]
-                        (or (= (clojure.set/intersection acc-x x)
-                               acc-x)
-                            (= (clojure.set/intersection acc-x x)
-                               x)))
-                      (map :action acc))
-                     true)]
-         (if (<= 0 assign)
-           (assoc acc assign {:action (:action (nth acc assign))
-                              :urls   (conj (:urls (nth acc assign)) u)})
-           (conj acc {:action x :urls [u]}))))
-     []
-     action-sets)))
+(defn trim-pagination
+  [model pagination]
+  (filter
+   (fn [[action-seq _]]
+     (not-paginated action-seq pagination))
+   model))

-(defn refine-xpath
-  [x urls infos url-clusters]
-  (let [num-clusters (count url-clusters)
-        proc-bodies  (map dom/html->xml-doc (map :body infos))]
-    (map
-     (fn [[u b]]
-       [x
-        (dom/refine-xpath-with-position b u x num-clusters)])
-     (map vector urls proc-bodies))))
+(defn fix-model
+  "Code that takes a sampled model and
+   fixes up the crawled model"
+  [model-file corpus-file]
+  (let [model       (read-model model-file)
+        corpus-data (corpus/read-corpus-file corpus-file)

-(defn cluster-results
-  "Do we need to add position info
-   to refine a particular model"
-  [a-model corpus]
-  (let [grouped (group-by
-                 (fn [[url s]] (:src-xpath s))
-                 corpus)
+        pagination (corpus/pagination-in-corpus corpus-data)
+        pagination-trimmed (trim-pagination model pagination)]
+    {:action     pagination-trimmed
+     :pagination pagination}))

-        cluster-cands (filter
-                       (fn [[p n]]
-                         (< 1 n))
-                       (map
-                        (fn [[p xs]]
-                          (let [clustered (cluster-actions xs)]
-                            [p
-                             (count clustered)
-                             (map :urls clustered)]))
-                        grouped))]
-    (map
-     (fn [[x n us]]
-       (let [items
-             (map
-              (fn [[p xs]]
-                (let [action (first p)
-                      urls   (distinct
-                              (map
-                               (fn [[url info]]
-                                 (:src-url info))
-                               xs))
-                      url-infos (map
-                                 #(corpus %)
-                                 urls)]
-                  (refine-xpath action urls url-infos us)))
-              (filter
-               #(= (first %) x)
-               grouped))]
-         items))
-     cluster-cands)))
-
-(defn refine-same-action-model
-  "Discover paths that exhibit pagination
-   or filter like characteristics
-
-   2 consecutive same actions for instance
-   are a pagination or a filter candidate"
-  [a-model a-corpus]
-  (map
-   (fn [[action-seq n]]
-     (let [reversed (reverse action-seq)
-           consecs  (map vector reversed (rest reversed))
-           posn     (+ 1 (.indexOf
-                          (map (fn [[x y]] (= x y)) consecs)
-                          true))]
-       posn))
-
-   ; retrieve only repetitions
-   (filter
-    (fn [[action-seq n]]
-      (let [reversed (reverse action-seq)
-            consecs  (map vector reversed (rest reversed))]
-        (some (fn [[x y]] (= x y)) consecs)))
-    a-model)))
-


Allowing configuration of the print level & length of pprint

--- src/untangled_spec/reporters/terminal.clj
+++ src/untangled_spec/reporters/terminal.clj
@@ -11,13 +11,15 @@

 (def cfg
   (atom
-    (let [COLOR       (System/getenv "US_DIFF_HL")
-          DIFF_MODE   (System/getenv "US_DIFF_MODE")
-          DIFF        (System/getenv "US_DIFF")
-          NUM_DIFFS   (System/getenv "US_NUM_DIFFS")
-          FRAME_LIMIT (System/getenv "US_FRAME_LIMIT")
-          QUICK_FAIL  (System/getenv "US_QUICK_FAIL")
-          FAIL_ONLY   (System/getenv "US_FAIL_ONLY")]
+    (let [COLOR        (System/getenv "US_DIFF_HL")
+          DIFF_MODE    (System/getenv "US_DIFF_MODE")
+          DIFF         (System/getenv "US_DIFF")
+          NUM_DIFFS    (System/getenv "US_NUM_DIFFS")
+          FRAME_LIMIT  (System/getenv "US_FRAME_LIMIT")
+          QUICK_FAIL   (System/getenv "US_QUICK_FAIL")
+          FAIL_ONLY    (System/getenv "US_FAIL_ONLY")
+          PRINT_LEVEL  (System/getenv "US_PRINT_LEVEL")
+          PRINT_LENGTH (System/getenv "US_PRINT_LENGTH")]
       {:fail-only?      (#{"1" "true"}  FAIL_ONLY)
        :color?          (#{"1" "true"}  COLOR)
        :diff-hl?        (#{"hl" "all"}  DIFF_MODE)
@@ -25,11 +27,14 @@
        :diff?      (not (#{"0" "false"} DIFF))
        :frame-limit (read-string (or FRAME_LIMIT "10"))
        :num-diffs  (read-string (or NUM_DIFFS "1"))
-       :quick-fail? (not (#{"0" "false"} QUICK_FAIL))})))
+       :quick-fail? (not (#{"0" "false"} QUICK_FAIL))
+       :*print-level* (read-string (or PRINT_LEVEL "3"))
+       :*print-length* (read-string (or PRINT_LENGTH "2"))})))
 (defn env [k] (get @cfg k))
 (defn merge-cfg!
   "For use in the test-refresh repl to change configuration on the fly.
-  Single arity will show you the possible keys you can use."
+  Single arity will show you the possible keys you can use.
+  Passing an empty map will show you the current values."
   ([] (println "Valid cfg keys: " (set (keys @cfg))))
   ([new-cfg]
    (doseq [[k v] new-cfg]
@@ -97,8 +102,8 @@
       (print-highligted-diff diff actual))))

 (defn ?ellipses [s]
-  (binding [*print-level* 3
-            *print-length* 2]
+  (binding [*print-level* (env :*print-level*)
+            *print-length* (env :*print-length*)]
     (apply str (drop-last (with-out-str (pprint s))))))

 (defn print-message [m print-fn]


Story ID: RPC-259 Summary: Fixed crashes in print-highlighted-diff if actual was not a coll? or if path was an empty seq

--- src/untangled_spec/reporters/terminal.clj
+++ src/untangled_spec/reporters/terminal.clj
@@ -24,11 +24,8 @@
                                :failed c/red
                                :error  c/red
                                :diff/impl (fn [[got exp]]
-                                            (str ((comp c/green-bg c/black
-                                                        c/bold)
-                                                  exp)
-                                                 ((comp c/red-bg c/bold)
-                                                  got)))}
+                                            ((comp c/bold c/inverse)
+                                              (str exp " != " got)))}
                         color? (merge {:normal (comp c/bold c/yellow)
                                        :diff (comp c/bold c/cyan)
                                        :where (comp c/bold c/white)}))
@@ -57,7 +54,8 @@
               (let [{:keys [exp got path]} (diff/extract d)]
                 (->> [got exp]
                      (color-str :diff/impl)
-                     (assoc-in out path))))
+                     (#(if (empty? path) %
+                         (assoc-in out path %))))))
             actual d)
     (pretty-str d 2)
     (println "DIFF:" d)))
@@ -65,7 +63,7 @@
 (defn print-diff [diff actual print-fn]
   (when (and (env :diff?) (diff/diff-paths? diff))
     (println)
-    (when (env :diff-hl?)
+    (when (and (env :diff-hl?) (coll? actual))
       (print-highligted-diff diff actual)
       (println))
     (when (env :diff-list?)


Only ask for record updates once

Only ask for record updates once

Before they were repeated asked for

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -716,6 +716,37 @@
       ;(println "SQL::: " sql "," id)
       (sql-1  sql [id])
       )))
+
+
+
+
+
+
+
+
+
+
+(defn delete-record-from-realtime-update  [ table-name    record-id     data-session-id ]
+  (let [client-data-atom         (if server-side-realtime-clients  (get @server-side-realtime-clients  data-session-id))
+        response-atom            (if client-data-atom  client-data-atom )
+        update-request-atom      (if response-atom  (get @response-atom :update-request ))
+        update-request           (if update-request-atom  @update-request-atom)
+        ]
+    (println (str "      update-request: " update-request))
+    (swap! update-request-atom dissoc-in [:records table-name record-id])
+  ))
+
+
+
+
+
+
+
+
+
+
+
+

@@ -762,6 +793,7 @@
         (if (not cached-record)
           (get-record-from-database    db-table id fields)
           (do
+            (delete-record-from-realtime-update  db-table    id     client-id)
             ;(println "Use cached value " id ":" cached-record)
             (get cached-record :value)
             )
@@ -1113,7 +1145,7 @@

-(defn delete-from-realtime-update  [ query-key     data-session-id ]
+(defn delete-query-from-realtime-update  [ query-key     data-session-id ]
   (let [client-data-atom         (if server-side-realtime-clients  (get @server-side-realtime-clients  data-session-id))
         response-atom            (if client-data-atom  client-data-atom )
         update-request-atom      (if response-atom  (get @response-atom :update-request ))
@@ -1122,6 +1154,18 @@
     (println (str "      update-request: " update-request))
     (swap! update-request-atom dissoc-in [:queries query-key])
   ))
+
+
+
+
+
+
+
+
+
+
+
+

@@ -1182,7 +1226,7 @@
                       :order     order)
          ]
      (create-client-cache  data-session-id)
-     (delete-from-realtime-update  query-key data-session-id)
+     (delete-query-from-realtime-update  query-key data-session-id)

      (if (get @server-side-cached-queries  query-key)
        nil


DISCARD committing premature async optimization for posterity

--- src/western_music/ingest/bio/wikidata.clj
+++ src/western_music/ingest/bio/wikidata.clj
@@ -3,25 +3,34 @@
             [clojure.string :as str]
             [cheshire.core :as json]))

-(declare lookup-nation lookup-city lookup-year)
+(declare lookup-nation lookup-city)

 (def ^:const base-url "https://www.wikidata.org/w/api.php")

-(def ^:const properties
-  {:place-of-birth "P19"
-   :date-of-birth "P569"
-   :title "P373" ;; technically "Commons Category". Regardless, seems to be a
+(def ^:const property-keys
+  {:place-of-birth :P19
+   :date-of-birth :P569
+   :title :P373 ;; technically "Commons Category". Regardless, seems to be a
    ;; good way to cut to the chase and get an identifier
    })
+
+(defn property
+  ([key properties]
+     (property key properties nil))
+  ([key properties default]
+     (get properties
+          (or (get property-keys key)
+              (throw (ex-info "Property key doesn't exist"
+                              {:key key
+                               :properties property
+                               :property-keys property-keys})))
+          default)))

 (defmacro defasync [name doc args & body]
   `(defn ~name ~doc
      ([~@(drop-last args)]
-        (println "start of single-arity async")
         (let [p# (promise)]
-          (println "init'ed promise for single-arity async")
           (~name ~@(drop-last args) (fn [val#] (p# val#) val#))
-          (println "returning promise for single-arity async")
           p#))
      ([~@args] ~@body)))

@@ -30,11 +39,10 @@
 (defasync base-query
   "GET query to wikidata with the given parameters"
   [params callback]
-  (println "aboot to query" params)
   (http/get base-url {:query-params (merge {:language "en"
                                             :format "json"}
                                            params)}
-            (comp callback id-print)))
+            callback))

 (defn body [http-response]
   (-> http-response (:body) (json/decode true)))
@@ -56,4 +64,57 @@
    TODO: figure out why promise is super broken, just use callback for now"
   [id callback]
   (base-query {:action "wbgetclaims" :entity id}
-              (comp callback :claims id-print body)))
+              (comp callback :claims body)))
+
+(defmulti prop-value* (fn [prop _] (:datatype (:mainsnak prop))))
+
+(defn year [string-time]
+  (apply str (take 4 (rest string-time))))
+
+(def value (comp :value :datavalue :mainsnak))
+
+(defmethod prop-value* "string"
+  [prop callback]
+  (callback (value prop)))
+
+(defmethod prop-value* "time"
+  [prop callback]
+  (-> prop
+      (value)
+      (:time)
+      (year)
+      (callback)))
+
+(defmethod prop-value* "wikibase-item"
+  [prop callback]
+  (let [id (str "Q" (:numeric-id (value prop)))]
+    (properties id callback)))
+
+(defasync prop-value
+  "Asynchronous, pull proper \"value\" representation out of a given
+   item. Extend with prop-value*"
+  [p c]
+  (prop-value* p c))
+
+
+#_(defn lookup-year [data]
+  (let [who (:name (:composer data))]
+    (->> (id-search who)
+         (properties)
+         (property :date-of-birth)
+         (first)
+         (prop-value))))
+
+(defn lookup-year [data]
+  (let [who (:name (:composer data))
+        p (promise)]
+    (id-search who
+               (fn [id]
+                 (properties id
+                             (comp #(prop-value % (partial deliver p)) first (partial property :date-of-birth)))))
+    p))
+
+
+;; TODO hey, that shit was fuckin easy, now what to do about place?
+;; * from Liszt "Raiding", got the idea that "Commons Category" for
+;; place is city, another query


define find-node-container

define find-node-container


break cycle by using template

break cycle by using template


Do not run nrepl in development

Do not run nrepl in development

--- server/src/clinicico/server/server.clj
+++ server/src/clinicico/server/server.clj
@@ -53,7 +53,7 @@
         (cli args
              ["-h" "--help" "Show Help" :default false :flag true]
              ["-p" "--port" "Port to listen to" :default 3000 :parse-fn #(Integer. %)]
-             ["-r" "--repl" "nREPL port to listen to" :default 7888 :parse-fn #(Integer. %)]
+             ["-r" "--repl" "nREPL port to listen to if in production" :default 7888 :parse-fn #(Integer. %)]
              ["-d" "--development" "Run server in development mode" :default false :flag true])]
     (defonce in-dev? (:development options))
     (when (:help options)
@@ -61,6 +61,6 @@
       (System/exit 0))
     (let [handler (if in-dev? (reload/wrap-reload app) app)]
       (log/info "Running server on :" (:port options) "and nREPL running on :" (:repl options))
-      (defonce repl-server (repl/start-server :port (:repl options)))
+      (if (not in-dev?) (defonce repl-server (repl/start-server :port (:repl options))))
       (tasks/initialize)
       (run-server handler {:port (:port options)}))))


updated scripts

updated scripts

--- src/duffel/script.clj
+++ src/duffel/script.clj
@@ -1,17 +1,18 @@
 (ns duffel.script
     (:use     [clojure.string :only [trim]])
-    (:require [duffel.fs-util :as dfs-util]))
+    (:require [duffel.fs :refer [exists? exec-in]]))

 (defn exec-script
-    "Runs root-dir/_SCRIPTS/script-name with args. Returns nil if script doesn't
-    actually exist, otherwise returns output from the execution"
-    [root-dir script-name & args]
-    (let [script-rel-path (str "_SCRIPTS/" script-name)]
-        (when (dfs-util/exists? (str root-dir "/" script-rel-path))
-            (apply dfs-util/exec-in root-dir script-rel-path args))))
+  "Runs root-dir/_SCRIPTS/script-name with args. Returns nil if script doesn't
+  actually exist, otherwise returns output from the execution"
+  [app script-name & args]
+  (let [script-rel-path (str (app :proj-root) "scripts/" script-name)]
+    (when (exists? script-rel-path)
+      (apply exec-in (app :proj-root) script-rel-path args))))

 (defn is-in-group?
-    [root-dir group-name]
-    (if-let [ret (exec-script root-dir "is-in-group" group-name)]
-        (= "1" (trim ret))
-        false))
+  [app group-name]
+  "Returns whether or not this node is in the given group"
+  (if-let [ret (exec-script app "is-in-group" group-name)]
+    (= "1" (trim ret))
+    false))


#6 - Added initial chapter pages. Needs more markup and styling.

--- src/biblecli/commands/staticpages.cljs
+++ src/biblecli/commands/staticpages.cljs
@@ -139,13 +139,23 @@
     :Revelation     "Revelation"}]
     (get m book-id)))

-(defn chapter-name [book-id chap-num chap-count]
-  (if (> chap-count 1)
-    (str (book-name book-id) " " chap-num)
-    (book-name book-id)))
-
-(defn rel-url [book-id chap-num chap-count]
-  (s/replace (chapter-name book-id chap-num chap-count) " " "-"))
+(defn chapter-name
+  ([book-id chap-num chap-count]
+    (if (> chap-count 1)
+      (str (book-name book-id) " " chap-num)
+      (book-name book-id)))
+  ([{book-id :book-id
+     chap-num :num
+     chap-cnt :chap-cnt}]
+    (chapter-name book-id chap-num chap-cnt)))
+
+(defn rel-url
+  ([book-id chap-num chap-count]
+    (s/replace (chapter-name book-id chap-num chap-count) " " "-"))
+  ([{book-id :book-id
+     chap-num :num
+     chap-cnt :chap-cnt}]
+    (rel-url book-id chap-num chap-cnt)))

 (defn toc-book [b]
   [:p {:class "tocp"}
@@ -174,6 +184,37 @@
           (drop 39)
           (map toc-book))]]))

+(defn chapters [m]
+  (->> m
+    (mapcat
+      (fn [b]
+        (map
+          (fn [ch]
+            (merge ch
+              {:book-id (:id b)
+               :book-num (:num b)
+               :chap-cnt (count (:chapters b))}))
+          (:chapters b))))))
+
+(defn verse [i ch v]
+  [:p {:class "foo"} v])
+
+(defn chapter
+  [{book-id :book-id
+    chap-num :num
+    chap-cnt :chap-cnt
+    verses :verses
+    :as ch}]
+  (html
+    [:html
+      [:head
+        [:title (str (chapter-name ch) " - The King James Bible")]
+        [:link {:rel "stylesheet" :type "text/css" :href "styles.css"}]]
+      [:body
+        [:h2 {:class "chap"}
+          (chapter-name ch)]
+        (map-indexed #(verse %1 ch %2) verses)]]))
+
 (defn write! [dir filename content]
   (let [filepath (.join node-path dir filename)
         buff (js/Buffer content "utf8")]
@@ -182,4 +223,6 @@
 (defn prepare! [parser src output-dir]
   (let [m (parse parser src)]
     (write! output-dir "styles.css" (style))
-    (write! output-dir "7ce12f75-f371-4e85-a3e9-b7749a65f140.html" (toc m))))+    (write! output-dir "7ce12f75-f371-4e85-a3e9-b7749a65f140.html" (toc m))
+    (doseq [ch (chapters m)]
+      (write! output-dir (rel-url ch) (chapter ch)))))


don't display old thread info in threads-view

addresses https://github.com/braidchat/meta/issues/568

Previously, when trying to maintain order of threads, the old threads
would stay in the threads list, which meant that if the tags changed the
thread wouldn't be updated & the limbo/private banners would stay above
the thread. To fix, calculate the order of threads in the same way, but
use new-threads as the actual data

--- src/braid/client/ui/views/threads.cljs
+++ src/braid/client/ui/views/threads.cljs
@@ -16,9 +16,10 @@
                                    (let [old-thread-ids (set (map :id old-threads))
                                          new-thread-ids (set (map :id new-threads))
                                          to-remove (difference old-thread-ids new-thread-ids)
-                                         to-add (difference new-thread-ids old-thread-ids)]
-                                     (vec (concat (remove (fn [t] (contains? to-remove (t :id))) old-threads)
-                                                  (filter (fn [t] (contains? to-add (t :id))) new-threads)))))))
+                                         to-add (difference new-thread-ids old-thread-ids)
+                                         ordered-ids (concat (remove to-remove old-thread-ids)
+                                                             (filter to-add new-thread-ids))]
+                                     (mapv (comp first (group-by :id new-threads)) ordered-ids)))))
         scroll-horizontally (fn [e]
                               (let [target-classes (.. e -target -classList)]
                                 ; TODO: check if threads-div needs to scroll?


remove data ns -- handling elsewhere

remove data ns -- handling elsewhere

--- src/buyme_aggregation_backend/data.clj
+++ src/buyme_aggregation_backend/data.clj
@@ -1,8 +0,0 @@
-(ns buyme-aggregation-backend.data
-  (:require [taoensso.timbre :refer [info]]
-            [clj-http.client :as client]))
-
-(defn fetch-http [source]
-  (let [url (:url_root source)]
-    (info "Fetching from" source)
-    (:body (client/get url))))


[Fix #151] Display JVM and nREPL version information on start

--- src/clj/reply/initialization.clj
+++ src/clj/reply/initialization.clj
@@ -2,11 +2,13 @@
   (:require [clojure.pprint]
             [clojure.repl]
             [clojure.main]
+            [clojure.tools.nrepl :only [version]]
             [trptcolin.versioneer.core :as version]))

 (def prelude
-  `[(println "REPL-y" ~(version/get-version "reply" "reply"))
-    (println "Clojure" (clojure-version))])
+  `[(println (str "REPL-y " ~(version/get-version "reply" "reply") ", nREPL " (:version-string clojure.tools.nrepl/version)))
+    (println "Clojure" (clojure-version))
+    (println (System/getProperty "java.vm.name") (System/getProperty "java.runtime.version"))])

 (defn help
   "Prints a list of helpful commands."


simplify game loop

simplify game loop

--- src/cljs/triboard/game_loop.cljs
+++ src/cljs/triboard/game_loop.cljs
@@ -20,13 +20,11 @@
    * Wait 500ms to start (animation might be frozen otherwise)
    * Wait 1s to play the move (avoid moves being played too fast)"
   [game]
-  (let [out-chan (chan 1)]
-    (go
-      (<! (async/timeout animation-delay))
-      (let [ai-chan (go (ai/find-best-move game))]
-        (<! (async/timeout ai-move-delay))
-        (>! out-chan (<! ai-chan))))
-    out-chan))
+  (go
+    (<! (async/timeout animation-delay))
+    (let [ai-chan (go (ai/find-best-move game))]
+      (<! (async/timeout ai-move-delay))
+      (<! ai-chan))))

 (defn player-moves-chan
   []


added implementation for oxford function

--- src/clojure/contrib/humanize.clj
+++ src/clojure/contrib/humanize.clj
@@ -117,3 +117,59 @@

   ([string length]
      (truncate string length "...")))
+
+(defn pluralize [count string]
+  "FIXME: dummy implementation"
+  (if (<= count 1)
+    string
+    (str string "s")))
+
+(defn oxford [coll  & {:keys [maximum-display truncate-noun]
+                         :or {maximum-display 4
+                              truncate-noun nil}}]
+  "Converts a list of items to a human readable string
+   with an optional limit."
+
+  (let [coll-length (count coll)]
+    (cond
+     ;; if coll has one or zero items
+     (< coll-length 2) (clojure.string/join coll)
+
+     ;; if the number of items doesn't exceed maximum display size
+     (<= coll-length maximum-display) (let [before-last (take (dec coll-length) coll)
+                                            last-item (last coll)]
+                                        (str (clojure.string/join (interpose ", " before-last))
+                                             " and " last-item))
+
+     (> coll-length maximum-display) (let [display-coll (take maximum-display coll)
+                                           remaining (- coll-length maximum-display)
+                                           last-item (if (empty? truncate-noun)
+                                                       (str remaining " " (pluralize remaining "other"))
+                                                       (str remaining " other " (pluralize remaining
+                                                                                truncate-noun)))
+                                                       ]
+                                       (str (clojure.string/join (interpose ", " display-coll))
+                                                " and " last-item))
+     ;; TODO: shouldn't reach here, throw exception
+     :else coll-length)
+    ))
+
+;; Humanize.oxford = (items, limit, limitStr) ->
+;;     numItems = items.length
+
+;;     if numItems < 2
+;;         return "#{items}"
+
+;;     else if numItems is 2
+;;         return items.join ' and '
+
+;;     else if limit? and numItems > limit
+;;         extra = numItems - limit
+;;         limitIndex = limit
+;;         limitStr ?= ", and #{extra} #{Humanize.pluralize(extra, 'other')}"
+
+;;     else
+;;         limitIndex = -1
+;;         limitStr = ", and #{items[numItems - 1]}"
+
+;;     items.slice(0, limitIndex).join(', ') + limitStr


Fix typo

Fix typo

--- src/cljs/salava/location/ui/embed.cljs
+++ src/cljs/salava/location/ui/embed.cljs
@@ -112,7 +112,7 @@
              lat (get-in @state [:query-params :lat] 40)
              long (get-in @state [:query-params :long] -20)
              lat-lng (js/L.latLng. lat long)
-             my-map (-> (js/L.map. "map-view" (-> (js->cls lu/map-opt :keywordize-keys true)
+             my-map (-> (js/L.map. "map-view" (-> (js->clj lu/map-opt :keywordize-keys true)
                                                   (assoc :scrollWheelZoom false)
                                                   (clj->js)))


start macro interface for query ns

start macro interface for query ns

--- src/com/billpiel/mem_tracer/query2.clj
+++ src/com/billpiel/mem_tracer/query2.clj
@@ -1,6 +1,5 @@
 (ns com.billpiel.mem-tracer.query2
-  (require [com.billpiel.mem-tracer.trace :as tr]
-           [clojure.zip :as z]))
+  (require [clojure.zip :as z]))

 ;; === zipper iterators

@@ -128,6 +127,51 @@
   ([tree pred-fn] (query-uno tree pred-fn))
   ([tree pred-map pred-final-fn] (query-dos tree pred-map pred-final-fn)))

+;; === macro interface
+
+
+(defn get-some
+  [coll v]
+  (loop [coll coll
+         v v]
+    (if ((some-fn empty? nil?) coll)
+      v
+      (let [[f & r] coll]
+        (when-let [v' (get-some* f v)]
+          (recur r v'))))))
+
+(defn eq* [pred v]
+  (cond (fn? pred)
+        (pred v)
+
+        (set? pred)
+        (pred v)
+
+        (instance? java.util.regex.Pattern pred)
+        (->> v
+             str
+             (re-matches pred))
+
+        :default (= pred v)))
+
+(defn mk-query-fn
+  [query-coll]
+  (let [path (drop-last query-coll)
+        pred (last query-coll)]
+    (fn [v]
+      (->> v
+           (get-some path)
+           (eq* pred)))))
+
+
+(defn q
+  [tree & body]
+  (let [[arg r] (if (-> body
+                        first
+                        vector?)
+                  [nil body]
+                  [(first body) (rest body)])]
+    (exec-query arg zipr r)))

 ;; === helpers


Oops, call resolve-param, don't just mention it!

The problems of committing something when you aren't in a position to
test it...

--- src/afterglow/effects/channel.clj
+++ src/afterglow/effects/channel.clj
@@ -73,5 +73,5 @@
 (defn channel-assignment-resolver
   "Resolves the assignment of a level to a single DMX channel."
   [show buffers snapshot target assignment]
-  (let [resolved params/resolve-param assignment show snapshot target]  ; In case it is frame dynamic
+  (let [resolved (params/resolve-param assignment show snapshot target)] ; In case it is frame dynamic
     (apply-channel-value buffers target resolved)))


Add global symbols in generated namespaces

--- src/googlica/core.clj
+++ src/googlica/core.clj
@@ -1,8 +1,8 @@
 (ns googlica.core
   (:gen-class)
   (:require [cheshire.core :as json]
-            [clojure.string :as s]
-            [clojure.set :as st]
+            [clojure.string :as str]
+            [clojure.set :as set]
             [me.raynes.fs :as fs]
             [clj-http.client :as http]
             [fipp.clojure :as f]
@@ -30,7 +30,6 @@

 (def base-url (-> storage-model :baseUrl))

-;;(generate-ns-sexp (:name storage-model) (:version storage-model) (:description storage-model) (:documentationLink storage-model))
 (defn generate-ns-sexp
   "Generates the ns declaration for an API.
   Takes name, version, description and docs link, all strings."
@@ -40,6 +39,11 @@
     ~(str desc "\n\nDocumentation link: " docs-link)
     (:gen-class)
     (:require [clj-http.client :as http])))
+
+(defn generate-global-vars
+  "Generates global variables that are used throughout the namespace"
+  [root-url service-path]
+  `[(def base-url ~(str root-url service-path))])

 (defn split-required-params
   "Returns a vector of two maps: first with the required params, second with the optional"
@@ -51,7 +55,7 @@
 (defn generate-function-name
   "Generates a symbol in the form of 'verb-resource', from a method map."
   [method]
-  (let [[_ resource-name method-name] (s/split (:id method) #"\.")]
+  (let [[_ resource-name method-name] (str/split (:id method) #"\.")]
     (-> (str method-name "-" resource-name)
         ->kebab-case-symbol)))

@@ -81,7 +85,7 @@
         template->path-vector'
         (fn [result-acc template matches]
           (if-some [[match arg] (first matches)]
-            (let [[pre post] (s/split template
+            (let [[pre post] (str/split template
                                       (re-pattern (str "\\{" arg "\\}")))]
               (recur (concat result-acc [pre (get args->symbols arg)])
                      post
@@ -99,15 +103,30 @@
                               keys
                               (map name))))

-(defn generate-request [base-url method]
-  {:method (-> method :httpMethod s/lower-case keyword)
-   :url `(str ~base-url ~@(generate-path method))})
+(defn generate-request
+  "Generates the request map to be passed to the http library.
+  NB: uses the `base-url` symbol, it should be generated in the ns including the method."
+  [method]
+  {:method (-> method :httpMethod str/lower-case keyword)
+   :url `(str base-url ~@(generate-path method))})

 (defn generate-function-from-method
-  [base-url method]
-  (-> `(defn ~(generate-function-name method)
-         ~(generate-docs method)
-         ~(generate-args method)
-         (http/request ~(generate-request base-url method)))
-      (f/pprint {:width 100}))) ;; This pretty prints the generated code in an idiomatic way
-      ;(with-out-str))) ;; TODO: uncomment this line to return formatted code as a string
+  [method]
+  `(defn ~(generate-function-name method)
+     ~(generate-docs method)
+     ~(generate-args method)
+     (http/request ~(generate-request method))))
+
+(defn generate-ns-file
+  "Given a service model, generates a clojure namespace with the implementation
+  of all the API methods as functions, and writes it to file."
+  [{:keys [name version description documentationLink rootUrl servicePath] :as model}]
+  (let [symbols->str #(-> %
+                          (f/pprint {:width 100}) ;; Fipp pretty prints clojure code nicely
+                          with-out-str)]
+    (->> [[(generate-ns-sexp name version description documentationLink)]
+          (generate-global-vars rootUrl servicePath)]
+          ;;(mapv generate-function-from-method ;; TODO get all the methods)])))
+         (apply concat) ;; <- this is for flattening the methods
+         (mapv symbols->str)
+         (str/join "\n\n"))))


Update VimClojure for the changes from the lazy branch

--- src/de/kotka/vimclojure/util.clj
+++ src/de/kotka/vimclojure/util.clj
@@ -96,9 +96,10 @@
            argmap (hash-map)]
       (let [arg (first args)]
         (cond
-          (nil? args)  (if-not rest-arg
-                         (thunk argmap)
-                         (throw (Exception. "Missing command line arguments")))
+          (empty? args)  (if-not rest-arg
+                           (thunk argmap)
+                           (throw
+                             (Exception. "Missing command line arguments")))

           (some #{arg} ["-h" "--help" "-?"])
           (print-usage description specs)
@@ -114,7 +115,7 @@
             (condp = (options option)
               :flag   (recur (rest args) (assoc argmap option true))
               :option (if-let [value (second args)]
-                        (recur (nthrest args 2) (assoc argmap option value))
+                        (recur (nthnext args 2) (assoc argmap option value))
                         (throw (Exception.
                                  (str "Missing value for option: " arg))))
               nil     (throw (Exception. (str "Unknown option: " option)))))


Oops, I accidentally returned an empty array when parsing the body. Fixed it.  Thanks @sebastianpoeplau.

--- src/io/sarnowski/swagger1st/parser.clj
+++ src/io/sarnowski/swagger1st/parser.clj
@@ -204,9 +204,10 @@
   (let [items-definition (get definition "items")
         items-parser (create-value-parser items-definition path parser-options)]
     (fn [value]
-      (let [vals (if (and value (not= "body" (first path)))
-                   (split-array definition value)
-                   [])
+      (let [vals (cond
+                   (= "body" (first path)) value
+                   (some? value) (split-array definition value)
+                   :else [])
             err (partial throw-value-error value definition path)
             check-count (fn [value]
                           (if-let [max-items (get definition "maxItems")]


Properly nest the namespace loading/evaluating code inside track blocks

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -344,21 +344,22 @@
 (defn- evaluate-namespace-metadata
   [context ns-sym]
   (t/track
-    #(format "Loading namespace `%s'." ns-sym))
-  (try
-    (if-not (find-ns ns-sym)
-      (require ns-sym))
-    (catch Exception e
-      (throw (ex-info (format "Failed to require namespace `%s': %s"
-                              ns-sym
-                              (to-message e))
-                      {:context   context
-                       :namespace ns-sym}
-                      e))))
-  (t/track
-    #(format "Evaluating metadata for namespace `%s'." ns-sym)
-    (binding [*ns* (the-ns ns-sym)]
-      (-> *ns* meta eval))))
+    #(format "Loading namespace `%s'." ns-sym)
+    (try
+      (if-not (find-ns ns-sym)
+        (require ns-sym))
+      (catch Exception e
+        (throw (ex-info (format "Failed to require namespace `%s': %s"
+                                ns-sym
+                                (to-message e))
+                        {:context   context
+                         :namespace ns-sym}
+                        e))))
+
+    (t/track
+      #(format "Evaluating metadata for namespace `%s'." ns-sym)
+      (binding [*ns* (the-ns ns-sym)]
+        (-> *ns* meta eval)))))

 (defn- expand-namespace-metadata
   "Adds a fifth element to each ns-spec, the evaluated namespace meta-data"


Increase REPL timeout to 5 minutes (#250)

Starting a REPL on a new project times out (issue #243). This increases
the timeout for starting the REPL to 5 minutes.

--- src/leiningen/new/chestnut/project.clj
+++ src/leiningen/new/chestnut/project.clj
@@ -24,7 +24,7 @@
   ;; nREPL by default starts in the :main namespace, we want to start in `user`
   ;; because that's where our development helper functions like (go) and
   ;; (browser-repl) live.
-  :repl-options {:init-ns user}
+  :repl-options {:timeout 300000 :init-ns user}

   :cljsbuild {:builds
               [{:id "app"


Use partial on function to map over

Use partial on function to map over

--- src/cljs/cglossa/result_views/cwb/core.cljs
+++ src/cljs/cglossa/result_views/cwb/core.cljs
@@ -116,9 +116,9 @@
      [:td {:col-span 3}
       row-contents]]))

-(defn- result-rows [res index
-                    {:keys [player-row-index current-player-type current-media-type] :as a}
-                    {:keys [corpus] :as m}]
+(defn- result-rows [{:keys [player-row-index current-player-type current-media-type] :as a}
+                    {:keys [corpus] :as m}
+                    res index]
   "Returns one or more rows representing a single search result."
   (let [[s-id fields] (if (re-find #"\{\{" (:text res))
                         ;; The result contains {{, which  is the left delimiter of a
@@ -157,8 +157,6 @@
     [:div.row>div.col-sm-12 {:style {:height 320 :overflow "auto"}}
      [b/table {:striped true :bordered true}
       [:tbody
-       (map result-rows
+       (map (partial result-rows a m)
              results
-             (range (count results))
-             (repeat a)
-             (repeat m))]]]))
+             (range (count results)))]]]))


unbreak the `prepared` macro

unbreak the `prepared` macro

--- src/clojure/clojurewerkz/cassaforte/cql.clj
+++ src/clojure/clojurewerkz/cassaforte/cql.clj
@@ -23,7 +23,8 @@
   "Helper macro to execute prepared statement"
   [& body]
   `(binding [cql/*prepared-statement* true
-             cql/*param-stack*        (atom [])]))
+             cql/*param-stack*        (atom [])]
+     (do ~@body)))

 (defn ^:private execute-
   [query-params builder]


Do not pass args to wrap-incise.

Do not pass args to wrap-incise.

--- src/incise/server.clj
+++ src/incise/server.clj
@@ -38,8 +38,7 @@
 (def app (-> routes
              (wrap-static-index)
              (wrap-reload :dirs ["src" "spec"])
-             (wrap-incise :out "resources/public"
-                          :in "resources/content")
+             (wrap-incise)
              (wrap-parsers-reload)
              (wrap-log-exceptions)
              (wrap-stacktrace-web)


On extend node, rename local var

On extend node, rename local var

--- src/com/wsscode/pathom/connect/planner.cljc
+++ src/com/wsscode/pathom/connect/planner.cljc
@@ -359,11 +359,11 @@
   inserted containing the previous node and the new one."
   [out
    {::keys [run-next run-next-trail] :as env}
-   node-id]
+   extend-node-id]
   (if (or (not run-next)
-          (contains? run-next-trail node-id))
+          (contains? run-next-trail extend-node-id))
     out
-    (let [node      (get-in out [::nodes node-id])
+    (let [node      (get-in out [::nodes extend-node-id])
           new-out   (compute-root-and
                       (assoc out ::root (::run-next node))
                       env
@@ -374,11 +374,11 @@
           (assoc
             ::nodes (::nodes new-out)
             ::index-syms (::index-syms new-out))
-          (assoc-in [::nodes node-id ::run-next] (::root new-out))
-          (assoc-in [::nodes (::root new-out) ::after-node] node-id)
-          (merge-node-provides node-id next-node)
+          (assoc-in [::nodes extend-node-id ::run-next] (::root new-out))
+          (assoc-in [::nodes (::root new-out) ::after-node] extend-node-id)
+          (merge-node-provides extend-node-id next-node)
           (propagate-provides node)
-          (update ::extended-nodes p.misc/sconj node-id)))))
+          (update ::extended-nodes p.misc/sconj extend-node-id)))))

 (defn include-node [out {::keys [node-id] :as node}]
   (let [sym (pc-sym node)]


Update new indiv tests and add p-min tests

--- test/hydrofoil/expectations/evolution.clj
+++ test/hydrofoil/expectations/evolution.clj
@@ -4,3 +4,42 @@
             [hydrofoil.core :refer :all]
             [hydrofoil.evolution :refer :all]
             [hydrofoil.utils :refer :all]))
+
+(expect true
+  (let [child (new-indv (NACA-design 2 4 12))]
+    (and (<= (child :max-camber) 22) (>= (child :max-camber 2)))))
+
+(expect true
+  (let [child (new-indv (NACA-design 2 4 12))]
+    (and (<= (child :positon-camber) 5) (>= (child :positon-camber 3)))))
+
+(expect true
+  (let [child (new-indv (NACA-design 2 4 12))]
+    (and (<= (child :thickness) 22) (> (child :thickness 2)))))
+
+(expect nil
+        (some #(and (> (% :max-camber) 100) (< (% :max-camber) 0)) (take 100 (iterate new-indv (NACA-design 2 4 12)))))
+
+(expect nil
+        (some #(and (> (% :positon-camber) 10) (< (% :positon-camber) 0)) (take 100 (iterate new-indv (NACA-design 2 4 12)))))
+
+(expect nil
+        (some #(and (> (% :thickness) 100) (< (% :thickness) 0)) (take 100 (iterate new-indv (NACA-design 2 4 12)))))
+
+;;; ---------------------- p-min -----------------------------
+(expect 0.0100
+        (round-double (p-min 0)))
+(expect 0.2194
+        (round-double (p-min 0.1)))
+(expect 0.8796
+        (round-double (p-min 10)))
+(expect 2.8578
+        (round-double (p-min 19.99)))
+(expect 2.79
+        (round-double (p-min 20)))
+(expect 2.79
+        (round-double (p-min 35)))
+(expect 2.79
+        (round-double (p-min 100)))
+;;; ---------------------- p-min -----------------------------
+


fix typo

fix typo

--- src/kixi/hecuba/api/profiles.clj
+++ src/kixi/hecuba/api/profiles.clj
@@ -12,7 +12,7 @@
    [kixi.hecuba.storage.sha1 :as sha1]
    [kixi.hecuba.web-paths :as p]
    [kixi.hecuba.data.users :as users]
-   [kixi.hecuba.data.entity :as entity]))
+   [kixi.hecuba.data.entities :as entities]))

 (def ^:private entity-profiles-resource (p/resource-path-string :entity-profiles-resource))

@@ -22,7 +22,7 @@
           method       (:request-method request)
           route-params (:route-params request)
           entity_id    (:entity_id route-params)
-          entity       (entity/get-by-id session entity_id)]
+          entity       (entities/get-by-id session entity_id)]
       (case method
         :post (not (nil? entity))
         :get (let [items (db/execute session (hayt/select :profiles (hayt/where [[= :entity_id entity_id]])))]
@@ -827,7 +827,7 @@
           username   (sec/session-username (-> ctx :request :session))
           profile_id (sha1/gen-key :profile profile)]
       (when (and entity_id timestamp)
-        (when (seq (entity/get-by-id session entity_id))
+        (when (entities/get-by-id session entity_id)
           (let [query-profile (-> profile
                                  (assoc :user_id username)
                                  (update-stringified-lists


RR: test num of submissions updated correctly

--- test/hatti/shared_test.cljs
+++ test/hatti/shared_test.cljs
@@ -51,6 +51,16 @@
       (swap! shared/app-state assoc-in [:languages :current] :English)
       (om/root shared/language-selector nil {:target c})
       (is (= (dommy/text (sel1 c [:span.dropdown :span])) "EN")))))
+
+
+(deftest num-of-submissions-updated-correctly
+  (testing "num_of_submissions in dataset-info is not replaced by
+  submission count if submission count is zero"
+    (let [num_of_submissions 2]
+      (shared/transact-app-state! shared/app-state [:dataset-info :num_of_submissions] #(-> num_of_submissions))
+      (shared/update-app-data! shared/app-state no-data)
+      (is (= (-> @shared/app-state :dataset-info :num_of_submissions) num_of_submissions))
+      (is (not= (-> @shared/app-state :dataset-info :num_of_submissions) 0)))))

 ;; TODO Move test to zerba
 #_(deftest update-data-on!-works


Added  to PersistentHashMap

Added  to PersistentHashMap

--- src/main/cljs/lean_map/core.cljs
+++ src/main/cljs/lean_map/core.cljs
@@ -5,7 +5,7 @@
                             TransientHashMap ->TransientHashMap
                             NodeSeq ->NodeSeq
                             create-inode-seq create-array-node-seq create-node
-                            mask bitmap-indexed-node-index bitpos]))
+                            mask bitmap-indexed-node-index bitpos inode-kv-reduce]))

 (declare NodeSeq HashCollisionNode TransientHashMap PersistentHashMap)

@@ -27,6 +27,22 @@

 (defn- can-edit [x y]
   (and (coercive-not= x nil) (coercive-not= y nil) (identical? x y)))
+
+(defn- inode-kv-reduce [arr kvs nodes f init]
+  (let [kv-len (* 2 kvs)
+        node-len (+ kv-len nodes)]
+    (loop [i 0 init init]
+      (cond (< i kv-len)
+            (let [init (f init (aget arr i) (aget arr (inc i)))]
+              (if (reduced? init)
+                @init
+                (recur (+ i 2) init)))
+            (< i node-len)
+            (let [init (.kv-reduce (aget arr i) f init)]
+              (if (reduced? init)
+                @init
+                (recur (inc i) init)))
+            :else init))))

 (deftype BitmapIndexedNode [edit ^:mutable datamap ^:mutable nodemap ^:mutable arr]
   Object
@@ -157,6 +173,9 @@
       (array-copy arr (inc idx-old) dst (+ idx-old 2) (- (alength arr) idx-old 1))
       (BitmapIndexedNode. e (bit-or datamap bit) (bit-xor nodemap bit) dst)))

+  (kv-reduce [inode f init]
+    (inode-kv-reduce arr (bit-count datamap) (bit-count nodemap) f init))
+
   (single-kv? [_]
     (and (zero? nodemap) (== 1 (bit-count datamap))))

@@ -239,6 +258,9 @@
              (array-copy arr (* 2 (inc i)) new-arr (* 2 i) (- (alength new-arr) (* 2 i)))
              (HashCollisionNode. wedit hash (dec cnt) new-arr)))))))

+  (kv-reduce [inode f init]
+    (inode-kv-reduce arr cnt 0 f init))
+
   (single-kv? [_]
     false))

@@ -325,7 +347,14 @@
       (let [new-root (.inode-without root nil 0 (hash k) k (Box. false false))]
         (if (identical? new-root root)
           coll
-          (PersistentHashMap. meta (dec cnt) new-root nil))))))
+          (PersistentHashMap. meta (dec cnt) new-root nil)))))
+
+  IKVReduce
+  (-kv-reduce [coll f init]
+    (cond
+      (reduced? init)          @init
+      (not (nil? root)) (.kv-reduce root f init)
+      :else                    init)))

 (set! (.-EMPTY PersistentHashMap) (PersistentHashMap. nil 0 nil empty-unordered-hash))

@@ -470,8 +499,10 @@
         ["assoc"
          (count hm1)
          (= (into #{} (vals hm1)) (into #{} (range times)))
+         (= (reduce-kv #(conj %1 %3) #{} hm1) (into #{} (range times)))
          (= (into #{} (vals hm1)) (into #{} (map #(get hm1 (str "key" %)) (range times))))
          (= (keys hm1) (map (fn [[k v]] k) hm1))
+         (= (reduce-kv #(conj %1 %2) #{} hm1) (into #{} (map #(str "key" %) (range times))))
          (= (into #{} (keys hm1)) (into #{} (map #(str "key" %) (range times))))])
       (let [subchan (/ times 2)
             dtimes (- times subchan)
@@ -482,8 +513,10 @@
             ["dissoc"
              (count dhm1)
              (= (into #{} (vals dhm1)) (into #{} (range dtimes)))
+             (= (reduce-kv #(conj %1 %3) #{} dhm1) (into #{} (range dtimes)))
              (= (into #{} (vals dhm1)) (into #{} (map #(get dhm1 (str "key" %)) (range dtimes))))
              (= (keys dhm1) (map (fn [[k v]] k) dhm1))
+             (= (reduce-kv #(conj %1 %2) #{} dhm1) (into #{} (map #(str "key" %) (range dtimes))))
              (= (into #{} (keys dhm1)) (into #{} (map #(str "key" %) (range dtimes))))]))
   (do
     (js/console.profile "CLJS Map")


Fix calling cqrs/dispatch in rss fetching

--- src/braid/rss/server/fetching.clj
+++ src/braid/rss/server/fetching.clj
@@ -67,21 +67,21 @@
   [feed item]
   (let [thread-id (java.util.UUID/randomUUID)]
     (cqrs/dispatch
-      [:braid.chat/create-thread!
-       {:user-id (feed :user-id)
-        :thread-id thread-id
-        :group-id (feed :group-id)}])
+      :braid.chat/create-thread!
+      {:user-id (feed :user-id)
+       :thread-id thread-id
+       :group-id (feed :group-id)})
     (cqrs/dispatch
-      [:braid.chat/create-message!
-       {:message-id (java.util.UUID/randomUUID)
-        ;; TODO: maybe also include description of item?
-        ;; it probably is html though, which may be something not
-        ;; worth the hassle
-        :content (string/join "\n" [(item :title) (item :link)])
-        :thread-id thread-id
-        :user-id (feed :user-id)
-        :mentioned-user-ids []
-        :mentioned-tag-ids (feed :tag-ids)}])))
+      :braid.chat/create-message!
+      {:message-id (java.util.UUID/randomUUID)
+       ;; TODO: maybe also include description of item?
+       ;; it probably is html though, which may be something not
+       ;; worth the hassle
+       :content (string/join "\n" [(item :title) (item :link)])
+       :thread-id thread-id
+       :user-id (feed :user-id)
+       :mentioned-user-ids []
+       :mentioned-tag-ids (feed :tag-ids)})))

 (defn update-feed!
   [feed]


connect to rabbitmq, implement some es functionality

--- src/brainbot/nozzle/esconnect.clj
+++ src/brainbot/nozzle/esconnect.clj
@@ -1,7 +1,12 @@
 (ns brainbot.nozzle.esconnect
   (:require [clojure.tools.logging :as logging])
-  (:require [brainbot.nozzle.misc :as misc])
-  (:require [clojurewerkz.elastisch.rest :as esr]
+  (:require [langohr.core :as rmq]
+            [langohr.consumers :as lcons]
+            [langohr.basic :as lb])
+  (:require [brainbot.nozzle.misc :as misc]
+            [brainbot.nozzle.mqhelper :as mqhelper])
+  (:require [clojurewerkz.elastisch.rest.document :as esd]
+            [clojurewerkz.elastisch.rest :as esr]
             [clojurewerkz.elastisch.rest.index :as esi]))

 ;; (esr/connect! "http://127.0.0.1:9200")
@@ -47,6 +52,44 @@
     (esi/create index-name :mappings mapping-types)))

+(defn es-listdir
+  [index-name parent]
+  (esd/search index-name
+              "doc"
+              :size 1000000
+              :query {:match_all {}}
+              :filter {:term {:parent parent}}))
+
+
+(defn es-recursive-delete
+  [index-name parent]
+  (let [with-slash (misc/ensure-endswith-slash parent)]
+    (esd/delete-by-query-across-all-types
+     index-name
+     {:prefix {:_id with-slash}})
+    (esd/delete index-name "dir" parent)))
+
+
+
+
+(defn simple-update_directory
+  [fs {:keys [directory entries] :as body} {publish :publish}]
+  (println "update-directory" body))
+
+
+(defn build-handle-connection
+  [es-index filesystems]
+  (fn [conn]
+    (logging/info "initializing rabbitmq connection")
+    (doseq [fs filesystems]
+      (mqhelper/channel-loop
+       conn
+       (fn [ch]
+         (let [qname (misc/initialize-rabbitmq-structures ch "update_directory" "nextbot" fs)]
+           (logging/info "starting consumer for" qname)
+           (lb/qos ch 1)
+           (lcons/subscribe ch qname (mqhelper/make-handler (partial simple-update_directory fs)))))))))
+

 (defn esconnect-run-section
   [iniconfig section]
@@ -64,5 +107,6 @@
      (logging/info "connecting to elasticsearch" es-url)
     (esr/connect! es-url)
     (ensure-index-and-mappings es-index)
-    #_(doseq [fs filesystems]
-      (future (manage-filesystem "nextbot" fs)))))
+    (mqhelper/connect-loop
+     #(rmq/connect rmq-settings)
+     (build-handle-connection es-index filesystems))))


Don't show the Chronos prompt if the Net Damage is 0 (ie. likely prevented)

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -60,7 +60,7 @@
    {:events
     {:pre-resolve-damage
      {:once :per-turn
-      :req (req (= target :net))
+      :req (req (and (= target :net) (> (last targets) 0)))
       :effect (effect (damage-defer :net (last targets))
                       (show-wait-prompt :runner "Corp to use Chronos Protocol: Selective Mind-mapping")
                       (resolve-ability


further simplified 2 card implementations

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -119,7 +119,7 @@
                             :effect (effect (gain :credit 1))}}}

    "Haas-Bioroid: Stronger Together"
-   {:events {:pre-ice-strength {:req (req (and (= (:type target) "ICE") (has? target :subtype "Bioroid")))
+   {:events {:pre-ice-strength {:req (req (and (ice? target) (has? target :subtype "Bioroid")))
                                 :effect (effect (ice-strength-bonus 1 target))}}}

    "Harmony Medtech: Biomedical Pioneer"
@@ -279,9 +279,9 @@

    "Reina Roja: Freedom Fighter"
    {:effect (effect (gain :link 1))
-    :events {:pre-rez {:req (req (and (= (:type target) "ICE") (not (get-in @state [:per-turn (:cid card)]))))
+    :events {:pre-rez {:req (req (and (ice? target) (not (get-in @state [:per-turn (:cid card)]))))
                        :effect (effect (rez-cost-bonus 1))}
-             :rez {:req (req (and (= (:type target) "ICE") (not (get-in @state [:per-turn (:cid card)]))))
+             :rez {:req (req (and (ice? target) (not (get-in @state [:per-turn (:cid card)]))))
                               :effect (req (swap! state assoc-in [:per-turn (:cid card)] true))}}}

    "Rielle \"Kit\" Peddler: Transhuman"


fix broken build

fix broken build

--- src/clj/hsm/integration/twttr.clj
+++ src/clj/hsm/integration/twttr.clj
@@ -6,6 +6,7 @@
    [twitter.api.streaming])
     (:require
    [cheshire.core :as json]
+   [environ.core :refer [env]]
    [http.async.client :as ac])
   (:import
    (twitter.callbacks.protocols AsyncStreamingCallback))
@@ -28,4 +29,4 @@

 (statuses-filter :params {:track "clojure"}
          :oauth-creds my-creds
-         :callbacks *custom-streaming-callback*+         :callbacks *custom-streaming-callback*)


Drop the local css

Drop the local css

--- src/clj/hyphen_keeper/handler.clj
+++ src/clj/hyphen_keeper/handler.clj
@@ -17,7 +17,7 @@
    [:meta {:charset "utf-8"}]
    [:meta {:name "viewport"
            :content "width=device-width, initial-scale=1"}]
-   (include-css (if (env :dev) "/css/site.css" "/css/site.min.css"))])
+   (include-css "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css")])

 (defn loading-page []
   (html5


Test for Accelerated Diagnostics with Shipment from SanSan.

--- src/clj/test/cards-operations.clj
+++ src/clj/test/cards-operations.clj
@@ -1,4 +1,32 @@
 (in-ns 'test.core)
+
+(deftest accelerated-diagnostics
+  "Accelerated Diagnostics - Interaction with prompt effects, like Shipment from SanSan"
+  (do-game
+    (new-game (default-corp [(qty "Accelerated Diagnostics" 1) (qty "Cerebral Overwriter" 1) (qty "Shipment from SanSan" 1)
+                             (qty "Hedge Fund" 1) (qty "Back Channels" 1)])
+              (default-runner))
+    (starting-hand state :corp ["Accelerated Diagnostics" "Cerebral Overwriter"])
+    (play-from-hand state :corp "Cerebral Overwriter" "New remote")
+    (core/gain state :corp :credit 1)
+    (play-from-hand state :corp "Accelerated Diagnostics")
+
+    (let [playarea (get-in @state [:corp :play-area])
+          hf (find-card "Hedge Fund" playarea)
+          ss (find-card "Shipment from SanSan" playarea)
+          bc (find-card "Back Channels" playarea)
+          co (get-content state :remote1 0)]
+      (is (= 3 (count playarea)) "3 cards in play area")
+      (prompt-select :corp ss)
+      (prompt-choice :corp "2")
+      (prompt-select :corp co)
+      (is (= 2 (:advance-counter (refresh co))) "Cerebral Overwriter gained 2 advancements")
+      (prompt-select :corp hf)
+      (is (= 9 (:credit (get-corp))) "Corp gained credits from Hedge Fund")
+      (prompt-select :corp bc)
+      (prompt-select :corp (refresh co))
+      (is (= 15 (:credit (get-corp))) "Corp gained 6 credits for Back Channels"))))
+

 (deftest big-brother
   "Big Brother - Give the Runner 2 tags if already tagged"


Start turn action resolution

Start turn action resolution

--- src/cljs/battle_console/game.cljs
+++ src/cljs/battle_console/game.cljs
@@ -105,10 +105,20 @@
                (dom/div #js {:className "panel-heading"}
                 (dom/h3 #js {:className "panel-title"} (get-name-for game :p1)))))))

+(defn- action-added
+  "Added action"
+  [data]
+  (println data))
+
 (defn- add-action
   "Processes a new action"
-  []
-  (GET "http://rules.api.orionsbelt.eu/game/turn/p1?context={}"))
+  [ev]
+  (let [game (-> (state/get-state :game-data)
+                 (assoc :actions [[:deploy 100 :toxic [8, 8]]]))
+        jsgame (js/encodeURIComponent (.stringify js/JSON (clj->js game)))
+        url (str "http://rules.api.orionsbelt.eu/game/turn/p1?context=" jsgame)]
+    (GET url {:handler action-added
+              :error-handler error-loading})))

 (defn- render-action-console
   "Renders the action management console"


Undo doc popup change

Undo doc popup change

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -395,13 +395,12 @@
       (keyReleased [this e] nil)
       (keyTyped [this e] nil)
       (keyPressed [this e]
-        (if (contains? completer-keys (.getKeyCode e))
-          (when (.isPopupVisible completer)
-            (let [ks (KeyStroke/getKeyStroke (.getKeyCode e) 0)
-                  condition JComponent/WHEN_FOCUSED]
-              (.processKeyBinding text-area ks e condition true))
-            (.consume e))
-          (.hideChildWindows completer))))))
+        (when (and (.isPopupVisible completer)
+                   (contains? completer-keys (.getKeyCode e)))
+          (let [ks (KeyStroke/getKeyStroke (.getKeyCode e) 0)
+                condition JComponent/WHEN_FOCUSED]
+            (.processKeyBinding text-area ks e condition true))
+          (.consume e))))))

 (defn create-console
   ([path]


Test that non-existent nodes 404.

Test that non-existent nodes 404.

--- test/shale/test/handler.clj
+++ test/shale/test/handler.clj
@@ -72,8 +72,12 @@
       (is-body response "[]\n")))
   (testing "non-existent sessions 404"
     (let [app (:ring-app (:app system))
-          response (app (mock/request :get (str "/sessions/" (gen-uuid))))])
-    (is-404 response)))
+          response (app (mock/request :get (str "/sessions/" (gen-uuid))))]
+      (is-404 response)))
+  (testing "non-existent nodes 404"
+    (let [app (:ring-app (:app system))
+          response (app (mock/request :get (str "/nodes/" (gen-uuid))))]
+      (is-404 response))))

 (defn refresh-nodes [app]
   (app (mock/request :post "/nodes/refresh")))


Adding a command to close tabs except current tab

--- src/lt/objs/tabs.cljs
+++ src/lt/objs/tabs.cljs
@@ -571,6 +571,15 @@
                         (doseq [obj objs]
                           (object/raise obj :close))))})

+(cmd/command {:command :tabs.close-others
+              :desc "Tab: Close tabs except current tab"
+              :exec (fn []
+                      (let [cur (active-tab)
+                            objs (object/by-tag :tabset.tab)]
+                        (doseq [obj objs]
+                          (if-not (identical? cur obj)
+                            (object/raise obj :close)))))})
+
 (cmd/command {:command :tabs.goto
               :hidden true
               :desc "Tab: Goto tab # or :last"


Default selected tab to tests if there are any since commits isn't a tab anymore.

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -645,8 +645,10 @@
    (and (:read-settings scopes)
         (build-model/in-usage-queue? build))
    :usage-queue
+   ;; If there's no SSH info, build isn't finished, show the config
+   (build-model/running? build) :config
    ;; Otherwise, just use the first one.
-   :else :commits))
+   :else :tests))

 (def tab-link :a.tab-link)


fix #43

fix #43

Former-commit-id: 6a084b0876ba819b06c8484e4dcee7f541332bfe

--- src/syng_im/chat/handlers.cljs
+++ src/syng_im/chat/handlers.cljs
@@ -8,7 +8,6 @@
             [syng-im.constants :refer [text-content-type
                                        content-type-command]]
             [syng-im.utils.random :as random]
-            [syng-im.components.react :as r]
             [syng-im.chat.sign-up :as sign-up-service]
             [syng-im.models.chats :as chats]
             [syng-im.navigation.handlers :as nav]
@@ -198,7 +197,6 @@
       ((enrich add-commands))
       ((enrich clear-input))
       ((enrich clear-staged-commands))
-      ((after (fn [_ _] (r/dismiss-keyboard!))))
       ((after send-message!))
       ((after save-message-to-realm!))
       ((after save-commands-to-realm!))


all available keys in the state

all available keys in the state

--- src/desdemona/ui/sample-data.cljs
+++ src/desdemona/ui/sample-data.cljs
@@ -1,4 +1,5 @@
-(ns desdemona.ui.sample-data)
+(ns desdemona.ui.sample-data
+  (:require [wilson.dom :as wd]))

 (def example-results
   [{:id "5719f32c7305fa39841e9a1b"
@@ -912,4 +913,8 @@
     :critical true
     :created-at "2005-03-30T11:49:32-02:00"}])

-(def sample-state {:results example-results})
+(def sample-state {:results example-results
+                   :table-toggled-ks (->
+                                     (mapcat wd/get-all-keys example-results)
+                                     distinct
+                                     wd/prepare-keys)})


better structure

better structure

--- src/didactic_waddle/sketch05.cljs
+++ src/didactic_waddle/sketch05.cljs
@@ -4,6 +4,8 @@

 (def width 100)
 (def height 100)
+(def expand 4)
+(def neighbour-width 1)
 (def hue 100)
 (def sat 200)
 (def max-b 200)
@@ -18,13 +20,16 @@
           (rand-int 2))))))

 (defn neighbouring [x y]
-  (for [dx (range -1 2)
-        dy (range -1 2)
+  (for [dx (range (- neighbour-width) (inc neighbour-width))
+        dy (range (- neighbour-width) (inc neighbour-width))
         :when (not (and (= dx 0) (= dy 0)))]
-    [(+ x dx) (+ y dy)]))
+    [dx dy]))
+
+(defn add-weight [v dx dy] v)

 (defn get-neighbours [field x y]
-  (map (fn [[x y]] (get-in field [y x] 0))
+  (map (fn [[dx dy]]
+         (add-weight (get-in field [(+ y dy) (+ x dx)] 0) dx dy))
        (neighbouring x y)))

 (defn check-spawn [v neighbours]
@@ -54,6 +59,7 @@
   (q/frame-rate 2)
   (q/background 0)
   (enable-console-print!)
+  (q/no-stroke)
   ; (q/no-loop)
   {:field (random-field width height)})

@@ -62,8 +68,8 @@

 (defn draw-dot-at [field x y]
   (let [color (to-color (get-in field [y x]))]
-    (apply q/stroke color) ; with-stroke doesn't work somehow
-    (q/point x y)
+    (apply q/fill color) ; with-stroke doesn't work somehow
+    (q/rect (* expand x) (* expand y) expand expand)
     ))

 (defn draw-state [s]
@@ -76,7 +82,7 @@

 (q/defsketch didactic-waddle
   :host "didactic-waddle"
-  :size [width height]
+  :size [(* expand width) (* expand height)]
   :setup setup
   :update update-state
   :draw draw-state


performant integration

performant integration

--- src/distributions/integration.clj
+++ src/distributions/integration.clj
@@ -1,36 +1,30 @@
 (ns distributions.integration)

+(defn expectation-mc [d n]
+  (let [draws (doall (sample d n))]
+    (fn [f]
+      (->> draws (map f) mean))))
+
+(defn expectation-qi [d n]
+  (let [delta (/ 1.0 n)
+        grid (doall (map (icdf d) (range delta 1 delta)))]
+    (fn [f]
+      (->> grid (map f) mean))))
+
 (defn expectation
-  ([h d n]
-   (mean (map h (sample d n))))
-  ([h d]
-   (expectation h d 10000)))
+  ([d & {:keys [n method]
+          :or {n 10000
+               method "monte-carlo"}}]
+   (case method
+     "monte-carlo" (expectation-mc d n)
+     "quantile-integration" (expectation-qi d n)
+     "Invalid method")))

-(defn kullback-leibler
-  ([f g n]
-   (let [h (fn [x] (- (log-pdf f x) (log-pdf g x)))]
-     (expectation h f n)))
-  ([f g]
-   (kullback-leibler f g 10000)))
-
-(defn expectation-qi
-  ([h d n]
-   (let [delta (/ 1.0 n)
-         grid (map (icdf d) (range delta 1 delta))]
-     (mean (map h grid))))
-  ([h d]
-   (expectation-qi h d 10000)))
-
-(defn kullback-leibler-qi
-  ([f g n]
-   (let [h (fn [x] (- (log-pdf f x) (log-pdf g x)))]
-     (expectation-qi h f n)))
-  ([f g]
-   (kullback-leibler-qi 10000)))
-
-(defn quantile-integrate
-  ([f d n]
-   (let [delta (/ 1.0 n)
-         grid (map (icdf d) (range delta 1 delta))
-         f_i (map f grid)]
-     (/ (reduce + 0 f_i) n))))
+(defn kullback-leibler [f & {:keys [n method]
+                             :or {n 10000
+                                  method "monte-carlo"}}]
+  (let [Ef (expectation f :n n :method method)
+        Ef-log-f (Ef #(log-pdf f %))]
+    (fn [g]
+      (let [Ef-log-g (Ef #(log-pdf g %))]
+        (- Ef-log-f Ef-log-g)))))


Code refactoring leftovers cleanup.

Code refactoring leftovers cleanup.

--- src/http/async/client/request.clj
+++ src/http/async/client/request.clj
@@ -62,44 +62,17 @@
 ;; default set of callbacks

 ;; status callbacks
-(defn accept-ok [_ status]
-  (if (not (= (:code status) 200)) :abort))
-
-(defn status-collect [state status]
-  "Stores status map under :status in state."
-  (dosync (alter state assoc :status status)))
-
-(defn status-print [state st]
-  (println (str (:id @state) "< " (:protocol st) " " (:code st) " " (:msg st))))
-
-(defn new-status-collect [_ status]
+(defn status-collect [_ status]
   "Returns all status and procides with execution"
   [status :continue])

 ;; header callbacks
-(defn headers-collect [state headers]
-  "Stores headers under :headers in state."
-  (if headers
-    (dosync (alter state assoc :headers headers))
-    (do
-      (println "Received empty headers, aborting.")
-      :abort)))
-
-(defn print-headers [state headers]
-  (doall (map #(println (str (:id @state) "< " % ": " (get headers %))) (keys headers))))
-
-(defn new-headers-collect [_ headers]
+(defn headers-collect [_ headers]
   "Reurns all headers, or aborts if no headers provided."
   [headers (if-not headers :abort)])

 ;; body callbacks
 (defn body-collect [state baos]
-  "Stores body parts under :body in state."
-  (if (:body @state)
-    (.writeTo baos (:body @state))
-    (dosync (alter state assoc :body baos))))
-
-(defn new-body-collect [state baos]
   (let [body (:body state)]
     (if (delivered? body)
       (do
@@ -109,27 +82,21 @@

 ;; completed callbacks
 (defn body-completed [state]
-  "Provides value that will be delivered to response promise."
-  @state)
-
-(defn new-body-completed [state]
   [true :continue])

 ;; error callbacks
 (defn error-collect [state t]
-  "Stores exception under :error in state"
-  (dosync (alter state assoc :error t)))
-
-(defn new-error-collect [state t]
   [t :continue])

 ;; default set of callbacks
-(def *default-callbacks*
-     {:status new-status-collect
-      :headers new-headers-collect
-      :part new-body-collect
-      :completed new-body-completed
-      :error new-error-collect})
+(def
+ ^{:doc "Default set of callbacks."}
+ *default-callbacks*
+ {:status status-collect
+  :headers headers-collect
+  :part body-collect
+  :completed body-completed
+  :error error-collect})

 (defn url-encode
   "Taken from Clojure Http Client"
@@ -256,6 +223,7 @@
        (onThrowable [#^Throwable t]
                     (do
                       (print-cause-trace t)
-                      (deliver (:error resp) (error resp t))))))
+                      (deliver (:error resp) (error resp t))
+                      (deliver (:done resp) true)))))
     ^{:started (System/currentTimeMillis)}
     resp))