Minor cosmetic changes on tests.

Minor cosmetic changes on tests.

--- frontend/test/uxbox/tests/test_main_data_shapes_impl.cljs
+++ frontend/test/uxbox/tests/test_main_data_shapes_impl.cljs
@@ -125,6 +125,8 @@
                                 3 {:id 3 :page 1}}}
         expected (assoc-in initial [:pages 1 :shapes] [1 3 2])
         result (impl/drop-shape initial 3 1 :after)]
+    ;; (pprint expected)
+    ;; (pprint result)
     (t/is (= result expected))
     (t/is (vector? (get-in result [:pages 1 :shapes])))))

@@ -286,9 +288,11 @@
                                 4 {:id 4 :page 1}}}

         shape (get-in initial [:shapes 4])
-        expected (-> initial
-                     (assoc-in [:pages 1 :shapes] [1 3])
-                     (update-in [:shapes] dissoc 4))
+        expected {:pages {1 {:id 1 :shapes [1 3]}}
+                  :shapes {1 {:id 1 :page 1 :type :group :items [2]}
+                           2 {:id 2 :page 1 :group 1}
+                           3 {:id 3 :page 1}}}
+
         result (impl/dissoc-shape initial shape)]
     ;; (pprint expected)
     ;; (pprint result)
@@ -304,38 +308,37 @@
                                 3 {:id 3 :page 1}
                                 4 {:id 4 :page 1}}}
         shape (get-in initial [:shapes 2])
-        expected (-> initial
-                     (assoc-in [:pages 1 :shapes] [3 4])
-                     (update-in [:shapes] dissoc 2)
-                     (update-in [:shapes] dissoc 1))
+        expected {:pages {1 {:id 1 :shapes [3 4]}}
+                  :shapes {3 {:id 3 :page 1}
+                           4 {:id 4 :page 1}}}
         result (impl/dissoc-shape initial shape)]
     ;; (pprint expected)
     ;; (pprint result)
     (t/is (= result expected))))

-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Group Shapes
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Group Shapes
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; group a shape
+
 (t/deftest group-shapes-1
   (let [initial {:pages {1 {:id 1 :shapes [1 2 3]}}
                  :shapes {1 {:id 1 :page 1}
                           2 {:id 2 :page 1}
                           3 {:id 3 :page 1}}}

-        expected (-> initial
-                     (assoc-in [:workspace :selected] #{4})
-                     (assoc-in [:pages 1 :shapes] [1 4 3])
-                     (assoc-in [:shapes 2 :group] 4)
-                     (assoc-in [:shapes 4] {:type :group :name "Group-1"
-                                            :items [2] :id 4 :page 1}))]
+        expected {:pages {1 {:id 1 :shapes [1 4 3]}}
+                  :shapes {1 {:id 1 :page 1}
+                           2 {:id 2 :page 1 :group 4}
+                           3 {:id 3 :page 1}
+                           4 {:type :group :name "Group-1" :items [2] :id 4 :page 1}}
+                  :workspace {:selected #{4}}}]
     (with-redefs [uxbox.util.uuid/random (constantly 4)]
       (let [result (impl/group-shapes initial [2] 1)]
         ;; (pprint expected)
         ;; (pprint result)
         (t/is (= result expected))))))
-

 ;; group two shapes

@@ -345,34 +348,32 @@
                                 2 {:id 2 :page 1}
                                 3 {:id 3 :page 1}}}

-        expected (-> initial
-                     (assoc-in [:workspace :selected] #{4})
-                     (assoc-in [:pages 1 :shapes] [1 4])
-                     (assoc-in [:shapes 2 :group] 4)
-                     (assoc-in [:shapes 3 :group] 4)
-                     (assoc-in [:shapes 4] {:type :group :name "Group-1"
-                                            :items [2 3] :id 4 :page 1}))]
+
+        expected {:pages {1 {:id 1 :shapes [1 4]}}
+                  :shapes {1 {:id 1 :page 1}
+                           2 {:id 2 :page 1 :group 4}
+                           3 {:id 3 :page 1 :group 4}
+                           4 {:type :group :name "Group-1" :items [2 3] :id 4 :page 1}}
+                  :workspace {:selected #{4}}}]
     (with-redefs [uxbox.util.uuid/random (constantly 4)]
       (let [result (impl/group-shapes initial [2 3] 1)]
         ;; (pprint expected)
         ;; (pprint result)
         (t/is (= result expected))))))

-
 ;; group group
+
 (t/deftest group-shapes-3
   (let [initial {:pages {1 {:id 1 :shapes [1 2 3]}}
                  :shapes {1 {:id 1 :page 1}
                           2 {:id 2 :page 1}
                           3 {:id 3 :page 1 :type :group}}}
-
-        expected (-> initial
-                     (assoc-in [:workspace :selected] #{4})
-                     (assoc-in [:pages 1 :shapes] [1 4])
-                     (assoc-in [:shapes 2 :group] 4)
-                     (assoc-in [:shapes 3 :group] 4)
-                     (assoc-in [:shapes 4] {:type :group :name "Group-1"
-                                            :items [2 3] :id 4 :page 1}))]
+        expected {:pages {1 {:id 1 :shapes [1 4]}}
+                  :shapes {1 {:id 1 :page 1}
+                           2 {:id 2 :page 1 :group 4}
+                           3 {:id 3 :page 1 :type :group :group 4}
+                           4 {:type :group :name "Group-1" :items [2 3] :id 4 :page 1}}
+                  :workspace {:selected #{4}}}]
     (with-redefs [uxbox.util.uuid/random (constantly 4)]
       (let [result (impl/group-shapes initial [2 3] 1)]
         ;; (pprint expected)
@@ -387,13 +388,17 @@
                           2 {:id 2 :page 1 :group 3}
                           3 {:id 3 :page 1 :type :group}}}

-        expected (-> initial
-                     (assoc-in [:workspace :selected] #{4})
-                     (assoc-in [:pages 1 :shapes] [1 3])
-                     (assoc-in [:shapes 2 :group] 4)
-                     (assoc-in [:shapes 3 :items] [4])
-                     (assoc-in [:shapes 4] {:type :group :name "Group-1"
-                                            :items [2] :id 4 :page 1 :group 3}))]
+        expected {:pages {1 {:id 1 :shapes [1 3]}}
+                  :shapes {1 {:id 1 :page 1}
+                           2 {:id 2 :page 1 :group 4}
+                           3 {:id 3 :page 1 :type :group :items [4]}
+                           4 {:type :group
+                              :name "Group-1"
+                              :items [2]
+                              :id 4
+                              :page 1
+                              :group 3}}
+                  :workspace {:selected #{4}}}]
     (with-redefs [uxbox.util.uuid/random (constantly 4)]
       (let [result (impl/group-shapes initial [2] 1)]
         ;; (pprint expected)
@@ -505,9 +510,9 @@
                           2 {:id 2 :page 1 :type :group :items [3] :group 1}
                           3 {:id 3 :page 1 :group 2}}}

-        expected {:pages {1 {:id 1, :shapes [1]}},
-                  :shapes {1 {:id 1, :page 1, :type :group, :items [3]},
-                           3 {:id 3, :page 1, :group 1}},
+        expected {:pages {1 {:id 1 :shapes [1]}}
+                  :shapes {1 {:id 1 :page 1 :type :group :items [3]}
+                           3 {:id 3 :page 1 :group 1}}
                   :workspace {:selected #{3}}}]
     (let [result (impl/degroup-shapes initial [2] 1)]
       ;; (pprint expected)
@@ -523,8 +528,8 @@
                           3 {:id 3 :page 1 :group 1}
                           4 {:id 4 :page 1 :group 2}}}

-        expected {:pages {1 {:id 1, :shapes [3 4]}},
-                  :shapes {3 {:id 3, :page 1}, 4 {:id 4, :page 1}},
+        expected {:pages {1 {:id 1 :shapes [3 4]}}
+                  :shapes {3 {:id 3 :page 1} 4 {:id 4 :page 1}}
                   :workspace {:selected #{4 3}}}]
     (let [result (impl/degroup-shapes initial [1 2] 1)]
       ;; (pprint expected)


add sortby function to the collection

add sortby function to the collection

--- src/io/perun/collection.clj
+++ src/io/perun/collection.clj
@@ -12,7 +12,9 @@
 (def ^:private
   +defaults+ {:target "public"
               :datafile "meta.edn"
-              :filterer identity})
+              :filterer identity
+              :sortby (fn [file]
+                (:date_published file))})

 (boot/deftask collection
   "Render collection files"
@@ -20,6 +22,7 @@
    d datafile DATAFILE str  "Datafile with all parsed meta information"
    r renderer RENDERER sym  "Page renderer"
    f filterer FILTER   code "Filter function"
+   s sortby   SORTBY   code "Sort by function"
    p page     PAGE     str  "Collection result page path"]
   (let [tmp (boot/temp-dir!)]
     (fn middleware [next-handler]
@@ -27,8 +30,9 @@
         (let [options (merge +defaults+ *opts*)
               files (util/read-files-defs fileset (:datafile options))
               filtered-files (filter (:filterer options) files)
+              sorted-files (sort-by (:sortby options) filtered-files)
               render-fn (resolve renderer)
-              html (render-fn filtered-files)
+              html (render-fn sorted-files)
               page-filepath (str (:target options) "/" page)]
             (util/create-file tmp page-filepath html)
           (u/info (str "Render collection " page "\n"))


Fix failure to run when plain is not given.

--- src/leiningen/midje_doc.clj
+++ src/leiningen/midje_doc.clj
@@ -52,10 +52,10 @@
   [project & args]
   (let [opts (set args)
         project (if (or (opts "plain") (check-pygmentize))
-                  (assoc-in project [:documentation :plain] true))]
-
+                  (assoc-in project [:documentation :plain] true)
+                  project)]
     (if (opts "once")
       (process-once project)
       (do
         (process-watch project)
-        (Thread/sleep 100000000000000)))))+        (Thread/sleep 100000000000000)))))


remove dead code

remove dead code

--- src/leiningen/new/migae.clj
+++ src/leiningen/new/migae.clj
@@ -177,28 +177,6 @@
       (make-servlet projname (list (str/join ":" [(pmap :appname) "request"])))
       (make-servlet projname (list (str/join ":" [(pmap :appname) "user"])))

-      ;; (doseq [s (:servlets pmap)]
-      ;;   (let [servlet (assoc s
-      ;;                   :appname (:appname pmap)
-      ;;                   :name (:name pmap)
-      ;;                   :projroot (:projroot pmap))
-      ;;         proj (name-to-path (:appname pmap))
-      ;;         toservlet (name-to-path (render-text
-      ;;                                  "src/{{appname}}/{{-servlet}}"
-      ;;                                  servlet))
-      ;;         toimpl (name-to-path (render-text
-      ;;                               "src/{{appname}}/{{-servlet}}"
-      ;;                               servlet))]
-      ;;     (binding [*dir* (.getCanonicalPath (io/file
-      ;;                                         (System/getProperty
-      ;;                                          "leiningen.original.pwd")
-      ;;                                         (:name servlet)))]
-      ;;       (->files servlet
-      ;;                [(str toservlet "_servlet.clj")
-      ;;                 (render "servlet.clj" servlet)]
-      ;;                [(str toimpl "_impl.clj")
-      ;;                 (render "servlet_impl.clj" servlet)]))))
-
       (binding [*dir* (.getPath
                        (io/file
                         (System/getProperty "leiningen.original.pwd")


No longer drain state-ch on shutdown, as this may clear shutdown trigger

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -63,8 +63,6 @@
   [{:keys [onyx.core/windows onyx.core/state-ch onyx.core/state-thread-ch] :as event}]
   (when-not (empty? windows)
     (close! state-ch)
-    ;; Drain state-ch to unblock any blocking puts
-    (while (poll! state-ch))
     (<!! state-thread-ch)))

 (s/defn start-lifecycle? [event]


Fix bootstrap.

Fix bootstrap.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -79,7 +79,7 @@

 (defn munge-apply-fn [{:keys [onyx.core/decompressed] :as event}]
   (if (seq decompressed)
-    (merge event (output-paths (p-ext/apply-fn event)))
+    (merge event (output-paths (merge event (p-ext/apply-fn event))))
     (merge event {:onyx.core/results []})))

 (defn munge-compress-batch [event]


Netty handler made sharable

Netty handler made sharable

--- src/org/spootnik/cyanite/tcp.clj
+++ src/org/spootnik/cyanite/tcp.clj
@@ -26,21 +26,22 @@

 (def ^:const new-line (byte 0x0A))

-(defn ^ChannelHandler build-handler-factory
+(defn ^ChannelHandler channel-putter
   "Returns a Netty handler."
   [response-channel]
-  (fn []
-    (proxy [ChannelInboundHandlerAdapter] []
-      (channelRead [^ChannelHandlerContext ctx ^String metric]
-        (when (not-empty metric)
-          (>!! response-channel metric)))
-      (exceptionCaught [^ChannelHandlerContext ctx ^Throwable e]
-        (if (instance? ReadTimeoutException e)
-          (.close ctx)
-          (proxy-super ctx e))))))
+  (proxy [ChannelInboundHandlerAdapter] []
+    (channelRead [^ChannelHandlerContext ctx ^String metric]
+      (when (not-empty metric)
+        (>!! response-channel metric)))
+    (exceptionCaught [^ChannelHandlerContext ctx ^Throwable e]
+      (if (instance? ReadTimeoutException e)
+        (.close ctx)
+        (proxy-super exceptionCaught ctx e)))
+    (isSharable []
+      true)))

 (defn boot-strap-server
-  [handler-factory ^Integer readtimeout]
+  [putter ^Integer readtimeout]
   (let [sd (new StringDecoder (CharsetUtil/UTF_8))]
       (doto
           (ServerBootstrap.)
@@ -53,14 +54,14 @@
                                                  [(new LineBasedFrameDecoder 2048)
                                                   sd
                                                   (new ReadTimeoutHandler readtimeout)
-                                                  (handler-factory)])))))
+                                                  putter])))))
         (.option ChannelOption/SO_BACKLOG (int 128))
         (.option ChannelOption/CONNECT_TIMEOUT_MILLIS (int 1000))
         (.childOption ChannelOption/SO_KEEPALIVE true))))

 (defn start-tcp-server
   [{:keys [port host readtimeout response-channel] :as options}]
-  (let [handler (build-handler-factory response-channel)
-        server (boot-strap-server handler readtimeout)
+  (let [putter (channel-putter response-channel)
+        server (boot-strap-server putter readtimeout)
         f (-> server (.bind port))]
     (-> f .channel .closeFuture)))


provide readable format for claims objects (#1076)

--- ssclj/jar/src/com/sixsq/slipstream/ssclj/resources/session_oidc.clj
+++ ssclj/jar/src/com/sixsq/slipstream/ssclj/resources/session_oidc.clj
@@ -98,7 +98,7 @@
                 email (:email claims)
                 roles (concat (oidc-utils/extract-roles claims)
                               (oidc-utils/extract-groups claims))]
-            (log/debug "oidc access token claims for" methodKey ":" claims)
+            (log/debug "oidc access token claims for" methodKey ":" (pr-str claims))
             (if subject
               (let [matched-user (ex/create-user-when-missing! subject email)]
                 (let [claims (cond-> (auth-internal/create-claims matched-user)
@@ -113,7 +113,7 @@
                                         :username matched-user
                                         :expiry expires)
                       {:keys [status] :as resp} (sutils/update-session session-id updated-session)]
-                  (log/debug "oidc cookie token claims for" methodKey ":" claims)
+                  (log/debug "oidc cookie token claims for" methodKey ":" (pr-str claims))
                   (if (not= status 200)
                     resp
                     (let [cookie-tuple [(sutils/cookie-name session-id) cookie]]


history: rename event-data key :browser-event? to :treat-as-browser-event?

--- examples/_common/middleware/history.cljs
+++ examples/_common/middleware/history.cljs
@@ -123,7 +123,7 @@
              (do
                (dispatch-action [::set-token token])

-               (when (or browser-event? (:browser-event? event-data))
+               (when (or browser-event? (:treat-as-browser-event? event-data))
                  (dispatch-signal [::on-enter token])))

              :else
@@ -152,7 +152,7 @@

   Sends [::on-enter token] signal to app after handling token change event initiated from browser (e.g. on clicking Back button).
   So using HistoryProtocol's replace-token/push-token would not trigger this signal.
-  You can still force sending this signal by passing {:browser-event? true} event-data to these functions."
+  You can still force sending this signal by passing {:treat-as-browser-event? true} event-data to these functions."
   [spec history]
   (-> spec
       (update :initial-model -wrap-initial-model)
@@ -174,8 +174,8 @@
   (when (-pure-click? e)
     (.preventDefault e)
     (if replace?
-      (replace-token history token {:browser-event? true})
-      (push-token history token {:browser-event? true}))))
+      (replace-token history token {:treat-as-browser-event? true})
+      (push-token history token {:treat-as-browser-event? true}))))

 (defn link
   "Link component which changes current URL without sending request to server.


Mixed case username bug fix

Mixed case username bug fix

--- src/foreclojure/register.clj
+++ src/foreclojure/register.clj
@@ -39,7 +39,7 @@
                  {:user lower-user
                   :pwd (.encryptPassword (StrongPasswordEncryptor.) pwd)
                   :email email})
-        (session/session-put! :user user)
+        (session/session-put! :user lower-user)
         (response/redirect "/"))
       (flash-error why "/register"))))


Board fns should not care about the tile's value

--- src/literate_2048/core.cljs
+++ src/literate_2048/core.cljs
@@ -31,18 +31,9 @@
   empty-board (vec (repeat (* board-order board-order) nil)))

 ;; Every time a tile is added to the board, it randomly appears in a empty
-;; square, with a value of either 2 or 4.
-
-;; It's easy to decide the value of the new tile.
-
-(defn rand-val
-  "Returns 2 most of the time, but sometimes it returns 4."
-  []
-  (if (< (rand) 0.8) 2 4))
-
-;; It's also easy to choose the empty square where the tile will be placed: get
-;; the indexes of the nil elements of the board representation, shuffle them and
-;; take the first.
+;; square. It's easy to choose what that square would be by getting the indexes
+;; of the nil elements of the board representation, shuffling them and taking
+;; the first.

 (defn nil-indexes
   "Returns a set with the indexes of the nil elements of v."
@@ -54,23 +45,23 @@
   [v]
   (-> v nil-indexes shuffle first))

-;; Finally, associate the index with a new tile in the board representation. A
-;; function that builds the tile from its value must be provided because the
-;; details about what a tile looks like aren't really important and somebody
-;; else should take care of them.
+;; Then, we associate the index with a new tile in the board representation. A
+;; function that builds the tile must be provided because the details about what
+;; a tile looks like aren't really important and somebody else should take care
+;; of them.

 (defn add-tile
   "Takes a board and returns a new one with one more tile, where tile-fn is a
-   function that will take a randomly choosen tile value and return a new tile."
+   function that returns a new tile."
   [tile-fn board]
-  (assoc board (rand-nil-index board) (tile-fn (rand-val))))
+  (assoc board (rand-nil-index board) (tile-fn)))

 ;; All the conditions are now met to build a board with two tiles, which is
 ;; necessary for the player to make the first move.

 (defn initial-board
   "Returns a board with two (random) tiles, where tile-fn is a function that
-   will take a randomly choosen tile value and return a new tile."
+   returns a new tile."
   [tile-fn]
   (let [f (partial add-tile tile-fn)]
     (-> empty-board f f)))


Clean up grammar test

Clean up grammar test

--- test/jest/grammar_test.clj
+++ test/jest/grammar_test.clj
@@ -9,22 +9,3 @@
     (is (.. ast (getChild 0) getType) (. S001HelloWordParser SALUTATION))
     (is (.. ast (getChild 1) getType) (. S001HelloWordParser ENDSYMBOL))
     ))
