using doseq let

using doseq let

--- src/aws/volumes.clj
+++ src/aws/volumes.clj
@@ -37,13 +37,15 @@
     :volumes first (get-in ks)))

 (defn handle-volumes
-   "attached and waits for ebs volumes"
+   "attaches and waits for ebs volumes"
    [{:keys [aws machine] :as spec} endpoint instance-id]
   (when (= (image-desc endpoint (image-id machine) :root-device-type) "ebs")
     (wait-for-attach endpoint instance-id [10 :minute]))
   (let [zone (instance-desc endpoint instance-id :placement :availability-zone)]
-    (doseq [{:keys [device size]} (aws :volumes)]
-      (let [{:keys [volume-id]} (with-ctx ec2/create-volume {:size size :availability-zone zone})]
+    (doseq [{:keys [device size]} (aws :volumes)
+            :let [{:keys [volume]}
+                  (with-ctx ec2/create-volume {:size size :availability-zone zone})
+                  {:keys [volume-id]} volume]]
         (wait-for {:timeout [10 :minute]}
            #(= "available" (volume-desc endpoint volume-id :state))
            {:type ::aws:ebs-volume-availability :message "Failed to wait for ebs volume to become available"})
@@ -51,7 +53,9 @@
           {:volume-id volume-id :instance-id instance-id :device device})
         (wait-for {:timeout [10 :minute]}
            #(= "attached" (volume-desc endpoint volume-id :attachments 0 :state))
-           {:type ::aws:ebs-volume-attach-failed :message "Failed to wait for ebs volume device attach"})))))
+           {:type ::aws:ebs-volume-attach-failed :message "Failed to wait for ebs volume device attach"})
+        (debug "attached volume" volume-id "owened by" instance-id)
+        )))

 (defn clear?
    "is this ebs clearable"
@@ -64,12 +68,13 @@
 (defn delete-volumes
   "Clear instance volumes"
   [endpoint instance-id system-id]
-  (doseq [{:keys [ebs device-name]} (-> (instance-desc endpoint instance-id) :block-device-mappings rest)]
+  (doseq [{:keys [ebs device-name]} (-> (instance-desc endpoint instance-id) :block-device-mappings rest)
+          :let [{:keys [volume-id]} ebs]]
     (when (clear? device-name system-id)
-      (trace "deleting volume" ebs)
-      (with-ctx ec2/detach-volume {:volume-id (ebs :volume-id)})
+      (debug "deleting volume" volume-id)
+      (with-ctx ec2/detach-volume {:volume-id volume-id})
       (wait-for {:timeout [10 :minute]}
-        #(= "available" (with-ctx (volume-desc endpoint (ebs :volume-id) :state)))
+        #(= "available" (volume-desc endpoint volume-id :state))
         {:type ::aws:ebs-volume-availability
          :message "Failed to wait for ebs volume to become available"})
-      (with-ctx ec2/delete-volume {:volume-id (ebs :volume-id)}))))
+      (with-ctx ec2/delete-volume {:volume-id volume-id}))))


better content-type handling

better content-type handling

--- src/io/sarnowski/swagger1st/parser.clj
+++ src/io/sarnowski/swagger1st/parser.clj
@@ -19,6 +19,13 @@
 ; add json capability to org.joda.time.DateTime
 (extend DateTime json/JSONWriter
   {:-write serialize-date-time})
+
+(def json-content-type?
+  ; TODO could be more precise but also complex
+  ; examples:
+  ;  application/json
+  ;  application/vnd.order+json
+  #"application/.*json")

 (defn throw-value-error
   "Throws a validation error if value cannot be parsed or is invalid."
@@ -72,26 +79,28 @@
   [request parameter-definition]
   (let [request-definition (-> request :swagger :request)
         ; TODO honor charset= definitions of content-type header
-        content-type (first (string/split (or
-                                            (get (:headers request) "content-type")
-                                            "application/octet-stream")
-                                          #";"))
+        [content-type charset] (string/split (or
+                                               (get (:headers request) "content-type")
+                                               "application/octet-stream")
+                                             #";")
+        content-type (string/trim content-type)
         allowed-content-types (into #{} (get request-definition "consumes"))
         ; TODO make this configurable
-        supported-content-types {"application/json" (fn [body] (json/read-json (slurp body)))}]
+        supported-content-types {json-content-type? (fn [body] (json/read-json (slurp body)))}]
+
     (if (allowed-content-types content-type)                ; TODO could be checked on initialization of ring handler chain
-      (if-let [deserialize-fn (get supported-content-types content-type)]
+      (if-let [deserialize-fn (second (first (filter (fn [[pattern _]] (re-matches pattern content-type)) supported-content-types)))]
         (try
           (deserialize-fn (:body request))
           (catch Exception e
-            (throw (ex-info (str "Malformed body. (" (str e)) {:http-code    400
-                                                               :content-type content-type}))))
-        ; TODO check during setup
-        (throw-value-error nil parameter-definition [(get parameter-definition "in") (get parameter-definition "name")] "its content-type is not supported"))
-      (throw (ex-info "Content type not allowed."
-                      {:http-code             406
-                       :content-type          content-type
-                       :allowed-content-types allowed-content-types})))))
+            (api/throw-error 400 (str "Body not parsable with given content type.")
+                             {:content-type content-type
+                              :error (str e)})))
+        ; if we cannot deserialize it, just forward it to the executing function
+        (:body request))
+      (api/throw-error 406 "Content type not allowed."
+                       {:content-type          content-type
+                        :allowed-content-types allowed-content-types}))))

 (def extractors
   {"path"     extract-parameter-path


CMR-2576 Fix poor indentation in delete-concept

--- access-control-app/src/cmr/access_control/data/access_control_index.clj
+++ access-control-app/src/cmr/access_control/data/access_control_index.clj
@@ -93,9 +93,9 @@
   [context concept-map]
   (let [id (:concept-id concept-map)]
     (m/delete-by-id (esi/context->search-index context)
-                       group-index-name
-                       group-type-name
-                       id)))
+                    group-index-name
+                    group-type-name
+                    id)))

 (defn delete-provider-groups
   "Unindexes all access groups owned by provider-id."


simplify pairs

simplify pairs

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

--- sandbox/AcquisitionEngine/src/main/java/main/sequence_generator.clj
+++ sandbox/AcquisitionEngine/src/main/java/main/sequence_generator.clj
@@ -27,15 +27,8 @@

 (def settings default-settings)

-(defn tails [x]
-  (loop [xi x tails []]
-    (if xi
-      (recur (next xi) (conj tails xi))
-      tails)))
-
 (defn pairs [x]
-  (for [xi (tails x)]
-    [(first xi) (second xi)]))
+  (partition 2 1 (concat x [nil])))

 (defn nest-loop [events dim-vals dim]
   (if dim-vals


adding or functionality

adding or functionality

--- src/flax/core.clj
+++ src/flax/core.clj
@@ -360,7 +360,15 @@
                 #(let [env (merge (:env config) {(keyword (-> fun-entry val ffirst (evaluate config))) %})]
                   (evaluate (->> fun-entry val (drop 1)) (assoc config :env env)))
                 coll)))
-
+
+          'or
+          (loop [args (-> fun-entry val)]
+            (when-not (empty? args)
+              (let [yield (evaluate (first args) config)]
+                (if (nil? yield)
+                  (recur (drop 1 args))
+                  yield))))
+
           ;; Functions
           (let [yield (apply (resolve fun) (evaluate (-> m first val) config))]
             (if (coll? yield)


added a jumbotron to the first two pages

--- src/anyviz/views.clj
+++ src/anyviz/views.clj
@@ -22,6 +22,11 @@
     [:div.container
       [:a.navbar-brand {:href "#"} @g/brand-name]
       [:ul.nav.navbar-nav]]])
+
+(defn jumbotron [title sub-title]
+  [:div.jumbotron
+    [:h1 title]
+    [:p sub-title]])

 (defn common-footer []
   [:div#footer.footer
@@ -145,6 +150,7 @@
         (nav-bar)
         [:div.container
           (breadcrumbs [["home" "/"]])
+          (jumbotron (str "Welcome to " @g/brand-name "!") "Step 1 is to get started please select a database from the list below")
           [:div.panel.panel-primary
             [:div.panel-heading
               [:h3.panel-title "Select a Database"]]
@@ -160,9 +166,14 @@
         (nav-bar)
         [:div.container
           (breadcrumbs [["home" "/"] (linkify-db db)])
+          (jumbotron "Almost there!" "Step 2 is to select a collection from the list below")
           [:div.panel.panel-primary
             [:div.panel-heading
               [:h3.panel-title "Select a Collection"]]
             [:div.panel-body
               (linked-items (map #(linkify-coll db %) colls))]]]
-        (common-footer)]]))+        (common-footer)]]))
+
+
+
+


document

document

--- src/voke/system/collision.cljs
+++ src/voke/system/collision.cljs
@@ -21,7 +21,9 @@
                 (shape2 :x))]))

 (sm/defn find-contacting-entity :- (s/maybe Entity)
-  "TODO: DOCUMENT SEMANTICS"
+  "Takes an Entity (one you're trying to move from one place to another) and a list of all of the
+  Entities in the game. Returns another Entity if the space `entity` is trying to occupy is already filled,
+  nil if the space `entity` is trying to occupy is empty."
   [entity :- Entity
    all-entities :- [Entity]]
   (let [entity-shape (entity :shape)
@@ -39,7 +41,7 @@
    publish-chan]
   (let [entity (event :moved-entity)]
     (if-let [contacted-entity (find-contacting-entity entity (event :all-entities))]
-      ; New position wasn't clear; contact!
+      ; New position wasn't clear; notify the world that a contact event occurred!
       (publish-event publish-chan {:event-type :contact
                                    :entities   [entity contacted-entity]})


bias drunkard's walk toward center

bias drunkard's walk toward center

--- src/voke/world/generation.cljs
+++ src/voke/world/generation.cljs
@@ -42,22 +42,29 @@
         width (count (first grid))]

     (loop [grid grid
-           [x y] [(rand-int width) (rand-int height)]]
+           x (rand-int width)
+           y (rand-int height)]

       (if (= (count-empty-spaces grid)
              num-empty-cells)
         grid

-        (recur (assoc-in grid [y x] :empty)
-               (case (rand-nth [:north :east :south :west])
-                 :north [x
-                         (bound-between (dec y) 0 height)]
-                 :east [(bound-between (inc x) 0 width)
-                        y]
-                 :south [x
-                         (bound-between (inc y) 0 height)]
-                 :west [(bound-between (dec x) 0 width)
-                        y]))))))
+        (let [base-directions [:north :south :east :west]
+              horizontal-direction-to-center (if (< x (/ width 2)) :east :west)
+              vertical-direction-to-center (if (< y (/ height 2)) :south :north)
+              direction (rand-nth (conj base-directions
+                                        horizontal-direction-to-center
+                                        vertical-direction-to-center))]
+
+          (recur (assoc-in grid [y x] :empty)
+                 (case direction
+                   :east (bound-between (inc x) 0 width)
+                   :west (bound-between (dec x) 0 width)
+                   x)
+                 (case direction
+                   :north (bound-between (dec y) 0 height)
+                   :south (bound-between (inc y) 0 height)
+                   y)))))))

 (comment
   (-> ::grid
@@ -68,7 +75,7 @@
       )

   (-> (full-grid 50 20)
-      (drunkards-walk 250)
+      (drunkards-walk 200)
       grid->str
       print
       )


cloaking connection creds in logs

cloaking connection creds in logs

--- src/chazel/core.clj
+++ src/chazel/core.clj
@@ -68,6 +68,12 @@

 (defonce c-instance (atom nil))

+(defn secrefy [{:keys [group-name
+                       group-password] :as conf}]
+  (-> conf
+      (cond-> group-name (assoc :group-name "********")
+              group-password (assoc :group-password "********"))))
+
 (defn client-instance
   ([] (client-instance default-client-config))
   ([conf]
@@ -75,7 +81,7 @@
       (if (and ci (instance-active? ci))
         ci
         (try
-          (info "connecting to: " conf)
+          (info "connecting to: " (secrefy conf))
           (reset! c-instance
                   (HazelcastClient/newHazelcastClient (client-config conf)))
           (catch Throwable t


Whitespace

Whitespace

--- src/cia/handler.clj
+++ src/cia/handler.clj
@@ -523,7 +523,7 @@
       :header-params [api_key :- s/Str]
       :capabilities #{:get-verdict :admin}
       (if-let [d (calculate-verdict @judgement-store {:type observable_type
-                                                   :value observable_value})]
+                                                      :value observable_value})]
         (ok d)
         (not-found)))))


