Fix up some comments, remove some incorrect ones.

Single ; comments are syntactically correct, but they auto-indent
differently in Emacs clojure-mode.

--- src/clj_ns_browser/browser.clj
+++ src/clj_ns_browser/browser.clj
@@ -607,7 +607,7 @@
       :action (fn [event] (swap! (id :color-coding-cb-atom) not)))
     ;; vars
     (config! (id :vars-entries-lbl) :text "0")
-    ; doc
+    ;; doc
     (config! (id :doc-tf) :text "")
     (config! (id :doc-ta) :text "                                                                        ")
     (selection! (id :ns-cbx) "loaded")
@@ -834,11 +834,11 @@
     ;;
     ;; typed regex in ns-filter-tf => visual feedback about validity
     (b/bind
-      ; As the text of the textbox changes ...
+      ;; As the text of the textbox changes ...
       (id :ns-filter-tf)
-      ; Convert it to a regex, or nil if it's invalid
+      ;; Convert it to a regex, or nil if it's invalid
       (b/transform #(try (re-pattern %) (catch Exception e nil)))
-      ; Now split into two paths ...
+      ;; Now split into two paths ...
       (b/bind
         (b/transform #(if % "white" "lightcoral"))
         (b/notify-soon)
@@ -846,11 +846,11 @@
     ;;
     ;; typed regex in vars-filter-tf => visual feedback about validity
     (b/bind
-      ; As the text of the textbox changes ...
+      ;; As the text of the textbox changes ...
       (id :vars-filter-tf)
-      ; Convert it to a regex, or nil if it's invalid
+      ;; Convert it to a regex, or nil if it's invalid
       (b/transform #(try (re-pattern %) (catch Exception e nil)))
-      ; Now split into two paths ...
+      ;; Now split into two paths ...
       (b/bind
         (b/transform #(if % "white" "lightcoral"))
         (b/notify-soon)
@@ -859,7 +859,7 @@
     ;; updated fqn in doc-tf or doc-cbx =>
     ;; new render-doc-text in doc-ta
     (b/bind
-      ; As the text of the fqn text field changes ...
+      ;; As the text of the fqn text field changes ...
       (apply b/funnel [(id :doc-tf) (id :doc-cbx) vars-lb-refresh-atom])
       (b/filter (fn [[doc-tf doc-cbx]]
                   (not (or (nil? doc-tf)  (= "" doc-tf)
@@ -885,16 +885,16 @@
             (let [type-str (get-object-type fqn)]
               (cond
                 (or (nil? fqn) (= "" fqn)) :white
-                (= type-str "Macro") :tomato ;;macro
-                (= type-str "Function") :lightgreen  ;; function
-                (= type-str "Multimethod") :lightgreen  ;; function
-                (= type-str "Protocol Interface/Function") :lightgreen  ;; function
-                (= type-str "Special Form") :lightsalmon  ;; function
-                (= type-str "Special Symbol") :lightsalmon  ;; function
-                (= type-str "Protocol") :lightblue  ;; function
-                (= type-str "Namespace") :blanchedalmond  ;; function
-                (= type-str "Class") :wheat  ;; function
-                (= type-str "java.lang.Class") :wheat  ;; function
+                (= type-str "Macro") :tomato
+                (= type-str "Function") :lightgreen
+                (= type-str "Multimethod") :lightgreen
+                (= type-str "Protocol Interface/Function") :lightgreen
+                (= type-str "Special Form") :lightsalmon
+                (= type-str "Special Symbol") :lightsalmon
+                (= type-str "Protocol") :lightblue
+                (= type-str "Namespace") :blanchedalmond
+                (= type-str "Class") :wheat
+                (= type-str "java.lang.Class") :wheat
                 true :white))
             :white))))
       (b/property (id :doc-tf) :background))
@@ -925,7 +925,7 @@
                   false))))
       (b/notify-soon)
       (b/property (id :edit-btn) :enabled?))
-    ;
+    ;;
     ;; browser-btn pressed =>
     ;;
     (b/bind
@@ -964,10 +964,10 @@
           (when-let [m (meta-when-file (config (id :doc-tf) :text))]
             (when-let [e (:out (clojure.java.shell/sh "bash" "-c" (str "echo -n $EDITOR")))]
               (:exit (clojure.java.shell/sh "bash" "-c" (str e " +" (:line m) " " (:file m))))))))))
-    ;
-    ; menu buttons
-    ;;
-    ; use local copy for clojuredocs lookup of comments/examples
+    ;;
+    ;; menu buttons
+    ;;
+    ;; use local copy for clojuredocs lookup of comments/examples
     (b/bind
       (b/funnel
         (id :clojuredocs-offline-rb-atom)
@@ -986,7 +986,7 @@
         (update-settings! {:clojuredocs-online
                            (config (id :clojuredocs-online-rb) :selected?)}))))
     ;;
-    ; update locally cached clojuredocs repo
+    ;; update locally cached clojuredocs repo
     (b/bind
       (id :update-clojuredocs-btn-atom)
       (b/transform (fn [& o]


Set/Update preview state in less-insane way

--- src/cljs/goya/timemachine.cljs
+++ src/cljs/goya/timemachine.cljs
@@ -18,26 +18,14 @@

 (defn update-preview []
   (reset! previewstate/preview-state
-          (assoc-in @previewstate/preview-state [:main-app :image-data]
-                    (get-in @app/app-state [:main-app :image-data])))
-  (reset! previewstate/preview-state
-          (assoc-in @previewstate/preview-state [:main-app :canvas-width]
-                    (get-in @app/app-state [:main-app :canvas-width])))
-  (reset! previewstate/preview-state
-          (assoc-in @previewstate/preview-state [:main-app :canvas-height]
-                    (get-in @app/app-state [:main-app :canvas-height]))))
+          (assoc-in @previewstate/preview-state [:main-app]
+                    (get-in @app/app-state [:main-app]))))

 (defn show-history-preview [idx]
   (reset! previewstate/preview-state
-          (assoc-in @previewstate/preview-state [:main-app :image-data]
-                    (get-in (nth @app-history idx) [:image-data])))
-  (reset! previewstate/preview-state
-          (assoc-in @previewstate/preview-state [:main-app :canvas-width]
-                    (get-in (nth @app-history idx) [:canvas-width])))
-  (reset! previewstate/preview-state
-          (assoc-in @previewstate/preview-state [:main-app :canvas-height]
-                    (get-in (nth @app-history idx) [:canvas-height]))))
+          (assoc-in @previewstate/preview-state [:main-app]
+                    (nth @app-history idx))))

 (add-watch app/app-state :preview-watcher


better event handling for drag

better event handling for drag

--- src/cljs/smgui/components.cljs
+++ src/cljs/smgui/components.cljs
@@ -40,6 +40,8 @@
             classes (class-set {"dragging" over})]
         (dom/div #js {:className   (str "flex flex-row " classes)
                       :onDragEnter #(update-over true)
+                      :onDragOver  #(update-over true)
                       :onDragLeave #(update-over false)
+                      :onDragEnd   #(update-over false)
                       :onDrop      (pd #(onFiles (read-file-paths %)))}
                  view)))))


Add a require REPL special

Add a require REPL special

--- ClojureScript/planck/src/planck/core.cljs
+++ ClojureScript/planck/src/planck/core.cljs
@@ -7,7 +7,7 @@
             [cljs.analyzer :as ana]
             [cljs.repl :as repl]
             [clojure.string :as s]
-            [cljs.env]
+            [cljs.env :as env]
             [planck.io]))

 (def st (cljs/empty-state))
@@ -28,16 +28,18 @@
 (defn ns-form? [form]
   (and (seq? form) (= 'ns (first form))))

-(def repl-specials '#{in-ns doc})
+(def repl-specials '#{in-ns require doc})

 (defn repl-special? [form]
   (and (seq? form) (repl-specials (first form))))

 (def repl-special-doc-map
-  '{in-ns {:arglists ([name])
-           :doc      "Sets *cljs-ns* to the namespace named by the symbol, creating it if needed."}
-    doc   {:arglists ([name])
-           :doc      "Prints documentation for a var or special form given its name"}})
+  '{in-ns   {:arglists ([name])
+             :doc      "Sets *cljs-ns* to the namespace named by the symbol, creating it if needed."}
+    require {:arglists ([& args])
+             :doc      "Loads libs, skipping any that are already loaded."}
+    doc     {:arglists ([name])
+             :doc      "Prints documentation for a var or special form given its name"}})

 (defn- repl-special-doc [name-symbol]
   (assoc (repl-special-doc-map name-symbol)
@@ -60,7 +62,7 @@
   (print (str @current-ns "=> ")))

 (defn form-full-path [relative-path extension]
-  (str "/Users/mfikes/Projects/planck/ClojureScript/planck/src"
+  (str "/Users/mfikes/Projects/planck/ClojureScript/planck/src/"
     relative-path extension))

 (defn extension->lang [extension]
@@ -70,6 +72,7 @@

 (defn load-and-callback! [path extension cb]
   (let [full-path (form-full-path path extension)]
+    (println "trying to load" full-path (planck.io/slurp full-path))
     (cb {:lang   (extension->lang extension)
          :source (planck.io/slurp full-path)})))

@@ -91,6 +94,19 @@
       {:error     true
        :exception e})))