-
-;; CommonTree leftChild = ast.getChild(0);
-;; 16
-;;   CommonTree rightChild = ast.getChild(1);
-;; 17
-
-;; 18
-;;   //check ast structure
-;; 19
-;;   assertEquals(S001HelloWordParser.SALUTATION, leftChild.getType());
-;; 20
-;;   assertEquals(S001HelloWordParser.ENDSYMBOL, rightChild.getType());
-
-
-
-;;     (is (= ast
-;;     ))
-;; (testing "FIXME, I fail."
-;;   (is (= 0 1))))


Remove unnecessary test

Remove unnecessary test

--- test/carambar/mvn_test.clj
+++ test/carambar/mvn_test.clj
@@ -43,8 +43,6 @@
 (fact "Read dependencies"
   (dependencies pom-xml) =>  [{:artifactId "junit", :groupId "junit", :version "4.11"} {:artifactId "slf4j-api", :groupId "org.slf4j", :version "1.7.5"}])

-(fact "Mvn local repo should be initialized."
-  (str/blank? local-repo) => false)

 (with-redefs [local-repo "/m2_repo"]
   (fact "Should expand dependency path."


Show how to load a memory-store repo.

Show how to load a memory-store repo.

--- src/grafter/rdf_examples.clj
+++ src/grafter/rdf_examples.clj
@@ -18,6 +18,7 @@
 (def urban (prefixer "http://linked.glasgow.gov.uk/def/urban-assets/"))

 (defonce my-repo (-> "./tmp/grafter-sesame-store" native-store repo))
+;;(defonce my-repo (repo (memory-store)))

 (defn urban-assets-ontology [ont-uri]
   (triplify [ont-uri


add email digest job on startup

add email digest job on startup

--- src/chat/server/handler.clj
+++ src/chat/server/handler.clj
@@ -234,4 +234,6 @@
     (nrepl/start-server :port repl-port)
     (println "starting on port " port)
     (println "starting quartz scheduler")
-    (start-scheduler!)))
+    (start-scheduler!)
+    (println "scheduling email digest jobs")
+    (email-digest/add-jobs @scheduler)))


add migration to add bot schema

add migration to add bot schema

--- src/chat/server/migrate.clj
+++ src/chat/server/migrate.clj
@@ -4,6 +4,42 @@
             [clojure.string :as string]
             [clojure.set :as set]
             [clojure.edn :as edn]))
+
+(defn migrate-2016-06-08
+  "Add bot schema"
+  []
+  (d/transact db/conn
+    [{:db/ident :bot/id
+      :db/valueType :db.type/uuid
+      :db/cardinality :db.cardinality/one
+      :db/unique :db.unique/identity
+      :db/id #db/id [:db.part/db]
+      :db.install/_attribute :db.part/db}
+     {:db/ident :bot/token
+      :db/valueType :db.type/string
+      :db/cardinality :db.cardinality/one
+      :db/id #db/id [:db.part/db]
+      :db.install/_attribute :db.part/db}
+     {:db/ident :bot/name
+      :db/valueType :db.type/string
+      :db/cardinality :db.cardinality/one
+      :db/id #db/id [:db.part/db]
+      :db.install/_attribute :db.part/db}
+     {:db/ident :bot/avatar
+      :db/valueType :db.type/string
+      :db/cardinality :db.cardinality/one
+      :db/id #db/id [:db.part/db]
+      :db.install/_attribute :db.part/db}
+     {:db/ident :bot/webhook-url
+      :db/valueType :db.type/string
+      :db/cardinality :db.cardinality/one
+      :db/id #db/id [:db.part/db]
+      :db.install/_attribute :db.part/db}
+     {:db/ident :bot/group
+      :db/valueType :db.type/ref
+      :db/cardinality :db.cardinality/one
+      :db/id #db/id [:db.part/db]
+      :db.install/_attribute :db.part/db}]))

 (defn migrate-2016-06-04
   "Remove old-style extensions"


Fix nabigation events

Fix nabigation events

--- src/cljs/subman/routes.cljs
+++ src/cljs/subman/routes.cljs
@@ -8,12 +8,9 @@
   "Set value of stable search query"
   [value]
   (when-let [state (secretary/get-config :state)]
-    (when (not= (:search-query @state) value)
-      (swap! state assoc
-             :stable-search-query value
-             :search-query value)
-      (swap! state update-in
-             [:search-query-counter] inc))))
+    (swap! state assoc
+           :stable-search-query value
+           :search-query value)))

 (defn change-url!
   "Change page url"
@@ -29,7 +26,7 @@
     (secretary/dispatch! (.getToken @d/history))
     (gevents/listen @d/history history-event/NAVIGATE
                     #(when (.-isNavigation %)
-                      secretary/dispatch! (.-token %)))))
+                      (secretary/dispatch! (.-token %))))))

 (defroute main-page "/" []
           (set-search-query ""))


