round information added to tree

round information added to tree

--- src/bracketolojy/tournament.clj
+++ src/bracketolojy/tournament.clj
@@ -12,6 +12,65 @@
   (Math/round
     (/ (Math/log x)
        (Math/log 2))))
+
+(defn ->tournament-teams
+  "Transform a sequence of team data into a map of team name->tournament team data."
+  [team-data]
+  (->> team-data
+       (remove (comp nil? :seed))
+       (map #(vector (:name %) (assoc % :weight 1 :avg-pts 0 :expected-value 0)))
+       (into {})))
+
+(defn ->tournament-bracket
+  "Transforms a bracket of team names and a map of tourament team data into a bracket of tournament teams."
+  [bracket tournament-teams]
+  (walk/postwalk-replace
+    tournament-teams
+    bracket))
+
+(defn- treeify-dispatch [node]
+  (cond
+    (and (coll? node) (= (count node) 2) (map? (first node)) (map? (last node)))
+    :branch
+
+    (and (map? node) (not (contains? node :upper)) (not (contains? node :lower)))
+    :leaf))
+
+(defmulti #^{:private true} treeify
+          treeify-dispatch)
+(defmethod treeify :default [node]
+  node)
+(defmethod treeify :branch [[upper lower]]
+  {:upper upper :lower lower})
+(defmethod treeify :leaf [node]
+  {:data {:teams (list node)} :upper nil :lower nil})
+
+(defn ->tournament-tree [bracket]
+  (walk/postwalk
+    treeify
+    bracket))
+
+(defn- compute-round-dispatch [_ node]
+  (when (and (map? node) (contains? node :upper) (contains? node :lower))
+    (if (get-in node [:data :round])
+      :branch
+      :root)))
+
+(defmulti #^{:private true} compute-round
+  compute-round-dispatch)
+(defmethod compute-round :default [_ node]
+  node)
+(defmethod compute-round :branch [_ node]
+  (let [current-round (get-in node [:data :round])]
+    (-> (assoc-in node [:upper :data :round] (dec current-round))
+        (assoc-in [:lower :data :round] (dec current-round)))))
+(defmethod compute-round :root [max-rounds node]
+  (compute-round max-rounds (assoc-in node [:data :round] max-rounds)))
+
+(defn round-info [max-rounds tree]
+  (walk/prewalk
+    (partial compute-round max-rounds)
+    tree))

 (defn weighted-pairing-log5
   "Compute and update the chance that Team a and Team b will advance when playing against each other,
@@ -29,60 +88,23 @@
   (let [a-comp-b (compare (:seed a) (:seed b))
         plus (fnil + 0)]
     (vector
-     (assoc a :avg-pts (* (:weight a) (plus (when (pos? a-comp-b)
-                                              upset-pts)
-                                            pick-pts)))
-     (assoc b :avg-pts (* (:weight b) (plus (when (neg? a-comp-b)
-                                              upset-pts)
-                                            pick-pts))))))
-
-(defn ->tournament-teams
-  "Transform a sequence of team data into a map of team name->tournament team data."
-  [team-data]
-  (->> team-data
-       (remove (comp nil? :seed))
-       (map #(vector (:name %) (assoc % :weight 1 :avg-pts 0 :expected-value 0)))
-       (into {})))
-
-(defn ->tournament-bracket
-  "Transforms a bracket of team names and a map of tourament team data into a bracket of tournament teams."
-  [bracket tournament-teams]
-  (walk/postwalk-replace
-    tournament-teams
-    bracket))
-
-(defn- treeify-dispatch [node]
-  (cond
-    (and (coll? node) (= (count node) 2) (map? (first node)) (map? (last node)))
-    :branch
-
-    (and (map? node) (not (contains? node :upper)) (not (contains? node :lower)))
-    :leaf))
-
-(defmulti #^{:private true} treeify
-  treeify-dispatch)
-(defmethod treeify :default [node]
-  node)
-(defmethod treeify :branch [[upper lower]]
-  {:upper upper :lower lower})
-(defmethod treeify :leaf [node]
-  {:data {:teams (list node)} :upper nil :lower nil})
-
-(defn ->tournament-tree [bracket]
-  (walk/postwalk
-    treeify
-    bracket))
+      (assoc a :avg-pts (* (:weight a) (plus (when (pos? a-comp-b)
+                                               upset-pts)
+                                             pick-pts)))
+      (assoc b :avg-pts (* (:weight b) (plus (when (neg? a-comp-b)
+                                               upset-pts)
+                                             pick-pts))))))

 (defmulti #^{:private true} compute-matchup
-  "Compute a matchup.  The first argument is an associative structure that gives the points per a correct pick
-  for each round.  The second argument is an associative structure that gives the points per an upset pick for each
-  round.  The third and final argument is the matchup data to perform the computation on."
-  (fn [_ _ field]
-    (cond
-      (and (coll? field) (= (count field) 2) (map? (first field)) (map? (last field)))
-      :leaf
-      (and (coll? field) (= (count field) 2) (coll? (first field)) (coll? (last field)))
-      :branch)))
+          "Compute a matchup.  The first argument is an associative structure that gives the points per a correct pick
+          for each round.  The second argument is an associative structure that gives the points per an upset pick for each
+          round.  The third and final argument is the matchup data to perform the computation on."
+          (fn [_ _ field]
+            (cond
+              (and (coll? field) (= (count field) 2) (map? (first field)) (map? (last field)))
+              :leaf
+              (and (coll? field) (= (count field) 2) (coll? (first field)) (coll? (last field)))
+              :branch)))
 (defmethod compute-matchup :default [_ _ matchup]
   matchup)
 (defmethod compute-matchup :branch [pick-pts-fn upset-pts-fn [[upper-field] [lower-field] :as fields]]
@@ -95,10 +117,10 @@
       (mapcat (partial apply weighted-pairing-pts pick-pts upset-pts)) ;calculate expected pts per game
       (reduce                                               ;aggregate game results together
         #(let [name (:name %2)]
-            (if (contains? %1 name)
-              (-> (update-in %1 [name :weight] + (:weight %2))
-                  (update-in [name :avg-pts] + (:avg-pts %2)))
-              (assoc %1 name %2)))
+          (if (contains? %1 name)
+            (-> (update-in %1 [name :weight] + (:weight %2))
+                (update-in [name :avg-pts] + (:avg-pts %2)))
+            (assoc %1 name %2)))
         {})
       vals                                                  ;get the aggregation
       (#(vector % fields)))))                               ;preserve the tree
@@ -123,8 +145,8 @@
   (vector
     (map
       #(update-in % [:expected-value] (fnil + 0 0)
-        (get-in parent-team-map [(:name %) :expected-value])
-        (:avg-pts %))
+                  (get-in parent-team-map [(:name %) :expected-value])
+                  (:avg-pts %))
       field)
     children))

@@ -174,4 +196,5 @@
     (->tournament-bracket
       bracket
       (->tournament-teams team-data))
-    ->tournament-tree))+    ->tournament-tree
+    (round-info 7)))


Adds try catch around recaptcha check answer.

--- src/cadence/model/recaptcha.clj
+++ src/cadence/model/recaptcha.clj
@@ -7,7 +7,7 @@
 (def ^:dynamic *recaptcha*
   (let [rconf (:recaptcha config/tokens)]
     (ReCaptchaFactory/newReCaptcha
-      (:public-key rconf) (:private-key rconf) false)))
+      (:public-key rconf) (:private-key rconf) true)))

 (defn get-html
   "Returns the html to show the recaptcha."
@@ -20,10 +20,17 @@
     ^String challenge
     ^String response]
    (let [req (ring-request)]
-     (-> (.checkAnswer recap
-                       (get req :remote-addr)
-                       challenge response)
-       (.isValid))))
+     (try (->
+            (.checkAnswer recap
+                          (get req :remote-addr)
+                          challenge response)
+            (.isValid))
+       (catch NullPointerException e
+         ;; TODO Replace with logging
+         (println "Issue with recaptcha answer checking: " (.getMessage e))
+         (println "\tChallenge,Response: " (str challenge "," response))
+         ;; Return false since we were not able to check.
+         false))))
   ([^String challenge
     ^String response] (check *recaptcha* challenge response)))


Fix DB details key name for SQL Server :yum: #1481

--- src/metabase/driver/sqlserver.clj
+++ src/metabase/driver/sqlserver.clj
@@ -119,9 +119,9 @@
                                                 :display-name "Port"
                                                 :type         :integer
                                                 :default      1433}
-                                               {:name         "dbname"
+                                               {:name         "db"
                                                 :display-name "Database name"
-                                                :placeholder  "birds_of_the_word"
+                                                :placeholder  "BirdsOfTheWorld"
                                                 :required     true}
                                                {:name         "user"
                                                 :display-name "Database username"


Show duration

Show duration

--- src/whisper2cyanite/core.clj
+++ src/whisper2cyanite/core.clj
@@ -331,7 +331,9 @@
                       (.toFormatter))
         duration-pp (.print formatter (.toPeriod interval))
         duration-sec (.getSeconds (.toStandardSeconds (.toDuration interval)))
-        duration-str (format "Duration: %ss (%s)" duration-sec duration-pp)]
+        duration-str (format "Duration: %ss%s" duration-sec
+                             (if (duration-sec > 59)
+                               (format " (%s)" duration-pp) ""))]
     (log/info duration-str)
     (newline)
     (println duration-str)))


fix integration test and clean up tokens (#802)

--- waiter/integration/waiter/authentication_test.clj
+++ waiter/integration/waiter/authentication_test.clj
@@ -17,14 +17,17 @@
                                                       :run-as-user (retrieve-username)
                                                       :token token)
                                                     :authentication))]