+(defn require [args]
+  "((quote foo.bar) :reload)"
+  (prn "require" args)
+  (cljs.js/require
+    {:*compiler*     (env/default-compiler-env)
+     :*data-readers* tags/*cljs-data-readers*
+     :*load-fn*      load
+     :*eval-fn*      eval}
+    (second (first args))
+    (second args)
+    (fn [res]
+      (println "require result:" res))))
+
 (defn ^:export read-eval-print [line]
   (binding [ana/*cljs-ns* @current-ns
             *ns* (create-ns @current-ns)
@@ -101,6 +117,7 @@
       (if (repl-special? form)
         (case (first form)
           in-ns (reset! current-ns (second (second form)))
+          require (planck.core/require (rest form))
           doc (if (repl-specials (second form))
                 (repl/print-doc (repl-special-doc (second form)))
                 (repl/print-doc


CMR-3685: Fixed bug in deflating cache wrt booleans

--- common-lib/src/cmr/common/cache/deflating_cache.clj
+++ common-lib/src/cmr/common/cache/deflating_cache.clj
@@ -23,16 +23,18 @@

   (get-value
     [this key]
-    (when-let [value (c/get-value delegate-cache key)]
-      (inflate-fn value)))
+    (let [value (c/get-value delegate-cache key)]
+      (when (not (nil? value))
+        (inflate-fn value))))

   (get-value
     [this key lookup-fn]
-    (when-let [value (c/get-value delegate-cache key
-                                  ;; If we lookup a value then it needs to be deflated for storage
-                                  ;; in the underlying cache.
-                                  (comp deflate-fn lookup-fn))]
-      (inflate-fn value)))
+    (let [value (c/get-value delegate-cache key
+                             ;; If we lookup a value then it needs to be deflated for storage
+                             ;; in the underlying cache.
+                             (comp deflate-fn lookup-fn))]
+      (when (not (nil? value))
+        (inflate-fn value))))

   (reset
     [this]
@@ -40,7 +42,7 @@

   (set-value
     [this key value]
-    (c/set-value delegate-cache key (when value (deflate-fn value)))))
+    (c/set-value delegate-cache key (when (not (nil? value)) (deflate-fn value)))))
 (record-pretty-printer/enable-record-pretty-printing DeflatingCache)

 (defn create-deflating-cache


Changed session-assoc and session-dissoc to return a ring function

--- src/compojure/http/session.clj
+++ src/compojure/http/session.clj
@@ -101,10 +101,14 @@

 (defn session-assoc
   "Associate key value pairs with the session."
-  [session & keyvals]
-  (set-session (apply assoc session keyvals)))
+  [& keyvals]
+  (fn [request]
+    (let [session (request :session)]
+      (set-session (apply assoc session keyvals)))))

 (defn session-dissoc
   "Dissociate keys from the session."
-  [session & keys]
-  (set-session (apply dissoc session keys)))
+  [& keys]
+  (fn [request]
+    (let [session (request :session)]
+      (set-session (apply dissoc session keys)))))


Na, bug in exploration with incomplete counterexamples

Update when new implication is added was not correct

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

--- src/conexp/fca/exploration.clj
+++ src/conexp/fca/exploration.clj
@@ -299,7 +299,7 @@
                                                   (filter (fn [[g m]]
                                                             (let [certain-atts (oprime new-certain-ctx #{g})]
                                                               (subset? (new-clop (conj certain-atts m))
-                                                                       (incidence possible-ctx))))
+                                                                       (oprime possible-ctx #{g}))))
                                                           (incidence possible-ctx)))]
                (recur new-implications
                       (next-closed-set (attributes possible-ctx) new-clop last)


I like to have the ns statement at the top of the file - move comment

--- dada-demo/src/main/clojure/org/dada/demo/whales.clj
+++ dada-demo/src/main/clojure/org/dada/demo/whales.clj
@@ -1,7 +1,3 @@
-;; to use:
-;; load-eval this file using dada/bin/clj
-;; run dada/bin/client
-
 (ns
  ^{:author "Jules Gosnell" :doc "Demo domain for DADA"}
  org.dada.demo.whales
@@ -26,6 +22,11 @@
    ]
   )
  )
+
+;; to use:
+;; load-eval this file using dada/bin/clj
+;; run dada/bin/client
+

 ;;--------------------------------------------------------------------------------
 ;; utils
@@ -342,10 +343,9 @@
 (do (time (doall (pmap (fn [whale] (insert whales-model whale)) some-whales))) nil)

 ;;--------------------------------------------------------------------------------
-;; A Join
-;;--------------------------------------------------------------------------------
-
-;;(defrecord-metadata
+;; A Join - by reference
+;;--------------------------------------------------------------------------------
+
 (definterface-metadata
     join-metadata
     Join
@@ -359,7 +359,6 @@
      ^{:tag int}                     ocean-max-depth]
     (fn [^Integer lhs ^Integer rhs] (- (int lhs) (int rhs))))

-;; definterface defines method names with '-' in them, but deftype mangles them to '_'
 (deftype
   JoinImpl
   [^int id ^int version ^Whale whale ^Ocean ocean]
@@ -380,13 +379,7 @@
       join-metadata
       whales-model
       {:ocean oceans-model}
-      (fn [id version ^Whale whale [[^Ocean ocean]]]
-	  (JoinImpl. id version whale ocean)
-	  ;; (let [[type length weight] (if whale [(.type whale)(.length whale)(.weight whale)][nil 0 0])
-	  ;; 	[ocean-id ocean-max-depth ocean-area] (if ocean [(.id ocean)(.max-depth ocean)(.area ocean)] [nil 0 0])]
-	  ;;   (Join. id version type length weight ocean-id ocean-area ocean-max-depth)
-	  ;;   )
-	  )))
+      (fn [id version ^Whale whale [[^Ocean ocean]]] (JoinImpl. id version whale ocean))))

 (insert *metamodel* joins-model)


[#11880] Open user profile when tapping on user icon in 1-1 chat

Signed-off-by: andrey <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/chat/toolbar_content.cljs
+++ src/status_im/ui/screens/chat/toolbar_content.cljs
@@ -42,7 +42,8 @@
   (when chat-id
     [react/view {:style st/toolbar-container}
      [react/view {:margin-right 10}
-      [chat-icon.screen/chat-icon-view-toolbar chat-id group-chat chat-name color]]
+      [react/touchable-highlight {:on-press #(when-not group-chat (re-frame/dispatch [:chat.ui/show-profile chat-id]))}
+       [chat-icon.screen/chat-icon-view-toolbar chat-id group-chat chat-name color]]]
      [react/view {:style st/chat-name-view}
       (if group-chat
         [react/text {:style               st/chat-name-text


Default request character encoding to UTF-8 if it is nil

--- src/compojure/http/servlet.clj
+++ src/compojure/http/servlet.clj
@@ -147,6 +147,8 @@
   "Handle incoming HTTP requests from a servlet."
   [[servlet request response] & routes]
   `(do (.setCharacterEncoding ~response "UTF-8")
+       (when-not (.getCharacterEncoding ~request)
+         (.setCharacterEncoding ~request "UTF-8"))
        (update-response ~servlet ~response
          (with-servlet-vars [~servlet ~request]
            ((combine-routes ~@routes)


Tidied up compojure.http.session a bit

Tidied up compojure.http.session a bit

--- src/compojure/http/session.clj
+++ src/compojure/http/session.clj
@@ -111,8 +111,8 @@
 (defn- get-request-session
   "Retrieve the session using the 'session' cookie in the request."
   [request]
-  (if-let [session-id (-> request :cookies :session)]
-    (read-session session-id)))
+  (if-let [session-data (-> request :cookies :session)]
+    (read-session session-data)))

 (defn- assoc-request-session
   "Associate the session with the request."
@@ -135,9 +135,9 @@

 (defn- set-session-cookie
   "Set the session cookie on the response."
-  [request response session]
+  [request response]
   (let [new?   (:new-session? request)
-        cookie (session-cookie new? session)
+        cookie (session-cookie new? (:session response))
         update (set-cookie :session cookie, :path "/")]
     (if cookie
       (update-response request response update)
@@ -151,18 +151,16 @@
   ([handler session-type]
     (fn [request]
       (binding [*session-type* session-type]
-        (let [request  (-> request
-                         assoc-cookies
-                         assoc-request-session
-                         assoc-request-flash)
-              response (handler request)
-              session  (:session response)]
+        (let [request  (-> request assoc-cookies
+                                   assoc-request-session
+                                   assoc-request-flash)
+              response (handler request)]
           (when response
-            (if (or session (:new-session? request))
-              (write-session session)
+            (if (or (:session response) (:new-session? request))
+              (write-session (:session response))
               (if (not-empty (:flash request))
                 (write-session (:session request))))
-            (set-session-cookie request response session)))))))
+            (set-session-cookie request response)))))))

 ;; User functions for modifying the session


Added cookie sessions

Added cookie sessions

--- src/compojure/http/session.clj
+++ src/compojure/http/session.clj
@@ -13,7 +13,10 @@
 (ns compojure.http.session
   (:use compojure.str-utils)
   (:use compojure.http.helpers)
-  (:use compojure.http.response))
+  (:use compojure.http.response)
+  (:use compojure.encodings)
+  (:use compojure.crypto)
+  (:use clojure.contrib.except))

 ;; Global session store type

@@ -27,14 +30,13 @@
 ;; Override these mulitmethods to create your own session storage

 (defmulti create-session
-  "Create a session map that's blank except for an :id. Should not attempt to
-  save the session."
+  "Create a new session map. Should not attempt to save the session."
   (fn [type] type))

 (defmulti read-session
-  "Read in the session matching the ID from the session store and return the
-  session map."
-  (fn [type id] type))
+  "Read in the session using the supplied data. Usually the data is a key used
+  to find the session in a store."
+  (fn [type data] type))

 (defmulti write-session
   "Write a new or existing session to the session store."
@@ -44,9 +46,10 @@
   "Remove the session from the session store."
   (fn [type session] type))

-(defmulti set-session-cookie
-  "Add the session cookie to the given response."
-  (fn [type response session] type))
+(defmulti session-cookie
+  "Return the session data to be stored in the cookie. This is usually the
+  session ID."
+  (fn [type new? session] type))

 ;; Default implementations of create-session and set-session-cookie

@@ -54,10 +57,10 @@
   [_]
   {:id (gen-uuid)})

-(defmethod set-session-cookie :default
-  [_ response session]
-  (update-response {} response
-    (set-cookie :session-id (session :id))))
+(defmethod session-cookie :default
+  [_ new? session]
+  (if (not new?)
+    (session :id)))

 ;; In memory sessions

@@ -81,14 +84,39 @@

 ;; Cookie sessions

-
+; Random secret key
+(def *session-secret-key* (gen-uuid))
+
+(defn- session-hmac
+  "Calculate a HMAC for a marshalled session"
+  [cookie-data]
+  (hmac *session-secret-key* "HmacSHA256" cookie-data))
+
+(defmethod create-session :cookie [_] {})
+
+(defmethod session-cookie :cookie
+  [_ _ session]
+  (let [cookie-data (marshal session)]
+    (if (> (count cookie-data) 4000)
+      (throwf "Session data exceeds 4K")
+      (str cookie-data "--" (session-hmac cookie-data)))))
+
+(defmethod read-session :cookie
+  [_ data]
+  (let [[session mac] (.split data "--")]
+    (if (= mac (session-hmac session))
+      (unmarshal session))))
+
+; Do nothing for write or destroy
+(defmethod write-session :cookie [_ _])
+(defmethod destroy-session :cookie [_ _])

 ;; Session middleware

 (defn- get-request-session
   "Retrieve the session using the 'session-id' cookie in the request."
   [request]
-  (if-let [session-id (-> request :cookies :session-id)]
+  (if-let [session-id (-> request :cookies :session)]
     (read-session *session-store* session-id)))

 (defn- assoc-request-session
@@ -113,8 +141,17 @@
 (defn- get-response-session
   "Retrieve the current session from the response map."
   [request response]
-  (assoc (:session response)
-    :id (-> request :session :id)))
+  (if-let [id (-> request :session :id)]
+    (assoc (:session response) :id id)
+    (:session response)))
+
+(defn- set-session-cookie
+  "Set the session cookie on the response."
+  [request response session]
+  (let [new?   (:new-session? request)
+        cookie (session-cookie *session-store* new? session)
+        update (set-cookie :session cookie)]
+    (update-response {} response update)))

 (defn with-session
   "Wrap a handler in a session."
@@ -130,10 +167,9 @@
         (write-session *session-store* session)
         (if (not-empty (:flash request))
           (write-session *session-store* (:session request))))
-
       ; Set cookie
-      (if (and response (:new-session? request))
-        (set-session-cookie *session-store* response session)
+      (if response
+        (set-session-cookie request response session)
         response))))

 ;; User functions for modifying the session


[verify/nn/train] Attempt to speed up mnist tests. (#127)

Re: https://github.com/thinktopic/cortex/issues/126

Recent refactors led to the mnist tests operating on a lot more data. This is not necessary to ensure the functionality these tests are trying to protect, and in the interest of speed operating on less data saves around 10min when running the tests on my local machine.

--- src/cortex/verify/nn/train.clj
+++ src/cortex/verify/nn/train.clj
@@ -137,9 +137,10 @@
     (when context
       ((:backend-fn context)))
     (let [n-epochs 4
-          batch-size 10
-          dataset (take 1000 @mnist-training-dataset*)
-          test-dataset @mnist-test-dataset*
+          training-batch-size 10
+          running-batch-size 100
+          dataset (take 100 @mnist-training-dataset*)
+          test-dataset (take 100 @mnist-test-dataset*)
           test-labels (map :label test-dataset)
           network (network/linear-network MNIST-NETWORK)
           _ (println (format "Training MNIST network for %s epochs..." n-epochs))
@@ -147,18 +148,19 @@
           network (reduce (fn [network epoch]
                             (let [new-network (execute/train network dataset
                                                              :context context
-                                                             :batch-size batch-size)
-                                  results (->> (execute/run new-network (take 100 test-dataset)
-                                                 :batch-size batch-size
+                                                             :batch-size training-batch-size)
+                                  results (->> (execute/run new-network test-dataset
+                                                 :batch-size running-batch-size
                                                  :context context
                                                  :loss-outputs? true))
-                                  loss-fn (execute/execute-loss-fn network results (take 100 test-dataset))
-                                  score (percent= (map :label results) (take 100 test-labels))]
+                                  loss-fn (execute/execute-loss-fn network results test-dataset)
+                                  score (percent= (map :label results) test-labels)]
                               (println (format "Score for epoch %s: %s" (inc epoch) score))
                               (println (loss/loss-fn->table-str loss-fn))
                               new-network))
                           network
                           (range n-epochs))
-          results (->> (execute/run network test-dataset :batch-size batch-size :context context)
+          results (->> (execute/run network test-dataset
+                         :batch-size running-batch-size :context context)
                        (map :label))]
       (is (> (percent= results test-labels) 0.6)))))


(TK-130) Add test for number of selectors per core

--- test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_config_test.clj
+++ test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_config_test.clj
@@ -265,6 +265,10 @@
     (is (= 1 (acceptors-count 3)))
     (is (= 2 (acceptors-count 4))))

+  (testing "Number of selectors per cpu"
+    (doseq [n (range 42)]
+      (is (= n (selectors-count n)))))
+
   (testing "The default number of threads are returned."
     (is (= default-max-threads (determine-max-threads {} 1)))
     (is (= default-max-threads (determine-max-threads


client side navigation 401 reuse :error route

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -16,6 +16,7 @@
             [frontend.utils.state :as state-utils]
             [frontend.utils.vcs-url :as vcs-url]
             [frontend.utils :as utils :refer [mlog merror set-page-title! set-page-description! scroll-to-id! scroll!]]
+            [frontend.routes :as routes]
             [goog.dom]
             [goog.string :as gstring])
   (:require-macros [frontend.utils :refer [inspect]]
@@ -437,7 +438,8 @@
 (defmethod navigated-to :account
   [history-imp navigation-point {:keys [subpage] :as args} state]
   (mlog "Navigated to account subpage:" subpage)
-  (let [logged-in? (get-in state state/user-path)]
+  (let [logged-in? (get-in state state/user-path)
+        nav-ch (get-in state [:comms :nav])]
     (if logged-in?
        (-> state
            state-utils/clear-page-state
@@ -445,14 +447,9 @@
            (assoc :navigation-data args)
            (assoc :account-settings-subpage subpage)
            (assoc-in state/crumbs-path [{:type :account}]))
-       (-> state
-           state-utils/clear-page-state
-           (assoc :navigation-point :error)
-           (assoc :navigation-data {:status 401})
-           (assoc :original-navigation-point :account))
-      )
-    )
-  )
+       (do
+         (routes/open-to-outer! nav-ch :error {:status 401})
+         state))))

 (defmethod post-navigated-to! :account
   [history-imp navigation-point {:keys [org-name subpage]} previous-state current-state]


Remove three unnecessary mixpanel events

https://trello.com/c/oKWo7xlj/109-analytics-remove-view-changelog-event-from-mixpanel-we-already-can-capture-that-event-with-view-page
https://trello.com/c/PAOl3F9H/110-analytics-remove-view-language-landing-page-event-from-mixpanel-we-already-can-capture-that-event-with-view-page
https://trello.com/c/2YIYEBDr/108-analytics-remove-view-docs-event-from-mixpanel-we-already-can-capture-that-event-with-view-page

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -405,7 +405,6 @@
   [history-imp navigation-point args previous-state current-state]
   (set-page-title! "Track CircleCI Updates")
   (set-page-description! "Track our platform changes and updates via the CircleCI Changelog. Stay up to date with the latest in Continuous Integration.")
-  (analytics/track-page "View Changelog")
   (scroll! args)
   (go (let [comms (get-in current-state [:comms])
             api-result (<! (ajax/managed-ajax :get "/changelog.rss" :format :xml :response-format :xml))]
@@ -454,7 +453,6 @@
          (set-page-title! (:title doc))
          (set-page-description! (:description doc))
          (scroll! params)
-         (analytics/track-page "View Docs")
          (when (and (empty? (:children doc))
                     (not (:markdown doc)))
            (let [url (-> "/docs/%s.md"
@@ -481,8 +479,7 @@
     (when-let [title (get titles language)]
       (set-page-title! (get titles language)))
     (when-let [description (get descriptions language)]
-      (set-page-description! (get descriptions language)))
-    (analytics/track-page "View Language Landing" {:language language})))
+      (set-page-description! (get descriptions language)))))

 (defmethod post-navigated-to! :integrations
   [history-imp navigation-point {:keys [integration] :as args} previous-state current-state]


Fix a bug tagging builds with their build name

--- backend/src/circle/backend/action/tag.clj
+++ backend/src/circle/backend/action/tag.clj
@@ -11,4 +11,4 @@
     (throw-if-not (-> @build :vcs_revision) "build must contain vcs revision")
     (ec2/add-tags (-> @build :instance-ids)
                   {:rev (-> @build :vcs_revision)
-                   :build (build/build-name @build)})))+                   :build (build/build-name build)})))


:tada: Add high level `schedule!` function to vertx.timers.

--- backend/vendor/vertx/src/vertx/timers.clj
+++ backend/vendor/vertx/src/vertx/timers.clj
@@ -13,6 +13,8 @@
   (:import
    io.vertx.core.Vertx
    io.vertx.core.Handler))
+
+;; --- Low Level API

 (defn schedule-once!
   [vsm ms f]
@@ -33,3 +35,42 @@
       java.lang.AutoCloseable
       (close [_]
         (.cancelTimer system timer-id)))))
+
+;; --- High Level API
+
+(s/def ::once boolean?)
+(s/def ::repeat boolean?)
+(s/def ::delay integer?)
+(s/def ::fn (s/or :fn fn? :var var?))
+
+(s/def ::schedule-opts
+  (s/keys :req [::fn ::delay] :opt [::once ::repeat]))
+
+(defn schedule!
+  "High level schedule function."
+  [vsm {:keys [::once ::repeat ::delay] :as opts}]
+  (s/assert ::schedule-opts opts)
+
+  (when (and (not once) (not repeat))
+    (throw (IllegalArgumentException. "you should specify `once` or `repeat` params")))
+
+  (let [system (vu/resolve-system vsm)
+        state  (atom nil)
+        taskfn (fn wrapped-task []
+                 (-> (p/do! ((::fn opts) opts))
+                     (p/catch' (constantly nil)) ; explicitly ignore all errors
+                     (p/then'  (fn [_]            ; the user needs to catch errors
+                                 (when repeat
+                                   (let [tid (schedule-once! vsm delay wrapped-task)]
+                                     (reset! state tid)
+                                     nil))))))
+        tid  (schedule-once! vsm delay taskfn)]
+    (reset! state tid)
+    (reify
+      java.lang.AutoCloseable
+      (close [this]
+        (locking this
+          (when-let [timer-id (deref state)]
+            (.cancelTimer system timer-id)
+            (reset! state nil)))))))
+


Use 3 arguments version of q/fill instead of unofficial cljs-specific string argument.

--- src/cljc/quil/snippets/math/trigonometry.cljc
+++ src/cljc/quil/snippets/math/trigonometry.cljc
@@ -20,7 +20,7 @@
      {}

      (comment "draw a red square for reference")
-     (q/fill "red")
+     (q/fill 255 0 0)
      (q/rect 0 0 100 100)

      (comment "rotation will be in degrees (instead of the default radians)")
@@ -28,7 +28,7 @@
      (q/rotate 45)

      (comment "draw a green square after the rotation of 45 degrees")
-     (q/fill "green")
+     (q/fill 0 255 0)
      (q/rect 0 0 100 100)))

 (defsnippet asin


GAWB-1340: visual tweaks for Library search results (#613)

visual tweaks for Library search results

--- src/cljs/org/broadinstitute/firecloud_ui/page/library/library_page.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/library/library_page.cljs
@@ -32,7 +32,7 @@
        :toolbar
        (fn [{:keys [reorderer]}]
          [:div {:style {:display "flex" :alignItems "top"}}
-          [:div {:style {:fontWeight 700 :fontSize "125%"}} "Search Results: "
+          [:div {:style {:fontWeight 700 :fontSize "125%" :marginBottom "1em"}} "Search Results: "
            [:span {:style {:fontWeight 100}}
             (let [total (or (:total @state) 0)]
               (str total
@@ -41,22 +41,21 @@
                    " found"))]]
           flex-strut
           reorderer])
-       :body-style {:fontSize nil :fontWeight nil}
-       :row-style {:backgroundColor nil :height 22}
-       :cell-content-style {:padding nil
-                            :color (:text-light style/colors)
-                            :fontSize "90%"}
-       :columns [{:header "Dataset Name" :starting-width 300
+       :body-style {:fontSize "87.5%" :fontWeight nil :marginTop 4
+                    :color (:text-light style/colors)}
+       :row-style {:backgroundColor nil :height 20}
+       :cell-content-style {:padding nil}
+       :columns [{:header "Dataset Name" :starting-width 250
                   :sort-by (comp clojure.string/lower-case :library:datasetName)
                   :as-text :library:datasetDescription
                   :content-renderer (fn [data]
                                       (style/create-link {:text (:library:datasetName data)
                                                           :onClick #(react/call :check-access this data)}))}
-                 {:header "Phenotype/indication" :starting-width 200
+                 {:header "Phenotype/indication" :starting-width 180
                   :sort-by clojure.string/lower-case}
-                 {:header "Data Use Restrictions" :starting-width 200
+                 {:header "Data Use Restrictions" :starting-width 180
                   :sort-by clojure.string/lower-case}
-                 {:header "# of Participants" :starting-width 150}]
+                 {:header "# of Participants" :starting-width 100}]
        :pagination (react/call :pagination this)
        :->row (juxt identity :library:indication :library:dataUseRestriction :library:numSubjects)}])
    :component-will-receive-props
@@ -106,7 +105,7 @@
   {:render
    (fn [{:keys [props]}]
      [:div {}
-      [:div {:style {:fontWeight 700 :fontSize "125%"}} "Search Filters:"]
+      [:div {:style {:fontWeight 700 :fontSize "125%" :marginBottom "1em"}} "Search Filters:"]
       [:div {:style {:background (:background-light style/colors) :padding "16px 12px"}}
        [comps/TextFilter {:ref "text-filter"
                           :initial-text (:search-text props)
@@ -128,7 +127,7 @@
         :validator (comp (partial = VERSION) :v)}))
    :render
    (fn [{:keys [state]}]
-     [:div {:style {:display "flex" :padding "20px 0"}}
+     [:div {:style {:display "flex" :marginTop "2em"}}
       [:div {:style {:flex "0 0 250px" :marginRight "2em"}}
        [SearchSection {:search-text (:search-text @state)
                        :on-filter #(swap! state assoc :search-text %)}]]


"tim helped me figure out images!"

"tim helped me figure out images!"

--- cartagena-web/src/cartagena_web/main.cljs
+++ cartagena-web/src/cartagena_web/main.cljs
@@ -152,7 +152,7 @@
    [:rect {:x 0 :y 0 :width (to-scale 500) :height (to-scale 300) :stroke "black" :stroke-width "0.5" :fill "burlywood"}]
    ;; jail
    [:rect {:x 0 :y 0 :width (to-scale 50) :height (to-scale 90) :stroke "black" :fill "darkgray"}]
-   [:text {:x 0 :y (to-scale 15) :style {:text-anchor "start" :stroke "none" :fill "black" :font-size "smaller"}} "jail"]
+   [:g {:dangerouslySetInnerHTML {:__html "<image xlink:href=\"img/jail.png\" x=0 y=0 height=\"50px\" width=\"50px\" />"}}]
    ;; ship
    [:rect {:x (to-scale 400) :y (to-scale 240) :width (to-scale 90) :height (to-scale 50) :stroke "black" :fill "sienna"}]
    [:text {:x (to-scale 400) :y (to-scale 255) :style {:text-anchor "start" :stroke "none" :fill "black" :font-size "smaller"}} "ship"]
@@ -260,7 +260,7 @@
     [:div
      [:div
       (-> [:svg
-           {:view-box (str "0 0" (to-scale 501) (to-scale 301))
+           {:view-box (str "0 0 " (to-scale 501) " " (to-scale 301))
             :width (to-scale 501)
             :height (to-scale 301)}]
           (into (static-board))


Added seven test into rest-api-test module

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -54,6 +54,12 @@
         (is (callable? 'emender-jenkins.rest-api/get-job-name-from-body))))

+(deftest test-test-job?-existence
+    "Check that the emender-jenkins.rest-api/test-job? definition exists."
+    (testing "if the emender-jenkins.rest-api/test-job? definition exists."
+        (is (callable? 'emender-jenkins.rest-api/test-job?))))
+
+
 (deftest test-send-response-existence
     "Check that the emender-jenkins.rest-api/send-response definition exists."
     (testing "if the emender-jenkins.rest-api/send-response definition exists."
@@ -120,6 +126,12 @@
         (is (callable? 'emender-jenkins.rest-api/job-does-not-exist-response))))

+(deftest test-wrong-job-name-existence
+    "Check that the emender-jenkins.rest-api/wrong-job-name definition exists."
+    (testing "if the emender-jenkins.rest-api/wrong-job-name definition exists."
+        (is (callable? 'emender-jenkins.rest-api/wrong-job-name))))
+
+
 (deftest test-job-already-exist-response-existence
     "Check that the emender-jenkins.rest-api/job-already-exist-response definition exists."
     (testing "if the emender-jenkins.rest-api/job-already-exist-response definition exists."
@@ -132,6 +144,12 @@
         (is (callable? 'emender-jenkins.rest-api/send-job-does-not-exist-response))))

+(deftest test-send-wrong-job-name-response-existence
+    "Check that the emender-jenkins.rest-api/send-wrong-job-name-response definition exists."
+    (testing "if the emender-jenkins.rest-api/send-wrong-job-name-response definition exists."
+        (is (callable? 'emender-jenkins.rest-api/send-wrong-job-name-response))))
+
+
 (deftest test-send-job-not-specified-response-existence
     "Check that the emender-jenkins.rest-api/send-job-not-specified-response definition exists."
     (testing "if the emender-jenkins.rest-api/send-job-not-specified-response definition exists."
@@ -204,6 +222,12 @@
         (is (callable? 'emender-jenkins.rest-api/uri->job-name))))

+(deftest test-get-job-name-from-uri-or-params-existence
+    "Check that the emender-jenkins.rest-api/get-job-name-from-uri-or-params definition exists."
+    (testing "if the emender-jenkins.rest-api/get-job-name-from-uri-or-params definition exists."
+        (is (callable? 'emender-jenkins.rest-api/get-job-name-from-uri-or-params))))
+
+
 (deftest test-get-job-existence
     "Check that the emender-jenkins.rest-api/get-job definition exists."
     (testing "if the emender-jenkins.rest-api/get-job definition exists."
@@ -250,6 +274,24 @@
     "Check that the emender-jenkins.rest-api/unknown-call-handler definition exists."
     (testing "if the emender-jenkins.rest-api/unknown-call-handler definition exists."
         (is (callable? 'emender-jenkins.rest-api/unknown-call-handler))))
+
+
+(deftest test-get-output-format-existence
+    "Check that the emender-jenkins.rest-api/get-output-format definition exists."
+    (testing "if the emender-jenkins.rest-api/get-output-format definition exists."
+        (is (callable? 'emender-jenkins.rest-api/get-output-format))))
+
+
+(deftest test-mime-type-existence
+    "Check that the emender-jenkins.rest-api/mime-type definition exists."
+    (testing "if the emender-jenkins.rest-api/mime-type definition exists."
+        (is (callable? 'emender-jenkins.rest-api/mime-type))))
+
+
+(deftest test-get-metadata-existence
+    "Check that the emender-jenkins.rest-api/get-metadata definition exists."
+    (testing "if the emender-jenkins.rest-api/get-metadata definition exists."
+        (is (callable? 'emender-jenkins.rest-api/get-metadata))))

 ;
 ; Function behaviours


add nonhuman "themselves"

add nonhuman "themselves"


Test for concurrency.

Test for concurrency.

--- test/onyx/coordinator/cluster_test.clj
+++ test/onyx/coordinator/cluster_test.clj
@@ -130,6 +130,15 @@
                  (>= (+ mean (* mean confidence)) %))
            result)))))

+#_(deftest concurrency-liveness
+  (testing ">= 25% of all concurrency tasks got > 1 peer at some point"
+    (let [query '[:find ?task (count ?peer) :where
+                  [?task :task/consumption :concurrent]
+                  [?peer :peer/task ?task]]
+          result (map second (d/q query (d/history result-db)))]
+      (is (>= (count (filter (partial < 1) result))
+              (/ (* n-jobs tasks-per-job) 0.25))))))
+
 (run-tests 'onyx.coordinator.cluster-test)

 (alter-var-root #'system component/stop)


consume-stack

consume-stack

--- test/push/design_spikes/dsl_macros.clj
+++ test/push/design_spikes/dsl_macros.clj
@@ -13,15 +13,15 @@
 ;; Everything would be assumed to happen inside one interpreter, and the interpreter
 ;; (and some store of scratch vars) would be passed step-to-step.
 ;;
-; - `count-of [stackname :as local]`
+; + `count-of [stackname :as local]`
 ;    store the number of items in `stackname` under key `local`
 ;    raise an Exception if the stack doesn't exist

-; + `consume [stackname]`
+; + `consume-top-of [stackname]`
 ;    pop an item (and discard it) from `stackname`
 ;    raise an Exception if it's empty or undefined

-; + `consume [stackname :as local]`
+; + `consume-top-of [stackname :as local]`
 ;    pop an item from `stackname` and store under key `local`
 ;    raise an Exception if it's empty or undefined

@@ -65,12 +65,13 @@
 ;    save a list of all active instructions in the named local

 ; - `inputs [:as kwd]`
-;    save a list of all known inputs in the namedlocal
+;    save a list of all known inputs in the named local
+
+; - `counter [:as kwd]`
+;    save the current interpreter counter in the named local

 (def six-ints (make-interpreter :stacks {:integer '(6 5 4 3 2 1)}))
-
-

 (defn store-scratch
   "stores a scratch kv pair; convenience function for DSL"
@@ -89,7 +90,7 @@
     (second (store-scratch foo :foo 999)) => {:foo 999}))

-(defn consume
+(defn consume-top-of
   [[interpreter scratch] stack & {:keys [as]}]
   (let [old-stack (get-stack interpreter stack)]
     (cond (empty? old-stack)
@@ -108,29 +109,29 @@
   (get-stack interpreter stackname))

-(fact "consume"
-  (second (consume [six-ints {}] :integer :as :int1)) => {:int1 6}
+(fact "consume-top-of"
+  (second (consume-top-of [six-ints {}] :integer :as :int1)) => {:int1 6}
   (get-stack-from-dslblob
-    (consume [six-ints {}] :integer :as :int1)
+    (consume-top-of [six-ints {}] :integer :as :int1)
     :integer) => '(5 4 3 2 1))

-(fact "consume throws an exception if the stack is empty"
-  (consume [six-ints {}] :boolean :as :nope) => (throws #"Push DSL Error:"))
-
-
-(fact "consume can be thread-firsted"
+(fact "consume-top-of throws an exception if the stack is empty"
+  (consume-top-of [six-ints {}] :boolean :as :nope) => (throws #"Push DSL Error:"))
+
+
+(fact "consume-top-of can be thread-firsted"
   (let [two-popped (->  [six-ints {}]
-                        (consume :integer :as :int1)
-                        (consume :integer :as :int2))]
+                        (consume-top-of :integer :as :int1)
+                        (consume-top-of :integer :as :int2))]
     (second two-popped) => {:int1 6, :int2 5}
     (get-stack-from-dslblob two-popped :integer) => '(4 3 2 1)))

-(fact "consume with no :as argument just throws the thing away"
+(fact "consume-top-of with no :as argument just throws the thing away"
   (let [two-popped (->  [six-ints {}]
-                        (consume :integer)
-                        (consume :integer :as :int2))]
+                        (consume-top-of :integer)
+                        (consume-top-of :integer :as :int2))]
     (second two-popped) => {:int2 5}
     (get-stack-from-dslblob two-popped :integer) => '(4 3 2 1)))

@@ -146,8 +147,8 @@

 (fact "`place` will push the saved scratch value to the indicated stack in the interpreter"
   (let [integer-added (-> [six-ints {}]
-                          (consume :integer :as :int1)
-                          (consume :integer :as :int2)
+                          (consume-top-of :integer :as :int1)
+                          (consume-top-of :integer :as :int2)
                           (place :boolean :int1))]
     (get-stack-from-dslblob integer-added :boolean) => '(6)))

@@ -162,16 +163,16 @@

 (fact "remember-calc stores the result of a calculation in a named scratch"
   (let [integer-added (-> [six-ints {}]
-                          (consume :integer :as :int1)
-                          (consume :integer :as :int2)
+                          (consume-top-of :integer :as :int1)
+                          (consume-top-of :integer :as :int2)
                           (remember-calc [:int1 :int2] #(+ %1 %2) :as :sum))]
   (second integer-added) => {:int1 6, :int2 5, :sum 11}))

 (fact "remember-calc has no effect if :as is not specified"
   (let [integer-added (-> [six-ints {}]
-                        (consume :integer :as :int1)
-                        (consume :integer :as :int2)
+                        (consume-top-of :integer :as :int1)
+                        (consume-top-of :integer :as :int2)
                         (remember-calc [:int1 :int2] #(+ %1 %2)))]
   (second integer-added) => {:int1 6, :int2 5}))

@@ -186,16 +187,16 @@

 (fact "remember-top stores the top item of a named stack"
   (let [integer-munged (-> [six-ints {}]
-                          (consume :integer :as :int1)
-                          (consume :integer :as :int2)
+                          (consume-top-of :integer :as :int1)
+                          (consume-top-of :integer :as :int2)
                           (remember-top :integer :as :third))]
   (second integer-munged) => {:int1 6, :int2 5, :third 4}))

 (fact "remember-top has no effect if :as is not specified"
   (let [integer-munged (-> [six-ints {}]
-                        (consume :integer :as :int1)
-                        (consume :integer :as :int2)
+                        (consume-top-of :integer :as :int1)
+                        (consume-top-of :integer :as :int2)
                         (remember-top :integer))]
   (second integer-munged) => {:int1 6, :int2 5}))

@@ -212,8 +213,8 @@

 (fact "remember-nth stores the nth item of a named stack"
   (let [integer-munged (-> [six-ints {}]
-                          (consume :integer :as :int1)
-                          (consume :integer :as :int2)
+                          (consume-top-of :integer :as :int1)
+                          (consume-top-of :integer :as :int2)
                           (remember-nth :integer :as :third :at 1))]
   (second integer-munged) => {:int1 6, :int2 5, :third 3}))  ;; 4 *3* 2 1

@@ -231,16 +232,16 @@

 (fact "remember-nth has no effect if :as is not specified"
   (let [integer-munged (-> [six-ints {}]
-                        (consume :integer :as :int1)
-                        (consume :integer :as :int2)
+                        (consume-top-of :integer :as :int1)
+                        (consume-top-of :integer :as :int2)
                         (remember-nth :integer))]
   (second integer-munged) => {:int1 6, :int2 5}))

 (fact "remember-nth acts like remember-top if :at is not specified"
   (let [integer-munged (-> [six-ints {}]
-                        (consume :integer :as :int1)
-                        (consume :integer :as :int2)
+                        (consume-top-of :integer :as :int1)
+                        (consume-top-of :integer :as :int2)
                         (remember-nth :integer :as :adsa))]
   (second integer-munged) => {:int1 6, :int2 5, :adsa 4}))

@@ -254,16 +255,16 @@

 (fact "remember-stack stores the stack specified in the :as variable"
   (let [integer-munged (-> [six-ints {}]
-                          (consume :integer :as :int1)
-                          (consume :integer :as :int2)
+                          (consume-top-of :integer :as :int1)
+                          (consume-top-of :integer :as :int2)
                           (remember-stack :integer :as :rest))]
   (second integer-munged) => {:int1 6, :int2 5, :rest '(4 3 2 1)}))

 (fact "remember-stack has no effect if :as is not specified"
   (let [integer-munged (-> [six-ints {}]
-                        (consume :integer :as :int1)
-                        (consume :integer :as :int2)
+                        (consume-top-of :integer :as :int1)
+                        (consume-top-of :integer :as :int2)
                         (remember-stack :integer))]
   (second integer-munged) => {:int1 6, :int2 5}))

@@ -285,9 +286,53 @@

 (fact "replace-stack replaces the entire stack with the item in a list"
   (let [integer-munged (-> [six-ints {}]
-                          (consume :integer :as :int1)
+                          (consume-top-of :integer :as :int1)
                           (replace-stack :integer :int1))]
   (get-stack-from-dslblob integer-munged :integer) => '(6)))
+
+
+(defn count-of
+  [[interpreter scratch] stackname & {:keys [as]}]
+  (if (nil? as)
+    (vector interpreter scratch)
+    (let [howmany (count (get-stack interpreter stackname))]
+      (vector interpreter (assoc scratch as howmany)))))
+
+(fact "count-of saves the size of the named stack"
+  (let [tester (-> [six-ints {}]
+                   (count-of :integer :as :ints))]
+    (second tester) => {:ints 6}))
+
+(fact "count-of does nothing if no local is specified"
+  (let [tester (-> [six-ints {}]
+                   (count-of :integer))]
+    (second tester) => {}))
+
+
+(defn consume-stack
+  [[interpreter scratch] stack & {:keys [as]}]
+  (let [old-stack (get-stack interpreter stack)]
+    (cond (nil? as)
+            [(set-stack interpreter stack (list)) scratch]
+          :else
+            (store-scratch
+              [(set-stack interpreter stack (list)) scratch]
+              as
+              old-stack))))
+
+(fact "consume-stack"
+  (second (consume-stack [six-ints {}] :integer :as :ints)) => {:ints '(6 5 4 3 2 1)}
+  (get-stack-from-dslblob
+    (consume-stack [six-ints {}] :integer :as :int1)
+    :integer) => '())
+
+
+(fact "consume-stack with no :as argument just throws the thing away"
+  (let [gone (->  [six-ints {}]
+                  (consume-stack :integer))]
+    (second gone) => {}
+    (get-stack-from-dslblob gone :integer) => '()))
+

 ; (def-pushinstruction
@@ -296,7 +341,7 @@
 ;   :needs {:integer 2}
 ;   :makes {:integer 1}
 ;   :tags [:arithmetic :core]
-;     (consume :integer :as :int1)
+;     (consume-top-of :integer :as :int1)
 ;     (consume :integer :as :int2)
 ;     (remember-calc [:int1 :int2] %(+ %1 %2) as :sum)
 ;     (place :integer :sum)


Bulk import ElectionAdministrations

Bulk import ElectionAdministrations

One feed had 10069 elements to insert using `korma.core/insert` and had
the connection close beneath it. This throws a lovely PGSQLException,
and processing halts. This fixes that, imitating our own
`db.translations.util/transformer` a bit more closely.

--- src/vip/data_processor/db/translations/v5_1/election_administrations.clj
+++ src/vip/data_processor/db/translations/v5_1/election_administrations.clj
@@ -40,12 +40,12 @@

 (defn transformer [{:keys [import-id ltree-index] :as ctx}]
   (let [idx-fn (util/index-generator ltree-index)
-        ltree-entries (util/prep-for-insertion
-                       import-id
-                       (election-administrations->ltree import-id idx-fn))]
-    (if (seq ltree-entries)
+        rows (util/prep-for-insertion
+              import-id
+              (election-administrations->ltree import-id idx-fn))]
+    (if (seq rows)
       (do
-        (korma/insert postgres/xml-tree-values
-          (korma/values ltree-entries))
-        (assoc ctx :ltree-index (idx-fn)))
-      ctx)))
+        (-> ctx
+            (postgres/bulk-import postgres/xml-tree-values rows)
+            (assoc :ltree-index (idx-fn)))
+        ctx))))


CMR-2397: Add configuration for using doc-values or not.

--- search-app/src/cmr/search/data/query_to_elastic.clj
+++ search-app/src/cmr/search/data/query_to_elastic.clj
@@ -9,66 +9,81 @@
             [cmr.common-app.services.search.query-model :as q]
             [cmr.common-app.services.search.query-order-by-expense :as query-expense]
             [cmr.common-app.services.search.query-to-elastic :as q2e]
-            [cmr.common-app.services.search.complex-to-simple :as c2s]))
+            [cmr.common-app.services.search.complex-to-simple :as c2s]
+            [cmr.common.config :refer [defconfig]]))
+
+(defconfig use-doc-values-fields
+  "Indicates whether search fields should use the doc-values fields or not. If false the field data
+  cache fields will be used."
+  {:type Boolean
+   :default true})

 (defmethod q2e/concept-type->field-mappings :collection
   [_]
-  {:provider :provider-id
-   :version :version-id
-   :project :project-sn2
-   :project-sn :project-sn2
-   :updated-since :revision-date2
-   :two-d-coordinate-system-name :two-d-coord-name
-   :platform :platform-sn
-   :instrument :instrument-sn
-   :sensor :sensor-sn
-   :revision-date :revision-date2
-   :mbr-north :mbr-north-doc-values
-   :mbr-south :mbr-south-doc-values
-   :mbr-east :mbr-east-doc-values
-   :mbr-west :mbr-west-doc-values
-   :lr-north :lr-north-doc-values
-   :lr-south :lr-south-doc-values
-   :lr-east :lr-east-doc-values
-   :lr-west :lr-west-doc-values})
+  (let [default-mappings {:provider :provider-id
+                          :version :version-id
+                          :project :project-sn2
+                          :project-sn :project-sn2
+                          :updated-since :revision-date2
+                          :two-d-coordinate-system-name :two-d-coord-name
+                          :platform :platform-sn
+                          :instrument :instrument-sn
+                          :sensor :sensor-sn
+                          :revision-date :revision-date2}]
+    (if (use-doc-values-fields)
+      (merge default-mappings
+             {:mbr-north :mbr-north-doc-values
+              :mbr-south :mbr-south-doc-values
+              :mbr-east :mbr-east-doc-values
+              :mbr-west :mbr-west-doc-values
+              :lr-north :lr-north-doc-values
+              :lr-south :lr-south-doc-values
+              :lr-east :lr-east-doc-values
+              :lr-west :lr-west-doc-values})
+      default-mappings)))

 (defmethod q2e/concept-type->field-mappings :granule
   [_]
-  {:granule-ur.lowercase :granule-ur.lowercase2
-   :producer-gran-id.lowercase :producer-gran-id.lowercase2
-   :provider :provider-id-doc-values
-   :provider-id :provider-id-doc-values
-   :collection-concept-id :collection-concept-id-doc-values
-   :collection-concept-seq-id :collection-concept-seq-id-doc-values
-   :concept-seq-id :concept-seq-id-doc-values
-   :size :size-doc-values
-   :start-date :start-date-doc-values
-   :end-date :end-date-doc-values
-   :revision-date :revision-date-doc-values
-   :updated-since :revision-date-doc-values
-   :producer-granule-id :producer-gran-id
-   :platform :platform-sn
-   :instrument :instrument-sn
-   :sensor :sensor-sn
-   :project :project-refs
-   :day-night :day-night-doc-values
-   :cloud-cover :cloud-cover-doc-values
-   :mbr-north :mbr-north-doc-values
-   :mbr-south :mbr-south-doc-values
-   :mbr-east :mbr-east-doc-values
-   :mbr-west :mbr-west-doc-values
-   :lr-north :lr-north-doc-values
-   :lr-south :lr-south-doc-values
-   :lr-east :lr-east-doc-values
-   :lr-west :lr-west-doc-values
-   :orbit-start-clat :orbit-start-clat-doc-values
-   :orbit-end-clat :orbit-end-clat-doc-values
-   :orbit-asc-crossing-lon :orbit-asc-crossing-lon-doc-values
-   :access-value :access-value-doc-values
-   :start-coordinate-1 :start-coordinate-1-doc-values
-   :end-coordinate-1 :end-coordinate-1-doc-values
-   :start-coordinate-2 :start-coordinate-2-doc-values
-   :end-coordinate-2 :end-coordinate-2-doc-values})
+  (let [default-mappings {:granule-ur.lowercase :granule-ur.lowercase2
+                          :producer-gran-id.lowercase :producer-gran-id.lowercase2
+                          :provider :provider-id
+                          :updated-since :revision-date
+                          :producer-granule-id :producer-gran-id
+                          :platform :platform-sn
+                          :instrument :instrument-sn
+                          :sensor :sensor-sn
+                          :project :project-refs}]
+        (if (use-doc-values-fields)
+          (merge default-mappings
+                 {:provider :provider-id-doc-values
+                  :provider-id :provider-id-doc-values
+                  :concept-seq-id :concept-seq-id-doc-values
+                  :collection-concept-id :collection-concept-id-doc-values
+                  :collection-concept-seq-id :collection-concept-seq-id-doc-values
+                  :size :size-doc-values
+                  :start-date :start-date-doc-values
+                  :end-date :end-date-doc-values
+                  :revision-date :revision-date-doc-values
+                  :updated-since :revision-date-doc-values
+                  :day-night :day-night-doc-values
+                  :cloud-cover :cloud-cover-doc-values
+                  :mbr-north :mbr-north-doc-values
+                  :mbr-south :mbr-south-doc-values
+                  :mbr-east :mbr-east-doc-values
+                  :mbr-west :mbr-west-doc-values
+                  :lr-north :lr-north-doc-values
+                  :lr-south :lr-south-doc-values
+                  :lr-east :lr-east-doc-values
+                  :lr-west :lr-west-doc-values
+                  :orbit-start-clat :orbit-start-clat-doc-values
+                  :orbit-end-clat :orbit-end-clat-doc-values
+                  :orbit-asc-crossing-lon :orbit-asc-crossing-lon-doc-values
+                  :access-value :access-value-doc-values
+                  :start-coordinate-1 :start-coordinate-1-doc-values
+                  :end-coordinate-1 :end-coordinate-1-doc-values
+                  :start-coordinate-2 :start-coordinate-2-doc-values
+                  :end-coordinate-2 :end-coordinate-2-doc-values})
+          default-mappings)))

 (defmethod q2e/elastic-field->query-field-mappings :collection
   [_]
@@ -116,15 +131,18 @@

 (defmethod q2e/field->lowercase-field-mappings :granule
   [_]
-  {:provider "provider-id.lowercase-doc-values"
-   :provider-id "provider-id.lowercase-doc-values"
-   :granule-ur "granule-ur.lowercase2"
-   :producer-gran-id "producer-gran-id.lowercase2"
-   :producer-granule-id "producer-gran-id.lowercase2"
-   :platform "platform-sn.lowercase-doc-values"
-   :instrument "instrument-sn.lowercase-doc-values"
-   :sensor "sensor-sn.lowercase-doc-values"
-   :project "project-refs.lowercase-doc-values"})
+  (let [default-mappings
+        {:granule-ur "granule-ur.lowercase2"
+         :producer-gran-id "producer-gran-id.lowercase2"
+         :producer-granule-id "producer-gran-id.lowercase2"}]
+    (if (use-doc-values-fields)
+      (merge default-mappings {:provider "provider-id.lowercase-doc-values"
+                               :provider-id "provider-id.lowercase-doc-values"
+                               :platform "platform-sn.lowercase-doc-values"
+                               :instrument "instrument-sn.lowercase-doc-values"
+                               :sensor "sensor-sn.lowercase-doc-values"
+                               :project "project-refs.lowercase-doc-values"})
+      default-mappings)))

 (defn- keywords-in-condition
   "Returns a list of keywords if the condition contains a keyword condition or nil if not."


gdgdg

gdgdg

--- src/mafia_votecount/models.clj
+++ src/mafia_votecount/models.clj
@@ -3,7 +3,11 @@
         [korma.core]))

 (def db
-  (postgres {:db "//ec2-107-20-222-114.compute-1.amazonaws.com:5432/dbsa7cb9rv7jtk"}))
+  {:classname "org.postgresql.Driver"
+   :subprotocol "postgresql"
+   :user "nqboeyfbipdulq"
+   :password "79gw1OolTi2gb8LxCFz4N1A06i"
+   :subname "//ec2-107-20-222-114.compute-1.amazonaws.com:5432/dbsa7cb9rv7jtk"})

 (defdb korma-db db)


too early to enable by default

too early to enable by default

--- src/main/shadow/cljs/build.clj
+++ src/main/shadow/cljs/build.clj
@@ -2577,8 +2577,7 @@

           (doto sb
             (.append "\n\t")
-            (.append (.-description err))
-            (.append "\n"))
+            (.append (.-description err)))

           (-> {:line line
                :column column
@@ -3302,7 +3301,7 @@
         :elide-asserts false

         :closure-warnings
-        {:check-types :warning}}
+        {:check-types :off}}

        :closure-defines
        {"goog.DEBUG" false


Add tests to make sure printing worked

Add tests to make sure printing worked

--- test/degasolv/resolver/string_to_req_test.clj
+++ test/degasolv/resolver/string_to_req_test.clj
@@ -48,12 +48,26 @@
              [[(->VersionPredicate :matches
                                    "f[ea]{2}ture")]])]
            (string-to-requirement "a<>f[ea]{2}ture"))))
+  (testing "Matching prints"
+    (is (= "a<>f[ea]{2}ture"
+           (str
+            (present
+             "a"
+             [[(->VersionPredicate :matches
+                                   "f[ea]{2}ture")]])))))
   (testing "Range cases"
     (is (= [(present
              "a"
              [[(->VersionPredicate :in-range
                                    "3")]])]
-           (string-to-requirement "a=>3")))))
+           (string-to-requirement "a=>3"))))
+  (testing "Range prints"
+    (is (= "a=>3"
+           (str
+            (present
+             "a"
+             [[(->VersionPredicate :in-range
+                                   "3")]]))))))

 (deftest ^:unit-tests test-string-to-requirement-illustrations
   (testing "Illustrative example"


log include server-time now

log include server-time now

--- ws-client/src/main/clojure/ws/client/ws-client.clj
+++ ws-client/src/main/clojure/ws/client/ws-client.clj
@@ -56,17 +56,16 @@

 (defmacro duration-in-millis
   "Evaluates expr and records the time it took in millis.
-   Passes the time as the first argument to 'on-complete' then returns the expression response."
-  [expr on-complete]
+   Returns a tuple of expression response and time in millis."
+  [expr]
   `(let [start# (. System (nanoTime))
          ret# ~expr]
-     (~on-complete (/ (double (- (. System (nanoTime)) start#)) 1000000.0))
-     ret#))
+     [ret# (/ (double (- (. System (nanoTime)) start#)) 1000000.0)]))

 (defn- send-response-log
   "Function that will 'send-off' for asynchronously logging response metrics.
    This function itself should not nothing blocking."
-  [time-in-millis response-log-agent log-writer num-threads]
+  [total-time server-time response-log-agent log-writer num-threads]
   (send-off response-log-agent (fn [count]
               (let [prefix
                     (if (= -1 count)
@@ -74,7 +73,7 @@
                       (do (inc count) "\t\t")
                       ; all other executions (comma, newline and tabs)
                       ",\n\t\t")]
-                (.write log-writer (str prefix "{\"timestamp\" : " (System/currentTimeMillis) ", \"total_time\" : " time-in-millis ", \"server_time\" : " time-in-millis "}"))
+                (.write log-writer (str prefix "{\"timestamp\" : " (System/currentTimeMillis) ", \"total_time\" : " total-time ", \"server_time\" : " server-time "}"))
                 (if (= 10 count)
                   (do
                     (.flush log-writer); flush writer every 10 log entries
@@ -90,9 +89,12 @@
       (let
         ; we generate a random id to seed the request with a different arg each request
         [url (str url "?id=" (rand-int 999999))]
-        ; perform http/get inside duration-in-millis macro which passes the
-        ; duration of the http/get function to the following function
-        (duration-in-millis (http/get url) #(send-response-log % response-log-agent log-writer num-threads))
+        ; perform http/get inside duration-in-millis macro that returns [response time-in-millis]
+        (let [r (duration-in-millis (http/get url))]
+          ; send the time-in-millis and server_response_time
+          (send-response-log (r 1) (get-header (r 0) "server_response_time") response-log-agent log-writer num-threads))
         )))

-
+(defn- get-header
+  [response header-name]
+  (get (:headers response) header-name))


hdm-uml changes

hdm-uml changes

--- hdm-uml-model.clj
+++ hdm-uml-model.clj
@@ -1,31 +1,31 @@

-(def-class :Extension
-  (with-attributes
+(class :Extension
+  (attributes
     :LocalID
     :Key
     :Value))

-(def-class :Entity
-  (with-attributes
+(class :Entity
+  (attributes
     :ID
     :Validity
     :CreationTime
     :OtherInfo
     :Name))

-(def-class :Domain
-  (with-attributes
+(class :Domain
+  (attributes
     :WWW
     :Description)
   (extends :Entity))

-(def-class :Share
-  (with-attributes
+(class :Share
+  (attributes
     :Description)
   (extends :Entity))

-(def-class :Service
-  (with-attributes
+(class :Service
+  (attributes
     :StatusInfo
     :QualityLevel
     :Capability
@@ -33,8 +33,8 @@
     :Complexity)
   (extends :Entity))

-(def-class :Location
-  (with-attributes
+(class :Location
+  (attributes
     :Latitude
     :Longitude
     :PostCode
@@ -43,36 +43,36 @@
     :Address)
   (extends :Entity))

-(def-class :AdminDomain
-  (with-attributes
+(class :AdminDomain
+  (attributes
     :Distributed
     :Owner)
-  (extends :Domain)) ;Pytanie, czy robimy podwójne dziedziczenie, czy wystarczy nam, że już :Domain dziedziczy po :Entity
-
-(def-class :UserDomain
-  (with-attributes
+  (extends :Domain))
+
+(class :UserDomain
+  (attributes
     :Member
     :UserManager
     :Level)
   (extends :Domain))

-(def-class :Contact
-  (with-attributes
+(class :Contact
+  (attributes
     :Type
     :Detail)
   (extends :Entity))

-(def-class :Manager
-  (with-attributes
+(class :Manager
+  (attributes
     :ProductVersion
     :ProductName)
   (extends :Entity))

-(def-class :Resource
-  (extends :Entity))
-
-(def-class :Endpoint
-  (with-attributes
+(class :Resource
+  (extends :Entity))
+
+(class :Endpoint
+  (attributes
     :StartTime
     :HealthStateInfo
     :SupportedProfile
@@ -97,123 +97,133 @@
     :TrustedCA)
   (extends :Entity))

-(def-class :Activity
-  (extends :Entity))
-
-(def-class :Policy
-  (with-attributes
+(class :Activity
+  (extends :Entity))
+
+(class :Policy
+  (attributes
     :Rule
     :Scheme)
   (extends :Entity))

-(def-class :AccessPolicy
+(class :AccessPolicy
   (extends :Policy))

-(def-class :MappingPolicy
+(class :MappingPolicy
   (extends :Policy))

-(association ""
-  "role1" :Extension 1 1
-  "role2" :Entity 0 *
-  )
-
-(association "ParticipatesIn"
-  "role1" :UserDomain 1 *)
-
-(association "Creates"
-  "role1" :Activity 1 *
-  "role2" :UserDomain 0 *)
-
-(association "HasPolicies"
-  "role1" :UserDomain 0 *
-  "role2" :Policy 0 1)
-
-(association "Has"
-  "role1" :Contact 0 *
-  "role2" :Domain 0 *)
-
-(association "Has"
-  "role1" :Contact 0 *
-  "role2" :Service 0 *)
-
-(association "PrimarilyLocatedAt"
-  "role1" :Domain 1 *
-  "role2" :Location 0 *)
-
-(association "PrimarilyLocatedAt"
-  "role1" :Service 1 *
-  "role2" :Location 0 *)
-
-(association "RelatesTo"
-  "role1" :Service 0 *)
-
-(association "ParticipatesIn"
-  "role1" :AdminDomain 1 *)
-
-(association "Manages"
-  "role1" :AdminDomain 0 *
-  "role2" :Service 0 *)
-
-(association "Manages"
-  "role2" :Manager 0 1
-  "role1" :Resource 0 *)
-
-(association "Offers"
-  "role1" :Service 0 *
-  "role2" :Manager 1 1)
-
-(association "Offers"
-  "role1" :Service 0 *
-  "role2" :Share 1 1)
-
-(association "Exposes"
-  "role1" :Service 0 *
-  "role2" :Endpoint 1 1)
-
-(association "CanBeMappedInto"
-  "role1" :MappingPolicy 1 1
-  "role2" :Share)
-
-(association "CanAccess"
-  "role1" :AccessPolicy 1 1
-  "role2" :Endpoint 0 *)
-
-(association "DefinedOn"
-  "role1" :Share 0 *
-  "role2" :Resource 0 *)
-
-(association "Offers"
-  "role1" :Endpoint 0 *
-  "role2" :Share)
-
-(association "SubmittedBy"
-  "role1" :Endpoint 0 *
-  "role2" :Activity 1 *)
-
-(association "MappedInto"
-  "role1" :Activity 1 *
-  "role2" :Resource 0 *)
-
-(association "Runs"
-  "role1" :Activity 1 *
-  "role2" :Share 0 *)
-
-(association "RelatesTo"
-  "role1" :Activity 0 *)
-
-
-;---------------------------------------------------------------------------------------------------------------
-;temporary, to be resolved solution
-
-(generalization
-  (into :Policy)
-  (from :MappingPolicy :AccessPolicy))
-
-(generalization
-  (into :Domain)
-  (from :AdminDomain :UserDomain))
-
-(genralization
-  (into :Entity)
-  (from :Domain :Policy :Endpoint :Contact :Location :Service :Share :Resource :Activity :Manager))+(association
+  "Has"
+  (role :Extension :1 :1)
+  (role :Entity :0 :*))
+
+(association
+  "ParticipatesIn"
+  (role :UserDomain :0 :1)
+  (role "to" :UserDomain :0 :*))
+
+(association
+  "Creates"
+  (role :Activity :1 :*)
+  (role :UserDomain :0 :*))
+
+(association
+  "HasPolicies"
+  (role :UserDomain :0 :*)
+  (role :Policy :0 :1))
+
+(association
+  "Has"
+  (role :Contact :0 :*)
+  (role :Domain :0 :*))
+
+(association
+  "Has"
+  (role :Contact :0 :*)
+  (role :Service :0 :*))
+
+(association
+  "PrimarilyLocatedAt"
+  (role :Domain :1 :*)
+  (role :Location :0 :*))
+
+(association
+  "PrimarilyLocatedAt"
+  (role :Service :1 :*)
+  (role :Location :0 :*))
+
+(association
+  "RelatesTo"
+  (role :Service :0 :*)
+  (role "to" :Service :0 :*))
+
+(association
+  "ParticipatesIn"
+  (role :AdminDomain :1 :*)
+  (role "to" :AdminDomain :1 :*))
+
+(association
+  "Manages"
+  (role :AdminDomain :0 :*)
+  (role :Service :0 :*))
+
+(association
+  "Manages"
+  (role :Manager :0 :1)
+  (role :Resource :0 :*))
+
+(association
+  "Offers"
+  (role :Service :0 :*)
+  (role :Manager :1 :1))
+
+(association
+  "Offers"
+  (role :Service :0 :*)
+  (role :Share :1 :1))
+
+(association
+  "Exposes"
+  (role :Service :0 :*)
+  (role :Endpoint :1 :1))
+
+(association
+  "CanBeMappedInto"
+  (role :MappingPolicy :1 :1)
+  (role :Share :0 :*))
+
+(association
+  "CanAccess"
+  (role :AccessPolicy :1 :1)
+  (role :Endpoint :0 :*))
+
+(association
+  "DefinedOn"
+  (role :Share :0 :*)
+  (role :Resource :0 :*))
+
+(association
+  "Offers"
+  (role :Endpoint :0 :*)
+  (role :Share :0 :*))
+
+(association
+  "SubmittedBy"
+  (role :Endpoint :0 :*)
+  (role :Activity :1 :*))
+
+(association
+  "MappedInto"
+  (role :Activity :1 :*)
+  (role :Resource :0 :*))
+
+(association
+  "Runs"
+  (role :Activity :1 :*)
+  (role :Share :0 :*))
+
+(association
+  "RelatesTo"
+  (role :Activity :0 :*)
+  (role "to" :Activity :0 :*))


core.clj load; remove vice drop

core.clj load; remove vice drop

--- clojure/src/dataloader/core.clj
+++ clojure/src/dataloader/core.clj
@@ -160,11 +160,11 @@
   (mg/connect! { :host host })
   (mg/set-db! (mg/get-db db))
   (outln "okay")
-  (out "Dropping collections... ")
-  (coll/drop "namespaces")
-  (coll/drop "nsvalues")
-  (coll/drop "annotations")
-  (coll/drop "annovalues")
+  (out "Removing objects from collections... ")
+  (coll/remove "namespaces")
+  (coll/remove "nsvalues")
+  (coll/remove "annotations")
+  (coll/remove "annovalues")
   (outln "okay")
   (outln "\nNAMESPACES\n--")
   (doseq [x (namespace-urls residx)]


Fix valid-entry-labels? check.

Fix valid-entry-labels? check.

--- src/oc/storage/api/entries.clj
+++ src/oc/storage/api/entries.clj
@@ -140,7 +140,7 @@
     created-board))

 (defn valid-labels-list? [entry-labels]
-  (> (count entry-labels) config/max-entry-labels))
+  (<= (count entry-labels) config/max-entry-labels))

 (defn- valid-new-entry? [conn org-slug board-slug ctx]
   (let [org (org-res/get-org conn org-slug)
@@ -157,7 +157,7 @@
                         (create-publisher-board conn org author))]
     (cond (not board)
           [false, {:reason "Invalid board."}] ; couldn't find the specified board
-          (valid-labels-list? (:labels entry-map))
+          (not (valid-labels-list? (:labels entry-map)))
           [false, {:reason (format "Too many labels (%d): %s. Max allowed is %d" (count (:labels entry-map)) (s/join " | " (map :name (:labels entry-map))) config/max-entry-labels)}]
           :else
           (try
@@ -239,7 +239,7 @@
                      {})]
       (cond (not (lib-schema/valid? common-res/Entry updated-entry))
             [false, {:updated-entry (api-common/rep updated-entry)}] ; invalid update
-            (valid-labels-list? (:labels entry-props))
+            (not (valid-labels-list? (:labels entry-props)))
             [false, {:reason (format "Too many labels (%d): %s. Max allowed is %d" (count (:labels entry-props)) (s/join " | " (map :name (:labels entry-props))) config/max-entry-labels)}]
             :else
             (merge ctx-base


change mix to apply + to a list of ins rather than the old impl which was equivalent to plain +

--- src/overtone/sc/ugen/extra.clj
+++ src/overtone/sc/ugen/extra.clj
@@ -1,7 +1,7 @@
 (defn mix
-  "Mix down (sum) a set of input channels into a single channel."
-  [& inputs]
-  (reduce overtone.ugen-collide/+ inputs))
+  "Mix down (sum) a list of input channels into a single channel."
+  [ins]
+  (apply overtone.ugen-collide/+ ins))

 (defn square
   "a square wave generator."


Timeout for local command

Timeout for local command

--- src/brevis_utils/distributed_computing/dc_utils.clj
+++ src/brevis_utils/distributed_computing/dc_utils.clj
@@ -17,12 +17,12 @@
 (defn local-command
   "Default behavior is a nonblocking execution."
   ([command]
-    (local-command command false))
-  ([command blocking?]
-    (when @debug-mode (println "local-command:" command))
+    (local-command command nil))
+  ([command timeout]
+    (when @debug-mode (println "local-command:" command "with timeout:" timeout))
     (let [process (.exec (. Runtime getRuntime) command)]
-      (when blocking?
-        (.waitFor process)))))
+      (when timeout
+        (.waitFor process timeout java.util.concurrent.TimeUnit/MILLISECONDS)))))

 (defn remote-command
   [username server command]


Added sesssion state for home routes

Added sesssion state for home routes

--- src/portal_clj/routes/home.clj
+++ src/portal_clj/routes/home.clj
@@ -1,5 +1,6 @@
 (ns portal-clj.routes.home
   (:require [compojure.core :refer :all]
+            [ring.middleware.session :as session]
             [portal-clj.routes.admin :as admin]
             [portal-clj.routes.user :as user]
             [portal-clj.views.layout :as layout]
@@ -7,27 +8,37 @@
             [portal-clj.models.post :as post]
             [portal-clj.models.tag :as tag]))

-(defn home []
-  (layout/common (base/index (post/all))))
+(defn with-session [template session]
+  {:body template
+   :session session})

-(defn about []
-  (layout/common (base/about)))
+(defn home [session]
+  (-> (layout/common (base/index (post/all)))
+      (with-session session)))

-(defn tags []
-  (layout/common (base/tags (tag/all))))
+(defn about [session]
+  (-> (layout/common (base/about))
+      (with-session session)))

-(defn login []
-  (layout/common (base/login)))
+(defn tags [session]
+  (-> (layout/common (base/tags (tag/all)))
+      (with-session session)))

-(defn do-login [user-credentials]
-  (let [params (get user-credentials :params)]
+(defn login [session]
+  (-> (layout/common (base/login))
+      (with-session session)))
+
+(defn do-login [req]
+  (let [params (get req :params)
+        session (get req :session)]
     (if (= (get params :email) "idi@admin.com")
-      (layout/common (admin/home))
+      (-> (layout/common (admin/home))
+          (with-session session))
       (layout/common (user/home)))))

 (defroutes home-routes
-  (GET "/" [] (home))
-  (GET "/page/about" [] (about))
-  (GET "/page/tags" [] (tags))
-  (GET "/page/login" [] (login))
-  (POST "/page/login" user-cred (do-login user-cred)))
+  (GET "/" {session :session} (home session))
+  (GET "/page/about" {session :session} (about session))
+  (GET "/page/tags" {session :session} (tags session))
+  (GET "/page/login" {session :session} (login session))
+  (POST "/page/login" req (do-login req)))


(SERVER-3079) Use clj-shell-utils for shelling out to Dropsonde

Elsewhere in the server, we use our own shell execution library to
invoke other processes. This gives us control over the interface and
lets us ensure that we're not doing bad things like forking the JVM when
we shell out. This commit updates the Dropsonde invocation to use the
same utility.

--- src/clj/puppetlabs/services/analytics/dropsonde.clj
+++ src/clj/puppetlabs/services/analytics/dropsonde.clj
@@ -2,6 +2,7 @@
   (:require [clojure.java.shell :refer [sh]]
             [clojure.tools.logging :as log]
             [puppetlabs.i18n.core :as i18n]
+            [puppetlabs.puppetserver.shell-utils :as shell-utils]
             [puppetlabs.services.jruby.jruby-puppet-core :as jruby-puppet]))

 (def puppet-agent-ruby "/opt/puppetlabs/puppet/bin/ruby")
@@ -18,15 +19,16 @@
                        jruby-puppet/default-master-var-dir)
         logdir (get-in config [:jruby-puppet :master-log-dir]
                        jruby-puppet/default-master-log-dir)
-        result (sh puppet-agent-ruby dropsonde-bin "submit"
-                   :env {"GEM_HOME" dropsonde-dir
-                         "GEM_PATH" dropsonde-dir
-                         "HOME" dropsonde-dir
-                         "PUPPET_CONFDIF" confdir
-                         "PUPPET_CODEDIR" codedir
-                         "PUPPET_VARDIR" vardir
-                         "PUPPET_LOGDIR" logdir})]
-    (if (= 0 (:exit result))
+        result (shell-utils/execute-command puppet-agent-ruby
+                                            {:args [dropsonde-bin "submit"]
+                                             :env {"GEM_HOME" dropsonde-dir
+                                                   "GEM_PATH" dropsonde-dir
+                                                   "HOME" dropsonde-dir
+                                                   "PUPPET_CONFDIF" confdir
+                                                   "PUPPET_CODEDIR" codedir
+                                                   "PUPPET_VARDIR" vardir
+                                                   "PUPPET_LOGDIR" logdir}})]
+    (if (= 0 (:exit-code result))
       (log/info (i18n/trs "Successfully submitted module metrics via Dropsonde."))
       (log/warn (i18n/trs "Failed to submit module metrics via Dropsonde. Error: {0}"
-                          (:err result))))))
+                          (:stderr result))))))


Changed references in clojure implementation

--- Code/DiningPhilosophers/src/main/clojure/dining.clj
+++ Code/DiningPhilosophers/src/main/clojure/dining.clj
@@ -8,6 +8,12 @@
 (def forks (doall (map #(ref [% true]) (range (count philosophers))))) ;ref due to being a shared resource
 (def logger (agent 0))
 (def stopwatch (. Stopwatch (createStarted)))
+
+(def fork1 (ref true))
+(def fork2 (ref true))
+(def fork3 (ref true))
+(def fork4 (ref true))
+(def fork5 (ref true))

 (defn debug [_ id msg r]
   (println id \space msg "(" r ")")
@@ -33,26 +39,33 @@
                  (elapsed (. TimeUnit MILLISECONDS))))
       (shutdown-agents))))

-(defn behave [a id]
+(defn behave [a id left right]
   (dosync ; Initiate transaction
     (when (more-food?) ; Is there more food?
       ;(if (> 5 (rand-int 10))        ; Do I want to takeFood or think?
-      (if (got-forks? id) ; Are both of my forks available?
+      (if (and @left @right) ; Are both of my forks available?
         (do
-          (handle-forks id :take)
+          (ref-set left false)
+          (ref-set right false)
+          ;(handle-forks id :take)
           (alter rounds dec)
           (send-off logger debug id "ate      " @rounds)
-          (handle-forks id :release))
+          ;(handle-forks id :release)
+          (ref-set left true)
+          (ref-set right true))
         (do
           (send-off logger debug id "thinks   " @rounds))
         )))
   (Thread/sleep 100)
-  (send-off *agent* behave id)) ; Repeat above
+  (send-off *agent* behave id left right)) ; Repeat above

 (defn start []
-  (doseq [i (range (count philosophers))]
-    (send logger debug i "being sent off to dinner" @rounds)
-    (send-off (nth philosophers i) behave i)))
+  (do
+    (send-off (nth philosophers 0) behave 0 fork1 fork2)
+    (send-off (nth philosophers 1) behave 1 fork2 fork3)
+    (send-off (nth philosophers 2) behave 2 fork3 fork4)
+    (send-off (nth philosophers 3) behave 3 fork4 fork5)
+    (send-off (nth philosophers 4) behave 4 fork5 fork1)))

 (defn -main [& args]


Make ack-process tests more reliable

Make ack-process tests more reliable

- There were intermittent false failures when using timeouts
- Add a test to help ensure that messages get the proper acknowledgment

--- test/com/farmlogs/subscription/ack_process_test.clj
+++ test/com/farmlogs/subscription/ack_process_test.clj
@@ -35,7 +35,25 @@
       (a/>!! result-chan (send-result :ack))
       (a/close! input)
       (is (= [:ack :foo] (take-with-timeout output 10)))
-      (is (closed? ack-process))))
+      (is (nil? (a/<!! ack-process)))))
+
+  (testing "Messages get the correct acknowledgement."
+    (let [input (a/chan 1)
+          ack-process (ack-process input nil)
+          output (a/chan 1)
+          send-result (partial result output)
+          result-chan1 (a/chan 1)
+          result-chan2 (a/chan 1)]
+
+      (a/>!! input [result-chan1 :foo])
+      (a/>!! input [result-chan2 :bar])
+      (a/>!! result-chan1 (send-result :ack))
+      (a/>!! result-chan2 (send-result :nack))
+      (a/close! input)
+      (is (nil? (a/<!! ack-process)))
+      (a/close! output)
+      (is (= #{[:ack :foo] [:nack :bar]}
+             (a/<!! (a/into #{} output))))))

   (testing "All messages get ack'd even if ack input closes before worker result."
     (let [input (a/chan 1)
@@ -46,10 +64,10 @@

       (a/>!! input [result-chan :foo])
       (a/close! input)
-      (is (not (closed? ack-process)))
+      (is (= ::timeout (take-with-timeout ack-process 10)))
       (a/>!! result-chan (send-result :ack))
       (is (= [:ack :foo] (take-with-timeout output 10)))
-      (is (closed? ack-process))))
+      (is (nil? (a/<!! ack-process)))))

   (testing "Ack process keeps working if there's an exception in WorkerResult."
     (let [input (a/chan 1)
@@ -62,8 +80,8 @@
       (a/>!! input [result-chan1 :foo])
       (a/>!! input [result-chan2 :bar])
       (a/close! input)
-      (is (not (closed? ack-process)))
+      (is (= ::timeout (take-with-timeout ack-process 10)))
       (a/>!! result-chan2 (broken-result))
       (a/>!! result-chan1 (send-result :ack))
       (is (= [:ack :foo] (take-with-timeout output 10)))
-      (is (closed? ack-process)))))
+      (is (nil? (a/<!! ack-process))))))


(EZ-140) Allow excluding projects from ezbake resource search

Previously, ezbake would search all of the dependencies that it compiled
into the uberjar for ezbake config resources (e.g. CLI scripts and conf
files). However, we have a usecase now where one ezbake project is
wrapping another standalone ezbake project, so we want to exclude the
config from the wrapped project (puppetserver) and just use the fixtures
from the wrapping project (pe-puppetserver).

This commit adds a value, `excluded-ezbake-deps` to the `lein-ezbake`
config section, which contains a list of project symbols. These projects
will not be searched for packaging resources, but they will still be
included for compiling.

--- src/puppetlabs/ezbake/core.clj
+++ src/puppetlabs/ezbake/core.clj
@@ -880,6 +880,9 @@
                            (deploy-snapshot lein-project)
                            (:version lein-project))
         reproducible? (not (System/getenv "EZBAKE_ALLOW_UNREPRODUCIBLE_BUILDS"))
+        ;; Do not copy the contents of :resource-paths from the deps in this list.
+        ;; Items should be symbols of the form `namespace/project`, e.g. `puppetlabs/puppetserver`
+        exclude-resources-from (get-in lein-project [:lein-ezbake :exclude-resources-from])
         lein-project (update lein-project :dependencies
                              #(deputils/expand-snapshot-versions
                                 lein-project % {:reproducible? reproducible?}))]
@@ -892,21 +895,24 @@
       (cp-template-files template-dir)
       (cp-template-files (get-template-file "global")))
     (let [dependencies    (deputils/get-dependencies-with-jars lein-project)
-          config-files    (cp-shared-files dependencies get-config-files-in)
+          non-excluded-deps (remove
+                             (fn [item] (some #(= (:project item) %) exclude-resources-from))
+                             dependencies)
+          config-files    (cp-shared-files non-excluded-deps get-config-files-in)
           config-files    (concat config-files  (cp-project-config-files lein-project))
           system-config-files (cp-system-config-files lein-project)
-          _               (cp-shared-files dependencies get-cli-app-files-in)
+          _               (cp-shared-files non-excluded-deps get-cli-app-files-in)
           cli-app-files   (->> (str/join "/" [staging-dir "ext" "cli"])
                             fs/list-dir
                             (map #(relativize staging-dir %)))
-          bin-files       (cp-shared-files dependencies get-bin-files-in)
-          terminus-files  (cp-terminus-files dependencies build-target)
+          bin-files       (cp-shared-files non-excluded-deps get-bin-files-in)
+          terminus-files  (cp-terminus-files non-excluded-deps build-target)
           upstream-ezbake-configs (get-upstream-ezbake-configs lein-project)
           additional-uberjar-info (build-additional-uberjars! lein-project)
           additional-uberjar-filenames (map #(fs/base-name (:uberjar %)) additional-uberjar-info)
           timestamp (get-timestamp-string)]
-      (cp-shared-files dependencies get-cli-defaults-files-in)
-      (cp-shared-files dependencies get-build-scripts-files-in)
+      (cp-shared-files non-excluded-deps get-cli-defaults-files-in)
+      (cp-shared-files non-excluded-deps get-build-scripts-files-in)
       (cp-project-build-scripts lein-project)
       (if cli-app-files
         (cp-cli-wrapper-scripts (:name lein-project)))