Improve 401 check to use new /me endpoint

--- src/cljs/org/broadinstitute/firecloud_ui/utils.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/utils.cljs
@@ -103,48 +103,38 @@
                     (aset xhr (name k) v))
                   xhr))
           call-on-done (fn []
-                         (let [status-code (.-status xhr)]
-                              (if (= status-code 401)
-                                (let [us-xhr (js/XMLHttpRequest.)]
-                                     (set! (.-withCredentials us-xhr) true)
-                                     (.addEventListener us-xhr "loadend"
-                                       (fn []
-                                           (let [us-status (.-status us-xhr)]
-                                                (cond
-                                                  ;TODO: Fix this with a real log-out once the login bug is fixed and logout is implemented.
-                                                  (= us-status 401)
-                                                    (do (delete-access-token-cookie)
-                                                        (.reload (.-location js/window)))
-                                                  (= us-status 200)
-                                                    (let [parsed-us-response (parse-json-string (.-responseText us-xhr))
-                                                        user-info (keywordize-keys parsed-us-response)]
-                                                      (when (not (:ldap (:enabled (:userInfo user-info)))))
-                                                        (on-done {:xhr us-xhr
-                                                                  :status-code 403
-                                                                  :success? false
-                                                                  :status-text "Access Disabled"
-                                                                  :get-parsed-response parsed-us-response})
-                                                        :else (on-done {:xhr us-xhr
-                                                                   :status-code us-status
-                                                                   :success? false
-                                                                   :status-text (.-statusText us-xhr)
-                                                                   :get-parsed-response parsed-us-response}))
-                                                  :else (on-done {:xhr us-xhr
-                                                                  :status-code us-status
-                                                                  :success? false
-                                                                  :status-text (.-statusText us-xhr)
-                                                                  :get-parsed-response (parse-json-string (.-responseText us-xhr))})))))
-                                     (.open us-xhr "GET" "/service/register")
-                                     (.setRequestHeader us-xhr "Authorization" (str "Bearer " @access-token))
-                                     (.setRequestHeader us-xhr "Content-Type" "application/json" )
-                                     (.setRequestHeader us-xhr "Accept" "application/json" )
-                                     (.send us-xhr))
-                              (on-done {:xhr xhr
-                                       :status-code status-code
-                                       :success? (and (>= status-code 200)
-                                                      (< status-code 300))
-                                       :status-text (.-statusText xhr)
-                                       :get-parsed-response #(parse-json-string (.-responseText xhr))}))))]
+                         (let [status-code (.-status xhr)
+                               orig-response {:xhr xhr
+                                              :status-code status-code
+                                              :success? (< 199 status-code 300)
+                                              :status-text (.-statusText xhr)
+                                              :get-parsed-response #(parse-json-string (.-responseText xhr))}]
+                           (if (= status-code 401)
+                             (let [us-xhr (js/XMLHttpRequest.)]
+                               (set! (.-withCredentials us-xhr) true)
+                               (.addEventListener us-xhr "loadend"
+                                 (fn []
+                                   (let [us-status (.-status us-xhr)
+                                         parsed-us-response (parse-json-string (.-responseText us-xhr))
+                                         keywordized-us-response (keywordize-keys parsed-us-response)]
+                                     (cond
+                                       ;TODO: Fix this with a real log-out once the login bug is fixed and logout is implemented.
+                                       (= us-status 401) (do (delete-access-token-cookie)
+                                                           (.reload (.-location js/window)))
+                                       (= us-status 403)
+                                       (on-done {:xhr us-xhr
+                                                 :status-code us-status
+                                                 :success? false
+                                                 :status-text "FireCloud user not activated"
+                                                 :get-parsed-response parsed-us-response})
+                                       (= us-status 404) (.replace (.-location js/window) "#profile")
+                                       :else (on-done orig-response)))))
+                               (.open us-xhr "GET" "/service/me")
+                               (.setRequestHeader us-xhr "Authorization" (str "Bearer " @access-token))
+                               (.setRequestHeader us-xhr "Content-Type" "application/json")
+                               (.setRequestHeader us-xhr "Accept" "application/json")
+                               (.send us-xhr))
+                             (on-done orig-response))))]
       (when with-credentials?
         (set! (.-withCredentials xhr) true))
       (if canned-response-params


Doubled max points

Doubled max points

--- src/clojush/problems/tozier/the_idea_of_numbers.clj
+++ src/clojush/problems/tozier/the_idea_of_numbers.clj
@@ -47,7 +47,7 @@
 (def argmap
   {:error-function (missing-numbers-error-function 20)
    :atom-generators missing-numbers-atom-generators
-   :max-points 500
+   :max-points 1000
    :max-genome-size-in-initial-program 300
    :evalpush-limit 1000
    :population-size 1000


Actually use seed in the new test

Actually use seed in the new test

Somehow I didn't notice that I was generating a couple things and not
using them at all.

--- src/test/clojure/clojure/test/check/test.cljc
+++ src/test/clojure/clojure/test/check/test.cljc
@@ -1011,12 +1011,11 @@
         failing-prop
         (prop/for-all [nums gen-let-with-independent-clauses]
           (not (every? #(< 100 % 1000) nums)))]
-    (prop/for-all [seed gen-seed
-                   size gen/nat]
+    (prop/for-all [seed gen-seed]
       ;; I suspect that this property is likely enough to fail
       ;; that 1000000 trials will virtually always trigger it,
       ;; but I haven't done the math on that.
-      (let [res (tc/quick-check 1000000 failing-prop)]
+      (let [res (tc/quick-check 1000000 failing-prop :seed seed)]
         (and (false? (:result res))
              (= [101 101 101]
                 (-> res :shrunk :smallest first)))))))


Changed visual regression name to match others

--- src/visuals/untangled/ui/element_visuals.cljs
+++ src/visuals/untangled/ui/element_visuals.cljs
@@ -24,7 +24,7 @@
     (e/ui-badge {} (icon :arrow_back))
     (e/ui-badge {} (icon :arrow_back) (icon :arrow_forward))))

-(defcard messages-for-visual-regressions
+(defcard messages-visual-regressions
          "Messages are decorated via a normal function.  The properties are a normal clj(s) map that can contain any of the normal HTML/React attributes"
          (dom/div nil
                   (e/ui-message {} "This is default message.")


dsets.clj: slight change in (trace)

dsets.clj: slight change in (trace)

--- clojure/org/gavrog/clojure/dsets.clj
+++ clojure/org/gavrog/clojure/dsets.clj
@@ -15,11 +15,12 @@
                (when-let [[i D] (first free)]
                  (when-let [oDi (s ds i (n2o D))]
                    (let [Di (or (o2n oDi) (inc n))
-                         free (if (<= Di n) free (plus-all free Di))]
-                     (lazy-seq (cons Di (step (assoc o2n oDi Di)
-                                              (assoc n2o Di oDi)
-                                              (max n Di)
-                                              (disj free [i D] [i Di]))))))))]
+                         free (if (<= Di n) free (plus-all free Di))
+                         o2n (assoc o2n oDi Di)
+                         n2o (assoc n2o Di oDi)
+                         n (max n Di)
+                         free (disj free [i D] [i Di])]
+                     (lazy-seq (cons Di (step o2n n2o n free)))))))]
     (step {D 1} {1 D} 1 (plus-all (sorted-set) 1))))

 (defn- cmp [xs ys]


update to latest om

update to latest om

--- labs/architecture-examples/om/src/todomvc/app.cljs
+++ labs/architecture-examples/om/src/todomvc/app.cljs
@@ -108,9 +108,10 @@
     false))

 (defn destroy-todo [app todo]
-  (let [id (om/read todo [:id])]
-    (om/transact! app [:todos]
-      (fn [todos] (into [] (remove #(= (:id %) id) todos))))))
+  (om/read todo [:id]
+    (fn [id]
+      (om/transact! app [:todos]
+        (fn [todos] (into [] (remove #(= (:id %) id) todos)))))))

 (defn edit-todo [app todo]
   (let [id (om/read todo [:id])]


fix keyword (schema -> scheme) from main-routes

--- storm-core/src/clj/backtype/storm/ui/core.clj
+++ storm-core/src/clj/backtype/storm/ui/core.clj
@@ -852,11 +852,11 @@
     (populate-context! servlet-request)
     (assert-authorized-user "getClusterInfo")
     (json-response (all-topologies-summary) (:callback m)))
-  (GET "/api/v1/topology/:id" [:as {:keys [cookies servlet-request schema]} id & m]
+  (GET "/api/v1/topology/:id" [:as {:keys [cookies servlet-request scheme]} id & m]
     (populate-context! servlet-request)
     (assert-authorized-user "getTopology" (topology-config id))
     (let [user (get-user-name servlet-request)]
-      (json-response (topology-page id (:window m) (check-include-sys? (:sys m)) user (= schema :https)) (:callback m))))
+      (json-response (topology-page id (:window m) (check-include-sys? (:sys m)) user (= scheme :https)) (:callback m))))
   (GET "/api/v1/topology/:id/visualization-init" [:as {:keys [cookies servlet-request]} id & m]
     (populate-context! servlet-request)
     (assert-authorized-user "getTopology" (topology-config id))


Simplify y-axis grid line drawing and programatically compute grid line interval constants.

--- metlog-vault/src-client/metlog_client/tsplot.cljs
+++ metlog-vault/src-client/metlog_client/tsplot.cljs
@@ -4,6 +4,14 @@
             [cljs-time.format :as time-format]
             [cljs-time.coerce :as time-coerce]))

+
+(defn floor [ x ]
+  (.floor js/Math x))
+
+(defn pixel-snap [ t ]
+  (+ 0.5 (floor t)))
+
+
 (def dtf-axis-label (time-format/formatter "MM-dd HH:mm"))
 (def dtf-header (time-format/formatter "yyyy-MM-dd HH:mm"))
 (def x-axis-space 20)
@@ -12,16 +20,17 @@

 (def pixels-per-y-label 20)

-(def y-line-intervals [0.1 0.2 0.5
-                       1 2 5
-                       10 20 50
-                       100 200 500])
+(def y-line-intervals
+  (mapcat (fn [ scale ]
+            (map #(* % (.pow js/Math 10 scale))
+                 [ 1 2 5 ]))
+          (range -3 3)))

 (def stroke-styles
   {:grid
    {:line-width 0
     :stroke-style "#707070"
-    :line-dash #js [ 2 2]}
+    :line-dash #js [ 2 2 ]}

    :grid-emphasis
    {:line-width 0
@@ -37,12 +46,6 @@
    {:line-width 1
     :stroke-style "#000000"
     :line-dash #js [ ]}})
-
-(defn floor [ x ]
-  (.floor js/Math x))
-
-(defn pixel-snap [ t ]
-  (+ 0.5 (floor t)))

 (defn range-contains-zero? [ range ]
   (and (< (:min range) 0.0)
@@ -155,25 +158,21 @@
   (with-preserved-ctx ctx
     (let [ty (translate-fn-invert y-range h)
           y-interval (find-y-grid-interval h y-range)]
-      (if (range-contains-zero? y-range)
-        (let [positive-lines (floor (/ (:max y-range) y-interval))
-              negative-lines (floor (/ (- (:min y-range)) y-interval))]
-          (draw-y-grid-line ctx w (pixel-snap (ty 0.0)) 0.0 true)
-          (doseq [ii (range positive-lines)]
-            (draw-y-grid-line ctx w (pixel-snap (ty (* y-interval (+ ii 1)))) (* y-interval (+ ii 1)) false))
-          (doseq [ii (range negative-lines)]
-            (draw-y-grid-line ctx w (pixel-snap (ty (* (- y-interval) (+ ii 1)))) (* (- y-interval) (+ ii 1)) false)))
-        (let [ lines (floor (/ (range-magnitude y-range) y-interval))]
-          (doseq [ii (range lines)]
-            (draw-y-grid-line ctx w (pixel-snap (ty (+ (:min y-range) (* y-interval (+ ii 1)))))
-                              (+ (:min y-range) (* y-interval (+ ii 1))) false)))))))
+      (doseq [ y (if (range-contains-zero? y-range)
+                   (concat (map #(* y-interval %)
+                                (range (/ (:max y-range) y-interval)))
+                           (map #(* (- y-interval) (+ % 1))
+                                (range (- (/ (- (:min y-range)) y-interval) 1))))
+                   (map #(+ (:min y-range) (* y-interval (+ % 1)))
+                        (range (/ (range-magnitude y-range) y-interval))))]
+        (draw-y-grid-line ctx w (pixel-snap (ty y)) y (= y 0))))))

 (defn draw-series [ ctx w h data x-range ]
   (with-preserved-ctx ctx
     (set-stroke-style ctx :series-line)

     (aset ctx "font" "12px Arial")
-    (let [y-range (rescale-range (s-yrange data) 1.2)]
+    (let [y-range (rescale-range (s-yrange data) 1.1)]
       (unless (empty? data)
               (draw-y-grid ctx w h y-range)
               (with-preserved-ctx ctx


DM + GR #107 - Front end test for validation messages on create question form post

--- test/objective8/integration/front_end/questions.clj
+++ test/objective8/integration/front_end/questions.clj
@@ -13,6 +13,7 @@
 (def USER_ID 1)
 (def OBJECTIVE_ID 234)
 (def QUESTION_ID 42)
+(def TWITTER_ID "twitter-12345")
 (def INVALID_ID "not-an-int-id")
 (def QUESTION_URI (str "/objectives/" OBJECTIVE_ID "/questions/" QUESTION_ID))
 (def question-view-get-request (mock/request :get (str utils/host-url "/objectives/" OBJECTIVE_ID "/questions/" QUESTION_ID)))
@@ -23,6 +24,30 @@
 (def default-app (core/app helpers/test-config))

 (def user-session (helpers/test-context))
+
+(facts "about creating questions"
+       (binding [config/enable-csrf false]
+         (tabular
+          (fact "validation errors are reported"
+                (against-background
+                 (oauth/access-token anything anything anything) => {:user_id TWITTER_ID}
+                 (http-api/find-user-by-twitter-id anything) => {:status ::http-api/success
+                                                                 :result {:_id USER_ID :username "username" :writer-records []}}
+                 (http-api/get-user anything) => {:result {:_id USER_ID :username "username" :writer-records []}}
+                 (http-api/get-objective OBJECTIVE_ID) => {:status ::http-api/success
+                                                           :result {:_id OBJECTIVE_ID}})
+                (-> user-session
+                    helpers/sign-in-as-existing-user
+                    (p/request (utils/path-for :fe/add-question-form-post :id OBJECTIVE_ID)
+                               :request-method :post
+                               :params {:question ?question})
+                    p/follow-redirect
+                    :response
+                    :body) => (contains ?expected-error-message))
+
+          ?question                        ?expected-error-message
+          (helpers/string-of-length 9)     "clj-question-length-error"
+          (helpers/string-of-length 501)   "clj-question-length-error")))

 (facts "about questions"
        (binding [config/enable-csrf false]


Track page views in mixpanel

Track page views in mixpanel

Including join code if any.

--- frontend/routes.cljs
+++ frontend/routes.cljs
@@ -12,11 +12,14 @@

 (defn open-to-inner! [nav-ch navigation-point args]
+  (mixpanel/track "View page" {:zone :inner})
   (put! nav-ch [navigation-point (assoc args :inner? true)]))

 (defn open-to-outer! [nav-ch navigation-point args]
-  (when-let [join (-> args :query-params :join)]
-    (mixpanel/track "Has join code" {:join join}))
+  (mixpanel/track "View page"
+                  (merge {:zone :outer}
+                         (when-let [join (-> args :query-params :join)]
+                           {:join-code join})))
   (put! nav-ch [navigation-point (assoc args :inner? false)]))

 (defn logout! [nav-ch]


Take 1000

Take 1000

--- src/wlmmap/handler.clj
+++ src/wlmmap/handler.clj
@@ -40,7 +40,7 @@
 (defn- generate-markers
   "return a string with the javascript code to generate addressPoints."
   [params]
-  (let [mons (take 5000 (wcar* (car/smembers "frfrim")))
+  (let [mons (take 1000 (wcar* (car/smembers "frfrim")))
         all (remove #(nil? %)
                     (for [m mons]
                       (let [res (read-string (wcar* (car/get m)))


Fix wrong data-symbol for macros

Fix wrong data-symbol for macros

--- src/leiningen/highlight/rendering_rules/html.clj
+++ src/leiningen/highlight/rendering_rules/html.clj
@@ -37,8 +37,9 @@
                (wrap-span type (symbol-attr v)
                           (var-link (:var info) v)))
         "macro"
-        #_=> (wrap-span type (symbol-attr (:macro info))
-                        (var-link (:macro info) v))
+        #_=> (let [macro-name (str/replace (str (:macro info)) #"^#'" "")]
+               (wrap-span type (symbol-attr macro-name)
+                          (var-link (:macro info) v)))
         #_else (wrap-span type v)))))

 (defn string-rule [x v]


refers on a newline as app-name messes with align Depending on the length of your app name, things will be misaligned.

--- src/leiningen/new/onyx_app/src/onyx_app/jobs/sample_submit_job.clj
+++ src/leiningen/new/onyx_app/src/onyx_app/jobs/sample_submit_job.clj
@@ -1,12 +1,8 @@
 (ns {{app-name}}.jobs.sample-submit-job
     (:require [{{app-name}}.catalogs.sample-catalog :refer [build-catalog]]
-              [{{app-name}}.lifecycles.sample-lifecycle :refer [add-core-async
-                                                                add-kafka
-                                                                add-logging
-                                                                add-sql
-                                                                add-seq
-                                                                add-metrics
-                                                                build-lifecycles]]
+              [{{app-name}}.lifecycles.sample-lifecycle
+               :refer [add-core-async add-kafka add-logging
+                       add-sql add-seq add-metrics build-lifecycles]]
               [{{app-name}}.sample-input :refer [lines]]
               [{{app-name}}.workflows.sample-workflow :refer [build-workflow]]
               [onyx.test-helper :refer [load-config]]))


Fix bug causing inventory to be nil

Fix bug causing inventory to be nil

--- src/monkey_music/core.cljs
+++ src/monkey_music/core.cljs
@@ -291,7 +291,7 @@
         total-value (reduce + (map value-of valuables))]
     (-> state
         (update-in [:teams team-name :score] + total-value)
-        (assoc-in [:teams team-name :inventory] non-valuables))))
+        (assoc-in [:teams team-name :inventory] (into [] non-valuables)))))

 (defn find-first [pred coll] (first (filter pred coll)))


Helpers for end offsets.

Helpers for end offsets.

--- src/onyx/kafka/helpers.clj
+++ src/onyx/kafka/helpers.clj
@@ -5,7 +5,7 @@
            [org.apache.kafka.clients.consumer KafkaConsumer ConsumerRecord]
            [org.apache.kafka.clients.producer KafkaProducer Callback ProducerRecord]
            [org.apache.kafka.common.serialization ByteArrayDeserializer ByteArraySerializer Serializer Deserializer]
-           [org.apache.kafka.common TopicPartition]
+           [org.apache.kafka.common TopicPartition PartitionInfo]
            [kafka.admin AdminUtils]
            [kafka.utils ZKStringSerializer$]
            [org.I0Itec.zkclient ZkClient ZkConnection IZkConnection]
@@ -163,3 +163,22 @@
         record (ProducerRecord. topic part k v)]
     (.send producer record (->ProducerCallback p))
     @p))
+
+(defn partition-info->topic-partition [topic ^PartitionInfo part-info]
+  (TopicPartition. topic (.partition part-info)))
+
+(defn end-offsets [bootstrap-servers topic]
+  (let [opts {"bootstrap.servers" bootstrap-servers}
+        k-deser (ByteArrayDeserializer.)
+        v-deser (ByteArrayDeserializer.)]
+    (with-open [consumer (build-consumer opts k-deser v-deser)]
+      (let [parts (.partitionsFor consumer topic)
+            tps (map (partial partition-info->topic-partition topic) parts)]
+        (.endOffsets consumer tps)))))
+
+(defn end-offsets->clj [end-offsets]
+  (reduce-kv
+   (fn [all ^TopicPartition k v]
+     (assoc all (.partition k) v))
+   {}
+   (into {} end-offsets)))


added binding for handshake so it can be done only after handler setup

--- src/org/httpkit/server.clj
+++ src/org/httpkit/server.clj
@@ -131,16 +131,18 @@
     (on-close [ch callback])

   See org.httpkit.timer ns for optional timeout facilities."
-  [request ch-name & body]
-  `(let [~ch-name (:async-channel ~request)]
+  [request ch-name handshake & body]
+  `(let [~ch-name (:async-channel ~request)
+         ~handshake #(throw (Exception. "No handler defined"))]
      (if (:websocket? ~request)
        (if-let [key# (get-in ~request [:headers "sec-websocket-key"])]
-         (do (.sendHandshake ~(with-meta ch-name {:tag `AsyncChannel})
-                             {"Upgrade"    "websocket"
-                              "Connection" "Upgrade"
-                              "Sec-WebSocket-Accept" (accept key#)})
-             ~@body
-             {:body ~ch-name})
+         (let [~handshake #(.sendHandshake
+                            ~(with-meta ch-name {:tag `AsyncChannel})
+                            {"Upgrade"    "websocket"
+                             "Connection" "Upgrade"
+                             "Sec-WebSocket-Accept" (accept key#)})]
+           ~@body
+           {:body ~ch-name})
          {:status 400 :body "Bad Sec-WebSocket-Key header"})
        (do ~@body
            {:body ~ch-name}))))


add satisfied? and satisfied-deps query fns to examine the state of satisfied dependencies.

--- src/overtone/libs/deps.clj
+++ src/overtone/libs/deps.clj
@@ -5,6 +5,13 @@
   overtone.libs.deps
   (:require [clojure.set :as set]))

+;; A representation of the state of the dependencies:
+;; :satisified - a set of keywords representing ids for each of the satisfied
+;;               dependencies
+;; :todo       - a list of functions with associated dependencies which need
+;;               to be executed when those dependencies are met
+;; :done       - a list of functions with associated dependencies which have
+;;               already been executed as their dependencies have been met
 (defonce dep-state* (agent {:satisfied #{}
                             :todo []
                             :done []}))
@@ -63,6 +70,13 @@
      :done t-done
      :todo t-todo}))

+(defn- deps->set
+  "Converts deps to a deps-set. Deals with single elements or collections."
+  [deps]
+  (if (coll? deps)
+    (set deps)
+    (set [deps])))
+
 (defn on-deps
   "Specify that a function should be called once one or more dependencies
   have been satisfied. The function is run immediately if the deps have
@@ -73,9 +87,7 @@

   Uses an agent so it's safe to call this from within a transaction."
   [deps key handler]
-  (let [deps (if (coll? deps)
-               (set deps)
-               (set [deps]))]
+  (let [deps (deps->set deps)]
     (send-off dep-state* on-deps* key deps handler)))

 (defn satisfy-deps
@@ -101,3 +113,16 @@
                      {:satisfied #{}
                       :todo (deps :done)
                       :done []})))
+
+(defn satisfied?
+  "Returns true if all the deps (specified either as a single dep or a
+  collection of deps) have been satisfied."
+  [deps]
+  (let [deps (deps->set deps)
+        satisfied (:satisfied @dep-state*)]
+    (set/superset? satisfied deps)))
+
+(defn satisfied-deps
+  "Returns a set of all satisfied deps"
+  []
+  (:satisfied @dep-state*))


Allow bus scopes to continue running after a (quit) and (boot). This isn't the case for buf scopes as loaded buffers are lost on quit.

--- src/overtone/viz/scope.clj
+++ src/overtone/viz/scope.clj
@@ -7,7 +7,7 @@
    (java.awt.geom Rectangle2D$Float Path2D$Float)
    (javax.swing JFrame JPanel))
   (:use
-   [overtone event util time-utils]
+   [overtone event util time-utils deps]
    [overtone.sc core synth ugen buffer node]
    [overtone.studio.util]
    clojure.stacktrace)
@@ -15,30 +15,32 @@
             [clojure.set :as set]))

 (def SCOPE-BUF-SIZE 4096)
-(def FPS 10)
-(def scopes* (atom {}))
-(def scope-pool* (atom nil))
-(def scopes-running?* (atom false))
+(def FPS 25)
+(def scopes* (ref {}))
+(def scope-pool* (agent (make-pool)))
+(def scopes-running?* (ref false))
 (def WIDTH 600)
 (def HEIGHT 400)
 (def X-PADDING 5)
 (def Y-PADDING 10)

-(defn- update-scope [s]
+(defn- update-scope-data [s]
   (let [{:keys [buf size width height panel y-array x-array panel]} s
         frames (buffer-data buf)
         step (int (/ (buffer-size buf) width))
         y-scale (/ (- height (* 2 Y-PADDING)) -2)
         y-shift (+ (/ height 2) Y-PADDING)]
-    (dotimes [x width]
-      (aset ^ints y-array x
-            (int (+ y-shift
-                    (* y-scale
-                       (aget ^floats frames (unchecked-multiply x step)))))))
+    (if-not (empty? frames)
+      (dotimes [x width]
+        (aset ^ints y-array x
+              (int (+ y-shift
+                      (* y-scale
+                         (aget ^floats frames (unchecked-multiply x step))))))))
+
     (.repaint panel)))

 (defn- update-scopes []
-  (doall (map update-scope (vals @scopes*))))
+  (doall (map update-scope-data (vals @scopes*))))

 (defn- paint-scope [g id]
   (if-let [scope (get @scopes* id)]
@@ -49,16 +51,6 @@
       (.drawRect ^Graphics g 0 0 width height)
       (.setColor ^Graphics g ^Color color)
       (.drawPolyline ^Graphics g ^ints x-array ^ints y-array width))))
-
-(defn- wait-for-buffer [b]
-  (loop [i 0]
-    (cond
-     (= 20 i) nil
-     (not (buffer-ready? b)) (do
-                               (java.lang.Thread/sleep 50)
-                               (recur (inc i))))))
-
-(def SCOPE-BUF-SIZE 4096)

 (defn scope-panel [id width height]
   (let [panel (proxy [JPanel] [true]
@@ -77,35 +69,32 @@
          (.show)
          (.setAlwaysOnTop keep-on-top)))))

-(defn- create-pool-if-necessary []
-  (if-not @scope-pool* (reset! scope-pool* (make-pool))))
-
-
 (defn- start-scopes-runner
   []
   (periodic update-scopes (/ 1000 FPS) 0 @scope-pool*))

 (defn scopes-start
   []
-  (if-not @scopes-running?*
-    (do
-      (create-pool-if-necessary)
-      (start-scopes-runner)
-      (reset! scopes-running?* true))))
-
-;;  (.cancel (:runner @scope*) true)
+  (dosync
+   (when-not @scopes-running?*
+     (start-scopes-runner)
+     (ref-set scopes-running?* true))))
+
 (defn scopes-stop
   []
-  (stop-and-reset-pool! scope-pool*)
-  (reset! scopes-running?* false))
-
+  (dosync
+   (stop-and-reset-pool! scope-pool*)
+   (ref-set scopes-running?* false)))
+
+(defn- start-bus-synth
+  [bus buf]
+  (bus->buf :target 0 :position :tail bus buf))

 (defn- scope-bus
   "Set a bus to view in the scope."
   [s]
   (let [buf (buffer SCOPE-BUF-SIZE)
-        _ (wait-for-buffer buf)
-        bus-synth (bus->buf :target 0 :position :tail (:num s) buf)]
+        bus-synth (start-bus-synth (:num s) buf)]
     (assoc s
       :size SCOPE-BUF-SIZE
       :bus-synth bus-synth
@@ -158,13 +147,28 @@
            kind (if (= -1 buf) :bus :buf)
            num  (if (= -1 buf) bus buf)
            s (mk-scope num kind keep-on-top WIDTH HEIGHT)]
-       (swap! scopes* assoc (:id s) s)
+       (dosync (alter scopes* assoc (:id s) s))
        (scopes-start))))

 (defn pscope
   "Creates a 'perminent' scope, i.e. one where the window is always kept on top of other OS windows. See scope."
   ([& args]
      (apply scope (concat args [:keep-on-top true]))))
+
+(defn- reset-scopes
+  "Restart scopes if they have already been running"
+  []
+  (dosync
+   (ref-set scopes*
+            (reduce (fn [new-scopes [k v]]
+                      (let [new-scope (if (= :bus (:kind v))
+                                        (scope-bus v)
+                                        v)]
+                        (assoc new-scopes k new-scope)))
+                    {}
+                    @scopes*))))
+
+(on-deps #{:synthdefs-loaded} ::reset-scopes reset-scopes)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Added rule description for root_concept_identifier_gen

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/pre-identifier-merge/step_a-ontology_to_ice/step_a/root_concept_identifier_gen.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/pre-identifier-merge/step_a-ontology_to_ice/step_a/root_concept_identifier_gen.clj
@@ -1,10 +1,10 @@
 ;; -------------------------------------------
 ;; --------- Root Concept Assignment ---------
 ;; -------------------------------------------
-;; create ICE URI's for each term in the ontology
 `{:name "root-concept-identifier-gen"
-  :head ((?/id rdf/type ccp/IAO_EXT_0000190) ; ontology root concept identifer
-         (?/id obo/IAO_0000219 ?/root)) ; denotes
+  :description "This rule creates an identifier for each root ontology class and types it as a root concept identifier (IAO_EXT_0000190)"
+  :head ((?/id rdf/type ccp/IAO_EXT_0000190) ;; ccp:ontology root concept identifer
+         (?/id obo/IAO_0000219 ?/root)) ;; obo:denotes
   :reify ([?/id {:ln (:localname ?/root)
                  :ns "ccp" :prefix "" :suffix ""}])
   :sparql-string "select ?root {


Remove unused mock from test

Remove unused mock from test

--- test/buildviz/jenkins/sync_jobs_test.clj
+++ test/buildviz/jenkins/sync_jobs_test.clj
@@ -28,15 +28,12 @@
                              (fn [_] {:status 404 :body ""})]) builds)]
     (cons job-builds test-results)))

-(defn- provide-buildviz-and-capture-puts [latest-build-start map-ref]
+(defn- provide-buildviz-and-capture-puts [map-ref]
   [[#"http://buildviz:8010/builds/(.+)/(.+)"
     (fn [req]
       (swap! map-ref #(conj % [(:uri req)
                                (j/parse-string (slurp (:body req)) true)]))
-      {:status 200 :body ""})]
-   ["http://buildviz:8010/status"
-    (successful-json-response (cond-> {}
-                                latest-build-start (assoc :latestBuildStart (tc/to-long latest-build-start))))]])
+      {:status 200 :body ""})]])

 (defn- serve-up [& routes]
   (->> routes
@@ -69,7 +66,7 @@
                                                                                :timestamp 1493201298062
                                                                                :duration 10200
                                                                                :result "SUCCESS"})
-                                                    (provide-buildviz-and-capture-puts beginning-of-2016 store))
+                                                    (provide-buildviz-and-capture-puts store))
         (with-out-str (sut/sync-jobs (url/url "http://jenkins:4321") (url/url "http://buildviz:8010") beginning-of-2016)))
       (is (= [["/builds/some_job/21" {:start 1493201298062
                                       :end 1493201308262
@@ -86,7 +83,7 @@
                                                                                :actions [{:causes [{:upstreamProject "the_upstream"
                                                                                :upstreamBuild "33"}]}
                                                                                {:causes [{:userId "the_user"}]}]})
-                                                    (provide-buildviz-and-capture-puts beginning-of-2016 store))
+                                                    (provide-buildviz-and-capture-puts store))
         (with-out-str (sut/sync-jobs (url/url "http://jenkins:4321") (url/url "http://buildviz:8010") beginning-of-2016)))
       (is (nil? (get (first (map last @store))
                      :triggeredBy))))))


Fix an arity exception in bigger-outbound test

Part of my logging refactoring

--- test/frereth_cp/message/message_test.clj
+++ test/frereth_cp/message/message_test.clj
@@ -529,7 +529,8 @@
         prelog (utils/pre-log test-run)
         logger (log2/std-out-log-factory)
         log-atom (atom (log2/info (log2/init ::bigger-outbound 0)
-                                  ::test-top))]
+                                  ::test-top
+                                  ""))]
     ;; TODO: split this into 2 tests
     ;; 1 should stall out like the current implementation,
     ;; waiting for ACKs (maybe drop every other packet?


Update for InfluxDB 0.9.0-rc30 write change.

--- src/riemann/influxdb_9.clj
+++ src/riemann/influxdb_9.clj
@@ -47,7 +47,7 @@
   [tag-keys event]
   (when (and (:time event) (:service event) (:metric event))
     {"name" (:service event)
-     "timestamp" (unix-to-iso8601 (:time event))
+     "time" (unix-to-iso8601 (:time event))
      "tags" (event-tags tag-keys event)
      "fields" (event-fields tag-keys event)}))

@@ -61,13 +61,13 @@

 (defn influxdb
   "Returns a function which accepts an event, or sequence of events, and writes
-  them to InfluxDB as a batch of measurement points.
+  them to InfluxDB as a batch of measurement points. For performance, you should
+  wrap this stream with `batch` or an asynchronous queue.

-  (batch 500 1
-    (influxdb {:host \"influxdb.example.com\"
-               :database \"my_db\"
-               :user \"riemann\"
-               :password \"secret\"}))
+      (influxdb {:host \"influxdb.example.com\"
+                 :database \"my_db\"
+                 :user \"riemann\"
+                 :password \"secret\"})

   Options:


Addressed review comments.

Addressed review comments.

--- storm-core/src/clj/backtype/storm/daemon/worker.clj
+++ storm-core/src/clj/backtype/storm/daemon/worker.clj
@@ -352,7 +352,11 @@
     (touch (worker-pid-path conf worker-id (process-pid))))
   (let [worker (worker-data conf shared-mq-context storm-id assignment-id port worker-id)
         heartbeat-fn #(do-heartbeat worker)
-
+
+        ;; do this here so that the worker process dies if this fails
+        ;; it's important that worker heartbeat to supervisor ASAP when launching so that the supervisor knows it's running (and can move on)
+        _ (heartbeat-fn)
+
         executors (atom nil)
         ;; launch heartbeat threads immediately so that slow-loading tasks don't cause the worker to timeout
         ;; to the supervisor


Completed rounds can not be selected

Completed rounds can not be selected

--- src/tango/cljs/client.cljs
+++ src/tango/cljs/client.cljs
@@ -405,26 +405,29 @@
             (om/props this)
             (first (:class/_rounds (:activity/source (om/props this)))))
           is-selected? (seq (filter #(= (:activity/id (om/props this)) (:activity/id %))
-                                    (:selected-activity (om/props this))))]
+                                    (:selected-activity (om/props this))))
+
+          completed? (= (:round/status (:activity/source (om/props this))) :completed)]
       ;(log (:selected-activity (om/props this)))
       (dom/tr #js {:className (if is-selected? "info" "")
-                   :onClick   #(om/transact!
-                                this
-                                `[(app/select-activity
-                                    {:activity/id    ~(:activity/id (om/props this))
-                                     :activity/name  ~name
-                                     :round/recall   ~(:round/recall (:activity/source
-                                                                       (om/props this)))
-                                     :round/name     ~round
-                                     :round/heats    ~(:round/heats (:activity/source
-                                                                      (om/props this)))
-                                     :round/starting ~(:round/starting (:activity/source
+                   :onClick   #(when-not completed?
+                                (om/transact!
+                                  this
+                                  `[(app/select-activity
+                                      {:activity/id    ~(:activity/id (om/props this))
+                                       :activity/name  ~name
+                                       :round/recall   ~(:round/recall (:activity/source
                                                                          (om/props this)))
-                                     :round/panel    ~(:round/panel (:activity/source
-                                                                      (om/props this)))
-                                     :round/dances ~(:round/dances (:activity/source
-                                                                     (om/props this)))})
-                                  :app/selected-activity])}
+                                       :round/name     ~round
+                                       :round/heats    ~(:round/heats (:activity/source
+                                                                        (om/props this)))
+                                       :round/starting ~(:round/starting (:activity/source
+                                                                           (om/props this)))
+                                       :round/panel    ~(:round/panel (:activity/source
+                                                                        (om/props this)))
+                                       :round/dances   ~(:round/dances (:activity/source
+                                                                         (om/props this)))})
+                                    :app/selected-activity]))}
         (dom/td nil time)
         (dom/td nil number)
         (dom/td nil name)


Don't try to read EZ or non-efiled forms

--- src/tax_extractor/core.clj
+++ src/tax_extractor/core.clj
@@ -76,36 +76,48 @@
 (defn threshold [filename]
   (sh "convert" filename "-threshold" "75%" filename))

+(defn efiled-990? [page-one]
+  (let [name-rect (Rectangle. 115 30 75 40)
+        tess (Tesseract/getInstance)]
+    (.setTessVariable tess "tessedit_char_whitelist" number-chars)
+    (= (clojure.string/trim (.doOCR tess page-one name-rect)) "990")))
+
 (defn read-pdf [pdf]
   (let [doc (doto (PDFDocument.)
-              (.load pdf))
-        renderer (doto (SimpleRenderer.)
-                   (.setResolution 300))
-        [page-one page-two] (.render renderer doc 7 8)
-        filename-one (str (java.util.UUID/randomUUID) ".png")
-        filename-two (str (java.util.UUID/randomUUID) ".png")
-        file-one (File. filename-one)
-        file-two (File. filename-two)]
-    (ImageIO/write page-one "png" file-one)
-    (ImageIO/write page-two "png" file-two)
-    (threshold filename-one)
-    (threshold filename-two)
-    (loop [idx 0
-           records []]
-      (if-let [record (try
-                        (read-record file-one file-two idx)
-                        (catch Exception e
-                          (println "Failed to read record" idx "from" (.getName pdf))
-                          (println "Exception:" (.getMessage e))
-                          nil))]
-        (do (print ".")
-            (flush)
-            (recur (inc idx)
-                   (conj records record)))
-        (do
-          (.delete file-one)
-          (.delete file-two)
-          records)))))
+              (.load pdf))]
+    (when (> (.getPageCount doc) 8)
+      (let [renderer (doto (SimpleRenderer.)
+                       (.setResolution 300))
+            [page-one page-two] (.render renderer doc 7 8)
+            filename-one (str (java.util.UUID/randomUUID) ".png")
+            filename-two (str (java.util.UUID/randomUUID) ".png")
+            file-one (File. filename-one)
+            file-two (File. filename-two)]
+        (ImageIO/write page-one "png" file-one)
+        (threshold filename-one)
+        (if (efiled-990? file-one)
+          (do
+            (ImageIO/write page-two "png" file-two)
+            (threshold filename-two)
+            (loop [idx 0
+                   records []]
+              (if-let [record (try
+                                (read-record file-one file-two idx)
+                                (catch Exception e
+                                  (println "Failed to read record" idx "from" (.getName pdf))
+                                  (println "Exception:" (.getMessage e))
+                                  nil))]
+                (do (print ".")
+                    (flush)
+                    (recur (inc idx)
+                           (conj records record)))
+                (do
+                  (.delete file-one)
+                  (.delete file-two)
+                  records))))
+          (do
+            (.delete file-one)
+            nil))))))

 (defn process-pdf [pdf out-path]
   (print "Processing" (.getName pdf))
@@ -113,13 +125,15 @@
   (let [out-filename (str out-path "/" (FilenameUtils/getBaseName (.getName pdf)) ".edn")]
     (when-not (.exists (File. out-filename))
       (try
-        (let [res (read-pdf pdf)]
-          (if (< (count res) 2)
-            (println "WARN: Fewer than 2 records for" (.getName pdf)))
-          (spit out-filename
-                (pr-str res)))
+        (if-let [res (read-pdf pdf)]
+          (do
+            (if (< (count res) 2)
+              (print " WARN: Fewer than 2 records"))
+            (spit out-filename
+                  (pr-str res)))
+          (print " SKIP: Not efiled 990"))
         (catch Exception e
-          (println "ERROR: Failed processing" (.getName pdf) "," (.getMessage e))))))
+          (println "ERROR: Failed processing," (.getMessage e))))))
   (println " DONE"))

 (defn pdf? [file]


🔊 Tweak logging

🔊 Tweak logging

--- src/territory_bro/main.clj
+++ src/territory_bro/main.clj
@@ -33,14 +33,14 @@
 (defn migrate-database! []
   (db/check-database-version 11)
   (let [master-schema (:database-schema config/env)]
-    (log/info "Migrating master schema" master-schema)
+    (log/info "Migrating master schema:" master-schema)
     (-> (db/master-schema master-schema)
         (.migrate))

     (doseq [congregation (db/with-db [conn {}]
                            (congregation/get-unrestricted-congregations conn))]
       (let [tenant-schema (:congregation/schema-name congregation)]
-        (log/info "Migrating tenant schema" tenant-schema)
+        (log/info "Migrating tenant schema:" tenant-schema)
         (-> (db/tenant-schema tenant-schema master-schema)
             (.migrate))))))


Unbox int value to ensure Integer-ness

Unbox int value to ensure Integer-ness

Fixes #64

--- server/src/main/clojure/vimclojure/repl.clj
+++ server/src/main/clojure/vimclojure/repl.clj
@@ -126,7 +126,7 @@
                    (the-repl :line)
                    line)]
     (with-bindings
-      {Compiler/LINE          line
+      {Compiler/LINE          (.intValue line) ; #64: Unbox to ensure int.
        Compiler/SOURCE        (.getName (java.io.File. file))
        Compiler/SOURCE_PATH   file
        #'*in*                 (make-reader *in* line)


replace <p> regex with stronger one

replace <p> regex with stronger one

--- src/unicodify_clj/core.clj
+++ src/unicodify_clj/core.clj
@@ -55,13 +55,14 @@

 (defn- DIRTY-strip-out-p-tags
   "Sometimes a file contains a
 tag that is not closed (e.g.
-  mirdardinaa%5E.html). This causes the parser to sloppily infer
+  mirdardinaa^.html). This causes the parser to sloppily infer
   where the
 should go, which causes transcoding issues. This
   is an attempt to get rid of these."
   [s]
   (if (and (clojure.string/includes? s "
")
            (not (clojure.string/includes? s "
")))
-    (clojure.string/replace s #"(
\s*)+(\r\n|\r|\n)" "\n")
+    ;(clojure.string/replace s #"(
\s*)+(\r\n|\r|\n)" "\n")
+    (clojure.string/replace s #"
" "
")
     s))

 (defn- DIRTY-fix-quotes


add missing argument

add missing argument

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -500,7 +500,7 @@
             #(set-property [d p v]))
           #(when-lets [exposure (:exposure event)
                        camera (core getCameraDevice)]
-             (device-best-effort (set-exposure exposure)))
+             (device-best-effort (set-exposure camera exposure)))
           #(when check-z-ref
              (recall-z-reference current-position))
           #(when-let [wait-time-ms (:wait-time-ms event)]


Revert accidental commit

Revert accidental commit

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -355,7 +355,7 @@

 (defn burst-cleanup []
    (when (@state :circular-buffer-overflow)
-   (ReportingUtils/logError "Circular buffer overflowed."))
+   (ReportingUtils/showError "Circular buffer overflowed."))
  (while (and (not (@state :stop)) (. mmc isSequenceRunning))
    (Thread/sleep 5)))


Added some hires tests.

Added some hires tests.

--- test/cmr/opendap/tests/system/app/ous/params_v1.clj
+++ test/cmr/opendap/tests/system/app/ous/params_v1.clj
@@ -140,3 +140,38 @@
       (is (= ["https://f5eil01.edn.ecs.nasa.gov/opendap/DEV01/user/FS2/AIRS/AIRX3STD.006/2002/AIRS.2002.09.04.L3.RetStd001.v6.0.9.0.G13208020620.hdf.nc"
               "https://f5eil01.edn.ecs.nasa.gov/opendap/DEV01/user/FS2/AIRS/AIRX3STD.006/2016.07.01/AIRS.2016.07.01.L3.RetStd001.v6.0.31.0.G16187132305.hdf.nc"]
              (util/parse-response response))))))
+
+(deftest collection-GET-query-coverage-rangesubset-hires
+  (let [collection-id "C1200268967-HMR_TME"
+        granule-id "G1200268968-HMR_TME"
+        variable-ids "V1200268970-HMR_TME,V1200268971-HMR_TME"
+        response @(httpc/get
+                   (format (str "http://localhost:%s"
+                                "/opendap/ous/collection/%s"
+                                "?coverage=%s,"
+                                "&rangesubset=%s")
+                           (test-system/http-port)
+                           collection-id
+                           granule-id
+                           variable-ids)
+                   (request/add-token-header {} (util/get-sit-token)))]
+    (is (= 200 (:status response)))
+    (is (= ["https://f5eil01.edn.ecs.nasa.gov/opendap/DEV01/user/FS2/DEMO/MUR-JPL-L4-GLOB-v4_1.001/2018.05.23/20180523090000-JPL-L4_GHRSST-SSTfnd-MUR-GLOB-v02.0-fv04.1.nc.nc?analysed_sst,analysis_error,lat,lon"]
+           (util/parse-response response)))))
+
+(deftest collection-GET-query-coverage-subset-hires
+  (let [collection-id "C1200268967-HMR_TME"
+        granule-id "G1200268968-HMR_TME"
+        response @(httpc/get
+                   (format (str "http://localhost:%s"
+                                "/opendap/ous/collection/%s"
+                                "?coverage=%s"
+                                "&subset=lat(56.109375,67.640625)"
+                                "&subset=lon(-9.984375,19.828125)")
+                           (test-system/http-port)
+                           collection-id
+                           granule-id)
+                   (request/add-token-header {} (util/get-sit-token)))]
+    (is (= 200 (:status response)))
+    (is (= ["XXX"]
+           (util/parse-response response)))))


Add more tests regarding nested protocols.

--- test/dsbdp/test/data_processing_dsl_tests.clj
+++ test/dsbdp/test/data_processing_dsl_tests.clj
@@ -338,7 +338,6 @@
 ;;;
 ;;; Tests for nested output data structures.
 ;;;
-
 (deftest byte-array-packet-to-nested-java-map-test
   (let [expected {"len" 58,
                   "data" {"dst" "FF:FE:FD:F2:F1:F0",
@@ -402,3 +401,41 @@
 ;    (is (map? result))
 ;    (is (= expected result))))

+(deftest nested-udp-byte-array-packet-test-1
+  (let [expected {"len" 58,
+                  "data" {"dst" "FF:FE:FD:F2:F1:F0",
+                          "data" {"proto-id" 17
+                                  "src" "1.2.3.4",
+                                  "data" {"src" 2048
+                                          "dst" 4096}}}}
+        dsl-expression {:output-type :clj-map
+                        :rules [['len '(int32be 8)]
+                                ['data [['dst '(eth-mac-addr-str 16)]
+                                        ['data [['proto-id '(int8 39)]
+                                                ['src '(ipv4-addr-str 42)]
+                                                ['data [['src '(int16 50)]
+                                                        ['dst '(int16 52)]]]]]]]]}
+        data-processing-fn (create-proc-fn dsl-expression)
+        result (data-processing-fn pcap-byte-array-test-data)]
+    (is (map? result))
+    (is (= expected result))))
+
+(deftest nested-tcp-byte-array-packet-test-1
+  (let [expected {"len" 58,
+                  "data" {"dst" "FF:FE:FD:F2:F1:F0",
+                          "data" {"proto-id" 6
+                                  "src" "127.0.0.1",
+                                  "data" {"src" 55522
+                                          "dst" 61481}}}}
+        dsl-expression {:output-type :clj-map
+                        :rules [['len '(int32be 8)]
+                                ['data [['dst '(eth-mac-addr-str 16)]
+                                        ['data [['proto-id '(int8 39)]
+                                                ['src '(ipv4-addr-str 42)]
+                                                ['data [['src '(int16 50)]
+                                                        ['dst '(int16 52)]]]]]]]]}
+        data-processing-fn (create-proc-fn dsl-expression)
+        result (data-processing-fn pcap-tcp-byte-array-test-data)]
+    (is (map? result))
+    (is (= expected result))))
+


Cosmetic refactor on sidebar options ns.

--- src/uxbox/main/ui/workspace/sidebar/options.cljs
+++ src/uxbox/main/ui/workspace/sidebar/options.cljs
@@ -6,32 +6,31 @@
 ;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

 (ns uxbox.main.ui.workspace.sidebar.options
-  (:require [sablono.core :as html :refer-macros [html]]
-            [rum.core :as rum]
-            [lentes.core :as l]
-            [uxbox.util.i18n :refer (tr)]
-            [uxbox.util.router :as r]
-            [uxbox.util.rstore :as rs]
-            [uxbox.main.state :as st]
-            [uxbox.main.library :as library]
-            [uxbox.main.data.workspace :as udw]
-            [uxbox.main.data.shapes :as uds]
-            [uxbox.main.ui.workspace.base :as wb]
-            [uxbox.main.ui.icons :as i]
-            [uxbox.util.mixins :as mx :include-macros true]
-            [uxbox.main.ui.workspace.colorpicker :refer (colorpicker)]
-            [uxbox.main.ui.workspace.recent-colors :refer (recent-colors)]
-            [uxbox.main.ui.workspace.sidebar.options.icon-measures :as options-iconm]
-            [uxbox.main.ui.workspace.sidebar.options.circle-measures :as options-circlem]
-            [uxbox.main.ui.workspace.sidebar.options.rect-measures :as options-rectm]
-            [uxbox.main.ui.workspace.sidebar.options.line-measures :as options-linem]
-            [uxbox.main.ui.workspace.sidebar.options.fill :as options-fill]
-            [uxbox.main.ui.workspace.sidebar.options.text :as options-text]
-            [uxbox.main.ui.workspace.sidebar.options.stroke :as options-stroke]
-            [uxbox.main.ui.workspace.sidebar.options.interactions :as options-interactions]
-            [uxbox.main.geom :as geom]
-            [uxbox.util.dom :as dom]
-            [uxbox.util.data :refer (parse-int parse-float read-string)]))
+  (:require
+   [lentes.core :as l]
+   [uxbox.util.i18n :refer (tr)]
+   [uxbox.util.router :as r]
+   [uxbox.util.rstore :as rs]
+   [uxbox.main.state :as st]
+   [uxbox.main.library :as library]
+   [uxbox.main.data.workspace :as udw]
+   [uxbox.main.data.shapes :as uds]
+   [uxbox.main.ui.workspace.base :as wb]
+   [uxbox.main.ui.icons :as i]
+   [uxbox.util.mixins :as mx :include-macros true]
+   [uxbox.main.ui.workspace.colorpicker :refer (colorpicker)]
+   [uxbox.main.ui.workspace.recent-colors :refer (recent-colors)]
+   [uxbox.main.ui.workspace.sidebar.options.icon-measures :as options-iconm]
+   [uxbox.main.ui.workspace.sidebar.options.circle-measures :as options-circlem]
+   [uxbox.main.ui.workspace.sidebar.options.rect-measures :as options-rectm]
+   [uxbox.main.ui.workspace.sidebar.options.line-measures :as options-linem]
+   [uxbox.main.ui.workspace.sidebar.options.fill :as options-fill]
+   [uxbox.main.ui.workspace.sidebar.options.text :as options-text]
+   [uxbox.main.ui.workspace.sidebar.options.stroke :as options-stroke]
+   [uxbox.main.ui.workspace.sidebar.options.interactions :as options-interactions]
+   [uxbox.main.geom :as geom]
+   [uxbox.util.dom :as dom]
+   [uxbox.util.data :refer (parse-int parse-float read-string)]))

 ;; --- Constants

@@ -83,29 +82,23 @@

 ;; --- Options

-(defn- options-render
+(mx/defcs options
+  {:mixins [mx/static (mx/local)]}
   [own shape]
   (let [local (:rum/local own)
         menus (get +menus-map+ (:type shape))
         active-menu (:menu @local (first menus))]
-    (html
-     [:div
-      [:ul.element-icons
-       (for [menu-id (get +menus-map+ (:type shape))
-             :let [menu (get +menus-by-id+ menu-id)
-                   selected? (= active-menu menu-id)]]
-         [:li#e-info {:on-click #(swap! local assoc :menu menu-id)
-                      :key (str "menu-" (:id menu))
-                      :class (when selected? "selected")}
-          (:icon menu)])]
-      (when-let [menu (get +menus-by-id+ active-menu)]
-        ((:comp menu) menu shape))])))
-
-(def ^:private options
-  (mx/component
-   {:render options-render
-    :name "options"
-    :mixins [mx/static (mx/local)]}))
+    [:div
+     [:ul.element-icons
+      (for [menu-id (get +menus-map+ (:type shape))
+            :let [menu (get +menus-by-id+ menu-id)
+                  selected? (= active-menu menu-id)]]
+        [:li#e-info {:on-click #(swap! local assoc :menu menu-id)
+                     :key (str "menu-" (:id menu))
+                     :class (when selected? "selected")}
+         (:icon menu)])]
+     (when-let [menu (get +menus-by-id+ active-menu)]
+       ((:comp menu) menu shape))]))

 (def selected-shape-ref
   (letfn [(getter [state]
@@ -115,23 +108,18 @@
     (-> (l/lens getter)
         (l/derive st/state))))

-(defn options-toolbox-render
-  [own]
+(mx/defc options-toolbox
+  {:mixins [mx/static mx/reactive]}
+  []
   (let [shape (mx/react selected-shape-ref)
         close #(rs/emit! (udw/toggle-flag :element-options))]
-    (html
-     [:div.elementa-options.tool-window
-      [:div.tool-window-bar
-       [:div.tool-window-icon i/options]
-       [:span (tr "ds.element-options")]
-       [:div.tool-window-close {:on-click close} i/close]]
-      [:div.tool-window-content
-       [:div.element-options
-        (if shape
-          (options shape))]]])))
+    [:div.elementa-options.tool-window
+     [:div.tool-window-bar
+      [:div.tool-window-icon i/options]
+      [:span (tr "ds.element-options")]
+      [:div.tool-window-close {:on-click close} i/close]]
+     [:div.tool-window-content
+      [:div.element-options
+       (if shape
+         (options shape))]]]))

-(def options-toolbox
-  (mx/component
-   {:render options-toolbox-render
-    :name "options-toolbox"
-    :mixins [mx/static mx/reactive (mx/local)]}))


Parameterized slide

Parameterized slide

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -20,17 +20,17 @@
   (init-slide-state [_])
   (render-slide [_ data owner]))

-(defrecord PutAndTakeSlide []
+(defrecord PutAndTakeSlide [opts]
   Slide
   (init-slide-state [_]
     (println "Init state of PutAndTakeSlide")
-    (let [bufsize 7
+    (let [bufsize (:buffer-size opts)
           buf1 (buffer bufsize)
           chan1 (chan buf1)]
       {:bufsize bufsize
        :buf1 buf1
        :chan1 chan1
-       :default-font "72pt"}))
+       :default-font (:font-size opts)}))
   (render-slide [_ data owner]
     (let [bufsize (om/get-state owner :bufsize)
           buf1 (om/get-state owner :buf1)
@@ -87,7 +87,7 @@
           {:title "Quick tutorial"}

           {:subtitle "put and take"
-           :custom (PutAndTakeSlide.)}
+           :custom (PutAndTakeSlide. {:buffer-size 7 :font-size "72pt"})}

           {:title "Buffers"
            :code "(<! (chan))"}


Better date format

Better date format

--- src/yada/file_resource.clj
+++ src/yada/file_resource.clj
@@ -12,7 +12,8 @@
             [yada.representation :refer (full-type)]
             [yada.resource :refer [Resource ResourceConstructor]])
   (:import [java.io File]
-           [java.util Date]))
+           [java.util Date TimeZone]
+           [java.text SimpleDateFormat]))

 (defn legal-name [s]
   (and
@@ -55,7 +56,10 @@
            [:tr
             [:td [:a {:href (if (.isDirectory child) (str (.getName child) "/") (.getName child))} (.getName child)]]
             [:td (if (.isDirectory child) "" (.length child))]
-            [:td (format-date (java.util.Date. (.lastModified child)))]])]]]])))
+            [:td (.format
+                  (doto (SimpleDateFormat. "yyyy-MM-dd HH:mm:ss zzz")
+                    (.setTimeZone (TimeZone/getTimeZone "UTC")))
+                  (java.util.Date. (.lastModified child)))]])]]]])))

 (extend-protocol Resource
   File


Fix indentation.

Fix indentation.

--- src/afterglow/fixtures/blizzard.clj
+++ src/afterglow/fixtures/blizzard.clj
@@ -48,9 +48,9 @@

 ```clojure
 (show/add-function! :torrent-shutter
-                    (afterglow.effects.channel/function-cue
-                    \"Torrent Shutter Open\" :shutter-open 50
-                    (show/fixtures-named \"torrent\")))
+  (afterglow.effects.channel/function-cue
+    \"Torrent Shutter Open\" :shutter-open 50
+    (show/fixtures-named \"torrent\")))
 ```"
   {:doc/format :markdown}
   []


Updated filename to fix test.

Updated filename to fix test.

--- taglines/test/com/lemonodor/commoncrawl_test.clj
+++ taglines/test/com/lemonodor/commoncrawl_test.clj
@@ -10,14 +10,6 @@
             [com.lemonodor.xio :as xio]
             [midje.cascalog :refer :all]
             [midje.sweet :refer :all]))
-
-
-(defn print-methods [item]
-  (pprint/print-table
-   (sort-by
-    :name
-    (filter :exception-types (:members (reflect/reflect item)))))
-  true)

 (deftest path-tests
@@ -71,7 +63,7 @@
   (testing "create arc item"
     (let [item (cc/arc-file-item-from-bytes
                 "WAT"
-                (xio/binary-slurp (io/resource "metafilter.arc")))]
+                (xio/binary-slurp (io/resource "metafilter.farc")))]
       (is (= (cc/item-mime-type item) "text/html"))
       (is (= (subs (cc/item-text item) 0 30) "<!DOCTYPE HTML PUBLIC \"-//W3C/")))))

@@ -141,14 +133,3 @@
       ["<html>\r\n\r\n<head>\r\n<title>"]
       ["<html>\r\n\r\n<head>\r\n<title>"]
       ["<html>\r\n\r\n<head>\r\n<title>"]])))
-
-
-(deftest another-test
-  (fact "aggregator?"
-    (let [tap [["1" "a"]
-               ["1" "b"]
-               ["2" "c"]]]
-      (<- [?url ?word]
-          (tap :> ?url ?word))
-      =>
-      (produces [[]]))))


Drop can-render-single-project-insights test

We could use better testing in frontend, but this isn't actually a
valuable way to achieve it.

--- test-cljs/frontend/components/test_insights.cljs
+++ test-cljs/frontend/components/test_insights.cljs
@@ -81,14 +81,6 @@
                {:target test-node
                 :shared {:timer-atom (timer/initialize)}}))))

-(deftest can-render-single-project-insights
-  (testing "Simple render of single-project insights."
-    (let [test-node (goog.dom/htmlToDocumentFragment "

")]
-      (om/root insights/single-project-insights
-               (insights/decorate-project test-utils/example-user-plans-paid test-project/private-project)
-               {:target test-node
-                :shared {:timer-atom (timer/initialize)}}))))
-
 (deftest median
   (are [m xs] (= m (insights/median xs))
       nil []


Similar bugfixes for jsth

Similar bugfixes for jsth

--- src/aurora/jsth.cljs
+++ src/aurora/jsth.cljs
@@ -10,77 +10,77 @@
   (join "\n" (for [line (split-lines lines)] (str "  " line))))

 (defn js-data->string [x]
-  (check
    (cond
     (nil? x) "null"
     (number? x) (str x)
     (string? x) (pr-str x)
-    (vector? x) (str "[" (join ", " (map js-data->string x)) "]")
-    (map? x) (do (check (empty? x)) ;; TODO emit objects
-               (str "{" "}")))))
+    (vector? x) (check (str "[" (join ", " (map js-data->string x)) "]"))
+    (map? x) (check (empty? x) ;; TODO emit objects
+                    (str "{" "}"))
+    :else (check false)))

 (defn cljs-data->string [x]
-  (check
    (cond
     (nil? x) "null"
     (number? x) (str x)
     (string? x) (pr-str x)
-    (vector? x) (expression->string `(cljs.core.PersistentVector.fromArray ~data))
-    (map? x) (expression->string `(cljs.core.PersistentHashMap.fromArrays ~(vec (keys data)) ~(vec (vals data)))))))
+    (vector? x) (check (expression->string `(cljs.core.PersistentVector.fromArray ~data)))
+    (map? x) (check (expression->string `(cljs.core.PersistentHashMap.fromArrays ~(vec (keys data)) ~(vec (vals data)))))
+    :else (check false)))

 (defn name->string [x]
   (check (symbol? x))
   (str x))

 (defn var->string [x]
-  (check
    (cond
-    (symbol? x) (name->string x)
-    (= "get!" (head x)) (do (check (= (count x) 3))
-                          (str (expression->string (nth x 1)) "[" (expression->string (nth x 2)) "]"))
-    (= ".." (head x)) (do (check (= (count x) 3))
-                        (str (expression->string (nth x 1)) "." (name->string (nth x 2)))))))
+    (symbol? x) (check (name->string x))
+    (= "get!" (head x)) (check (= (count x) 3)
+                               (str (expression->string (nth x 1)) "[" (expression->string (nth x 2)) "]"))
+    (= ".." (head x)) (check (= (count x) 3)
+                             (str (expression->string (nth x 1)) "." (name->string (nth x 2))))
+    :else (check false)))

 (defn expression->string [x]
-  (check
-   (cond
-    (or (symbol? x) (#{"get!" ".."} (head x))) (var->string x)
-    (or (nil? x) (number? x) (string? x) (vector? x) (map? x)) (js-data->string x)
-    (= "edn" (head x)) (do (check (= (count x) 2))
-                         (cljs-data->string (nth x 1)))
-    (= "=" (head x)) (do (check (= (count x) 3))
-                       (str (expression->string (nth x 1)) " == " (expression->string (nth x 2))))
-    (= "==" (head x)) (do (check (= (count x) 3))
-                        (str (expression->string (nth x 1)) " === " (expression->string (nth x 2))))
-    (= "not" (head x)) (do (check (= (count x) 2))
-                         (str "!(" (expression->string (nth x 1)) ")"))
-    (= "fn" (head x)) (do (check (= (count x) 5))
-                        (check (sequential? (nth x 2)))
-                        (str "function " (when (nth x 1) (name->string (nth x 1))) "(" (join ", " (map name->string (nth x 2))) ") {\n"
-                             (indent (statement->string (nth x 3))) "\n"
-                             (indent (str "return " (expression->string (nth x 4)) ";")) "\n"
-                             "}"))
-    (seq? x) (do (check (>= (count x) 1))
-               (str (expression->string (nth x 1)) "(" (join ", " (map expression->string (rest x))) ")")))))
+  (cond
+   (or (symbol? x) (#{"get!" ".."} (head x))) (check (var->string x))
+   (or (nil? x) (number? x) (string? x) (vector? x) (map? x)) (check (js-data->string x))
+   (= "edn" (head x)) (check (= (count x) 2)
+                             (cljs-data->string (nth x 1)))
+   (= "=" (head x)) (check (= (count x) 3)
+                           (str (expression->string (nth x 1)) " == " (expression->string (nth x 2))))
+   (= "==" (head x)) (check (= (count x) 3)
+                            (str (expression->string (nth x 1)) " === " (expression->string (nth x 2))))
+   (= "not" (head x)) (check (= (count x) 2)
+                             (str "!(" (expression->string (nth x 1)) ")"))
+   (= "fn" (head x)) (check (= (count x) 5)
+                            (sequential? (nth x 2))
+                            (str "function " (when (nth x 1) (name->string (nth x 1))) "(" (join ", " (map name->string (nth x 2))) ") {\n"
+                                 (indent (statement->string (nth x 3))) "\n"
+                                 (indent (str "return " (expression->string (nth x 4)) ";")) "\n"
+                                 "}"))
+   (seq? x) (check (>= (count x) 1)
+                   (str (expression->string (nth x 1)) "(" (join ", " (map expression->string (rest x))) ")"))
+   :else (check false)))

 (defn statement->string [x]
-  (check
-   (cond
-    (= "do" (head x)) (join "\n" (map statement->string (rest x)))
-    (= "let!" (head x)) (do (check (= (count x) 3))
-                          (str "var " (name->string (nth x 1)) " = " (expression->string (nth x 2)) ";"))
-    (= "set!" (head x)) (do (check (= (count x) 3))
-                          (str (var->string (nth x 1)) " = " (expression->string (nth x 2)) ";"))
-    (= "throw" (head x)) (do (check (= (count x) 2))
-                           (str "throw " (expression->string (nth x 1)) ";"))
-    (= "try" (head x)) (do (check (#{2 3} (count x)))
-                         (str "try {\n"
-                              (indent (statement->string (nth x 1))) "\n"
-                              "}"
-                              (when (= 3 (count x))
-                                (let [catch (nth x 2)]
-                                  (check (= (count catch) 3))
-                                  (str " catch (" (name->string (nth catch 1)) ") {\n"
-                                       (indent (statement->string (nth catch 2))) "\n"
-                                       "}")))))
-    :else (expression->string x))))
+  (cond
+   (= "do" (head x)) (join "\n" (map statement->string (rest x)))
+   (= "let!" (head x)) (check (= (count x) 3)
+                              (str "var " (name->string (nth x 1)) " = " (expression->string (nth x 2)) ";"))
+   (= "set!" (head x)) (check (= (count x) 3)
+                              (str (var->string (nth x 1)) " = " (expression->string (nth x 2)) ";"))
+   (= "throw" (head x)) (check (= (count x) 2)
+                               (str "throw " (expression->string (nth x 1)) ";"))
+   (= "try" (head x)) (check (#{2 3} (count x))
+                             (str "try {\n"
+                                  (indent (statement->string (nth x 1))) "\n"
+                                  "}"
+                                  (when (= 3 (count x))
+                                    (let [catch (nth x 2)]
+                                      (check (= (count catch) 3)
+                                             (= "catch" (head catch)))
+                                      (str " catch (" (name->string (nth catch 1)) ") {\n"
+                                           (indent (statement->string (nth catch 2))) "\n"
+                                           "}")))))
+   :else (check (expression->string x))))


spacing

spacing

--- src/babel/forest.clj
+++ src/babel/forest.clj
@@ -52,8 +52,8 @@
                   (log/debug (str "generate-all with pred: " (show-spec (remove-false (get-in spec [:synsem :sem :pred])))))
                   (log/debug (str "generate-all(details): " (show-spec spec)))
                   (let [lb (lightning-bolt grammar
-                                      lexicon
-                                      spec 0 index nil morph)]
+                                           lexicon
+                                           spec 0 index nil morph)]
                     (-> lb
                         ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
                         (add-complements-to-bolts [:head :head :head :comp] :top grammar lexicon index morph)


Refactored: edit community chats different screen segments

Signed-off-by: jo-mut <d4a6f406e82d8862547aead32e429239e01a7132@gmail.com>

--- src/status_im/ui/screens/communities/reorder_categories.cljs
+++ src/status_im/ui/screens/communities/reorder_categories.cljs
@@ -70,7 +70,7 @@
      [rn/view {:accessibility-label :category-item
                :style               (merge styles/category-item
                                            {:background-color background-color})}
-      (if-not (categories-tab?)
+      (if (not (categories-tab?))
         [icons/icon :main-icons/channel-category {:color colors/gray}]
         [rn/touchable-opacity
          {:accessibility-label :delete-category-button


Log error if we fail to parse auth header

--- src/clojars/auth.clj
+++ src/clojars/auth.clj
@@ -81,7 +81,9 @@
                        Base64/decodeBase64
                        (String. "UTF-8")
                        (#(re-find #"([^:]*):(.*)" %)))
-                   (catch Exception _))]
+                   (catch Exception e
+                     (log/error {:tag :failed-parsing-authorization-header
+                                 :error e})))]
         {:username username
          :password password}))))


resolved ns-conflict

resolved ns-conflict

--- src/clojerl/node.clj
+++ src/clojerl/node.clj
@@ -1,4 +1,5 @@
 (ns clojerl.node
+  (:refer-clojure :exclude [send])
   (:require [clojerl.types :as erltypes])
   (:import (com.ericsson.otp.erlang OtpNode
                                     OtpMsg)))
@@ -53,3 +54,11 @@

 (defn self [mbox]
   (.self mbox))
+
+(defn ping [mbox target]
+  (.ping mbox target))
+
+(defn send-message [mbox recipient message]
+  (.send mbox recipient
+         (erltypes/tuple [(self mbox)
+                          (erltypes/to-erlang message)])))


Fixed Heritage build.

Fixed Heritage build.

--- access-control-app/src/cmr/access_control/system.clj
+++ access-control-app/src/cmr/access_control/system.clj
@@ -128,6 +128,8 @@
   (let [started-system (start system)]
     (try
       (access-control-index/create-index-or-update-mappings (:search-index started-system))
+      ;; This is needed to bootstrap admin group for legacy services for integration tests
+      (bootstrap/bootstrap started-system)
       (catch Exception e
         (common-sys/stop started-system component-order)
         (throw e)))


add missing \!s

add missing \!s

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

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -239,17 +239,17 @@
 (defn replace-in-file!
   "Replace a re-pattern in a file with a new value."
   [file pat new-val]
-  (edit-file file #(clojure.string/replace % pat new-val)))
+  (edit-file! file #(clojure.string/replace % pat new-val)))

 (defn replace-in-files!
   "Replace a re-pattern in a list of files with a new value."
   [files pat new-val]
-  (dorun (map #(replace-in-file % pat new-val) files)))
+  (dorun (map #(replace-in-file! % pat new-val) files)))

 (defn fix-output-file-tags!
   "Fix the dll output path specified in all vcproj files."
   []
-  (replace-in-files (device-vcproj-files)
+  (replace-in-files! (device-vcproj-files)
                     #"\$\(OutDir\)/.+?\.dll" "\\$(OutDir)/mmgr_dal_\\$(ProjectName).dll"))

 (defn find-copy-step [vcproj]


Fix an NPE

Fix an NPE

--- scheduler/test/clj_http_async_pool/test_utils.clj
+++ scheduler/test/clj_http_async_pool/test_utils.clj
@@ -32,8 +32,8 @@

 (defn multiply-duration
   [base]
-  (* base (or (Long. (System/getenv "CLJ_HTTP_ASYNC_POOL_TEST_DURATION_MULTIPLIER"))
-              1)))
+  (* base (Long. (or (System/getenv "CLJ_HTTP_ASYNC_POOL_TEST_DURATION_MULTIPLIER")
+                     1))))

 (defmacro timed
   [& body]


map-imgs for arbitrary arity fix

map-imgs for arbitrary arity fix

--- src/funimage/img.clj
+++ src/funimage/img.clj
@@ -60,7 +60,7 @@
            t (Thread.
                (fn []
                  (loop []
-                   (when (every? (map #(.hasNext ^Cursor %) curs))
+                   (when (every? #(.hasNext ^Cursor %) curs)
                      (doseq [cur curs] (.fwd ^Cursor cur))
                      (apply f curs)
                      (recur)))))]


Read the app to use for an interface correctly

It was hardcoded before

--- idecode/myappshare/mainapp.cljs
+++ idecode/myappshare/mainapp.cljs
@@ -190,8 +190,7 @@
 ;                      (span {:onClick #(go  (write-ui app [:mode] "editdata"))} "Data")
                       (if (get @can-use-interfaces "edit.my.database")
                         (span {:onClick #(go  (write-ui app [:mode] "view")
-                                              ;(write-ui app [:submode] "editappname")
-                                              (write-ui app [:app-id] 81)
+                                              (write-ui app [:app-id] (get @can-use-interfaces "edit.my.database"))
                                               (evalapp (get @can-use-interfaces "edit.my.database"))
                                               )} "Data"))


add more indices

add more indices

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -25,9 +25,14 @@
    [dag_unify.core :refer (fail? get-in remove-matching-keys unifyc)]))

 (def index-lexicon-on-paths
-  [[:synsem :cat]
+  [[:synsem :agr :gender]
+   [:synsem :agr :number]
+   [:synsem :agr :person]
    [:synsem :aux]
-   [:synsem :sem :pred]])
+   [:synsem :cat]
+   [:synsem :pronoun]
+   [:synsem :sem :pred]
+   [:synsem :sem :human]])

 (declare cache)


first arg of be-called should be nominative

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -139,6 +139,7 @@
                                     :subj the-real-subj
                                     :obj the-obj}
                               :subcat {:1 {:cat :noun
+                                           :case :nom
                                            :agr subj-agr
                                            :sem {:pred :name
                                                  :subj the-real-subj}


convert book to non-unify form

convert book to non-unify form

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -313,16 +313,14 @@
    "boil" {:synsem {:cat :verb
                 :sem {:pred :boil}}}
    "book"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          {:synsem {:sem {:artifact true
-                          :pred :libro
-                          :legible true
-                          :speakable false
-                          :mass false
-                          :place false
-                          :consumable false}}})
+   {:synsem {:cat :noun
+             :sem {:artifact true
+                   :pred :libro
+                   :legible true
+                   :speakable false
+                   :mass false
+                   :place false
+                   :consumable false}}}

    "break" {:synsem {:cat :verb
                      :sem {:pred :break }}


fix typo

fix typo

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -303,7 +303,7 @@
         [(unify shared-part-of-faire
              {:synsem {:sem {:pred :do}}})
          (unify shared-part-of-faire
-                {:synsem {:pred :make}})])
+                {:synsem {:sem {:pred :make}}})])

    "former" {:synsem {:cat :verb
                      :sem {:pred :form}}}


more logging about compiled bolt-finding

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -134,20 +134,31 @@
 (defn get-bolts-for
   "Return every possible bolt for the given model and spec."
   [model spec depth]
-  (let [bolts ;; check for bolts compiled into model
+  (let [search-for-key
+        (dag_unify.core/strip-refs
+         {:synsem {:sem {:aspect (get-in spec [:synsem :sem :aspect] :top)
+                         :reflexive (get-in spec [:synsem :sem :reflexive] :top)
+                         :tense (get-in spec [:synsem :sem :tense] :top)}
+                   :subcat (get-in spec [:synsem :subcat] :top)
+                   :cat (get-in spec [:synsem :cat] :top)}
+          :depth depth})
+
+        debug (log/debug (str "looking for key: "
+                             search-for-key))
+
+        bolts ;; check for bolts compiled into model
         (get (-> model :bolts)
-             {:synsem {:sem {:aspect (get-in spec [:synsem :sem :aspect])
-                             :reflexive (get-in spec [:synsem :sem :reflexive])
-                             :tense (get-in spec [:synsem :sem :tense])}
-                       :subcat (get-in spec [:synsem :subcat])
-                       :cat (get-in spec [:synsem :cat])}
-              :depth depth})]
+             search-for-key)]
     (cond
       (not (nil? bolts))
-      (shufflefn (->> bolts
-                      (map #(unify spec %))
-                      (filter #(not (= :fail %)))))
-      true (lightning-bolts model spec 0 depth))))
+      (do
+        (log/info (str "found compiled bolts."))
+        (shufflefn (->> bolts
+                        (map #(unify spec %))
+                        (filter #(not (= :fail %))))))
+      true
+      (do (log/debug (str "no compiled bolts found."))
+          (lazy-seq (lightning-bolts model spec 0 depth))))))

 (defn lightning-bolts
   "Return every possible bolt for the given model and spec. Start at the given depth and


+(do-defaults)

+(do-defaults)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -150,7 +150,7 @@
                           (let [comp-paths (keys comps-map)
                                 comp-bolts (mapfn #(get comps-map %)
                                                   comp-paths)]
-                            (mapfn #(assoc-in bolt path %)
+                            (mapfn #(do-defaults (assoc-in bolt path %) model)
                                    (add-comps bolt-at
                                               model
                                               comp-paths


Pruned group-saving code

Pruned group-saving code

https://app.asana.com/0/50978096561390/59155341320044

--- src/app/booklet/core.cljs
+++ src/app/booklet/core.cljs
@@ -105,57 +105,6 @@
     {:app-state {:tabs tabs}
      :ui-state  {:section :time-track}}))

-(register-handler
-  :group-add
-  (fn [app-state [_]]
-    (let [tabs    (get-in app-state [:app-state :tabs])
-          to-save (map (fn [m] (select-keys m relevant-tab-items)) tabs)
-          groups  (conj (or (get-in app-state [:data :groups]) '())
-                        (group-from-tabs to-save))]
-      (dispatch [:data-set :groups groups])
-      app-state)))
-
-(register-handler
-  :group-delete-set
-  (fn [app-state [_ group]]
-    (dispatch [:modal-info-set {:header       "Please confirm"
-                                :body         (str "Do you want to delete tab group " (group-label group) "?")
-                                :action-label "Kill it"
-                                :action       #(do
-                                                (dispatch [:modal-info-set nil])
-                                                (dispatch [:group-delete group]))}])
-    app-state))
-
-(register-handler
-  :group-delete
-  (fn [app-state [_ group]]
-    (let [original (get-in app-state [:data :groups])
-          groups   (remove #(= group %) original)]
-      (dispatch [:data-set :groups groups])
-      app-state)))
-
-
-(register-handler
-  :group-edit-set
-  (fn [app-state [_ group]]
-    (dispatch [:group-label-set (group-label group)])
-    (assoc-in app-state [:ui-state :group-edit] group)))
-
-
-(register-handler
-  :group-label-set
-  (fn [app-state [_ label]]
-    (assoc-in app-state [:ui-state :group-label] label)))
-
-(register-handler
-  :group-update
-  (fn [app-state [_ old-group new-group]]
-    (dispatch [:data-set :groups (->> (get-in app-state [:data :groups])
-                                      (remove #(= % old-group))
-                                      (cons new-group))])
-    app-state))
-
-

 (register-handler
   :log-content
@@ -238,8 +187,7 @@
 (defn navbar-item [label section current]
   [:li {:class (when (= section current) "active")}
    [:a {:on-click #(dispatch [:app-state-item [:ui-state :section] section])} label
-    (when (= section current) [:span {:class "sr-only"} "(current)"])]]
-  )
+    (when (= section current) [:span {:class "sr-only"} "(current)"])]])

 (defn navbar []
   (let [section (subscribe [:ui-state :section])]
@@ -257,7 +205,6 @@
          [:ul {:class "nav navbar-nav"}
           [navbar-item "Times" :time-track @section]
           [navbar-item "Monitor" :monitor @section]
-          [navbar-item "Groups" :groups @section]
           ]
          [:form {:class "navbar-form navbar-left", :role "search"}
           [:div {:class "form-group"}
@@ -326,59 +273,15 @@
         [:tbody
          (list-tabs @tabs :id)]
         ]
-       [:a {:class    "btn btn-primary btn-sm"
+
+       #_ [:a {:class    "btn btn-primary btn-sm"
             :on-click #(dispatch [:group-add])} "Save me"]
-       [:a {:class    "btn btn-primary btn-sm"
+       #_ [:a {:class    "btn btn-primary btn-sm"
             :on-click #(go (console/log (<! (storage/get))))} "Get"]
-       [:a {:class    "btn btn-primary btn-sm"
+       #_ [:a {:class    "btn btn-primary btn-sm"
             :on-click #(go (console/log "Usage: " (<! (storage/bytes-in-use))))} "Usage"]
        ; [:button {:on-click #(storage/clear)} "Clear"]
        ])))
-
-(defn list-groups
-  [group-list editable? group-edit edit-label]
-  (for [group group-list]
-    ^{:key (:date group)}
-    [:div
-     [:div
-      (if (= group group-edit)
-        [initial-focus-wrapper
-         [:input {:type      "text"
-                  :class     "form-control"
-                  :value     edit-label
-                  :on-change #(dispatch-sync [:group-label-set (-> % .-target .-value)])
-                  :on-blur   #(do
-                               (dispatch [:group-update group (assoc group :name edit-label)])
-                               (dispatch [:group-edit-set nil]))
-                  }]]
-        [:h3 {:on-click #(dispatch [:group-edit-set group])} (group-label group)]
-        )
-      (if editable? [:small [:a {:on-click #(dispatch [:group-delete-set group])} "Delete"]])
-      ]
-
-     [:table {:class "table table-striped table-hover"}
-      [:thead
-       [:tr
-        [:th "#"]
-        [:th "Title"]
-        [:th "URL"]]]
-      [:tbody
-       (list-tabs (filter-tabs (:tabs group)) nil)]
-      ]])
-  )
-
-(defn div-tab-groups []
-  (let [tab-groups (subscribe [:data :groups])
-        group-edit (subscribe [:ui-state :group-edit])
-        label      (subscribe [:ui-state :group-label])
-        to-list    (reaction (sort-by #(* -1 (:date %)) @tab-groups))]
-    (fn []
-      [:div
-       [modal-confirm]
-       [:div {:class "page-header"} [:h2 "Previous groups"]]
-       (list-groups @to-list true @group-edit @label)
-       ])
-    ))

 (defn div-timetrack []
   (let [url-times  (subscribe [:data :url-times])
@@ -433,7 +336,6 @@

 (def component-dir {:monitor    current-tabs
-                    :groups     div-tab-groups
                     :export     data-export
                     :import     data-import
                     :time-track div-timetrack})


Formatting

Formatting

--- src/braid/server/db.clj
+++ src/braid/server/db.clj
@@ -7,13 +7,13 @@
     [mount.core :refer [defstate]]))

 (defn install-schema! [db-url]
- (d/transact (d/connect db-url)
-                 (concat
-                   ; partition for our data
-                   [{:db/ident :entities
-                     :db/id #db/id [:db.part/db]
-                     :db.install/_partition :db.part/db}]
-                   schema)))
+  (d/transact (d/connect db-url)
+              (concat
+                ;; partition for our data
+                [{:db/ident :entities
+                  :db/id #db/id [:db.part/db]
+                  :db.install/_partition :db.part/db}]
+                schema)))

 (defn init!
   "set up schema"


Actually explain why this sometimes isn't a map

--- src/caesium/binding.clj
+++ src/caesium/binding.clj
@@ -20,8 +20,9 @@
   the data in metadata-annotated form anyway (both to create the
   interface and to bind fns to vars).

-  This has to be a vec and not a map, because the same key (symbol, method
-  name) might occur with multiple values ()"
+  This has to be a vec and not a map, because the same key (symbol,
+  method name) might occur with multiple values (e.g. when binding the
+  same char* fn with different JVM byte types)."
   '[[^int sodium_init []]
     [^String sodium_version_string []]


Helper var net-state.

Helper var net-state.

--- src/cbfg/world-net.cljs
+++ src/cbfg/world-net.cljs
@@ -78,8 +78,11 @@
                                                vis-chs world-vis-init el-prefix))))))))
               el-prefix
               (fn [vis]
-                (set-el-innerHTML "net"
-                                  (first (filter (fn [[actx actx-info]] (= (last actx) "net-1")) (:actx vis)))))
+                (let [net-state (:loop-state (second (first (filter (fn [[actx actx-info]]
+                                                                      (= (last actx) "net-1"))
+                                                                    (:actxs vis)))))]
+                  (set-el-innerHTML "net"
+                                    (str "hi" net-state))))
               init-event-delay)
     cmd-inject-ch))


cleaning

cleaning

--- src/celestial/redis.clj
+++ src/celestial/redis.clj
@@ -46,28 +46,6 @@
   (when-let [lkeys (seq (wcar (car/keys (lkey "*"))))]
     (wcar (apply car/del lkeys))))

-(defn atom-key [k] (str "atom" k))
-
-(defn apply-diff [map-key _new old]
-  {:pre [(map? _new) (map? old)]}
-    (letfn [(sub [a b] (difference (into #{} a) (into #{} b)))]
-      (doseq [[k v] (sub old _new)] (wcar (car/hdel map-key k)))
-      (doseq [[k v] (sub _new old)]  (wcar (car/hset map-key k (car/preserve v))))
-      ))
-
-(defn sync-watch [map-key r]
-  (add-watch r map-key
-     (fn [_key _ref old _new]
-       (with-lock (server-conn) _key half-hour minute
-         (apply-diff map-key _new old)) r)))
-
-(defn synched-map [k]
-  "Lock backed atom map watcher that persists changes into redis takes the backing redis hash key."
-  (sync-watch (atom-key k)
-    (if-let [data (wcar (car/hgetall* (atom-key k) true) )]
-       (atom data)
-       (atom {}))))
-
 (defn create-worker [name f]
   (carmine-mq/worker (server-conn) name {:handler f :eoq-backoff-ms 200}))


break out decimal coercion

break out decimal coercion

--- src/clj/clj_money/coercion.clj
+++ src/clj/clj_money/coercion.clj
@@ -53,14 +53,25 @@
             %))
        value))

+(defn- parse-decimal
+  [v]
+  (try
+    (bigdec v)
+    (catch NumberFormatException e
+      nil)))
+
+(defn- coerce-decimal
+  [v]
+  (let [result (if (decimal? v)
+                 v
+                 (or (parse-decimal v) v))]
+    result))
+
 (register-coerce-fn :integer    #(if (integer? %)
                                    %
                                    (when (re-matches #"\A\d+\z" %)
                                      (Integer. %))))
-(register-coerce-fn :decimal    #(if (decimal? %) % (try
-                                                      (bigdec %)
-                                                      (catch NumberFormatException e
-                                                        %))))
+(register-coerce-fn :decimal coerce-decimal)
 (register-coerce-fn :keyword    #(if (keyword? %) % (keyword %)))
 (register-coerce-fn :local-date #(if (string? %) (or (parse-local-date %) %) %))
 (register-coerce-fn :integer-collection parse-integer-collection)
@@ -73,6 +84,7 @@
   (when-not (sequential? coercions)
     (throw (ex-info "The coercions must be a sequence" {:coercisons coercions})))
   (reduce (fn [result {:keys [path coerce-fn]}]
+            ; TODO write update-in-if so that nil values are not added
             (if (nil? (get-in result path))
               result
               (update-in result path coerce-fn)))


Coffee and cigarettes, man

Coffee and cigarettes, man

THAT's a combination!

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -49,6 +49,7 @@
    (coffee-train ":badger:" ":mushroom:")
    (coffee-train ":coffeepot:" ":heart:")
    (coffee-train ":simply_overcaffeinated:" ":coffeespin:")
+   (coffee-train ":smoking:")
    (train ":coffeealarm:" ":coffeealarm:")
    (train ":nespresso:" ":ali:")
    (train ":ali:" ":gruff:")


Use thread pool for httpkit clients and callback handlers

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -2,7 +2,10 @@
   (:require [org.httpkit.client :as http]
             [clj-time.core :as time]
             [clj-time.local :as local-time]
-            [clojure.core.async :as async :refer [go go-loop put! <!! alts! <! >!]]))
+            [clojure.core.async :as async :refer [go go-loop put! <!! alts! <! >!]])
+  (:import  [org.httpkit PrefixThreadFactory]
+            [org.httpkit.client HttpClient]
+            [java.util.concurrent ThreadPoolExecutor LinkedBlockingQueue TimeUnit]))

 (defprotocol RunnerProtocol
   (continue-run? [runner current-time i])
@@ -20,9 +23,23 @@

 (defn- now [] (System/currentTimeMillis))

+
+(defonce pool-size (* 2 (.availableProcessors (Runtime/getRuntime))))
+
+(defonce httpkit-pool (repeatedly pool-size #(HttpClient.)))
+
+(defn- get-httpkit-client [^long idx]
+  (nth httpkit-pool (mod idx pool-size)))
+
+(defonce httpkit-callback-pool (let [pool-size (.availableProcessors (Runtime/getRuntime))
+                                     queue (LinkedBlockingQueue.)
+                                     factory (PrefixThreadFactory. "httpkit-callback-worker-")]
+                                     (ThreadPoolExecutor. pool-size pool-size 60 TimeUnit/SECONDS queue factory)))
+
 (defn- async-http-request [url user-id context callback]
-  (let [check-status (fn [{:keys [status]}] (callback (= 200 status)))]
-    (http/get url {} check-status)))
+  (let [check-status (fn [{:keys [^long status]}]
+                        (callback (= 200 status)))]
+    (http/get url {:worker-pool httpkit-callback-pool :client (get-httpkit-client user-id)} check-status)))

 (defn- request-fn [request]
   (if-let [url (:http request)]


Make toggle all works

Make toggle all works

--- src/cljs/clojure_rest/api.cljs
+++ src/cljs/clojure_rest/api.cljs
@@ -32,10 +32,3 @@
   [card task-index]
   (update-in card [:tasks] utils/remove-idx task-index))

-(defn toggle-all-cards
-  [cards]
-  (let [all-toggled (every? ::show-details cards)
-        toggle-card #(assoc % ::show-details (not all-toggled))]
-    (mapv toggle-card cards)
-  ))
-


Add replace-movement swap

Add replace-movement swap

--- src/cljs/movement/session.cljs
+++ src/cljs/movement/session.cljs
@@ -10,25 +10,22 @@
     [movement.util :refer [vec-remove handler-fn positions]]
     [movement.text :refer [text-edit-component text-input-component auto-complete-did-mount]]))

-#_(defn replace-movement [event {:keys [kw movement part-number]}]
-    (.preventDefault event)
+(defn replace-movement [e {:keys [kw movement part-number]}]
+    (.preventDefault e)
     (cond
-      (= :swap kw) (let [slot-category (:slot-category movement)
-                         category (if slot-category
-                                    (name (first (shuffle slot-category)))
-                                    (name (first (shuffle (:category movement)))))]
-                     (GET "movement-from-category" {:params        {:user-id  (:user-id (session/get :user))
-                                                                    :category category}
-                                                    :handler       (fn [new-movement]
-                                                                     (let [old-movement (dissoc movement :next :previous) ; remove data that may not be overwritten by merging with the new movement
-                                                                           part (session/get-in [:movement-session :parts part-number])
-                                                                           pos (first (positions #{movement} part))
-                                                                           new-part (assoc part pos (merge old-movement (first new-movement)))]
-                                                                       (session/assoc-in! [:movement-session :parts part-number] new-part)))
-                                                    :error-handler (fn [r] nil)}))
+      (= :swap kw) (let [ slot-category (:slot-category movement)
+                          category (if slot-category ; movement has slot-category if it has been created from a template
+                                      (first (shuffle slot-category))
+                                      (first (shuffle (:category movement))))
+                          old-movement (dissoc movement :next :previous) ; remove data that may not be overwritten by merging with the new movement
+                          part (session/get-in [:movement-session :parts part-number])
+                          pos (first (positions #{movement} part))
+                          new-movement (-> (filter #(contains? (:category %) category) data/all-movements) shuffle first)
+                          new-part (assoc part pos (merge old-movement new-movement))]
+                      (session/assoc-in! [:movement-session :parts part-number] new-part))
       (or (= :next kw)
           (= :previous kw)) (let [new-movement (first (shuffle (kw movement)))]
-                              (GET "movement" {:params        {:user-id (:user-id (session/get :user))
+                              #_(GET "movement" {:params        {:user-id (:user-id (session/get :user))
                                                                :name    new-movement}
                                                :handler       (fn [new-movement]
                                                                 (let [old-movement (dissoc movement :next :previous) ; remove data that may not be overwritten by merging with the new movement
@@ -217,11 +214,11 @@
                                     :title   "Fjern øvelse"}
              [:i.fa.fa-remove {:style {:color "#CC9999" :opacity 0.8}}]
              "Fjern øvelse"]
-            [:a.pure-u.pure-button {:style      {:margin "5px 5px 5px 5px"} :title "Bytt øvelse"
-                                    :onClick    #(;replace-movement % {:kw :swap :movement m :part-number part-number}
-                                                  )
-                                    :onTouchEnd #(;replace-movement % {:kw :swap :movement m :part-number part-number}
-                                                  )} [:i.fa.fa-random {:style {:color "#99cc99" :opacity 0.8}}] "Bytt ut øvelse"]
+            [:a.pure-u.pure-button {
+                :style      {:margin "5px 5px 5px 5px"} :title "Bytt øvelse"
+                :onClick    #(replace-movement % {:kw :swap :movement m :part-number part-number})
+              }
+              [:i.fa.fa-random {:style {:color "#99cc99" :opacity 0.8}}] "Bytt ut øvelse"]
             (when previous
               [:a.pure-u.pure-button {:style {:margin "5px 5px 5px 5px"}
                                       :onClick #(;replace-movement % {:kw :previous :movement m :part-number part-number}


make app close button confirm exit like Ctrl+Q

--- src/clojure/nightcode/core.clj
+++ src/clojure/nightcode/core.clj
@@ -108,6 +108,12 @@
                           :divider-location 0.8
                           :resize-weight 0.5))))

+(defn confirm-exit-app
+  []
+  (if (dialogs/show-shut-down-dialog)
+    (System/exit 0)
+    true))
+
 (defn -main
   "Launches the main window."
   [& args]
@@ -124,7 +130,7 @@
                      :content (get-window-content)
                      :width 1152
                      :height 768
-                     :on-close :exit)
+                     :on-close :nothing)
         ; create the shortcut hints for the main buttons
         shortcuts/create-hints
         ; listen for keys while modifier is down
@@ -142,16 +148,16 @@
               ; down
               40 (p/move-project-tree-selection 1)
               ; Q
-              81 (if (dialogs/show-shut-down-dialog)
-                   (System/exit 0)
-                   true)
+              81 (confirm-exit-app)
               ; W
               87 (editors/close-selected-editor)
               false)))
         ; update the project tree when window comes into focus
         (.addWindowListener (proxy [WindowAdapter] []
                               (windowActivated [e]
-                                (ui/update-project-tree))))
+                                (ui/update-project-tree))
+                              (windowClosing [e]
+                                (confirm-exit-app))))
         ; show the frame
         s/show!))
     ; initialize the project pane


Fix swagger after rename

Fix swagger after rename

--- src/yada/swagger.clj
+++ src/yada/swagger.clj
@@ -32,11 +32,11 @@
 (defn- to-path [route]
   (infof "to-path arg is %s" (pr-str route))
   (let [path (-> route :path)
-        endpoint (-> route :handler :delegate)
-        {:keys [resource options methods parameters representations]} endpoint
+        http-resource (-> route :handler :delegate)
+        {:keys [resource options methods parameters representations]} http-resource
         swagger (:swagger options)]
     (infof "path is %s" (apply str (map encode path)))
-    (infof "endpoint is %s" endpoint)
+    (infof "http-resource is %s" http-resource)

     (infof "resource is %s" resource)
     (infof "options is %s" options)