Fix focusing on search input

Fix focusing on search input

--- src/cljs/subman/search.cljs
+++ src/cljs/subman/search.cljs
@@ -163,10 +163,10 @@
     (update-total-count total-count)
     (init-history query)
     (init-push total-count)
-    (set-focus)
     (wait 0 #(init-autocomplete query
                                 (:languages props)
                                 (:sources props)))
+    (wait 0 set-focus)
     (render-component [components/search-page
                        query
                        results


Fix git merge remnants

Fix git merge remnants

--- src/cljs/zetawar/views.cljs
+++ src/cljs/zetawar/views.cljs
@@ -349,13 +349,10 @@

                          :unit-type.armor-type/naval
                          [:abbr {:title "Naval" :style {:cursor "inherit"}}
-<<<<<<< HEAD
                           armor-type-abbrev]

                          :unit-type.armor-type/air
                          [:abbr {:title "Air" :style {:cursor "inherit"}}
-=======
->>>>>>> 76780f8daec37cad4f438f4cd94bc310b2372cc4
                           armor-type-abbrev])]
                   [:td movement]
                   [:td (if can-capture


Started work on WC data domains.

Started work on WC data domains.

--- src/clojush/examples/wc.clj
+++ src/clojush/examples/wc.clj
@@ -199,22 +199,54 @@
     'boolean_dup))

 ;; Define test cases
-(defn random-wc-inputs
-  "Returns a list of n random inputs. Each will have size between 0 and 100."
-  [n]
-  (let [chars (map char (range 32 127))
-        max-len 100]
-    (repeatedly n
-                (fn []
-                  (apply str
-                         (repeatedly (lrand-int (inc max-len))
-                                     (fn []
-                                       (let [rand-cond (lrand)]
-                                         (cond
-                                           (< rand-cond 0.05) \tab
-                                           (< rand-cond 0.1) \newline
-                                           (< rand-cond 0.35) \space
-                                           :else (lrand-nth chars))))))))))
+(defn wc-input
+  "Makes a WC input of length len."
+  [len]
+  (apply str
+         (repeatedly len
+                     (fn []
+                       (let [rand-cond (lrand)]
+                         (cond
+                           (< rand-cond 0.05) \tab
+                           (< rand-cond 0.1) \newline
+                           (< rand-cond 0.35) \space
+                           :else (lrand-nth (map char (range 32 127)))))))))
+
+;; A list of data domains for the WC problem. Each domain is a vector containing
+;; a "set" of inputs and two integers representing how many cases from the set
+;; should be used as training and testing cases respectively. Each "set" of
+;; inputs is either a list or a function that, when called, will create a
+;; random element of the set.
+(def wc-data-domains
+  [['("", "A", " ", "\t", "\n", "5", "#", "A\n", " \n", "\t\n", "\n\n") 11 0] ;; "Special" inputs covering most base cases
+   [(fn [] (str (wc-input (lrand-int 100)) \newline)) 20 50] ;; Inputs ending in a newline
+   [(fn [] (wc-input (lrand-int 101))) 200 500] ;; Inputs that may or may not end in a newline
+   ])
+
+(defn test-and-train-data-from-domains
+  "Takes a list of domains and creates a set of train inputs and a set of test
+   inputs based on the domains. Returns [train test]. A program should not
+   be considered a solution unless it is perfect on both the train and test
+   cases."
+  [domains]
+  (apply mapv concat (map (fn [[input-set n-train n-test]]
+                            (if (fn? input-set)
+                              (vector (repeatedly n-train input-set)
+                                      (repeatedly n-test input-set))
+                              (vector (take n-train (shuffle input-set))
+                                      (take n-test (shuffle input-set)))))
+                          domains)))
+
+;;WC test data like this:
+;(test-and-train-data-from-domains wc-data-domains)
+
+;(defn random-wc-inputs
+;  "Returns a list of n random inputs. Each will have size between 0 and 100."
+;  [n]
+;  (let [chars (map char (range 32 127))
+;        max-len 100]
+;    (repeatedly n
+;                (partial wc-input (lrand-int (inc max-len))))))

 (defn wc-char-count
   "Takes a wc input and returns the char count output"
@@ -233,33 +265,33 @@
   (get (frequencies input) \newline 0))

 (defn wc-test-cases
-  "Gives n IO test cases of the form [input output-char output-word output-line]."
-  [n]
+  "Takes a sequence of inputs and gives IO test cases of the form
+   [input output-char output-word output-line]."
+  [inputs]
   (map #(vector %
                 (wc-char-count %)
                 (wc-word-count %)
                 (wc-line-count %))
-       (random-wc-inputs n)))
+       inputs))

 ;; Define error function. For now, each run uses different random inputs
 (defn wc-error-function
   "Returns the error function for the wc problem. Takes as
-   input number of test cases to use."
-  ([number-test-cases]
-    (wc-error-function number-test-cases
-                       (wc-test-cases number-test-cases)))
-  ([_ test-cases]
+   input WC data domains."
+  [data-domains]
+  (let [[train-cases test-cases] (map wc-test-cases
+                                      (test-and-train-data-from-domains wc-data-domains))]
     (fn [program]
       (flatten
         (doall
-          (for [[input out-char out-word out-line] test-cases]
+          (for [[input out-char out-word out-line] train-cases]
             (let [final-state (run-push program
                                         (->> (make-push-state)
-                                             (push-item nil :auxiliary)
-                                             (push-item nil :auxiliary)
-                                             (push-item nil :auxiliary)
-                                             (push-item input :auxiliary)
-                                             (push-item input :auxiliary)))
+                                          (push-item nil :auxiliary)
+                                          (push-item nil :auxiliary)
+                                          (push-item nil :auxiliary)
+                                          (push-item input :auxiliary)
+                                          (push-item input :auxiliary)))
                   result-char (stack-ref :auxiliary 2 final-state)
                   result-word (stack-ref :auxiliary 3 final-state)
                   result-line (stack-ref :auxiliary 4 final-state)]
@@ -280,7 +312,7 @@

 ; Define the argmap
 (def argmap
-  {:error-function (wc-error-function 50)
+  {:error-function (wc-error-function wc-data-domains)
    :atom-generators wc-atom-generators
    :max-points 200
    :max-points-in-initial-program 50


(PDB-4636) jdbc: add a bit of background regarding setIsolateInternalQueries

--- src/puppetlabs/puppetdb/jdbc.clj
+++ src/puppetlabs/puppetdb/jdbc.clj
@@ -605,6 +605,13 @@
        (.setAutoCommit false)
        (.setInitializationFailTimeout -1)
        (.setTransactionIsolation "TRANSACTION_READ_COMMITTED")
+       ;; Because we currently disable autocommit and specify
+       ;; connectionInitSql, we need to set IsolateInternalQueries to
+       ;; true because otherwise hikaricp will run our connection init
+       ;; code which issues a select without committing it, which
+       ;; causes later attempts to (for example) change the isolation
+       ;; level to fail (because the pending transaction already
+       ;; includes that select).
        (.setIsolateInternalQueries true))
      (some->> (when expected-schema
                 (block-on-schema-mismatch expected-schema))


Encode org.bson.BsonUndefined as null

Encode org.bson.BsonUndefined as null

--- src/metabase/middleware.clj
+++ src/metabase/middleware.clj
@@ -4,7 +4,7 @@
             [clojure.tools.logging :as log]
             [clojure.walk :as walk]
             (cheshire factory
-                      [generate :refer [add-encoder encode-str]])
+                      [generate :refer [add-encoder encode-str encode-nil]])
             [korma.core :as k]
             [medley.core :refer [filter-vals map-vals]]
             [metabase.api.common :refer [*current-user* *current-user-id*]]
@@ -146,6 +146,9 @@

 ;; Encode BSON IDs like strings
 (add-encoder org.bson.types.ObjectId encode-str)
+
+;; Encode BSON undefined like nil
+(add-encoder org.bson.BsonUndefined encode-nil)

 ;; serialize sql dates (i.e., QueryProcessor results) like YYYY-MM-DD instead of as a full-blown timestamp
 (add-encoder java.sql.Date (fn [^java.sql.Date date ^com.fasterxml.jackson.core.JsonGenerator json-generator]


Fix Content-Security-Policy errors on Safari

--- src/metabase/middleware.clj
+++ src/metabase/middleware.clj
@@ -142,8 +142,8 @@
                                                       :script-src  ["'unsafe-inline'"
                                                                     "'unsafe-eval'"
                                                                     "'self'"
-                                                                    "www.google-analytics.com"
-                                                                    "*.googleapis.com"
+                                                                    "https://www.google-analytics.com" ; Safari requires the protocol
+                                                                    "https://*.googleapis.com"
                                                                     "*.gstatic.com"
                                                                     "js.intercomcdn.com"
                                                                     "*.intercom.io"


Change the order of the defns

Change the order of the defns

so that all vars are known and single pass compilation works

--- src/catalog/web/views.clj
+++ src/catalog/web/views.clj
@@ -212,6 +212,27 @@
          [:td ]
          [:td ]
          [:td (pr-str errors)]]))]])
+
+
+(defn upload-full-form [request year issue & [errors]]
+  (let [identity (friend/identity request)]
+    (layout/common
+     identity
+     year issue
+     [:div.row
+      [:div.col-md-6
+       (upload-well "Upload Gesamtkatalog Hörfilm"
+                    (format "/%s/%s/%s/upload-confirm" year issue (name :hörfilm))
+                    (:hörfilm errors))]
+      [:div.col-md-6
+       (upload-well "Upload Gesamtkatalog Spiele"
+                    (format "/%s/%s/%s/upload-confirm" year issue (name :ludo))
+                    (:ludo errors))]]
+     [:div.row
+      [:div.col-md-6
+       (upload-well "Upload Gesamtkatalog Taktile Bücher"
+                    (format "/%s/%s/%s/upload-confirm" year issue (name :taktilesbuch))
+                    (:taktilesbuch errors))]])))

 (defn upload-confirm [request year issue fmt file]
   (let [{tempfile :tempfile} file
@@ -248,26 +269,6 @@
     (:hörfilm :ludo :taktilesbuch) (db/save-full-catalog! year (name fmt) (edn/read-string items))
     (db/save-catalog! year issue (edn/read-string items)))
   (response/redirect-after-post (format "/%s/%s" year issue)))
-
-(defn upload-full-form [request year issue & [errors]]
-  (let [identity (friend/identity request)]
-    (layout/common
-     identity
-     year issue
-     [:div.row
-      [:div.col-md-6
-       (upload-well "Upload Gesamtkatalog Hörfilm"
-                    (format "/%s/%s/%s/upload-confirm" year issue (name :hörfilm))
-                    (:hörfilm errors))]
-      [:div.col-md-6
-       (upload-well "Upload Gesamtkatalog Spiele"
-                    (format "/%s/%s/%s/upload-confirm" year issue (name :ludo))
-                    (:ludo errors))]]
-     [:div.row
-      [:div.col-md-6
-       (upload-well "Upload Gesamtkatalog Taktile Bücher"
-                    (format "/%s/%s/%s/upload-confirm" year issue (name :taktilesbuch))
-                    (:taktilesbuch errors))]])))

 (defn editorial-form [request fmt year issue]
   (let [identity (friend/identity request)


add helper function to shared util

add helper function to shared util

ended up not using it right now, but it'll probably be useful for condp
or similiar

--- src/chat/shared/util.cljc
+++ src/chat/shared/util.cljc
@@ -28,3 +28,9 @@
   "Checks if a tag name is valid, but not if already taken"
   [tag]
   (re-matches tag-name-re tag))
+
+(defn reversed
+  "Given a function f, return a function that passes arguments to f in the reversed order"
+  [f]
+  (fn [& args]
+    (apply f (reverse args))))


CLJS-657: Remove duplicated warning method

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -88,10 +88,6 @@
 (defmethod default-warning-handler* :protocol-deprecated
   [warning-type extra]
   (str "Protocol " (:protocol extra) " is deprecated"))
-
-(defmethod default-warning-handler* :undeclared-protocol-symbol
-  [warning-type extra]
-  (str "Can't resolve protocol symbol " (:protocol extra)))

 (defmethod default-warning-handler* :undeclared-protocol-symbol
   [warning-type extra]


* src/clj/cljs/compiler.clj: if no init, make :def emit "void 0;" to support use of declare at repl

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -343,13 +343,15 @@

 (defmethod emit :def
   [{:keys [name init env doc export]}]
-  (when init
-    (emit-comment doc (:jsdoc init))
-    (print name)
-    (print (str " = " (emits init)))
-    (when-not (= :expr (:context env)) (print ";\n"))
-    (when export
-      (println (str "goog.exportSymbol('" export "', " name ");")))))
+  (if init
+    (do
+     (emit-comment doc (:jsdoc init))
+     (print name)
+     (print (str " = " (emits init)))
+     (when-not (= :expr (:context env)) (print ";\n"))
+     (when export
+       (println (str "goog.exportSymbol('" export "', " name ");"))))
+    (println "void 0;")))

 (defn emit-apply-to
   [{:keys [name params env]}]


Convert lat/lon to Double.

Convert lat/lon to Double.

--- src/clj/forma/gfw/cdm.clj
+++ src/clj/forma/gfw/cdm.clj
@@ -105,7 +105,9 @@
 (defn latlon->tile
   [lat lon zoom]
   "Returns tile [x y zoom] corresponding to a lat/lon at the given zoom."
-  (let [alert (Alert. lat lon zoom)
+  (let [lat (Double/parseDouble lat)
+        lon (Double/parseDouble lon)
+        alert (Alert. lat lon zoom)
         tile (get-maptile alert)
         {:keys [coordinate zoom]} tile
         {:keys [x y]} coordinate]


reordering

reordering

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -176,9 +176,53 @@
   [rdr _]
   (set (read-delimited-list "}" rdr true)))

+(defn read-number
+  [reader initch]
+  (loop [buffer (gstring/StringBuffer. initch)
+         ch (read-char reader)]
+    (if (or (nil? ch) (whitespace? ch) (macro? ch))
+      (do
+        (unread reader ch)
+        (match-number (.toString buffer)))
+      (recur buffer (read-char reader)))))
+
+(defn read-string
+  [reader initch])
+
+(defn read-symbol
+  [reader initch is-recursive])
+
+(defn desugar-meta
+  [f]
+  (cond
+   (symbol? f) {:tag f}
+   (string? f) {:tag f}
+   (keyword? f) {f true}
+   :else f))
+
+(defn read-meta
+  [rdr _]
+  (let [m (desugar-meta (read rdr true nil true))]
+    (when-not (map? m)
+      (throw "Metadata must be Symbol,Keyword,String or Map"))
+    (let [o (read rdr true nil true)]
+      (if (satisfies? IWithMeta o)
+        (with-meta o (merge (meta o) m))
+        (throw "Metadata can only be applied to IWithMetas")))))
+
+#_(defn read-token
+  [rdr initch]
+  (let [sb (gsb/StringBuffer. initch)]
+    (loop [ch (read-char rdr)]
+      (if (or (nil? ch)
+              (whitespace? ch)
+              (macro-terminating? ch))
+        (do (unread rdr ch) s)
+        (recur (.append sb ch))))))
+
 (def macros
   { \" read-string
-    \; read-comment
+    \; not-implemented ;; never hit this
     \' not-implemented
     \@ not-implemented
     \^ read-meta
@@ -198,50 +242,6 @@
 (def dispatch-macros
   {"{" read-set})

-(defn read-number
-  [reader initch]
-  (loop [buffer (gstring/StringBuffer. initch)
-         ch (read-char reader)]
-    (if (or (nil? ch) (whitespace? ch) (macro? ch))
-      (do
-        (unread reader ch)
-        (match-number (.toString buffer)))
-      (recur buffer (read-char reader)))))
-
-(defn read-string
-  [reader initch])
-
-(defn read-symbol
-  [reader initch is-recursive])
-
-(defn desugar-meta
-  [f]
-  (cond
-   (symbol? f) {:tag f}
-   (string? f) {:tag f}
-   (keyword? f) {f true}
-   :else f))
-
-(defn read-meta
-  [rdr _]
-  (let [m (desugar-meta (read rdr true nil true))]
-    (when-not (map? m)
-      (throw "Metadata must be Symbol,Keyword,String or Map"))
-    (let [o (read rdr true nil true)]
-      (if (satisfies? IWithMeta o)
-        (with-meta o (merge (meta o) m))
-        (throw "Metadata can only be applied to IWithMetas")))))
-
-#_(defn read-token
-  [rdr initch]
-  (let [sb (gsb/StringBuffer. initch)]
-    (loop [ch (read-char rdr)]
-      (if (or (nil? ch)
-              (whitespace? ch)
-              (macro-terminating? ch))
-        (do (unread rdr ch) s)
-        (recur (.append sb ch))))))
-
 (defn read
   "Reads the first object from a PushbackReader. Returns the object read.
 Returns sentinel if the reader did not contain any forms."


Remove legacy fixture mechanism

Remove legacy fixture mechanism

--- src/cljs/geoforms/db.cljs
+++ src/cljs/geoforms/db.cljs
@@ -55,8 +55,6 @@
 (def ref (m/connect config/fb-uri))

 (def ideas-ref (m/get-in ref [:ideas]))
-
-(def users-ref (m/get-in ref [:users]))

 (def categories-ref (m/get-in ref [:categories]))

@@ -292,44 +290,8 @@
 (defn snippet [key]
   (get-in @app-cms [@language key]))

-;; fixtures
-
-(defn load-fixtures! [ref values]
-  (m/deref ref (fn [data] (when-not (seq data)
-                           (doseq [v values]
-                             (m/conj! ref v))))))
-
-;; (load-fixtures!
-;;  ideas-ref
-;;  [{:created-at "2013-08-10 11:20:22"
-;;    :districts  ["Brooklyn"]
-;;    :title      "New skatepark"
-;;    :desc       "Would be really nice to have a new skatepark"
-;;    :links      ["http://lapresse.ca/article-2"]
-;;    :supporters (->set-map ["email@email.com" "email2@email.com" "john@hotmail.com"])
-;;    :supporters (->set-map [])
-;;    :category   "Other..."}])
-
-;; (load-fixtures!
-;;  users-ref
-;;  [{:created-at       "2013-08-10 11:20:22"
-;;    :fullname         "Leon Talbot"
-;;    :email            "email@email.com"
-;;    :zip-code         "G21 2C5"
-;;    :age              "32"
-;;    :annual-revenue   ""
-;;    :alert-ideas?     true
-;;    :alert-volunteer? false
-;;    :alert-districts? true
-;;    :comments         ""}])
-
-;(load-fixtures!
- ;categories-ref
- ;["Shops" "Security" "Green" "Other..."])
-
-;(load-fixtures!
- ;districts-ref
- ;["Manhattan" "Brooklyn" "Queens" "Other districts"])
+
+;; auth

 (defn init-session []
   ;; TODO: to be more robust, should really handle failures here,


Remove nested threading that's unnecessary now that there's no need to update nodes-by-character

--- src/cljs/nchart/core.cljs
+++ src/cljs/nchart/core.cljs
@@ -123,13 +123,12 @@
         (let [character (first characters)
               last-node (-> new-g :last-nodes-by-character character)
               disappeared (contains? (-> node :path-mods character) :disappeared)
-              g (-> new-g
-                    (cond->
-                     disappeared (update-in [:last-nodes-by-character] dissoc character)
-                     (not disappeared) (->
-                                        (assoc-in [:last-nodes-by-character character] node)
-                                        (update-in [:last-nodes-by-node (:id node)] (fnil conj #{}) character))
-                     last-node (update-in [:last-nodes-by-node (:id last-node)] disj character)))]
+              g (cond-> new-g
+                        disappeared (update-in [:last-nodes-by-character] dissoc character)
+                        (not disappeared) (->
+                                           (assoc-in [:last-nodes-by-character character] node)
+                                           (update-in [:last-nodes-by-node (:id node)] (fnil conj #{}) character))
+                        last-node (update-in [:last-nodes-by-node (:id last-node)] disj character))]
           (recur g (rest characters)))))))


Remove debugging

Remove debugging

--- src/clojure_ruby/core.clj
+++ src/clojure_ruby/core.clj
@@ -189,7 +189,6 @@
             (recur whens)))))))

 (defn evaluate [stmt]
-  (prn stmt)
   (try
     (evaluate-one stmt)
     (catch Exception e


fix access-control-allow-origin

fix access-control-allow-origin

--- src/modus/system/webapp.clj
+++ src/modus/system/webapp.clj
@@ -54,7 +54,7 @@
           (ANY "*" []
             (ring/not-found "Not found"))))
       (wrap-authenticate-api-user-using-buddy db-conn)
-      (wrap-cors :access-control-allow-origin [#"*"]
+      (wrap-cors :access-control-allow-origin [#".+"]
                  :access-control-allow-methods [:get :put :post :delete])))

 (defrecord WebApp [routes db-conn api-web-app]


look for the correct jar name

look for the correct jar name

--- tasks/leiningen/fatdeb.clj
+++ tasks/leiningen/fatdeb.clj
@@ -83,7 +83,7 @@
     ; Jar
     (.mkdirs (file dir "usr" "lib" "riemann"))
     (copy (file (:root project) "target"
-                (str "riemann-" (get-version project) "-standalone.jar"))
+                (str "riemann-" (:version project) "-standalone.jar"))
           (file dir "usr" "lib" "riemann" "riemann.jar"))

     ; Binary


test/www.clj: removed obsolete can-get-case-text test

--- src/org/altlaw/test/www.clj
+++ src/org/altlaw/test/www.clj
@@ -56,27 +56,6 @@
     (.delete static-dir)))

-(deftest can-get-case-text
-  (let [docid (str "98765432" (rand-int 10))
-        path (str "docs/98/76/54/32/" docid "-text")
-        html-file (duck/file (context/www-public-dir) "/" path ".html")
-        dir (.getParentFile html-file)
-        html "can-get-case-file"]
-
-    ;; setup
-    (.mkdirs dir)
-    (duck/spit html-file html)
-
-    ;; Test that we get the HTML file /v1/cases/{docid}
-    (let [response (client/http-get (str "/v1/cases/" docid))]
-      (is (.isSuccess (.getStatus response)))
-      (is (= MediaType/TEXT_HTML (.getMediaType (.getEntity response))))
-      (is (= html (.getText (.getEntity response)))))
-
-    ;; cleanup
-    (.delete html-file)))
-
-
 (deftest can-get-simple-search-page
   (let [response (client/http-get (str "/v1/search"))]
     (is (.isSuccess (.getStatus response)))))


OUTPUT-UGENS is not used in the codebase

--- src/overtone/studio/rig.clj
+++ src/overtone/studio/rig.clj
@@ -173,10 +173,6 @@

 (defn clear-instruments []
   (dosync (ref-set instruments* {})))
-
-; When there is a single channel audio output add pan2 and out ugens
-; to make all instruments stereo by default.
-(def OUTPUT-UGENS #{"Out" "RecordBuf" "DiskOut" "LocalOut" "OffsetOut" "ReplaceOut" "SharedOut" "XOut"})

 (def DEFAULT-INST-VOLUME 0.6)


made all events use the new macro

made all events use the new macro

--- src/server/client-interface.cljs
+++ src/server/client-interface.cljs
@@ -57,10 +57,10 @@
 (defn connection [socket]
   (println (str "User " (.-id socket) " has connected!"))

-  (s/defevent "socket-id-change" [user-id] [a b]
-    (rooms/set-user-id (.-id socket) user-id
+  (s/defevent "socket-id-change" [new-user-id] [_ _]
+    (rooms/set-user-id (.-id socket) new-user-id
       (fn []
-        (rooms/get-room-from-user-id user-id
+        (rooms/get-room-from-user-id new-user-id
           (fn [room-id]
             (.join socket room-id
               (fn []
@@ -69,7 +69,7 @@
                     (if-not (empty? users)
                       (.emit (.to io room-id) "users-list" (clj->js users))))))))))))

-  (s/defevent "disconnect" [] [a b]
+  (s/defevent "disconnect" [] [_ _]
     (rooms/disconnect (.-id socket)
       (fn [room-id]
         (if-not (nil? room-id)
@@ -84,7 +84,7 @@
                       (println (str (.-id socket) " has disconnected from " room-id))
                       (done)))))))))))

-  (s/defevent "sign-in" [room-id username] [a b]
+  (s/defevent "sign-in" [room-id username] [_ _]
     (println (.-id socket) "sign-in as" username "in" room-id)
     (.join socket room-id
       (fn []
@@ -103,19 +103,15 @@
                   (rooms/get-all-users room-id
                     #(.emit (.to io room-id) "users-list" (clj->js %1)))))))))))

-  (s/defevent "chat-message" [room message] [a b]
-    (println "A" a)
-    (println "B" b)
+  (s/defevent "chat-message" [room message] [user-id room-id]
     (println "Received chat-message in " room "from" (.-id socket)
              "containing:" message)
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-username room user-id
-          (fn [username]
-            (.emit (.to io room) "chat-message" #js {:username username
-                                                     :message  message}))))))
-
-  (s/defevent "ready-to-start" [sound-id] [a b]
+    (rooms/get-username room user-id
+      (fn [username]
+        (.emit (.to io room) "chat-message" #js {:username username
+                                                 :message  message}))))
+
+  (s/defevent "ready-to-start" [sound-id] [user-id room-id]
     (println "Received ready-to-start signal for" sound-id
              "from" (.-id socket))
     (letfn [(convert-position [track-position-info]
@@ -139,292 +135,224 @@
                                                               (convert-position track-position-info))))
                               (.emit (.to io room) "start-track" file-url
                                                                  (convert-position track-position-info)))))))))))]