-        (assert-response-status response 200)
-        (let [{:keys [service-id body]} (make-request-with-debug-info
+        (try
+          (assert-response-status response 200)
+          (let [{:keys [service-id body]} (make-request-with-debug-info
                                           {:x-waiter-token token}
                                           #(make-kitchen-request waiter-url % :path "/request-info"))
-              body-json (json/read-str (str body))]
-          (with-service-cleanup
-            service-id
-            (is (= (retrieve-username) (get-in body-json ["headers" "x-waiter-auth-principal"])))))))))
+                body-json (json/read-str (str body))]
+            (with-service-cleanup
+              service-id
+              (is (= (retrieve-username) (get-in body-json ["headers" "x-waiter-auth-principal"])))))
+          (finally
+            (delete-token-and-assert waiter-url token)))))))

 (deftest ^:parallel ^:integration-fast test-token-authentication-parameter-error
   (testing-using-waiter-url
@@ -100,46 +103,49 @@
 (deftest ^:parallel ^:integration-fast ^:explicit test-saml-authentication
   (testing-using-waiter-url
     (when (supports-saml-authentication? waiter-url)
-      (let [auth-principal (or (System/getenv "SAML_AUTH_USER") (retrieve-username))
-            token (rand-name)
+      (let [token (rand-name)
             response (post-token waiter-url (-> (kitchen-params)
                                               (assoc
                                                 :authentication "saml"
                                                 :name token
                                                 :permitted-user "*"
                                                 :run-as-user (retrieve-username)
-                                                :token token)))
-            _ (assert-response-status response 200)
-            {:keys [headers] :as response} (make-request waiter-url "/request-info" :headers {:x-waiter-token token})
-            _ (assert-response-status response 302)
-            saml-redirect-location (get headers "location")
-            saml-authentication-fn (if use-spnego perform-saml-authentication-kerberos perform-saml-authentication)
-            {:keys [relay-state saml-response waiter-saml-acs-endpoint]} (saml-authentication-fn saml-redirect-location)
-            {:keys [body]} (make-request waiter-saml-acs-endpoint ""
-                                         :body (str "SAMLResponse=" (URLEncoder/encode saml-response) "&RelayState=" (URLEncoder/encode relay-state))
-                                         :headers {"content-type" "application/x-www-form-urlencoded"}
-                                         :method :post)
-            {:keys [waiter-saml-auth-redirect-endpoint saml-auth-data]}
-            (reaver/extract (reaver/parse body) [:waiter-saml-auth-redirect-endpoint :saml-auth-data]
-                            "form" (reaver/attr :action)
-                            "form input[name=saml-auth-data]" (reaver/attr :value))
-            _ (is (= (str "http://" waiter-url "/waiter-auth/saml/auth-redirect") waiter-saml-auth-redirect-endpoint))
-            {:keys [cookies headers] :as response} (make-request waiter-url "/waiter-auth/saml/auth-redirect"
-                                                                 :body (str "saml-auth-data=" (URLEncoder/encode saml-auth-data))
-                                                                 :headers {"content-type" "application/x-www-form-urlencoded"}
-                                                                 :method :post)
-            _ (assert-response-status response 303)
-            cookie-fn (fn [cookies name] (some #(when (= name (:name %)) %) cookies))
-            auth-cookie (cookie-fn cookies "x-waiter-auth")
-            _ (is (not (nil? auth-cookie)))
-            _ (is (> (:max-age auth-cookie) (-> 1 t/hour t/in-seconds)))
-            _ (is (= (str "http://" waiter-url "/request-info") (get headers "location")))
-            {:keys [body service-id] :as response} (make-request-with-debug-info
-                                                     {:x-waiter-token token}
-                                                     #(make-request waiter-url "/request-info" :headers % :cookies cookies))
-            _ (assert-response-status response 200)
-            body-json (json/read-str (str body))]
-        (with-service-cleanup
-          service-id
-          (is (= auth-principal (get-in body-json ["headers" "x-waiter-auth-principal"]))))))))
+                                                :token token)))]
+        (assert-response-status response 200)
+        (try
+          (let [auth-principal (or (System/getenv "SAML_AUTH_USER") (retrieve-username))
+                {:keys [headers] :as response} (make-request waiter-url "/request-info" :headers {:x-waiter-token token})
+                _ (assert-response-status response 302)
+                saml-redirect-location (get headers "location")
+                saml-authentication-fn (if use-spnego perform-saml-authentication-kerberos perform-saml-authentication)
+                {:keys [relay-state saml-response waiter-saml-acs-endpoint]} (saml-authentication-fn saml-redirect-location)
+                {:keys [body]} (make-request waiter-saml-acs-endpoint ""
+                                             :body (str "SAMLResponse=" (URLEncoder/encode saml-response) "&RelayState=" (URLEncoder/encode relay-state))
+                                             :headers {"content-type" "application/x-www-form-urlencoded"}
+                                             :method :post)
+                {:keys [waiter-saml-auth-redirect-endpoint saml-auth-data]}
+                (reaver/extract (reaver/parse body) [:waiter-saml-auth-redirect-endpoint :saml-auth-data]
+                                "form" (reaver/attr :action)
+                                "form input[name=saml-auth-data]" (reaver/attr :value))
+                _ (is (= (str "http://" waiter-url "/waiter-auth/saml/auth-redirect") waiter-saml-auth-redirect-endpoint))
+                {:keys [cookies headers] :as response} (make-request waiter-url "/waiter-auth/saml/auth-redirect"
+                                                                     :body (str "saml-auth-data=" (URLEncoder/encode saml-auth-data))
+                                                                     :headers {"content-type" "application/x-www-form-urlencoded"}
+                                                                     :method :post)
+                _ (assert-response-status response 303)
+                cookie-fn (fn [cookies name] (some #(when (= name (:name %)) %) cookies))
+                auth-cookie (cookie-fn cookies "x-waiter-auth")
+                _ (is (not (nil? auth-cookie)))
+                _ (is (> (:max-age auth-cookie) (-> 1 t/hours t/in-seconds)))
+                _ (is (= (str "http://" waiter-url "/request-info") (get headers "location")))
+                {:keys [body service-id] :as response} (make-request-with-debug-info
+                                                         {:x-waiter-token token}
+                                                         #(make-request waiter-url "/request-info" :headers % :cookies cookies))
+                _ (assert-response-status response 200)
+                body-json (json/read-str (str body))]
+            (with-service-cleanup
+              service-id
+              (is (= auth-principal (get-in body-json ["headers" "x-waiter-auth-principal"])))))
+          (finally
+            (delete-token-and-assert waiter-url token)))))))


import

import

--- src/clj/scrabble/generators.clj
+++ src/clj/scrabble/generators.clj
@@ -1,13 +1,13 @@
 (ns scrabble.generators
   (:require [clojure.test.check.generators :as gen]
             [clojure.string :as str]
-            [clojure.test.check.properties :as prop]))
+            [scrabble.constants :as constants]))

 (defn max-frequency [char max-els]
   (fn [word] (<= (get (frequencies word) char 0) max-els)))

 ;; just take the list of letters per language and use that to generate all the constraints instead
-(def jolly-check (max-frequency scrabble.constants/JOLLY-CHAR 2))
+(def jolly-check (max-frequency constants/JOLLY-CHAR 2))

 ;; make this more flexible for example could pass things like
 ;; - ratio of vowels to consonants
@@ -19,6 +19,6 @@
   (gen/fmap str/join
             (gen/such-that jolly-check
                            (gen/vector
-                            (gen/elements (:english scrabble.constants/ALPHABET)) 1 scrabble.constants/MAX-LETTERS))))
+                            (gen/elements (:english constants/ALPHABET)) 1 constants/MAX-LETTERS))))

 ;; (gen/sample chars-available-generator)


allow nil user and entity references

allow nil user and entity references

--- src/clj_money/serialization.clj
+++ src/clj_money/serialization.clj
@@ -19,7 +19,8 @@
   [context email]
   (->> context
        :users
-       (filter #(= email (:email %)))
+       (filter #(or (nil? email)
+                    (= email (:email %))))
        first))

 (defn- resolve-user
@@ -40,7 +41,8 @@
   [context entity-name]
   (->> context
        :entities
-       (filter #(= (:name %) entity-name))
+       (filter #(or (nil? entity-name)
+                    (= (:name %) entity-name)))
        first))

 (defn- resolve-entity


resolve default commodity ids before creating accounts

--- src/clj_money/serialization.clj
+++ src/clj_money/serialization.clj
@@ -387,9 +387,9 @@
       (realize-images s)
       (realize-imports s)
       (realize-entities s)
-      (realize-accounts s)
       (realize-commodities s)
       (resolve-default-commodity-ids s)
+      (realize-accounts s)
       (realize-prices s)
       (realize-lots s)
       (realize-lot-transactions s)


main.cljs - Add 'test' code

main.cljs - Add 'test' code

This is code we use to check if things are working. It'd seem very
dishonest not to add this in and leave anyone who happens to be browsing
the history of this repository confused.

So here's a slightly more honest picture of how things are like at the
moment. There's more tidying up I need to do, especially with regards to
building the repository.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/main.cljs
+++ src/cljs/cljs_nusmods/main.cljs
@@ -366,4 +366,42 @@
            (initialize-exhibit3 MODULES AUXMODULES)))

     ; Retrieve Exhibit 3.0 Library
-    (getScript "js/vendor/exhibit3-all.min.js" (fn []))))
+    (getScript "js/vendor/exhibit3-all.min.js" (fn []))
+
+    ; Test code - remove when appropriate
+    (let [ModulesMap (aget js/window "ModulesMap")
+          c1 (timetable/get-next-lesson-bg-color-css-class)
+          c2 (timetable/get-next-lesson-bg-color-css-class)
+          c3 (timetable/get-next-lesson-bg-color-css-class)
+          c4 (timetable/get-next-lesson-bg-color-css-class)
+          c5 (timetable/get-next-lesson-bg-color-css-class)
+          c6 (timetable/get-next-lesson-bg-color-css-class)
+          c7 (timetable/get-next-lesson-bg-color-css-class)]
+      ; Wednesday 1000 - 1200; Row 0
+      (timetable/add-module-lesson-group "ACC1002" "LECTURE" "V1" c1 ModulesMap)
+      ; Tuesday 1000 - 1200; Row 0
+      (timetable/add-module-lesson-group "ACC1002" "TUTORIAL" "V01" c1 ModulesMap)
+      ; Tuesday 1000- 1300; Row 1
+      (timetable/add-module-lesson-group "CS1010" "SECTIONAL TEACHING" "1" c2 ModulesMap)
+      ; Friday 1000 - 1200; Row 0
+      (timetable/add-module-lesson-group "CS1010" "TUTORIAL" "1" c2 ModulesMap)
+      ; Thursday 1000 - 1200; Row 0
+      (timetable/add-module-lesson-group "CS1020" "LABORATORY" "1" c3 ModulesMap)
+      ; Tuesday 1000 - 1200; Row 2
+      (timetable/add-module-lesson-group "CS1020" "SECTIONAL TEACHING" "1" c3 ModulesMap)
+      ; Friday 1000 - 1100; Row 1
+      (timetable/add-module-lesson-group "CS1020" "TUTORIAL" "2" c3 ModulesMap)
+      ; Monday 1000 - 1200; Row 0
+      (timetable/add-module-lesson-group "CM1121" "LECTURE" "SL1" c4 ModulesMap)
+      ; Thursday 1000 - 1200; Row 1
+      (timetable/add-module-lesson-group "CM1121" "TUTORIAL" "TH1" c4 ModulesMap)
+      ; Monday 1900 - 2200; Row 0
+      (timetable/add-module-lesson-group "BPS5103" "LECTURE" "1" c5 ModulesMap)
+      ; Tuesday 0900 - 1530; Row 3
+      (timetable/add-module-lesson-group "BPS5103" "TUTORIAL" "1" c5 ModulesMap)
+      ; Monday 1400 - 1700; Row 0
+      (timetable/add-module-lesson-group "AR4223" "LECTURE" "1" c6 ModulesMap)
+      ; Monday 0900 - 1200; Row 1
+      (timetable/add-module-lesson-group "AR4223" "TUTORIAL" "1" c6 ModulesMap)
+      ; Monday 1100 - 1400; Row 2
+      (timetable/add-module-lesson-group "DSC3226" "SECTIONAL TEACHING" "Z1" c7 ModulesMap))))


Story list updates

Story list updates

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -61,17 +61,25 @@
 (defn story-list-item [id]
   (let [data (base/id->atom id)]
     (fn [id]
-      (let [{:keys [id by title score]} @data]
-        (when id
-          [:li
-           [:p [:a {:href (str "/#/items/" id)} title] " * " score]
-           [:p "By: " by]])))))
+      (let [{:keys [by title score]} @data]
+        (when (every? identity [by title score])
+          [:div
+           [:p [:a {:href (str "/#/items/" id)} title]]
+           [:p (str score " points by " by)
+            [:span {:on-click #(reset-item-sync! id app-state [:current-item])
+                    :style {:cursor :pointer}}
+             [:i " Preview "]]]])))))

 (defn top-stories [state]
-  (let [{top-stories :top-stories} state]
+  (let [{top-stories :top-stories} state
+        selected-story (get-in state [:current-item :item])]
     [:ul
      (for [id (vec top-stories)]
-       ^{:key id} [story-list-item id])]))
+       (if (= id (:id selected-story))
+         ^{:key id} [:li
+                     [story-list-item id]
+                     [story selected-story]]
+         ^{:key id} [:li [story-list-item id]]))]))

 ;; -------------------------
 ;; Views


Catch-all route and initial dispatch

Catch-all route and initial dispatch

--- src/cljs/openslack/routing.cljs
+++ src/cljs/openslack/routing.cljs
@@ -4,6 +4,28 @@
             [openslack.state :as st]
             [secretary.core :as secretary :refer-macros [defroute]])
   (:import goog.History))
