enumerate tense, number, person, and gender, as with Italian

--- src/babel/english/writer.clj
+++ src/babel/english/writer.clj
@@ -17,6 +17,7 @@
          (map (fn [lexeme-set]
                 (filter (fn [lexeme]
                           (and
+                           (or true (= (get-in lexeme [:synsem :sem :pred]) :talk)) ;; for development, restrict :pred to a single value.
                            (= (get-in lexeme [:synsem :cat]) :verb)
                            (= (get-in lexeme [:synsem :infl]) :top)
                            (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
@@ -32,11 +33,52 @@
                     (.size (map (fn [tense]
                                   (let [spec (unify {:root {:english {:english root-form}}}
                                                     tense)]
-                                    (log/debug (str "generating from: " spec))
-                                    (process [{:fill-with-language
-                                               {:spec spec
-                                                :model small-plus-vp-pronoun
-                                                :count count}}] "en")))
+                                    (.size
+                                     (map (fn [gender]
+                                            (let [spec (unify spec
+                                                              {:comp {:synsem {:agr gender}}})]
+                                              (log/trace (str "generating from gender: " gender))
+                                              (.size
+                                               (map (fn [person]
+                                                      (let [spec (unify spec
+                                                                        {:comp {:synsem {:agr {:person person}}}})]
+                                                        (log/trace (str "generating from person: " person))
+                                                        (.size
+                                                         (map (fn [number]
+                                                                (let [spec (unify spec
+                                                                                {:comp {:synsem {:agr {:number number}}}})]
+                                                                  (log/debug (str "generating from spec: " spec))
+                                                                  (try
+                                                                    (process [{:fill-one-language
+                                                                               {:count 1
+                                                                                :spec spec
+                                                                                :model small
+                                                                                }}]
+                                                                             "it")
+                                                                    (catch Exception e
+                                                                      (cond
+
+                                                                       ;; TODO: make this conditional on
+                                                                       ;; there being a legitimate reason for the exception -
+                                                                       ;; e.g. the verb is "works (nonhuman)" (which takes a non-human
+                                                                       ;; subject), but we're trying to generate with
+                                                                       ;; {:agr {:person :1st or :2nd}}, for which the only lexemes
+                                                                       ;; are human.
+                                                                       true
+
+                                                                       (log/warn (str "ignoring exception: " e))
+                                                                       false
+                                                                       (throw e))))
+                                                                  ))
+                                                              [:sing :plur]))))
+                                                    [:1st :2nd :3rd]))))
+                                          (cond (= tense
+                                                   {:synsem {:sem {:aspect :perfect
+                                                                   :tense :past}}})
+                                                [{:gender :masc}
+                                                 {:gender :fem}]
+                                                true
+                                                [:top])))))
                                 (list {:synsem {:sem {:tense :conditional}}}
                                       {:synsem {:sem {:tense :future}}}
                                       {:synsem {:sem {:tense :present}}}


optimize checking of hooks by avoiding empty? which uses seq in favor of java isEmpty method

--- src/clj/backtype/storm/daemon/task.clj
+++ src/clj/backtype/storm/daemon/task.clj
@@ -64,10 +64,13 @@
 (defn get-context-hooks [^TopologyContext context]
   (.getHooks context))

+(defn hooks-empty? [^Collection hooks]
+  (.isEmpty hooks))
+
 (defmacro apply-hooks [topology-context method-sym info-form]
   (let [hook-sym (with-meta (gensym "hook") {:tag 'backtype.storm.hooks.ITaskHook})]
     `(let [hooks# (get-context-hooks ~topology-context)]
-       (when-not (empty? hooks#)
+       (when-not (hooks-empty? hooks#)
          (let [info# ~info-form]
            (fast-list-iter [~hook-sym hooks#]
              (~method-sym ~hook-sym info#)


Fix to get id of programme allowed

Fix to get id of programme allowed

--- src/clj/kixi/hecuba/api/programmes.clj
+++ src/clj/kixi/hecuba/api/programmes.clj
@@ -31,13 +31,12 @@
   (let [allowed-programme-ids      (into #{} (keys allowed-programmes))
         allowed-project-ids        (into #{} (keys allowed-projects))]
     (->> all-programmes
-         (map (fn [programme]
+         (keep (fn [programme]
                 (let [programme-id (:programme_id programme)]
                   (cond
                    (some #{programme-id} allowed-programme-ids) (enrich-by-role (get allowed-programmes programme-id) programme)
                    (some #{programme-id} programme-ids-for-projects) (enrich-by-role :kixi.hecuba.security/user programme)
-                   (:public_access programme) (assoc programme :editable false)))))
-         (remove nil?))))
+                   (:public_access programme) (assoc programme :editable false))))))))

 (defn allowed?*
   ([allowed-programmes allowed-projects role request-method store]
@@ -64,10 +63,10 @@
                  request-method]

                 [true _ _ _]    [true {::item (assoc (programmes/get-by-id session programme_id) :editable true :admin true)}]
-                [_ true _ _]    [true {::item (filter-programmes allowed-programmes allowed-projects programme-ids-for-projects
-                                                                 [(programmes/get-by-id session programme_id)])}]
-                [_ _ true :get] [true {::item (filter-programmes allowed-programmes allowed-projects programme-ids-for-projects
-                                                                 [(programmes/get-by-id session programme_id)])}]
+                [_ true _ _]    [true {::item (first (filter-programmes allowed-programmes allowed-projects programme-ids-for-projects
+                                                                        [(programmes/get-by-id session programme_id)]))}]
+                [_ _ true :get] [true {::item (first (filter-programmes allowed-programmes allowed-projects programme-ids-for-projects
+                                                                        [(programmes/get-by-id session programme_id)]))}]
                 :else false)))))

 (defn index-allowed? [store]


repack fn

repack fn

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -556,11 +556,7 @@
     (swap! page-state #(-> %
                           (assoc :transaction-entry-mode mode
                                  :unprep-fn unprep-fn)
-                          (update-in [:transaction] #_(comp prep-fn unprep-fn)
-                                     (fn [trx]
-                                       (let  [unprepped (current-unprep-fn trx)
-                                              prepped (prep-fn unprepped)]
-                                         prepped)))))))
+                          (update-in [:transaction] (comp prep-fn current-unprep-fn))))))

 (defn- transaction-form-nav-tab
   [mode {:keys [disabled? hidden?]} page-state]


send blank track to now-playing when stopped and send current track when play is clicked

--- src/cljs/cljspazzer/client/player.cljs
+++ src/cljs/cljspazzer/client/player.cljs
@@ -23,6 +23,12 @@
       :seek-forward (aset audio-node "currentTime" (+ (.-currentTime audio-node) 1))
       (.pause audio-node))))

+(defn set-track [track offset owner]
+  (om/set-state! owner :current-offset offset)
+  (aset audio-node "src" (tracks/mk-track-url track))
+  (ctrl-audio-node :play)
+  (put! channels/now-playing track))
+
 (defn audio-elem [data owner]
   (reify
     om/IInitState
@@ -35,14 +41,9 @@
        :end-position 0})
     om/IWillMount
     (will-mount [this]
-      (let [set-track (fn [track offset]
-                        (om/set-state! owner :current-offset offset)
-                        (aset audio-node "src" (tracks/mk-track-url track))
-                        (ctrl-audio-node :play)
-                        (put! channels/now-playing track))]
-        (go (loop []
+      (go (loop []
               (let [track-src (<! channels/track-list)]
-                (set-track (first track-src) 1)
+                (set-track (first track-src) 1 owner)
                 (om/set-state! owner :current-src track-src))
               (recur)))
         (go (loop []
@@ -53,16 +54,21 @@
                     track-src (om/get-state owner :current-src)
                     next-track (last (take next-offset track-src))
                     previous-track (last (take previous-offset track-src))
+                    current-track (last (take current-offset track-src))
                     ]
                 (om/set-state! owner :ctrl ctrl)
                 (cond
                   (and (= ctrl :next) (> next-offset (count track-src)))
                   (ctrl-audio-node :stop)
                   (and (= ctrl :next) (not (nil? next-track)))
-                  (set-track next-track next-offset)
+                  (set-track next-track next-offset owner)
                   (and (= ctrl :previous) (not (nil? previous-track)))
-                  (set-track previous-track previous-offset)
-                  :else (ctrl-audio-node ctrl)))
+                  (set-track previous-track previous-offset owner)
+                  :else (do (ctrl-audio-node ctrl)
+                            (when (= ctrl :stop)
+                              (put! channels/now-playing {"track" {}}))
+                            (when (= ctrl :play)
+                              (put! channels/now-playing current-track)))))
               (recur)))
         (go (loop []
               (<! channels/stream-position)
@@ -75,8 +81,7 @@
                   (do
                     (om/set-state! owner :current-position c)
                     (om/set-state! owner :end-position e))))
-              (recur)))
-        ))
+              (recur))))
     om/IRender
     (render [this]
       (let [ctrl-current (om/get-state owner :ctrl)


hide iframe on small screens

hide iframe on small screens

--- src/cljs/ikea_clojure_cup/pack_it.cljs
+++ src/cljs/ikea_clojure_cup/pack_it.cljs
@@ -47,7 +47,7 @@
          [:h3 "Preview:"]
          (if (= :no (:result result-state))
            [:p "N/A"]
-           [:p
-            "In the below box, you can pan around and zoom in and out to see how to stack your packages."
-            [:iframe {:width "800" :height "500" :src (str "/ikea/preview?bins=" (-> result-state :preview :bins) "&items=" (-> result-state :preview :items))}]])]]])))
-
+           [:div
+            [:p.hidden-xs "In the below box, you can pan around and zoom in and out to see how to stack your packages."
+             [:iframe.hidden-xs {:width "800" :height "500" :src (str "/ikea/preview?bins=" (-> result-state :preview :bins) "&items=" (-> result-state :preview :items))}]]
+            [:p.visible-xs "3D preview showing how stack the packages is not available when viewing on small screen devices. Please try again on a larger screen."]])]]])))


feature #4183 - token transfer history gets actual transaction timestamp from block info

Signed-off-by: Julien Eluard <c768e13f1ba4c3ebed2909a1fc1e4b50bb021a2f@gmail.com>

--- src/status_im/utils/ethereum/erc20.cljs
+++ src/status_im/utils/ethereum/erc20.cljs
@@ -82,30 +82,27 @@
   (if topic
     (str "0x" (subs topic 26))))

-(defn- parse-transaction-entry [block-number chain direction entries]
+(defn- parse-transaction-entries [current-block-number block-info chain direction transfers]
   (into {}
-        (for [entry entries]
-          (let [token (->> entry :address (tokens/address->token chain))]
-            [(:transactionHash entry)
-             {:block         (-> entry :blockNumber ethereum/hex->int str)
-              :hash          (:transactionHash entry)
+        (for [transfer transfers]
+          (let [token (->> transfer :address (tokens/address->token chain))]
+            [(:transactionHash transfer)
+             {:block         (-> block-info :number str)
+              :hash          (:transactionHash transfer)
               :symbol        (:symbol token)
-              :from          (-> entry :topics second remove-padding)
-              :to            (-> entry :topics last remove-padding)
-              :value         (-> entry :data ethereum/hex->bignumber)
+              :from          (-> transfer :topics second remove-padding)
+              :to            (-> transfer :topics last remove-padding)
+              :value         (-> transfer :data ethereum/hex->bignumber)
               :type          direction

-              :confirmations (str (- block-number (-> entry :blockNumber ethereum/hex->int)))
+              :confirmations (str (- current-block-number (-> transfer :blockNumber ethereum/hex->int)))

               :gas-price     nil
               :nonce         nil
               :data          nil

               :gas-limit     nil
-              ;; NOTE(goranjovic) - timestamp is mocked to the current time so that the transaction is shown at the
-              ;; top of transaction history list between the moment when transfer event was detected and actual
-              ;; timestamp was retrieved from block info.
-              :timestamp     (str (datetime/timestamp))
+              :timestamp     (-> block-info :timestamp (* 1000) str)

               :gas-used      nil

@@ -117,7 +114,18 @@
               ;; confirmations count.
               :transfer      true}]))))

-(defn- response-handler [block-number chain direction error-fn success-fn]
+(defn add-block-info [web3 current-block-number chain direction result success-fn]
+  (let [transfers-by-block (group-by :blockNumber result)]
+    (doseq [[block-number transfers] transfers-by-block]
+      (ethereum/get-block-info web3 (ethereum/hex->int block-number)
+                               (fn [block-info]
+                                 (success-fn (parse-transaction-entries current-block-number
+                                                                        block-info
+                                                                        chain
+                                                                        direction
+                                                                        transfers)))))))
+
+(defn- response-handler [web3 current-block-number chain direction error-fn success-fn]
   (fn handle-response
     ([response]
      (let [{:keys [error result]} (parse-json response)]
@@ -125,7 +133,7 @@
     ([error result]
      (if error
        (error-fn error)
-       (success-fn (parse-transaction-entry block-number chain direction result))))))
+       (add-block-info web3 current-block-number chain direction result success-fn)))))

 ;;
 ;; Here we are querying event logs for Transfer events.
@@ -139,8 +147,9 @@
 ;;

 (defn get-token-transfer-logs
-  ;; NOTE(goranjovic): here we cannot use web3 since events don't work with infura
-  [block-number network contracts direction address cb]
+  ;; NOTE(goranjovic): here we use direct JSON-RPC calls to get event logs because of web3 event issues with infura
+  ;; we still use web3 to get other data, such as block info
+  [web3 current-block-number network contracts direction address cb]
   (let [chain (ethereum/network->chain-keyword network)
         [from to] (if (= :inbound direction)
                     [nil (ethereum/normalized-address address)]
@@ -155,9 +164,9 @@
                                      (add-padding to)]}]}
         payload (.stringify js/JSON (clj->js args))]
     (status/call-web3-private payload
-                              (response-handler block-number chain direction ethereum/handle-error cb))))
+                              (response-handler web3 current-block-number chain direction ethereum/handle-error cb))))

 (defn get-token-transactions
   [web3 network contracts direction address cb]
   (ethereum/get-block-number web3
-                             #(get-token-transfer-logs % network contracts direction address cb)))
+                             #(get-token-transfer-logs web3 % network contracts direction address cb)))


adding a function to import the old database dump into the new database

--- src/bitfondue/migrations.clj
+++ src/bitfondue/migrations.clj
@@ -2,6 +2,8 @@
   (:require (ragtime [jdbc :as jdbc]
                      [repl :as repl])
             [bitfondue.config :as config]
+            (bitfondue.models [chunks :as chunks]
+                              [users :as users])
             [cheshire.core :refer :all]))

 ;; Database Migrations
@@ -31,3 +33,12 @@
     (doall (->> rdr
                 line-seq
                 (map #(parse-string % true))))))
+
+(defn import-old-data
+  "Parses the old database dump and imports it"
+  []
+  (doseq [item (parse-json-line-items "existing_data.json")]
+    (->> item
+         :tab_info
+         chunks/insert-chunk!)))
+


good so far

good so far

--- src/bluebell/utils/trace.clj
+++ src/bluebell/utils/trace.clj
@@ -105,11 +105,47 @@
       parse-spec
       check-no-invalid-blocks))

-(defn disp-parsed [])
+(declare disp-parsed)

-(defn disp-trace [trace]
-  (if (fn? trace)
-    (disp-trace (trace))
-    (-> trace
-        parse
-        (disp-parsed ""))))
+(defn ns2str [ns]
+  (format "%.3g ms" (* 1.0e-6 (double ns))))
+
+(defn disp-item [item indent cfg]
+  (println (str indent (:value item)
+                " at " (ns2str (- (:time item)
+                                  (:start cfg)))
+                (if (contains? item :dur)
+                  (str " (dur=" (ns2str (:dur item)) ")")
+                  ""))))
+
+(defn disp-block-bd [bd indent cfg]
+  (disp-item (update bd :value :value) indent cfg))
+
+(defn disp-block [block indent cfg]
+  (let [dur (- (-> block :end :time)
+               (-> block :begin :time))]
+    (disp-block-bd (:begin block) indent cfg)
+    (disp-parsed (:trace block) (str indent " | ") cfg)
+    (disp-block-bd (merge (:end block)
+                          {:dur dur}) indent cfg)))
+
+(defn disp-parsed [trace-data indent cfg]
+  (doseq [[item-type item-data] trace-data]
+    (case item-type
+      :block (disp-block item-data indent cfg)
+      :item (disp-item item-data indent cfg))))
+
+(defn start-time [trace]
+  (-> trace
+      first
+      second))
+
+
+(defn disp-trace
+  ([trace] (disp-trace trace {}))
+  ([trace cfg0]
+   (if (fn? trace)
+     (disp-trace (trace))
+     (-> trace
+         parse
+         (disp-parsed "" (merge cfg0 {:start (start-time trace)}))))))


bug fix release for sp pages

bug fix release for sp pages

--- src/ontrail/pages.clj
+++ src/ontrail/pages.clj
@@ -21,8 +21,10 @@

 (defn parse-int [^String int-str]
   (try
+    (.info logger int-str)
     (Integer/parseInt int-str)
     (catch Exception e
+      (.info logger (str e))
       0)))

 (defn truncate
@@ -42,9 +44,13 @@
         :body (str exception#)})))

 (defn to-dur-str [params]
-  (str (parse-int (:duration.h params)) "h"
-       (parse-int (:duration.m params)) "m"
-       (parse-int (:duration.s params)) "s"))
+  (.info logger (str params))
+  (.info logger (str (str (parse-int (params "duration.h")) "h"
+       (parse-int (params "duration.m")) "m"
+       (parse-int (params "duration.s")) "s")))
+  (str (str (parse-int (params "duration.h")) "h"
+            (parse-int (params "duration.m")) "m"
+            (parse-int (params "duration.s")) "s")))

 (defn redirect [page]
   {:status 301
@@ -169,8 +175,9 @@
      [:input {:name "duration.h" :type "number" :max "99" :min "0"}] "h"
      [:input {:name "duration.m" :type "number" :max "59" :min "0"}] "m"
      [:input {:name "duration.s" :type "number" :max "59" :min "0"}] "s" [:br]
+     (span-w "Matka: ") [:input {:name "distance"}] [:br]
+
      (span-w "Syke: ") [:input {:name "avghr" :type "number" :min "0" :max "200"}] [:br]
-     (span-w "Matka: ") [:input {:name "distance"}] [:br]
      (span-w "Päivä: ") [:input {:name "date" :type "date" :value "today"}] [:br]
      "Kuvaus:" [:br]
      [:textarea {:name "body" :rows "8" :cols "25"}]
@@ -218,10 +225,11 @@
          (render-with addex {:params params :sports nlp/sports :user user})))

   (POST "/sp/addex" {params :params cookies :cookies}
+        (.info logger (str params))
         (if (auth/valid-auth-token? (:value (cookies "authToken")))
           (let [params-with-dur (assoc params :duration (to-dur-str params))
                 posted (mutate/create-ex (auth/user-from-cookie cookies) params-with-dur)]
-            (redirect (url "/sp/ex/" (:id  posted))))
+            (redirect (url "/ex/" (:id  posted))))
           (redirect "/s/login.html")))

   (GET "/sp" {cookies :cookies}


remove konserve

remove konserve

--- src/ceres_collector/core.clj
+++ src/ceres_collector/core.clj
@@ -4,7 +4,6 @@
             [ceres-collector.mongo :as mongo]
             [ceres-collector.scheduler :as scheduler]
             [gezwitscher.core :refer [start-filter-stream gezwitscher]]
-            [konserve.protocols :refer [-get-in]]
             [clojure.java.io :as io]
             [taoensso.timbre :refer [info debug error warn] :as timbre]))

@@ -27,8 +26,7 @@
     (let [{{:keys [follow track credentials]} :app} @state
           db (mongo/init :name "juno")]
       (do
-        (when (:init? @state)
-          (mongo/create-index (:db db)))
+        (when (:init? @state) (mongo/create-index (:db db)))
         (start-filter-stream follow track (fn [status] (proc/process db status)) credentials)))
     (when (:backup? @state)
       (scheduler/start-jobs (:backup-folder @state)))


Handle DOIs with slashes in them.

Handle DOIs with slashes in them.

--- src/chronograph/handlers.clj
+++ src/chronograph/handlers.clj
@@ -91,13 +91,10 @@
                (ring-response (redirect (str "/dois/" (::doi ctx))))))

 (defresource doi-page
-  [doi-prefix doi-suffix]
-  :available-media-types ["text/html"]
-  :exists? (fn [ctx] (let [doi (str doi-prefix "/" doi-suffix)]
-            [doi {::doi doi}]))
-  :handle-ok (fn [ctx]
-               (let [doi (::doi ctx)
-                     events (d/get-doi-events doi)
+  [doi]
+  :available-media-types ["text/html"]
+  :handle-ok (fn [ctx]
+               (let [events (d/get-doi-events doi)
                      timelines (d/get-doi-timelines doi)

                      timeline-dates (apply merge (map #(keys (:timeline %)) timelines))
@@ -231,7 +228,7 @@
   (GET "/" [] (home))
   (context "/dois" []
     (GET "/" [] (dois-redirect))
-    (context ["/:doi-prefix/:doi-suffix" :doi-prefix #".+?" :doi-suffix #".+?"] [doi-prefix doi-suffix] (doi-page doi-prefix doi-suffix)))
+    (ANY "/*" {{doi :*} :params} (doi-page doi)))
   (context "/domains" []
     (GET "/" [] (domains-redirect))
     (context ["/:domain" :domain #".+?"] [domain] (domain-page domain)))
@@ -245,8 +242,7 @@
       (context ["/:doi-prefix/:doi-suffix/facts" :doi-prefix #".+?" :doi-suffix #".+?"] [doi-prefix doi-suffix] (doi-facts doi-prefix doi-suffix))
       (context ["/:doi-prefix/:doi-suffix/events" :doi-prefix #".+?" :doi-suffix #".+?"] [doi-prefix doi-suffix] (doi-events doi-prefix doi-suffix))))

-  (route/resources "/")
-  )
+  (route/resources "/"))

 (def app
   (-> app-routes


If you push return on People form, submit

--- src/cljs/herder/persons.cljs
+++ src/cljs/herder/persons.cljs
@@ -9,6 +9,16 @@

 (defn get-persons [& {:keys [refresh]}]
   (get-data :persons (persons-url) :refresh refresh))
+
+(defn create-new [val]
+  (POST (persons-url)
+    {:params @val
+     :format :json
+     :handler
+     (fn [resp]
+       (do
+         (reset! val {:fromTime nil :toTime nil})
+         (get-persons :refresh true)))}))

 (defn ^:export component []
   (let [val (r/atom {})]
@@ -26,7 +36,11 @@
                                               (fn [resp] (get-persons :refresh true))})}
                        (str "Delete " name)]])]
        [:hr]
-       [:form {:class "form-inline"}
+       [:form {:class "form-inline"
+               :on-submit #(do
+                             (.preventDefault %)
+                             (create-new val)
+                             false)}
         [:div {:class "form-group"}
          [:label {:for "name"} "Add Person with name"]
          [:input {:id "name"
@@ -39,12 +53,5 @@
          [:button {:type "button"
                    :class "btn btn-primary"
                    :style {:margin-left "5px"}
-                   :on-click #(do
-                                (.log js/console (pr-str @val))
-                                (POST (persons-url)
-                                  {:params @val
-                                   :format :json
-                                   :handler (fn [resp] (do
-                                                         (reset! val {:fromTime nil :toTime nil})
-                                                         (get-persons :refresh true)))}))}
+                   :on-click #(create-new val)}
           "Create a new person"]]]])))


make code simpler

make code simpler

--- src/cljs/tictactoe/core.cljs
+++ src/cljs/tictactoe/core.cljs
@@ -59,18 +59,14 @@
         {:on-click #(on-move-event x y)} {}))
     ))

-(defn render-board
-  [board-size]
-  [:svg.board
-   {:view-box (str "0 0 " board-size " " board-size)
-    :style {:max-height "500px"}}])
-
 (defn tictactoe
   []
   [:div
    [:h1 "tic tac toe"]
    (into
-     (render-board board-size)
+     [:svg.board
+      {:view-box (str "0 0 " board-size " " board-size)
+       :style {:max-height "500px"}}]
      (for [x (range board-size)
            y (range board-size)]
        [render-board-cell @app-state x y]


tids now written line by line

tids now written line by line

--- src/clueweb_disqus/posts.clj
+++ src/clueweb_disqus/posts.clj
@@ -218,8 +218,9 @@
                                    credentials
                                    (Long/parseLong associated-epoch)))
                   (binding [*out* deja-downloaded-wrtr]
-                    (println thread-id)
-                    (flush)))
+                    (doseq [t thread-id]
+                      (println t)
+                      (flush))))

                 ;; rename back the file
                 (.rename (io/as-file file-to-write)


enable :infer-externs :auto by default

enable :infer-externs :auto by default

users can always opt out by setting

   :compiler-options {:infer-externs true}

or false. true just doesn't warn unless *warn-on-infer* is set.

--- src/main/shadow/build/api.clj
+++ src/main/shadow/build/api.clj
@@ -70,7 +70,7 @@
    ;; :fn-invoke-direct true
    :elide-asserts false
    :closure-configurators []
-   :infer-externs true
+   :infer-externs :auto
    :language-in :ecmascript-next
    ;; still need to set this since it otherwise ends up using strict mode default
    :language-out :ecmascript5


added doall to distillery.tasks/map-fn

added doall to distillery.tasks/map-fn

--- src/distillery/tasks.clj
+++ src/distillery/tasks.clj
@@ -39,7 +39,10 @@
   The configuration var `distillery.configuration/parallel-proc`
   controls whether `pmap` or `map` is returned."
   []
-  (if (cfg/value :parallel-proc) pmap map))
+  (if (cfg/value :parallel-proc)
+    #(doall (pmap %1 %2))
+    #(doall (map %1 %2))))
+
 (def ^:private filter-map
   {:not-short proc/not-short?
    :noun proc/noun?


Revert "Merge pull request #74 from brycecovert/fix-input-issue"

This reverts commit 76b2699c62a84bcae20122474b7b92d963350c65, reversing
changes made to 6f37552ed63c0dd93d8ba58a9e555ed912e3eb03.

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -515,24 +515,20 @@
   (let [run-fn! (fn [k & args]
                   (doseq [screen screen-objects]
                     (apply (get screen k) args)))]
-    (when-let [old-screen (.getScreen game-object)]
-      (.dispose old-screen))
-    (on-gl
-     (.setScreen game-object
-                 (reify Screen
-                   (show [this]
-                     (input! :set-input-processor (InputMultiplexer.))
-                     (run-fn! :show)
-
-                     (doseq [{:keys [screen]} screen-objects]
-                       (doseq [[_ listener] (:input-listeners @screen)]
-                         (add-input! listener))))
-                   (render [this d] (run-fn! :render d))
-                   (hide [this] (run-fn! :hide))
-                   (pause [this] (run-fn! :pause))
-                   (resize [this w h] (run-fn! :resize w h))
-                   (resume [this] (run-fn! :resume))
-                   (dispose [this]))))))
+    (.setScreen game-object
+      (reify Screen
+        (show [this]
+          (input! :set-input-processor (InputMultiplexer.))
+          (run-fn! :show)
+          (doseq [{:keys [screen]} screen-objects]
+            (doseq [[_ listener] (:input-listeners @screen)]
+              (add-input! listener))))
+        (render [this d] (run-fn! :render d))
+        (hide [this] (run-fn! :hide))
+        (pause [this] (run-fn! :pause))
+        (resize [this w h] (run-fn! :resize w h))
+        (resume [this] (run-fn! :resume))
+        (dispose [this])))))

 (defn set-screen-wrapper!
   "Sets a function that wraps around all screen functions, allowing you to


Always clear layers in :on-show

Always clear layers in :on-show

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -98,6 +98,7 @@
                           :update-fn! update-fn!
                           :options options
                           :on-timer on-timer
+                          :layers nil
                           :input-listeners (input-listeners options execute-fn!)
                           :ui-listeners (ui-listeners options execute-fn!)])
              ; run :on-show


Update window width state when window resizes

Fixes #26

--- src/day8/re_frame/trace.cljs
+++ src/day8/re_frame/trace.cljs
@@ -318,34 +318,37 @@
 (defn devtools []
   ;; Add clear button
   ;; Filter out different trace types
-  (let [position          (r/atom :right)
-        panel-width% (r/atom (localstorage/get "panel-width-ratio" 0.35))
-        showing?          (r/atom (localstorage/get "show-panel" false))
-        dragging?         (r/atom false)
-        pin-to-bottom?    (r/atom true)
-        selected-tab      (r/atom :traces)
-        window-width      (r/atom js/window.innerWidth)
-        handle-keys       (fn [e]
-                           (let [combo-key?      (or (.-ctrlKey e) (.-metaKey e) (.-altKey e))
-                                 tag-name        (.-tagName (.-target e))
-                                 key             (.-key e)
-                                 entering-input? (contains? #{"INPUT" "SELECT" "TEXTAREA"} tag-name)]
-                             (when (and (not entering-input?) combo-key?)
-                               (cond
-                                 (and (= key "h") (.-ctrlKey e))
-                                 (do (swap! showing? not)
-                                     (toggle-traces showing?)
-                                     (.preventDefault e))))))
-        handle-mousemove  (fn [e]
-                           (when @dragging?
-                             (let [x (.-clientX e)
-                                   y (.-clientY e)
-                                   new-window-width js/window.innerWidth]
-                               (.preventDefault e)
-                               ;; Set a minimum width of 5% to prevent people from accidentally dragging it too small.
-                               (reset! panel-width% (max (/ (- new-window-width x) new-window-width) 0.05))
-                               (reset! window-width new-window-width))))
-        handle-mouse-up   (fn [e] (reset! dragging? false))]
+  (let [position             (r/atom :right)
+        panel-width%         (r/atom (localstorage/get "panel-width-ratio" 0.35))
+        showing?             (r/atom (localstorage/get "show-panel" false))
+        dragging?            (r/atom false)
+        pin-to-bottom?       (r/atom true)
+        selected-tab         (r/atom :traces)
+        window-width         (r/atom js/window.innerWidth)
+        handle-window-resize (fn [e]
+                               ;; N.B. I don't think this should be a perf bottleneck.
+                               (reset! window-width js/window.innerWidth))
+        handle-keys          (fn [e]
+                               (let [combo-key?      (or (.-ctrlKey e) (.-metaKey e) (.-altKey e))
+                                     tag-name        (.-tagName (.-target e))
+                                     key             (.-key e)
+                                     entering-input? (contains? #{"INPUT" "SELECT" "TEXTAREA"} tag-name)]
+                                 (when (and (not entering-input?) combo-key?)
+                                   (cond
+                                     (and (= key "h") (.-ctrlKey e))
+                                     (do (swap! showing? not)
+                                         (toggle-traces showing?)
+                                         (.preventDefault e))))))
+        handle-mousemove     (fn [e]
+                               (when @dragging?
+                                 (let [x                (.-clientX e)
+                                       y                (.-clientY e)
+                                       new-window-width js/window.innerWidth]
+                                   (.preventDefault e)
+                                   ;; Set a minimum width of 5% to prevent people from accidentally dragging it too small.
+                                   (reset! panel-width% (max (/ (- new-window-width x) new-window-width) 0.05))
+                                   (reset! window-width new-window-width))))
+        handle-mouse-up      (fn [e] (reset! dragging? false))]
     (add-watch panel-width%
                :update-panel-width-ratio
                (fn [_ _ _ new-state]
@@ -359,11 +362,13 @@
                                  (toggle-traces showing?)
                                  (js/window.addEventListener "keydown" handle-keys)
                                  (js/window.addEventListener "mousemove" handle-mousemove)
-                                 (js/window.addEventListener "mouseup" handle-mouse-up))
+                                 (js/window.addEventListener "mouseup" handle-mouse-up)
+                                 (js/window.addEventListener "resize" handle-window-resize))
        :component-will-unmount (fn []
                                  (js/window.removeEventListener "keydown" handle-keys)
                                  (js/window.removeEventListener "mousemove" handle-mousemove)
-                                 (js/window.removeEventListener "mouseup" handle-mouse-up))
+                                 (js/window.removeEventListener "mouseup" handle-mouse-up)
+                                 (js/window.removeEventListener "resize" handle-window-resize))
        :display-name           "devtools outer"
        :reagent-render         (fn []
                                  (let [draggable-area 10


Optimize imports

Optimize imports

--- src/discuss/utils/views.cljs
+++ src/discuss/utils/views.cljs
@@ -1,8 +1,8 @@
 (ns discuss.utils.views
   (:require [goog.dom :as gdom]
             [goog.string :as gstring]
-            [om.core :as om :include-macros true]
-            [om.dom :as dom :include-macros true]
+            [om.core :as om]
+            [om.dom :as dom]
             [discuss.utils.extensions]
             [discuss.utils.common :as lib]))


compute shortest unambiguous paths using ellipses where helpful fixes #46

--- src/pronouns/util.clj
+++ src/pronouns/util.clj
@@ -16,6 +16,8 @@

 (ns pronouns.util
   (:require [clojure.string :as s]))
+
+(defn print-and-return "for debugging" [x] (println x) x)

 (defn slurp-tabfile [path]
   "read a tabfile from a filesystem <path> as a table"
@@ -45,23 +47,56 @@
       (first (table-end-filter query-end front-matches)))
     (first (table-front-filter query-key table))))

-(defn minimum-unambiguous-path
-  "compute the shortest (in number of path elements) path which refers to
-  a specific <row> in a <table> unambiguously."
-  ([table row] (minimum-unambiguous-path table row 1))
-  ([table row number-of-row]
-    (let [row-subset (take number-of-row row)
-          results (filter #(= (take number-of-row %) row-subset)
-                          table)]
-      (case (count results)
-        0 nil
-        1 (clojure.string/join "/" row-subset)
-        (recur table row (+ number-of-row 1))))))
+(defn shortest-unambiguous-forward-path
+  "Compute the shortest (in number of path elements) forward path which
+  unambiguously refers to a specific <row> in a <table>. The behavior of
+  this function is undefined if given a <row> that is not in the <table>.
+
+  See also: shortest-unambiguous-path"
+  [table row]
+  (loop [n 1]
+    (let [row-front (take n row)]
+      (if (>= 1 (count (table-front-filter row-front table)))
+        row-front
+        (recur (inc n))))))
+
+(defn shortest-unambiguous-ellipses-path
+  "Compute the shortest (in number of path elements) ellipses path which
+  unambiguously refers to a specific <row> in a <table>. The behavior of
+  this function is undefined if given a <row> that is not in the <table>.
+
+  See also: shortest-unambiguous-path"
+  [table row]
+  (let [row-end (last row)
+        filtered-table (table-end-filter [row-end] table)]
+    (loop [n 1]
+      (let [row-front (take n row)]
+        (if (>= 1 (count (table-front-filter row-front filtered-table)))
+          (concat row-front ["..." row-end])
+          (recur (inc n)))))))
+
+(defn shortest-unambiguous-path
+  "Compute the shortest (in number of path elements) path which unambiguously
+  refers to a specific <row> in a <table>. The behavior of this function is
+  undefined if given a <row> that is not in the <table>.
+
+  A path can either be a 'forward path', in which it specifies the row with
+  elements from the front (e.g. ze/zir), or an 'ellipses path', which elides
+  unnecessary elements from the middle (e.g. they/.../themselves). If the
+  shortest forward and ellipses paths are the same length, prefer the forward
+  path"
+  [table row]
+  (let [forward-path (shortest-unambiguous-forward-path table row)
+        ellipses-path (shortest-unambiguous-ellipses-path table row)]
+    (s/join "/"
+            (if (> (count forward-path) (count ellipses-path))
+              ellipses-path
+              forward-path))))

 (defn abbreviate
   "return the list of minimum unabiguous paths from a <table>"
   [table]
-  (map (partial minimum-unambiguous-path table) table))
+  (map (partial shortest-unambiguous-path table) table))

 (defn vec-coerce [x]
   "wrap a value <x> in a vector if it is not already in one. note that if


Completed reagent tictactoe interface

Completed reagent tictactoe interface

--- src/games/tictactoe.cljc
+++ src/games/tictactoe.cljc
@@ -64,7 +64,7 @@
 (defn three-in-row [key
                {tl [0 0] t  [1 0] tr [2 0]
                 l  [0 1] m  [1 1] r  [2 1]
-                bl [0 2] b  [1 2] br [2 2]}]
+                bl [0 2] b  [1 2] br [2 2] :as a}]
   (or (= key tl l bl)
       (= key tl m br)
       (= key tl t tr)
@@ -177,7 +177,7 @@
       [:div {:style {:display "inline-block" :padding "0 15px 0 0"}} "x"]
       [:input
        {:value x
-        :type "text"
+        :type "number"
         :on-change
         (fn [component]
           (reset! ui-atom [(-> component .-target .-value) y]))}]]
@@ -185,13 +185,13 @@
       [:div {:style {:display "inline-block" :padding "0 15px 0 0"}} "y"]
       [:input
        {:value y
-        :type "text"
+        :type "number"
         :on-change
         (fn [component]
           (reset! ui-atom [x (-> component .-target .-value)]))}]]
      [:div>button
       {:on-click
-       (fn [] ((:input engine-connection) {turn s}))}
+       (fn [] ((:input engine-connection) {turn (map int s)}))}
       "Take Turn"]])))

 #?(:cljs


Use line breaks between map keys and collection values.

--- src/puget/printer.clj
+++ src/puget/printer.clj
@@ -161,8 +161,18 @@

 (defn- canonize-map
   [m]
-  (let [canonize-kv (fn [[k v]] [:span (canonize k) " " (canonize v)])
-        entries (->> (seq m) (sort-by first order/rank) (map canonize-kv))]
+  (let [canonize-kv
+        (fn [[k v]]
+          [:span
+           (canonize k)
+           (cond
+             (satisfies? data/TaggedValue v) " "
+             (coll? v) :line
+             :else " ")
+           (canonize v)])
+        entries (->> (seq m)
+                     (sort-by first order/rank)
+                     (map canonize-kv))]
     [:group
      (color-doc :delimiter "{")
      [:align (interpose [:span *map-delimiter* :line] entries)]


Email team when a new problem is submitted

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -326,6 +326,16 @@
                                {:_id "problems"}
                                {:$inc {:seq 1}})))]

+        (when (empty? author) ; newly submitted, not a moderator tweak
+          (send-email
+           {:from "team@4clojure.com"
+            :to ["team@4clojure.com"]
+            :subject (str "User submission: " title)
+            :body (html [:h3 (link-to (str "https://4clojure.com/problem/edit/"
+                                           id)
+                                      title)]
+                        [:div description])}))
+
         (update! :problems
                  {:_id prob-id}
                  {:_id prob-id


bugfix

bugfix

--- src/hivewing_core/worker.clj
+++ src/hivewing_core/worker.clj
@@ -19,7 +19,7 @@
 (defn worker-in-hive?
   "Is this worker in the given hive?"
   [worker-uuid hive-uuid]
-  (jdbc/query sql-db ["SELECT uuid FROM workers WHERE uuid = ? AND hive_uuid ? LIMIT 1"
+  (jdbc/query sql-db ["SELECT uuid FROM workers WHERE uuid = ? AND hive_uuid = ? LIMIT 1"
                       (ensure-uuid worker-uuid)
                       (ensure-uuid hive-uuid)] :result-set-fn first))
 (defn worker-get


start brepl client only once

start brepl client only once

--- src/replify/core.cljs
+++ src/replify/core.cljs
@@ -2,6 +2,9 @@
   (:require [clojure.browser.repl :as repl]))

 ;; Automatically start brepl after compilation of cljs
+(defonce conn
+  (repl/connect "http://localhost:9000/repl"))

-(repl/connect (str "http://localhost:9000/repl"))
-(.log js/console "Started browser Repl")
+(enable-console-print!)
+
+(println "Started browser Repl")


add dependency

add dependency

--- server/project.clj
+++ server/project.clj
@@ -13,7 +13,7 @@
                  [ring-mock "0.1.4"]
                  [ring-middleware-format "0.3.0"]
                  [compojure "1.1.5"]
-                 [liberator "0.8.0"]
+                 [liberator "0.9.0"]
                  [com.cemerick/friend "0.1.5"]
                  [crypto-random "1.1.0"]
                  [org.clojure/tools.namespace "0.2.2"]


Remove printlns.

Remove printlns.

--- src/onyx/peer/coordinator.clj
+++ src/onyx/peer/coordinator.clj
@@ -131,16 +131,16 @@
     ;; No op because hasn't finished emitting last barrier, wait again
     state
     (let [;; always checkpoints at the moment
-          checkpoint? (first (shuffle [true #_false]))
+          start-checkpoint? (first (shuffle [true #_false]))
           messenger (m/set-epoch! messenger (inc (m/epoch messenger)))]
       (-> state
           (update :checkpoint merge {:initiated? true
-                                     :epoch (if checkpoint? (m/epoch messenger) (:epoch checkpoint))})
+                                     :epoch (if start-checkpoint? (m/epoch messenger) (:epoch checkpoint))})
           (update :barrier merge {:scheduled? false
                                   :offering? true
                                   :remaining (m/publishers messenger)
                                   :opts {:completed? (:sealing? (:job state))
-                                         :checkpoint? checkpoint?}})
+                                         :checkpoint? start-checkpoint?}})
           (assoc :messenger messenger)))))

 (defn shutdown [{:keys [messenger] :as state}]
@@ -154,7 +154,6 @@

 (defn checkpoint-complete?
   [{:keys [initiated? epoch] :as checkpoint} status]
-  (println "Checkpointing " checkpoint status)
   (or (not initiated?)
       (and (not (:checkpointing? status))
            (>= (:min-epoch status) epoch))))
@@ -166,14 +165,13 @@
                      :job-id job-id
                      :replica-version (m/replica-version messenger)
                      :epoch epoch}
-        _ (println "COmpleted checkpoint " coordinates)
         ;; get the next version of the zk node, so we can detect when there are other writers
         next-write-version (if write-coordinate?
                              (write-coordinate write-version log tenancy-id job-id coordinates)
                              write-version)]
+
+
     (-> state
-        ;; TODO, move this into a barrier completed action
-        ;; so we can make the checkpoints separate to the barriers
         (update :barrier    merge {:scheduled? false})
         (update :checkpoint merge {:initiated? false
                                    :write-version next-write-version}))))


fixed test related to rendering post mutation networking

--- spec/untangled/client/data_fetch_spec.cljs
+++ spec/untangled/client/data_fetch_spec.cljs
@@ -10,7 +10,8 @@
      [specification behavior assertions provided component when-mocking]]
     [untangled.client.mutations :as m]
     [untangled.client.logging :as log]
-    [om.next.protocols :as omp]))
+    [om.next.protocols :as omp]
+    [untangled.dom :as udom]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; SETUP
@@ -275,8 +276,9 @@

 (defmethod m/mutate 'qrp-loaded-callback [{:keys [state]} n p] (swap! state assoc :callback-done true))

-(specification "Query response processing (loaded-callback)"
-  (let [item (dfi/set-loading! (dfi/ready-state :ident [:item 2] :query [:id :b] :post-mutation 'qrp-loaded-callback :refresh [:a]))
+
+(specification "Query response processing (loaded-callback with post mutation)"
+  (let [item (dfi/set-loading! (dfi/ready-state :ident [:item 2] :query [:id :b] :post-mutation 'qrp-loaded-callback))
         state (atom {:untangled/loads-in-progress #{(dfi/data-uuid item)}
                      :item                        {2 {:id :original-data}}})
         items [item]
@@ -289,8 +291,7 @@
     (when-mocking
       (om/app-state r) => state
       (om/merge! r resp query) => (reset! merged true)
-      (omp/queue! r items) => (reset! queued (set items))
-      (omp/schedule-render! r) => (reset! rendered true)
+      (udom/force-render r) => (reset! rendered true)
       (dfi/set-global-loading r) => (reset! globally-marked true)

       (loaded-cb response items)
@@ -300,12 +301,39 @@
         @merged => true
         "Runs post-mutations"
         (:callback-done @state) => true
+        "Force re-renders the entire application"
+        @rendered => true
+        "Removes loading markers for results that didn't materialize"
+        (get-in @state (dfi/data-path item) :fail) => nil
+        "Updates the global loading marker"
+        @globally-marked => true))))
+
+(specification "Query response processing (loaded-callback with no post-mutations)"
+  (let [item (dfi/set-loading! (dfi/ready-state :ident [:item 2] :query [:id :b] :refresh [:a]))
+        state (atom {:untangled/loads-in-progress #{(dfi/data-uuid item)}
+                     :item                        {2 {:id :original-data}}})
+        items [item]
+        queued (atom [])
+        rendered (atom false)
+        merged (atom false)
+        globally-marked (atom false)
+        loaded-cb (dfi/loaded-callback :reconciler)
+        response {:id 2}]
+    (when-mocking
+      (om/app-state r) => state
+      (om/merge! r resp query) => (reset! merged true)
+      (udom/force-render r items) => (reset! queued (set items))
+      (dfi/set-global-loading r) => (reset! globally-marked true)
+
+      (loaded-cb response items)
+
+      (assertions
+        "Merges response with app state"
+        @merged => true
         "Queues the refresh items for refresh"
         @queued =fn=> #(contains? % :a)
         "Queues the global loading marker for refresh"
         @queued =fn=> #(contains? % :ui/loading-data)
-        "Re-renders the application"
-        @rendered => true
         "Removes loading markers for results that didn't materialize"
         (get-in @state (dfi/data-path item) :fail) => nil
         "Updates the global loading marker"


(SERVER-1262) Initialize SSL files for legacy-ca-routes-disabled test

Previously, if the `legacy-ca-routes-disabled` test was run in isolation
or before any other test in the `legacy-routes-test` namespace, the
server would error out on test startup because no SSL files were in
place.  This commit adds an extra service startup, using the real CA
service, before starting up with the disabled CA service.  This is done
to ensure that all of the necessary SSL files have been created before
the disabled CA service is bootstrapped, allowing the test to be able to
succeed regardless of the order in which it is run.

--- test/integration/puppetlabs/services/legacy_routes/legacy_routes_test.clj
+++ test/integration/puppetlabs/services/legacy_routes/legacy_routes_test.clj
@@ -291,19 +291,29 @@
 (deftest ^:integration legacy-ca-routes-disabled
   (testing (str "(SERVER-759) The legacy CA routes are not forwarded when the "
                 "disabled CA is configured")
-    (logutils/with-test-logging
-      (bootstrap/with-puppetserver-running-with-services-and-mock-jrubies
-       "Mocking JRubies because CA endpoints are pure clojure"
-        app
-       (->> bootstrap/services-from-dev-bootstrap
-            (remove #(= :CaService (tk-services/service-def-id %)))
-            (cons disabled-ca/certificate-authority-disabled-service))
-        {}
-
-        (is (= 404 (:status (http-get "/production/certificate_statuses/all")))
-            (str "A 404 was not returned, indicating that the legacy CA routes "
-                 "are still being forwarded to the core CA functions."))
-
-        (is (not (= 200 (:status (http-get "/production/certificate_statuses/all"))))
-            (str "A 200 was returned from a request made to a legacy CA endpoint "
-                 "indicating the disabled CA service was not detected."))))))
+    ;; Startup server once with real CA service so that SSL certs/keys/etc.
+    ;; are generated properly before we start again with the disabled CA
+    ;; service bootstrapped.  When starting up with disabled CA service,
+    ;; the certs/keys/etc. are assumed to already be in place at startup.  The
+    ;; server would fail to start on being unable to find any of these files.
+    (bootstrap/with-puppetserver-running-with-mock-jrubies
+     "Mocking JRubies because don't need real ones just to have SSL files created"
+     _
+     {}
+     ;; Sanity check to see that the server was started up the first time
+     (is true))
+    (bootstrap/with-puppetserver-running-with-services-and-mock-jrubies
+     "Mocking JRubies because CA endpoints are pure clojure"
+     app
+     (->> bootstrap/services-from-dev-bootstrap
+          (remove #(= :CaService (tk-services/service-def-id %)))
+          (cons disabled-ca/certificate-authority-disabled-service))
+     {}
+
+     (is (= 404 (:status (http-get "/production/certificate_statuses/all")))
+         (str "A 404 was not returned, indicating that the legacy CA routes "
+              "are still being forwarded to the core CA functions."))
+
+     (is (not (= 200 (:status (http-get "/production/certificate_statuses/all"))))
+         (str "A 200 was returned from a request made to a legacy CA endpoint "
+              "indicating the disabled CA service was not detected.")))))


Update to uri transformation fn for assets again.

--- src/timber/assets.clj
+++ src/timber/assets.clj
@@ -7,8 +7,10 @@
           (second
             (h-uri/path-divergence
               public-uri
-              (h-uri/path
-                (vec (rest (get-in match [:attrs uri-attr]))))))))
+              (vec
+                (rest
+                  (rest
+                    (h-uri/path (get-in match [:attrs uri-attr])))))))))

 (defn transform-link
   "Creates an enlive transformation fn that re-writes link asset URIs."


Limit size of image queue, and block if it is full.

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

--- clojure/acq_engine.clj
+++ clojure/acq_engine.clj
@@ -183,7 +183,7 @@
       {"ElapsedTime-ms" (clock-ms)}))))

 (defn collect-image [event out-queue]
-    (.add out-queue (annotate-image (. mmc getImage) event)))
+    (.put out-queue (annotate-image (. mmc getImage) event)))

 (defn run-event [event last-wake-time out-queue]
   (run-actions (create-presnap-actions event))
@@ -226,12 +226,16 @@
   (doto
     (proxy [AcquisitionWrapperEngine] []
       (runPipeline [^SequenceSettings settings]
-        (let [out-queue (LinkedBlockingQueue.)]
+        (def orig-settings settings)
+        (println "ss positions: " (.size (.positions settings)))
+        (println "position-count: " (.getNumberOfPositions (.getPositionList gui)))
+        (let [out-queue (LinkedBlockingQueue. 100)]
           (.start (Thread. #(run-acquisition (convert-settings settings) out-queue)))
           (.start (LiveAcqDisplay. mmc out-queue settings (.channels settings) (.save settings) this)))))
     (.setCore mmc (.getAutofocusManager gui))
     (.setParentGUI gui)
-    (.setPositionList (.getPositionList gui))))
+    (.setPositionList (.getPositionList gui))
+    ))

 (defn test-dialog [eng]
   (.show (AcqControlDlg. eng (Preferences/userNodeForPackage (.getClass gui)) gui)))


Modifying markov to have start/end nodes.

Unfortunately the start/end nodes use :start and :end, and I'm unsure how
to serialize that into json. Also, it doesn't properly resolve start nodes
for counts > 1.

--- wysitutwyg/src-clj/wysitutwyg/markov.clj
+++ wysitutwyg/src-clj/wysitutwyg/markov.clj
@@ -1,64 +1,94 @@
 (ns wysitutwyg.markov
   (:require [clojure.data.json :as json]))

+(def test-text "He is mad! It is mad? She is mad. He is sad! It is sad? She is sad.")
+
 (def delimiters #{\space})
+(def end-nodes #{\. \! \?})
+; How to handle ellipses?

 (defn not-delimiter? [char]
   (not (delimiters char)))
-
+
+(defn process-corpus [corpus]
+  "Processes the corpus into a collection of segments, determined by the
+  delimiter set. Members of end-nodes are grouped into their own segments."
+  (->> corpus
+       (partition-by not-delimiter?)
+       (filter (comp not-delimiter? first))
+       (mapcat #(partition-by end-nodes %))))
+
+;; Does not properly generate :start nodes for counts > 1!
 (defn parse-counts
-  "Transforms the corpus into a mapping of n-grams to counts, of the form:
-  [[['He' 'is'] {'a' 2}], [['is' 'a'] {'sad' 2, 'mad' 2}]]. The output is a
-  vector of key/value vectors for easy json serialization, which may be easily
-  converted back through #(into {} %)."
+  "Creates a mapping of states to counts of the form
+  {start-state {end-state n, end-state n}}
+    start-state | ((\\w \\o \\r \\d \\1) (\\w \\2))
+    end-state | (\\w \\o \\r \\d)
+  with the start and end states mapped to :start and :end."
   [n corpus-string]
-  (loop [counts {}
-         corpus (filter (comp not-delimiter? first)
-                        (partition-by not-delimiter? corpus-string))]
+  (loop [counts (apply hash-map (mapcat vector
+                                        (map (comp list list) end-nodes)
+                                        (repeat :end)))
+         corpus (process-corpus corpus-string)]
     (let [[state rest-corpus] (split-at n corpus)
           follows (first rest-corpus)]
       (if (seq rest-corpus)
-          (recur (update-in counts [state follows] (fnil inc 0)) (rest corpus))
+          (cond
+            (end-nodes (first (last state)))
+              (recur (update-in counts [:start follows] (fnil inc 0))
+                     (rest corpus))
+            :else
+              (recur (update-in counts [state follows] (fnil inc 0))
+                     (rest corpus)))
           counts))))

-(defn keys-to-strings [s]
+;;; Everything below this is broken by the inclusion of keywords.
+;;; Until I can figure out how I want to handle them in json, it will remain
+;;; so.
+;;; Default behavior uses name, and that is just unacceptable, but how should
+;;; it be handled such that, if I happened to use the Clojure documentation as
+;;; a corpus, it wouldn't break due to the keywords being valid?
+
+#_(defn keys-to-strings [s]
   (vec (map #(apply str %) s)))

-(defn inner-map [m]
+#_(defn inner-map [m]
   (into {} (map (fn [[k v]] [(apply str k) v]) m)))

-(defn stringify
+#_(defn stringify
   [m]
   (->> m
        (map #(update-in % [0] keys-to-strings))
        (map #(update-in % [1] inner-map))))

-(defn parse-and-save
+#_(defn parse-and-save
   [infile outfile n]
   (with-open [w (clojure.java.io/writer outfile)]
     (spit outfile (json/write-str (stringify (parse-counts n (slurp infile)))))))
-
-(parse-and-save
-  "resources/public/corpora/sonnets/corpus.txt"
-  "resources/public/corpora/sonnets/1.json"
-  1)
-(parse-and-save
-  "resources/public/corpora/sonnets/corpus.txt"
-  "resources/public/corpora/sonnets/2.json"
-  2)
-(parse-and-save
-  "resources/public/corpora/sonnets/corpus.txt"
-  "resources/public/corpora/sonnets/3.json"
-  3)
-(parse-and-save
-  "resources/public/corpora/loremipsum/corpus.txt"
-  "resources/public/corpora/loremipsum/1.json"
-  1)
-(parse-and-save
-  "resources/public/corpora/loremipsum/corpus.txt"
-  "resources/public/corpora/loremipsum/2.json"
-  2)
-(parse-and-save
-  "resources/public/corpora/loremipsum/corpus.txt"
-  "resources/public/corpora/loremipsum/3.json"
-  3)+
+#_(defn do-parses []
+  (doall
+    (parse-and-save
+      "resources/public/corpora/sonnets/corpus.txt"
+      "resources/public/corpora/sonnets/1.json"
+      1)
+    (parse-and-save
+      "resources/public/corpora/sonnets/corpus.txt"
+      "resources/public/corpora/sonnets/2.json"
+      2)
+    (parse-and-save
+      "resources/public/corpora/sonnets/corpus.txt"
+      "resources/public/corpora/sonnets/3.json"
+      3)
+    (parse-and-save
+      "resources/public/corpora/loremipsum/corpus.txt"
+      "resources/public/corpora/loremipsum/1.json"
+      1)
+    (parse-and-save
+      "resources/public/corpora/loremipsum/corpus.txt"
+      "resources/public/corpora/loremipsum/2.json"
+      2)
+    (parse-and-save
+      "resources/public/corpora/loremipsum/corpus.txt"
+      "resources/public/corpora/loremipsum/3.json"
+      3)))


코드 정리

코드 정리

--- src/tufdown/core.cljc
+++ src/tufdown/core.cljc
@@ -21,31 +21,15 @@
 (declare render-html)

 (defn- render-element [[태그 & 내용]]
-  (let [태그맵 {:큰제목   "h2"
-                :작은제목 "h3"
-                :일반목록 "ul"
-                :숫자목록 "ol"
-                :항목     "li"
-                :인용     "blockquote"
-                :원문     "pre"
-                :문단     "div"
-                :문장     "p"
-                :기울임   "i"
-                :굵게     "em"}
-        여닫기 (fn [e]
-                 (if-let [tag (태그맵 e)]
-                   [(str "<" tag ">") (str "</" tag ">")]
-                   ["" ""]))
-        추출 (fn [내부태그]
-               (some (fn [요소]
-                       (if (= 내부태그 (first 요소))
-                         (apply str (rest 요소)))) 내용))]
+  (let [태그맵 {:큰제목 "h2", :작은제목 "h3", :일반목록 "ul", :숫자목록 "ol"
+                :항목 "li", :인용 "blockquote", :원문 "pre", :문단 "div"
+                :문장 "p", :기울임 "i", :굵게 "em"}
+        추출 (fn [tag] (some
+                       (fn [e] (if (= (first e) tag) (apply str (rest e))))
+                       내용))]
     (case 태그
-      :빈줄
-      "
"
-
-      :구분줄
-      "
"
+      :빈줄   "
"
+      :구분줄 "
"

       :소스코드
       (str "
"
@@ -53,8 +37,9 @@
            "
")

       ;; 기본
-      (let [[열기 닫기] (여닫기 태그)]
-        (str 열기 (render-html 내용) 닫기)))))
+      (if-let [tag (태그맵 태그)]
+        (str "<" tag ">" (render-html 내용) "</" tag ">")
+        (render-html 내용)))))

 (defn render-html [e]
   (cond
@@ -62,3 +47,5 @@
     (string? e) (escape-html e)
     (seq? e)    (apply str (map render-html e))
     (nil? e)    ""))
+
+;; (render-html (parse "테스트\n==="))


Add -render-svg method to shapes ns.

Add -render-svg method to shapes ns.

--- src/uxbox/shapes.cljs
+++ src/uxbox/shapes.cljs
@@ -24,6 +24,10 @@
   (:type shape))

 (defmulti -render
+  dispatch-by-type
+  :hierarchy #'+hierarchy+)
+
+(defmulti -render-svg
   dispatch-by-type
   :hierarchy #'+hierarchy+)


added the indexed change back in

added the indexed change back in


Extend example for trace-context.

Extend example for trace-context.

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

--- doc/examples/trace-context.clj
+++ doc/examples/trace-context.clj
@@ -2,6 +2,7 @@
 ;;; This file is in the public domain.

 (use 'conexp.main)
+(use 'conexp.layouts.base)

 ;;;

@@ -29,6 +30,24 @@
                      (union N M)
                      (union I_HN I_GN I_HM I_GM))))

+(defn trace-layout
+  "Returns a layout of the concept lattice of the trace context of ctx-S in ctx-K, with a reduced
+  annotation."
+  [ctx-S ctx-K]
+  (let [trace-ctx (trace-context ctx-S ctx-K)
+        layout    (standard-layout (concept-lattice trace-ctx)),
+        ann       (concept-lattice-annotation layout),
+        label     #(apply str (interpose ", " %))]
+    (make-layout (lattice layout)
+                 (positions layout)
+                 (connections layout)
+                 (fn [x]
+                   [(label (set-of g | [g n] (first (ann x)) :when (= n 1))),
+                    nil])
+                 (fn [x]
+                   [(label (set-of m | [m n] (second (ann x)) :when (= n 1))),
+                    nil]))))
+
 (defn interval-context
   "Returns the formal context representing the interval induced by the pair [E F] in the concept
   lattice of ctx."


Formatting change

Formatting change

--- spec/rooms.clj
+++ spec/rooms.clj
@@ -12,11 +12,10 @@

 (rs/defschema RoomSize (s/enum :single :double :suite :special))

-(rs/defschema CreateRoomRequest {
-                             :number s/Int
-                             :floor  s/Int
-                             :size   RoomSize
-                             })
+(rs/defschema CreateRoomRequest
+  {:number s/Int
+   :floor  s/Int
+   :size   RoomSize})

 (def create-responses
   {HttpServletResponse/SC_CREATED   {:id       s/Int


File watcher: send events even when watch service fails

--- boot/worker/src/boot/watcher.clj
+++ boot/worker/src/boot/watcher.clj
@@ -75,8 +75,17 @@
 (defn- take-watch-key [service]
   (try
     (.take service)
-    (catch java.nio.file.ClosedWatchServiceException _ nil)
-    (catch com.barbarysoftware.watchservice.ClosedWatchServiceException _ nil)))
+    (catch java.nio.file.ClosedWatchServiceException _
+      (util/dbug "watch service closed\n"))
+    (catch com.barbarysoftware.watchservice.ClosedWatchServiceException _
+      (util/dbug "watch service closed\n"))))
+
+(defn- send-it!
+  [queue]
+  ;; It doesn't matter what we send because the information in the watch keys
+  ;; is completely unreliable and useless, so we send the sentinel "changed!".
+  (util/dbug "sending change event\n")
+  (.offer queue "changed!"))

 (defn- service
   [queue paths]
@@ -84,24 +93,23 @@
         doreg   #(register-recursive %1 %2 [:create :modify])]
     (doseq [path paths] (doreg service (io/file path)))
     (-> #(let [watch-key (take-watch-key service)]
-           (when watch-key
+           (when-let [path (and watch-key (or (.watchable watch-key) ""))]
              (if-not (.isValid watch-key)
-               (do (util/dbug "invalid watch key %s\n" (.watchable watch-key))
-                   (recur))
+               (util/dbug "invalid watch key %s\n" (.watchable watch-key))
                (do (doseq [event (.pollEvents watch-key)]
-                     (let [dir     (.toFile (.watchable watch-key))
+                     (let [dir     (.toFile path)
                            changed (io/file dir (str (.context event)))
                            etype   (enum->kw service (.kind event))
                            dir?    (.isDirectory changed)]
-                       (util/dbug "event: %s %s %s\n" etype dir? (.watchable watch-key))
+                       (util/dbug "event: %s %s %s\n" etype dir? path)
                        (when (and dir? (= :create etype))
                          (try (doreg service changed)
                               (catch Throwable t
-                                (util/dbug "error registering %s: %s\n" (.watchable watch-key) t))))
-                       (.offer queue (.getPath changed))))
-                   (if-not (.reset watch-key)
-                     (util/dbug "failed to reset watch key %s\n" (.watchable watch-key)))
-                   (recur)))))
+                                (util/dbug "error registering %s: %s\n" path t))))))
+                   (when-not (.reset watch-key)
+                     (util/dbug "failed to reset watch key %s\n" path))))
+             (send-it! queue)
+             (recur)))
         Thread. .start)
     service))

@@ -117,5 +125,5 @@
         s  (service queue paths)
         fs (->> paths (mapcat (comp file-seq io/file)) (filter (memfn isFile)))]
     (swap! watchers assoc k s)
-    (doseq [f fs] (.offer queue (.getPath f)))
+    (send-it! queue)
     k))


CMR-3282 removes unneeded space

CMR-3282 removes unneeded space

--- access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
@@ -751,7 +751,6 @@
                                   :native-id "coll8"
                                   :provider-id "PROV1"
                                   :temporal-singles #{(t/date-time 2012 1 1 0 0 1)}})
-

         gran1 (u/save-granule coll1 {:temporal {:range-date-time {:beginning-date-time (t/date-time 2010)
                                                                   :ending-date-time (t/date-time 2011)}}})
@@ -1119,7 +1118,7 @@
                                    :provider-id "PROV1"})

          gran1 (u/save-granule coll1 {:provider-id "PROV1"})
-
+
          acl1 (ingest-acl token (assoc (catalog-item-acl "Temporal contains")
                                        :catalog_item_identity {:name "Temporal contains"
                                                                :collection_applicable true


CMR-5368: Fix syntax error.

CMR-5368: Fix syntax error.

--- ingest-app/src/config/migrate_config.clj
+++ ingest-app/src/config/migrate_config.clj
@@ -3,12 +3,12 @@
   (:require
    [clojure.java.jdbc :as j]
    [cmr.common.lifecycle :as lifecycle]
-   [cmr.ingest.config :as ingest-config])
+   [cmr.ingest.config :as ingest-config]
    [cmr.oracle.config :as oracle-config]
    [cmr.oracle.connection :as oracle]
-   [drift.builder :refer [incremental-migration-number-generator]]
+   [drift.builder :refer [incremental-migration-number-generator]])
   (:import
-   (java.sql SQLException))
+   (java.sql SQLException)))

 (def db-atom (atom nil))


spacing

spacing

--- test/celestial/fixtures.clj
+++ test/celestial/fixtures.clj
@@ -55,9 +55,6 @@
       (p/add-system redis-prox-spec)
       (p/add-system redis-ec2-spec))))

-
-
 (def host (.getHostName (java.net.InetAddress/getLocalHost)))

 (def puppet-ami (merge-with merge redis-ec2-spec {:aws {:image-id "ami-f5e2ff81" :key-name host}}))
-


add a sleep in the PART tests to make them more deterministic

--- test/subrosa/test/rooms.clj
+++ test/subrosa/test/rooms.clj
@@ -29,6 +29,7 @@
       (transmit s2 "USER dan 0 * :Dan Larkin")
       (transmit s2 "JOIN #foo")
       (transmit s2 "JOIN #foo2")
+      (Thread/sleep 1000)
       (transmit s1 "PART")
       (is (received? s1 #"461 dan PART :Not enough parameters"))
       (transmit s1 "PART #foobar")


Stub out call for unit test

Stub out call for unit test

--- test/tyranitar/unit/web.clj
+++ test/tyranitar/unit/web.clj
@@ -27,7 +27,9 @@
         (request :get "/1.x/status") => (contains {:status 200}))

   (fact "Healthcheck returns ok"
-        (request :get "/healthcheck") => (contains {:status 200}))
+        (request :get "/healthcheck") => (contains {:status 200})
+        (provided
+         (store/git-connection-working?) => true))

   (fact "Invalid environment name results in not found response"
         (request :get "/1.x/applications/wrongenv") => (contains {:status 404}))


add filter-keys and remove-keys

add filter-keys and remove-keys

--- src/useful.clj
+++ src/useful.clj
@@ -238,7 +238,7 @@
     (for [[key val] map :when (pred val)] key)))

 (defn remove-keys-by-val
-  "Returns a keys of map for which (pred value) returns false."
+  "Returns all keys of map for which (pred value) returns false."
   [pred map]
   (filter-keys-by-val (complement pred) map))

@@ -252,6 +252,17 @@
   "Returns a map that only contains values where (pred value) returns false."
   [pred map]
   (filter-vals (complement pred) map))
+
+(defn filter-keys
+  "Returns a map that only contains keys where (pred key) returns true."
+  [pred map]
+  (when map
+    (select-keys map (filter pred (keys map)))))
+
+(defn remove-keys
+  "Returns a map that only contains keys where (pred key) returns false."
+  [pred map]
+  (filter-keys (complement pred) map))

 (defn any
   "Takes a list of predicates and returns a new predicate that returns true if any do."


More readable code and update of some examples

--- src/datascript_dom/core.clj
+++ src/datascript_dom/core.clj
@@ -64,39 +64,45 @@
   (if-not (string? node)
     (merge
      {:dom/tag (html/tag node)}
+
+     ;;include attributes, but not :id
      (dissoc (html/attributes node) :id)
+
+     ;;id will ne given a special name
      (when-let [id (:id node)] {:dom/id id})
+
+     ;;assoc children -- if present
      (when-let [children (html/children node)]
        {:child children}))
+
+    ;;if it's a string, encode as text-node
     {:dom/tag :text-node
      :text    node}))

-(defn- has-children? [node]
-  (not-empty (:child node)))
-
-(defn- set-children [node children]
-  (assoc node :child children))
-
-(defn- replace-node [zipper fun]
-  (zip/replace zipper (fun (zip/node zipper))))
-
-(defn- assoc-dom-index [zipper]
-  (let [new-index (some-> zipper zip/left zip/node :dom/index inc)]
+(defn- replace-node [zipper]
+  (let [dom-index (or (some-> zipper zip/left zip/node :dom/index inc) 0)]
     (zip/replace
      zipper
      (-> zipper
          zip/node
          to-entity
-         (assoc :dom/index (or new-index 0))))))
+         (assoc :dom/index dom-index)))))
+
+(defn dom-zipper [dom]
+  (zip/zipper
+   (fn [node] (not-empty (:child node))) ;;branch?
+   :child
+   (fn [node children] (assoc node :child children)) ;;make-node
+   dom))

 (defn dom->transaction [dom]
-  (loop [zipper (zip/zipper has-children? :child set-children dom)]
+  (loop [zipper (dom-zipper dom)]
     (if (zip/end? zipper)
       [(zip/root zipper)]
-      (recur (zip/next (assoc-dom-index zipper))))))
+      (recur (zip/next (replace-node zipper))))))

 (defn- dump [dom]
-  (let [z (zip/zipper has-children? html/children set-children dom)]
+  (let [z (dom-zipper dom)]
     (loop [z z]
       (prn (zip/node z))
       (if-not (zip/end? z) (recur (zip/next z))))))
@@ -122,24 +128,26 @@
   ;; THE FOLLOWING QUERIES ARE BEST APPLIED TO THE SMALL DOM (see parse-string above)

   ;;get the <body> tag via its attribute
-  (d/q '[:find (pull ?node [:dom/tag]) .
+  (d/q '[:find [(pull ?node [*]) ...]
          :where
          [?node :class "test"]]
        @small-conn)

-  ;;find root - returns the actual map because of the pull API
+  ;;find root
   (d/q '[:find (pull ?node [:dom/tag]) .
          :where
          [?node _]
          [(missing? $ ?node :_child)]]
        @small-conn)

-  ;;find root with a rule - returns the id because of the simple find
-  (def r
-    (d/q '[:find ?node .
-           :in $ %
-           :where (root ?node)]
-         @small-conn rules))
+  ;;find root with a rule
+  (d/q '[:find (pull ?node [:dom/tag]) .
+         :in $ %
+         :where (root ?node)]
+       @small-conn
+       '[[(root ?node)
+          [?node _]
+          [(missing? $ ?node :_child)]]])

   (->> r (d/entity @small-conn) :child first ;;gets <body> tag
        :child (map d/touch)) ;;gets the two paragraph tags


Fix error in pair-channel->lazy-seq.

Fix error in pair-channel->lazy-seq.

Signed-off-by: Richard Newman <c8f4dc3b2a000e5f4b07e416774ad99513089206@twinql.com>

--- src/datomish/exec_repl.cljc
+++ src/datomish/exec_repl.cljc
@@ -32,7 +32,7 @@
    (when-let [v (clojure.core.async/<!! channel)]
      (if (second v)
        (cons v nil)
-       (cons v (channel->lazy-seq channel)))))))
+       (cons v (pair-channel->lazy-seq channel)))))))

 #?(:clj
 (defn run-to-pair-seq


Prepare usages-view

Prepare usages-view

--- src/discuss/references.cljs
+++ src/discuss/references.cljs
@@ -19,7 +19,9 @@
   (let [url (str (:base config/api) (get-in config/api [:get :reference-usages]) "/" reference)]
     (com/ajax-get url {} reference-usage-handler)))

-(defn dialog
+
+;;;; Views
+(defn dialog-view
   "Show a dialog to give the user the option to choose, whether she wants to get some information about the statement
    or just wants to construct a new statement."
   []
@@ -30,4 +32,11 @@
                            "Find usages of this reference")
                " "
                (dom/button #js {:className "btn btn-primary"}
-                           "Create new Statement with this reference")))))+                           "Create new Statement with this reference")))))
+
+(defn usages-view
+  "Detail page showing the usages of the given reference."
+  []
+  (reify om/IRender
+    (render [_]
+      (dom/h4 nil "foo"))))


Update tools-deps to 1.10.3.1075

Update tools-deps to 1.10.3.1075


Fix universe selection for new fixtures.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -57,10 +57,10 @@
                        :x-rotation (tf/degrees 180) :y-rotation (tf/degrees 180))
   (show/patch-fixture! :ws-2 (blizzard/weather-system) universe 187
                        :x (tf/inches -76) :y (tf/inches 64) :z (tf/inches -4))
-  (show/patch-fixture! :puck-1 (blizzard/puck-fab5) 1 97 :x (tf/inches -76) :y (tf/inches 8) :z (tf/inches 52))
-  (show/patch-fixture! :puck-2 (blizzard/puck-fab5) 1 113 :x (tf/inches -76) :y (tf/inches 8) :z (tf/inches 40))
-  (show/patch-fixture! :snowball (blizzard/snowball) 1 33 :x (tf/inches -76) :y (tf/inches 10) :z (tf/inches 60))
-  (show/patch-fixture! :hyp-rgb (adj/hypnotic-rgb) 1 45)
+  (show/patch-fixture! :puck-1 (blizzard/puck-fab5) universe 97 :x (tf/inches -76) :y (tf/inches 8) :z (tf/inches 52))
+  (show/patch-fixture! :puck-2 (blizzard/puck-fab5) universe 113 :x (tf/inches -76) :y (tf/inches 8) :z (tf/inches 40))
+  (show/patch-fixture! :snowball (blizzard/snowball) universe 33 :x (tf/inches -76) :y (tf/inches 10) :z (tf/inches 60))
+  (show/patch-fixture! :hyp-rgb (adj/hypnotic-rgb) universe 45)
   '*show*)


Update core.clj

Update core.clj

--- src/hasta_la_vista/core.clj
+++ src/hasta_la_vista/core.clj
@@ -148,14 +148,14 @@
     ;; (println (client/get-client-status client))
     (log/info (client/get-available-servers client))
     ;; creating N async threads
-    (dotimes [i 2]
+    (dotimes [i thread-count]
       (thread
         ;; inside a thread we usually process something
         ;; blocking like this thread sleeps for random(1000) ms
         ;; after the blocking part you send the message
         ;; :couchbase-client might be missing - should catch it here
         ;; connecting might be slow
-        (Thread/sleep 500)
+        (Thread/sleep thread-timeout)
         ;; should be a check here if connection was successful
         ;; (cond ...
         ;; "Lazy query can be used to get the amount of documents specified per iteration.


Allow layouts.core/register to accept a single short name or sequence.

--- src/incise/layouts/core.clj
+++ src/incise/layouts/core.clj
@@ -33,5 +33,7 @@
   shortname of a registered layout function."
   [short-names layout-fn]
   (swap! layouts
-         merge (zipmap (map name short-names)
+         merge (zipmap (map name (if (sequential? short-names)
+                                   short-names
+                                   [short-names]))
                        (repeat layout-fn))))


removed POST /api/article

removed POST /api/article

* GET /api/article/new is used instead

--- src/instapapure/servlet.clj
+++ src/instapapure/servlet.clj
@@ -178,8 +178,6 @@
   (GET "/article/:id"
     (edit-article (:id params)))
   ;;  API
-  (POST "/api/article"
-    (new-article (:location params) (:title params) (:summary params)))
   ;;  for Google Reader
   (GET "/api/article/new"
     (new-article (:location params) (:title params) (:summary params)))


lint fix 2000

lint fix 2000

--- src/metabase/api/common.clj
+++ src/metabase/api/common.clj
@@ -451,7 +451,7 @@
      ;; a separate multimethod or protocol so other models besides DB can write optimized
      ;; implementations. Currently, we always fetch an *entire* object to do read checking,
      ;; which is wasteful.
-     (= (name entity) "Database") `nil
+     (= (name entity) "Database") `(comment "@(:can-read database) is always true.") ; put some non-constant value here so Eastwood doesn't complain about unused return values
      :else                        `(read-check (sel :one ~entity :id ~id)))))

 (defmacro write-check


when creating group, add self to group

when creating group, add self to group

--- src/chat/client/store.cljs
+++ src/chat/client/store.cljs
@@ -392,6 +392,7 @@
   (transact! [:groups] (flip dissoc (group :id))))

 (defn become-group-admin! [group-id]
+  (transact! [:users (current-user-id) :group-ids] #(vec (conj (set %) group-id)))
   (transact! [:groups group-id :admins] #(conj % (current-user-id))))

 (defn add-group-admin! [group-id user-id]


Require the json protocol extension

Require the json protocol extension

--- src/cider_ci/utils/app.clj
+++ src/cider_ci/utils/app.clj
@@ -5,9 +5,10 @@
 (ns cider-ci.utils.app
   (:require
     [cider-ci.utils.config :as config :refer [get-config get-db-spec]]
+    [cider-ci.utils.http-server :as http-server]
+    [cider-ci.utils.json-protocol]
     [cider-ci.utils.nrepl :as nrepl]
     [cider-ci.utils.rdbms :as rdbms]
-    [cider-ci.utils.http-server :as http-server]
     [cider-ci.utils.self]

     [logbug.catcher :as catcher]


Fixed all-installed to pass integration tests.

--- src/clj/game/core-misc.clj
+++ src/clj/game/core-misc.clj
@@ -69,8 +69,7 @@
   (if (= side :runner)
     (let [top-level-cards (flatten (for [t [:program :hardware :resource]] (get-in @state [:runner :rig t])))
           hosted-on-ice (->> (:corp @state) :servers seq flatten (mapcat :ices) (mapcat :hosted))]
-      (concat top-level-cards (filter #(= (:side %) "Runner") hosted-on-ice))
-      (loop [unchecked top-level-cards installed ()]
+      (loop [unchecked (concat top-level-cards (filter #(= (:side %) "Runner") hosted-on-ice)) installed ()]
         (if (empty? unchecked)
           (filter :installed installed)
           (let [[card & remaining] unchecked]
@@ -81,7 +80,7 @@
           top-level-cards (concat ice content)]
       (loop [unchecked top-level-cards installed ()]
         (if (empty? unchecked)
-          installed
+          (filter #(= (:side %) "Corp") installed)
           (let [[card & remaining] unchecked]
             (recur (filter identity (into remaining (:hosted card))) (into installed [card]))))))))


fetch-config-key renamed to get-config and support for nested keys added

--- src/clj/hellhound/core.clj
+++ src/clj/hellhound/core.clj
@@ -54,8 +54,9 @@
       (load-runtime-configuration)
       config-data)))

-(defn fetch-config-key
-  "Fetch the given key from the environment config of the project
-  other. Returns the default value from hellhound.config"
-  [key]
-  (or ((application-config) key) (config/default-config key)))
+(defn get-config
+  "Fetch the given key (or nested keys) from the environment config of
+  the project other. Returns the default value from hellhound.config"
+  [& keys]
+  (or (get-in (application-config) keys)
+      (get-in config/default-config keys)))


switch to use uncle

switch to use uncle

--- src/clj/protobuf/tasks.clj
+++ src/clj/protobuf/tasks.clj
@@ -1,5 +1,5 @@
 (ns protobuf.tasks
-  (:use cake cake.core cake.ant
+  (:use cake cake.core uncle.core
         [cake.file :only [file]]
         [bake.core :only [log]]
         [cake.utils :only [os-name prompt-read]]


fix file quota function

fix file quota function

--- src/clj/salava/file/db.clj
+++ src/clj/salava/file/db.clj
@@ -10,14 +10,17 @@

 (defqueries "sql/file/queries.sql")

-(defn used-quota [ctx user-id]
-  (select-used-file-quota {:user_id user-id} (into {:result-set-fn first :row-fn :used_quota} (get-db ctx))))
-
 (defn user-files-all [ctx user-id]
   (let [files (select-user-files {:user_id user-id} (get-db ctx))
         max-size (get-in ctx [:config :file :max-size] 100000000)
         sorted-files (map #(assoc % :tags (if (:tags %) (split (get % :tags "") #",") [])) files)]
     {:files sorted-files :max-size (str (quot max-size (* 1024 1024)) "MB")}))
+
+(defn used-quota [ctx user-id]
+  (let [user-files (:files (user-files-all ctx user-id))]
+    (if (seq user-files)
+      (select-used-file-quota {:user_id user-id} (into {:result-set-fn first :row-fn :used_quota} (get-db ctx)))
+      0)))

 (defn file-owner? [ctx file-id user-id]
   (let [owner (select-file-owner {:id file-id} (into {:result-set-fn first :row-fn :user_id} (get-db ctx)))]


Check for ready nodes before cluster statistics calc #418

--- src/clj/swarmpit/stats.clj
+++ src/clj/swarmpit/stats.clj
@@ -1,8 +1,20 @@
 (ns swarmpit.stats
   (:require [clojure.core.cache :as cache]
+            [clojure.core.memoize :as memo]
+            [swarmpit.docker.engine.client :as docker]
             [swarmpit.influxdb.client :as influx]
             [swarmpit.influxdb.mapper :as m]
             [swarmpit.config :refer [config]]))
+
+(defn active-hosts
+  []
+  "List of running nodes"
+  (->> (docker/nodes)
+       (filter #(= "ready" (get-in % [:Status :State])))
+       (map :ID)
+       (set)))
+
+(def active-hosts-memo (memo/ttl active-hosts :ttl/threshold 5000))

 (def cache (atom (cache/basic-cache-factory {})))

@@ -10,7 +22,8 @@
   (some? (config :influxdb-url)))

 (defn ready? []
-  (not (empty? @cache)))
+  (not (and (empty? @cache)
+            (empty? (active-hosts-memo)))))

 (defn store-to-cache
   "Store stats in local cache"
@@ -44,7 +57,9 @@
 (defn cluster
   "Get latest cluster statistics"
   []
-  (let [hosts (vals @cache)
+  (let [cached-hosts (vals @cache)
+        active-hosts (active-hosts-memo)
+        hosts (filter #(contains? active-hosts (:id %)) cached-hosts)
         sum-fn (fn [ks] (reduce + (map #(get-in % ks) hosts)))
         mean-fn (fn [ks] (/ (sum-fn ks) (count hosts)))]
     {:cpu    {:usage (mean-fn [:cpu :usedPercentage])}
@@ -70,5 +85,4 @@
   (map #(m/->host-ts %)
        (-> (influx/read-host-stats)
            (first)
-           (get "series"))))
-
+           (get "series"))))


Run server with 1000 threads

Run server with 1000 threads

--- src/clj_tutorials/main.clj
+++ src/clj_tutorials/main.clj
@@ -18,6 +18,6 @@
   (GET "/ping" [] (pong)))

 (defn run []
-  (run-server (handler/api app-routes) {:port 8080 :join? false}))
+  (run-server (handler/api app-routes) {:port 8080 :join? false :thread 1000}))


Doc fix for adding that :src-paths are strings

--- src/cljs/replumb/core.cljs
+++ src/cljs/replumb/core.cljs
@@ -155,7 +155,7 @@
       If the resource could not be resolved, the callback should be invoked with
       nil.

-  The 2-arity function accepts a sequence of source paths and
+  The 2-arity function accepts a sequence of source path strings and
   `read-file-fn!`, an asynchronous 2-arity function with signature
   `[file-path src-cb]` where src-cb is itself a function `(fn [source]
   ...)` that needs to be called with the file content as string (`nil`
@@ -195,7 +195,7 @@
       If the resource could not be resolved, the callback should be invoked with
       nil.

-  The 2-arity function accepts a sequence of source paths and
+  The 2-arity function accepts a sequence of source path strings and
   `read-file-fn!`, an asynchronous 2-arity function with signature
   `[file-path src-cb]` where src-cb is itself a function `(fn [source]
   ...)` that needs to be called with the file content as string (`nil`


more clear initial message

more clear initial message

--- src/cljs/smgui/search.cljs
+++ src/cljs/smgui/search.cljs
@@ -25,7 +25,7 @@
   (let [url (-> status :download :source-url)]
     (smgui.components/external-link url url)))

-(def status-map { :init       (define-status "time"        (fn [] ["Iniciando a busca..."]))
+(def status-map { :init       (define-status "time"        (fn [] ["Aguardando..."]))
                   :info       (define-status "time"        (fn [] ["Carregando informações do vídeo..."]))
                   :upload     (define-status "upload"      (fn [status] ["Enviando " (:extra status) " ..."]))
                   :search     (define-status "search"      (fn [status] [(str "Buscando legendas nos idiomas: " (get-in status [:search-languages]))]))


Don't needlessly use 1.5isms

Don't needlessly use 1.5isms

--- src/cljx/transom/core.cljx
+++ src/cljx/transom/core.cljx
@@ -128,11 +128,12 @@
           reb (rebase-paths doc old new)]
       (reduce
         (fn [reb [new-path new-edit]]
-          (if-some [reb-edit (get reb new-path)]
-            (let [state (get-in doc new-path)
-                  cmp-edit (impl/compose state reb-edit new-edit)]
-              (assoc reb new-path cmp-edit))
-            (assoc reb new-path new-edit)))
+          (let [reb-edit (get reb new-path)]
+            (if (not (nil? reb-edit))
+              (let [state (get-in doc new-path)
+                    cmp-edit (impl/compose state reb-edit new-edit)]
+                (assoc reb new-path cmp-edit))
+              (assoc reb new-path new-edit))))
         reb
         new)))
   ([doc old new & more]


all-lock-indices refacto

all-lock-indices refacto

--- src/sandbox/multithread.clj
+++ src/sandbox/multithread.clj
@@ -51,19 +51,10 @@

 (def insts-effort {:heavy-op 10 :medium-op 5 :light-op 2 :lock 1 :unlock 1})

-(defn all-locks-indices  [instructions]
-  ;;=> 'instructions' is the ':instructions vector' of the output of
-  ;; fire-process.
-  (let [locks (filter #(= (:inst-type %) :lock) instructions)
-        ;;=> We find out all the 'locks' in 'instructions'.
-        lock-indices (map (fn [l] {:lock-id (l :inst-id)
-                                   :lock-idx (.indexOf
-                                              instructions l)})
-                          locks)]
-    ;; And for every lock we find out its index in 'instructions,
-    ;; and prepare a map with it.
-    lock-indices))
-;;=> output of this is : ({:lock-id {:lock "l1"}, :lock-idx 2})
+(defn all-lock-indices [instructions]
+  (->> instructions
+       (filter #(= (:inst-type %) :lock))
+       (map #({:lock-id (% :inst-id), :lock-idx (.indexOf instructions %)}))))

 (defn the-locks-inst-depends-on
   [instructions instruction]


Rename wrap-restricted to wrap-require-authorization

--- src/cylon/oauth/client.clj
+++ src/cylon/oauth/client.clj
@@ -23,32 +23,35 @@
     in a new request being made with an access token, if possible."
     ))

-(s/defn get-access-token+ :- (s/maybe {:access-token s/Str
-                                       :scope #{s/Keyword}
-                                       (s/optional-key :original-uri) s/Str
-                                       s/Keyword s/Any})
+(s/defn ^{:doc "May returns nil if no access token"}
+  get-access-token+ :- {(s/optional-key :access-token) s/Str
+                        (s/optional-key :scope) #{s/Keyword}
+                        (s/optional-key :original-uri) s/Str
+                        s/Keyword s/Any}
   [p :- (s/protocol AccessTokenGrantee)
    req :- s/Any]
-  (get-access-token p req))
+  (or (get-access-token p req) {}))

 (defprotocol UserIdentity
   (get-claims [_ req]
     "Get the claims contained in the id-token returned as part of an
     OpenID/Connect exchange."))

+(defn get-identity [client req]
+  (-> (get-claims client req) :sub))

 ;; Ring middleware to restrict a handler to a given role.
 ;; The algo in here should fit many usages. However, other functions
 ;; could be provided to implement different policies.
-(defn wrap-restricted
+(defn wrap-require-authorization
   "Restrict a handler to a role. :identity and :access-token are added
   to the request. If a role is specified, also check that the role
   exists in the scope of the client. If role isn't specified, the
   identity and access-token are still retrieved."
   [h client & [role]]
   (fn [req]
-    (let [{:keys [access-token scope] :as at} (s/with-fn-validation (get-access-token+ client req))
-          identity (-> (get-claims client req) :sub)]
+    (let [{:keys [access-token scope]}
+          (s/with-fn-validation (get-access-token+ client req))]
       (cond
        (nil? access-token)
        (do
@@ -67,4 +70,6 @@
        {:status 401 :body "Sorry, you just don't have enough privileges to access this page"}

        :otherwise
-       (h (assoc req :identity identity :access-token access-token))))))
+       (h (assoc req
+            :identity (get-identity client req)
+            :access-token access-token))))))


Fixed jump animation orientation.

Fixed jump animation orientation.

--- src/divergence/system.cljs
+++ src/divergence/system.cljs
@@ -288,13 +288,17 @@
         (swap! e assoc-in [:acceleration] [-3 0 0])
         (swap! e assoc-in [:climbing] 0) ;when pressing left, turn gravity back on and climb mode off
         (swap! e assoc-in [:gravity] [0 0.2 0])
-        (set! (.-textures sprite) (cljs-to-js (map textures/textures e/walkAnimationLeft))))
+        (if (= (@e :can-jump) 0)
+         (set! (.-textures sprite) (cljs-to-js (map textures/textures e/jumpAnimationLeft)))
+         (set! (.-textures sprite) (cljs-to-js (map textures/textures e/walkAnimationLeft)))))
       (when
         (actions :right)
         (swap! e assoc-in [:acceleration] [3 0 0])
         (swap! e assoc-in [:climbing] 0) ;when pressing right, turn gravity back on and climb mode off
         (swap! e assoc-in [:gravity] [0 0.2 0])
-        (set! (.-textures sprite) (cljs-to-js (map textures/textures e/walkAnimationRight))))
+        (if (= (@e :can-jump) 0)
+          (set! (.-textures sprite) (cljs-to-js (map textures/textures e/jumpAnimationRight)))
+          (set! (.-textures sprite) (cljs-to-js (map textures/textures e/walkAnimationRight)))))
       (when
         (actions :down)
         (swap! e assoc-in [:acceleration] [0 1 0]))
@@ -302,11 +306,8 @@
         (and (= (@e :can-jump) 1) (actions :up))
         (when (= (e/entity-atom->component-val e :name) :player)
           (a/play-sound :jump)
-          (if (actions :right)
             (do (set! (.-textures sprite) (cljs-to-js (map textures/textures e/jumpAnimationRight)))
-                (set! (.-playing sprite) true))
-            (do (set! (.-textures sprite) (cljs-to-js (map textures/textures e/jumpAnimationLeft)))
-                (set! (.-playing sprite) true))))
+                (set! (.-playing sprite) true)))
         (swap! e assoc-in [:acceleration] [0 -4 0])
         (swap! e assoc-in [:can-jump] 0))


show current track info

show current track info

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -73,9 +73,9 @@
   (reify
     om/IRender
     (render [this]
-      (if-not (= 0 (:current-track data))
-        (let [track-index (- (:current-track data) 1)
-              tags (nth (:music-tags data) track-index)]
+      (if-not (nil? (:current-track-id data))
+        (let [music-info (core/get-music-info-from-id (:current-track-id data))
+              tags (.-tags music-info)]
           (dom/div nil
             (dom/div nil (.-title tags))
             (dom/div nil (.-album tags))
@@ -94,7 +94,7 @@
 (om/root users-upload-progress-view core/app-state {:target (. js/document (getElementById "users-upload-progress"))})
 (om/root username-form core/app-state {:target (. js/document (getElementById "username-form"))})
 (om/root message-form core/app-state {:target (. js/document (getElementById "message-form"))})
-;(om/root current-track-tags-view core/app-state {:target (. js/document (getElementById "current-track-tags"))})
+(om/root current-track-tags-view core/app-state {:target (. js/document (getElementById "current-track-tags"))})

 ; music player
 (defn resume-button [data owner]


Add sandbox function to generate random dates

--- src/test_utils/sandbox.cljs
+++ src/test_utils/sandbox.cljs
@@ -21,3 +21,9 @@

 (defn phone-number []
   (str "555-" (tuc/rand-3) "-" (tuc/rand-4)))
+
+(defn date []
+  (str (tuc/rand-range 1999 2023) "-"
+       (tuc/rand-range 1 13) "-"
+       (tuc/rand-range 1 32) " "))
+


support InlineFragment in transformation

--- src/graphql_clj/parser.clj
+++ src/graphql_clj/parser.clj
@@ -96,7 +96,10 @@
                    {:fragment-name (second v)})
    :FragmentSpread (fn fragment-spread [v]
                      (log/debug "FragmentSpread: " v)
-                     [:fragment-spread v])})
+                     [:fragment-spread v])
+   :InlineFragment (fn inline-fragment [& args]
+                     (log/debug "InlineFragment: " args)
+                     [:inline-fragment (into {} args)])})

 (defn transformer
   [parse-tree]


Fix formatting of Jetty exclude tests

Fix formatting of Jetty exclude tests

--- ring-jetty-adapter/test/ring/adapter/test/jetty.clj
+++ ring-jetty-adapter/test/ring/adapter/test/jetty.clj
@@ -47,6 +47,12 @@
        (first)
        (.getSslContextFactory)))

+(defn- exclude-ciphers [server]
+  (set (.getExcludeCipherSuites (get-ssl-context-factory server))))
+
+(defn- exclude-protocols [server]
+  (set (.getExcludeProtocols (get-ssl-context-factory server))))
+
 (def test-port (find-free-local-port))

 (def test-ssl-port (find-free-local-port))
@@ -55,20 +61,16 @@

 (def test-ssl-url (str "https://localhost:" test-ssl-port))

-(def test-ssl-options {:port test-port
-                       :ssl? true
-                       :ssl-port test-ssl-port
-                       :keystore (doto (KeyStore/getInstance (KeyStore/getDefaultType))
-                                   (.load nil))
-                       :key-password "hunter2"
-                       :join? nil})
-
-(defn- with-ssl-server [app options f]
-  (let [options (merge test-ssl-options options)]
-    (let [server (run-jetty app options)]
-      (try
-        (f server)
-        (finally (.stop server))))))
+(def nil-keystore
+  (doto (KeyStore/getInstance (KeyStore/getDefaultType)) (.load nil)))
+
+(def test-ssl-options
+  {:port         test-port
+   :ssl?         true
+   :ssl-port     test-ssl-port
+   :keystore     nil-keystore
+   :key-password "hunter2"
+   :join?        false})

 (deftest test-run-jetty
   (testing "HTTP server"
@@ -213,6 +215,24 @@
         (let [response (http/get test-url)]
           (is (not (contains? (:headers response) "Server")))))))

+  (testing "excluding cipher suites"
+    (let [cipher  "SSL_RSA_WITH_NULL_MD5"
+          options (assoc test-ssl-options :exclude-ciphers [cipher])
+          server  (run-jetty echo-handler options)]
+      (try
+        (is (contains? (exclude-ciphers server) cipher))
+        (finally
+          (.stop server)))))
+
+  (testing "excluding cipher protocols"
+    (let [protocol "SSLv2Hello"
+          options  (assoc test-ssl-options :exclude-protocols [protocol])
+          server   (run-jetty echo-handler options)]
+      (try
+        (is (contains? (exclude-protocols server) protocol))
+        (finally
+          (.stop server)))))
+
   ;; Unable to get test working with Jetty 9
   (comment
     (testing "resource cleanup on exception"
@@ -224,15 +244,3 @@
               (Thread/sleep 250)
               (recur (inc i))))
           (is (= thread-count (count (all-threads)))))))))
-
-(deftest test-ssl-context-factory
-  (testing "excluding cipher suites"
-    (let [cipher "SSL_RSA_WITH_NULL_MD5"]
-      (with-ssl-server
-        echo-handler {:exclude-ciphers [cipher]}
-        #(is (contains? (set (.getExcludeCipherSuites (get-ssl-context-factory %))) cipher)))))
-
-  (testing "excluding protocols"
-    (let [protocol "SSLv2Hello"]
-      (with-ssl-server echo-handler {:exclude-prococols [protocol]}
-        #(is (contains? (set (.getExcludeProtocols (get-ssl-context-factory %))) protocol))))))