Further improve alternate scrolling.

Further improve alternate scrolling.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -153,9 +153,7 @@
                                     prompt-string
                                     "\u001B[1;" (- height alternate-height 2) "r"
                                     "\u001B[" (- height alternate-height) ";" (+ prompt-width 1) "H")]
-	(print (str
-			 "\u001B[2J\u001B[1;" (- height alternate-height 2) "r"
-			 "\u001B[" (- height alternate-height 1) ";0H"))
+	(print (str "\u001B[2J\u001B[1;" (- height alternate-height 2) "r"))
 	(flush)
     (.setPrompt in-rdr adjusted-prompt-string)))

@@ -381,7 +379,9 @@
                        term-height (.getHeight term)]
 				   (binding [*out* stdout]
 					 (when @new-line
-					   (print (str "\u001B[" (- term-height alternate-height 3) ";0H\n"))
+					   (print (str "\u001B[" (- term-height alternate-height) ";0H"
+                                   "\u001B[0J"
+                                   "\u001B[" (- term-height alternate-height 3) ";0H\n"))
 					   (reset! new-line false))
 					 (print s)
 					 (when (.contains s "\n")


:use -> :require/:refer

:use -> :require/:refer

--- src/leiningen/ancient/maven_metadata.clj
+++ src/leiningen/ancient/maven_metadata.clj
@@ -1,9 +1,9 @@
 (ns ^{:doc "Maven Metadata Inspection for lein-ancient"
       :author "Yannick Scherer"}
   leiningen.ancient.maven-metadata
-  (:require [clojure.data.xml :as xml :only [parse-str]])
-  (:use [leiningen.ancient.version :only [version-sort version-map snapshot? qualified?]]
-        [leiningen.ancient.verbose :only [verbose]]))
+  (:require [clojure.data.xml :as xml :only [parse-str]]
+            [leiningen.ancient.version :refer [version-sort version-map snapshot? qualified?]]
+            [leiningen.ancient.verbose :refer [verbose]]))

 ;; ## Metadata Retrieval


do not gen var cls if no vars

do not gen var cls if no vars

--- src/cljss/core.cljs
+++ src/cljss/core.cljs
@@ -5,6 +5,8 @@
 (defonce ^:private sheet (create-sheet))

 (defn css [cls vars]
-  (let [var-cls (str "vars-" cls)]
-    (insert! sheet (build-css var-cls vars))
-    (str "css-" cls " " var-cls)))
+  (if (seq vars)
+    (let [var-cls (str "vars-" cls)]
+      (insert! sheet (build-css var-cls vars))
+      (str "css-" cls " " var-cls))
+    (str "css-" cls)))


runtime kebab-case->camelCase attributes in defstyled

--- src/cljss/core.cljs
+++ src/cljss/core.cljs
@@ -50,6 +50,21 @@
         anim-name))))

 ;; ==============================