+
+;; History
+
+(def history (History.))
+
+(defn navigate
+  [token]
+  (.setToken history token))
+
+
+(defn start-history!
+  []
+  ;; Config routing
+  (secretary/set-config! :prefix "#")
+  ;; Listen for navigate
+  (go
+    (let [event (<! (events/listen history "navigate"))]
+      (secretary/dispatch! (.-token event))))
+  ;; Enable history
+  (.setEnabled history true)
+  ;; Dispacth initial route
+  (secretary/dispatch! (.getToken history)))

 ;; Routes

@@ -15,30 +37,12 @@

 (defroute room-route "/room/:jid" [jid]
   ; TODO: validate jid
-  (swap! st/state assoc :page {:name :room
-                                  :jid jid}))
+  (swap! st/state assoc :page {:name :room, :jid jid}))

 (defroute contact-route "/contact/:jid" [jid]
   ; TODO: validate jid
-  (swap! st/state assoc :page {:name :contact
-                                  :jid jid}))
+  (swap! st/state assoc :page {:name :contact, :jid jid}))

-;; Start history
-
-(defn navigate
-  [route]
-  (secretary/dispatch! route))
-
-(defn start-history!
-  []
-  (let [history (History.)]
-    ;; Config routing
-    (secretary/set-config! :prefix "#")
-    ;; Listen for navigate
-    (go
-      (let [event (<! (events/listen history "navigate"))]
-        (secretary/dispatch! (.-token event))))
-    ;; Enable history
-    (.setEnabled history true)
-    ;; Dispacth initial route
-    (secretary/dispatch! (.getToken history))))
+(defroute catch-all-route "*" []
+  ; FIXME: invalid route
+  (navigate ""))


count a seq

count a seq

--- src/cljs/pain_tetris/turns.cljs
+++ src/cljs/pain_tetris/turns.cljs
@@ -63,7 +63,7 @@
     (do
       (swap! points (partial + (* (count rows-full)
                                   (count rows-full))))
-      (when (and (even? count) (> (count rows-full) 0))
+      (when (and (even? (count rows-full)) (> (count rows-full) 0))
         (swap! block-speed inc)
         (start-game @block-speed))
       (swap! grid (partial g/clear-full-rows))


Added GROUP BY to db/util (#50)

Added GROUP BY to db/util (#50)

--- src/yetibot/core/db/util.clj
+++ src/yetibot/core/db/util.clj
@@ -96,6 +96,7 @@
           where-clause :where/clause
           where-args :where/args
           ;; optional
+          group-clause :group/clause
           order-clause :order/clause
           offset-clause :offset/clause
           limit-clause :limit/clause
@@ -111,6 +112,7 @@
                     [(str "SELECT " select-clause
                           " FROM " (qualified-table-name table)
                           (when-not (blank? where-clause) (str " WHERE " where-clause))
+                          (when group-clause (str " GROUP BY " group-clause))
                           (when order-clause (str " ORDER BY " order-clause))
                           (when offset-clause (str " OFFSET " offset-clause))
                           (when limit-clause (str " LIMIT " limit-clause)))]


swap-pair! no longer required by bookkeeper impl

--- src/onyx/state/log/bookkeeper.clj
+++ src/onyx/state/log/bookkeeper.clj
@@ -49,7 +49,6 @@
 (defn password [peer-opts]
   (.getBytes ^String (arg-or-default :onyx.bookkeeper/ledger-password peer-opts)))

-
 (defn new-ledger ^LedgerHandle [client peer-opts]
   (let [ensemble-size (arg-or-default :onyx.bookkeeper/ledger-ensemble-size peer-opts)
         quorum-size (arg-or-default :onyx.bookkeeper/ledger-quorum-size peer-opts)]
@@ -60,20 +59,6 @@
   (reify AsyncCallback$AddCallback
     (addComplete [this rc lh entry-id callback-fn]
       (callback-fn))))
-
-;; Adapted from Prismatic Plumbing:
-;; https://github.com/Prismatic/plumbing/blob/c53ba5d0adf92ec1e25c9ab3b545434f47bc4156/src/plumbing/core.cljx#L346-L361
-(defn swap-pair!
-  "Like swap! but returns a pair [old-val new-val]"
-  ([a f]
-     (loop []
-       (let [old-val @a
-             new-val (f old-val)]
-         (if (compare-and-set! a old-val new-val)
-           [old-val new-val]
-           (recur)))))
-  ([a f & args]
-     (swap-pair! a #(apply f % args))))

 (defn compaction-transition
   "Transitions to a new compacted ledger, plus a newly created ledger created


fix output from "buildcca" subcommand

fix output from "buildcca" subcommand

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/subcommands/buildcca.clj
+++ src/obcc/subcommands/buildcca.clj
@@ -36,6 +36,6 @@

     (dar.unpack/unpack index workingdir :false)
     (let [config (config.util/load workingdir)]
-      (println "Building " file)
+      (println "Building CCA" (.getAbsolutePath file))
       (build.core/compile workingdir config output)
       (fileutils/recursive-delete (io/file workingdir)))))


(PDB-5548) Log just before/after partition drop

...so that we'll provide information about exactly when it happened
and how long it took.  Place the log messages so that the "before"
message also indicates that the gc bulldozer has its connection.

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -1603,7 +1603,11 @@
       (try
         (.start gc-bulldozer)
         (when @bulldozer-connected
-          (drop-one candidate))
+          ;; This log message also provides evidence the bulldozer has
+          ;; acquired its connection.
+          (log/info (trs "Partition GC dropping partition {0}" candidate))
+          (drop-one candidate)
+          (log/info (trs "Partition GC dropped partition {0}" candidate)))
         (finally
           (when-not @bulldozer-connected
             (log/error (trs "Partition GC bulldozer could not connect to the database")))
@@ -1614,7 +1618,7 @@
           (when (.isAlive gc-bulldozer)
             ;; if the join above timed out and the bulldozer thread is still alive
             ;; log an ERROR because it could indicate a memory leak
-            (log/error "Unable to clean up the gc bulldozer thread.
+            (log/error "Unable to clean up the GC bulldozer thread.
                         Please file a bug with the stack trace below: \n"
                        (apply str (interpose "\n" (.getStackTrace gc-bulldozer))))))))))

@@ -1677,7 +1681,7 @@
                   ;; GC needs AccessExclusiveLocks on in order to drop
                   (drop-one-partition drop-one candidate db)
                   (when (> (bounded-count 3 candidates) 2)
-                    (log/warn (trs "More than 2 partitions to prune: {0}"
+                    (log/warn (trs "More than 2 partitions remaining to prune: {0}"
                                    (pr-str (butlast candidates))))))
                 (doseq [candidate candidates]
                   (drop-one candidate)))]


(maint) Update require & import to match current conventions

The previous usage of referencing fully qualified java class(es) and not
namespacing libraries does not match current puppet clj best practices.

Additional changes are about to be made in service of TK-214 and
updating the small amount of existing code to be in a similar style to
the code that will come from TK-214 should allow for easier code revieww.

--- src/puppetlabs/ring_middleware/core.clj
+++ src/puppetlabs/ring_middleware/core.clj
@@ -1,20 +1,21 @@
 (ns puppetlabs.ring-middleware.core
-  (:require [ring.middleware.cookies :refer [wrap-cookies]]
-            [puppetlabs.ssl-utils.core :refer [get-cn-from-x509-certificate]]
-            [puppetlabs.ring-middleware.common :refer [proxy-request]]))
+  (:require [ring.middleware.cookies :as cookies]
+            [puppetlabs.ssl-utils.core :as ssl-utils]
+            [puppetlabs.ring-middleware.common :as common])
+  (:import (java.util.regex Pattern)))

 (defn wrap-proxy
   "Proxies requests to proxied-path, a local URI, to the remote URI at
   remote-uri-base, also a string."
   [handler proxied-path remote-uri-base & [http-opts]]
-  (let [proxied-path (if (instance? java.util.regex.Pattern proxied-path)
+  (let [proxied-path (if (instance? Pattern proxied-path)
                        (re-pattern (str "^" (.pattern proxied-path)))
                        proxied-path)]
-       (wrap-cookies
+       (cookies/wrap-cookies
          (fn [req]
              (if (or (and (string? proxied-path) (.startsWith ^String (:uri req) (str proxied-path "/")))
-                     (and (instance? java.util.regex.Pattern proxied-path) (re-find proxied-path (:uri req))))
-               (proxy-request req proxied-path remote-uri-base http-opts)
+                     (and (instance? Pattern proxied-path) (re-find proxied-path (:uri req))))
+               (common/proxy-request req proxied-path remote-uri-base http-opts)
                (handler req))))))

 (defn wrap-add-cache-headers
@@ -46,6 +47,6 @@
   [handler]
   (fn [{:keys [ssl-client-cert] :as req}]
     (let [cn  (some-> ssl-client-cert
-                      get-cn-from-x509-certificate)
+                      ssl-utils/get-cn-from-x509-certificate)
           req (assoc req :ssl-client-cn cn)]
       (handler req))))


Add 'nested-select-keys'.

Add 'nested-select-keys'.

--- src/org/spootnik/cyanite/util.clj
+++ src/org/spootnik/cyanite/util.clj
@@ -137,3 +137,11 @@
   "Returns a unix epoch"
   []
   (quot (System/currentTimeMillis) 1000))
+
+(defn nested-select-keys
+  "Nested select-keys."
+  [map keyseq]
+  (reduce-kv (fn [a k v]
+               (merge a (if (map? v) (nested-select-keys v keyseq) {})))
+             (select-keys map keyseq)
+             map))


Replace multicanvas icon on workspace header with play button.

--- src/uxbox/main/ui/workspace/header.cljs
+++ src/uxbox/main/ui/workspace/header.cljs
@@ -155,8 +155,8 @@
          i/alignment]]
        [:ul.options-btn
         [:li.tooltip.tooltip-bottom
-         {:alt "Multi-canvas (Ctrl + M)"}
-         i/multicanvas]]
+         {:alt "View mode (Ctrl + P)"}
+         i/play]]
        (coordinates)]
       (ui.u/user)])))


Minor name clean up.

Minor name clean up.

--- airesources/Clojure/src/MyBot.clj
+++ airesources/Clojure/src/MyBot.clj
@@ -17,8 +17,8 @@
                *planets* (:planets m#)]
        ~@body)))