-      (rooms/get-user-id-from-socket (.-id socket)
-        (fn [user-id]
-          (rooms/get-room-from-user-id user-id
-            (fn [room]
-              (rooms/get-current-sound-id room
-                (fn [current-sound-id]
-                  (if (= sound-id current-sound-id)
-                    (rooms/client-sync room "sync-start" user-id
-                      (fn [ready?]
-                        (if ready?
-                          (rooms/has-track-started? room
-                            (fn [started?]
-                              (if started?
-                                (start-track room nil)
-                                (rooms/start-current-track room
-                                  (fn [track-position-info]
-                                    (start-track room track-position-info))))))))))))))))))
-
-  (s/defevent "pause" [position] [a b]
+      (rooms/get-current-sound-id room-id
+        (fn [current-sound-id]
+          (if (= sound-id current-sound-id)
+            (rooms/client-sync room-id "sync-start" user-id
+              (fn [ready?]
+                (if ready?
+                  (rooms/has-track-started? room-id
+                    (fn [started?]
+                      (if started?
+                        (start-track room-id nil)
+                        (rooms/start-current-track room-id
+                          (fn [track-position-info]
+                            (start-track room-id track-position-info))))))))))))))
+
+  (s/defevent "pause" [position] [user-id room-id]
     (println "Received pause signal with position" position
              "from" (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room]
-            (rooms/cooldown room "play-pause"
-              (fn [ok?]
-                (if ok?
-                  (rooms/pause-current-track room position
-                    (fn []
-                      (.emit (.to io room) "pause" position)))))))))))
-
-  (s/defevent "resume" [] [a b]
+    (rooms/cooldown room-id "play-pause"
+      (fn [ok?]
+        (if ok?
+          (rooms/pause-current-track room-id position
+            (fn []
+              (.emit (.to io room-id) "pause" position)))))))
+
+  (s/defevent "resume" [] [user-id room-id]
     (println "Received resume signal from" (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room]
-            (rooms/cooldown room "play-pause"
-              (fn [ok?]
-                (if ok?
-                  (rooms/resume-current-track room
-                    (fn []
-                      (.emit (.to io room) "resume")))))))))))
-
-  (s/defevent "position-change" [position] [a b]
+    (rooms/cooldown room-id "play-pause"
+      (fn [ok?]
+        (if ok?
+          (rooms/resume-current-track room-id
+            (fn []
+              (.emit (.to io room-id) "resume")))))))
+
+  (s/defevent "position-change" [position] [user-id room-id]
     (println "Received position-change signal with position" position
              "from" (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room]
-            (rooms/cooldown room "position-change"
-              (fn [ok?]
-                (if ok?
-                  (rooms/get-current-sound-id room
-                    (fn [sound-id]
-                      (if-not (nil? sound-id)
-                        (rooms/change-current-track-position room position
+    (rooms/cooldown room-id "position-change"
+      (fn [ok?]
+        (if ok?
+          (rooms/get-current-sound-id room-id
+            (fn [sound-id]
+              (if-not (nil? sound-id)
+                (rooms/change-current-track-position room-id position
+                  (fn []
+                    (.emit (.to io room-id) "position-change" position))))))))))
+
+  (s/defevent "start-looping" [] [user-id room-id]
+    (println "Received start-looping signal from" (.-id socket))
+    (rooms/cooldown room-id "looping"
+      (fn [ok?]
+        (if ok?
+          (rooms/start-looping room-id
+            (fn []
+              (.emit (.to io room-id) "set-loop" true)))))))
+
+  (s/defevent "stop-looping" [] [user-id room-id]
+    (println "Received stop-looping signal from" (.-id socket))
+    (rooms/cooldown room-id "looping"
+      (fn [ok?]
+        (if ok?
+          (rooms/stop-looping room-id
+            (fn []
+              (.emit (.to io room-id) "set-loop" false)))))))
+
+  (s/defevent "mute-user" [] [user-id room-id]
+    (println "Socket id " (.-id socket) " is muted!")
+    (rooms/mute-user user-id
+      (fn []
+        (.emit (.to io room-id) "user-muted" user-id))))
+
+  (s/defevent "unmute-user" [] [user-id room-id]
+    (println "Socket id " (.-id socket) " is unmuted!")
+    (rooms/unmute-user user-id
+      (fn []
+        (.emit (.to io room-id) "user-unmuted" (.-id socket)))))
+
+
+  (s/defevent "track-complete" [] [user-id room-id]
+    (println "Received track-complete signal from " (.-id socket))
+    (rooms/client-sync room-id "track-complete" user-id
+      (fn [synced?]
+        (if synced?
+          (rooms/clear-track-complete room-id
+            (fn []
+              (rooms/is-looping? room-id
+                (fn [looping?]
+                  (if looping?
+                    (rooms/set-current-track-position room-id 0
+                      (fn []
+                        (.emit (.to io room-id) "position-change" 0)))
+                    (rooms/next-track room-id
+                      (fn [track-id sound-id]
+                        (rooms/track-complete room-id
                           (fn []
-                            (.emit (.to io room) "position-change" position))))))))))))))
-
-  (s/defevent "start-looping" [] [a b]
-    (println "Received start-looping signal from" (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room]
-            (rooms/cooldown room "looping"
-              (fn [ok?]
-                (if ok?
-                  (rooms/start-looping room
+                            (if-not (nil? track-id)
+                              (rooms/clear-ready-to-start room-id
+                                (fn []
+                                  (rooms/set-waiting-to-start-flag room-id
+                                    (fn []
+                                      (.emit (.to io room-id)
+                                             "track-change"
+                                             track-id
+                                             sound-id)))))))))))))))))))
+
+  (s/defevent "track-deleted" [] [user-id room-id]
+    (println "Received track-delete signal from" (.-id socket))
+    (rooms/client-sync room-id "track-deleted" user-id
+      (fn [synced?]
+        (if synced?
+          (rooms/track-complete room-id
+            (fn []
+              (rooms/delete-client-sync room-id "track-deleted"
+                (fn []
+                  (rooms/clear-ready-to-start room-id
                     (fn []
-                      (.emit (.to io room) "set-loop" true)))))))))))
-
-  (s/defevent "stop-looping" [] [a b]
-    (println "Received stop-looping signal from" (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room]
-            (rooms/cooldown room "looping"
-              (fn [ok?]
-                (if ok?
-                  (rooms/stop-looping room
-                    (fn []
-                      (.emit (.to io room) "set-loop" false)))))))))))
-
-  (s/defevent "mute-user" [] [a b]
-    (println "Socket id " (.-id socket) " is muted!")
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/mute-user user-id
-          (fn []
-            (rooms/get-room-from-user-id user-id
-              (fn [room-id]
-                (.emit (.to io room-id) "user-muted" user-id))))))))
-
-  (s/defevent "unmute-user" [] [a b]
-    (println "Socket id " (.-id socket) " is unmuted!")
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/unmute-user user-id
-          (fn []
-            (rooms/get-room-from-user-id (.-id socket)
-              (fn [room-id]
-                (.emit (.to io room-id) "user-unmuted" (.-id socket)))))))))
-
-
-  (s/defevent "track-complete" [] [a b]
-    (println "Received track-complete signal from " (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room]
-            (rooms/client-sync room "track-complete" (.-id socket)
-              (fn [synced?]
-                (if synced?
-                  (rooms/clear-track-complete room
-                    (fn []
-                      (rooms/is-looping? room
-                        (fn [looping?]
-                          (if looping?
-                            (rooms/set-current-track-position room 0
-                              (fn []
-                                (.emit (.to io room) "position-change" 0)))
-                            (rooms/next-track room
-                              (fn [track-id sound-id]
-                                (rooms/track-complete room
-                                  (fn []
-                                    (if-not (nil? track-id)
-                                      (rooms/clear-ready-to-start room
-                                        (fn []
-                                          (rooms/set-waiting-to-start-flag room
-                                            (fn []
-                                              (.emit (.to io room)
-                                                     "track-change"
-                                                     track-id
-                                                     sound-id)))))))))))))))))))))))
-
-  (s/defevent "track-deleted" [] [a b]
-    (println "Received track-delete signal from" (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room]
-            (rooms/client-sync room "track-deleted" (.-id socket)
-              (fn [synced?]
-                (if synced?
-                  (rooms/track-complete room
-                    (fn []
-                      (rooms/delete-client-sync room "track-deleted"
+                      (rooms/clear-track-complete room-id
                         (fn []
-                          (rooms/clear-ready-to-start room
-                            (fn []
-                              (rooms/clear-track-complete room
-                                (fn []
-                                  (rooms/next-track room
-                                    (fn [track-id sound-id]
-                                      (println "next-track returned track-id:" track-id)
-                                      (if-not (nil? track-id)
-                                        (.emit (.to io room)
-                                               "track-change"
-                                               track-id
-                                               sound-id))))))))))))))))))))
-
-
-  (s/defevent "clear-songs" [] [a b]
+                          (rooms/next-track room-id
+                            (fn [track-id sound-id]
+                              (println "next-track returned track-id:" track-id)
+                              (if-not (nil? track-id)
+                                (.emit (.to io room-id)
+                                       "track-change"
+                                       track-id
+                                       sound-id))))))))))))))))
+
+
+  (s/defevent "clear-songs" [] [user-id room-id]
     (println "Received clear-songs signal from" (.-id socket))
-
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room-id]
-            (rooms/clear-songs room-id
-              (fn []
-                (.emit (.to io room-id) "clear-songs"))))))))
-
-  (s/defevent "delete-track" [track-id] [a b]
+    (rooms/clear-songs room-id
+      (fn []
+        (.emit (.to io room-id) "clear-songs"))))
+
+  (s/defevent "delete-track" [track-id] [user-id room-id]
     (println "Received delete-track signal for track-id" track-id
              "from" (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room-id]
-            (rooms/delete-track room-id track-id
-              (fn [next-track-num]
-                (rooms/set-delete-flag room-id
-                  (fn []
-                    (if-not (nil? next-track-num)
-                      (.emit (.to io room-id) "delete-track" track-id)))))))))))
-
-  (s/defevent "track-order-change" [track-id destination-track-num] [a b]
+    (rooms/delete-track room-id track-id
+      (fn [next-track-num]
+        (rooms/set-delete-flag room-id
+          (fn []
+            (if-not (nil? next-track-num)
+              (.emit (.to io room-id) "delete-track" track-id)))))))
+
+  (s/defevent "track-order-change" [track-id destination-track-num] [user-id room-id]
     (println "Track order change of track-id:" track-id
              "to track-num:" destination-track-num)
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room-id]
-            (rooms/cooldown room-id "track-order-change"
-              (fn [ok?]
-                (if ok?
-                  (rooms/change-track-order room-id track-id destination-track-num
-                    (fn [new-track-order]
-                      (.emit (.to io room-id) "track-order-change" new-track-order)))))))))))
-
-  (s/defevent "change-track" [track-num sound-id] [a b]
+    (rooms/cooldown room-id "track-order-change"
+      (fn [ok?]
+        (if ok?
+          (rooms/change-track-order room-id track-id destination-track-num
+            (fn [new-track-order]
+              (.emit (.to io room-id) "track-order-change" new-track-order)))))))
+
+  (s/defevent "change-track" [track-num sound-id] [user-id room-id]
     (println "Received change-track signal to track-num" track-num
              "with sound-id" sound-id
              "from" (.-id socket))
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-room-from-user-id user-id
-          (fn [room]
-            (rooms/cooldown room "change-track"
-              (fn [ok?]
-                (if ok?
-                  (change-track room track-num sound-id)))))))))
-
-  (s/defevent "lastfm-auth" [token] [a b]
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (lastfm/authenticate! user-id token
-          (fn [status username]
-            (if (= :success status)
-              (.emit socket "lastfm-auth" "success" username)
-              (.emit socket "lastfm-auth" "failure" nil)))))))
-
-  (s/defevent "lastfm-scrobble" [artist track] [a b]
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (lastfm/scrobble! user-id artist track))))
-
-  (s/defevent "change-upload-slots" [new-upload-slots] [a b]
+    (rooms/cooldown room-id "change-track"
+      (fn [ok?]
+        (if ok?
+          (change-track room-id track-num sound-id)))))
+
+  (s/defevent "lastfm-auth" [token] [user-id room-id]
+    (lastfm/authenticate! user-id token
+      (fn [status username]
+        (if (= :success status)
+          (.emit socket "lastfm-auth" "success" username)
+          (.emit socket "lastfm-auth" "failure" nil)))))
+
+  (s/defevent "lastfm-scrobble" [artist track] [user-id room-id]
+    (lastfm/scrobble! user-id artist track))
+
+  (s/defevent "change-upload-slots" [new-upload-slots] [user-id room-id]
     (println "Received change-upload-slots signal from" (.-id socket)
              "with value of" new-upload-slots)
     (if (and (> new-upload-slots 0)
              (<= new-upload-slots (config/data "max-upload-slots")))
       (.emit socket "upload-slots-change" new-upload-slots)))

