Entity listeners

Entity listeners

--- src/re_db/core.cljs
+++ src/re_db/core.cljs
@@ -49,18 +49,20 @@
 (defn unique? [db-snap a]
   (boolean (get-in* db-snap [:schema a :db/unique])))

-(defn has? [db-snap e]
-  (contains? (:data db-snap) (resolve-id db-snap e)))
-
-(defn create-id! [db]
-  (:entity-count (swap! db update* :entity-count
-                        (fn [c] (first (filter #(not (has? @db %))
-                                               (iterate inc (inc c))))))))
+(defn identity? [db-snap a]
+  (= :db.unique/identity (get-in* db-snap [:schema a :db/unique])))

 (defn resolve-id
   [db-snap id]
   (when id
     (cond (number? id) id
+          ;; experimental: :db.identity/string can be set in schema to be a
+          ;;               :db.unique/identity attribute which will be assumed
+          ;;               if a raw string is passed as an entity id.
+          ;;               example:
+          ;;                with schema - {:db.identity/string :id}
+          ;;                (d/entity "my-id") resolves as (d/entity "my-id")
+          (string? id) (resolve-id db-snap [(get-in* db-snap [:schema :db.identity/string]) id])
           (sequential? id) (let [[a v] id]
                              (if-not (unique? db-snap a)
                                (throw (js/Error (str "Not a unique attribute: " a)))
@@ -68,14 +70,40 @@
           :else (do
                   (throw (js/Error (str "Not a valid id: " id)))))))

+(defn has? [db-snap e]
+  (contains? (:data db-snap) (resolve-id db-snap e)))
+
+(defn create-id! [db]
+  (:entity-count (swap! db update* :entity-count
+                        (fn [c] (first (filter #(not (has? @db %))
+                                               (iterate inc (inc c))))))))
+
+
+(defn- listen-path!
+  [db path f]
+  (doto db
+    (swap! update-in path #((fnil conj #{}) % f))))
+
 (defn listen!
-  [db key f]
-  (swap! db assoc-in [:listeners :tx-log key] f) db)
+  ([db f]
+   (listen-path! db [:listeners :tx-log] f))
+  ([db id f]
+   (listen-path! db [:listeners :entity id] f))
+  ([db id attr f]
+   (listen-path! db [:listeners :entity-attr id attr] f)))
+
+(defn- unlisten-path!
+  [db path f]
+  (doto db
+    (swap! update-in path #(disj % f))))

 (defn unlisten!
-  [db key]
-  (swap! db update-in [:listeners :tx-log] dissoc key)
-  db)
+  ([db f]
+   (unlisten-path! db [:listeners :tx-log] f))
+  ([db id f]
+   (unlisten-path! db [:listeners :entity id] f))
+  ([db id attr f]
+   (unlisten-path! db [:listeners :entity-attr id attr] f)))

 (defn upsert-attr? [id]
   (and (number? id) (neg? id)))
@@ -84,10 +112,10 @@
   (when-let [id (resolve-id db-snap id)]
     (get-in* db-snap [:data id])))

-(defn get [db-snap id attr]
-  (get* (entity db-snap id) attr))
-
-(defn get-in [db-snap id & ks]
+(defn get [db-snap id & args]
+  (apply get* (cons (entity db-snap id) args)))
+
+(defn get-in [db-snap id ks]
   (get-in* (entity db-snap id) ks))

 (defn add-index [[db-snap reports] id a v]
@@ -190,7 +218,7 @@
                    (add-index id attr val)
                    (remove-index id attr prev-val)))))))

-(defn update [[db-snap reports] id attr f & args]
+(defn update-attr [[db-snap reports] id attr f & args]
   {:pre [(not (many? db-snap attr))]}
   (assert (not (many? db-snap attr)) "Cannot update a :many attribute")
   (let [new-val (apply f (cons (get db-snap id attr) args))]
@@ -200,14 +228,14 @@
   {:db/retract-entity retract-entity
    :db/retract-attr   retract-attr
    :db/add            add
-   :db/update         update})
+   :db/update-attr    update-attr})

 (defn find-id-by-unique-attr [db-snap tx]
   (when (map? tx)
-        (when-let [a (->> (keys tx)
-                          (filter (partial unique? db-snap))
-                          first)]
-          (resolve-id db-snap [a (get* tx a)]))))
+    (when-let [a (->> (keys tx)
+                      (filter (partial identity? db-snap))
+                      first)]
+      (resolve-id db-snap [a (get* tx a)]))))

 (defn get-id [tx]
   (cond (map? tx) (:db/id tx)
@@ -247,7 +275,17 @@
       out)))

 (defn notify-listeners [db-snap reports]
-  (doseq [listener (vals (get-in* db-snap [:listeners :tx-log]))]
+  (when (seq (get-in* db-snap [:listeners :entity]))
+    (doseq [eid (set (map first reports))]
+      (doseq [f (get-in* db-snap [:listeners :entity (get db-snap eid :id)])]
+        (f (entity db-snap eid)))))
+
+  (when (seq (get-in* db-snap [:listeners :entity-attr]))
+    (doseq [[eid attr] (set (map #(do [(first %) (second %)]) reports))]
+      (doseq [f (get-in* db-snap [:listeners :entity-attr (get db-snap eid :id) attr])]
+        (f (get db-snap eid attr)))))
+
+  (doseq [listener (get-in* db-snap [:listeners :tx-log])]
     (listener (remove nil? reports))))

 (defn transact! [db txs]
@@ -280,8 +318,8 @@
    (transact! db [{:db/id id
                    attr   val}])))

-(defn update! [db id & args]
-  (transact! db [(into [:db/update id] args)]))
+(defn update-attr! [db id attr & args]
+  (transact! db [(into [:db/update-attr id attr] args)]))

 (defn retract!
   ([db id]
@@ -312,7 +350,6 @@

 (defn entities
   [db-snap & qs]
-  (prn (apply entity-ids (cons db-snap qs)))
   (map (partial entity db-snap) (apply entity-ids (cons db-snap qs))))

 (defn squuid []


Display messages if player tries to go to room they are already in or that does not exist.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -5,7 +5,8 @@
   (:require [isla.interpreter :as interpreter])
   (:require [isla.story-utils :as story-utils])
   (:require [mrc.utils :as utils])
-  (:require [isla.library :as library]))
+  (:require [isla.library :as library])
+  (:require [isla.talk :as t]))

 (declare types name-into-objs extract-by-class get-story-ctx tuples-to-hash resolve-
          extract-arguments creturn)
@@ -57,6 +58,10 @@
              (assoc this :player (assoc player :room (get rooms name)))
             (creturn this (str "You cannot go into the " name ".")))))))
              (t/room-intro room))