+(defn -camel-case [k]
+  (if (or (keyword? k)
+          (string? k)
+          (symbol? k))
+    (let [[first-word & words] (cstr/split (name k) #"-")]
+      (if (or (empty? words)
+              (= "aria" first-word)
+              (= "data" first-word))
+        k
+        (-> (map cstr/capitalize words)
+            (conj first-word)
+            cstr/join
+            keyword)))
+    k))
+
 (defn -compile-class-name [props]
   (let [className
         (-> props
@@ -80,6 +95,16 @@
        flatten
        set))

+(defn -camel-case-attrs [props]
+  (reduce-kv
+    (fn [m k v]
+      (let [k (case k
+                :for :htmlFor
+                (-camel-case k))]
+        (assoc m k v)))
+    {}
+    props))
+
 (defn -styled [cls static vars attrs create-element]
   (let [clsn (str cls "-" (gensym))
         static (if ^boolean goog.DEBUG
@@ -97,5 +122,6 @@
             meta-attrs (-meta-attrs vars)
             className (str (-compile-class-name props) var-class)
             props (-> (apply dissoc props (concat attrs meta-attrs [:class :class-name :className]))
-                      (assoc :className className))]
+                      (assoc :className className)
+                      -camel-case-attrs)]
         (create-element props children)))))


CMR-3044: Reverted refs-match?

CMR-3044: Reverted refs-match?

--- system-int-test/src/cmr/system_int_test/data2/core.clj
+++ system-int-test/src/cmr/system_int_test/data2/core.clj
@@ -231,10 +231,10 @@
 (defn refs-match?
   "Returns true if the references match the expected items"
   [items search-result]
-  (is (= (set (map item->ref items))
-         ;; need to remove score etc. because it won't be available in collections
-         ;; to which we are comparing
-         (set (map #(dissoc % :score :granule-count) (:refs search-result))))))
+  (= (set (map item->ref items))
+     ;; need to remove score etc. because it won't be available in collections
+     ;; to which we are comparing
+     (set (map #(dissoc % :score :granule-count) (:refs search-result)))))

 (defn assert-refs-match
   "Asserts that the references match the results returned. Use this in place of refs-match? to


Re-format alias help output.

Re-format alias help output.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -104,7 +104,7 @@
     (fn []
       (doseq [c command-names]
         (when (map? (cmds c))
-          (println (str (name c) "\t" (vec (map name (c cmd-aliases))) "\n"
+          (println (str (name c) " " (vec (map #(symbol (name %)) (c cmd-aliases))) "\n"
                         "\t" (get-in cmds [c :short-info])))
           (when-let [li (get-in cmds [c :long-info])]
             (println (str "\t" li)))


Add option to enable printing of exception traces.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -30,6 +30,7 @@

 (def ^:dynamic *cli4clj-line-sep* (System/getProperty "line.separator"))

+(def print-exception-trace (atom false))

 (defn cli-repl-print
   "The default repl print function of cli4clj only prints non-nil values."
@@ -200,7 +201,9 @@
    Otherwise, the string representation of the passed argument is printed to stderr."
   (fn [arg] (instance? Exception arg)))
 (defmethod print-err-fn true [arg]
-  (println-err (.getMessage arg)))
+  (if @print-exception-trace
+    (.printStackTrace arg)
+    (println-err (.getMessage arg))))
 (defmethod print-err-fn false [arg]
   (println-err (str arg)))

@@ -208,7 +211,13 @@
   {:allow-eval false
    :cmds {:h :help
           :? :help
-          :q :quit}
+          :q :quit
+          :enable-trace {:fn (fn [arg]
+                               (when (= java.lang.Boolean (type arg))
+                                 (reset! print-exception-trace arg)
+                                 (println "Set print-exception-trace to:" @print-exception-trace)))
+                         :short-info "Enable/Disable Printing of Full Exception Traces"
+                         :long-info "When set to false (default), only the exception message will be printed when an exception occurs. When set to true, the full traces of exceptions will be printed."}}
    :eval-factory create-cli-eval-fn
    :help-factory create-cli-help-fn
    :help-cmd-entry-delimiter *cli4clj-line-sep*


dom/classed! should return element.

dom/classed! should return element.

--- src/cljs/c2/dom.cljs
+++ src/cljs/c2/dom.cljs
@@ -176,7 +176,8 @@
 (defn classed!
   "Add or remove `class` to element based on boolean `classed?`, returning element."
   [el class classed?]
-  (gclasses/enable (->dom el) (name class) classed?))
+  (gclasses/enable (->dom el) (name class) classed?)
+  el)

 ;;TODO: make these kind of shortcuts macros for better performance.
 (defn add-class! [el class] (classed! el class true))


more on mutations

more on mutations

--- src/tutorial/untangled_tutorial/H_Server_Interactions.cljs
+++ src/tutorial/untangled_tutorial/H_Server_Interactions.cljs
@@ -92,7 +92,24 @@

   ### Server Writes

-  TODO: Just like Om
+  TODO: Just like Om (:remote true); however adds in error handling triggering via tx fallbacks:
+
+  ```
+  (om/transact! this '[(app/f) (tx/fallback {:action mutation-symbol :param 1})])
+  ```
+
+  assuming the `app/f` mutation returns remote true, this sends `app/f` to the server. If the server throws an error
+  (via ex-info) then the fallback action's mutation symbol (a dispatch key for mutate) is invoked on the client with
+  params that include the client fallback params (`:param 1` in the example) and an `:error` key that includes the
+  details of the server exception (error type, message, and ex-info's data). Be sure to only throw serializable data
+  in the server!
+
+  You can have any number of fallbacks in a tx, and they will run in order if the transaction fails.
+
+  TODO: Clearing the remaining send queue, etc. The API does not support (but needs to) optional clearing of
+  the remainder of the send queue on the client as part of fallback handling. This might be necessary, say, in the case
+  where the tx that failed indicates the app state is invalid...additional network interactions are probably all going to
+  fail. What you want to do is trigger some kind of state reload to restore sanity.

   #### Updating an existing item

@@ -298,6 +315,6 @@

   ### Global Network activity marker

-  TODO: Document how to use the network activity marker to show a general purpose loading marker in the UI. Probably needs
-  a little implementation work still (though the marker exists, and is tested).
+  TODO: Document how to use the network activity marker to show a general purpose loading marker in the UI. Basically query
+  to the top-level (via an Om query link).
 ")


got that backwards

got that backwards

--- test/bifurcan/run_tests.clj
+++ test/bifurcan/run_tests.clj
@@ -10,5 +10,5 @@
     e/find-tests
     (remove #(-> % meta (contains? :benchmark)))
     (#(e/run-tests % #_{:report eftest.report.pretty/report, :capture-output? false}))
-    (#(if (= (:test %) (:pass %)) 0 1))
+    (#(if (pos? (:fail %)) 1 0))
     System/exit))


Fixes #64 a stacktrace while testing

Fixes #64 a stacktrace while testing

--- test/circle/test_system.clj
+++ test/circle/test_system.clj
@@ -1,4 +1,4 @@
-(ns circle.backend.build.test-system
+(ns circle.test-system
   (:use midje.sweet)
   (:require [circle.backend.ec2 :as ec2])
   (:use [circle.backend.action :only (action)])


GUI: index fix on remove tab

GUI: index fix on remove tab

--- src/gui/handler.clj
+++ src/gui/handler.clj
@@ -174,12 +174,20 @@
   "Handler function for closing a tab."
   [_]
   (if (not (zero? (tab-count)))
-    (let [active-tab (selection editor-tabs)]
+    (let [tab-index (:index (selection editor-tabs))]
       (if (tab-marked-new?)
         (alert "Saving aborted: The tab you are about to close contains unsaved changes.")
-        (let [node ((zipmap (vals @*node-tabs*) (keys @*node-tabs*)) (active-tab :index))]
-          (.remove editor-tabs (:index active-tab))
-          (swap! *node-tabs* #(dissoc % node)))))))
+        (let [node ((zipmap (vals @*node-tabs*) (keys @*node-tabs*)) tab-index)]
+          (.remove editor-tabs tab-index)
+          (swap! *node-tabs* #(dissoc % node))
+
+          ; after removing tab, correct the indexes in *node-tabs*, as they are not valid any longer
+          (swap! *node-tabs* #(apply conj (map (fn [[k v]]
+                                                (if (> v tab-index)
+                                                   {k (dec v)}
+                                                   {k v}
+                                                )) %)))
+          )))))

 ;; Listener
 (defn tab-mark-new-listener


Made do-begin return the resultset

Made do-begin return the resultset

do-begin now returns what it calculated.

--- src/control/core.clj
+++ src/control/core.clj
@@ -193,20 +193,21 @@
                " just needs "
                task-arg-count
                " arguments")))
-      (let [map-fn (if parallel pmap map)]
-        (binding [*enable-logging* (if (nil? log) true log)]
-          (if *enable-logging*
-            (println  (str bash-bold
-                           "Performing "
-                           (name clusterName)
-                           bash-reset
-                           (if parallel
-                             " in parallel"))))
-          (dorun (map-fn #(perform % user cluster task taskName args)
-                         addresses))
-          (dorun (map-fn #(perform (:host %) (:user %) cluster task taskName args)
-                         clients)))
-        (shutdown-agents)))))
+      (binding [*enable-logging* (if (nil? log) true log)]
+        (if *enable-logging*
+          (println  (str bash-bold
+                         "Performing "
+                         (name clusterName)
+                         bash-reset
+                         (if parallel
+                           " in parallel"))))
+        (let [map-fn (if parallel pmap map)
+              a (dorun (map-fn #(perform % user cluster task taskName args)
+                               addresses))
+              c (dorun (map-fn #(perform (:host %) (:user %) cluster task taskName args)
+                               clients))]
+          (shutdown-agents)
+          (concat a c))))))

 (defn begin []
   (do-begin *command-line-args*))


Flesh out Redis tests

Flesh out Redis tests

--- test/exploud/redis_test.clj
+++ test/exploud/redis_test.clj
@@ -7,7 +7,7 @@

 (binding [*dummy-connection* true]

-  (fact "Enqueuing something does the right thing"
+  (fact "that enqueuing something does the right thing"
         (enqueue ..task..) => ..id..
         (provided
          (car-mq/enqueue "scheduled-tasks" ..task..) => ..id..))
@@ -27,12 +27,94 @@
         (provided
          (car/del "exploud:lock") => ..result..))

-  (fact "Application/environment combination is not in-progress when not present"
+  (fact "that determining whether something is not paused when not present"
+        (paused? "app" "env" "region") => falsey
+        (provided
+         (car/hget "exploud:deployments:paused" "app-env-region") => nil))
+
+  (fact "that determining whether something is paused when present"
+        (paused? "app" "env" "region") => truthy
+        (provided
+         (car/hget "exploud:deployments:paused" "app-env-region") => "id"))
+
+  (fact "that getting paused deployments works"
+        (paused) => [{:application "app1" :environment "env1" :id "id1" :region "region1"}
+                     {:application "app2" :environment "env2" :id "id2" :region "region2"}]
+        (provided
+         (car/hgetall "exploud:deployments:paused") => ["app1-env1-region1" "id1" "app2-env2-region2" "id2"]))
+
+  (fact "that getting paused deployments works when nothing is paused"
+        (paused) => []
+        (provided
+         (car/hgetall "exploud:deployments:paused") => []))
+
+  (fact "that pausing a deployment is truthy when it wasn't already paused"
+        (pause "app" "env" "id" "region") => truthy
+        (provided
+         (car/hsetnx "exploud:deployments:paused" "app-env-region" "id") => 1))
+
+  (fact "that pausing a deployment is falsey when it wasn't already paused"
+        (pause "app" "env" "id" "region") => falsey
+        (provided
+         (car/hsetnx "exploud:deployments:paused" "app-env-region" "id") => 0))
+
+  (fact "that unpausing a deployment is truthy when it was already paused"
+        (resume "app" "env" "region") => truthy
+        (provided
+         (car/hdel "exploud:deployments:paused" "app-env-region") => 1))
+
+  (fact "that unpausing a deployment is falsey when it wasn't already paused"
+        (resume "app" "env" "region") => falsey
+        (provided
+         (car/hdel "exploud:deployments:paused" "app-env-region") => 0))
+
+  (fact "that determining whether a pause is registered is truthy when present"
+        (pause-registered? "app" "env" "region") => truthy
+        (provided
+         (car/sismember "exploud:deployments:awaiting-pause" "app-env-region") => 1))
+
+  (fact "that determining whether a pause is registered is falsey when not present"
+        (pause-registered? "app" "env" "region") => falsey
+        (provided
+         (car/sismember "exploud:deployments:awaiting-pause" "app-env-region") => 0))
+
+  (fact "that getting all deployments awaiting a pause works"
+        (awaiting-pause) => [{:application "app1" :environment "env1" :region "region1"}
+                             {:application "app2" :environment "env2" :region "region2"}]
+        (provided
+         (car/smembers "exploud:deployments:awaiting-pause") => ["app1-env1-region1" "app2-env2-region2"]))
+
+  (fact "that getting all deployments awaiting a pause works when there aren't any"
+        (awaiting-pause) => []
+        (provided
+         (car/smembers "exploud:deployments:awaiting-pause") => []))
+
+  (fact "that registering a pause is truthy when one wasn't already present"
+        (register-pause "app" "env" "region") => truthy
+        (provided
+         (car/sadd "exploud:deployments:awaiting-pause" "app-env-region") => 1))
+
+  (fact "that registering a pause is falsey when one was already present"
+        (register-pause "app" "env" "region") => falsey
+        (provided
+         (car/sadd "exploud:deployments:awaiting-pause" "app-env-region") => 0))
+
+  (fact "that unregistering a pause is truthy when one was present"
+        (unregister-pause "app" "env" "region") => truthy
+        (provided
+         (car/srem "exploud:deployments:awaiting-pause" "app-env-region") => 1))
+
+  (fact "that unregistering a pause is truthy when one was present"
+        (unregister-pause "app" "env" "region") => falsey
+        (provided
+         (car/srem "exploud:deployments:awaiting-pause" "app-env-region") => 0))
+
+  (fact "that a deployment is not in-progress when not present"
         (in-progress? "app" "env" "region") => falsey
         (provided
          (car/hget "exploud:deployments:in-progress" "app-env-region") => nil))

-  (fact "Application/environment combination is in-progress when present"
+  (fact "that a deployment is in-progress when present"
         (in-progress? "app" "env" "region") => truthy
         (provided
          (car/hget "exploud:deployments:in-progress" "app-env-region") => "id"))
@@ -49,12 +131,12 @@
      :id "id"
      :region "region"})

-  (fact "Beginning a deployment when one doesn't exist gives true"
+  (fact "that beginning a deployment when one doesn't exist gives true"
         (begin-deployment begin-deployment-params) => true
         (provided
          (car/hsetnx "exploud:deployments:in-progress" "app-env-region" "id") => 1))

-  (fact "Beginning a deployment when one already exists give false"
+  (fact "that beginning a deployment when one already exists give false"
         (begin-deployment begin-deployment-params) => false
         (provided
          (car/hsetnx "exploud:deployments:in-progress" "app-env-region" "id") => 0))
@@ -64,13 +146,13 @@
      :environment "env"
      :region "region"})

-  (fact "Ending a deployment which exists returns true"
+  (fact "that ending a deployment which exists returns true"
         (end-deployment end-deployment-params) => true
         (provided
          (car/srem "exploud:deployments:awaiting-pause" "app-env-region") => 0
          (car/hdel "exploud:deployments:in-progress" "app-env-region") => 1))

-  (fact "Ending a deployment which didn't exist returns false"
+  (fact "that ending a deployment which didn't exist returns false"
         (end-deployment end-deployment-params) => false
         (provided
          (car/srem "exploud:deployments:awaiting-pause" "app-env-region") => 0


makecontent.clj: ensure both key and value are non-nil

--- src/org/altlaw/jobs/post/makecontent.clj
+++ src/org/altlaw/jobs/post/makecontent.clj
@@ -19,7 +19,8 @@
   (binding [h/*reporter* reporter]
    (let [[key value] (my-map (read-string (str wkey))
                              (read-string (str wvalue)))]
-     (.collect output (Text. key) (Text. value)))))
+     (when (and key value)
+       (.collect output (Text. key) (Text. value))))))

 (defn tool-run [this args]
   (let [job (h/default-jobconf this)


Add static index middlware.

Add static index middlware.

--- src/incise/core.clj
+++ src/incise/core.clj
@@ -11,9 +11,17 @@
   (resources "/")
   (not-found (html5 [:h1 "404"])))

+(defn wrap-static-index [handler]
+  (fn [request]
+    (let [uri (:uri request)]
+      (handler (if (= (last uri) \/)
+                 (assoc request :uri (str uri "index.html"))
+                 request)))))
+
 (def app (-> routes
+             (wrap-static-index)
+             (wrap-reload)
              (wrap-stacktrace)
-             (wrap-reload)
              (asset-pipeline {:cache-mode :development
                               :engine :v8
                               :compress false})))


fixes home loading indicator

fixes home loading indicator

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

--- src/status_im/ui/screens/home/views.cljs
+++ src/status_im/ui/screens/home/views.cljs
@@ -98,7 +98,8 @@
                   {:keys [chats all-home-items search-filter]} [:home-items]
                   {:keys [hide-home-tooltip?]} [:multiaccount]]
     (if loading?
-      [react/activity-indicator {:flex 1 :animating true}]
+      [react/view {:flex 1 :align-items :center :justify-content :center}
+       [react/activity-indicator {:animating true}]]
       (if (and (empty? all-home-items) hide-home-tooltip? (not @search-active?))
         [welcome-blank-page]
         (let [data (if @search-active? chats all-home-items)]


Return measurements in random length units

Previous commits returned the magnitude of the measurements in feet
only.

This commit changes the implementations of
- typical-vertical-depth
- typical-measured-depth
- typical-toe-measured-depth

to
- Return a measurement in a random unit if not unit supplied
- Return a measuremment in the specified unit is supplied

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -106,15 +106,34 @@
       (apply make-measurement target-temperature to location)
       (make-measurement target-temperature to))))

-(defn typical-vertical-depth []
-  (tuc/draw-normal 8000 1216))
-
-(defn typical-measured-depth []
-  (+ (tuc/draw-normal 8000 1216)
-     (* 5280 (rand))))
-
-(defn typical-toe-measured-depth []
-  (tuc/draw-normal 18000 1500))
+(defn typical-vertical-depth
+  ([] (typical-vertical-depth (rand-length-unit)))
+  ([length-unit]
+   (let [typical-vertical-depth-in-feet
+         (fn [] (make-measurement (tuc/draw-normal 8000 1216) :ft))]
+     (condp = length-unit
+       :ft (typical-vertical-depth-in-feet)
+       :m (length-as (typical-vertical-depth-in-feet) :m)))))
+
+(defn typical-measured-depth
+  ([] (typical-measured-depth (rand-length-unit)))
+  ([length-unit]
+   (let [typical-measured-depth-in-feet
+         (fn [] (make-measurement (+ (tuc/draw-normal 8000 1216)  ;; horizontal
+                                     (* 5280 (rand)))  ;; typical vertical
+                                  :ft))]
+     (condp = length-unit
+       :ft (typical-measured-depth-in-feet)
+       :m (length-as (typical-measured-depth-in-feet) :m)))))
+
+(defn typical-toe-measured-depth
+  ([] (typical-toe-measured-depth (rand-length-unit)))
+  ([length-unit]
+   (let [typical-toe-measured-depth-in-feet
+         (fn [] (make-measurement (tuc/draw-normal 18000 1500) :ft))]
+     (condp = length-unit
+       :ft (typical-toe-measured-depth-in-feet)
+       :m (length-as (typical-toe-measured-depth-in-feet) :m)))))

 (defn typical-stage-top
   ([] (typical-stage-top (rand-length-unit)))
@@ -708,4 +727,3 @@
                     (repeat 12 :sliding-sleeve)
                     (repeat 5 :single-point-entry)
                     (repeat 3 :open-hole))))
-


Fix linter

Fix linter

--- test/icecap/schema_test.clj
+++ test/icecap/schema_test.clj
@@ -19,7 +19,8 @@
   (testing "plans with empty steps in them don't validate"
     (are [example reason] (= (pr-str (s/check Plan example))
                              (pr-str reason))
-      [#{} simple-http-step] ['(not ("collection of one or more plans" #{})) nil]))
+         [#{} simple-http-step] ['(not ("collection of one or more plans" #{}))
+                                 nil]))
   (testing "plans with unsupported steps don't validate, with useful error"
     (let [supported-types (into #{} (keys (methods get-schema)))]
       (are [example] (let [e (:type (s/check Plan example))


Fix ".." special case.

Fix ".." special case.

--- src/mash_commander/nix/filesystem.cljs
+++ src/mash_commander/nix/filesystem.cljs
@@ -31,7 +31,7 @@
     (str/join "\t" (keys (:files dir)))))

 (defn cd [param]
-  (if (= [".."] param)
+  (if (= ".." param)
     (om/transact! (fs-cursor) #(assoc % :cwd (drop-last (:cwd %))))
     (let [path (str/split param "/")
           cwd (:cwd @(fs-cursor))


Fake exception handling to pass fc gen test

--- test/onyx/flow_conditions/flow_conditions_gen_test.clj
+++ test/onyx/flow_conditions/flow_conditions_gen_test.clj
@@ -99,7 +99,9 @@
   (let [e (ex-info "hih" {})
         wrapped-e (ex-info "" {:exception e})]
     (is (thrown? clojure.lang.ExceptionInfo
-                 (r/route-data {} {:flow-conditions nil :egress-ids [:a :b]} nil wrapped-e)))))
+                 (r/route-data {}
+                               {:compiled-handle-exception-fn (constantly :restart)
+                                :flow-conditions nil :egress-ids [:a :b]} nil wrapped-e)))))

 (deftest conj-downstream-tasks-together
   (checking


Fix transducer ordering in new-webjar-resource

Accessing nonexisting path in webjar resource will result in a NullPointerException because the ordering of functions within the transducer `(comp (map io/resource) (drop-while nil?))` is reversed. `files` I.e. (sequence (comp (map io/resource) (drop-while nil?)) '(nil)) => NullPointerException.

--- ext/webjars/src/yada/resources/webjar_resource.clj
+++ ext/webjars/src/yada/resources/webjar_resource.clj
@@ -55,8 +55,8 @@
                               files (if (= (last path-info) \/)
                                       (map #(get assets (str path %)) index-files)
                                       (list (get assets path)))
-                              res (first (sequence (comp (map io/resource)
-                                                         (drop-while nil?))
+                              res (first (sequence (comp (drop-while nil?)
+                                                         (map io/resource))
                                                    files))]
                           (as-resource res))))})))


clean up

clean up

--- src-cljs/cljs_workcalendar/api.cljs
+++ src-cljs/cljs_workcalendar/api.cljs
@@ -63,12 +63,11 @@
           (nil? count))
     (throw (js/Error. "number of days is equal to zero"))
     (let [n (Math/abs count)
-          direction (if (> count 0) false true)
-          direction-int (if (> count 0) 1 -1)]
+          direction (if (> count 0) 1 -1)]
       (first
        (drop n
              (filter (fn [d] (is-workday d))
-                     (iterate (fn [d] (add-days d direction-int)) date)))))))
+                     (iterate (fn [d] (add-days d direction)) date)))))))

 (defn ^:export work-day-count [start-date end-date]
   (if (> (.getTime start-date)


Clean up

Clean up

--- src-cljs/kixi/hecuba/web/chart.cljs
+++ src-cljs/kixi/hecuba/web/chart.cljs
@@ -50,34 +50,36 @@

 ;;;;;;;;; Utils ;;;;;;;;;;;;;;;;;;;;;;

-(defn- fetch-data
+(defn- remove-chart []
+  (.remove (first (nodelist-to-seq (.getElementsByTagName js/document "svg")))))
+
+(defn- fetch-data!
   "The data need to be a vector."
   [cursor opts]
-  (om/update!
-   cursor #(assoc % :data (get mock-data (:selected cursor)))))
-
-(defn- remove-chart []
-  (.remove (first (nodelist-to-seq (.getElementsByTagName js/document "svg")))))
+  (om/transact! cursor (fn [cursor]
+                         (assoc cursor :data (get mock-data (:selected cursor)))))
+  ;(om/update! cursor #(assoc % :data (get mock-data (:selected cursor))))
+  )

 (defn- select-device!
   [cursor device-id]
   (.log js/console device-id)
  ; (remove-chart)
-  (om/update!
-   cursor #(assoc % :selected (vector device-id))))
+  (om/update! cursor [:selected] (constantly (vector device-id)))
+ ; (om/transact! cursor (fn [cursor] (assoc cursor :selected (vector device-id))))
+ ; (om/update! cursor #(assoc % :selected (vector device-id)))
+  )

 ;;;;;;;;;; Components ;;;;;;;;;;;;;;;;;

 (def chart-state
-  (atom {:selected ["01"]
+  (atom {:selected []
          :property "rad003"
          :devices [{:hecuba/name "01"
                     :name "External temperature"}
                    {:hecuba/name "02"
-                    :name "External humidity"}
-                   {:hecuba/name "03"
-                    :name "Ambient temperature"}]
-         :data (get mock-data "01")}))
+                    :name "External humidity"}]
+         :data []}))

 ;;;;;;;;;;; Component 1:  List of devices for axis plots ;;;;;;;;;;

@@ -101,16 +103,17 @@
   (fn [cursor opts]
     (reify
       om/IInitState
-      (init-state [_]
-        (om/update! cursor #(assoc % :selected "01")))
+      (init-state [this]
+        (om/update! cursor #(assoc % :selected (vector "01"))) ; TOFIX this does not update :selected
+        (.log js/console (get cursor :selected)))
       om/IWillMount
-      (will-mount [_]
-        (go (fetch-data cursor opts)))
+      (will-mount [this]
+        (fetch-data! cursor opts)) ;; TOFIX This does not update :data
       om/IRender
       (render [this]
         (dom/div #js {:id "chart"}))
       om/IDidMount
-      (did-mount [_ owner]
+      (did-mount [this owner]
         (let [Chart        (.-chart dimple)
               svg          (.newSvg dimple "#chart" 400 350)
               measurements (:data cursor)
@@ -128,7 +131,7 @@
   (fn [cursor owner]
     (reify
       om/IRender
-      (render [_]
+      (render [this]
         (dom/div #js {:className "devices"}
                  (dom/h3 nil (str "Metering data - " (get-in cursor [:property])))
                  (dom/h4 nil "Select devices to be plotted on the chart:")


Fix <main> width.

Fix <main> width.

--- src-cljs/pepa/style.cljs
+++ src-cljs/pepa/style.cljs
@@ -744,10 +744,8 @@
     tags-css
     upload-css

-    [:main {:height "100%"
-            :overflow-x :hidden
-            ;; :display :flex
-            }
+    [:main {:height "100%", :width "100%"
+            :overflow-x :hidden}
      workflow-css]]))

 ;;; Apply the CSS


[skip ci] Minor refactor

[skip ci] Minor refactor

--- build.boot
+++ build.boot
@@ -162,13 +162,14 @@
    t target       VAL kw   "The target for the cljs compiler."
    o opt          VAL kw   "The optimization level for the cljs compiler."
    s self-hosted?     bool "True if self-hosted."]
-  (case (or platform :clj)
-    :clj  (test-clj)
-    :cljs (case (or target :browser)
-            :browser (test-browser :opt    opt
-                                   :js-env :slimer)
-            :nodejs  (test-node :opt          opt
-                                :self-hosted? self-hosted?))))
+  (let [platform (or platform :clj)]
+    (case platform
+      :clj  (test-clj)
+      :cljs (case (or target :browser)
+              :browser (test-browser :opt    opt
+                                     :js-env :slimer)
+              :nodejs  (test-node :opt          opt
+                                  :self-hosted? self-hosted?)))))

 (deftask compile-cljs
   "Compiles the cljs source files."


Read deps.edn directly

Read deps.edn directly

--- build.boot
+++ build.boot
@@ -2,13 +2,14 @@
   :dependencies '[[org.clojure/test.check "0.9.0" :scope "test"]
                   [adzerk/boot-cljs "2.1.4" :scope "test"]
                   [javax.xml.bind/jaxb-api "2.3.0" :scope "test"]
-                  [org.clojars.oakes/boot-tools-deps "0.1.4.1" :scope "test"]]
+                  [seancorfield/boot-tools-deps "0.1.4" :scope "test"]]
   :repositories (conj (get-env :repositories)
                   ["clojars" {:url "https://clojars.org/repo/"
                               :username (System/getenv "CLOJARS_USER")
                               :password (System/getenv "CLOJARS_PASS")}]))

 (require
+  '[clojure.edn :as edn]
   '[adzerk.boot-cljs :refer [cljs]]
   '[clojure.java.io :as io]
   '[boot-tools-deps.core :refer [deps]])
@@ -19,7 +20,19 @@
        :version "2.5.5-SNAPSHOT"
        :description "An IDE for Clojure"
        :url "https://github.com/oakes/Nightcode"
-       :license {"Public Domain" "http://unlicense.org/UNLICENSE"}}
+       :license {"Public Domain" "http://unlicense.org/UNLICENSE"}
+       :dependencies (->> "deps.edn"
+                          slurp
+                          edn/read-string
+                          :deps
+                          (reduce
+                            (fn [deps [artifact info]]
+                              (if-let [version (:mvn/version info)]
+                                (conj deps
+                                  (transduce cat conj [artifact version]
+                                    (select-keys info [:scope :exclusions])))
+                                deps))
+                            []))}
   push {:repo "clojars"}
   aot {:namespace '#{nightcode.core
                      nightcode.lein}}
@@ -60,9 +73,9 @@

 (deftask local []
   (set-env! :resource-paths #{"src/clj" "src/cljs"})
-  (comp (deps) (pom) (jar) (install)))
+  (comp (pom) (jar) (install)))

 (deftask deploy []
   (set-env! :resource-paths #{"src/clj" "src/cljs"})
-  (comp (deps) (pom) (jar) (push)))
+  (comp (pom) (jar) (push)))


Remove Unused Message Id from Logging

Remove Unused Message Id from Logging

--- src/lens/broker.clj
+++ src/lens/broker.clj
@@ -89,7 +89,6 @@
               (lb/reject ch delivery-tag))
           (do (debug {:ch-num (.getChannelNumber ch)
                       :delivery-tag delivery-tag
-                      :message-id message-id
                       :cmd cmd})
               (try
                 (handle-command env cmd (:params cmd))


Normalize when setting as well

Normalize when setting as well

--- src/net/sekao/nightcode/controller.clj
+++ src/net/sekao/nightcode/controller.clj
@@ -342,7 +342,7 @@
 ; font

 (defn font! [^Scene scene]
-  (-> scene .getRoot (.setStyle (str "-fx-font-size: " (:text-size @pref-state))))
+  (-> scene .getRoot (.setStyle (str "-fx-font-size: " (u/normalize-text-size (:text-size @pref-state)))))
   (p/update-webviews! @pref-state @runtime-state))

 (defn font-dec! [^Scene scene]


add a bench-only test for indexing speed.

--- test/riemann/test/index.clj
+++ test/riemann/test/index.clj
@@ -46,3 +46,40 @@

            (is (= (map (fn [e] (:host e)) i)
                   [2]))))
+
+(defn random-event
+  [& {:as event}]
+  (merge {:host    (rand-int 100)
+          :service (rand-int 100)
+          :ttl     (rand-int 500)
+          :time    (- (unix-time) (rand-int 30))}
+         event))
+
+(deftest ^:bench indexing-nbhm-time
+  (let [_        (println "building events, this might take some time")
+        not-much (doall (repeatedly 100 random-event))
+        a-few    (doall (repeatedly 100000 random-event))
+        a-lot    (doall (repeatedly 1000000 random-event))
+        i        (nbhm-index)]
+    (println "updating and expiring the same 100 events 10000 times:")
+    (time (dotimes [iter 10000]
+            (do (doseq [event not-much]
+                  (update i event)))))
+    (println "expiring")
+    (time (dotimes [iter 10000] (doall (expire i))))
+    (clear i)
+
+    (println "updating and expiring the same 100000 events 100 times:")
+    (time (dotimes [iter 100]
+            (do (doseq [event a-few]
+                  (update i event)))))
+    (println "expiring")
+    (time (dotimes [iter 100] (doall (expire i))))
+    (clear i)
+
+    (println "updating and expiring the same 10000000 events 10 times:")
+    (time (dotimes [iter 10]
+            (do (doseq [event a-lot]
+                  (update i event)))))
+    (println "expiring")
+    (time (dotimes [iter 10] (doall (expire i))))))


4Clojure (~61)

4Clojure (~61)


Reduces count of generated roundtrip tests.

--- umm-spec-lib/test/cmr/umm_spec/test/generate_and_parse.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/generate_and_parse.clj
@@ -37,7 +37,7 @@
       (is (= (expected-conversion/convert expected-conversion/example-record metadata-format)
              (xml-round-trip expected-conversion/example-record metadata-format))))))

-(defspec roundtrip-generated-records 1000
+(defspec roundtrip-generated-records 100
   (for-all [umm-record (gen/no-shrink umm-gen/umm-c-generator)
             metadata-format (gen/elements tested-formats)]
     (is (= (expected-conversion/convert umm-record metadata-format)


switch es-client to jet as well

switch es-client to jet as well

--- src/org/spootnik/cyanite/es_client.clj
+++ src/org/spootnik/cyanite/es_client.clj
@@ -5,34 +5,34 @@
             [clojurewerkz.elastisch.rest :as rest]
             [clojurewerkz.elastisch.arguments :as ar]
             [clojure.string :as str]
-            [org.httpkit.client :as http]
+            [qbits.jet.client.http :as http]
             [cheshire.core :as json]
+            [clojure.core.async :refer [<! go]]
             [clojure.tools.logging :refer [error info debug]])
   (:import clojurewerkz.elastisch.rest.Connection))

 (defn multi-get
   [^Connection conn index mapping-type query func]
-  (http/post
-   (rest/index-mget-url conn index mapping-type)
-   {:body (json/encode {:docs query})}
-   #(if (= 200 (:status %))
-      (let [bod (json/decode (:body %) true)]
-        (func (filter :found (:docs bod))))
-      (error "ES responded with non-200: " %))))
+  (go
+    (let [url  (rest/index-mget-url conn index mapping-type)
+          resp (<! (http/post url {:body (json/encode {:docs query})}))]
+      (if (= 200 (:status resp))
+        (let [body (json/decode (:body resp) true)]
+          (func (filter :found (:docs body))))
+        (error "ES responded with non-200: " resp)))))

 (comment "Note: i've ditched the optional args to ES, refer to orignal elastich code for how they should return")

 (defn bulk-with-url
   [url operations func]
-  (let [bulk-json (map json/encode operations)
-        bulk-json (-> bulk-json
+  (let [bulk-json (-> (map json/encode operations)
                       (interleave (repeat "\n"))
                       (str/join))]
-    (http/post url
-               {:body bulk-json}
-               #(let [status (:status %)]
-                  (when (not= 200 status)
-                    (func %))))))
+    (go
+      (let [resp   (<! (http/post url {:body bulk-json}))
+            status (:status resp)]
+        (when-not (= 200 status)
+          (func resp))))))

 (defn remove-ids-from-docs
   [op-or-doc]


fix handle-key-down behavior

fix handle-key-down behavior

--- labs/architecture-examples/om/src/todomvc/app.cljs
+++ labs/architecture-examples/om/src/todomvc/app.cljs
@@ -21,11 +21,14 @@
       (into [] (map #(assoc % :completed checked) todos)))))

 (defn handle-new-todo-keydown [e app owner]
-  (when (not (identical? (.-which e) ENTER_KEY))
-    (om/update! app [:todos] conj
-      {:id (guid)
-       :title (.-value (dom/get-node owner "newField"))
-       :completed false})))
+  (when (identical? (.-which e) ENTER_KEY)
+    (let [new-field (dom/get-node owner "newField")]
+      (om/update! app [:todos] conj
+        {:id (guid)
+         :title (.-value new-field)
+         :completed false})
+      (set! (.-value new-field) ""))
+    false))

 (defn main [todos chans]
   (dom/component


Fix self-shadowing bug in transactions

Fix self-shadowing bug in transactions

--- src/derive/core.clj
+++ src/derive/core.clj
@@ -7,9 +7,10 @@
   `(binding [derive.core/*tracker* (if derive.core/*shadow*
                                      derive.core/*tracker*
                                      (derive.core/default-tracker))
+             parent-shadow?#      derive.core/*shadow*
              derive.core/*shadow* (or derive.core/*shadow* ~shadow?)]
      (let [result# (do ~@body)]
-       (when-not derive.core/*shadow*
+       (when-not parent-shadow?#
          (let [dmap# (derive.core/dependencies derive.core/*tracker*)]
            (~handler result# dmap#)))
        result#)))


Test text input and clearing

Test text input and clearing

--- test/clj_chrome_devtools/chrome_test.clj
+++ test/clj_chrome_devtools/chrome_test.clj
@@ -28,6 +28,10 @@
   (load-test-page)
   (testing "Typing into an input field works"
     (is (= "NO GREETING YET" (text-of "#greeting")))
-    (input-text [:#greeter :input] "old friend")
-    (click "#greeter button")
-    (is (= "Hello, old friend!" (text-of [:#greeting])))))
+    (doseq [txt ["old friend"
+                 "foo@bar"
+                 "keys [ that require $ modifiers"]]
+      (input-text [:#greeter :input] txt)
+      (click "#greeter button")
+      (is (= (str "Hello, " txt "!") (text-of [:#greeting])))
+      (clear-text-input [:#greeter :input]))))


switch ref for atomic boolean: fixes #1

switch ref for atomic boolean: fixes #1

--- src/irmgard/core.clj
+++ src/irmgard/core.clj
@@ -4,7 +4,8 @@
    [clojure.java.jdbc     :as jdbc]
    [clojure.tools.logging :as log])
   (:import
-   [java.sql Connection DriverManager]))
+   [java.sql Connection         DriverManager]
+   [java.util.concurrent.atomic AtomicBoolean]))

 ;; See:   "http://jdbc.postgresql.org/documentation/91/listennotify.html"
@@ -123,7 +124,7 @@
           dbname     (-> conf :dbconf :subname)
           sleep-time (:sleep-time conf 1000)]
       (loop [conf     conf
-             continue @(:continue conf)]
+             continue (.get (:continue conf))]
         (if continue
           (do
             (log/infof "db-watcher[%s] polling" dbname)
@@ -133,12 +134,12 @@
              (catch Exception e
                ;; do nothing
                ))
-            (recur conf @(:continue conf)))
+            (recur conf (.get (:continue conf))))
           (do
             (log/infof "db-watcher[%s] terminating" dbname)))))))

 (defn start-watcher [wname conf]
-  (let [control-atom   (atom true)
+  (let [control-atom   (AtomicBoolean. true)
         watcher-config {:conf     conf
                         :error    (atom nil)
                         :continue control-atom
@@ -150,7 +151,7 @@
 (defn stop-watcher [name]
   (let [conf (get @db-watchers name)]
     (when conf
-      (reset! (:continue conf) false)
+      (.lazySet (:continue conf) false)
       (.interrupt (:thread conf))
       (swap! db-watchers dissoc name))))

@@ -202,6 +203,10 @@
     (DriverManager/getConnection url (:username c) (:password c))))

 (comment
+  (register-listener :test-listener (:database (config :db)) "irmgard" "example_table"
+                     (fn [recs]
+                       (log/infof "ROW CHANGE! %s" recs)))
+
   (do
     (stop-watcher :test1)
     (start-watcher :test1 (db-conn-info (config :db))))
@@ -210,9 +215,6 @@
   (jdbc/with-connection  (db-conn-info (config :db))
     (exec-sql "SELECT now()" []))

-  (register-listener :test-listener (:database (config :db)) "irmgard" "example_table"
-                     (fn [recs]
-                       (log/infof "ROW CHANGE! %s" recs)))

   (jdbc/with-connection  (db-conn-info (config :db))
     (process-row-changes


Implement event creation API

Implement event creation API

--- src/checkin_halake/routes/admin.clj
+++ src/checkin_halake/routes/admin.clj
@@ -1,4 +1,5 @@
 (ns checkin-halake.routes.admin
+  (:refer-clojure :exclude [format])
   (:require [compojure.core :refer [defroutes GET POST PUT]]
             [checkin-halake.util :as util]
             [checkin-halake.models
@@ -6,7 +7,15 @@
              [admin :as admin]
              [ticket :as ticket]
              [events :as events]
-             [checkin :as checkin]]))
+             [checkin :as checkin]]
+            [clj-time
+             [format :as format]
+             [local :as local]]))
+
+(def format (format/formatter "yyyy-MM-dd HH:mm"))
+
+(defn- str->datetime [s]
+  (local/to-local-date-time (format/parse format s)))

 (defroutes ^:private admin-routes*
   (POST "/users" {{:keys [name password phone email]} :params}
@@ -21,7 +30,13 @@
           (when (and user (contains? ticket/ticket-types type))
             (ticket/add-ticket-to-user user type count)
             (let [tickets (ticket/available-tickets user)]
-              (util/response-with-status true :tickets tickets))))))
+              (util/response-with-status true :tickets tickets)))))
+  (POST "/events" {{:keys [title image-url event-at content-url]} :params}
+        (if-let [event-at (try (str->datetime event-at)
+                               (catch IllegalArgumentException _ nil))]
+          (let [event (events/register-event title image-url event-at content-url)]
+            (util/response-with-status true :event event))
+          (util/response-with-status false :reason "Wrong datetime format"))))

 (defn- wrap-check-admin [app]
   (fn [{:keys [user] :as req}]


Include the master in the build

Include the master in the build

--- src/circle/backend/build/config.clj
+++ src/circle/backend/build/config.clj
@@ -228,6 +228,12 @@
   {:actions (inference/infer-actions repo)
    :job-name "build-inferred"})

+(defn get-master
+  "Returns the master's ec2 instance-id or hostname"
+  []
+  (or (ec2/self-instance-id)
+      (circle.env/hostname)))
+
 (def config-action-name "configure the build")  ;; this is a def because other code depends on it.

 ;; defines a build action that does inference/configuring stuff. This should typically be the first action in a build.
@@ -256,6 +262,8 @@
                        :default inferred-config)
           node (or (-> proto-build :node) rails/rails-node)
           actions (-> proto-build :actions)
+          master (get-master)
+
           proto-build (dissoc proto-build :actions)]

       (dosync
@@ -263,6 +271,7 @@
        (alter build merge commit-details)
        (alter build assoc :node node)
        (alter build assoc :lb-name lb-name)
+       (alter build assoc :master master)
        (alter build assoc :vcs_revision vcs-revision)
        (alter build assoc :vcs-private-key (-> project :ssh_private_key))
        (alter build assoc :vcs-public-key (-> project :ssh_public_key))


render left panel as div

render left panel as div

--- src/clj/hsm/controllers/project.clj
+++ src/clj/hsm/controllers/project.clj
@@ -84,7 +84,8 @@
             (views/layout host
               ; [:h1 "Top Projects"]
               [:div.row
-                [:div.col-lg-2
+                [:div.col-lg-3
+                  (panelx "Social" "" ""
                   [:a.btn.btn-success {:href "#mc_embed _signup"} "Subscribe"]
                   [:p "Join " [:b 917] " others"]
                   [:p "No spamming. I promise!"]
@@ -98,8 +99,9 @@
                     } "Tell your friends"]
                   [:a.twitter-follow-button {:href "https://twitter.com/pythonhackers" :data-show-count true :data-size :small }]
                   [:div.fb-like {:data-href (format "http://%s/top-%s-projects" host platform)}]
+                  )
                 ]
-                [:div.col-lg-10
+                [:div.col-lg-9
                   (view-fn top-projects keyset)]]
               )))))))


Added missing deck validation rule

Added missing deck validation rule

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -44,7 +44,7 @@
 (defn parse-deck [side deck]
   (reduce #(if-let [card (parse-line side %2)] (conj %1 card) %1) [] (split-lines deck)))

-(defn allowed? [card {:keys [side faction title] :as deck}]
+(defn allowed? [card {:keys [side faction title] :as identity}]
   (and (not= (:type card) "Identity")
        (= (:side card) side)
        (or (not= (:type card) "Agenda")
@@ -110,7 +110,8 @@
 (defn valid? [{:keys [identity cards] :as deck}]
   (and (>= (card-count cards) (:minimumdecksize identity))
        (<= (influence deck) (:influencelimit identity))
-       (every? #(allowed? (:card %) identity) cards)
+       (every? #(and (allowed? (:card %) identity)
+                     (<= (:qty %) (or (get-in % [:card :limit]) 3))) cards)
        (or (= (:side identity) "Runner")
            (let [min (min-agenda-points deck)]
              (<= min (agenda-points deck) (inc min))))))


performance optimizations

performance optimizations

--- src/cljs/server/service/github.cljs
+++ src/cljs/server/service/github.cljs
@@ -26,8 +26,9 @@
 (defn- paginate
   [ch]
   (fn [err page]
-      (when page
-        (onto-chan ch (js->clj page) false))
+      (let [p (js->cljs (or page nil))]
+        (when (< 0 (count p))
+          (onto-chan ch p false)))

       (if (.hasNextPage client page)
         ; then
@@ -42,30 +43,30 @@
         author (-> config (.-github) (.-username))
         since  (time/ago (time/years 1))]
     (. RepoApi (getCommits (clj->js {:user      user
-                                     :repo      repo
-                                     :author    author
-                                     "per_page" 100
-                                     :since     (ctime/to-string since)})
+                                      :repo      repo
+                                      :author    author
+                                      "per_page" 100
+                                      :since     (ctime/to-string since)})
                            (paginate out-ch)))
     (conj acc out-ch)))

 (defn- reduce-commits [acc commit]
-  (let [formatter (ftime/formatter "yyyyMMdd")
-        date      (-> commit
-                      (get "commit")
-                      (get "committer")
-                      (get "date")
-                      (ctime/from-string))]
-    (merge-with + acc {(ftime/unparse formatter date) 1})))
+  (let [date (-> commit
+                (get-in ["commit" "committer" "date"])
+                (js/Date.)
+                (.toLocaleDateString))]
+    (merge-with + acc {date 1})))

 ; @TODO: account for error in all requests
 ; @TODO: native clj transformations to transit
 (defn get-activity
   []
-  ; paginate through all user repos
-  (.getAll RepoApi (clj->js {"per_page" 100}) (paginate repo-ch))
-  ; reduce over commits and add them together
+  (.getAll RepoApi #js {"per_page" 100}
+                   (paginate repo-ch))
   (go
+    ; paginate through all user repos
+
+    ; reduce over commits and add them together
     (->> repo-ch
          (async/reduce reduce-repos [])
          (<!)


minor simplification

minor simplification

--- src/cljs/tictactoe/logic/logic.cljs
+++ src/cljs/tictactoe/logic/logic.cljs
@@ -43,6 +43,7 @@
     (update :player next-player)
     ))

+
 ;; --------------------------------------------------------
 ;; Game logic (public)
 ;; --------------------------------------------------------
@@ -82,6 +83,6 @@
   [game-state]
   (let [current-board (get-board game-state)]
     (or
-      (not (some #{:cell/empty} (map second current-board)))
+      (not-any? #{:cell/empty} (map second current-board))
       (has-winner? current-board)
       )))


Enable snippet for `pixel-density` for cljs. Issue #255.

--- src/cljc/quil/snippets/environment.cljc
+++ src/cljc/quil/snippets/environment.cljc
@@ -109,13 +109,11 @@
   (q/fill 0)
   (q/text-num (q/display-density) 10 20))

-#?(:clj
-   (defsnippet pixel-density
-     "pixel-density"
-     {:settings #(q/pixel-density 1)}
+(defsnippet pixel-density
+  "pixel-density"
+  {:settings #(q/pixel-density 1)}

-     (q/background 255)
-     (q/fill 0)
-     (q/ellipse 102 102 200 200)
-     (q/triangle 200 200 400 300 300 400)))
-
+  (q/background 255)
+  (q/fill 0)
+  (q/ellipse 102 102 200 200)
+  (q/triangle 200 200 400 300 300 400))


Initialize stats view component with InitState

--- src/cljs/sidequarter_frontend/core.cljs
+++ src/cljs/sidequarter_frontend/core.cljs
@@ -14,14 +14,25 @@
 (defonce app-state (atom {}))

 (defn sidekiq-stats-view [data owner]
-  (om/component
-   (dom/ul #js {:className "sidekiq-stats h-list"}
-           (dom/li nil (str "Busy: " (data :busy)))
-           (dom/li nil (str "Enqueued: " (data :enqueued)))
-           (dom/li nil (str "Scheduled: " (data :scheduled)))
-           (dom/li nil (str "Retries: " (data :retries)))
-           (dom/li nil (str "Failed: " (data :failed)))
-           (dom/li nil (str "Processed: " (data :processed))))))
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:stats {}})
+    om/IWillMount
+    (will-mount [_]
+      (go
+        (let [response ((<! (api/get-stats (data :id))) :body)
+              stats (:stats response)]
+          (om/set-state! owner :stats stats))))
+    om/IRenderState
+    (render-state [_ {:keys [stats]}]
+      (dom/ul #js {:className "sidekiq-stats h-list"}
+              (dom/li nil (str "Busy: " (stats :busy)))
+              (dom/li nil (str "Enqueued: " (stats :enqueued)))
+              (dom/li nil (str "Scheduled: " (stats :scheduled)))
+              (dom/li nil (str "Retries: " (stats :retries)))
+              (dom/li nil (str "Failed: " (stats :failed)))
+              (dom/li nil (str "Processed: " (stats :processed)))))))

 (defn sidekiq-redis-view [data owner]
   (om/component
@@ -40,12 +51,6 @@

 (defn sidekiq-view [data owner]
   (reify
-    om/IWillMount
-    (will-mount [_]
-      (go
-        (let [response ((<! (api/get-stats (data :id))) :body)
-              stats (:stats response)]
-          (om/update! data [:stats] stats))))
     om/IRender
     (render [_]
       (dom/div #js {:className "sidekiq col s12" :id (data :id)}
@@ -55,7 +60,7 @@
                         (dom/div #js {:className "col s4"}
                                  (om/build sidekiq-redis-view data))
                         (dom/div #js {:className "col s11"}
-                                 (om/build sidekiq-stats-view (get data :stats {})))
+                                 (om/build sidekiq-stats-view data))
                         (dom/div #js {:className "col s1"}
                                  (om/build sidekiq-read-more data)))))))


default gravatar pic fix

default gravatar pic fix

--- src/cljs/swarmpit/component/header.cljs
+++ src/cljs/swarmpit/component/header.cljs
@@ -26,7 +26,7 @@
     {:className "Swarmpit-appbar-avatar"
      :src       (str "https://www.gravatar.com/avatar/"
                      (user-gravatar-hash (storage/email))
-                     "?d=https://raw.githubusercontent.com/swarmpit/swarmpit/issues/159/resources/public/img/user.png")}))
+                     "?d=https://raw.githubusercontent.com/swarmpit/swarmpit/master/resources/public/img/user.png")}))

 (rum/defc user-info < rum/static []
   (html


remove debug

remove debug

--- src/com/billpiel/sayid/inner_trace3.clj
+++ src/com/billpiel/sayid/inner_trace3.clj
@@ -769,7 +769,6 @@
                         (util/macroexpand-in-ns ns-sym $)
                         get-fn
                         (xpand-fn* meta''))]
-    (clojure.pprint/pprint traced-form)
     (try (util/eval-in-ns (-> ns' str symbol)
                           traced-form)
          (catch Exception e


Finish tests for shotgun

Finish tests for shotgun

--- test/beehive/patterns_test.clj
+++ test/beehive/patterns_test.clj
@@ -68,4 +68,12 @@

 (deftest shotgun-test
   (testing "Acquire attempts are distributed to multiple beehives."
-    ))
+    (let [shotgun (patterns/shotgun [beehive1 beehive2 beehive3] 2)
+          beehives (atom #{})]
+      (doseq [_ (range 20)]
+        (let [hives (patterns/pattern-seq shotgun)]
+          (is (= 2 (count (set (map :name hives)))))
+          (doseq [hive hives]
+            (swap! beehives conj hive)
+            (hive/release-raw-permits hive 1))))
+      (is (= beehives (set [beehive1 beehive2 beehive3]))))))


add error handler in make-caching-store

add error handler in make-caching-store

--- src/keypin/store.clj
+++ src/keypin/store.clj
@@ -166,7 +166,15 @@
   (let [data? (not (instance? IDeref store))
         state (agent {:kvdata (when data?
                                 store)
-                      :cache  {}})
+                      :cache  {}}
+                :error-handler (fn [state ^Throwable ex]
+                                 (let [err-ts (i/now-millis)]
+                                   (binding [*out* *err*]
+                                     (printf "Error updating caching store for %s at %s\n"
+                                       (i/as-str store)
+                                       (.format (SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSSXXX") (Date. err-ts)))
+                                     (cs/print-stack-trace ex)
+                                     (flush)))))
         fetch (if data?
                 (fn []
                   @state)


Fix tests related to httpbasic backend.

Fix tests related to httpbasic backend.

--- test/buddy/test_buddy_auth.clj
+++ test/buddy/test_buddy_auth.clj
@@ -16,10 +16,9 @@
     {:headers {}}))

 (defn httpbasic-auth-fn
-  [request parsed-data]
-  (let [username (:username parsed-data)]
-    (cond
-      (= username "foo") :foo)))
+  [request {:keys [username]}]
+  (when (= username "foo")
+    :foo))

 (def secret-key "test-secret-key")

@@ -192,15 +191,7 @@
       (is (= (:status resp) 403)))))

 (deftest authentication-middleware-test-with-httpbasic
-  (testing "Auth middleware with http-basic backend 01"
-    (let [backend (http-basic-backend {:realm "Foo"})
-          handler (fn [req] req)
-          handler (wrap-authentication handler backend)
-          req     (make-httpbasic-request "user" "pass")
-          resp    (handler req)]
-        (is (nil? (:identity resp)))))
-
-  (testing "Auth middleware with http-basic backend 02"
+  (testing "Auth middleware with http-basic backend"
     (let [backend (http-basic-backend {:realm "Foo" :authfn httpbasic-auth-fn})
           handler (fn [req] req)
           handler (wrap-authentication handler backend)]


[#2388] Add expected paths in derive-category op

--- backend/src/akvo/lumen/lib/auth.clj
+++ backend/src/akvo/lumen/lib/auth.clj
@@ -89,6 +89,8 @@
                  "/api/datasets/:id" {:methods #{:get :put :delete}}
                  "/api/datasets/:id/meta" {:methods #{:get}}
                  "/api/datasets/:id/update" {:methods #{:post}}
+                 "/api/datasets/:id/sort/:column-name/text" {:methods #{:get}}
+                 "/api/datasets/:id/sort/:column-name/number" {:methods #{:get}}
                  "/api/datasets" {:methods #{:get}}
                  "/api/visualisations" {:methods #{:get :post}}
                  "/api/visualisations/:id" {:methods #{:get :put :delete}}


Rudimentary lock preventing concurrent deployment of same application and environment combination

--- src/exploud/web.clj
+++ src/exploud/web.clj
@@ -106,6 +106,41 @@
      (response "Exploud is currently closed for business." "text/plain" 409)
      (do ~@body)))

+(def ongoing-deployments
+  "An atom containing the set of all in-progress deployments."
+  (atom #{}))
+
+(defn- deployment-string
+  "Generate a string which combined the environment and application name."
+  [application environment]
+  (str environment "-" application))
+
+(defn- can-deploy?
+  "Determine whether the set of ongoing deployment already contains an entry for the environment and application."
+  [application environment]
+  (contains? @ongoing-deployments (deployment-string application environment)))
+
+(defn- register-deployment
+  "Register a deployment in the set of ongoing deployments."
+  [application environment]
+  (swap! ongoing-deployments conj (deployment-string application environment)))
+
+(defn- unregister-deployment
+  "Removes a deployment from the set of ongoing deployments."
+  [application environment]
+  (swap! ongoing-deployments disj (deployment-string application environment)))
+
+(defmacro one-at-a-time-please
+  "We only allow one action against an application in an environment at a time."
+  [application environment & body]
+  (if (can-deploy? application environment)
+    (try
+      (register-deployment application environment)
+      (do ~@body)
+      (finally
+        (unregister-deployment application environment)))
+    (response (str "An action for " application " in " environment " is already underway") "text/plain" 409)))
+
 (defroutes routes
   "The RESTful routes we provide."

@@ -235,70 +270,48 @@
              (response body nil 201))
            (error-response "Illegal application name" 400))))

-   (POST "/applications/:application/deploy"
-         [application ami environment hash message user]
-         (guarded
-          (log/warn application "being deployed to" environment "using deprecated API")
-          (let [{:keys [id]} (dep/prepare-deployment
-                              default-region
-                              application
-                              environment
-                              (or user default-user)
-                              ami
-                              hash
-                              message)]
-            (dep/start-deployment id)
-            (response {:id id}))))
-
    (POST "/applications/:application/:environment/deploy"
          [application ami environment hash message user]
          (guarded
-          (let [{:keys [id]} (dep/prepare-deployment
-                              default-region
-                              application
-                              environment
-                              (or user default-user)
-                              ami
-                              hash
-                              message)]
-            (dep/start-deployment id)
-            (response {:id id}))))
+          (one-at-a-time-please application environment
+                                (register-deployment application environment)
+                                (let [{:keys [id]} (dep/prepare-deployment
+                                                    default-region
+                                                    application
+                                                    environment
+                                                    (or user default-user)
+                                                    ami
+                                                    hash
+                                                    message)]
+                                  (dep/start-deployment id)
+                                  (response {:id id})))))

    (POST "/applications/:application/:environment/undo"
          [application environment]
          (guarded
-          (if-let [deployment (first (store/get-deployments {:application application
-                                                             :environment environment
-                                                             :size 1}))]
-            (let [{:keys [id]} (dep/prepare-undo deployment)]
-              (dep/start-deployment id)
-              (response {:id id}))
-            (error-response "No previous deployment" 500))))
-
-   (POST "/applications/:application/rollback"
-         [application environment message user]
-         (guarded
-          (log/warn application "being rolled back in" environment "using deprecated API")
-          (let [{:keys [id]} (dep/prepare-rollback
-                              default-region
-                              application
-                              environment
-                              (or user default-user)
-                              message)]
-            (dep/start-deployment id)
-            (response {:id id}))))
+          (one-at-a-time-please application environment
+                                (register-deployment application environment)
+                                (if-let [deployment (first (store/get-deployments {:application application
+                                                                                :environment environment
+                                                                                :size 1}))]
+                                  (let [{:keys [id]} (dep/prepare-undo deployment)]
+                                    (dep/start-deployment id)
+                                    (response {:id id}))
+                                  (error-response "No previous deployment" 500)))))

    (POST "/applications/:application/:environment/rollback"
          [application environment message user]
          (guarded
-          (let [{:keys [id]} (dep/prepare-rollback
-                              default-region
-                              application
-                              environment
-                              (or user default-user)
-                              message)]
-            (dep/start-deployment id)
-            (response {:id id}))))
+          (one-at-a-time-please application environment
+                                (register-deployment application environment)
+                                (let [{:keys [id]} (dep/prepare-rollback
+                                                    default-region
+                                                    application
+                                                    environment
+                                                    (or user default-user)
+                                                    message)]
+                                  (dep/start-deployment id)
+                                  (response {:id id})))))

    (GET "/environments"
         []
@@ -306,7 +319,15 @@

    (GET "/tasks"
         []
-        (response (with-out-str (at-at/show-schedule tasks/pool)))))
+        (response (with-out-str (at-at/show-schedule tasks/pool))))
+
+   (GET "/in-progress"
+        []
+        (response {:deployments (sort @ongoing-deployments)}))
+
+   (DELETE "/in-progress/:application/:environment"
+           [application environment]
+           (unregister-deployment application environment)))

   (route/not-found (error-response "Resource not found" 404)))


Add some docstrings

Add some docstrings

--- src/extremo/db.cljs
+++ src/extremo/db.cljs
@@ -5,17 +5,23 @@

 (def repo-path "./content/notes/.git")

-(defn open-repo []
-  (-> (.resolve path "./content/notes/.git")
+(defn open-repo
+  "Returns a promise for the repo specified by repo-path."
+  []
+  (-> (.resolve path repo-path)
       (nodegit.Repository.open)
       (.catch #(js/console.error "Something went wrong opening repo: " %))))

-(defn get-entry-by-path [repo filepath]
+(defn get-entry-by-path
+  "Returns a promise for the entry specified by filepath in repo."
+  [repo filepath]
   (-> repo
       (.then #(.getMasterCommit %))
       (.then #(.getEntry % filepath))))

 (defn get-file-history
+  "Returns a promise for hash-map containing information data about
+   file specified by filepath."
   [filepath]
   ;; TODO: At the momment this will only fetch 50 commits into the
   ;;       file history. It may be that the max that fileHisotryWalk


Only production with valid manifests can be set to recorded

Also adapt to some api changes in validation/*-validation-errors

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -77,57 +77,65 @@
 (defn import-new-production
   "Import a new production from file `f`"
   [f]
-  (if-let [errors (validation/open-validation-errors f)]
-    errors
-    (prod/update-or-create! (read-file f))))
+  (let [errors (validation/open-validation-errors f)]
+    (if (seq errors)
+      errors
+      (prod/update-or-create! (read-file f)))))

 (defn import-recorded-production
   "Import a recorded production from file `f`"
   [f]
-  (if-let [errors (validation/recorded-validation-errors f)]
-    errors
-    (let [{product_number :product_number :as new-production}
-          (-> (read-file f)
-              ;; ignore production_type and periodical_number when
-              ;; importing a recorded production
-              ;; periodical_number is wrong because the XML exported
-              ;; for a recorded production lacks the mvl_only field
-              ;; and hence the production_type and the
-              ;; periodical_number will be wrong
-              (dissoc :production_type :periodical_number))
-          production (prod/find-by-productnumber product_number)]
-      (cond
-        (empty? production)
-        (format "Non-existing product number %s" product_number)
-        (not= "structured" (:state production))
-        (format "Production %s is not structured (%s instead)"
-                product_number (:state production))
-        (not (prod/manifest? production))
-        (format "Production %s has no DAISY Export in %s"
-                product_number (path/manifest-path production))
-        :else (-> production
+  (let [errors (validation/recorded-validation-errors f)]
+    (if (seq errors)
+      errors
+      (let [{product_number :product_number :as new-production}
+            (-> (read-file f)
+                ;; ignore production_type and periodical_number when
+                ;; importing a recorded production
+                ;; periodical_number is wrong because the XML exported
+                ;; for a recorded production lacks the mvl_only field
+                ;; and hence the production_type and the
+                ;; periodical_number will be wrong
+                (dissoc :production_type :periodical_number))
+            production (prod/find-by-productnumber product_number)]
+        (cond
+          (empty? production)
+          [(format "Non-existing product number %s" product_number)]
+          (not= "structured" (:state production))
+          [(format "Production %s is not structured (%s instead)"
+                   product_number (:state production))]
+          (not (prod/manifest? production))
+          [(format "Production %s has no DAISY Export in %s"
+                   product_number (path/manifest-path production))]
+          :else
+          (let [errors (prod/manifest-validate production)]
+            (if (seq errors)
+              errors
+              (-> production
                   (merge new-production)
-                  prod/set-state-recorded!)))))
+                  prod/set-state-recorded!))))))))

 (defn import-status-request
   "Import a status request from file `f`"
   [f]
-  (if-let [errors (validation/status-request-errors f)]
-    errors
-    (let [{product_number :product_number} (read-file f)
-          production (prod/find-by-productnumber product_number)]
-      (msg/publish (queues/notify-abacus) production)
-      production)))
+  (let [errors (validation/status-request-errors f)]
+    (if (seq errors)
+      errors
+      (let [{product_number :product_number} (read-file f)
+            production (prod/find-by-productnumber product_number)]
+        (msg/publish (queues/notify-abacus) production)
+        production))))

 (defn import-metadata-update
   "Import a metadata update request from file `f`"
   [f]
-  (if-let [errors (validation/metadata-sync-errors f)]
-    errors
-    (prod/update!
-     (-> (read-file f)
-         ;; ignore production_type when updating metadata
-         (dissoc :production_type)))))
+  (let [errors (validation/metadata-sync-errors f)]
+    (if (seq errors)
+      errors
+      (prod/update!
+       (-> (read-file f)
+           ;; ignore production_type when updating metadata
+           (dissoc :production_type))))))

 (defn wrap-rows
   "Wrap an export record according to ABACUS conventions"


belongs to #119: switched images back to 32x32

--- config.clj
+++ config.clj
@@ -5,6 +5,6 @@
  :host          "localhost"
  :run-mode      :prod
  ; {username} is replaced with the username
- :avatar-url   "https://.../users/{username}/avatar/48x48"
+ :avatar-url   "https://.../users/{username}/avatar/32x32"
  ;:avatar-url    "http://assets.github.com/images/gravatars/gravatar-user-420.png"
  :profile-url-prefix    "https://intern.innoq.com/liqid/users/"}


remove unused import

remove unused import

--- dev/user.clj
+++ dev/user.clj
@@ -23,8 +23,7 @@
             [clojure.java.io :as io]
             [clojure.tools.namespace.repl :as nrepl]
             [clojure.java.shell :refer (sh)]
-            [pantomime.mime :refer [mime-type-of]]
-            [useful.experimental :refer (cond-let)])
+            [pantomime.mime :refer [mime-type-of]])
   (:use [environ.core]))

 (def sample-original-hash {:wikia "bucket"


cleanup

cleanup

--- dev/user.clj
+++ dev/user.clj
@@ -19,8 +19,6 @@
             [clojento.config :as config]
             [clojento.magento :as mage]
             [clojento.magento.db :as mage-db]
-            [clojento.magento.db.products :as mage-db-products]
-            [clojento.magento.t_db :as mage-db-test]
             [ragtime.jdbc]
             [ragtime.repl]
             [mount.lite :as mount :refer [defstate]]))


minor changes

minor changes

--- modules/src/samsara_builtin_modules/sessionize.clj
+++ modules/src/samsara_builtin_modules/sessionize.clj
@@ -85,6 +85,7 @@
                 (- timestamp (:timestamp prev-event)))]))

+
 (def sessionize-web-requests
   (pipeline
    add-sessionId
@@ -100,6 +101,12 @@
                {:eventName "web.page.viewed" :timestamp 10 :sourceId "cookie1"}
                #_{:eventName "web.page.viewed" :timestamp 50 :sourceId "cookie1"}])

+  (def events [{:eventName "web.page.viewed" :timestamp 1  :sourceId "cookie1"}
+               {:eventName "web.page.viewed" :timestamp 10 :sourceId "cookie1"}
+               {:eventName "web.page.viewed" :timestamp 25 :sourceId "cookie1"}
+               {:eventName "web.page.viewed" :timestamp 50 :sourceId "cookie1"}
+               {:eventName "web.page.viewed" :timestamp 60 :sourceId "cookie1"}])
+
   (def proc (moebius sessionize-web-requests))

   (second


remove unused leaf? function

remove unused leaf? function

--- src/crawler/rich_char_extractor.clj
+++ src/crawler/rich_char_extractor.clj
@@ -4,13 +4,6 @@
            [crawler.similarity :as similarity]
            [net.cgrand.enlive-html :as html]
            [crawler.utils :as utils]))
-
-(defn leaf?
-  "Examples are used to to RTDM style stuff."
-  [src-num target-num]
-  (and
-   (-> src-num nil? not)
-   (>= 0.2 (/ target-num src-num))))

 (defn state-action
   "Args:


Make move-to-section injectable

Make move-to-section injectable

--- src/discuss/components/tooltip.cljs
+++ src/discuss/components/tooltip.cljs
@@ -58,12 +58,14 @@

 (defn move-to-selection
   "Sets CSS position of tooltip and move it to the mouse selection."
-  []
-  (when-let [tooltip (get-tooltip)]
-    (let [[top left] (calc-position tooltip.offsetWidth tooltip.offsetHeight)]
-      (set! (.. tooltip -style -top) (str top "px"))
-      (set! (.. tooltip -style -left) (str left "px"))
-      (show))))
+  ([[top left]]
+   (let [tooltip (get-tooltip)]
+     (set! (.. tooltip -style -top) (str top "px"))
+     (set! (.. tooltip -style -left) (str left "px"))
+     (show)))
+  ([]
+   (when-let [tooltip (get-tooltip)]
+     (move-to-selection (calc-position tooltip.offsetWidth tooltip.offsetHeight)))))

 ;;;; Include listener for tooltips


Test that the record expr is only eval'd once

--- test/useful/datatypes_test.clj
+++ test/useful/datatypes_test.clj
@@ -16,4 +16,10 @@
             r (Test. 1 2 3 m {})]
         (is (= m (meta (assoc-record r :b 10))))))
     (testing "Inline typehinting"
-      (is (= second (assoc-record ^Test (assoc init :b 5) :c 4))))))
+      (is (= second (assoc-record ^Test (assoc init :b 5) :c 4))))
+
+    (testing "Don't eval more than once"
+      (let [times-evaled (atom 0)
+            r (Test. 1 2 3)]
+        (assoc-record ^Test (do (swap! times-evaled inc) r) :a :x :b :y :c :z)
+        (is (= 1 @times-evaled))))))


Remove duplicate vars from aggregates. Count from 1 instead of 0.

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -127,7 +127,7 @@
   (run [this kn rule->dirty? kind->name->rules]
        (let [current-key nil
              current-limit nil
-             current-index 0
+             current-index 1
              inputs #js []
              aggs (make-array (alength agg-ixes))
              facts&vals #js []
@@ -147,8 +147,8 @@
                             (aclear inputs)
                             (set!! current-key key)
                             (set!! current-limit (aget key limit-ix))
-                            (set!! current-index 0))
-                          (when (< current-index current-limit)
+                            (set!! current-index 1))
+                          (when (<= current-index current-limit)
                             (let [input (aclone key)]
                               (apush input current-index)
                               (set!! current-index (+ current-index 1))
@@ -293,14 +293,13 @@
                               in-var)
                 agg-out-vars (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
                                out-var)
-                ;; TODO should these be distinct-ified?
-                in-vars (into-array (concat group-by-vars (vals sort-by-vars) agg-in-vars [limit]))
-                out-vars (into-array (concat group-by-vars (vals sort-by-vars) agg-in-vars [limit ordinal] agg-out-vars))
+                in-vars (into-array (distinct (concat group-by-vars [limit] (vals sort-by-vars) agg-in-vars)))
+                out-vars (into-array (distinct (concat group-by-vars [limit] (vals sort-by-vars) agg-in-vars [ordinal] agg-out-vars)))
                 var->ix (into {}
                               (for [i (range (alength out-vars))]
                                 [(aget out-vars i) i]))
                 index (.get-or-create-index kn "know" agg-index-id in-vars)
-                group-len (count group-by-vars)
+                group-len (count (conj (set group-by-vars) limit))
                 limit-ix (var->ix limit)
                 ascending? (= ascending|descending "ascending")
                 agg-ixes (into-array


Use add-hook to patch cached-file-path.

Use add-hook to patch cached-file-path.

--- src/incise/core.clj
+++ src/incise/core.clj
@@ -5,8 +5,11 @@
             [incise.parsers.core :refer [parse]]
             [taoensso.timbre :refer [info]]
             (dieter [settings :refer [with-options]]
-                    [core :as dc])
+                    [core :as dc]
+                    [path :refer [adrf->uri]]
+                    [cache :as dcache])
             [clojure.java.io :refer [file]]
+            [robert.hooke :refer [add-hook]]
             [clojure.string :as s]
             [incise.server :refer [wrap-log-exceptions serve stop-server
                                    defserver]])
@@ -20,12 +23,22 @@
 (defn once [& {:as config}]
   (load-all)
   (conf/merge config)
-  (delete-recursively (file (conf/get :out-dir)))
-  (let [dieter-pre-opts {:cache-mode :production
+  (let [out-dir (conf/get :out-dir)
+        dieter-pre-opts {:cache-mode :production
                          :compress false
                          :engine :v8
                          :precompiles (conf/get :precompiles)
-                         :cache-root (conf/get :out-dir)}]
+                         :cache-root out-dir}]
+    (info "Clearing out" (str \" out-dir \"))
+    (delete-recursively (file out-dir))
+    (add-hook #'dieter.cache/cached-file-path
+              (fn [f & more]
+                (let [[adrf] more
+                      cached-path (apply f more)]
+                  (dcache/add-cached-uri (adrf->uri adrf)
+                                         (.substring cached-path
+                                                     (count out-dir)))
+                  cached-path)))
     (with-options dieter-pre-opts
       (info "Precompiling assets...")
       (info (with-out-str (dc/precompile dieter-pre-opts)))


check children

check children

--- src/cambo/component.cljc
+++ src/cambo/component.cljc
@@ -228,21 +228,24 @@
              (specify! (.-prototype container)
                Object
                (shouldComponentUpdate [this next-props next-state next-context]
-                 (let [update-props (fn [props]
-                                      (reduce (fn [props key]
-                                                (let [path (get-path props key)]
-                                                  (assoc props key path)))
-                                              props
-                                              (keys fragments)))
-                       current-props (update-props (props this))
-                       current-state (state this)
-                       current-context (context this)
-                       next-props (update-props (get-props next-props))
-                       next-state (get-state next-state)
-                       next-context (get-context next-context)]
-                   (or (not= current-props next-props)
-                       (not= current-state next-state)
-                       (not= current-context next-context))))
+                 (if (not= (.-children next-props)
+                           (.. this .-props .-children))
+                   false
+                   (let [update-props (fn [props]
+                                        (reduce (fn [props key]
+                                                  (let [path (get-path props key)]
+                                                    (assoc props key path)))
+                                                props
+                                                (keys fragments)))
+                         current-props (update-props (props this))
+                         current-state (state this)
+                         current-context (context this)
+                         next-props (update-props (get-props next-props))
+                         next-state (get-state next-state)
+                         next-context (get-context next-context)]
+                     (or (not= current-props next-props)
+                         (not= current-state next-state)
+                         (not= current-context next-context)))))

                (initialize [this props {:keys [route] :as context} vars]
                  (let [next-vars (prepare-variables vars route)]


Shorten things up a bit

Shorten things up a bit

--- src/invadm/core.clj
+++ src/invadm/core.clj
@@ -55,21 +55,15 @@
 (defn cwd []
   (System/getProperty "user.dir"))

-(defn is-json? [filename]
-  (.endsWith filename ".json"))
-
-(defn get-io-file-name [io-file]
-  (.getName io-file))
-
 (defn get-invoice-filenames []
-  (filter is-json? (map get-io-file-name (file-seq (io/file (cwd))))))
+  (filter #(.endsWith % ".json") (map #(.getName %) (file-seq (io/file (cwd))))))

 (defn read-all-invoices []
   (map read-json (get-invoice-filenames)))

 (defn options-to-filter [options]
   (fn [invoice]
-    (every? (fn[key_](= (get options key_) (get invoice (name key_)))) (keys options))))
+    (every? #(= (get options %) (get invoice (name %))) (keys options))))

 (defn data [options]
   (println (json/write-str (filter (options-to-filter options) (read-all-invoices)))))


grabbing host from section

grabbing host from section

--- src/celestial/launch.clj
+++ src/celestial/launch.clj
@@ -39,7 +39,7 @@
   []
   (let [log* (partial get! :celestial :log)]
     (set-config! [:appenders :gelf] gelf-appender)
-    (set-config! [:shared-appender-config :gelf] {:host (log* :gelf-host)})
+    (set-config! [:shared-appender-config :gelf] {:host (log* :gelf :host)})
     (set-config! [:shared-appender-config :spit-filename] (log* :path))
     (set-config! [:appenders :spit :enabled?] true)
     (set-level! (log* :level))))


renamed plan/cost to plan/linux-cost

renamed plan/cost to plan/linux-cost

--- src-cljs/frontend/models/plan.cljs
+++ src-cljs/frontend/models/plan.cljs
@@ -143,7 +143,7 @@
         {:keys [free_containers container_cost]} template-properties]
     (max 0 (* container_cost (- containers free_containers)))))

-(defn cost [plan containers & {:keys [include-trial?]}]
+(defn linux-cost [plan containers & {:keys [include-trial?]}]
   (let [paid-plan-template (or (-> plan :paid :template)
                                (-> plan :enterprise :template)
                                default-template-properties)
@@ -174,7 +174,7 @@
 (defn grandfathered? [plan]
   (and (linux? plan)
        (< (stripe-cost plan)
-          (cost plan (linux-containers plan) :include-trial? true))))
+          (linux-cost plan (linux-containers plan) :include-trial? true))))

 (defn admin?
   "Whether the logged-in user is an admin for this plan."


fix bug in cljs.closure/build around constants table, deref'ing the wrong thing

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -995,7 +995,7 @@
                  ; the constants_table.js file is not used directly here, is picked up by
                  ; add-dependencies below
                  _ (when emit-constants
-                     (comp/emit-constants-table-to-file (::ana/constant-table @compiler-env)
+                     (comp/emit-constants-table-to-file (::ana/constant-table @env/*compiler*)
                                                         (str (output-directory all-opts) "/constants_table.js")))
                  js-sources (concat
                              (apply add-dependencies all-opts


fix error when build

fix error when build

--- src/clj_docker/image.clj
+++ src/clj_docker/image.clj
@@ -15,7 +15,7 @@

 (defn build-from-dir [cli path & opts]
   (let [tar (create-archive path)
-        response (build-from-stream cli (input-stream tar) opts)]
+        response (apply build-from-stream cli (input-stream tar) opts)]
     (delete-file tar)
     response))

@@ -25,7 +25,7 @@
               "dockerfile.tar.gz"
               (fn [tar]
                 (add-entry tar docker-file "Dockerfile")))
-        response (build-from-stream cli (input-stream tar) opts)]
+        response (apply build-from-stream cli (input-stream tar) opts)]
     (delete-file tar)
     response))