-  (s/defevent "check-hash" [file-hash] [a b]
+  (s/defevent "check-hash" [file-hash] [user-id room-id]
     (println (.-id socket) "sent hash:" file-hash)
     (file-hash/file-hash-exists? file-hash
       (fn [file-exists?]
         (if file-exists?
-          (rooms/get-user-id-from-socket (.-id socket)
-            (fn [user-id]
-              (.emit socket "hash-found" file-hash)
-              (rooms/set-music-info-from-hash (.v4 js-uuid)
-                                              file-hash
-                                              (.-id socket)
-                (fn [music-info]
-                  (rooms/get-room-from-user-id (.-id socket)
-                    (fn [room-id]
-                      (rooms/get-track-order room-id
-                        (fn [track-order]
-                          (rooms/get-track-id-hashes room-id
-                            (fn [track-id-hashes]
-                              (.emit (.to io room-id) "upload-complete"
-                                                      (clj->js music-info)
-                                                      track-order
-                                                      track-id-hashes)))))
-                      (rooms/is-waiting-to-start? room-id
-                      (fn [waiting?]
-                        (if-not waiting?
-                          (rooms/has-track-started? room-id
-                            (fn [started?]
-                              (if-not started?
-                                (rooms/get-num-of-tracks room-id
-                                  (fn [num-of-tracks]
-                                    (change-track room-id (- num-of-tracks 1) (.v4 js-uuid))))))))))))))))
+          (do
+            (.emit socket "hash-found" file-hash)
+            (rooms/set-music-info-from-hash (.v4 js-uuid)
+                                            file-hash
+                                            (.-id socket)
+              (fn [music-info]
+                (rooms/get-track-order room-id
+                  (fn [track-order]
+                    (rooms/get-track-id-hashes room-id
+                      (fn [track-id-hashes]
+                        (.emit (.to io room-id) "upload-complete"
+                                                (clj->js music-info)
+                                                track-order
+                                                track-id-hashes)))))
+                    (rooms/is-waiting-to-start? room-id
+                    (fn [waiting?]
+                      (if-not waiting?
+                        (rooms/has-track-started? room-id
+                          (fn [started?]
+                            (if-not started?
+                              (rooms/get-num-of-tracks room-id
+                                (fn [num-of-tracks]
+                                  (change-track room-id (- num-of-tracks 1) (.v4 js-uuid)))))))))))))
           (.emit socket "hash-not-found" file-hash)))))

-  (s/defevent "cancel-upload" [id] [a b]
+  (s/defevent "cancel-upload" [id] [user-id room-id]
     (println "Received cancel-upload signal from" (.-id socket) " for id:" id)
-    (rooms/get-user-id-from-socket (.-id socket)
-      (fn [user-id]
-        (rooms/get-uploader-id id
-          (fn [uploader-id]
-            (if (= uploader-id user-id)
-              (rooms/cancel-upload id
-                (fn []
-                  (.publish redis-pub-client "cancel-upload" id)
-                  (rooms/get-room-from-user-id user-id
-                    (fn [room]
-                      (.emit (.to io room) "upload-cancelled" id)))))))))))
+    (rooms/get-uploader-id id
+      (fn [uploader-id]
+        (if (= uploader-id user-id)
+          (rooms/cancel-upload id
+            (fn []
+              (.publish redis-pub-client "cancel-upload" id)
+              (.emit (.to io room-id) "upload-cancelled" id)))))))

   (.on (new socketio-stream socket) "file-upload"
     (fn [stream original-filename file-size client-id]


Fix sample selection dropdown bug.

Fix sample selection dropdown bug.

--- sonic-jam/src/sonic_jam/core.cljs
+++ sonic-jam/src/sonic_jam/core.cljs
@@ -99,7 +99,7 @@
                    (dom/span nil "}"))
           :sample (p (dom/span #js {:onClick #(transition {:state :init})} (str "{- " (:width state) " sample ... "))
                      (apply dom/select #js {:onChange #(transition {:state :commit :sample (-> % .-target .-value)})}
-                            (map #(dom/option nil %) (om/observe owner (samples)) id))
+                            (map #(dom/option nil %) (om/observe owner (samples))))
                      (dom/span nil "}"))
           :commit (p (dom/span #js {:onClick #(transition {:state :init})}
                                (str "{- " (:width state) " sample " (:sample state) " ... "))


Assign proper type to fetched image collections.

--- frontend/src/uxbox/main/data/images.cljs
+++ frontend/src/uxbox/main/data/images.cljs
@@ -59,9 +59,9 @@
 (defrecord CollectionsFetched [items]
   rs/UpdateEvent
   (-apply-update [_ state]
-    (reduce (fn [state item]
-              (let [id (:id item)
-                    item (assoc item :type :own)]
+    (reduce (fn [state {:keys [id user] :as item}]
+              (let [type (if (uuid/zero? (:user item)) :builtin :own)
+                    item (assoc item :type type)]
                 (assoc-in state [:images-collections id] item)))
             state
             items)))


Fixing bug in annotation computation

Fixing bug in annotation computation

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/layouts/base.clj
+++ src/conexp/layouts/base.clj
@@ -191,10 +191,10 @@
     (let [uppers (upper-neighbours layout),
           lowers (lower-neighbours layout)]
       (map-by-fn (fn [node]
-                   [node [(set-to-label
-                           (apply difference (second node) (map second (uppers node))))
-                          (set-to-label
-                           (apply difference (first node) (map first (lowers node))))]])
+                   [(set-to-label
+                     (apply difference (second node) (map second (uppers node))))
+                    (set-to-label
+                     (apply difference (first node) (map first (lowers node))))])
                  (nodes layout)))))

 ;;;


Consistency commit

Consistency commit

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/io/layouts.clj
+++ src/conexp/io/layouts.clj
@@ -52,7 +52,7 @@
 ;;; Text

 (defn- seq-positions
-  "Returns a map from"
+  "Returns a map from elements of seq to their positions."
   [seq]
   (loop [seq   seq,
          index 0,
@@ -88,13 +88,18 @@
         (println (str "Attribute: " (node-number n) ", " m)))
       (println "EOF"))))

-;; todo: :text input format
+(add-layout-input-format :text
+                         (fn [_] (re-find #"^Node: " (read-line))))
+
+(define-layout-input-format :text
+  [file]
+  (unsupported-operation "Input in :text format is not yet supported."))

 ;;; FCA-style

 (define-layout-output-format :fca-style
   [layout file]
-  'to-be-done)
+  (unsupported-operation "Output in :fca-style is not yet supported."))

 ;;;


Trying to make text layout output smaller

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/io/layouts.clj
+++ src/conexp/io/layouts.clj
@@ -27,7 +27,7 @@

 (add-layout-input-format :simple
                          (fn [rdr]
-                           (= "conexp-clj simple" (.readLine rdr))))
+                           (= "conexp-clj simple" (read-line))))

 (define-layout-output-format :simple
   [layout file]
@@ -71,7 +71,8 @@
     (illegal-argument "Cannot store layout in :text format which does "
                       "not come from a concept lattice."))
   (let [nodes       (vec (keys (positions layout))),
-        node-number (comp inc (seq-positions nodes))]
+        node-number (comp inc (seq-positions nodes)),
+        annotation  (annotation layout)]
     (with-out-writer file
       ;; Node
       (doseq [n nodes]
@@ -82,11 +83,13 @@
         (println (str "Edge: " (node-number x) ", " (node-number y))))
       ;; Object
       (doseq [n nodes,
-              g (first n)]
+              g (clojure.string/split (second (annotation n)) #", ")
+              :when (not-empty g)]
         (println (str "Object: " (node-number n) ", " g)))
       ;; Attribute
       (doseq [n nodes,
-              m (second n)]
+              m (clojure.string/split (first (annotation n)) #", ")
+              :when (not-empty m)]
         (println (str "Attribute: " (node-number n) ", " m)))
       (println "EOF"))))

@@ -102,6 +105,7 @@

 (define-layout-input-format :text
   [file]
+  (unsupported-operation "Not available.")
   (let [lines (partition-by #(second (re-matches #"^([^:]*): .*$" %))
                             (line-seq (reader file)))]
     (when-not (<= (count lines) 5)


Added tests for partial-{min,max} and minimal-generating-sets

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>


Document possible efficient expected-slot mechanism

--- src/taoensso/carmine/cluster.clj
+++ src/taoensso/carmine/cluster.clj
@@ -64,7 +64,7 @@
   ;; to our handling here.

   ;; Step 3:
-  ;; Does our cache know which servers serve each of the above slots?
+  ;; Does our cache know which servers serve each of the above slots?[1]
   ;; Group requests per server + `execute-requests` in parallel with
   ;; appropriate Connections specified (will override the dynamic args).

@@ -82,4 +82,14 @@
   ;; Step 7:
   ;; Return all replies in order as a single vector (i.e. the consumer won't be
   ;; aware which nodes served which replies).
+
+  ;; [1]
+  ;; Since slots are distributed to servers in _ranges_, we can do this quite
+  ;; efficiently.
+  ;; Let's say we request a key at slot 42 and determine that it's at
+  ;; 127.0.0.1:6379 so we cache {42 <server 127.0.0.1:6379>}.
+  ;;
+  ;; Now we want a key at slot 78 but we have no idea where it is. We can scan
+  ;; our cache and find the nearest known slot to 78 and use that for our first
+  ;; attempt. So with n nodes, we'll have at most n-1 expected-slot misses.
   )


Fix warnings not being disabled on shadow-cljs (#234)

This basically just replicates the implementation of the `cljs.analyzer/no-warn` macro. Instead of changing the warning map to an empty map, it sets all warnings to `false`.

--- src/daiquiri/compiler.clj
+++ src/daiquiri/compiler.clj
@@ -44,7 +44,10 @@
   "Infer the tag of `form` using `env`."
   [env form]
   (when env
-    (let [e (with-bindings* {(requiring-resolve 'cljs.analyzer/*cljs-warnings*) {}}
+    (let [*analyzer-warnings* (requiring-resolve 'cljs.analyzer/*cljs-warnings*)
+          ;; We would want to use cljs.analyzer/no-warn here but we can't since
+          ;; it's a macro and won't work with requiring-resolve
+          e (with-bindings* {*analyzer-warnings* (zipmap (keys @*analyzer-warnings*) (repeat false))}
               (fn []
                 ((requiring-resolve 'cljs.analyzer/analyze) env form)))
           ;; Roman. Propagating Rum's component return tag


under :simple optimizations the only way to find a namespace is to use our old friend eval

--- src/main/cljs/cljs/core.cljs
+++ src/main/cljs/cljs/core.cljs
@@ -9926,11 +9926,14 @@
     :else (recur (gobject/get ctxt (first xs)) (next xs))))

 (defn find-ns-obj [ns]
-  (let [segs (-> ns str (.split "."))]
-    (case *target*
-      "nodejs"  (find-ns-obj* js/global segs)
-      "default" (find-ns-obj* js/window segs)
-      (throw (js/Error. (str "find-ns-obj not supported for target " *target*))))))
+  (let [munged-ns (munge (str ns))
+        segs (.split munged-ns ".")]
+    (if ^boolean js/COMPILED
+      (js/eval munged-ns)
+      (case *target*
+        "nodejs" (find-ns-obj* js/global segs)
+        "default" (find-ns-obj* js/window segs)
+        (throw (js/Error. (str "find-ns-obj not supported for target " *target*)))))))

 (defn ns-interns* [sym]
   (let [ns-obj (find-ns-obj sym)


goog.object/contains -> goog.object/containsKey

--- src/main/cljs/cljs/core.cljs
+++ src/main/cljs/cljs/core.cljs
@@ -9844,7 +9844,7 @@
         (symbol (str name) (str sym)) nil)))
   (findInternedVar [_ sym]
     (let [k (munge (str sym))]
-      (when (gobject/contains obj k)
+      (when (gobject/containsKey obj k)
         (Var. #(gobject/get obj k)
           (symbol (str name) (str sym)) nil))))
   (getMappings [_]


Use ring's default set of MIME types

Use ring's default set of MIME types

--- src/main/clojure/cascade.clj
+++ src/main/clojure/cascade.clj
@@ -19,7 +19,7 @@
     [java.io File FileInputStream BufferedInputStream InputStream]
     [java.util Calendar Date])
   (:require
-    [ring.util.response :as ring]
+    [ring.util [response :as ring] [mime-type :as mime-type]]
     [ring.middleware.file-info :as file-info])
   (:use
     [compojure core]
@@ -70,13 +70,6 @@
 This should only be changed at startup, by (initialize-assets)."
   (atom nil))

-(def default-file-extension-to-mime-type
-  "Default set of mappings from file extensions (as keywords) to corresponding MIME type."
-  {
-    :js "text/javascript"
-    :css "text/css"
-    })
-
 ; Should Asset extend Renderable?
 (defprotocol Asset
   "Represent a server-side resource so that it can be exposed efficiently to the client."
@@ -110,8 +103,8 @@
 (defn get-content-type [asset]
   (let [name (file-name asset)
         dotx (.lastIndexOf name ".")
-        extension (keyword (.substring name (inc dotx)))
-        content-type (-> @asset-configuration :file-extension extension)]
+        extension (.substring name (inc dotx))
+        content-type (-> @asset-configuration :file-extensions (get extension))]
     (or content-type "text/plain")))

 (defn generic-asset-handler
@@ -161,7 +154,7 @@
        :public-folder public-folder
        :virtual-folder virtual-folder
        :file-path (str root "/file/")
-       :file-extensions (merge default-file-extension-to-mime-type file-extensions)})
+       :file-extensions (merge mime-type/default-mime-types file-extensions)})
     (printf "Initialized asset access at virtual folder %s\n" root)
     (wrap-exception-handling
       (routes


Fixed set up of moderation tests

Fixed set up of moderation tests

--- test/conversation_test.clj
+++ test/conversation_test.clj
@@ -66,10 +66,12 @@

     (deftest moderation-test
       (testing "from scratch with fleshed out conv"
-        (is (:mod-out (mod-update fleshed-conv [{:tid :x}]))))
+        (is (= (:mod-out (mod-update fleshed-conv
+                                     [{:tid :x :mod -1}]))
+               (set [:x]))))
       (testing "based on previous moderations"
         (is (= (:mod-out (mod-update (assoc big-conv :mod-out [:x])
-                                     [{:tid :y}]))
+                                     [{:tid :y :mod -1}]))
                (set [:x :y]))))))

   (deftest large-conv-update-test


omit flaky test condition

omit flaky test condition

--- test/keypin/store_test.clj
+++ test/keypin/store_test.clj
@@ -84,7 +84,7 @@
       (Thread/sleep 50)
       (dotimes [_ 5000] (kfoo cs))  ; warmup
       (is (> t1 (nanos (kfoo cs))))))
-  (testing "Cache busts on underlying store changes &&&"
+  (testing "Underlying store changes &&&"
     (let [^DynamicStore ds (ks/make-dynamic-store (fn [_] {:foo "10"}) {:foo "20"})
           ^CachingStore cs (ks/make-caching-store ds)
           dyn-data  (fn [] (:store-data @(.-state-agent ds)))
@@ -101,8 +101,7 @@
         (Thread/sleep 1000)  ; wait for dynamic store 01 second refresh window to elapse
         (kfoo cs)            ; trigger fetch
         (Thread/sleep 100)   ; wait for async fetch to be over
-        (is (= 10 (kfoo cs)))
-        (is (= {} (get-cache)) "busted cache"))
+        (is (= {:foo "10"} (dyn-data)) "data refreshed"))
       (testing "after fetch"
         (is (= 10 (kfoo cs)))
         (Thread/sleep 100)   ; wait for cache-populating to be over


fix PRIVMSG tests to hopefully no longer fail intermittently

--- test/subrosa/test/chat.clj
+++ test/subrosa/test/chat.clj
@@ -9,21 +9,25 @@
     (transmit s1 "NICK dan")
     (transmit s1 "USER dan 0 * :Dan Larkin")
     (transmit s1 "JOIN #foo")
+    (is (received? s1 #"JOIN #foo"))
     (with-connection s2
       (transmit s2 "NICK dan2")
       (transmit s2 "USER dan 0 * :Dan Larkin")
       (transmit s2 "JOIN #foo")
-      (transmit s2 "PRIVMSG #foo :Hello, World!"))
+      (transmit s2 "PRIVMSG #foo :Hello, World!")
+      (Thread/sleep 1000)) ; give some time for the message to get to the server
     (is (received? s1 #"dan2!dan@.* PRIVMSG #foo :Hello, World!"))))

 (deftest basic-privmsg-to-user
   (with-connection s1
     (transmit s1 "NICK dan")
     (transmit s1 "USER dan 0 * :Dan Larkin")
+    (is (received? s1 #"Welcome to the .* dan$"))
     (with-connection s2
       (transmit s2 "NICK dan2")
       (transmit s2 "USER dan 0 * :Dan Larkin")
-      (transmit s2 "PRIVMSG dan :Hello, Dan!"))
+      (transmit s2 "PRIVMSG dan :Hello, Dan!")
+      (Thread/sleep 1000)) ; give some time for the message to get to the server
     (is (received? s1 #"dan2!dan@.* PRIVMSG dan :Hello, Dan!"))))

 (deftest privmsg-error-cases


[fix #3091] fix edit group chat contact list

--- src/status_im/ui/screens/group/edit_contacts/views.cljs
+++ src/status_im/ui/screens/group/edit_contacts/views.cljs
@@ -23,11 +23,10 @@
   [react/view {:flex 1}
    [list/flat-list {:data                      contacts
                     :enableEmptySections       true
-                    :renderRow                 (fn [contact]
+                    :render-fn                 (fn [contact]
                                                  [contact-view {:contact        contact
                                                                 :extended?      extended?
                                                                 :extend-options (extend-options contact)}])
-
                     :bounces                   false
                     :keyboardShouldPersistTaps :always
                     :footer                    list/default-footer


Add support for search options wrapped in braces.  Use this to implement optional date sorting.

E.g.: myquery AND something {sort:date}

--- src/net/dishevelled/mailindex.clj
+++ src/net/dishevelled/mailindex.clj
@@ -20,7 +20,8 @@
            (org.apache.lucene.queryParser MultiFieldQueryParser
                                           QueryParser$Operator)
            (org.apache.lucene.search BooleanClause$Occur BooleanQuery
-                                     PhraseQuery TermQuery TopDocs)
+                                     PhraseQuery TermQuery TopDocs
+                                     Sort SortField)
            (org.apache.lucene.search.highlight QueryTermExtractor)
            (org.apache.lucene.util Version))
   (:gen-class))
@@ -484,17 +485,31 @@
     query))

+(defn extract-query-options [input]
+  (let [option-fragments (re-seq #"\{([^ ]+)\}" input)
+        querystr (reduce (fn [s [option _]] (.replace s option ""))
+                         input
+                         option-fragments)]
+    [querystr
+     (into {} (map (fn [[_ option]] (vec (.split option ":" 2)))
+                   option-fragments))]))
+
+
 (defn search
   "Perform a search against `index' using `querystr'.  Returns the top
 matching documents."
-  [indexfile querystr]
+  [indexfile input]
   (let [searcher (searcher-manager/take indexfile)
-        reader (.getIndexReader searcher)]
+        reader (.getIndexReader searcher)
+        [querystr options] (extract-query-options input)]
     (try (doall (result-seq reader
                             (.search searcher
                                      (build-query querystr reader)
                                      nil
-                                     (:max-results @config))))
+                                     (:max-results @config)
+                                     (if (= (options "sort") "date")
+                                       (Sort. (SortField. "date" SortField/STRING true))
+                                       Sort/RELEVANCE))))
          (finally (searcher-manager/release indexfile searcher)))))


Remove commentsˆ

Remove commentsˆ

--- src/clj_simple_chart/ssb/diagrams/reg_koyretoy_etter_kategori.clj
+++ src/clj_simple_chart/ssb/diagrams/reg_koyretoy_etter_kategori.clj
@@ -53,21 +53,6 @@
                      :x      xx
                      :y      yy}))

-;{"EKOFISK"           blue
-; "STATFJORD"         red
-; "VALHALL"           orange
-; "GULLFAKS"          "#ffaa00"
-; "SNORRE"            "#9467bd"
-; "TROLL"             green
-; "OSEBERG"           cyan
-; "ÅSGARD"            hydro-blue
-; "HEIDRUN"           "#bcbd22"
-; "OTHERS_PRE_1990"   "#969696"
-; "OTHERS_POSTE_1990" "#a1d99b"
-; "OTHERS_POSTE_2000" "rgb(231, 186, 82)"
-; "JOHAN SVERDRUP"    dark-purple
-; "JOHAN CASTBERG"    pink}
-
 (def prop->color
   [[:personbiler brown "Personbilar"]
    [:varebiler red "Varebilar"]


needed to convert question to seq (#1062)

--- src/cljs/main/broadfcui/page/workspace/summary/library_utils.cljs
+++ src/cljs/main/broadfcui/page/workspace/summary/library_utils.cljs
@@ -75,7 +75,7 @@
 (defn validate-required [attributes questions required-attributes]
   (let [questions (reduce (fn [prev question]
                             (into prev
-                                  (if (map? question) (:items question) question)))
+                                  (if (map? question) (:items question) [question])))
                           []
                           questions)
         required-props (->> questions


CMR-298: Added support to search granule in iso-smap format.

--- src/cmr/search/results_handlers/metadata_results_handler.clj
+++ src/cmr/search/results_handlers/metadata_results_handler.clj
@@ -33,6 +33,10 @@
   [])

 (defmethod elastic-search-index/concept-type+result-format->fields [:collection :iso-smap]
+  [concept-type result-format]
+  [])
+
+(defmethod elastic-search-index/concept-type+result-format->fields [:granule :iso-smap]
   [concept-type result-format]
   [])


add comments about the accuracy of the toy ML algorithms from ch09

--- src/r_incantations/core.clj
+++ src/r_incantations/core.clj
@@ -258,9 +258,18 @@
         b-dist (euclidian-distance bx by x y)]
     (if (<= a-dist b-dist) a b)))

+
 (defn ch09-ml-toy
   "See listings 9-3 through 9-6.
-   Use r? true to use the same test selection that R generates."
+   Use r? true to use the same test selection that R generates.
+
+   FYI:
+   (incanter.stats/summary
+    (incanter.core/dataset
+     [:accuracy]
+     (take 300
+           (repeatedly r-incantations.core/ch09-ml-toy))))
+   ; => ({:col :accuracy, :min 0.8292683, :max 0.9756098, :mean 0.9070886662572523, :median 0.9024389982223511, :is-numeric true})"
   [& {:keys [r?] :or [false]}]
   (let [memproc (read-memproc-data)
         n (count (:rows memproc))
@@ -311,7 +320,9 @@
 (defn ch09-ml-toy2
   "Same Euclidian distance basis as ch09-ml-toy, but does
    leave-one-out cross-validation.
-   http://en.wikipedia.org/wiki/Cross-validation_(statistics)#Leave-one-out_cross-validation"
+   http://en.wikipedia.org/wiki/Cross-validation_(statistics)#Leave-one-out_cross-validation
+
+   FYI: accuracy is (deterministically) 0.9068826"
   []
   (let [memproc (read-memproc-data)
         n (count (:rows memproc))


deps.edn added as a project root marker

deps.edn added as a project root marker

--- src/refactor_nrepl/core.clj
+++ src/refactor_nrepl/core.clj
@@ -71,7 +71,7 @@
          start (if (fs/directory? path-or-file-in-project)
                  path-or-file-in-project
                  (fs/parent path-or-file-in-project))
-         names-at-root #{"project.clj" "build.boot" "build.gradle" "pom.xml"}
+         names-at-root #{"project.clj" "build.boot" "build.gradle" "pom.xml" "deps.edn"}
          known-root-file? (fn [^File f] (some (fn [known-root-name]
                                                 (.endsWith (.getCanonicalPath f)
                                                            known-root-name))


Equivalence for References

Equivalence for References

--- src/derive/nativestore.cljs
+++ src/derive/nativestore.cljs
@@ -57,6 +57,11 @@
   (-pr-writer [native writer opts]
     (-write writer (str "#ref [" id "]")))

+  IEquiv
+  (-equiv [ref other]
+    (and (= store (.-store other))
+         (= id (.-id other))))
+
   IReference
   (resolve-ref [_] (store id))
   (reference-id [_] id)


removing unnecessary import

removing unnecessary import

--- src/desdemona/ui/server.clj
+++ src/desdemona/ui/server.clj
@@ -1,8 +1,7 @@
 (ns desdemona.ui.server
   (:require
    [ring.middleware.defaults :refer :all]
-   [hiccup.page :refer [html5 include-js include-css]]
-   [hiccup.element :refer [javascript-tag]]))
+   [hiccup.page :refer [html5 include-js include-css]]))

 (def page
   (html5


Add --load arg to image build command

Add --load arg to image build command

This assumes you're using buildx, so that needs to be installed and set as the default builder

--- src/docker_clojure/core.clj
+++ src/docker_clojure/core.clj
@@ -149,7 +149,7 @@
         (generate-dockerfile! installer-hashes variant)

         build-cmd (remove nil? ["docker" "build" "--no-cache" "-t" image-tag
-                                "-f" dockerfile "."])]
+                                "--load" "-f" dockerfile "."])]
     (apply println "Running" build-cmd)
     (let [{:keys [out err exit]}
           (with-sh-dir build-dir (apply sh build-cmd))]


continue saving settings; rearrange widgets

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

--- plugins/DataBrowser/src/org/micromanager/browser/core.clj
+++ plugins/DataBrowser/src/org/micromanager/browser/core.clj
@@ -261,9 +261,11 @@
      :locations
        (->> @settings-window :locations :table .getModel .getDataVector
             seq (map seq) flatten)
-;     :sorted-column
-;       (->> table getRowSorter
-     }))
+     :sorted-column
+       (let [sort-key (->> table .getRowSorter .getSortKeys seq first)]
+         {:order ({SortOrder/ASCENDING 1 SortOrder/DESCENDING -1}
+                   (.getSortOrder sort-key))
+          :model-column (.getColumnName model (.getColumn sort-key))})}))

 (defn update-collection-menu [items]
   (let [menu (@browser :collection-menu)]


more collections code

more collections code

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

--- plugins/DataBrowser/src/org/micromanager/browser/core.clj
+++ plugins/DataBrowser/src/org/micromanager/browser/core.clj
@@ -19,7 +19,7 @@
            [javax.swing.table AbstractTableModel DefaultTableModel
                               TableColumn TableRowSorter]
            [javax.swing.event DocumentListener TableModelListener]
-           [java.io BufferedReader File FileReader]
+           [java.io BufferedReader File FileReader PrintWriter]
            [java.util Vector]
            [java.util.prefs Preferences]
            [java.awt Color Dimension Font Insets]
@@ -37,6 +37,8 @@
 (def settings-window (atom nil))

 (def headings (atom nil))
+
+(def collections (atom nil))

 (def prefs (.. Preferences userRoot
       (node "MMDataBrowser") (node "b3d184b1-c580-4f06-a1d9-b9cc00f12641")))
@@ -237,14 +239,13 @@

 ;; collection files

-(defn create-default-path []
-  (str (System/getProperty "user.name") ".mmdb.txt"))
-
-(defn new-collection []
-  (File. (create-default-path)))
-
-(defn read-collection-list []
-  (read-value-from-prefs prefs "collection-files"))
+(defn read-collection-map []
+  (or (read-value-from-prefs prefs "collection-files")
+      (let [name (System/getProperty "user.name")]
+        {name (.getAbsolutePath (File. (str name ".mmdb.txt")))})))
+
+(defn save-collection-map [collection-map]
+  (write-value-to-prefs prefs "collection-files" collection-map))

 (defn get-current-data-and-settings []
   (let [table (@browser :table)
@@ -262,16 +263,44 @@
        (->> @settings-window :locations :table .getModel .getDataVector
             seq (map seq) flatten)
      :sorted-column
-       (let [sort-key (->> table .getRowSorter .getSortKeys seq first)]
+       (when-let [sort-key (->> table .getRowSorter .getSortKeys seq first)]
          {:order ({SortOrder/ASCENDING 1 SortOrder/DESCENDING -1}
                    (.getSortOrder sort-key))
-          :model-column (.getColumnName model (.getColumn sort-key))})}))
-
-(defn update-collection-menu [items]
-  (let [menu (@browser :collection-menu)]
+          :model-column (.getColumnName model (.getColumn sort-key))})
+     }))
+
+(defn apply-data-and-settings [settings]
+  (let [table (@browser :table)
+        model (.getModel table)
+        {:keys [browser-model-data
+                browser-model-headings
+                window-size display-columns
+                locations sorted-column]} settings]
+    (.setDataVector model
+      (Vector. (map #(Vector. %) (:browser-model-data settings)))
+      (Vector. browser-model-headings))
+    ))
+
+(defn get-current-collection-file []
+   (->> @browser :collection-menu
+               .getSelectedItem (get @collections)))
+
+(defn save-current-data-and-settings []
+    (with-open [pr (PrintWriter. (get-current-collection-file))]
+      (write-json (get-current-data-and-settings) pr)))
+
+(defn load-data-and-settings [name]
+  (let [f (get @collections name)]
+    (apply-data-and-settings (read-json (slurp f))))
+    (.setSelectedItem (@browser :collection-menu) name))
+
+(defn update-collection-menu []
+  (let [menu (@browser :collection-menu)
+        names (sort (keys @collections))]
     (.removeAllItems menu)
-    (dorun (map #(.addItem menu %) (sort items)))
-    (.addItem menu "New...")))
+    (dorun (map #(.addItem menu %) names))
+    (.addItem menu "New...")
+    (.addItem menu "Load...")))

 ;; windows

@@ -341,10 +370,10 @@
     (.setLayout panel (SpringLayout.))
     (constrain-to-parent scroll-pane :n 32 :w 5 :s -5 :e -5
                          search-field :n 5 :w 25 :n 28 :w 200
-                         settings-button :n 5 :w 200 :n 28 :w 305
+                         settings-button :n 5 :w 405 :n 28 :w 510
                          search-label :n 5 :w 5 :n 28 :w 25
-                         collection-label :n 5 :w 310 :n 28 :w 380
-                         collection-menu :n 5 :w 380 :n 28 :w 525)
+                         collection-label :n 5 :w 205 :n 28 :w 275
+                         collection-menu :n 5 :w 275 :n 28 :w 405)
     (connect-search search-field table)
     (.setSortsOnUpdates (.getRowSorter table) true)
     (listen-to-open table)
@@ -357,11 +386,13 @@

 (defn start-browser []
   (load-mm)
+  (reset! collections (read-collection-map))
   (reset! settings-window (create-settings-window))
   (reset! browser (create-browser))
   (reset! headings tags)
   (.setModel (:table @browser) (create-table-model tags))
   (update-all-columns (.getModel (get-in @settings-window [:columns :table])))
+  (update-collection-menu)
   (add-location "/Users/arthur/qqqq")
   (.show (@browser :frame))
   browser)


make eastwood happy

make eastwood happy

--- src/oc/storage/async/bot.clj
+++ src/oc/storage/async/bot.clj
@@ -4,17 +4,7 @@
             [taoensso.timbre :as timbre]
             [schema.core :as schema]
             [oc.lib.schema :as lib-schema]
-            [oc.storage.config :as config]
-            [oc.storage.resources.entry :as entry-res]))
-
-(defn- index-of
-  "Given a collection and a function return the index that make the function truely."
-  [s f]
-  (loop [idx 0 items s]
-    (cond
-      (empty? items) nil
-      (f (first items)) idx
-      :else (recur (inc idx) (rest items)))))
+            [oc.storage.config :as config]))

 (def BotTrigger
   "All Slack bot triggers have the following properties."