+            (if (= name (:name (:room player)))
+              (creturn this (t/room-already name))
+              (creturn this (t/room-not-allowed name))))))))
+
   (look [this arguments-str]
     (let [arguments (extract-arguments arguments-str)]
       (if (empty? arguments)


Print useful autotest message when loaded file has a bad `ns` header.

--- src/midje/repl.clj
+++ src/midje/repl.clj
@@ -384,10 +384,15 @@
   *me nil)

 (defn- on-require-failure [the-ns throwable]
-  (println (color/fail "LOAD FAILURE for " (ns-name the-ns)))
+  (println (color/fail "LOAD FAILURE for " the-ns))
   (println (.getMessage throwable))
   (emit/fail-silently) ; to make sure last line shows a failure.
   (when (config/running-in-repl?)
+    (when (re-find #"ould not locate.*classpath" (.getMessage throwable))
+      (println "+ This error indicates that the first argument to `ns` doesn't match the file path.")
+      (println "+ That breaks autotest's file tracking (even for files without errors).")
+      (println "+ After you fix the problem, rerun `autotest`.")
+      (println))
     (println "The exception has been stored in #'*me, so `(pst *me)` will show the stack trace.")
     (alter-var-root #'*me (constantly throwable))))


Updated load-facts doc string.

Updated load-facts doc string.

--- src/midje/repl.clj
+++ src/midje/repl.clj
@@ -71,13 +71,16 @@
   "Load given namespaces, as in:
      (load-facts 'midje.t-sweet 'midje.t-repl)

-   If no namespaces are given, all the namespaces in the project.clj's
+   A partial namespace ending in a `*` will load all sub-namespaces.
+   Example: (load-facts 'midje.ideas.*)
+
+   If the :all argument is given, all the namespaces in the project.clj's
    :test-paths and :source-paths will be loaded.
    But if there's no project.clj, all namespaces under \"test\"
    will be loaded.

-   A partial namespace ending in a `*` will load all sub-namespaces.
-   Example: (load-facts 'midje.ideas.*)
+   If no namespace arguments are given, the working set is reloaded.
+   (See `(doc midje-repl-working-set)`.)

    By default, all facts are loaded from the namespaces. You can, however,
    add further arguments. Only facts matching one or more of the arguments


Refacto - Deal with the prev block to display or not depending on the current ns.

--- src/app/cljs/one/sample/view.cljs
+++ src/app/cljs/one/sample/view.cljs
@@ -152,23 +152,27 @@
   ;; hide the spinner
   (set-styles! (by-id "spinner") {:display "none"}))

+(defn- previous-ns-block "Display or not the prev block depending on the current namespace."
+  [all-ns ns-nav]
+  ;; Deal with ..
+  (let [prev (by-id "prev")]
+    (if ns-nav
+      (do
+        (set-styles! prev {:display "block"})
+        (event/listen prev "click"
+                      #(dispatch/fire :ns-clicked {:ns (parent-ns all-ns ns-nav)})))
+      (set-styles! prev {:display "none"}))))
+
 (defmethod render-fnx :ns-navigating [{:keys [all-ns ns-nav]}]
   (let [lns-fns (ls-curr-ns all-ns ns-nav)
         lns (first lns-fns)
         fns (second lns-fns)
         nsn (by-id "ns-nav")
-        fnd (by-id "fn-display")
-        prev (by-id "prev")]
+        fnd (by-id "fn-display")]

     (hide-spinner)

-    ;; Deal with ..
-    (if ns-nav
-      (do
-        (set-styles! prev {:display "block"})
-        (event/listen prev "click"
-                      #(dispatch/fire :ns-clicked {:ns (parent-ns all-ns ns-nav)})))
-      (set-styles! prev {:display "none"}))
+    (previous-ns-block all-ns ns-nav)

     (when lns
       ;; show the namespace block


only send enable command if continuous focus is not enabled

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -306,7 +306,8 @@
   (core setAutoShutter (@state :init-auto-shutter))
   (core setExposure (@state :init-exposure))
   (core setPosition (core getFocusDevice) (@state :init-z-position))
-  (when (@state :init-continuous-focus)
+  (when (and (@state :init-continuous-focus)
+             (not (core isContinuousFocusEnabled))
     (core enableContinuousFocus true))
   (return-config))


attempt snapping a second time as well

attempt snapping a second time as well

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -194,6 +194,23 @@

 ;; acq-engine

+(defmacro successful? [& body]
+  `(try (do ~@body true)
+     (catch Exception e#
+            (do (ReportingUtils/logError e#) false))))
+
+(defmacro device-best-effort [dev & body]
+  `(let [attempt# #(do (wait-for-device ~dev) ~@body)]
+    (when-not
+      (or
+        (successful? (attempt#)) ; first attempt
+        (do (log "second attempt") (successful? (attempt#)))
+        (do (log "reload and try a third time")
+            (successful? (reload-device ~dev) (attempt#)))) ; third attempt after reloading
+      (throw (Exception. (str "Device failure: " ~dev)))
+      (swap! state assoc :stop true)
+      nil)))
+
 (defn get-z-stage-position [stage]
   (if-not (empty? stage) (core getPosition stage) 0))

@@ -261,22 +278,6 @@
     (when-let [exposure (:exposure event)]
       (list [(core getCameraDevice) #(core setExposure exposure)]))))

-(defmacro successful? [& body]
-  `(try (do ~@body true)
-     (catch Exception e#
-            (do (ReportingUtils/logError e#) false))))
-
-
-(defn device-best-effort [dev fun]
-  (let [attempt #(do (wait-for-device dev) (fun))]
-    (when-not
-      (or
-        (successful? (attempt)) ; first attempt
-        (successful? (attempt)) ; second attempt
-        (successful? (reload-device dev) (attempt))) ; third attempt after reloading
-      (ReportingUtils/showError (str "Device failure: " dev ".\nAborting acquisition."))
-      (swap! state assoc :stop true))))
-
 (defn run-actions [action-map]
   (if run-devices-parallel
     (do
@@ -287,7 +288,7 @@
       (doall (map (partial await-for 10000) (vals device-agents))))
     (do
       (doseq [[dev action] action-map]
-        (device-best-effort dev action)))))
+        (device-best-effort dev (action))))))

 (defn run-autofocus []
   (.. gui getAutofocusManager getDevice fullFocus)
@@ -296,13 +297,17 @@

 (defn snap-image [open-before close-after]
   (with-core-setting [getAutoShutter setAutoShutter false]
-    (when open-before
-      (core setShutterOpen true)
-      (wait-for-device (core getShutterDevice)))
-    (core snapImage)
-    (when close-after
-      (core setShutterOpen false))
-      (wait-for-device (core getShutterDevice))))
+    (let [shutter (core getShutterDevice)]
+      (device-best-effort shutter
+        (when open-before
+          (core setShutterOpen true)
+          (wait-for-device (core getShutterDevice))))
+      (device-best-effort (core getCameraDevice)
+        (core snapImage))
+      (device-best-effort shutter
+        (when close-after
+          (core setShutterOpen false))
+          (wait-for-device (core getShutterDevice))))))

 (defn init-burst [length]
   (core setAutoShutter (@state :init-auto-shutter))


Prevent double acquisitions

Prevent double acquisitions

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

--- plugins/SlideExplorer2/src/slide_explorer/main.clj
+++ plugins/SlideExplorer2/src/slide_explorer/main.clj
@@ -146,6 +146,8 @@
 (def image-processing-executor (Executors/newFixedThreadPool 1))

 (defn add-tiles-at [memory-tiles [nx ny] affine-stage-to-pixel acquired-images]
+  (reactive/submit image-processing-executor
+                   #(swap! acquired-images conj [nx ny]))
   (doseq [image (doall (acquire-at (inverse-transform
                                      (Point. (* 512 nx) (* 512 ny))
                                      affine-stage-to-pixel)))]
@@ -154,15 +156,14 @@
                    :nz (get-in image [:tags "SliceIndex"])
                    :nt 0
                    :nc (or (get-in image [:tags "Channel"]) "Default")}]
+      (println indices)
       ;(println indices @acquired-images)
       (reactive/submit
         image-processing-executor
         #(add-to-memory-tiles
            memory-tiles
            indices
-           (image :proc)))))
-  (reactive/submit image-processing-executor
-           #(swap! acquired-images conj [nx ny])))
+           (image :proc))))))

 (defn acquire-next-tile
   [memory-tiles-atom
@@ -171,6 +172,7 @@
   (when-let [next-tile (next-tile @screen-state-atom
                                   acquired-images
                                   [tile-width tile-height])]
+    (println "acquire-next-tile" next-tile)
     (add-tiles-at memory-tiles-atom next-tile affine acquired-images)
     next-tile))


Indentation!

Indentation!

--- src/wishlistd/models/redis.clj
+++ src/wishlistd/models/redis.clj
@@ -49,4 +49,4 @@
       (let [wishes (merge (:wishes old) (:wishes wishlist))
             no-nils (remove-map-nils wishes)
             neu (assoc wishlist :wishes no-nils)]
-      (update-wishlist (merge old neu))))))
+        (update-wishlist (merge old neu))))))


added a docstring for uptime computer

added a docstring for uptime computer

--- src/backtype/storm/util.clj
+++ src/backtype/storm/util.clj
@@ -721,6 +721,7 @@

 (defn uptime-computer []
+  "Returns a function which computes time difference from when created."
   (let [start-time (current-time-secs)]
     (fn [] (time-delta start-time))))


일반 목록 마커에 +, - 추가

일반 목록 마커에 +, - 추가


avoid initialization errors

avoid initialization errors

--- src/babel/workbook.clj
+++ src/babel/workbook.clj
@@ -1,6 +1,7 @@
 (ns babel.workbook
   (:refer-clojure :exclude [get-in merge resolve find parents])
   (:require
+   [babel.engine :refer [generate]]
    [babel.english.writer :as en]
    [babel.espanol.writer :as es]
    [babel.francais.writer :as fr]
@@ -167,3 +168,17 @@
                           (get (get request :query-params) "attrs"))
          :headers {"Content-Type" "text/html;charset=utf-8"}})
   ))
+
+;; this def is needed to avoid initialization errors when evaluating within the workbook
+;; e.g.: evaluating things like:
+;;(generate {:synsem {:subcat '()
+;;                                          :infl :imperfect
+;;                                          :sem {:subj {:pred :I} :pred :be}}}
+;;                                @fr/small)
+
+(def foo
+  (generate {:synsem {:subcat '()
+                      :infl :imperfect
+                      :sem {:pred :be
+                            :subj {:pred :I}}}}
+            @fr/small))


Refactor

Refactor

--- src/braid/server/events.clj
+++ src/braid/server/events.clj
@@ -7,14 +7,13 @@

 (defn register-user!
   [email group-id]
-  (let [id (db/uuid)
-        ; TODO: guard against duplicate nickname?
-        u (db/create-user! {:id id
-                            :email email
-                            :password (random-nonce 50)
-                            :avatar (gravatar email
-                                      :rating :g
-                                      :default :identicon)})]
-    (sync/user-join-group! id group-id)
-    id))
+  (let [; TODO: guard against duplicate nickname?
+        user (db/create-user! {:id (db/uuid)
+                               :email email
+                               :password (random-nonce 50)
+                               :avatar (gravatar email
+                                         :rating :g
+                                         :default :identicon)})]
+    (sync/user-join-group! (user :id) group-id)
+    (user :id)))


Whitespace.

Whitespace.

--- src/cbfg/world-storage.cljs
+++ src/cbfg/world-storage.cljs
@@ -58,7 +58,8 @@
     (ago storage-scan actx
          (let [s @storage
                changes (:changes s)]
-           (doseq [[key sq] (subseq (:keys s) >= from < to)]
+           (doseq [[key sq]
+                   (subseq (into (sorted-map) (:keys s)) >= from < to)]
              (when-let [change (get changes sq)]
                (when (not (:deleted change))
                  (aput storage-scan out
@@ -73,7 +74,8 @@
   (let [out (achan actx)]
     (ago storage-changes actx
          (let [s @storage]
-             (doseq [[sq change] (subseq (into (sorted-map) (:changes s)) >= from < to)]
+             (doseq [[sq change]
+                     (subseq (into (sorted-map) (:changes s)) >= from < to)]
                (aput storage-changes out (-> change
                                              (assoc :opaque opaque)
                                              (assoc :status :part)))))


fix test name

fix test name

--- test/clj/lambdacd/steps/control_flow_test.clj
+++ test/clj/lambdacd/steps/control_flow_test.clj
@@ -84,7 +84,7 @@
     (is (map-containing {:global {:some :value}}
                         ((in-cwd "somecwd" some-step-that-returns-a-global-value some-successful-step) {} (some-ctx))))))

-(deftest do-test
+(deftest run-test
   (testing "that it runs all the children and collects the results"
     (is (map-containing {:outputs { [1 0 0] {:status :success} [2 0 0] {:foo :baz :status :success}} :status :success}
                         ((run some-successful-step some-other-step) {} (some-ctx-with :step-id [0 0])))))


[#1656] Add shared dataset endpoint

[#1656] Add shared dataset endpoint

--- backend/src/akvo/lumen/endpoint/public.clj
+++ backend/src/akvo/lumen/endpoint/public.clj
@@ -38,25 +38,33 @@
   [["/:id"
     ["" {:get {:parameters {:path-params {:id string?}}
             :handler (handler opts)}}]
-    ["/dataset/:dataset-id/column/:column-name"
+    ["/dataset/:dataset-id"
+     ["" {:get {:parameters e.dataset/fetch-column-params
+                :handler (fn [{tenant :tenant
+                               headers :headers
+                               {:keys [id dataset-id]} :path-params}]
+                           (let [password (get headers "x-password")
+                                 tenant-conn (p/connection tenant-manager tenant)]
+                             (if-let [share (public/share* tenant-conn id)]
+                               (if-let [auth-share (public/auth-share* share password)]
+                                 (lib/ok
+                                  (dataset/fetch tenant-conn dataset-id))
+                                 (lib/not-authorized {:share-id id}))
+                               (lib/not-found {:share-id id}))))}}]
+     ["/column/:column-name" {:get {:parameters e.dataset/fetch-column-params
+                                    :handler (fn [{tenant :tenant
+                                                   headers :headers
+                                                   {:keys [id dataset-id column-name]} :path-params

-     {:get {:parameters e.dataset/fetch-column-params
-            :handler (fn [{tenant :tenant
-                           headers :headers
-                           {:keys [id dataset-id column-name]} :path-params
-
-                           query-params :query-params}]
-                       (let [password (get headers "x-password")
-                             tenant-conn (p/connection tenant-manager tenant)]
-                         (if-let [share (public/share* tenant-conn id)]
-                           (if-let [auth-share (public/auth-share* share password)]
-                             (lib/ok
-                              (dataset/sort-text tenant-conn dataset-id column-name (get query-params "limit")))
-                             (lib/not-authorized {:share-id id}))
-                           (lib/not-found {:share-id id})
-                           )
-))}}
-     ]]])
+                                                   query-params :query-params}]
+                                               (let [password (get headers "x-password")
+                                                     tenant-conn (p/connection tenant-manager tenant)]
+                                                 (if-let [share (public/share* tenant-conn id)]
+                                                   (if-let [auth-share (public/auth-share* share password)]
+                                                     (lib/ok
+                                                      (dataset/sort-text tenant-conn dataset-id column-name (get query-params "limit")))
+                                                     (lib/not-authorized {:share-id id}))
+                                                   (lib/not-found {:share-id id}))))}}]]]])

 (defmethod ig/init-key :akvo.lumen.endpoint.public/public  [_ opts]
   (routes opts))


Add more tests.

Add more tests.

--- test/dsbdp/test/processing_fn_utils_tests.clj
+++ test/dsbdp/test/processing_fn_utils_tests.clj
@@ -83,9 +83,33 @@
         expected [2 2 2 2]]
     (is (= expected (calculate-distribution-mapping in-seq ratios)))))

-(deftest calculate-distribution-mapping-6-to-4-test
+(deftest calculate-distribution-mapping-6-to-4-uniform-test
   (let [in-seq (repeat 6 nil)
         ratios [0.25 0.25 0.25 0.25]
         expected [2 2 1 1]]
     (is (= expected (calculate-distribution-mapping in-seq ratios)))))

+(deftest calculate-distribution-mapping-6-to-4-skewed-test
+  (let [in-seq (repeat 6 nil)
+        ratios [0.1 0.1 0.4 0.4]
+        expected [1 1 2 2]]
+    (is (= expected (calculate-distribution-mapping in-seq ratios)))))
+
+(deftest calculate-distribution-mapping-12-to-4-skewed-test-1
+  (let [in-seq (repeat 12 nil)
+        ratios [0.1 0.1 0.4 0.4]
+        expected [2 2 4 4]]
+    (is (= expected (calculate-distribution-mapping in-seq ratios)))))
+
+(deftest calculate-distribution-mapping-12-to-4-skewed-test-2
+  (let [in-seq (repeat 12 nil)
+        ratios [0.166 0.166 0.33 0.33]
+        expected [2 2 4 4]]
+    (is (= expected (calculate-distribution-mapping in-seq ratios)))))
+
+(deftest calculate-distribution-mapping-15-to-4-skewed-test-1
+  (let [in-seq (repeat 15 nil)
+        ratios [0.166 0.166 0.33 0.33]
+        expected [2 2 4 4]]
+    (is (= expected (calculate-distribution-mapping in-seq ratios)))))
+


Clean up namespace

Clean up namespace

--- src/clj/mdr2/middleware.clj
+++ src/clj/mdr2/middleware.clj
@@ -1,24 +1,23 @@
 (ns mdr2.middleware
   (:require
+    [buddy.auth :refer [authenticated?]]
+    [buddy.auth.accessrules :refer [restrict]]
+    [buddy.auth.backends.token :refer [jws-backend]]
+    [buddy.auth.middleware :refer [wrap-authentication wrap-authorization]]
+    [clojure.set :refer [intersection]]
+    [clojure.tools.logging :as log]
+    [mdr2.config :refer [env]]
     [mdr2.env :refer [defaults]]
-    [clojure.tools.logging :as log]
+    [mdr2.i18n :refer [tr]]
     [mdr2.layout :refer [error-page]]
+    [mdr2.middleware.formats :as formats]
+    [muuntaja.middleware :refer [wrap-format wrap-params]]
+    [reitit.ring :as ring]
+    [ring.adapter.undertow.middleware.session :refer [wrap-session]]
     [ring.middleware.anti-forgery :refer [wrap-anti-forgery]]
-    [mdr2.middleware.formats :as formats]
-    [mdr2.i18n :refer [tr]]
-    [muuntaja.middleware :refer [wrap-format wrap-params]]
-    [mdr2.config :refer [env]]
+    [ring.middleware.defaults :refer [site-defaults wrap-defaults]]
     [ring.middleware.flash :refer [wrap-flash]]
-    [ring.adapter.undertow.middleware.session :refer [wrap-session]]
-    [ring.middleware.defaults :refer [site-defaults wrap-defaults]]
-    [ring.util.http-response :refer [unauthorized forbidden]]
-    [buddy.auth.middleware :refer [wrap-authentication wrap-authorization]]
-    [buddy.auth.accessrules :refer [restrict]]
-    [buddy.auth :refer [authenticated?]]
-    [buddy.auth.backends.token :refer [jws-backend]]
-    [clojure.set :refer [intersection]]
-    [reitit.ring :as ring])
-  )
+    [ring.util.http-response :refer [forbidden unauthorized]]))

 (defn wrap-internal-error [handler]
   (fn [req]


Working on pattern matching code.

Working on pattern matching code.

--- src/clj/minijava/cannon.clj
+++ src/clj/minijava/cannon.clj
@@ -1,86 +1,39 @@
-(ns minijava.cannon
-  (:use (minijava ir exp label x86)))
-
+(ns minijava.canon
+  "Implementation of the canonicalization algorithms for IR."
+  (:use minijava.ir))
+
+(defn remove-eseq-left
+  [tree]
+  (let [statements (get-in tree [:exp1 :seqs])
+        expression (get-in tree [:exp1 :exp])]
+    (conj (vec statements)
+          (merge tree [:exp1 expression]))))
+
+(defn remove-double-eseq
+  [tree]
+  (let [s1 (get tree :seqs)
+        s2 (get-in tree [:exp :seqs])
+        e (get-in tree [:exp :exp])]
+    (conj (vec (concat s1 s2))
+          e)))
+
+(defn remove-eseq-commute
+  [tree]
+  (let [s1 (get-in tree [:exp1 :seqs])
+        e1 (get-in tree [:exp1 :exp])
+        e2 (get tree :exp2)]
+    (conj (vec s1)
+          (merge tree [:exp1 e1]))))
+
+(defn remove-eseq-no-commute
+  [tree]
+  (let [e1 (get tree :exp1)
+        s1 (get-in tree [:exp2 :seqs])
+        e2 (get-in tree [:exp2 :exp])
+        t (minijava.ir.temp.Temp.)]
+    (concat [(Move e1 (Temp t))]
+            s1
+            [(merge tree [:exp1 (Temp t)]
+                    [:exp2 e2])])))
+
 (defmulti cannon (fn [x] (type x)))
-
-
- (defn isNop [a]
-  (and (isa? a :minijava.ir/Statement) (isa? (:exp a) :minijava.ir/Const))
-  )
-
- (defn seq [a b]
-  (cond
-  			((isNop a) b)
-  			((isNop b) a)
-  			(true (Seq a b)))
-  )
-
-(defmethod cannon :minijava.ir/Seq
-  [x]
-  (seq (cannon (.left x) (.right x))) ;;this code is wrong - how are the elements of the sequence accessed?
-  )
-
-(defmethod cannon :minijava.ir/Move
-  [x]
-  (cond
-  	(and ( isa? (:dst x ) :minijava.ir/Temp) ( isa? (:src x ) :minijava.ir/Call) )
-  			(reorderCallMove (:dst x ) (:src x ))
-  	 (isa? (:dst x) :minijava.ir/ExpSeq)
-  	 		 (cannon (Seq (:seqs (:dst x)) (Move (:exp (:dst x)) (:src x)) ) )
-  	 (true (reorder x) )
-
-  )
-
- )
-
-(defmethod cannon :minijava.ir/Statement
-  [x]
-  (cond
-  	 (isa? (:exp x) :minijava.ir/Call)
-  	 			(reorderExpCall (:exp x))
-  	 	(true (reorder x))
-  )
- )
-
- (defmethod cannon :minijava.ir/ExpSeq
-  [x]
- 	(let ( (stms  cannon (:seqs x))
- 				(b (cannon (:exp x))))
- 			(ExpSeq (seq stms (:stm b)) (:exp b)))
- 	)
-
- (defmethod cannon :minijava.ir/ExpSeq
-  [x]
- 	(reorder x)
- )
-
- (defmethod cannon :default
-  [x]
- 	(reorder x)
- )
-
-
-  static ESEQ do_exp(ESEQ e) {
-		IRStm stms = do_stm(e.stm);
-		ESEQ b = do_exp(e.exp);
-		return new ESEQ(seq(stms,b.stm), b.exp);
-	}
-
-	static ESEQ do_exp (IRExp e) {
-		if (e instanceof ESEQ) return do_exp((ESEQ)e);
-		else return reorder_exp(e);
-	}
-
-(defn reorderExpCall [x]
-
-
-)
-
-(defn reorderCallMove [x]
-
-
-)
-
-(defmulti reorder (fn [x] (type x)))
-
-


refactor code

refactor code

--- src/clj/salava/page/pdf.clj
+++ src/clj/salava/page/pdf.clj
@@ -11,7 +11,7 @@
             [clojure.zip :as zip]
             [salava.user.db :as ud]
             [net.cgrand.enlive-html :as enlive]
-            [salava.badge.pdf :refer [process-markdown replace-nils]]
+            [salava.badge.pdf :refer [process-markdown replace-nils pdf-generator-helper]]
             ))

 (defqueries "sql/page/main.sql")
@@ -70,34 +70,33 @@
        ))

 (defn generate-pdf [ctx page-id user-id header?]
-  (let [ badge-info-fn (first (plugin-fun (get-plugins ctx) "pdf" "pdf-generator-helper"))
-         page (replace-nils (conj () (page-with-blocks ctx page-id)))
-         data-dir (get-in ctx [:config :core :data-dir])
-         site-url (get-in ctx [:config :core :site-url])
-         plugins (get-plugins ctx)
-         user-data (ud/user-information ctx user-id)
-         ul (if (blank? (:language user-data)) "en" (:language user-data))
-         font-path  (first (mapcat #(get-in ctx [:config % :font] []) plugins))
-         header-path (first (mapcat #(get-in ctx [:config % :logo] []) plugins))
-         font  {:ttf-name (str site-url font-path)}
-         stylesheet  {:generic {:family :times-roman
-                                :color [127 113 121]}
+  (let [page (replace-nils (conj () (page-with-blocks ctx page-id)))
+        data-dir (get-in ctx [:config :core :data-dir])
+        site-url (get-in ctx [:config :core :site-url])
+        plugins (get-plugins ctx)
+        user-data (ud/user-information ctx user-id)
+        ul (if (blank? (:language user-data)) "en" (:language user-data))
+        font-path  (first (mapcat #(get-in ctx [:config % :font] []) plugins))
+        header-path (first (mapcat #(get-in ctx [:config % :logo] []) plugins))
+        font  {:ttf-name (str site-url font-path)}
+        stylesheet  {:generic {:family :times-roman
+                               :color [127 113 121]}
                       :link {:family :times-roman
                              :color [66 100 162]}
-                      :bold {:style :bold}}
-         header      (if (= "true" header?)
-                       {:table
-                        [:pdf-table {:border false}
-                         [100]
-                         [[:pdf-cell {:padding 5}[:image {:width 200 :height 48} (str site-url (if-not (blank? header-path) header-path "/img/logo.png"))] [:line] [:spacer 2]]
-                          ]]} nil)
-
-         pdf-settings  (if (empty? font-path) {:header header :stylesheet stylesheet  :bottom-margin 0 :footer {:page-numbers false :align :right}} {:font font :header header :stylesheet stylesheet  :bottom-margin 0 :footer {:page-numbers false :align :right}})
-         page-template (pdf/template
-                         (let [template #(cons [:paragraph][
-                                                             (when (= "heading"  (:type %))
-                                                               (case (:size %)
-                                                                 "h1" [:paragraph.generic {:align :left }
+                     :bold {:style :bold}}
+        header      (if (= "true" header?)
+                      {:table
+                       [:pdf-table {:border false}
+                        [100]
+                        [[:pdf-cell {:padding 5}[:image {:width 200 :height 48} (str site-url (if-not (blank? header-path) header-path "/img/logo.png"))] [:line] [:spacer 2]]
+                         ]]} nil)
+
+        pdf-settings  (if (empty? font-path) {:header header :stylesheet stylesheet  :bottom-margin 0 :footer {:page-numbers false :align :right}} {:font font :header header :stylesheet stylesheet  :bottom-margin 0 :footer {:page-numbers false :align :right}})
+        page-template (pdf/template
+                        (let [template #(cons [:paragraph][
+                                                            (when (= "heading"  (:type %))
+                                                              (case (:size %)
+                                                                "h1" [:paragraph.generic {:align :left }
                                                                        [:spacer 0]
                                                                        [:heading  (:content %)]
                                                                        [:line {:dotted true}]
@@ -118,7 +117,7 @@
                                                                        [:paragraph [:chunk [:image {:align :center :width 80 :height 80} (str data-dir "/" (:image_file %))]] [:spacer 1]"\n" ]
                                                                        "")])
                                                                   [:paragraph
-                                                                   (let [badge (badge-info-fn ctx user-id (conj () (:badge_id %)))]
+                                                                   (let [badge (pdf-generator-helper ctx user-id (list (:badge_id %)))]
                                                                     (when-not (empty? badge)
                                                                       [:phrase {:align :center}
                                                                        [:chunk [:image {:align :center :width 75 :height 75  :base64 true} (:qr_code (first badge))]]"\n"
@@ -138,9 +137,9 @@
                                                                     [:phrase.bold (str (t :badge/Criteria ul)": ")] [:spacer 0]
                                                                     [:anchor {:target (:criteria_url %) :style{:family :times-roman :color [66 100 162]}} (:criteria_url %)]
                                                                     [:spacer 0]
-                                                                    (let [content (some->> (badge-info-fn ctx user-id (conj () (:badge_id %))) first :content first) ]
+                                                                    (let [content (some->> (pdf-generator-helper ctx user-id (list (:badge_id %))) first :content first) ]
                                                                       (when-not (empty? content)
-                                                                        (process-markdown "Criteria" (:criteria_content content))))]]]]
+                                                                        (process-markdown (:criteria_content content))))]]]]

                                                                 [[:cell {:colspan 2} [:line {:dotted true}]]]])

@@ -169,7 +168,7 @@
                                                                (if (= "long" (:format %))
                                                                  (into [:table {:border false :widths [1 3] :keep-together? false}]
                                                                        (conj  (into [[[:cell {:colspan 2}]]] (for [badge (:badges %)
-                                                                                :let [b (badge-info-fn ctx user-id (conj () (:id badge)))
+                                                                                :let [b (pdf-generator-helper ctx user-id (list (:id badge)))
                                                                                content (-> b first :content first)]]
                                                                                (when-not (empty? b)
                                                                                (conj [[:cell {:align :left} (if (and (not (= "-" (:image_file badge))) (ends-with? (:image_file badge) "png")) [:image {:align :center :width 75 :height 75}(str data-dir "/" (:image_file badge))] [:image {:align :center :width 75 :height 75 :base64 true} (:qr_code (first b))])]]
@@ -184,7 +183,7 @@
                                                                                [:paragraph {:keep-together true}
                                                                                [:phrase.bold (str (t :badge/Criteria ul)": ")] "\n"
                                                                                [:anchor {:target (:criteria_url badge) :style{:family :times-roman :color [66 100 162]}} (:criteria_url badge)] "\n"
-                                                                                (process-markdown "Criteria" (:criteria_content content))
+                                                                                (process-markdown (:criteria_content content))
                                                                                ]
                                                                                ][:spacer 0]]))))
                                                                               [[:cell {:colspan 2}[:line {:dotted true}]]]))
@@ -193,7 +192,7 @@
                                                                   [[:cell
                                                                     [:table {:align :center :width-percent 100 :border false :num-cols 5}
                                                                      (into [[:cell {:colspan 5}]] (for [badge (:badges %)
-                                                                                :let [b (badge-info-fn ctx user-id (conj () (:id badge)))
+                                                                                :let [b (pdf-generator-helper ctx user-id (list (:id badge)))
                                                                                content (-> b first :content first)]]
                                                                                (when-not (empty? b)
                                                                                [:cell {:padding-right 10}[:anchor {:target (str site-url "/badge/info/" (:id badge))}


Node URLs are immutable.

Node URLs are immutable.

--- src/clj/shale/resources.clj
+++ src/clj/shale/resources.clj
@@ -275,8 +275,7 @@
   :known-content-type? is-json-or-unspecified?
   :malformed? #(parse-request-data
                  :context %
-                 :schema {(s/optional-key :url) s/Str
-                          (s/optional-key :tags) [s/Str]})
+                 :schema {(s/optional-key :tags) [s/Str]})
   :handle-ok (fn [context]
                (jsonify (get context ::node)))
   :handle-exception handle-exception


Use logging namespace in train-race.core

--- src/clj/train_race/core.clj
+++ src/clj/train_race/core.clj
@@ -4,8 +4,8 @@
             [luminus.http-server :as http]
             [luminus-migrations.core :as migrations]
             [train-race.config :refer [env]]
+            [train-race.log :as log :refer [logger]]
             [clojure.tools.cli :refer [parse-opts]]
-            [clojure.tools.logging :as log]
             [mount.core :as mount])
   (:gen-class))

@@ -35,7 +35,7 @@

 (defn stop-app []
   (doseq [component (:stopped (mount/stop))]
-    (log/info component "stopped"))
+    (log/info logger ::system.shutdown {:msg (str component " stopped")}))
   (shutdown-agents))

 (defn start-app [args]
@@ -43,16 +43,16 @@
                         (parse-opts cli-options)
                         mount/start-with-args
                         :started)]
-    (log/info component "started"))
+    (log/info logger ::system.startup {:msg (str component " started")}))
   (.addShutdownHook (Runtime/getRuntime) (Thread. stop-app)))

 (defn dev-restart
   ([] (dev-restart nil))
   ([& args]
-   (log/info "Shutting down all services")
+   (log/info logger ::system.restart {:msg "Shutting down all services"})
    (doseq [component (:stopped (mount/stop))]
-     (log/info component "stopped"))
-   (log/info "Restarting..")
+     (log/info logger ::system.restart {:msg (str component " stopped")}))
+   (log/info logger ::system.restart {:msg "Restarting.."})
    (start-app args)))

 (defn -main [& args]
@@ -64,4 +64,3 @@
       (System/exit 0))
     :else
     (start-app args)))
-


Temp on the page

Temp on the page

--- src/cljs/aladin/client.cljs
+++ src/cljs/aladin/client.cljs
@@ -7,21 +7,26 @@

 (enable-console-print!)

-(defn doweather [data]
-   (jqm/let-ajax [weather {:url (str "/weather/"
-                                     (-> data .-coords .-latitude)
-                                     "/"
-                                     (-> data .-coords .-longitude))}]
-     (println weather)
-     (let [curtime (now)
-           forecast-from (parse (formatter "yyyy-MM-dd HH:mm:ss Z")
-                                (str (:forecastTimeIso weather) " +0100"))]
-       (println
-         (nth (-> weather :parameterValues :TEMPERATURE)
-              (in-hours (interval forecast-from curtime)))))))
+(def weather-data (r/atom {}))
+
+(defn current-index [weather]
+  (let [curtime (now)
+        forecast-from (parse (formatter "yyyy-MM-dd HH:mm:ss Z")
+                             (str (:forecastTimeIso weather) " +0100"))]
+    (in-hours (interval forecast-from curtime))))
+
+(defn weather-now []
+  [:h1 (nth (-> @weather-data :parameterValues :TEMPERATURE)
+            (current-index @weather-data))])
+
+(defn show-weather [data]
+   (jqm/let-ajax [weather {:url (str "/weather/" (-> data .-coords .-latitude) "/" (-> data .-coords .-longitude))}]
+     (reset! weather-data weather)
+     (r/render-component [weather-now]
+                         (.-body js/document))))

 (jqm/ready
   (let [geo (.-geolocation js/navigator)]
     (if geo
-      (.getCurrentPosition geo doweather)
+      (.getCurrentPosition geo show-weather)
       (println "GTFO"))))


Remove debugging, handle Sente operations properly (:chsk/recv indicates a received event!).

Still some funkiness around form field updating (first keystroke blanks the field, requires two ENTER presses to cause data view to change).

--- src/cljs/om_sente/core.cljs
+++ src/cljs/om_sente/core.cljs
@@ -39,11 +39,13 @@
     om/IWillMount
     (will-mount [this]
       (go (loop []
-            (js/alert "waiting for data")
-            (let [[ev-id & payload :as msg] (<! ch-chsk)]
-              (js/alert (str "got " (pr-str msg)))
-              (case ev-id
-                :test/reply (om/set-state! owner :text (first payload))
+            (let [[op & args :as event] (<! ch-chsk)]
+              (case op
+                :chsk/recv
+                (let [[ev-id & payload] (first args)]
+                  (case ev-id
+                    :test/reply (om/set-state! owner :text (first payload))
+                    nil))
                 nil))
             (recur))))
     om/IRenderState


Renders todo in a list with just the title

--- src/cljs/todo_clj/core.cljs
+++ src/cljs/todo_clj/core.cljs
@@ -5,19 +5,26 @@

 (enable-console-print!)

-(defonce app-state (atom {:text "Hello Chestnut!"}))
+(defonce app-state (atom {:todos []}))

-(defn handler [response]
-  (.log js/console (str response)))
+(defn handler [response cursor]
+  (om/update! cursor :todos response))
+
+(defn todo [todo]
+  (dom/li #js {:key (:id todo)} (:title todo)))

 (defn root-component [app owner]
   (reify
     om/IWillMount
     (will-mount [_]
-      (GET "/todos" {:handler handler}))
+      (GET "/todos" {:handler #(handler % app)
+                     :keywords? true
+                     :response-format :json}))
     om/IRender
     (render [_]
-      (dom/div nil (dom/h1 nil (:text app))))))
+      (dom/div nil
+        (dom/h1 nil "Todo")
+        (dom/ul nil (map todo (get app :todos)))))))

 (om/root
  root-component


Factorize

Factorize

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -393,22 +393,19 @@
      {:class (str "cell--" (name player))
       :x (+ 0.05 x) :width  0.9
       :y (+ 0.05 y) :height 0.9}
-     options)
-   ])
+     options)])

 (defn ^boolean show-help?
-  [game x y]
+  [x y]
   (and
-    (:help @app-state) ;; TODO - Refactor not to use globals
-    (not (is-ai? (:player game)))
-    (get-move-at game (:player game) [x y])))
+    (:help @app-state)
+    (not (is-ai? @current-player))
+    (get-move-at @game @current-player [x y])))

 (defn empty-cell
-  [x y game]
-  (rect-cell x y
-    (if-not (show-help? game x y) :empty :help)
-    {:on-click #(send-player-event! [x y])}
-    ))
+  [x y player]
+  (rect-cell x y player
+    {:on-click #(send-player-event! [x y])}))

 (defn show-scores
   [scores player]
@@ -450,10 +447,10 @@
      (for [[x y] all-positions
            :let [cell (get-in @board [x y])]]
        ^{:key [x y]}
-       (case cell
-         :empty [empty-cell x y @game] ;; TODO - Help cell somewhere here
-                [rect-cell x y cell]
-         )))
+       (if (= :empty cell)
+         [empty-cell x y (if-not (show-help? x y) :empty :help)]
+         [rect-cell x y cell])
+       ))
    ])

 (reagent/render [run-game]


dump preprocessor nodes

dump preprocessor nodes

--- src/atom_finder/location_dump.clj
+++ src/atom_finder/location_dump.clj
@@ -44,8 +44,11 @@
 (defn location-dump-atoms-and-non-atoms [filename]
   (let [root      (->> filename parse-file)
         all-atoms (find-all root)
+        all-nodes (->> root flatten-tree-context (map (fn [[ctx n]] (assoc ctx :node n))))
+        all-macro (->> root all-preprocessor (map #(array-map :node %)))
+        all-nodes-macro (concat all-nodes all-macro)
         non-atoms (set-difference-by :node
-                                     (->> root flatten-tree-context (map (fn [[ctx n]] (assoc ctx :node n))))
+                                     all-nodes-macro
                                      all-atoms)]
     (map (partial merge {:file filename})
          (concat all-atoms (map #(merge {:type :non-atom} %1 (loc-data (:node %1))) non-atoms)))))
@@ -60,11 +63,12 @@
      (pmap-dir-files location-dump-atoms-and-non-atoms)
      (mapcat (partial map #(update % :node write-node)))
      (map #(merge %1 (if (:path %1) {:depth (count (:path %1))} {})))
+     (map (fn [m] (update m :file #(subs % (- (count gcc-path) 3))))) ; remove gcc-path prefix from file paths
      (map (juxt :file :type :start-line :end-line :depth))
      (map prn)
      (take 50000)
      dorun
-     (log-to "location-dump_non-atoms_2017-06-02.txt")
+     (log-to "location-dump_non-atoms_2017-06-05.txt")
      time
      )

@@ -102,3 +106,10 @@
      (map process-dump-file)
      pprint
      )
+
+(->> "/Users/dgopstein/opt/src/gcc/libatomic/gload.c"
+     parse-file
+     all-preprocessor
+     (map loc)
+     (map prn)
+     )


adding jobs statuses

adding jobs statuses

--- src/celestial/jobs.clj
+++ src/celestial/jobs.clj
@@ -1,13 +1,13 @@
 (comment
-   Celestial, Copyright 2012 Ronen Narkis, narkisr.com
-   Licensed under the Apache License,
-   Version 2.0  (the "License") you may not use this file except in compliance with the License.
-   You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS,
-   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-   See the License for the specific language governing permissions and
-   limitations under the License.)
+  Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+  Licensed under the Apache License,
+  Version 2.0  (the "License") you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.)

 (ns celestial.jobs
   (:refer-clojure :exclude [identity])
@@ -35,14 +35,14 @@
 (defn job-exec [f  {:keys [message attempt]}]
   "Executes a job function tries to lock identity first (if used)"
   (let [{:keys [identity args tid env] :as spec} message]
-   (set-env env
-     (set-tid tid
-       (let [{:keys [wait-time expiry]} (map-vals (or (get* :celestial :job) defaults) #(* minute %) )]
-         (try
-          (if identity
-           (do (with-lock (server-conn) identity expiry wait-time (apply f args)) {:status :success})
-           (do (apply f args) {:status :success}))
-          (catch Throwable e (error e) {:status  :error})))))))
+    (set-env env
+             (set-tid tid
+                      (let [{:keys [wait-time expiry]} (map-vals (or (get* :celestial :job) defaults) #(* minute %) )]
+                        (try
+                          (if identity
+                            (do (with-lock (server-conn) identity expiry wait-time (apply f args)) {:status :success})
+                            (do (apply f args) {:status :success}))
+                          (catch Throwable e (error e) {:status  :error})))))))

 (def jobs
   (atom
@@ -71,6 +71,23 @@
 (defn status [queue uuid]
   (mq/message-status (server-conn) queue uuid))

+(defn- job-desc [type js]
+  (mapv (fn [[jid {:keys [args]}]]
+          {:type type :status (status type jid) :id ((args 0) :system-id) :jid jid}) (apply hash-map js)))
+
+(defn queue-status
+  "The entire queue messages statuses"
+  [job]
+  (let [ks [:messages :locks :backoffs]]
+    (reduce
+      (fn [r v] (into r (job-desc job v))) []
+            (apply merge (vals (select-keys (mq/queue-status (server-conn) job) ks))))))
+
+(defn jobs-statues
+  "Get all jobs message statuses"
+  []
+  (reduce (fn [r t] (into r (queue-status (name t)))) [] (keys @jobs)))
+
 (defn shutdown-workers []
   (doseq [[k ws] @workers]
     (doseq [w ws]


add db/user-pull-pattern and use throughout

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -237,6 +237,12 @@
                       :message/content
                       {:message/user [:user/id]}
                       :message/created-at]}])
+
+(def user-pull-pattern
+  '[:user/id
+    :user/nickname
+    :user/avatar
+    {:group/_user [:group/id]}])

 (defn- db->thread
   [thread]
@@ -398,13 +404,13 @@

 (defn user-by-id
   [id]
-  (some-> (d/pull (d/db *conn*) '[:user/id :user/avatar :user/nickname] [:user/id id])
+  (some-> (d/pull (d/db *conn*) user-pull-pattern [:user/id id])
           db->user))

 (defn user-with-email
   "get the user with the given email address or nil if no such user registered"
   [email]
-  (some-> (d/pull (d/db *conn*) '[:user/id :user/email :user/avatar :user/nickname] [:user/email email])
+  (some-> (d/pull (d/db *conn*) user-pull-pattern [:user/email email])
           db->user))

 (defn create-invitation!
@@ -434,16 +440,15 @@
 (defn fetch-users-for-user
   "Get all users visible to given user"
   [user-id]
-  (->> (d/q '[:find (pull ?e [:user/id
-                              :user/nickname
-                              :user/avatar
-                              {:group/_user [:group/id]}])
-              :in $ ?user-id
+  (->> (d/q '[:find (pull ?e pull-pattern)
+              :in $ ?user-id pull-pattern
               :where
               [?u :user/id ?user-id]
               [?g :group/user ?u]
               [?g :group/user ?e]]
-            (d/db *conn*) user-id)
+            (d/db *conn*)
+            user-id
+            user-pull-pattern)
        (map (comp db->user first))
        set))

@@ -501,13 +506,14 @@
        set))

 (defn get-users-in-group [group-id]
-  (->> (d/q '[:find (pull ?u [:user/id :user/email :user/nickname :user/avatar])
-              :in $ ?group-id
+  (->> (d/q '[:find (pull ?u pull-pattern)
+              :in $ ?group-id pull-pattern
               :where
               [?g :group/id ?group-id]
               [?g :group/user ?u]]
             (d/db *conn*)
-            group-id)
+            group-id
+            user-pull-pattern)
        (map (comp db->user first))
        set))


CMR-2257: Fixed umm-spec temporal parsing to handle both date string and datetime string.

--- umm-spec-lib/src/cmr/umm_spec/json_schema.clj
+++ umm-spec-lib/src/cmr/umm_spec/json_schema.clj
@@ -9,13 +9,13 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Defined schema files
-(def concept-type->schema-file
+(def concept-type->schema-file
   "Maps a concept type to the schema required to parse it."
-  {:collection (io/resource "json-schemas/umm-c-json-schema.json")
+  {:collection (io/resource "json-schemas/umm-c-json-schema.json")
    :service (io/resource "json-schemas/umm-s-json-schema.json")})

-(def umm-cmn-schema-file
-  "The schema required to parse umm-common"
+(def umm-cmn-schema-file
+  "The schema required to parse umm-common"
   (io/resource "json-schemas/umm-cmn-json-schema.json"))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -188,6 +188,14 @@
     (recur (apply lookup-ref pair))
     pair))

+(defn- parse-datetime
+  "Returns the datetime parsed from a date-string or datetime-string."
+  [datetime-string]
+  (when datetime-string
+    (if (re-matches #"^\d\d\d\d-\d?\d-\d?\d$" datetime-string)
+      (dtp/parse-date datetime-string)
+      (dtp/parse-datetime datetime-string))))
+
 (defn coerce
   "Returns x coerced according to a JSON schema type type definition. With no other parameters, the
   schema and type defaults to the umm-c-schema and the root UMM-C type."
@@ -205,7 +213,7 @@
                    "date-time"
                    (if (instance? org.joda.time.DateTime x)
                      x
-                     (try (dtp/parse-datetime x)
+                     (try (parse-datetime x)
                        (catch Exception e
                          (throw (IllegalArgumentException.
                                   (format "Failed to parse date-time [%s] at key-path [%s]"


Fix parallelism picker in 15.4.2

Fix parallelism picker in 15.4.2

Previously, strings became `span` elements. As of React 15, they become
text nodes. Our CSS expected a `span`.

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -389,7 +389,7 @@
          (for [parallelism (range 1 (inc number-tiles))]
            [:label {:class (parallel-label-classes project-data parallelism)
                     :for (str "parallel_input_" parallelism)}
-            parallelism
+            [:span parallelism]
             (parallelism-tile project-data owner parallelism)
             [:input {:id (str "parallel_input_" parallelism)
                      :type "radio"


relative paths for lambdacd-favicon introduced in #50

--- src/clj/lambdacd/ui/ui_server.clj
+++ src/clj/lambdacd/ui/ui_server.clj
@@ -57,9 +57,9 @@
                        (if pipeline-name
                          [:title (str pipeline-name " - LambdaCD")]
                          [:title "LambdaCD"])
-                       [:link {:rel "icon" :type "image/png" :sizes "32x32" :href "/favicon-32x32.png"}]
-                       [:link {:rel "icon" :type "image/png" :sizes "96x96" :href "/favicon-96x96.png"}]
-                       [:link {:rel "icon" :type "image/png" :sizes "16x16" :href "/favicon-16x16.png"}]
+                       [:link {:rel "icon" :type "image/png" :sizes "32x32" :href "favicon-32x32.png"}]
+                       [:link {:rel "icon" :type "image/png" :sizes "96x96" :href "favicon-96x96.png"}]
+                       [:link {:rel "icon" :type "image/png" :sizes "16x16" :href "favicon-16x16.png"}]
                        (p/include-css "css/thirdparty/normalize.css")
                        (p/include-css "css/main.css")
                        (p/include-css "css/thirdparty/font-awesome-4.4.0/css/font-awesome.min.css")]


provisional format for list generation routine

--- src/clj/webapp/routes/listlpv.clj
+++ src/clj/webapp/routes/listlpv.clj
@@ -56,51 +56,6 @@
               [:td [:input#submit
                     {:value "Make Language-Property-Value Lists", :name "submit", :type "submit"}]]]]))))

-(defn csv2table-1
-"Takes sorted 3-col csv list and outputs html table with empty [:td]  for repeated col1 and vec of col3 vals for repeated col2. [IN PROGRESS!]"
- [lpvs]
-(let [curcat1 (atom "")
-      curcat2 (atom "")
-      curcat3 (atom [])]
- [:table
-(for [lpv lpvs]
- (let [catmap (zipmap [:cat1 :cat2 :cat3] (split lpv #","))
-       ;;nextmap (zipmap [:cat1 :cat2 :cat3] (split (first (rest lpvs)) #","))
-       ]
-   (if (= (:cat1 catmap) @curcat1)
-
-     (if (= (:cat2 catmap) @curcat2)
-       (swap! curcat3 conj (str (:cat3 catmap)))
-       (do [:tr [:td] [:td curcat2] [:td curcat3]]
-          (reset! curcat2 (str (:cat2 catmap)))))
-
-     ((if (clojure.string/blank? @curcat1)
-        (do (reset! curcat1 (str (:cat1 catmap)))
-         (reset! curcat2 (str (:cat2 catmap)))
-         (swap! curcat3 conj (str (:cat3 catmap))))
-        (do [:tr [:td @curcat1] [:td @curcat2] [:td @curcat3]]
-           (reset! curcat1 (str (:cat1 catmap)))
-           (reset! curcat2 (str (:cat2 catmap)))
-           (reset! curcat3 (str (:cat3 catmap)))))))))]))
-
-(defn csv2table-2
-"Takes sorted 3-col csv list and outputs html table with empty [:td]  for repeated col1 and vec of col3 vals for repeated col2. [IN PROGRESS!]"
- [lpvs]
-(let  [curcat1 (atom "")
-      curcat2 (atom "")
-      curcat3 (atom [])
-       ]
- [:table
-(for [lpv lpvs]
- (let [catmap (zipmap [:cat1 :cat2 :cat3] (split lpv #","))
-       ;;nextmap (zipmap [:cat1 :cat2 :cat3] (split (first (rest lpvs)) #","))
-       ]
-   (if (= (:cat1 catmap) @curcat1)
-     [:tr [:td] [:td (:cat2 catmap)][:td (:cat3 catmap)]]
-     (do (reset! curcat1 (:cat1 catmap))
-         [:tr [:td @curcat1][:td (:cat2 catmap)][:td (:cat3 catmap)]]
-          ))))]))
-
 (defn csv2table
 "Takes sorted 3-col csv list and outputs html table with empty [:td]  for repeated col1 and vec of col3 vals for repeated col2. [IN PROGRESS!]"
  [lpvs]
@@ -125,64 +80,6 @@
          [:tr [:td @curcat1][:td @curcat2][:td (:cat3 catmap)]]
          ))))]))

-(defn csv2table-3
-"Takes sorted 3-col csv list and outputs html table with empty [:td]  for repeated col1 and vec of col3 vals for repeated col2. [IN PROGRESS!]"
- [lpvs]
-(let  [curcat1 (atom "")
-      curcat2 (atom "")
-      curcat3 (atom "")
-       ]
- [:table
-(for [lpv lpvs]
- (let [catmap (zipmap [:cat1 :cat2 :cat3] (split lpv #","))
-       ;;nextmap (zipmap [:cat1 :cat2 :cat3] (split (first (rest lpvs)) #","))
-       ]
-   (if (= (:cat1 catmap) @curcat1)
-
-     (if (= (:cat2 catmap) @curcat2)
-       ;;(reset! curcat3 (str @curcat3 " " (:cat3 catmap)))
-       [:td (:cat3 catmap)]
-       (do [:tr [:td] [:td @curcat2][:td @curcat3]]
-          (reset! curcat2 (:cat2 catmap))
-          (reset! curcat3 (:cat3 catmap))
-           ))
-
-     (do (reset! curcat1 (:cat1 catmap))
-         (reset! curcat2 (:cat2 catmap))
-         [:tr [:td @curcat1][:td @curcat2][:td (:cat3 catmap)]]
-         ))))]))
-
-(defn csv2table-4
-"Takes sorted 3-col csv list and outputs html table with empty [:td]  for repeated col1 and vec of col3 vals for repeated col2. [IN PROGRESS!]"
-[lpvs]
-(let  [curcat1 (atom "")
-      curcat2 (atom "")
-      curcat3 (atom [])
-       ]
- [:table
-(for [lpv lpvs]
- (let [catmap (zipmap [:cat1 :cat2 :cat3] (split lpv #","))
-       ]
-   (if (= (:cat1 catmap) @curcat1)
-
-     (if (= (:cat2 catmap) @curcat2)
-       (swap! curcat3 conj (:cat3 catmap))
-       (do [:tr [:td] [:td @curcat2][:td @curcat3]]
-           (reset! curcat2 (:cat2 catmap))
-           (reset! curcat3 [])
-           (swap! curcat3 conj (:cat3 catmap))))
-
-    (if (= @curcat1 "")
-     (do (reset! curcat1 (:cat1 catmap))
-         (reset! curcat2 (:cat2 catmap))
-         (swap! curcat3 conj (:cat3 catmap)))
-     (do [:tr [:td @curcat1][:td @curcat2][:td @curcat3]]
-         (reset! curcat1 (:cat1 catmap))
-         (reset! curcat2 (:cat2 catmap))
-         (swap! curcat3 conj (:cat3 catmap)))
-     ))))]))
-
-
 ;; try (while) --
 ;; cf. "(while (pos? @a) (do (println @a) (swap! a dec)))"

@@ -205,8 +102,8 @@
                             {:query-params
                              {"query" query-sparql ;;generated sparql
                               ;;"format" "application/sparql-results+json"}})]
-                              "format" "text"}})
-                              ;;"format" "csv"}})
+                              ;;"format" "text"}})
+                              "format" "csv"}})
               ;;reqvec (csv/parse-csv req)
               reqvec (split (:body req) #"\n")
               header (first reqvec)
@@ -215,7 +112,7 @@
               ]
           (log/info "sparql result status: " (:status req))
           [:div
-          [:pre (:body req)]
+          ;;[:pre (:body req)]
            [:p header]
            [:hr]
            ;;[:pre reqvec]


add hack for back button on attachments index

--- src/clj_money/web/attachments.clj
+++ src/clj_money/web/attachments.clj
@@ -13,6 +13,7 @@
             [clj-money.pagination :as pagination]
             [clj-money.validation :as validation]
             [clj-money.models.images :as images]
+            [clj-money.models.transactions :as transactions]
             [clj-money.models.attachments :as attachments])
   (:use [clj-money.web.shared :refer :all]))

@@ -34,9 +35,11 @@

 (defn index
   [{{transaction-id :transaction-id} :params}]
-  (let [attachments (attachments/search
+  (let [transaction (transactions/find-by-id (env :db)
+                                             (Integer. transaction-id))
+        attachments (attachments/search
                       (env :db)
-                      {:transaction-id (Integer. transaction-id)})]
+                      {:transaction-id (:id transaction)})]
     (with-layout "Attachments" {}
       [:div.row
        [:div.col-md-4
@@ -46,7 +49,13 @@
           [:th " "]]
          (map attachment-row attachments)]]]
       [:a.btn.btn-primary {:href (format "/transactions/%s/attachments/new" transaction-id)}
-       "Add"])))
+       "Add"]
+      " "
+      ; TODO Fix this hack, we need to know the correct account to go back to
+      [:a.btn.btn-default
+       {:href (format "/accounts/%s"
+                      (-> transaction :items first :account-id))}
+       "Back"])))

 (defn new-attachment
   ([{{transaction-id :transaction-id} :params :as req}]


add delete commodity UI

add delete commodity UI

--- src/clj_money/web/commodities.clj
+++ src/clj_money/web/commodities.clj
@@ -14,11 +14,19 @@
    [:td (:name commodity)]
    [:td (:exchange commodity)]
    [:td
-    (glyph-button :pencil
-                  (format "/commodities/%s/edit" (:id commodity))
-                  {:level :info
-                   :size :extra-small
-                   :title "Click here to edit this commodity"})]])
+    [:div.btn-group
+     (glyph-button :pencil
+                   (format "/commodities/%s/edit" (:id commodity))
+                   {:level :info
+                    :size :extra-small
+                    :title "Click here to edit this commodity"})
+     (glyph-button :remove
+                   (format "/commodities/%s/delete" (:id commodity))
+                   {:level :danger
+                    :size :extra-small
+                    :data-method :post
+                    :data-confirm "Are you sure you want to delete this account?"
+                    :title "Click here to remove this commodity"})]]])

 (defn index
   [{params :params}]
@@ -106,5 +114,7 @@
       (redirect (format "/entities/%s/commodities" (:entity-id result))))))

 (defn delete
-  [req]
-  "delete")
+  [{params :params}]
+  (let [commodity (commodities/find-by-id (env :db) (Integer. (:id params)))]
+    (commodities/delete (env :db) (:id commodity))
+    (redirect (format "/entities/%s/commodities" (:entity-id commodity)))))


tutorial says use defonce not def

tutorial says use defonce not def

--- src/cljs/apollo/client/state.cljs
+++ src/cljs/apollo/client/state.cljs
@@ -1,7 +1,7 @@
 (ns apollo.client.state
   (:require [om.core :as om :include-macros true]))

-(def app-state (atom {:now-playing []
+(defonce app-state (atom {:now-playing []
                       :player {:current-playlist []}
                       :sub-view-mode [:now-playing]
                       :post-filter {:value nil}}))


Formatting

Formatting

--- src/cljs/asciinema_player/vt.cljs
+++ src/cljs/asciinema_player/vt.cljs
@@ -808,7 +808,8 @@

 (defn feed-one [{{old-state :state} :parser :as vt} input]
   (let [[new-state actions] (parse old-state input)]
-    (-> vt (assoc-in [:parser :state] new-state)
+    (-> vt
+        (assoc-in [:parser :state] new-state)
         (execute-actions actions input))))

 (defn feed [vt inputs]


Perform deploy action

Perform deploy action

--- src/cljs/battle_console/game.cljs
+++ src/cljs/battle_console/game.cljs
@@ -1,6 +1,6 @@
 (ns battle-console.game
   (:require [battle-console.state :as state]
-            [ajax.core :refer [GET POST]]
+            [ajax.core :refer [GET POST, PUT]]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
             [cljs.reader :as reader]
@@ -38,6 +38,7 @@
   (let [token (state/get-state :token)
         url (str "http://api.orionsbelt.eu/game/" (params :id) "?token=" token)]
     (state/set-state :loading-game (str "Loading game " (params :id) "..."))
+    (state/set-state :game-id (params :id))
     (GET url {:handler game-loaded
               :error-handler error-loading})))

@@ -62,10 +63,7 @@
 (defn- get-stash
   "Gets the current stash"
   [game]
-  (println game)
-  (if (empty? (get-in game ["battle" "stash" "p1"]))
-    (get-in game ["battle" "stash" "p2"])
-    (get-in game ["battle" "stash" "p1"])))
+  (get-in game ["battle" "stash" (get-in game ["viewed-by" "player-code"])]))

 (defn- game-stash
   "Shows the current stash if available"
@@ -190,6 +188,21 @@
   "Error loading action"
   []
   (state/set-state :processing-action nil))
+
+(defn- deploy-game
+  "Deploys a game"
+  [ev]
+  (let [actions (or (state/get-state :current-actions) [])
+        game (state/get-state :original-game-data)
+        player-code (get-in game ["viewed-by" "player-code"])
+        token (state/get-state :token)
+        game-id (state/get-state :game-id)
+        url (str "http://api.orionsbelt.eu/game/" game-id "/deploy?token=" token)]
+    (state/set-state :processing-action actions)
+    (PUT url {:params {:actions actions}
+              :format :json
+              :handler action-added
+              :error-handler error-loading-action})))

 (defn- add-action
   "Processes a new action"
@@ -236,7 +249,7 @@
     (dom/input #js {:type "text" :id "newAction" :className "form-control"})
     (dom/button #js {:id "resetActionButton" :onClick reset-actions :className "btn btn-default"} "Reset")
     (dom/button #js {:id "addActionButton" :onClick add-action :className "btn btn-info" :disabled (add-action-disabled state)} "Add")
-    (dom/button #js {:id "deployButton" :onClick add-action :className "btn btn-info" :disabled (deploy-disabled state)} "Deploy")))
+    (dom/button #js {:id "deployButton" :onClick deploy-game :className "btn btn-info" :disabled (deploy-disabled state)} "Deploy")))

 (defn- render-game
   "Renders the index page"


Add breadcrumb logic

Add breadcrumb logic

--- src/cljs/elevent_client/core.cljs
+++ src/cljs/elevent_client/core.cljs
@@ -1,6 +1,7 @@
 (ns elevent-client.core
     (:require
-      [clojure.set :refer [difference]]
+      [clojure.set :as set]
+      [clojure.string :as str]

       [goog.crypt.base64 :as b64]
       [goog.events :as events]
@@ -138,13 +139,13 @@
          events-explore-page
          event-page
          event-edit-page
+         event-register-page
          event-activities-page
          event-activities-explore-page
          event-activity-page
          event-activity-edit-page
          event-attendees-page
          event-attendee-page
-         event-register-page
          organizations-page
          organizations-explore-page
          organization-page
@@ -181,6 +182,10 @@
   "/events/:EventId/edit" [EventId]
   (reset! current-page [#'event-edit-page (int EventId)]))

+(defroute event-register-route
+  "/events/:EventId/register" [EventId]
+  (reset! current-page [#'event-register-page (int EventId)]))
+
 (defroute event-activities-route
   "/events/:EventId/activities" [EventId]
   (reset! current-page [#'event-activities-page (int EventId)]))
@@ -209,10 +214,6 @@
 (defroute event-attendee-route
   "/events/:EventId/attendees/:AttendeeId" [EventId AttendeeId]
   (reset! current-page [#'event-attendee-page (int EventId) (int AttendeeId)]))
-
-(defroute event-register-route
-  "/events/:EventId/register" [EventId]
-  (reset! current-page [#'event-register-page (int EventId)]))

 (defroute organizations-route
   "/organizations" []
@@ -383,15 +384,122 @@
        "Sign up"]])])

 (defn breadcrumbs-component []
-  [:div.sixteen.wide.column
-   [:div.ui.breadcrumb
-    #_(interpose [:div.divider "/"]
-                 (map (fn [[name hash]]
-                        (if (= hash @location)
-                          [:div.active.section name]
-                          [:a.section {:href hash} name]))
-                      (cons ["Home" (home-route)]
-                            (:breadcrumbs @session))))]])
+  (let [breadcrumber
+        (fn breadcrumber [lambda]
+          (fn
+            ([results _] results)
+            ([results env fragment]
+             (let [[result env continuation] (lambda env fragment)]
+               (partial (breadcrumber continuation)
+                        (conj results result)
+                        env)))))
+
+        event-activity-breadcrumbs
+        (fn [env _]
+          [["Edit" (event-activity-edit-route env)] env nil])
+
+        event-activities-breadcrumbs
+        (fn [env fragment]
+          (case fragment
+            "explore" [["Explore" (event-activities-explore-route env)] env nil]
+            "add" [["Add" (event-activity-add-route env)] env nil]
+            (let [env (assoc env :ActivityId fragment)]
+              [[(:Name (d/entity @activities-db (int fragment)))
+                (event-activity-route env)]
+               env
+               event-activity-breadcrumbs])))
+
+        event-attendees-breadcrumbs
+        (fn [env fragment]
+          (let [env (assoc env :AttendeeId fragment)
+                entity (d/entity @attendees-db (int fragment))]
+            [[(str (:FirstName entity) (:LastName entity))
+              env
+              event-attendee-route]]))
+
+        event-breadcrumbs
+        (fn [env fragment]
+          (case fragment
+            "edit" [["Edit" (event-edit-route env)] env nil]
+            "register" [["Register" (event-register-route env)] env nil]
+            "activities" [["Activities" (event-activities-route env)]
+                          env
+                          event-activities-breadcrumbs]
+            "attendees" [["Attendees" (event-attendees-route env)]
+                         env
+                         event-attendees-breadcrumbs]))
+
+        events-breadcrumbs
+        (fn [env fragment]
+          (case fragment
+            "explore" [["Explore" (events-explore-route)] env nil]
+            "add" [["Add" (event-add-route)] env nil]
+            (let [env (assoc env :EventId fragment)]
+              [[(:Name (d/entity @events-db (int fragment))) (event-route env)]
+               env
+               event-breadcrumbs])))
+
+        organization-breadcrumbs
+        (fn [env _]
+          [["Edit" (organization-edit-route env)] env nil])
+
+        organizations-breadcrumbs
+        (fn [env fragment]
+          (case fragment
+            "explore" [["Explore" (organizations-explore-route)] env nil]
+            "add" [["Add" (organization-add-route)] env nil]
+            (let [env (assoc env :OrganizationId fragment)]
+              [[(:Name (d/entity @organizations-db (int fragment)))
+                (organization-route env)]
+               env
+               organization-breadcrumbs])))
+
+        top-breadcrumbs
+        (fn [env fragment]
+          (case fragment
+            "events" [["Events" (events-route)] env events-breadcrumbs]
+            "organizations" [["Organizations" (organization-route)]
+                             env
+                             organizations-breadcrumbs]
+            "statistics" [["Statistics" (statistics-route)] env nil]
+            "sign-in" [["Sign in" (sign-in-route)] env nil]
+            "sign-up" [["Sign up" (sign-up-route)] env nil]))
+
+        get-breadcrumbs
+        (fn
+          ([] [["Home" (home-route)]])
+          ([fragment]
+           ((breadcrumber
+              (fn [env _] [["Home" (home-route)] env top-breadcrumbs]))
+            []
+            {}
+            fragment)))
+
+        breadcrumbs
+        ((reduce #(%1 %2) get-breadcrumbs (str/split @location #"/")))]
+    [:div.sixteen.wide.column
+     [:div.ui.breadcrumb
+      (map-indexed (fn [index [name hash]]
+                     (condp = index
+                       0
+                       (if (= (count breadcrumbs) 1)
+                         ^{:key (str "only-" hash)}
+                         [:div.active.section name]
+
+                         ^{:key (str "first-" hash)}
+                         [:a.section {:href hash} name])
+
+                       (dec (count breadcrumbs))
+                       ^{:key (str "last-" hash)}
+                       [:span
+                        [:div.divider "/"]
+                        [:div.active.section name]]
+
+                       ^{:key hash}
+                       [:span
+                        [:div.divider "/"]
+                        [:a.section {:href hash} name]]))
+                   breadcrumbs)]]))

 (defn messages-component []
   (when-let [messages* (seq @messages)]
@@ -481,11 +589,11 @@
                               @events-db
                               @attendees-db
                               (get-in @session [:user :UserId]))
-        unattending-events (difference (into #{}
-                                             (d/q '[:find [?event-id ...]
-                                                    :where [?event-id]]
-                                                  @events-db))
-                                       (into #{} attending-events))]
+        unattending-events (set/difference (into #{}
+                                                 (d/q '[:find [?event-id ...]
+                                                        :where [?event-id]]
+                                                      @events-db))
+                                           (into #{} attending-events))]
     [:div.sixteen.wide.column
      [:div.ui.segment
       [:div
@@ -629,7 +737,7 @@

             errors
             (validator @form)
-
+
             register
             (fn [form]
               (attendees-endpoint :create


Changes play-zone to new Temporary Zone visible to all, with card backs if not for the player.

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -492,6 +492,22 @@
                          [:div (om/build card-view card)]])
                       cards)])))))

+(defn play-area-view [{:keys [name player] :as cursor}]
+  (om/component
+   (sab/html
+    (let [cards (:play-area player)
+          size (count cards)
+          side (get-in player [:identity :side])]
+      (when-not (empty? cards)
+        [:div.panel.blue-shade.rfg {:class (when (> size 2) "squeeze")}
+         (om/build label cards {:opts {:name name}})
+         (map-indexed (fn [i card]
+                        [:div.card-wrapper {:style {:left (* (/ 128 size) i)}}
+                         (if (= (:user player) (:user @app-state))
+                           (om/build card-view card)
+                           [:img.card {:src (str "/img/" (.toLowerCase side) ".png")}])])
+                      cards)])))))
+
 (defn scored-view [{:keys [scored] :as cursor}]
   (om/component
    (sab/html
@@ -660,7 +676,8 @@
                [:div
                 (om/build rfg-view {:cards (:rfg opponent) :name "Removed from the game"})
                 (om/build rfg-view {:cards (:rfg me) :name "Removed from the game"})
-                (when (not-spectator? game-state app-state) (om/build rfg-view {:cards (:play-area me)}))
+                (om/build play-area-view {:player opponent :name "Temporary Zone"})
+                (om/build play-area-view {:player me :name "Temporary Zone"})
                 (om/build rfg-view {:cards (:current opponent) :name "Current"})
                 (om/build rfg-view {:cards (:current me) :name "Current"})]
                (when-not (= side :spectator)


remove useless help attribute

remove useless help attribute

--- src/cljs/triboard/logic/turn.cljs
+++ src/cljs/triboard/logic/turn.cljs
@@ -48,7 +48,6 @@
   (-> {:board (board/new-board)
        :player (rand-nth cst/players)
        :moves {}
-       :help false
        :scores scores/initial-scores}
     with-available-moves))


Keep focus on text area after buttons are pressed

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -127,17 +127,20 @@
   [& _]
   (when-let [text-area (get-selected-text-area)]
     (.undoLastAction text-area)
+    (s/request-focus! text-area)
     (update-buttons! (get-selected-editor) text-area)))

 (defn redo-file!
   [& _]
   (when-let [text-area (get-selected-text-area)]
     (.redoLastAction text-area)
+    (s/request-focus! text-area)
     (update-buttons! (get-selected-editor) text-area)))

 (defn set-font-size!
   [text-area size]
-  (.setFont text-area (-> text-area .getFont (.deriveFont (float size)))))
+  (.setFont text-area (-> text-area .getFont (.deriveFont (float size))))
+  (s/request-focus! text-area))

 (defn save-font-size!
   [size]
@@ -161,14 +164,17 @@

 (defn toggle-paredit!
   [& _]
-  (reset! paredit-enabled? (not @paredit-enabled?)))
+  (reset! paredit-enabled? (not @paredit-enabled?))
+  (some-> (get-selected-text-area) s/request-focus!))

 (defn toggle-doc!
   [& _]
-  (reset! completions/doc-enabled? (not @completions/doc-enabled?)))
+  (reset! completions/doc-enabled? (not @completions/doc-enabled?))
+  (some-> (get-selected-text-area) s/request-focus!))

 (defn show-paredit-help!
   [& _]
+  (some-> (get-selected-text-area) s/request-focus!)
   (let [commands (->> pw/advanced-keymap
                       (apply concat)
                       (apply sorted-map-by #(compare %1 %2)))


Fix error with named services when fetching one service.

--- src/clojure/staircase/handler.clj
+++ src/clojure/staircase/handler.clj
@@ -251,12 +251,11 @@
                             (let [ident (real-id ident)
                                   uri (get-in config [:services ident])
                                   user-services (get-where services [:= :root uri])
-                                  service (-> (full-outer-join [{:root uri :name ident}]
+                                  service (-> (full-outer-join [{:root uri :confname ident}]
                                                               user-services
-                                                              :root
                                                               :root)
                                               first)]
-                              (response (ensure-token service)))))
+                              (response (ensure-name (ensure-token service))))))
                     (PUT "/" {doc :body}
                          (locking services
                             (let [uri (or (get doc "root") (get-in config [:services (real-id ident)]))


[#455] Catch proper exception

[#455] Catch proper exception

--- backend/src/akvo/lumen/component/keycloak.clj
+++ backend/src/akvo/lumen/component/keycloak.clj
@@ -71,7 +71,7 @@
           response-filter ["admin" "email" "firstName" "id" "lastName"
                            "username"]]
       (response (map #(select-keys % response-filter) members)))
-    (catch ExceptionInfo e
+    (catch clojure.lang.ExceptionInfo e
       (let [ed (ex-data e)]
         (response {:status (:status ed)
                    :body (:reasonPhrase ed)})))))


Handle System.exit()

Handle System.exit()

--- src/cljakstab/core.clj
+++ src/cljakstab/core.clj
@@ -14,18 +14,36 @@
   [opts]
   (set! org.jakstab.Options/mainFilename (:mainFile opts)))

+(defn security-manager-proxy []
+  (proxy
+      [java.lang.SecurityManager] []
+    (checkPermission [perm]
+      (if (not (= "setSecurityManager" (.getName ^java.security.Permission perm)))
+        ;(proxy-super checkPermission perm)
+        nil))
+    (checkExit [code#]
+      (throw
+       (java.lang.SecurityException.
+        (str "catched exit with code " code#))))))
+
+(defmacro disable-system-exit [& exprs]
+  `(let [old-mgr# (java.lang.System/getSecurityManager)
+         new-mgr# (security-manager-proxy)]
+     (try
+       (do
+         (java.lang.System/setSecurityManager new-mgr#)
+         ~@exprs)
+       (finally (java.lang.System/setSecurityManager old-mgr#)))))

 (defn find-jumps
   "find unresolved jumps in specified binary"
   [binary-file]
   (init-options {:mainFile binary-file})
-  (let [arch (org.jakstab.ssl.Architecture. (.getValue org.jakstab.Options/sslFilename))
-        program (org.jakstab.Program/createProgram arch)
-        file (.getAbsoluteFile (java.io.File. binary-file))]
-    (.loadMainModule program file)
-    (.installHarness program (org.jakstab.loader.DefaultHarness.))
-    (try
-      (let [cfr (org.jakstab.analysis.ControlFlowReconstruction. program)]
-        (.run cfr)))))
-
-
+  (disable-system-exit
+   (let [arch (org.jakstab.ssl.Architecture. (.getValue org.jakstab.Options/sslFilename))
+         program (org.jakstab.Program/createProgram arch)
+         file (.getAbsoluteFile (java.io.File. binary-file))]
+     (.loadMainModule program file)
+     (.installHarness program (org.jakstab.loader.DefaultHarness.))
+     (let [cfr (org.jakstab.analysis.ControlFlowReconstruction. program)]
+       (.run cfr)))))


Add median fn.

Add median fn.

--- src/cljx/c2/maths.cljx
+++ src/cljx/c2/maths.cljx
@@ -41,11 +41,24 @@
   [(apply min xs)
    (apply max xs)])

+
+;;TODO: replace mean and median with smarter algorithms for better performance.
 (defn mean
   "Arithemetic mean of collection"
   [xs]
   (/ (reduce + xs)
      (count xs)))
+
+(defn median
+  "Median of a collection."
+  [xs]
+  (let [sorted (sort xs)
+        n (count xs)]
+    (if (odd? n)
+      (nth sorted (/ (inc n) 2))
+      (let [mid (/ n 2)]
+        (mean [(nth sorted (floor mid))
+               (nth sorted (ceil mid))])))))

 (defn irange
   "Inclusive range; same as core/range, but includes the end."


Fixed divide-by-zero error in certain situations in Tag Cloud.

--- lambda-blog/src/lambda_blog/templates/tags.clj
+++ lambda-blog/src/lambda_blog/templates/tags.clj
@@ -17,10 +17,13 @@
                                count
                                ;; NOTE Since tags only appear in the list if there's at least one entry
                                ;; NOTE tagged with them, we need to subtract 1 from the count in order
-                               ;; NOTE to span the entire [min-size; max-size] range.
+                               ;; NOTE to span the entire [`min-size`; `max-size`] range.
                                (+ -1)
                                (vector %))))
-        total (apply max (map second counts))]
+        ;; NOTE `total` needs to be at least 1 not to divide by 0.
+        ;; NOTE This means that when all tags have a count of 0 they'll appear
+        ;; NOTE in the tag cloud with `min-size` size instead of `max-size`.
+        total (apply max 1 (map second counts))]
     (text-centered
      (ul {:class :list-inline}
          (map (fn [[t c]]


Prettify screen layouts

Prettify screen layouts

--- client/src/cljs/receipts_client/views.cljs
+++ client/src/cljs/receipts_client/views.cljs
@@ -17,6 +17,14 @@

 ;; home

+(def tight-gap "0.2rem")
+(def std-gap "0.5rem")
+(def title-gap "0.5rem")
+(def title-width "7em")
+(def tiny-field-width "5rem")
+(def tight-field-width "11rem")
+(def field-width "14rem")
+
 (defn app-title []
   (let [name (re-frame/subscribe [:name])
         server (re-frame/subscribe [:server])]
@@ -49,10 +57,10 @@
   (fn [label error component]
     [re-com/h-box
      :width "100%"
-     :gap "1rem"
+     :gap std-gap
      :children [[re-com/label
                  :class (if error "errmsg" "")
-                 :width "8rem"
+                 :width title-width
                  :label (str label (if (str/blank? label) "" ": "))]
                 [re-com/v-box :children [component
                                          (when error
@@ -78,7 +86,7 @@
         date-atom (reagent/atom date)
         time-atom (reagent/atom time)]
     [re-com/h-box
-     :gap "0.2rem"
+     :gap tight-gap
      :align :center
      :children [(when show-multi-year?
                   [re-com/button
@@ -116,7 +124,7 @@
   (let [current-receipt (re-frame/subscribe [:current-receipt])
         schema (re-frame/subscribe [subs-key])]
     [(if multiple? re-com/selection-list re-com/single-dropdown)
-     :width "15rem"
+     :width field-width
      :model ((if multiple? (partial into #{}) identity)
              (field-key @current-receipt))
      :choices (sort-by :label (mapv (fn [{id schema-id-key
@@ -133,17 +141,17 @@
         password (reagent/atom "")]
     (fn []
       [re-com/v-box
-       :gap "0.5rem"
+       :gap title-gap
        :children [(panel-title "Login")
                   [labelled "Email" nil
                    [re-com/input-text
-                    :width "15rem"
+                    :width field-width
                     :model email
                     :on-change #(reset! email %)
                     :attr {:type "Email"}]]
                   [labelled "Password" nil
                    [re-com/input-text
-                    :width "15rem"
+                    :width field-width
                     :model password
                     :on-change #(reset! password %)
                     :attr {:type "Password"}]]
@@ -172,7 +180,7 @@
     (fn []
       (let [validation-errors (first (validate-receipt @current-receipt))]
         [re-com/v-box
-         :gap "0.2rem"
+         :gap tight-gap
          :children
          [[labelled "Paid by"
            (:purchase/paymentMethod validation-errors)
@@ -188,7 +196,7 @@
           [labelled "Price"
            (:purchase/price validation-errors)
            [re-com/input-text
-            :width "15rem"
+            :width field-width
             :model (or (:purchase/price @current-receipt) "0.00")
             :on-change #(re-frame/dispatch [:edit-current-receipt :purchase/price %])
             :attr {:type "number"
@@ -209,7 +217,7 @@
           [labelled "Comment"
            (:purchase/comment validation-errors)
            [re-com/input-text
-            :width "15rem"
+            :width field-width
             :model (or (:purchase/comment @current-receipt) "")
             :on-change #(re-frame/dispatch [:edit-current-receipt :purchase/comment %])
             :attr {:type "text"}]]
@@ -221,7 +229,7 @@
             :filter-fn :user/isConsumer
             :schema-label-key :user/name
             :schema-id-key :user/abbrev]]
-          [re-com/gap :size "0.5rem"]
+          [re-com/gap :size std-gap]
           [re-com/h-box
            :children
            [[re-com/button
@@ -234,7 +242,7 @@
     (fn []
       (if (:user/isEditor @user)
         [re-com/v-box
-         :gap "1rem"
+         :gap title-gap
          :children [(panel-title "New Receipt")
                     [receipt-page]]]
         [login-panel]))))
@@ -246,31 +254,31 @@
                         (-> @new-user :permissions :user/isEditor))
             consumer? (-> @new-user :permissions :user/isConsumer)]
         [re-com/v-box
-         :gap "0.5rem"
+         :gap std-gap
          :children [[labelled "Name" nil
                      [re-com/input-text
-                      :width "15rem"
+                      :width field-width
                       :model (or (:name @new-user) "")
                       :on-change #(swap! new-user assoc :name %)
                       :attr {:type "text"}]]
                     (when editor?
                       [labelled "Password" nil
                        [re-com/input-text
-                        :width "15rem"
+                        :width field-width
                         :model (or (:password @new-user) "")
                         :on-change #(swap! new-user assoc :password %)
                         :attr {:type "password"}]])
                     (when consumer?
                       [labelled "Abbrev" nil
                        [re-com/input-text
-                        :width "15rem"
+                        :width field-width
                         :model (or (:abbrev @new-user) "")
                         :on-change #(swap! new-user assoc :abbrev %)
                         :attr {:type "text"}]])
                     (when editor?
                       [labelled "Email" nil
                        [re-com/input-text
-                        :width "15rem"
+                        :width field-width
                         :model (or (:email @new-user) "")
                         :on-change #(swap! new-user assoc :email %)
                         :attr {:type "Email"}]])
@@ -297,10 +305,10 @@
         vendor (reagent/atom "")]
     (fn []
       [re-com/v-box
-       :gap "0.5rem"
+       :gap std-gap
        :children [[labelled "Category" nil
                    [re-com/single-dropdown
-                    :width "12rem"
+                    :width field-width
                     :choices categories
                     :id-fn :db/id
                     :label-fn :category/name
@@ -310,7 +318,7 @@
                    [re-com/input-text
                     :model vendor
                     :on-change #(reset! vendor %)
-                    :width "12rem"]]
+                    :width field-width]]
                   [button #(do (re-frame/dispatch [:add-vendor @category @vendor])
                                (reset! vendor ""))
                    "Add Vendor" "Create a new vendor"]]])))
@@ -329,16 +337,16 @@
       (if @user
         (let [admin? (:user/isAdmin @user)]
           [re-com/v-box
-           :gap "1rem"
+           :gap title-gap
            :children [[panel-title "Schema Editor"]
-                      [labelled "Schema change" nil
+                      [labelled "Action" nil
                        [re-com/h-box
-                        :gap "0.5rem"
-                        :children [[re-com/single-dropdown :width  "5rem"
+                        :gap std-gap
+                        :children [[re-com/single-dropdown :width tiny-field-width
                                     :choices actions
                                     :model action
                                     :on-change #(reset! action %)]
-                                   [re-com/single-dropdown :width "11rem"
+                                   [re-com/single-dropdown :width tight-field-width
                                     :choices entities
                                     :model entity
                                     :on-change #(reset! entity %)]]]]
@@ -358,7 +366,7 @@
   (let [about-server (re-frame/subscribe [:about-server])]
     (fn []
       [re-com/v-box
-       :gap "1rem"
+       :gap title-gap
        :children [(panel-title "About")
                   [:div
                    [:p "Third iteration of a simple receipts management program."]
@@ -436,9 +444,11 @@
               editor? (:user/isEditor @user)
               admin? (:user/isAdmin @user)]
           [re-com/v-box
-           :gap "1rem"
+           :gap title-gap
            :children [(panel-title "History")
-                      [history-table @history]
+                      [re-com/scroller
+                       :scroll :auto
+                       :child [history-table @history]]
                       (when admin?
                         [history-csv @csv])
                       [re-com/h-box
@@ -467,28 +477,28 @@
             editor? (:user/isEditor @user)
             admin? (:user/isAdmin @user)]
         [re-com/v-box
-         :gap "1rem"
+         :gap title-gap
          :children [(panel-title "Setup")
                     [re-com/h-box
-                     :gap "1rem"
+                     :gap std-gap
                      :children [[:span (str "Logged in as " (or email "[UNKNOWN USER]"))]
                                 [button [:logout] "Logout" "Logout from server"]]]
                     (section-title "Developer tools")
                     (if admin?
                       [re-com/h-box
-                                  :gap "1rem"
-                                  :children [[re-com/v-box
-                                              :children [[re-com/label :label "Server cold init:"]
-                                                         (button [:preload-base]
-                                                                 "Preload database"
-                                                                 "Install initial DB (you should not need this)")]]
-                                             [re-com/v-box
-                                              :children [[re-com/label :label "Choose server:"]
-                                                         [re-com/single-dropdown :choices [{:id :production :label "production"}
-                                                                                {:id :development :label "development"}]
-                                                          :width "12rem"
-                                                          :model @server
-                                                          :on-change #(re-frame/dispatch [:set-server %])]]]]]
+                       :gap std-gap
+                       :children [[re-com/v-box
+                                   :children [[re-com/label :label "Server cold init:"]
+                                              (button [:preload-base]
+                                                      "Preload database"
+                                                      "Install initial DB (you should not need this)")]]
+                                  [re-com/v-box
+                                   :children [[re-com/label :label "Choose server:"]
+                                              [re-com/single-dropdown :choices [{:id :production :label "production"}
+                                                                                {:id :development :label "development"}]
+                                               :width tight-field-width
+                                               :model @server
+                                               :on-change #(re-frame/dispatch [:set-server %])]]]]]
                       [unavailable])
                     (section-title "Schema")
                     (re-com/checkbox
@@ -509,11 +519,11 @@

 (defn wrap-page [page]
   [re-com/border
-   :width "90vw"
+   :width "98vw"
    :margin "1vmin"
    :border "0.2vmin solid lightgrey"
-   :padding "1rem"
-   :child page])
+   :padding "2vmin"
+   :child [re-com/scroller :scroll :auto :child page]])

 (def tabs [{:id :home    :label "receipt"   :panel (wrap-page [home-panel])}
            {:id :edit    :label "edit"      :panel (wrap-page [edit-panel])}


Fixed bug with single params showing up as vector

--- src/compojure/http.clj
+++ src/compojure/http.clj
@@ -114,7 +114,7 @@
   "Parse a key and value to make them more Clojure-friendly."
   [key val]
   [(keyword key)
-   (if (rest val) val [(first val)])])
+   (if (rest val) val (first val))])

 (defn get-params
   "Creates a name/value map of all the request parameters."


adding time to model and Data UI

adding time to model and Data UI

--- sr-client/app/src/sr_client/behavior.clj
+++ sr-client/app/src/sr_client/behavior.clj
@@ -24,17 +24,24 @@
 (defn merge-players [_ {:keys [me others]}]
   (assoc others "Me" me))

+(defn inc-transform [old_value _]
+  ((fnil inc 0) old_value))
+
 (defn init-main [_]
   [[:transform-enable [:main :my-car :gear]
-    :shift-gear [{msg/topic [:my-car :gear]}]]])
+    :shift-gear [{msg/topic [:my-car :gear]}]]
+   [:transform-enable [:time]
+    :heartbeat [{msg/topic [:time]}]]])

 (def sr-half-mile-app
   {:version 2
    :transform [[:shift-gear [:my-car :gear] shift-gear-transform]
                [:swap [:**] swap-transform]
+               [:heartbeat [:time] inc-transform]
                [:debug [:pedestal :**] swap-transform]]
    :emit [{:init init-main}
           [#{[:my-car :gear]
+             [:time]
              [:other-players :*]
              [:total-count]
              [:total-gears]} (app/default-emitter [:main])]


more react keys

more react keys

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -1152,7 +1152,8 @@
                      {:onContextMenu (fn [e]
                                        (.preventDefault e)
                                        (.stopPropagation e))
-                      :tabIndex 1}
+                      :tabIndex 1
+                      :key "canvas"}
                      (when (needs-copy-paste-hack?)
                        ;; gives focus to our copy/paste element, so that we can copy
                        {:onKeyDown #(do (utils/swallow-errors
@@ -1163,8 +1164,8 @@
                                                (gforms/focusAndSelect hack-node)))))
                                         true)}))
         (when (needs-copy-paste-hack?)
-          (om/build copy-paste-hack app))
-        (om/build svg-canvas app)
+          (om/build copy-paste-hack app {:react-key "copy-paste-hack"}))
+        (om/build svg-canvas app {:react-key "svg-canvas"})
         (when (:opened? (:layer-properties-menu app))
           (om/build layer-properties (:layer-properties-menu app)
                     {:react-key "layer-props"}))