-;; Here we set the bot name to Hickey.
-(def my-bot-name "Hickey")
+;; Here we set the bot name to Doohickey.
+(def my-bot-name "Doohickey")
 (defmacro initialize-game
   [& body]
   `(let [prelude# (io/read-prelude)


Added placeholder test and some notes for [IMMUTANT-454]

--- modules/caching/src/test/clojure/wunderboss/caching_test.clj
+++ modules/caching/src/test/clojure/wunderboss/caching_test.clj
@@ -35,3 +35,17 @@
         c (.findOrCreate default "repl" options)]
     (is (= CacheMode/REPL_SYNC (.. config clustering cacheMode)))
     (is (= CacheMode/LOCAL (.. c getCacheConfiguration clustering cacheMode)))))
+
+(deftest remove-persistent-cache
+  (let [options (Options. {Caching$CreateOption/PERSIST "target/test-caches"})
+        config (Config/uration options)
+        c (.findOrCreate default "persisty" options)]
+
+    ;; The next line throws an NPE on 6.0.2.Final [See ISPN-4446]
+    ;; (.stop default (.getName c))
+
+    ;; ISPN-4446 is fixed in 6.0.3.Final, but that isn't expected to
+    ;; be released. 7.1.1.Final is stable and expected in WF9, but
+    ;; there are incompatible changes in the Cache interface that
+    ;; would complicate the CacheWithCodec impl.
+    ))


Fixed broken test by adding schema output

--- kuona-api/test/kuona_api/query_handlers_test.clj
+++ kuona-api/test/kuona_api/query_handlers_test.clj
@@ -12,18 +12,23 @@
   {:query {:match_all {}}})

 (facts "about queries"
-       (fact "query endpoint lists available data sources"
-             (:status (app (mock/request :get "/api/query"))) => 200)
-       (fact "returns available sources"
-             (count (-> (helper/parse-json-response (app (mock/request :get "/api/query"))) :sources)) => 4)
-       (fact "returns 404 for invalid index"
-             (:status (helper/mock-json-post app "/api/query/invalid" {})) => 404)
-       (fact "returns 200 for valid index"
-             (:status (helper/mock-json-post app "/api/query/builds" {})) => 200
-             (provided (http/get "http://localhost:9200/kuona-builds/builds/_search" {:headers {"content-type" "application/json; charset=UTF-8"}, :body "{}"}) => {:status 200 :body "{}"}))
-       (fact "returns content"
-             (helper/mock-json-post app "/api/query/snapshots" match-all) => {:body "{\"count\":0,\"results\":[]}", :headers {"Content-Type" "application/json; charset=utf-8"}, :status 200}
-
-             (provided (http/get "http://localhost:9200/kuona-snapshots/snapshots/_search" {:headers {"content-type" "application/json; charset=UTF-8"}, :body (generate-string match-all)}) => {:status 200,
-                                                                                :body   (generate-string {:hits {:total 0 :hits []}})})))
-
+       (let [std-headers {"content-type" "application/json; charset=UTF-8"}]
+         (fact "query endpoint lists available data sources"
+               (:status (app (mock/request :get "/api/query"))) => 200)
+         (fact "returns available sources"
+               (count (-> (helper/parse-json-response (app (mock/request :get "/api/query"))) :sources)) => 4)
+         (fact "returns 404 for invalid index"
+               (:status (helper/mock-json-post app "/api/query/invalid" {})) => 404)
+         (fact "returns 200 for valid index"
+               (:status (helper/mock-json-post app "/api/query/builds" {})) => 200
+               (provided (http/get "http://localhost:9200/kuona-builds/builds/_search" {:headers std-headers :body "{}"}) => {:status 200 :body "{}"}))
+         (fact "returns content"
+               (helper/mock-json-post app "/api/query/snapshots" match-all) => {:body "{\"count\":0,\"results\":[]}", :headers {"Content-Type" "application/json; charset=utf-8"}, :status 200}
+
+               (provided (http/get "http://localhost:9200/kuona-snapshots/snapshots/_search" {:headers std-headers :body (generate-string match-all)}) => {:status 200,
+                                                                                :body   (generate-string {:hits {:total 0 :hits []}})})
+
+               (provided (http/get "http://localhost:9200/kuona-snapshots/snapshots/_mapping" {:headers std-headers}) => {:status 200
+                                                                                :body (generate-string {:index-name {:mappings {:mapping-name {:properties {}}}}})}
+                                                                                ))))
+


Don't have explict dependency on Datomic.

--- src/provisdom/spectomic/specs.clj
+++ src/provisdom/spectomic/specs.clj
@@ -3,8 +3,7 @@
     [clojure.spec.alpha :as s]
     [clojure.spec.gen.alpha :as gen]
     [clojure.string :as str]
-    [clojure.spec.alpha :as s])
-  (:import (datomic.db DbId)))
+    [clojure.spec.alpha :as s]))

 (def datomic-value-types
@@ -14,7 +13,7 @@
 (s/def ::tempid
   (s/with-gen
     (s/or
-      :dbid #(instance? DbId %)
+      :dbid #(instance? (Class/forName "datomic.db.DbId") %)
       :string (s/and string? #(not (str/starts-with? % ":"))))
     (fn [] (gen/return ((resolve 'datomic.api/tempid) :db.part/db)))))


Refactored

Refactored

--- src/rpi_challenger/core/round.clj
+++ src/rpi_challenger/core/round.clj
@@ -77,10 +77,11 @@

 (defn- points-based-on-acceleration [round previous-round]
   (let [max-points (:points round)
-        previous-points (or (:points previous-round) 0)]
+        previous-points (:points previous-round 0)]
     (-> round
       (assoc :max-points max-points)
       (assoc :points (min max-points (+ acceleration previous-points))))))

+; TODO: this might be rewriteable with http://clojuredocs.org/clojure_core/clojure.core/reductions
 (defn apply-point-acceleration [rounds]
   (reduce (fn [previous-rounds round] (conj previous-rounds (points-based-on-acceleration round (last previous-rounds)))) [] rounds))


removed hack and unused code

removed hack and unused code

--- pigpen-cascading/src/main/clojure/pigpen/cascading.clj
+++ pigpen-cascading/src/main/clojure/pigpen/cascading.clj
@@ -93,7 +93,7 @@
                  (cfields (map #(cascading-field (:alias %)) field-projections))
                  Fields/UNKNOWN)
         cogroup-opts (get-in flowdef [:cogroup-opts pipe])]
-    (if-not (or (nil? cogroup-opts) (= (symbol "generate56") pipe))
+    (if-not (nil? cogroup-opts)
       (let [buffer (case (:group-type cogroup-opts)
                      :group (GroupBuffer. (str init) (str func) fields (:num-streams cogroup-opts) (:group-all cogroup-opts) (:join-nils cogroup-opts) (:join-requirements cogroup-opts) udf)
                      :join (JoinBuffer. (str init) (str func) fields (:all-args cogroup-opts)))]
@@ -242,32 +242,10 @@
                                                            %) a))))))
          (remove is-field-projection))))

-; TODO: lots of code duplication here
-(defn- collapse-func-projections [commands]
-  (let [is-func-projection (fn [c] (some #(= :projection-func (:type %)) (if-let [p (:projections c)] p [0])))
-        successors (zipmap (map #(first (:ancestors %)) commands) (map :id commands))
-        fp-by-key (fn [key-fn] (->> commands
-                                    (filter is-func-projection)
-                                    (map (fn [c] [(key-fn c) c]))
-                                    (into {})))
-        fp-by-successor (fp-by-key #(successors (:id %)))
-        fp-by-id (fp-by-key :id)]
-    (->> commands
-         (map (fn [c]
-                (let [fp (fp-by-successor (:id c))
-                      c (if fp
-                          (assoc c :func-projections (:projections fp))
-                          c)]
-                  (update-in c [:ancestors] (fn [a] (map #(if (fp-by-id %)
-                                                           (first (:ancestors (fp-by-id %)))
-                                                           %) a))))))
-         (remove is-func-projection))))

 (defn preprocess-commands [commands]
   (-> commands
-      collapse-field-projections
-      ;collapse-func-projections
-      ))
+      collapse-field-projections))

 (defn commands->flow
   "Transforms a series of commands into a Cascading flow"


Extract fns to load image and not found

Extract fns to load image and not found

--- src/silly_image_store/handler.clj
+++ src/silly_image_store/handler.clj
@@ -8,11 +8,16 @@
 (def images-dir
   (env :base-store-dir))

+(defn load-image [basedir filename]
+  (let [file (io/file (str basedir filename))]
+    (if (.exists file) file nil)))
+
+(defn image-not-found [image-name]
+  (route/not-found (str "No image '" image-name "' found")))
+
 (defn serve-image [image-name]
-  (let [image-file (io/file (str images-dir image-name))]
-    (if (.exists image-file)
-      image-file
-      (route/not-found (str "No image '" image-name "' found")))))
+  (let [image-file (load-image images-dir image-name)]
+    (or image-file (image-not-found image-name))))

 (defroutes app-routes
   (GET "/image/:image-name" [image-name] (serve-image image-name))


Fix parser-stack ordering bug

Fix parser-stack ordering bug

AFFECTS: Users of `with-parser`, `skip-replies`, or the `eval*` helper.

DESCRIPTION: Order of parsers on stack wasn't being handled correctly and could get
confused under certain circumstances. For `eval*` this meant an incorrect return value
every time.

NOTES: The new stack should also be faster.

--- src/taoensso/carmine/protocol.clj
+++ src/taoensso/carmine/protocol.clj
@@ -7,8 +7,7 @@
   (:require [clojure.string :as str]
             [taoensso.carmine (utils :as utils)]
             [taoensso.nippy :as nippy])
-  (:import  [java.io DataInputStream BufferedOutputStream]
-            [clojure.lang PersistentQueue]))
+  (:import  [java.io DataInputStream BufferedOutputStream]))

 ;; Hack to allow cleaner separation of namespaces
 (utils/declare-remote taoensso.carmine.connections/get-spec
@@ -164,7 +163,7 @@
         reply-count (if (= reply-count :all) (count parsers) reply-count)]

     (when (pos? reply-count)
-      (swap! (:parser-stack *context*) (partial drop reply-count))
+      (swap! (:parser-stack *context*) #(subvec % reply-count))

       (if (= reply-count 1)
         (->> (get-basic-reply! in)
@@ -190,7 +189,7 @@
      (binding [*context*
                (Context. (taoensso.carmine.connections/in-stream  ~connection)
                          (taoensso.carmine.connections/out-stream ~connection)
-                         (when-not listener?# (atom (PersistentQueue/EMPTY))))
+                         (when-not listener?# (atom [])))
                *parser* nil]
        ~@body
        (if listener?# nil (get-replies! :all)))))


Fixed op-handlers optional param for make-kvs-mgr.

--- src/cbfg/kvs.cljs
+++ src/cbfg/kvs.cljs
@@ -77,7 +77,7 @@
          (kvs-snapshot-do actx res-ch kvs-snapshot (kvs-checker kvs-ident cb))
          (kvs-do actx state-ch nil (kvs-checker kvs-ident cb))))))

-(def op-handlers
+(def default-op-handlers
   {:kvs-open
    (fn [actx state-ch m]
      (kvs-do actx state-ch (:res-ch m)
@@ -160,12 +160,12 @@
                                            (assoc :dirty (make-kc))))
                              {:status :ok :status-info [:synced (:kv-ident m)]}]))))})

-(defn make-kvs-mgr [actx & op-handlers-in & {:keys [cmd-ch state-ch]}]
+(defn make-kvs-mgr [actx & {:keys [cmd-ch state-ch op-handlers]}]
   (let [cmd-ch (or cmd-ch (achan actx))
         state-ch (or state-ch (achan actx))]
     (act-loop kvs-mgr-in actx [tot-ops 0]
               (if-let [m (atake kvs-mgr-in cmd-ch)]
-                (if-let [op-handler (get (or op-handlers-in op-handlers) (:op m))]
+                (if-let [op-handler (get (or op-handlers default-op-handlers) (:op m))]
                   (do (op-handler kvs-mgr-in state-ch m)
                       (recur (inc tot-ops)))
                   (println :kvs-mgr-in-exit-unknown-op m))


fix yarn & node installation

fix yarn & node installation

--- main/src/dda/pallet/dda_managed_ide/infra/java_script.clj
+++ main/src/dda/pallet/dda_managed_ide/infra/java_script.clj
@@ -86,7 +86,7 @@
   [facility :- s/Keyword]
   (actions/as-action
     (logging/info (str facility "-install system: install-yarn")))
-  (actions/packages :aptitude ["nodejs"]))
+  (actions/packages :aptitude ["yarn"]))

 (s/defn init-asciinema
   [facility :- s/Keyword]
@@ -155,5 +155,4 @@
    settings]
   (let [{:keys [nodejs]} js]
     (when contains-java-script?
-      (when (contains? js :nodejs)
-        (install-user-nodejs facility os-user-name nodejs)))))
+      (install-user-nodejs facility os-user-name nodejs))))


remove self host tests from main tests

remove self host tests from main tests

--- src/test/cljs/self_host/test.cljs
+++ src/test/cljs/self_host/test.cljs
@@ -1,170 +0,0 @@
-(ns self-host.test
-  (:require [cljs.test :as test
-             :refer-macros [run-tests deftest testing is async]]
-            [cljs.js :as cljs]
-            [cljs.nodejs :as nodejs]))
-
-(set! (.-user js/cljs) #js {})
-
-(nodejs/enable-util-print!)
-
-(defn latch [m f]
-  (let [r (atom 0)]
-    (add-watch r :latch
-      (fn [_ _ o n]
-        (when (== n m) (f))))
-    r))
-
-(defn inc! [r]
-  (swap! r inc))
-
-(def vm (js/require "vm"))
-(def fs (js/require "fs"))
-(def st (cljs/empty-state))
-
-(defn node-eval [{:keys [name source]}]
-  (if-not js/COMPILED
-    (.runInThisContext vm source (str (munge name) ".js"))
-    (js/eval source)))
-
-(def libs
-  {'bootstrap-test.core :cljs
-   'bootstrap-test.macros :clj
-   'bootstrap-test.helper :clj})
-
-(defn node-load [{:keys [name macros]} cb]
-  (if (contains? libs name)
-    (let [path (str "src/test/cljs/" (cljs/ns->relpath name)
-                    "." (cljs.core/name (get libs name)))]
-      (.readFile fs path "utf-8"
-        (fn [err src]
-          (cb (if-not err
-                {:lang :clj :source src}
-                (.error js/console err))))))
-    (cb nil)))
-
-(defn elide-env [env ast opts]
-  (dissoc ast :env))
-
-;; NOTE: can't set passes because callbacks happen _inside_ binding
-;; do so will effect other tests
-
-(deftest test-analyze-str
-  (async done
-    (let [l (latch 1 done)]
-      (cljs/analyze-str st "(+ 1 1)" nil
-        {:context :expr}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (= :js (:op value)))
-          (inc! l))))))
-
-(deftest test-compile-str
-  (async done
-    (let [l (latch 3 done)]
-      (cljs/compile-str st "(+ 1 1)"
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (= value "(1 + 1);\n"))
-          (inc! l)))
-      (cljs/compile-str st "(fn [])" nil
-        {:context :expr}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (= value "(function (){\nreturn null;\n})"))
-          (inc! l)))
-      (cljs/compile-str st "(if cljs.core.first 1 2)" nil
-        {:context :expr}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (= value "(cljs.core.truth_(cljs.core.first)?1:2)"))
-          (inc! l))))))
-
-(deftest test-eval-str
-  (async done
-    (let [l (latch 6 done)]
-      (cljs/eval-str st "(+ 1 1)" nil
-        {:eval node-eval}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (== value 2))
-          (inc! l)))
-      (cljs/eval-str st "(def x 1)" nil
-        {:eval node-eval
-         :context :expr
-         :def-emits-var true}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (var? value))
-          (inc! l)))
-      (cljs/eval-str st "(fn [])" nil
-        {:eval node-eval
-         :context :expr
-         :def-emits-var true}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (fn? value))
-          (inc! l)))
-      (cljs/eval-str st "((fn [a b] (+ a b)) 1 2)" nil
-        {:eval node-eval
-         :context :expr
-         :def-emits-var true}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (== 3))
-          (inc! l)))
-      (cljs/eval-str st "(ns foo.bar)" nil
-        {:eval node-eval
-         :context :expr
-         :def-emits-var true}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (not (nil? js/foo.bar)))
-          (inc! l)))
-      (cljs/eval-str st "(defn foo [a b] (+ a b))" nil
-        {:eval node-eval
-         :context :expr
-         :def-emits-var true}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (== (js/cljs.user.foo 1 2) 3))
-          (inc! l))))))
-
-(deftest test-eval-str-with-require
-  (async done
-    (let [l (latch 2 done)]
-      (cljs/eval-str st
-        "(ns foo.bar (:require [bootstrap-test.core]))\n(bootstrap-test.core/foo 3 4)"
-        nil
-        {:eval node-eval
-         :load node-load}
-        (fn [{:keys [value error]}]
-          (is (nil? error))
-          (is (== 7 value))
-          (inc! l)))
-      #_(cljs/eval-str st
-        "(ns foo.bar (:require-macros [bootstrap-test.macros :refer [foo]]))\n(foo 4 4)"
-        nil
-        {:eval node-eval
-         :load node-load}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (== 16 value))
-          (inc! l)))
-      (cljs/eval-str st
-        "(ns foo.bar)\n(first [1 2 3])"
-        nil
-        {:eval node-eval
-         :load node-load}
-        (fn [{:keys [error value]}]
-          (is (nil? error))
-          (is (== 1 value))
-          (inc! l))))))
-
-(defn -main [& args]
-  (run-tests))
-
-(set! *main-cli-fn* -main)
-
-(comment
-  )


Story ID: 0.4.5 fixed a few things in support viewer

--- src/untangled/support_viewer.cljs
+++ src/untangled/support_viewer.cljs
@@ -16,9 +16,9 @@
   (render [this]
     (let [{:keys [ui/react-key current-position client-time frames position comments] :or {ui/react-key "ROOT"}} (om/props this)]
       (dom/div #js {:key react-key :className (str "history-controls " (name position))}
-        (dom/button #js {:class "toggle-position" :onClick #(om/transact! this '[(support-viewer/toggle-position)])} (tr "<= Reposition =>"))
-        (dom/button #js {:class "history-back" :onClick #(om/transact! this '[(support-viewer/step-back)])} (tr "Back"))
-        (dom/button #js {:class "history-forward" :onClick #(om/transact! this '[(support-viewer/step-forward)])} (tr "Forward"))
+        (dom/button #js {:className "toggle-position" :onClick #(om/transact! this '[(support-viewer/toggle-position)])} (tr "<= Reposition =>"))
+        (dom/button #js {:className "history-back" :onClick #(om/transact! this '[(support-viewer/step-back)])} (tr "Back"))
+        (dom/button #js {:className "history-forward" :onClick #(om/transact! this '[(support-viewer/step-forward)])} (tr "Forward"))
         (dom/hr nil)
         (dom/span #js {:className "frame"} (trf "Frame {f,number} of {end,number} " :f (inc current-position) :end frames))
         (dom/span #js {:className "timestamp"} (trf "{ts,date,short} {ts,time,long}" :ts client-time))
@@ -62,7 +62,7 @@
                                                                          :current-position 0}
                                                          :started-callback
                                                          (fn [{:keys [reconciler]}]
-                                                           (load-singleton reconciler `[:support-request]
+                                                           (load-singleton reconciler `[(:support-request {:id ~(core/get-url-param "id")})]
                                                              :callback (fn [state]
                                                                          (swap! state
                                                                            (fn [s]
@@ -77,8 +77,7 @@
                                                                                (assoc :comments comments)
                                                                                (assoc :frames frames)
                                                                                (assoc :history history)
-                                                                                (assoc :current-position last-idx))))))
-                                                             :params {:id (core/get-url-param "id")}))))})]
+                                                                                (assoc :current-position last-idx))))))))))})]
     (core/mount viewer SupportViewerRoot support-dom-id)))

 (defn history-step [state delta-fn]


Fix looking up users in Slack

Fix looking up users in Slack

Fix #555

--- src/yetibot/core/models/users.clj
+++ src/yetibot/core/models/users.clj
@@ -90,9 +90,10 @@
 (defn get-users
   "Returns users for a given chat source"
   [source]
-  (->> @users
-       vals
-       (filter (fn [u] (and (:rooms u) ((:rooms u) source))))))
+  (let [chat-source (select-keys source [:adapter :uuid :room])]
+    (->> @users
+         vals
+         (filter (fn [u] (and (:rooms u) ((:rooms u) chat-source)))))))

 (defn get-user [source id]
   (@users {:adapter (:adapter source) :id id}))


[WM] update dependencies to latest versions

pedestal-toolbox in particular contains an important bug fix we should
have in every new -http-api component.

--- resources/leiningen/new/kraken_http_api/project.clj
+++ resources/leiningen/new/kraken_http_api/project.clj
@@ -7,7 +7,7 @@
                  [org.clojure/tools.logging "0.3.1"]
                  [turbovote.resource-config "0.2.0"]
                  [com.novemberain/langohr "3.3.0"]
-                 [prismatic/schema "0.4.3"]
+                 [prismatic/schema "0.4.4"]
                  [ch.qos.logback/logback-classic "1.1.3"]

                  ;; core.async has to come before pedestal or kehaar.wire-up will


Proxy true for heroku.

Proxy true for heroku.

--- src/forces_assemble/handler.clj
+++ src/forces_assemble/handler.clj
@@ -111,7 +111,7 @@
   (route/not-found "Not Found"))

 (def app
-  (wrap-defaults app-routes secure-api-defaults))
+  (wrap-defaults app-routes (secure-api-defaults :proxy true)))

 (def handler
   (-> app-routes


prevent variables with the same names from using same buffers across programs

--- src/gamma_driver/impl/bind.cljs
+++ src/gamma_driver/impl/bind.cljs
@@ -32,7 +32,7 @@
         (assoc input
                :data data
                :usage :static-draw
-               :element element
+               :element [program element]
                :count (if-let [c (:count input)]
                         c
                         (if (seqable? data)
@@ -48,7 +48,7 @@
            data (:data input)]
        (assoc input
          :tag :uniform
-         :element element
+         :element [program element]
          :data (if (array? data)
                  data
                  (clj->js (flatten [data]))))))))
@@ -69,7 +69,7 @@
                           ;; Probably already flattened, but keeping it here for now
                           :data data
                           :usage :static-draw
-                          :element element
+                          :element [program element]
                           :count (if-let [c (:count input)]
                                    c
                                    (count (:data input)))))]


[#38] Include destructuring for defn, let, etc.

--- priv/clojure/core.clj
+++ priv/clojure/core.clj
@@ -4407,206 +4407,207 @@
       :static true}
      ([] (. clojure.lang.PersistentArrayMap EMPTY))
      ([& keyvals]
-      (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array keyvals))))
-
-   ;;redefine let and loop  with destructuring
-
-   (defn destructure [bindings]
-     (let [bents (partition 2 bindings)
-           pb (fn pb [bvec b v]
-                (let [pvec
-                      (fn [bvec b val]
-                        (let [gvec (gensym "vec__")]
-                          (loop [ret (-> bvec (conj gvec) (conj val))
-                                 n 0
-                                 bs b
-                                 seen-rest? false]
-                            (if (seq bs)
-                              (let [firstb (first bs)]
-                                (cond
-                                  (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n))
-                                                       n
-                                                       (nnext bs)
-                                                       true)
-                                  (= firstb :as) (pb ret (second bs) gvec)
-                                  :else (if seen-rest?
-                                          (throw "Unsupported binding form, only :as can follow & parameter")
-                                          (recur (pb ret firstb  (list `nth gvec n nil))
-                                                 (inc n)
-                                                 (next bs)
-                                                 seen-rest?))))
-                              ret))))
-                      pmap
-                      (fn [bvec b v]
-                        (let [gmap (gensym "map__")
-                              gmapseq (with-meta gmap {:tag 'clojure.lang.ISeq})
-                              defaults (:or b)]
-                          (loop [ret (-> bvec (conj gmap) (conj v)
-                                         (conj gmap) (conj `(if (seq? ~gmap) (clojure.lang.PersistentHashMap/create (seq ~gmapseq)) ~gmap))
-                                         ((fn [ret]
-                                            (if (:as b)
-                                              (conj ret (:as b) gmap)
-                                              ret))))
-                                 bes (reduce1
-                                      (fn [bes entry]
-                                        (reduce1 #(assoc %1 %2 ((val entry) %2))
-                                                 (dissoc bes (key entry))
-                                                 ((key entry) bes)))
-                                      (dissoc b :as :or)
-                                      {:keys #(if (keyword? %) % (keyword (str %))),
-                                       :strs str, :syms #(list `quote %)})]
-                            (if (seq bes)
-                              (let [bb (key (first bes))
-                                    bk (val (first bes))
-                                    bv (if (contains? defaults bb)
-                                         (list `get gmap bk (defaults bb))
-                                         (list `get gmap bk))]
-                                (recur (cond
-                                         (symbol? bb) (-> ret (conj (if (namespace bb) (symbol (name bb)) bb)) (conj bv))
-                                         (keyword? bb) (-> ret (conj (symbol (name bb)) bv))
-                                         :else (pb ret bb bv))
-                                       (next bes)))
-                              ret))))]
-                  (cond
-                    (symbol? b) (-> bvec (conj b) (conj v))
-                    (vector? b) (pvec bvec b v)
-                    (map? b) (pmap bvec b v)
-                    :else (throw (str "Unsupported binding form: " b)))))
-           process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
-       (if (every? symbol? (map first bents))
-         bindings
-         (reduce1 process-entry [] bents))))
-
-   (defmacro let
-     "binding => binding-form init-expr
+      (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array keyvals)))))
+
+;;redefine let and loop  with destructuring
+
+(defn destructure [bindings]
+  (let [bents (partition 2 bindings)
+        pb (fn pb [bvec b v]
+             (let [pvec
+                   (fn [bvec b val]
+                     (let [gvec (gensym "vec__")]
+                       (loop [ret (-> bvec (conj gvec) (conj val))
+                              n 0
+                              bs b
+                              seen-rest? false]
+                         (if (seq bs)
+                           (let [firstb (first bs)]
+                             (cond
+                               (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n))
+                                                    n
+                                                    (nnext bs)
+                                                    true)
+                               (= firstb :as) (pb ret (second bs) gvec)
+                               :else (if seen-rest?
+                                       (throw "Unsupported binding form, only :as can follow & parameter")
+                                       (recur (pb ret firstb  (list `nth gvec n nil))
+                                              (inc n)
+                                              (next bs)
+                                              seen-rest?))))
+                           ret))))
+                   pmap
+                   (fn [bvec b v]
+                     (let [gmap (gensym "map__")
+                           gmapseq (with-meta gmap {:tag 'clojure.lang.ISeq})
+                           defaults (:or b)]
+                       (loop [ret (-> bvec (conj gmap) (conj v)
+                                      (conj gmap) (conj `(if (seq? ~gmap) (clojure.lang.PersistentHashMap/create (seq ~gmapseq)) ~gmap))
+                                      ((fn [ret]
+                                         (if (:as b)
+                                           (conj ret (:as b) gmap)
+                                           ret))))
+                              bes (reduce1
+                                   (fn [bes entry]
+                                     (reduce1 #(assoc %1 %2 ((val entry) %2))
+                                              (dissoc bes (key entry))
+                                              ((key entry) bes)))
+                                   (dissoc b :as :or)
+                                   {:keys #(if (keyword? %) % (keyword (str %))),
+                                    :strs str, :syms #(list `quote %)})]
+                         (if (seq bes)
+                           (let [bb (key (first bes))
+                                 bk (val (first bes))
+                                 bv (if (contains? defaults bb)
+                                      (list `get gmap bk (defaults bb))
+                                      (list `get gmap bk))]
+                             (recur (cond
+                                      (symbol? bb) (-> ret (conj (if (namespace bb) (symbol (name bb)) bb)) (conj bv))
+                                      (keyword? bb) (-> ret (conj (symbol (name bb)) bv))
+                                      :else (pb ret bb bv))
+                                    (next bes)))
+                           ret))))]
+               (cond
+                 (symbol? b) (-> bvec (conj b) (conj v))
+                 (vector? b) (pvec bvec b v)
+                 (map? b) (pmap bvec b v)
+                 :else (throw (str "Unsupported binding form: " b)))))
+        process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
+    (if (every? symbol? (map first bents))
+      bindings
+      (reduce1 process-entry [] bents))))
+
+(defmacro let
+  "binding => binding-form init-expr

   Evaluates the exprs in a lexical context in which the symbols in
   the binding-forms are bound to their respective init-exprs or parts
   therein."
-     {:added "1.0", :special-form true, :forms '[(let [bindings*] exprs*)]}
-     [bindings & body]
-     (assert-args
-      (vector? bindings) "a vector for its binding"
-      (even? (count bindings)) "an even number of forms in binding vector")
-     `(let* ~(destructure bindings) ~@body))
-
-   (defn ^{:private true}
-     maybe-destructured
-     [params body]
-     (if (every? symbol? params)
-       (cons params body)
-       (loop [params params
-              new-params (with-meta [] (meta params))
-              lets []]
-         (if params
-           (if (symbol? (first params))
-             (recur (next params) (conj new-params (first params)) lets)
-             (let [gparam (gensym "p__")]
-               (recur (next params) (conj new-params gparam)
-                      (-> lets (conj (first params)) (conj gparam)))))
-           `(~new-params
-             (let ~lets
-               ~@body))))))
+  {:added "1.0", :special-form true, :forms '[(let [bindings*] exprs*)]}
+  [bindings & body]
+  (assert-args
+   (vector? bindings) "a vector for its binding"
+   (even? (count bindings)) "an even number of forms in binding vector")
+  `(let* ~(destructure bindings) ~@body))
+
+(defn ^{:private true}
+  maybe-destructured
+  [params body]
+  (if (every? symbol? params)
+    (cons params body)
+    (loop [params params
+           new-params (with-meta [] (meta params))
+           lets []]
+      (if params
+        (if (symbol? (first params))
+          (recur (next params) (conj new-params (first params)) lets)
+          (let [gparam (gensym "p__")]
+            (recur (next params) (conj new-params gparam)
+                   (-> lets (conj (first params)) (conj gparam)))))
+        `(~new-params
+          (let ~lets
+            ~@body))))))

    ;;redefine fn with destructuring and pre/post conditions

-   (defmacro fn
-     "params => positional-params* , or positional-params* & next-param
+
+(defmacro fn
+  "params => positional-params* , or positional-params* & next-param
   positional-param => binding-form
   next-param => binding-form
   name => symbol

   Defines a function"
-     {:added "1.0", :special-form true,
-      :forms '[(fn name? [params* ] exprs*) (fn name? ([params* ] exprs*)+)]}
-     [& sigs]
-     (let [name (if (symbol? (first sigs)) (first sigs) nil)
-           sigs (if name (next sigs) sigs)
-           sigs (if (vector? (first sigs))
-                  (list sigs)
-                  (if (seq? (first sigs))
-                    sigs
-                    ;; Assume single arity syntax
-                    (throw (if (seq sigs)
-                             (str "Parameter declaration "
-                                  (first sigs)
-                                  " should be a vector")
-                             (str "Parameter declaration missing")))))
-           psig (fn* [sig]
-                     ;; Ensure correct type before destructuring sig
-                     (when (not (seq? sig))
-                       (throw (str "Invalid signature " sig
-                                   " should be a list")))
-                     (let [[params & body] sig
-                           _ (when (not (vector? params))
-                               (throw (if (seq? (first sigs))
-                                        (str "Parameter declaration " params
-                                             " should be a vector")
-                                        (str "Invalid signature " sig
-                                             " should be a list"))))
-                           conds (when (and (next body) (map? (first body)))
-                                   (first body))
-                           body (if conds (next body) body)
-                           conds (or conds (meta params))
-                           pre (:pre conds)
-                           post (:post conds)
-                           body (if post
-                                  `((let [~'% ~(if (< 1 (count body))
-                                                 `(do ~@body)
-                                                 (first body))]
-                                      ~@(map (fn* [c] `(assert ~c)) post)
-                                      ~'%))
-                                  body)
-                           body (if pre
-                                  (concat (map (fn* [c] `(assert ~c)) pre)
-                                          body)
-                                  body)]
-                       (maybe-destructured params body)))
-           new-sigs (map psig sigs)]
-       (with-meta
-         (if name
-           (list* 'fn* name new-sigs)
-           (cons 'fn* new-sigs))
-         (meta &form))))
-
-   (defmacro loop
-     "Evaluates the exprs in a lexical context in which the symbols in
+  {:added "1.0", :special-form true,
+   :forms '[(fn name? [params* ] exprs*) (fn name? ([params* ] exprs*)+)]}
+  [& sigs]
+  (let [name (if (symbol? (first sigs)) (first sigs) nil)
+        sigs (if name (next sigs) sigs)
+        sigs (if (vector? (first sigs))
+               (list sigs)
+               (if (seq? (first sigs))
+                 sigs
+                 ;; Assume single arity syntax
+                 (throw (if (seq sigs)
+                          (str "Parameter declaration "
+                               (first sigs)
+                               " should be a vector")
+                          (str "Parameter declaration missing")))))
+        psig (fn* [sig]
+                  ;; Ensure correct type before destructuring sig
+                  (when (not (seq? sig))
+                    (throw (str "Invalid signature " sig
+                                " should be a list")))
+                  (let [[params & body] sig
+                        _ (when (not (vector? params))
+                            (throw (if (seq? (first sigs))
+                                     (str "Parameter declaration " params
+                                          " should be a vector")
+                                     (str "Invalid signature " sig
+                                          " should be a list"))))
+                        conds (when (and (next body) (map? (first body)))
+                                (first body))
+                        body (if conds (next body) body)
+                        conds (or conds (meta params))
+                        pre (:pre conds)
+                        post (:post conds)
+                        body (if post
+                               `((let [~'% ~(if (< 1 (count body))
+                                              `(do ~@body)
+                                              (first body))]
+                                   ~@(map (fn* [c] `(assert ~c)) post)
+                                   ~'%))
+                               body)
+                        body (if pre
+                               (concat (map (fn* [c] `(assert ~c)) pre)
+                                       body)
+                               body)]
+                    (maybe-destructured params body)))
+        new-sigs (map psig sigs)]
+    (with-meta
+      (if name
+        (list* 'fn* name new-sigs)
+        (cons 'fn* new-sigs))
+      (meta &form))))
+
+(defmacro loop
+  "Evaluates the exprs in a lexical context in which the symbols in
   the binding-forms are bound to their respective init-exprs or parts
   therein. Acts as a recur target."
-     {:added "1.0", :special-form true, :forms '[(loop [bindings*] exprs*)]}
-     [bindings & body]
-     (assert-args
-      (vector? bindings) "a vector for its binding"
-      (even? (count bindings)) "an even number of forms in binding vector")
-     (let [db (destructure bindings)]
-       (if (= db bindings)
-         `(loop* ~bindings ~@body)
-         (let [vs (take-nth 2 (drop 1 bindings))
-               bs (take-nth 2 bindings)
-               gs (map (fn [b] (if (symbol? b) b (gensym))) bs)
-               bfs (reduce1 (fn [ret [b v g]]
-                              (if (symbol? b)
-                                (conj ret g v)
-                                (conj ret g v b g)))
-                            [] (map vector bs vs gs))]
-           `(let ~bfs
-              (loop* ~(vec (interleave gs gs))
-                     (let ~(vec (interleave bs gs))
-                       ~@body)))))))
-
-   (defmacro when-first
-     "bindings => x xs
+  {:added "1.0", :special-form true, :forms '[(loop [bindings*] exprs*)]}
+  [bindings & body]
+  (assert-args
+   (vector? bindings) "a vector for its binding"
+   (even? (count bindings)) "an even number of forms in binding vector")
+  (let [db (destructure bindings)]
+    (if (= db bindings)
+      `(loop* ~bindings ~@body)
+      (let [vs (take-nth 2 (drop 1 bindings))
+            bs (take-nth 2 bindings)
+            gs (map (fn [b] (if (symbol? b) b (gensym))) bs)
+            bfs (reduce1 (fn [ret [b v g]]
+                           (if (symbol? b)
+                             (conj ret g v)
+                             (conj ret g v b g)))
+                         [] (map vector bs vs gs))]
+        `(let ~bfs
+           (loop* ~(vec (interleave gs gs))
+                  (let ~(vec (interleave bs gs))
+                    ~@body)))))))
+
+(defmacro when-first
+  "bindings => x xs

   Roughly the same as (when (seq xs) (let [x (first xs)] body)) but xs is evaluated only once"
-     {:added "1.0"}
-     [bindings & body]
-     (assert-args
-      (vector? bindings) "a vector for its binding"
-      (= 2 (count bindings)) "exactly 2 forms in binding vector")
-     (let [[x xs] bindings]
-       `(when-let [xs# (seq ~xs)]
-          (let [~x (first xs#)]
-            ~@body)))))
+  {:added "1.0"}
+  [bindings & body]
+  (assert-args
+   (vector? bindings) "a vector for its binding"
+   (= 2 (count bindings)) "exactly 2 forms in binding vector")
+  (let [[x xs] bindings]
+    `(when-let [xs# (seq ~xs)]
+       (let [~x (first xs#)]
+         ~@body))))

 (defmacro lazy-cat
   "Expands to code which yields a lazy sequence of the concatenation


Fixed CLI in 'check' task.

Fixed CLI in 'check' task.

--- src/leiningen/ancient/check.clj
+++ src/leiningen/ancient/check.clj
@@ -52,6 +52,6 @@

 (defn run-file-check-task!
   "Run project/plugin checker on the given file."
-  [project [_ path & args]]
+  [project [path & args]]
   (when-let [project (read-project-map! path)]
     (run-check-task! project args)))


Using a specialized version to compute the minimal covers

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

--- src/conexp/contrib/experimental/ryssel_algorithm.clj
+++ src/conexp/contrib/experimental/ryssel_algorithm.clj
@@ -15,12 +15,27 @@

 ;;;

-(defn cover [base-set candidates m extent]
-  (apply partial-min
-         subset?
-         (set-of X [X (subsets candidates),
-                    :when (subset? (reduce intersection base-set (map extent X))
-                                   (extent m))])))
+(defn- minimal-covers [base-set sets]
+  (let [covers (if (subset? base-set (reduce union sets))
+                 [sets]
+                 [])]
+    (loop [covers         covers,
+           minimal-covers []]
+      (if (empty? covers)
+        minimal-covers
+        (let [next-cover     (first covers),
+              smaller-covers (filter #(subset? base-set (reduce union %))
+                                     (map #(disj next-cover %) next-cover))]
+          (if (not-empty smaller-covers)
+            (recur (concat smaller-covers (rest covers))
+                   minimal-covers)
+            (recur (rest covers)
+                   (conj minimal-covers next-cover))))))))
+
+(defn- cover [base-set candidates m extent]
+  (minimal-covers (difference base-set (extent m))
+                  (map #(difference base-set (extent %))
+                       candidates)))

 (defn ryssel-base
   "Returns the set of implications computed by Ryssels Algorithm."


handleEx comment

handleEx comment

--- src/lt/plugins/ltfiles/vim.cljs
+++ src/lt/plugins/ltfiles/vim.cljs
@@ -82,6 +82,8 @@
               :exec smart-join})

 (comment
+  (def ed (pool/last-active))
+  (js/CodeMirror.Vim.handleEx (editor/->cm-ed ed) ":sort")
   (.-text (.-unamedRegister (CodeMirror.Vim.getRegisterController)))
   (.pushText
    (CodeMirror.Vim.getRegisterController)


Delete task.clj

Delete task.clj

--- src/iyye/task.clj
+++ src/iyye/task.clj
@@ -1,24 +0,0 @@
-; Iyye - AI agent
-; Copyright (C) 2016-2017  Sasha Yumzya
-
-; This program is free software: you can redistribute it and/or modify
-; it under the terms of the GNU Affero General Public License as
-; published by the Free Software Foundation, either version 3 of the
-; License, or (at your option) any later version.
-
-; This program is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU Affero General Public License for more details.
-
-; You should have received a copy of the GNU Affero General Public License
-; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-(ns iyye.task)
-
-(defn start-task [task]
-  (dosync ( ref-set (:task-future task) (future (while (not (Thread/interrupted))
-                                                       (dorun [((:function task))]))))))
-
-(defn stop-task [task]
-  (future-cancel @(:task-future task)))


need to rework this config via leiningen thing

--- dev/build.clj
+++ dev/build.clj
@@ -26,24 +26,6 @@
       (cljs/flush-modules-to-disk)
       ))

- :cljs {:modules [{:name :cljs
-                    :main 'cljs.core}
-                   {:name :basic
-                    :main 'basic
-                    :depends-on #{:cljs}}
-                   {:name :other
-                    :main 'other
-                    :depends-on #{:cljs}}]
-
-         :source-paths ["test-data"]
-         :public-dir "target/cljs"
-         :public-path "target/cljs"
-
-         :live-reload {;; :host "localhost" ;; optional, defaults to localhost
-                       ;; :port 8889 ;; optional, defaults to random open port
-                       :before-load 'basic.stop-app
-                       :after-load 'basic.start-app
-                       }}
 (defn dev
   [& args]
   (-> (cljs/init-state)


add [:cold_reads_to_omit 0]

add [:cold_reads_to_omit 0]

Cassandra optmizes size tiered compaction by ignoring sstables that are
not read. Under specific cases this may cause an explosion of sstables.

--- src/blackbox/src/leela/blackbox/storage/cassandra.clj
+++ src/blackbox/src/leela/blackbox/storage/cassandra.clj
@@ -56,7 +56,7 @@
                cluster colfam
                (if-not-exists)
                (column-definitions {:key :uuid :name :varchar :bucket :bigint :slot :int :data :blob :primary-key [[:key :name :bucket] :slot]})
-               (with {:compaction {:class "SizeTieredCompactionStrategy" :min_threshold "6"}}))))))
+               (with {:compaction {:class "SizeTieredCompactionStrategy" :cold_reads_to_omit "0"}}))))))
   (when-not (describe-table cluster keyspace :k_attr)
     (warn "creating table k_attr")
     (create-table


Including clojure/core.incubator for -?> macro.

--- KataTrigrams/project.clj
+++ KataTrigrams/project.clj
@@ -2,6 +2,7 @@
   :description "Random text generator using trigrams."
   :url "https://github.com/bfontaine/Katas"
   :dependencies [[org.clojure/clojure "1.3.0"]
-                 [org.clojure/data.json "0.2.2"]]
+                 [org.clojure/data.json "0.2.2"]
+                 [org.clojure/core.incubator "0.1.2"]]
   :main kata-trigrams.cli
   :repl-init kata-trigrams.core)


refactor tests

refactor tests

--- test/flo_invest/database_test.clj
+++ test/flo_invest/database_test.clj
@@ -58,22 +58,22 @@
     ;; Insert security date for ACME 2012-1-1
     ;; Add a new company also called ACME on 2012-5-1
     ;; Rename first ACME to Silly corp on 2013-1-1
-    (let [row1 {:name "ACME corp" :isin "de1234567890" :date_added (date-time 2012 1 1)}
-          row2 {:name "ACME corp"
-                :isin "de1234567891" :date_added (date-time 2012 5 1)}
-          row3 {:name "Silly corp (formerly ACME)"
-                :isin "de1234567890" :date_added (date-time 2013 1 1)}
-          res1 (assoc  row1 :date_added (to-string (row1 :date_added)) :id 1)
-          res2 (assoc  row2 :date_added (to-string (row2 :date_added)) :id 2)
-          res3 (assoc  row3 :date_added (to-string (row3 :date_added)) :id 3)]
-      (add-security test-conn row1)
-      (add-security test-conn row2)
-      (add-security test-conn row3)
+    (let [rows [{:name "ACME corp"
+                 :isin "de1234567890" :date_added (date-time 2012 1 1)}
+                {:name "ACME corp"
+                 :isin "de1234567891" :date_added (date-time 2012 5 1)}
+                {:name "Silly corp (formerly ACME)"
+                 :isin "de1234567890" :date_added (date-time 2013 1 1)}]
+          order [0 1 2]
+          [res1 res2 res3] (for [[row num] (map vector rows (map (zipmap order [1 2 3]) [0 1 2]))]
+                             (assoc row :date_added (to-string (row :date_added)) :id num))
+          ]
+      (doseq [row (map rows order)] (add-security test-conn row))
       (is (= (set (db-read-all test-conn)) #{res1 res2 res3}))
       (is (= (set (db-read-date test-conn (date-time 2011))) #{}))
       (is (= (set (db-read-date test-conn (date-time 2012 2 1))) #{res1}))
       (is (= (set (db-read-date test-conn (date-time 2012 6 1))) #{res1 res2}))
-      (is (= (set (db-read-date test-conn (date-time 2013 6 1))) #{ res2 res3}))
+      (is (= (set (db-read-date test-conn (date-time 2013 6 1))) #{res2 res3}))
       )))

 (deftest query-date-snapshots-permutated
@@ -81,20 +81,20 @@
     ;; Insert security date for ACME 2012-1-1
     ;; Add a new company also called ACME on 2012-5-1
     ;; Rename first ACME to Silly corp on 2013-1-1
-    (let [row1 {:name "ACME corp" :isin "de1234567890" :date_added (date-time 2012 1 1)}
-          row2 {:name "ACME corp"
-                :isin "de1234567891" :date_added (date-time 2012 5 1)}
-          row3 {:name "Silly corp (formerly ACME)"
-                :isin "de1234567890" :date_added (date-time 2013 1 1)}
-          res1 (assoc  row1 :date_added (to-string (row1 :date_added)) :id 2)
-          res2 (assoc  row2 :date_added (to-string (row2 :date_added)) :id 3)
-          res3 (assoc  row3 :date_added (to-string (row3 :date_added)) :id 1)]
-      (add-security test-conn row3)
-      (add-security test-conn row1)
-      (add-security test-conn row2)
+    (let [rows [{:name "ACME corp"
+                 :isin "de1234567890" :date_added (date-time 2012 1 1)}
+                {:name "ACME corp"
+                 :isin "de1234567891" :date_added (date-time 2012 5 1)}
+                {:name "Silly corp (formerly ACME)"
+                 :isin "de1234567890" :date_added (date-time 2013 1 1)}]
+          order [2 0 1]
+          [res1 res2 res3] (for [[row num] (map vector rows (map (zipmap order [1 2 3]) [0 1 2]))]
+                              (assoc row :date_added (to-string (row :date_added)) :id num))
+          ]
+      (doseq [row (map rows order)] (add-security test-conn row))
       (is (= (set (db-read-all test-conn)) #{res1 res2 res3}))
       (is (= (set (db-read-date test-conn (date-time 2011))) #{}))
       (is (= (set (db-read-date test-conn (date-time 2012 2 1))) #{res1}))
       (is (= (set (db-read-date test-conn (date-time 2012 6 1))) #{res1 res2}))
-      (is (= (set (db-read-date test-conn (date-time 2013 6 1))) #{ res2 res3}))
+      (is (= (set (db-read-date test-conn (date-time 2013 6 1))) #{res2 res3}))
       )))


Testing cnstr records using pre/post maps

--- test/fogus/me/invariant_tests.clj
+++ test/fogus/me/invariant_tests.clj
@@ -21,7 +21,7 @@
   Object
   (toString [this] (str "record Foo has " a " and " b)))

-(deftest test-constrained-record
+(deftest test-constrained-record-with-vector-spec
   (is (= (:a (new-Foo)) 1))
   (is (= (:b (new-Foo)) 2))
   (is (= (:a (new-Foo :a 42)) 42))
@@ -33,3 +33,23 @@
   (is (= (:c (new-Foo :a 42 :b 108 :c 36)) 36))
   (is (thrown? Error (new-Foo :a :b)))
   (is (thrown? Error (new-Foo :a 42 :b nil))))
+
+;; testing default clojure pre/post maps
+
+(defconstrainedrecord Bar [a 1 b 2]
+  {:pre [(every? number? [a b])]}
+  Object
+  (toString [this] (str "record Bar has " a " and " b)))
+
+(deftest test-constrained-record-with-map-spec
+  (is (= (:a (new-Bar)) 1))
+  (is (= (:b (new-Bar)) 2))
+  (is (= (:a (new-Bar :a 42)) 42))
+  (is (= (:b (new-Bar :b 108)) 108))
+  (is (= (:a (new-Bar :a 42 :b 108)) 42))
+  (is (= (:b (new-Bar :a 42 :b 108)) 108))
+  (is (= (:a (new-Bar :a 42 :b 108 :c 36)) 42))
+  (is (= (:b (new-Bar :a 42 :b 108 :c 36)) 108))
+  (is (= (:c (new-Bar :a 42 :b 108 :c 36)) 36))
+  (is (thrown? Error (new-Bar :a :b)))
+  (is (thrown? Error (new-Bar :a 42 :b nil))))


update coll column layout, dynamically toggle upload button

--- src-cljs/imago/collection.cljs
+++ src-cljs/imago/collection.cljs
@@ -44,7 +44,8 @@
   (swap! local update-in [:files] dissoc id)
   (dom/remove! (dom/by-id id))
   (when (empty? (:files @local))
-    (dom/show! (dom/by-id "drop-msg"))))
+    (dom/show! (dom/by-id "drop-msg"))
+    (dom/add-class! (dom/by-id "bt-upload") "disabled")))

 (defn remove-all-files
   [state local])
@@ -82,6 +83,7 @@
               (swap! local update-in [:files] assoc id file))
             (recur (inc i)))))
       (dom/remove-class! (dom/by-id "dropzone-wrapper") "dropzone-active")
+      (dom/remove-class! (dom/by-id "bt-upload") "disabled")
       (debug @local))))

 (defn show-template
@@ -103,10 +105,10 @@
               [:h2#drop-msg.text-center "Drop media files here"]]]
             [:div.row
              [:div.col-xs-12
-              [:button#bt-upload.btn.btn-primary.btn-lg
+              [:button#bt-upload.btn.btn-primary.btn-lg.disabled
                {:events [[:click (upload-files state local)]]}
                "Upload media"] " "
-              [:button#bt-upload.btn.btn-default.btn-lg
+              [:button#bt-upload-cancel.btn.btn-default.btn-lg
                {:disabled "disabled"
                 :events [[:click (remove-all-files state local)]]}
                "Cancel all"]]]))
@@ -115,7 +117,7 @@
            [:h3 [:span.label.label-default (count (:items @local))] " items in collection..."]]]
          [:div.row
           (for [{:syms [?thumb ?xl]} (:items @local)]
-            [:div.col-xs-2
+            [:div.col-xs-4.col-md-2
              [:a.thumbnail {:href (str "/media/image/" ?xl)}
               [:img {:src (str "/media/image/" ?thumb)}]]])]
          ])))


Slowdown events

Slowdown events

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -170,7 +170,7 @@
              biome (.get b (:x pos) (:y pos))]
         (not (= (.name biome) "OCEAN"))))))

-(def fastness 1000)
+(def fastness 10000)

 (defn settlements-around [pos radius]
   (let [cx (:x pos)


[FIX #1602] Trim whitespace from passphrase during account recovery

Currently account recovery includes whitespace on either side of the
passphrase, preventing recovery of the desired account.

We trim that whitespace in the account-recovery-fx

--- src/status_im/ui/screens/accounts/recover/events.cljs
+++ src/status_im/ui/screens/accounts/recover/events.cljs
@@ -16,7 +16,10 @@
 (reg-fx
   ::recover-account-fx
   (fn [[passphrase password]]
-    (status/recover-account passphrase password #(dispatch [:account-recovered %]))))
+    (status/recover-account
+     (str/trim passphrase)
+     password
+     #(dispatch [:account-recovered %]))))

 ;;;; Handlers

@@ -45,4 +48,3 @@
   :recover-account
   (fn [_ [_ passphrase password]]
     {::recover-account-fx [passphrase password]}))
-


[#5934] persist text in message input field after navigating to user profile and back

--- src/status_im/ui/screens/desktop/main/chat/views.cljs
+++ src/status_im/ui/screens/desktop/main/chat/views.cljs
@@ -180,35 +180,40 @@
                     :current-public-key current-public-key)]))]]
        [connectivity/error-view]])))

-(views/defview chat-text-input []
+(views/defview chat-text-input [chat-id input-text]
   (views/letsubs [inp-ref (atom nil)]
-    (let [component              (reagent/current-component)
+    {:should-component-update
+     (fn [_ [_ old-chat-id] [_ new-chat-id]]
+       ;; update component only when switch to another chat
+       (not= old-chat-id new-chat-id))}
+    (let [component               (reagent/current-component)
           set-container-height-fn #(reagent/set-state component {:container-height %})
           {:keys [container-height empty?] :or {empty? true}} (reagent/state component)]
       [react/view {:style (styles/chat-box container-height)}
-       [react/text-input {:placeholder    (i18n/label :t/type-a-message)
-                          :auto-focus     true
-                          :multiline      true
-                          :blur-on-submit true
-                          :style          (styles/chat-text-input container-height)
-                          :font           :default
-                          :ref            #(reset! inp-ref %)
+       [react/text-input {:placeholder            (i18n/label :t/type-a-message)
+                          :auto-focus             true
+                          :multiline              true
+                          :blur-on-submit         true
+                          :style                  (styles/chat-text-input container-height)
+                          :font                   :default
+                          :ref                    #(reset! inp-ref %)
+                          :default-value          input-text
                           :on-content-size-change #(set-container-height-fn (.-height (.-contentSize (.-nativeEvent %))))
-                          :on-key-press   (fn [e]
-                                            (let [native-event (.-nativeEvent e)
-                                                  key (.-key native-event)
-                                                  modifiers (js->clj (.-modifiers native-event))
-                                                  should-send (and (= key "Enter") (not (contains? (set modifiers) "shift")))]
-                                              (when should-send
-                                                (.clear @inp-ref)
-                                                (.focus @inp-ref)
-                                                (re-frame/dispatch [:send-current-message]))))
-                          :on-change      (fn [e]
-                                            (let [native-event (.-nativeEvent e)
-                                                  text (.-text native-event)]
-                                              (reagent/set-state component {:empty? (= "" text)})
-                                              (re-frame/dispatch [:set-chat-input-text text])))}]
-       [react/touchable-highlight {:style styles/send-button
+                          :on-key-press           (fn [e]
+                                                    (let [native-event (.-nativeEvent e)
+                                                          key          (.-key native-event)
+                                                          modifiers    (js->clj (.-modifiers native-event))
+                                                          should-send  (and (= key "Enter") (not (contains? (set modifiers) "shift")))]
+                                                      (when should-send
+                                                        (.clear @inp-ref)
+                                                        (.focus @inp-ref)
+                                                        (re-frame/dispatch [:send-current-message]))))
+                          :on-change              (fn [e]
+                                                    (let [native-event (.-nativeEvent e)
+                                                          text         (.-text native-event)]
+                                                      (reagent/set-state component {:empty? (= "" text)})
+                                                      (re-frame/dispatch [:set-chat-input-text text])))}]
+       [react/touchable-highlight {:style    styles/send-button
                                    :on-press (fn []
                                                (.clear @inp-ref)
                                                (.focus @inp-ref)
@@ -217,11 +222,11 @@
          [icons/icon :icons/arrow-left {:style (styles/send-icon-arrow empty?)}]]]])))

 (views/defview chat-view []
-  (views/letsubs [current-chat [:get-current-chat]]
+  (views/letsubs [{:keys [input-text chat-id] :as current-chat} [:get-current-chat]]
     [react/view {:style styles/chat-view}
      [toolbar-chat-view current-chat]
      [messages-view current-chat]
-     [chat-text-input]]))
+     [chat-text-input chat-id input-text]]))

 (views/defview chat-profile []
   (letsubs [identity        [:get-current-contact-identity]


use transform-with-english-lexical-rules

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -1,11 +1,12 @@
 (ns babel.english.grammar
   (:refer-clojure :exclude [get-in])
   (:require
-   [babel.english.lexicon :refer [deliver-lexicon vocab-entry-to-lexeme]]
+   [babel.english.lexicon :refer [deliver-lexicon transform-with-english-lexical-rules
+                                  vocab-entry-to-lexeme]]
    [babel.english.morphology :refer (analyze fo)]
    [babel.generate :as generate]
    [babel.index :refer [create-indices lookup-spec]]
-   [babel.lexiconfn :refer [edn2lexicon read-lexicon]]
+   [babel.lexiconfn :refer [edn2lexicon filtered-lexicon read-lexicon]]
    [babel.parse :as parse]
    [babel.ug :as ug
     :refer [apply-default-if comp-modifies-head
@@ -116,6 +117,7 @@
     [result]))

 (declare cache)
+(declare model-with-vocab-items)

 (defn fo-ps [expr]
   (parse/fo-ps expr fo))
@@ -517,13 +519,6 @@
    (if (get-in tree [:head])
      {:head (morph-walk-tree (get-in tree [:head]))})))

-(defn compile-lexicon []
-  (into {}
-        (for [[k v] (deliver-lexicon)]
-          (let [filtered-v v]
-            (if (not (empty? filtered-v))  ;; TODO: this empty-filtering should be done in lexicon.cljc, not here.
-              [k filtered-v])))))
-
 (defn model []
   (let [debug (log/info "  loading lexicon..")
         lexicon (read-lexicon "en")
@@ -557,19 +552,28 @@
          :lookup (fn [arg]
                    (analyze arg lexicon))
          :morph morph
-         :morph-ps fo-ps}]
+         :morph-ps fo-ps
+
+         :vocab2model (fn [vocab-items filter-lexicon-fn]
+                        (model-with-vocab-items vocab-items filter-lexicon-fn model))}]
     (assoc model
           :generate-fn
           (fn [spec]
             (generate/generate spec model)))))

 (defn model-with-vocab-items [vocab-items filter-lexicon-fn model]
-  (let [input-lexicon (reduce merge (map vocab-entry-to-lexeme vocab-items))
-        synthetic-noun (babel.lexiconfn/edn2lexicon input-lexicon)
-        new-lexicon (merge-with concat
-                                synthetic-noun
-                                (babel.lexiconfn/filtered-lexicon
-                                 (:lexicon model)
-                                 filter-lexicon-fn))]
+  (let [input-lexicon (transform-with-english-lexical-rules
+                       (reduce merge (map vocab-entry-to-lexeme vocab-items)))
+        model (merge model
+                     {:lexicon
+                      (merge-with concat
+                                  input-lexicon
+                                  (filtered-lexicon
+                                   (:lexicon model)
+                                   filter-lexicon-fn))})]
     (merge model
-           {:lexicon new-lexicon})))
+           {:generate-fn (fn [spec]
+                           (generate/generate spec model))})))
+
+
+


move real-world stuff to encyclopedia

move real-world stuff to encyclopedia

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -377,11 +377,7 @@
              :sem {:pred :can}}}

    "car" {:synsem {:cat :noun
-                   :sem {:pred :car
-                         :animate false
-                         :artifact true
-                         :edible false
-                         :place false}}}
+                   :sem {:pred :car}}}

    "carry" {:synsem {:cat :verb
                      :sem {:human true