Added file-info middleware for setting correct content type header on resources.

--- src/tfe/main.clj
+++ src/tfe/main.clj
@@ -1,6 +1,7 @@
 (ns tfe.main
   (:require [org.httpkit.server :refer [run-server]]
-            [ring.middleware.resource :refer [wrap-resource]])
+            [ring.middleware.resource :refer [wrap-resource]]
+            [ring.middleware.file-info :refer [wrap-file-info]])
   (:gen-class :main true))

 (defn request-logging [app]
@@ -17,6 +18,7 @@
 (def app
   (-> handler
       (wrap-resource "public")
+      (wrap-file-info)
       (request-logging)))

 (defn -main [port]


fix QUIT to behave correctly and actually disconnect the client

--- src/subrosa/commands.clj
+++ src/subrosa/commands.clj
@@ -79,10 +79,12 @@
             :msg ":Unauthorized command (already registered)"})))

 (defcommand "QUIT" [channel quit-msg]
-  (-> channel
-      (send-to-client* (format ":%s QUIT :Client Quit"
-                               (format-client channel)))
-      (.addListener (ChannelFutureListener/CLOSE))))
+  (let [chan-future-agent (send-to-client* channel
+                                           (format ":%s QUIT :Client Quit"
+                                                   (format-client channel)))]
+    (await chan-future-agent)
+    (when-let [chan-future @chan-future-agent]
+      (.addListener chan-future (ChannelFutureListener/CLOSE)))))

 (defcommand "JOIN" [channel args]
   (let [[rooms keys extra-args] (.split args " ")]


Remove some println's in http impl.

Remove some println's in http impl.

--- src/uxbox/util/http.cljs
+++ src/uxbox/util/http.cljs
@@ -44,7 +44,6 @@

 (defn- translate-response-type
   [type]
-  (println "translate-response-type" type)
   (case type
     :text ResponseType.TEXT
     :blob ResponseType.BLOB
@@ -63,7 +62,6 @@
   [{:keys [method url query-string query-params headers body] :as request}
    {:keys [timeout credentials? response-type]
     :or {timeout 0 credentials? false response-type :text}}]
-  (println "fetch$1" url)
   (let [uri (create-url url query-string query-params)
         headers (if headers (clj->js headers) #js {})
         method (translate-method method)


s/schema/parent/

s/schema/parent/

--- src/babel/cache.cljc
+++ src/babel/cache.cljc
@@ -104,34 +104,34 @@
     {}))

 ;; TODO: spec is not used yet; add support for it.
-(defn get-lex [schema head-or-comp cache spec]
-  "return the subset of the whole lexicon that can be added either as a head (head-or-comp=:head) or as a comp (head-or-comp=:comp)."
-  (log/debug (str "get-lex:" schema))
-  (if (nil? schema)
+(defn get-lex [parent head-or-comp cache spec]
+  "return the subset of the whole lexicon that can be added to _parent_ either as a head (head-or-comp=:head) or as a comp (head-or-comp=:comp)."
+  (log/debug (str "get-lex:" parent))
+  (if (nil? parent)
     #{}
     (do
-      (log/debug (str "get-lex: " (get-in schema [:rule]) " ; head-or-comp:" head-or-comp))
-      (if (not (map? schema))
-        (throw (exception (str "first arguments should have been a map, but instead was of type: " (type schema) "; schema: " schema))))
-      (log/trace (str "get-lex schema: " (get-in schema [:rule]) " for: " head-or-comp))
-      (if (nil? (get-in schema [:rule]))
-        (throw (exception (str "no schema for: " schema))))
+      (log/debug (str "get-lex: " (get-in parent [:rule]) " ; head-or-comp:" head-or-comp))
+      (if (not (map? parent))
+        (throw (exception (str "first arguments should have been a map, but instead was of type: " (type parent) "; parent: " parent))))
+      (log/trace (str "get-lex parent: " (get-in parent [:rule]) " for: " head-or-comp))
+      (if (nil? (get-in parent [:rule]))
+        (throw (exception (str "no parent for: " parent))))
       (let [result (cond (= :head head-or-comp)
                          (if (and (= :head head-or-comp)
-                                  (not (nil? (:head (get cache (get-in schema [:rule]))))))
+                                  (not (nil? (:head (get cache (get-in parent [:rule]))))))
                            (do
-                             (log/trace (str "get-lex hit: head for schema: " (get-in schema [:rule])))
-                             (:head (get cache (get-in schema [:rule]))))
-
-                           (do (log/warn (str "CACHE MISS 1 for rule: " (get-in schema [:rule]) " h/c: " head-or-comp " :: cache:" (type cache)))
+                             (log/trace (str "get-lex hit: head for parent: " (get-in parent [:rule])))
+                             (:head (get cache (get-in parent [:rule]))))
+
+                           (do (log/warn (str "CACHE MISS 1 for rule: " (get-in parent [:rule]) " h/c: " head-or-comp " :: cache:" (type cache)))
                                #{}))

                          (= :comp head-or-comp)
                          (if (and (= :comp head-or-comp)
-                                  (not (nil? (:comp (get cache (get-in schema [:rule]))))))
+                                  (not (nil? (:comp (get cache (get-in parent [:rule]))))))
                            (do
-                             (log/trace (str "get-lex hit: comp for schema: " (get-in schema [:rule])))
-                             (:comp (get cache (get-in schema [:rule]))))
+                             (log/trace (str "get-lex hit: comp for parent: " (get-in parent [:rule])))
+                             (:comp (get cache (get-in parent [:rule]))))
                            (do
                              (log/warn (str "CACHE MISS 2"))
                              nil))


+TODO

+TODO

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -45,6 +45,7 @@

   (log/debug (str "over: rules: " (string/join ","
                                                (map :rule grammar)) " with default-fn:" default-fn))
+  ;; TODO: use dag_unify/assoc-in rather than over/over, so that we can remove babel.over.
   (if default-fn
     (->>
      (over/over grammar left right)


more logging

more logging

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -105,7 +105,13 @@
                                       right-lexemes (mapcat (:lookup model)
                                                             right-strings)
                                       left-signs (lazy-cat left-lexemes (filter map? left))
-                                      right-signs (lazy-cat right-lexemes (filter map? right))]
+                                      right-signs (lazy-cat right-lexemes (filter map? right))
+                                      debug (log/debug (str "# lexemes found for left:" (string/join "," left-strings) ":"
+                                                            (count left-lexemes)))
+                                      debug (log/debug (str "# lexemes found for right:" (string/join "," right-strings) ":"
+                                                            (count right-lexemes)))
+
+                                      ]
                                   (lazy-cat
                                    (if (and (not (empty? left-signs))
                                             (not (empty? right-signs)))


fix target-spec

fix target-spec

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -94,8 +94,7 @@
   (let [target-spec (unify target-spec
                            {:synsem {:subcat '()}})]
     (cond (= target-language "la")
-          (let [target-spec (unify (babel.latin/get-spec)
-                                   target-spec)
+          (let [target-spec (babel.latin/get-spec target-spec)
                 target-expr
                 ((-> models
                      (get "la")


make 3rd param (source-language) of (defn populate-with-language) be optional, and add documentation and TODO about it

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -190,7 +190,10 @@
                                "]")
                 language]])))

-(defn populate-with-language [num model spec]
+;; TODO: change all calls to populate-with-language to set source-language if needed
+(defn populate-with-language
+  "generate(model,spec) and insert _num_ expressions into the _expression_ database table. source-language may be used to affect how source expression appears in the _expression_ table's _surface_ column."
+  [num model spec & [source-language]]
   (let [spec (if spec spec :top)
         language (:language model)
         debug (log/debug (str "populate-with-language: spec: " spec "; language: " language))]
@@ -207,9 +210,8 @@
             ;; writer implementation (e.g. babel.italiano/writer searches based on :comp and :head).
             fo (:morph model)

-            ;; TODO: hard-wired from-language to "it" for now: :from-language
-            ;; should be passed down the caller chain.
-            surface (fo sentence :from-language "it")]
+            surface (if source-language (fo sentence :source-language source-language)
+                        (fo sentence))]
         (if (empty? surface)
           (let [warn-mesg (str "Surface was empty for expression generated from spec: " spec)]
             (log/warn (str "sentence: " sentence))


fix failing runbld.test.tests-test/some-errors

This fixes the following test failure:

    lein test :only runbld.test.tests-test/some-errors

    FAIL in (some-errors) (tests_test.clj:15)
    expected: (= ["java.nio.file.NoSuchFileException" "junit.framework.AssertionFailedError"] (map :type (:failed-testcases res)))
      actual: (not (= ["java.nio.file.NoSuchFileException" "junit.framework.AssertionFailedError"] ("junit.framework.AssertionFailedError" "java.nio.file.NoSuchFileException")))

It seems the test is not deterministic. Sometimes the order changes.
This commit sorts both in order to make the test consistent.

--- test/runbld/test/tests_test.clj
+++ test/runbld/test/tests_test.clj
@@ -12,9 +12,9 @@
             :tests 3
             :skipped 0}
            (select-keys res [:errors :failures :tests :skipped])))
-    (is (= ["java.nio.file.NoSuchFileException"
-            "junit.framework.AssertionFailedError"]
-           (map :type (:failed-testcases res))))))
+    (is (= (sort ["java.nio.file.NoSuchFileException"
+                  "junit.framework.AssertionFailedError"])
+           (sort (map :type (:failed-testcases res)))))))

 (deftest no-errors
   (let [res (tests/capture-failures "test/repo/no-errors")]


add redis client timeout

add redis client timeout

--- jepsen-test/src/jepsen/elasticell.clj
+++ jepsen-test/src/jepsen/elasticell.clj
@@ -40,7 +40,7 @@
   [s]
   (when s (Long/parseLong s)))

-(def server1-conn {:pool {:max-total 8} :spec {:host "10.214.160.200" :port 6379}})
+(def server1-conn {:pool {:max-total 8} :spec {:host "10.214.160.200" :port 6379 :timeout-ms 6000}})
 (defmacro wcar* [& body] `(car/wcar server1-conn ~@body))

 (defn client


simple edit consolidation tests

simple edit consolidation tests

--- test/text_stream/edits_test.clj
+++ test/text_stream/edits_test.clj
@@ -119,3 +119,16 @@
       (testing "out of bounds"
         (is (thrown? StringIndexOutOfBoundsException
                      ((forward-delete 1) source-map)))))))
+
+(deftest consolidation
+  (testing "consolidate"
+    (is (= ((consolidate
+             [(delete 3) (insert "abc") (cursor 0)])
+            (initial-text "hello"))
+           ((cursor 0) (initial-text "hello")))))
+
+  (testing "perform"
+    (is (= (perform
+            [(delete 3) (insert "abc") (cursor 0)]
+            (initial-text "hello"))
+           ((cursor 0) (initial-text "hello"))))))


Make default port work in quotes app

Make default port work in quotes app

--- quotes/src/quotes/routes.clj
+++ quotes/src/quotes/routes.clj
@@ -17,7 +17,7 @@
       correlation-id-middleware))

 (defn -main []
-  (let [port (Integer/parseInt (utils/config "APP_PORT" 8080))]
+  (let [port (Integer/parseInt (utils/config "APP_PORT" "8080"))]
     (log/info "Running quotes on port" port)
     (future (jetty/run-jetty (var app) {:host "0.0.0.0"
                                         :port port}))))


More deferred value cleanup

More deferred value cleanup

--- test/picard/test/core/deferred.clj
+++ test/picard/test/core/deferred.clj
@@ -14,6 +14,21 @@

     (receive dval2 (fn [_ val _] (reset! res val)))
     (is (nil? @res))))
+
+(deftest catching-objects-does-nothing
+  (let [res (atom nil)]
+    (catch :hello Exception #(reset! res %))
+    (is (nil? @res))
+    (catch nil Exception #(reset! res %))
+    (is (nil? @res))))
+
+(deftest calling-finally-is-invoked
+  (let [res (atom nil)]
+    (finally :hello #(reset! res :one))
+    (is (= :one @res))
+
+    (finally nil #(reset! res :two))
+    (is (= :two @res))))

 (deftest waiting-for-objects
   (let [dval1 :hello
@@ -107,7 +122,6 @@
 (deftest calling-wait
   (let [dval (deferred)
         res  (atom nil)]
-
     (future
       (Thread/sleep 20)
       (put dval :hello))
@@ -116,12 +130,30 @@
     (is (wait dval))
     (is (= :hello @res))))

+(deftest calling-wait-then-aborted
+  (let [dval (deferred)
+        res  (atom nil)]
+    (future
+      (Thread/sleep 20)
+      (abort dval (Exception. "TROLLOLOL")))
+
+    (catch dval Exception #(reset! res %))
+    (is (wait dval))
+    (is (instance? Exception @res))))
+
 (deftest calling-wait-when-already-realized
   (let [dval (deferred)
-        res  (atom nil)]
+        now  (System/currentTimeMillis)]
     (put dval :hello)
-    (receive dval (fn [_ val _] (reset! res val)))
-    (is (= true (wait dval)))))
+    (is (wait dval))
+    (is (> 2 (- (System/currentTimeMillis) now)))))
+
+(deftest calling-wait-when-already-aborted
+  (let [dval (deferred)
+        now  (System/currentTimeMillis)]
+    (abort dval (Exception.))
+    (is (wait dval))
+    (is (> 2 (- (System/currentTimeMillis) now)))))

 (deftest wait-call-times-out
   (let [dval   (deferred)
@@ -134,13 +166,3 @@
                  (- (System/currentTimeMillis) now))]
     ;; Timers aren't precise
     (is (< 19 @first @second 80))))
-
-;; Catching
-;; * Only one catch block gets invoked
-;; * On abort
-;;   * Immedietly check all registered handlers.
-;;   * Only a single handler gets invoked
-;;   * If no handler is invoked, do nothing.
-;;   * When matching handler registered, invoke
-;;   * When another matching handler registered, do nothing.
-;; * Finally callback gets called on success / abort


CMR-4247 - Converted nested conditional in-memory db fn to multimethod.

--- metadata-db-app/src/cmr/metadata_db/data/memory_db.clj
+++ metadata-db-app/src/cmr/metadata_db/data/memory_db.clj
@@ -15,47 +15,59 @@
    [cmr.metadata-db.data.providers :as providers]
    [cmr.metadata-db.services.provider-validation :as pv]))

-(defn after-save
-  "Handler for save calls. It will be passed the list of concepts and the concept that was just
-  saved. It should manipulate anything required and return the new list of concepts."
+(defmulti after-save
+  "Handler for save calls. It will be passed the list of concepts and the
+  concept that was just saved. Implementing mehods should manipulate anything
+  required and return the new list of concepts."
+  (fn [db concepts concept]
+    (:concept-type concept)))
+
+(defmethod after-save :collection
   [db concepts concept]
-  (cond (and (= :collection (:concept-type concept))
-             (:deleted concept))
-        (filter #(not= (:concept-id concept) (get-in % [:extra-fields :parent-collection-id]))
-                concepts)
-
-        ;; CMR-2520 Remove this case when asynchronous cascaded deletes are implemented.
-        (and (= :tag (:concept-type concept))
-             (:deleted concept))
-        (let [tag-associations (tag/get-tag-associations-for-tag-tombstone db concept)
-              tombstones (map (fn [ta] (-> ta
-                                           (assoc :metadata "" :deleted true)
-                                           (update :revision-id inc)))
-                              tag-associations)]
-          ;; publish tag-association delete events
-          (doseq [tombstone tombstones]
-            (ingest-events/publish-event
-              (:context db)
-              (ingest-events/concept-delete-event tombstone)))
-          (concat concepts tombstones))
-
-        ;; CMR-2520 Remove this case when asynchronous cascaded deletes are implemented.
-        (and (= :variable (:concept-type concept))
-             (:deleted concept))
-        (let [variable-associations (variable/get-associations-for-variable-tombstone
-                                     db concept)
-              tombstones (map (fn [ta] (-> ta
-                                           (assoc :metadata "" :deleted true)
-                                           (update :revision-id inc)))
-                              variable-associations)]
-          ;; publish variable-association delete events
-          (doseq [tombstone tombstones]
-            (ingest-events/publish-event
-              (:context db)
-              (ingest-events/concept-delete-event tombstone)))
-          (concat concepts tombstones))
-
-        :else concepts))
+  (if-not (:deleted concept)
+    concepts
+    (filter #(not= (:concept-id concept)
+                   (get-in % [:extra-fields :parent-collection-id]))
+            concepts)))
+
+;; CMR-2520 Readdress this case when asynchronous cascaded deletes are implemented.
+(defmethod after-save :tag
+  [db concepts concept]
+  (if-not (:deleted concept)
+    concepts
+    (let [tag-associations (tag/get-tag-associations-for-tag-tombstone db concept)
+          tombstones (map (fn [ta] (-> ta
+                                       (assoc :metadata "" :deleted true)
+                                       (update :revision-id inc)))
+                          tag-associations)]
+      ;; publish tag-association delete events
+      (doseq [tombstone tombstones]
+        (ingest-events/publish-event
+          (:context db)
+          (ingest-events/concept-delete-event tombstone)))
+      (concat concepts tombstones))))
+
+;; CMR-2520 Readdress this case when asynchronous cascaded deletes are implemented.
+(defmethod after-save :variable
+  [db concepts concept]
+  (if-not (:deleted concept)
+    concepts
+    (let [variable-associations (variable/get-associations-for-variable-tombstone
+                                 db concept)
+          tombstones (map (fn [ta] (-> ta
+                                       (assoc :metadata "" :deleted true)
+                                       (update :revision-id inc)))
+                          variable-associations)]
+      ;; publish variable-association delete events
+      (doseq [tombstone tombstones]
+        (ingest-events/publish-event
+          (:context db)
+          (ingest-events/concept-delete-event tombstone)))
+      (concat concepts tombstones))))
+
+(defmethod after-save :default
+  [db concepts concept]
+  concepts)

 (defn- concept->tuple
   "Converts a concept into a concept id revision id tuple"


added competition test

added competition test

--- test/tango/import_datoms_tests.clj
+++ test/tango/import_datoms_tests.clj
@@ -187,6 +187,45 @@
                      (clean-test-data
                        (ds/query-competition @conn ['* {:competition/options ['*]}]))))))))

+(deftest import-real-example-kongsor
+  (testing "Import of real example from Kungsör"
+    (let [competition-data (imp/competition-xml->map
+                             u/real-example-kungsor
+                             #(java.util.UUID/randomUUID))
+          _ (ds/transact-competition @conn competition-data)]
+      (is (= (count (ds/query-adjudicators @conn ['*]))
+             6))
+
+      (is (seq (s/validate dom/competition-data-schema
+                           (clean-test-data (first (ds/query-competition
+                                                     @conn
+                                                     ['* {:competition/options ['*]
+                                                          :competition/adjudicators ['*]
+                                                          :competition/activities activities-query
+                                                          :competition/classes class-query
+                                                          :competition/panels panel-query}])))))))))
+
+;; TODO - add support for this competition
+;; TODO - it seems that rounds with several dances have multiple entries for marks
+;; i.e. 3 adjs and rounds is 4 dances will give 12 mark entries
+;(deftest import-real-example-uppsala
+;  (testing "Import of real example from Uppsala"
+;    (let [competition-data (imp/competition-xml->map
+;                             u/real-example-uppsala
+;                             #(java.util.UUID/randomUUID))
+;          _ (ds/transact-competition @conn competition-data)]
+;      (is (= (count (ds/query-adjudicators @conn ['*]))
+;             6))
+;
+;      (is (seq (s/validate dom/competition-data-schema
+;                           (clean-test-data (first (ds/query-competition
+;                                                     @conn
+;                                                     ['* {:competition/options ['*]
+;                                                          :competition/adjudicators ['*]
+;                                                          :competition/activities activities-query
+;                                                          :competition/classes class-query
+;                                                          :competition/panels panel-query}])))))))))
+
 (deftest transform-old-result
   (testing "Transform old result format to new"
     (let [old-result


WIP

WIP

Difference of square of sum and sum of squares nonsense

--- go-fighweel/src/cloj/core.cljc
+++ go-fighweel/src/cloj/core.cljc
@@ -17,6 +17,17 @@
                                                   ]]
             [cloj.math.misc :refer :all]))

+
+(do
+(defn diff-2 [^long n]
+  (*
+   (/ 1 12)
+   (- n 1)
+   n
+   (+ n 1)
+   (+ (* 3 n) 2)))  )
+
+
 (comment
   ;; Mess around with pub / sub
   ;; seems good
@@ -35,3 +46,7 @@

     (println (<!! shoes-chan))
     ))
+
+
+
+


Initial work on modal dialog.  Dialog works, but is poorly styled and is not currently reusable.

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspaces.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspaces.cljs
@@ -125,23 +125,45 @@
         [:div {:style {:clear "both"}}]])}))

+(defn- render-overlay [state refs]
+  [:div {:style {:display (if-not (:overlay-shown? @state) "none")
+                 :position "absolute"
+                 :top 0 :left 0 :width "100%" :height "100%"
+                 :background "rgba(82, 129, 197, 0.4)" :zIndex "99999"
+                 :textAlign "center"}}
+   [:div {:style {:width 300 :margin "100px auto"
+                  :backgroundColor "white" :border "1px solid black"
+                  :padding 15
+                  :textAlign "center"}}
+    [:div {} "Enter a name for the new Workspace:"]
+    [:div {:style {:padding "10px"}} [:input {:ref "wsName" :type "text"}]]
+    (let [clear-overlay (fn []
+                          (set! (.-value (.getDOMNode (@refs "wsName"))) "")
+                          (swap! state assoc :overlay-shown? false))]
+      [:div {}
+       [:button {:onClick #(let [n (.-value (.getDOMNode (@refs "wsName")))]
+                             (clear-overlay)
+                             (when-not (or (nil? n) (empty? n))
+                               (swap! state update-in [:workspaces] conj
+                                 {"name" n
+                                  "status" :not-started
+                                  "sample-count" (rand-int 1000)
+                                  "workflow-count" (rand-int 10)
+                                  "size-gb" (/ (rand-int 20) 2)})))}
+        "OK"]
+       [:button {:onClick clear-overlay} "Cancel"]])]])
+
+
 (react/defc Page
   {:render
    (fn [{:keys [state refs]}]
      [:div {}
+      (render-overlay state refs)
       [:div {:style {:padding "2em"}}
        [:div {:style {:float "right" :display (when-not (:workspaces-loaded? @state) "none")}}
         [common/Button
          {:text "Create New Workspace" :style :add
-          :onClick (fn [e]
-                     (let [n (js/prompt "Enter a name for the new Workspace:")]
-                       (when-not (or (nil? n) (empty? n))
-                         (swap! state update-in [:workspaces] conj
-                                {"name" n
-                                 "status" :not-started
-                                 "sample-count" (rand-int 1000)
-                                 "workflow-count" (rand-int 10)
-                                 "size-gb" (/ (rand-int 20) 2)}))))}]]
+          :onClick #(swap! state assoc :overlay-shown? true)}]]
        [:span {:style {:fontSize "180%"}} "Workspaces"]]
       (if-not (:workspaces-loaded? @state)
         [common/Spinner {:text "Loading workspaces..."}]


CasAbleClient -> CasAuthenticatingClient

--- src/clj_util/cas.clj
+++ src/clj_util/cas.clj
@@ -1,13 +1,13 @@
 (ns clj-util.cas
   (:refer-clojure :exclude [get])
   (:require [clj-util.client :as cl])
-  (:import [fi.vm.sade.utils.cas CasAbleClient CasClient CasParams]))
+  (:import [fi.vm.sade.utils.cas CasAuthenticatingClient CasClient CasParams]))

 (defn cas-params [uri user passwd] (CasParams/apply uri user passwd))

 (defn cas-client [uri] (CasClient. uri cl/client))

-(defn cassableclient [cc cp] (CasAbleClient. cc cp cl/client))
+(defn cassableclient [cc cp] (CasAuthenticatingClient. cc cp cl/client))

 (def current-client (atom nil))


fix sorter functions to work on a snippet in README

--- src/cljam/sorter.clj
+++ src/cljam/sorter.clj
@@ -101,20 +101,19 @@
         ref-map (apply merge
                        (map-indexed (fn [i val] {val i})
                                     (map :name (sam-util/make-refs header))))]
-    (with-open [wtr wtr]
-      (io/write-header wtr header)
-      (io/write-refs wtr header)
-      (loop [blocks-list (map #(io/read-blocks % {:mode :coordinate}) rdrs)]
-        (let [candidates (map first blocks-list)]
-          (when-not (every? nil? candidates)
-            (let [[i b] (head candidates ref-map)]
-              (io/write-blocks wtr [b])
-              (recur (map
-                      (fn [[idx blocks]]
-                        (if (= idx i)
-                          (drop 1 blocks)
-                          blocks))
-                      (map-indexed vector blocks-list))))))))))
+    (io/write-header wtr header)
+    (io/write-refs wtr header)
+    (loop [blocks-list (map #(io/read-blocks % {:mode :coordinate}) rdrs)]
+      (let [candidates (map first blocks-list)]
+        (when-not (every? nil? candidates)
+          (let [[i b] (head candidates ref-map)]
+            (io/write-blocks wtr [b])
+            (recur (map
+                    (fn [[idx blocks]]
+                      (if (= idx i)
+                        (drop 1 blocks)
+                        blocks))
+                    (map-indexed vector blocks-list)))))))))

 (defn clean-split-merge-cache
   [name-fn sorted-name-fn count]
@@ -158,10 +157,9 @@
         hdr (replace-header (io/read-header rdr)
                             version
                             (name order-queryname))]
-    (with-open [wtr wtr]
-      (io/write-header wtr hdr)
-      (io/write-refs wtr hdr)
-      (io/write-alignments wtr alns hdr))))
+    (io/write-header wtr hdr)
+    (io/write-refs wtr hdr)
+    (io/write-alignments wtr alns hdr)))

 (defn sorted-by?
   "Returns true if the sam is sorted, false if not. It is detected by


Needs to be double quotes

Needs to be double quotes

--- src/cljs/go/core.clj
+++ src/cljs/go/core.clj
@@ -37,7 +37,7 @@
                   (apply core/str))]
     ;; Google closure advanced compile will stringify and concat strings and
     ;; numbers at compilation time.
-    (list* 'js* (core/str (if (core/string? (first clean-xs)) "(" "(''+")
+    (list* 'js* (core/str (if (core/string? (first clean-xs)) "(" "(\"\" +")
                           strs ")")
            clean-xs)))


[sidecar] model->description now correctly invokes load-weights-for-description

--- keras/src/think/cortex/keras/core.clj
+++ keras/src/think/cortex/keras/core.clj
@@ -348,9 +348,11 @@
 (defn model->description
   "Given a json model and weight hdf5 file load model into a cortex description layer."
   [model-json-fname weight-hdf5-fname]
-  (-> (read-model model-json-fname)
-      model->simple-description
-      (load-weights-for-description weight-hdf5-fname)))
+  (let [model-desc (-> (read-model model-json-fname)
+                       model->simple-description)
+        built-desc (desc/build-full-network-description model-desc)
+        desc-seq   (mapv vector model-desc built-desc)]
+    (load-weights-for-description desc-seq weight-hdf5-fname)))

 (defn tokenize-output-name
   [out-name]


not really happy with the code style but covering more, patterns will emerge

--- src/etcd_clojure/core.clj
+++ src/etcd_clojure/core.clj
@@ -22,14 +22,6 @@
   (reset! endpoint (format "http://%s:4001" etcd-server-host))
   (reset! admin-endpoint (format "http://%s:7001" etcd-server-host)))

-(defn- build-url
-  [& {:keys [key value ttl prev-val]}]
-  (cond-> (base-url)
-          key (str "/keys/" key)
-          value (str "?value=" value)
-          prev-val (str "&prevValue=" prev-val)
-          ttl (str "&ttl=" ttl)))
-
 (defn- when-done [future-to-watch function-to-call]
   (future (function-to-call @future-to-watch)))

@@ -48,16 +40,46 @@
   (clojure.core/get-in (parse-string (:body (client/get (str (base-url) "/keys/" key)))) ["node" "value"]))

 (defn delete
+  "Deletes a value"
   [key]
   (parse-string (:body (client/delete (str (base-url) "/keys/" key)))))

 (defn delete-dir
+  "Deletes a dir"
   [key]
   (parse-string (:body (client/delete (str (base-url) "/keys/" key "?dir=true")))))

 (defn delete-dir-recur
+  "Deletes a directory recursively"
   [key]
   (parse-string (:body (client/delete (str (base-url) "/keys/" key "?dir=true&recursive=true")))))
+
+(defn create-in-order
+  "Creates in order"
+  [key value]
+  (let [url (str (base-url) "/keys/" key)]
+    (clojure.core/get-in (parse-string (:body (client/post url {:form-params {:value value}}))) ["node" "value"])))
+
+(defn list
+  "Lists the content of a directory"
+  [key & {:keys [recursive]}]
+  (let [url (str (base-url) "/keys/" key "?recursive=" recursive)]
+    (clojure.core/get-in (parse-string (:body (client/get url ))) ["node"])))
+
+(defn list-in-order
+  "Lists the content of a directory recursively and in order"
+  [key]
+  (let [url (str (base-url) "/keys/" key "?recursive=true&sorted=true")]
+    (map #(clojure.core/get % "value") (clojure.core/get-in (parse-string (:body (client/get url ))) ["node" "nodes"]))))
+
+(defn create-dir
+  "Creates a dir"
+  [key & {:keys [ttl]}]
+  (let [data {:value val :dir true}
+        url (str (base-url) "/keys/" key)]
+    (if ttl
+      (clojure.core/get-in (parse-string (:body (client/put url {:form-params (assoc data :ttl ttl)}))) ["node" "key"])
+      (clojure.core/get-in (parse-string (:body (client/put url {:form-params data}))) ["node" "key"]))))

 (defn watch
   [key callback]
@@ -65,31 +87,31 @@
     (when-done f #(callback %)) f))

 (defn stats
-  ""
+  "Leader stats"
   []
   (parse-string (:body (client/get (str (base-url) "/stats/leader")))))

 (defn self-stats
-  ""
+  "Self Stats"
   []
   (parse-string(:body (client/get (str (base-url) "/stats/self")))))

 (defn store-stats
-  ""
+  "Store stats"
   []
   (parse-string (:body (client/get (str (base-url) "/stats/store")))))

 (defn machines
+  "Machines"
   []
-  (println (str (admin-base-url) api-version "/admin/machines"))
   (parse-string (:body (client/get (str (admin-base-url) "/admin/machines")))))

 (defn get-config
-  ""
+  "Gets the config"
   []
   (parse-string (:body (client/get (str (admin-base-url) "/admin/config")))))

 (defn get-version
-  ""
+  "Gets the etcd server version"
   []
   (:body (client/get (str @endpoint "/version"))))


mostly done

mostly done

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -61,7 +61,27 @@
     (if-not (nil? new-uploads-info)
       (swap! app-state/app-state merge new-uploads-info))))

-(add-watch app-state/app-state :upload-slots  upload-slots-watch-fn!)
+(add-watch app-state/app-state :upload-slots upload-slots-watch-fn!)
+
+(defn upload-removed-watch-fn! [_ _ old-state new-state]
+  (let [uploads-keys-diff (data/diff (keys (:uploads old-state))
+                                     (keys (:uploads new-state)))
+        deleted-upload-ids (first uploads-keys-diff)]
+    (if-not (nil? deleted-upload-ids)
+      (let [active-uploads  (vec (remove (set deleted-upload-ids) (:active-uploads new-state)))
+            inactive-uploads (vec (remove (set deleted-upload-ids) (:inactive-uploads new-state)))
+            uploads (:uploads new-state)]
+        (if-not (empty? inactive-uploads)
+          (swap! app-state/app-state
+                 merge
+                 {:active-uploads (append-upload active-uploads
+                                                 (first inactive-uploads))
+                  :inactive-uploads (drop-first-upload inactive-uploads)
+                  :uploads (merge uploads {(first inactive-uploads)
+                                     (start-upload (uploads (first inactive-uploads)))})}))))))
+
+
+(add-watch app-state/app-state :upload-removed upload-removed-watch-fn!)

 (defn get-action [old-state new-state upload-id]
   "returns the action applied to the given upload-id.
@@ -107,11 +127,9 @@
       (fn []
         (remove-watch app-state/app-state upload-id)
         (swap! app-state/app-state
-               merge
-               {:uploads (dissoc (:uploads @app-state/app-state)
-                         upload-id)
-                :active-uploads (remove @app-state/app-state #{upload-id})
-                :inactive-uploads (remove @app-state/app-state #{upload-id})})))
+               dissoc
+               :uploads
+               upload-id)))

     (add-watch app-state/app-state
                upload-id


whitespace

whitespace


delete contact as well

delete contact as well

--- fe/src/cljs/fe/core.cljs
+++ fe/src/cljs/fe/core.cljs
@@ -34,7 +34,7 @@
                         parse-contact)]
     (when new-contact
       (om/transact! app :contacts #(conj % new-contact))
-      (set! (.-value input) "")
+      (om/set-state! owner :text "")
       )))

 (defn middle-name [{:keys [middle middle-initial]}]
@@ -53,47 +53,43 @@
         (dom/span nil (display-name contact))
         (dom/button #js {:onClick (fn [e] (put! delete @contact))} "Delete")))))

+(defn handle-change2 [e owner {:keys [text]}]
+  (om/set-state! owner :text (.. e -target -value)))
+
+(defn handle-change [e owner {:keys [text]}]
+  (let [value (.. e -target -value)]
+    (if-not (re-find #"[0-9]" value)
+      (om/set-state! owner :text value)
+      (om/set-state! owner :text text))))
+
 (defn contacts-view [app owner]
   (reify
     om/IInitState
     (init-state [_]
-      {:delete (chan) :text ""})
+      {:delete (chan)
+       :text ""})
     om/IWillMount
     (will-mount [_]
       (let [delete (om/get-state owner :delete)]
         (go (loop []
-          (let [contact (<! delete)]
-            (om/transact! app :contacts
-              (fn [xs] (vec (remove #(= contact %) xs))))
-            (recur))))))
+              (let [contact (<! delete)]
+                (om/transact! app :contacts
+                  (fn [xs] (vec (remove #(= contact %) xs))))
+                (recur))))))
     om/IRenderState
-    (render-state [this {:keys [delete]}]
+    (render-state [this state]
       (dom/div nil
         (dom/h2 nil "Contact list")
         (apply dom/ul nil
           (om/build-all contact-view (:contacts app)
-            {:init-state {:delete delete}}))
+            {:init-state state}))
         (dom/div nil
-          (dom/input #js {:type "text" :ref "new-contact"})
-          (dom/button #js {:onClick #(add-contact app owner)} "Add contact"))
-        ))))
+          (dom/input #js {:type "text" :ref "new-contact" :value (:text state)
+                          :onChange #(handle-change % owner state)})
+          (dom/button #js {:onClick #(add-contact app owner)} "Add contact"))))))

 (defn main []
 (om/root
   contacts-view
   app-state
   {:target (. js/document (getElementById "app"))}))
-
-; (swap! app-state assoc :text "Multiple roots!")
-; (defn main []
-;   (om/root
-;     (fn [app owner]
-;       (om/component (dom/h2 nil (:text app))))
-;       ; (reify
-;         ; om/IRender
-;         ; (render [_]
-;           ; (dom/h1 nil (:text app))
-;           ; (dom/h2 "Setting" (:text app))
-;           ))
-;     app-state
-;     {:target (. js/document (getElementById "app"))}))


Pod pool takes :size :init and :destroy kwargs

--- boot/pod/src/boot/pod.clj
+++ boot/pod/src/boot/pod.clj
@@ -332,5 +332,40 @@
     (.. pod getClassLoader close)))

 (defn pod-pool
-  [size env]
-  (lifecycle-pool size #(make-pod env) destroy-pod))
+  "Creates a pod pool service. The service maintains a pool of prebuilt pods
+  with a current active pod and a number of pods in reserve, warmed and ready
+  to go (it takes ~2s to load clojure.core into a pod).
+
+  Pool Service API:
+  -----------------
+
+  The pod-pool function returns a pod service instance, which is itself a
+  Clojure function. The pod service function can be called with no arguments
+  or with :refresh or :shutdown.
+
+  Calling the function with no arguments produces a reference to the current
+  pod. Expressions can be evaluated in this pod via with-eval-in, etc.
+
+  Calling the function with the :refresh argument swaps out the current pod,
+  destroys it, and promotes a pod from the reserve pool. A new pod is created
+  asynchronously to replenish the reserve pool.
+
+  Calling the function with the :shutdown argument destroys all pods in the
+  pool and shuts down the service.
+
+  Options:
+  --------
+
+  :size       The total number of pods to be maintained in the pool. Default
+              size is 2.
+  :init       A function that is called when a new pod is created. Takes the
+              new pod as an argument, is evaluated for side effects only.
+  :destroy    A function that is called when a pod is destroyed. Takes the pod
+              to be destroyed as an argument, is evaluated for side effects
+              before pod is destroyed."
+  [env & {:keys [size init destroy]}]
+  (let [size    (or size 2)
+        init    (if-not init #(make-pod env) #(doto (make-pod env) init))
+        destroy (if-not destroy destroy-pod #(doto % destroy destroy-pod))]
+    (lifecycle-pool size init destroy)))
+


Code complete on resolve-locations! CLI

Code complete on resolve-locations! CLI

--- src/degasolv/cli.clj
+++ src/degasolv/cli.clj
@@ -1,5 +1,6 @@
 (ns degasolv.cli
   (:require [degasolv.util :refer :all]
+            [degasolv.resolver :refer :all]
             [clojure.tools.cli :refer [parse-opts summarize]]
             [clojure.string :as string]
             [clojure.pprint :as pprint]
@@ -61,8 +62,51 @@

 (defn- resolve-locations!
   [options arguments]
-  (pprint/pprint options)
-  )
+  (when (not (:repositories options))
+    (throw (ex-info
+            (str
+             "No repositories specified\n"
+             "(either through CLI or config file)"))))
+  (let [{:keys [repositories
+                resolve-strategy
+                repo-merge-strategy]}
+        options
+        requirements
+        (if (:project-file options)
+          (let [project-info (edn/read-string
+           (slurp
+            (:project-file options)))]
+            (when (not (:requirements project-info))
+              (.println *err* "Warning: project file does not contain a `:requirements` key."))
+            (:requirements project-info))
+           (map
+            #(string-to-requirement %)
+            arguments))
+        aggregate-repo
+        (merge-with
+         concat
+         (map
+          (fn slurp-url
+            [url]
+            (edn/read-string
+             (slurp url)))
+          repositories))
+        used-repo
+        (if (= repo-merge-strategy "priority")
+          aggregate-repo
+          (into {}
+                (map
+                 (fn [[k v]]
+                   [k
+                    (sort #(- (cmp (:version %1)
+                                   (:version %2)))
+                          v)])
+                 aggregate-repo)))]
+    (resolve-dependencies
+     requirements
+     used-repo
+     :strategy (keyword resolve-strategy)
+     :compare cmp)))

 (def subcommand-cli
   {"generate-repo-index"
@@ -84,6 +128,7 @@
     :function resolve-locations!
     :cli [["-r" "--repository REPO"
            "Specify a repository to use. May be used more than once."
+           :id :repositories
            :assoc-fn
            (fn [m k v] (update-in m [k] #(conj % v)))]
           ["-s" "--resolve-strategy STRATEGY"


Closes #49

Closes #49

--- src/doctopus/web.clj
+++ src/doctopus/web.clj
@@ -53,7 +53,8 @@
 (def substitutions {"$URL_ROOT"  (:ip (server-config))})

 ;; Let's start bootstrapping!
-(def doctopus (bootstrap-heads (Doctopus. (server-config) substitutions)))
+(def doctopus (Doctopus. (server-config) substitutions))
+(bootstrap-heads doctopus)

 (defn serve-index
   [_]


A concurrency problem in cassandra stop function fixed. (had to shutdonw the cluster)

--- src/clj/hellhound/components/cassandra.clj
+++ src/clj/hellhound/components/cassandra.clj
@@ -27,7 +27,7 @@
   [config]
   (let [cluster (alia/cluster (:connecttion config))]
     (try
-      (alia/connect cluster)
+      [cluster (alia/connect cluster)]
       (catch com.datastax.driver.core.exceptions.NoHostAvailableException e
         (throw (ex-info "Can't connect to Cassandra Cluster." {}))))))

@@ -90,11 +90,14 @@
     (logger/info "Connecting to Cassandra cluster...")

     ;; Connect to the cluster and select the default keyspace
-    (let [session          (connect options)
+    (let [[cluster session]          (connect options)
           keyspace         (:name (:keyspace options))]
       (select-keyspace session keyspace)
       (logger/info "Connected to cassandra cluster.")
-      (assoc this :session session :keyspace keyspace)))
+      (assoc this
+             :cluster cluster
+             :session session
+             :keyspace keyspace)))

   (stop [this]
     (if (:session this)
@@ -102,7 +105,8 @@
         (logger/info "Disconnecting from Cassandra cluster...")
         ;; Shutting down the connection to cluster
         (alia/shutdown (:session this))
-        (dissoc this :session :keyspace :keyspace))
+        (alia/shutdown (:cluster this))
+        (dissoc this :session :keyspace))
       this))

   ;; DatabaseLifecycle implementation. Allow the migration system to operate


lifecycle protocols of component namespace refactored to act separately

--- src/clj/hellhound/components/protocols.clj
+++ src/clj/hellhound/components/protocols.clj
@@ -8,18 +8,10 @@
     "The ending point of any component's life cycle."))

 (defprotocol DatabaseLifecycle
-  "Any database component should implement this protocol. This way
-  **HellHound** can manage database accordingly to the implementation
-  of this protocol. For example in order to create the database,
+  "Any database component should implement this protocol in addition to
+  `Lifecycle` protocol. This way **HellHound** can manage database accordingly
+  to the implementation of this protocol. For example in order to create the database,
   **HellHound** uses the `setup` function of the implementated protocol."
-  (start [component]
-    "Starting point of the database component. Usually this function
-     would be responsible for connecting to the database engine.")
-
-  (stop [component]
-    "Ending point for the commponent life cycle. Usually this function
-     is responsible for disconnecting from the engine and cleaning up.")
-
   (setup [component]
     "This function should bootstrap the database and setup the necessary
      means for the database component to work. **HellHound** will call


Fix audio loading on Safari

Fix audio loading on Safari

--- src/cljs/daveconservatoire/audio/core.cljs
+++ src/cljs/daveconservatoire/audio/core.cljs
@@ -9,15 +9,12 @@
             [cljs.spec.alpha :as s]
             [cljs.core.async :as async :refer [chan promise-chan put! close! <! >! alts!]]))

-(defonce AudioContext (or js/AudioContext js/webkitAudioContext))
+(defonce AudioContext (or (gobj/get js/window "AudioContext")
+                          (gobj/get js/window "webkitAudioContext")))
+
 (defonce ^:dynamic *audio-context* (AudioContext.))

 (defn output [] (.-destination *audio-context*))
-
-(defn promise->chan [promise]
-  (let [c (promise-chan)]
-    (.then promise #(put! c %) #(put! c %))
-    c))

 (s/def ::context #(instance? AudioContext %))
 (s/def ::node #(instance? js/AudioNode %))
@@ -36,7 +33,9 @@

 (defn decode-audio-data [buffer]
   {:pre [(s/valid? ::ss/array-buffer buffer)]}
-  (promise->chan (.decodeAudioData *audio-context* buffer)))
+  (let [c (promise-chan)]
+    (.decodeAudioData *audio-context* buffer #(put! c %))
+    c))

 (s/fdef decode-audio-data
   :args (s/cat :buffer ::ss/array-buffer)


Removed inadvertent paste error

Removed inadvertent paste error


use keycode constants instead of magic numbers

--- src/chat/client/new-message.cljs
+++ src/chat/client/new-message.cljs
@@ -12,7 +12,7 @@
     om/IInitState
     (init-state [_]
       {:text ""
-       :highlighted-result-index -1 })
+       :highlighted-result-index -1})
     om/IRenderState
     (render-state [_ {:keys [text highlighted-result-index] :as state}]
       (let [clear-tags! (fn []
@@ -59,7 +59,7 @@
                                (fn [e]
                                  (cond
                                    ; enter when autocomplete -> tag
-                                   (and (= 13 e.keyCode) autocomplete-open?)
+                                   (and (= KeyCodes.ENTER e.keyCode) autocomplete-open?)
                                    (do
                                      (.preventDefault e)
                                      (when-let [tag (nth results highlighted-result-index nil)]
@@ -67,23 +67,23 @@
                                                                :id (tag :id)})
                                        (close-autocomplete!)))
                                    ; enter otherwise -> message
-                                   (and (= 13 e.keyCode) (= e.shiftKey false))
+                                   (and (= KeyCodes.ENTER e.keyCode) (= e.shiftKey false))
                                    (do
                                      (.preventDefault e)
                                      (dispatch! :new-message {:thread-id (config :thread-id)
                                                               :content text})
                                      (clear-text!))
-                                   ; esc
-                                   (= 27 e.keyCode)
+
+                                   (= KeyCodes.ESC e.keyCode)
                                    (do
                                      (close-autocomplete!))
-                                   ; up
-                                   (= 38 e.keyCode)
+
+                                   (= KeyCodes.UP e.keyCode)
                                    (do
                                      (.preventDefault e)
                                      (highlight-prev!))
-                                   ; down
-                                   (= 40 e.keyCode)
+
+                                   (= KeyCodes.DOWN e.keyCode)
                                    (do
                                      (.preventDefault e)
                                      (highlight-next!))


made new look similar to edit

made new look similar to edit

--- src/checkmate/views/new_list.clj
+++ src/checkmate/views/new_list.clj
@@ -22,9 +22,7 @@
    [:div.form-group [:hr]]
    [:div.form-group {:id "items"}]

-   [:div.btn-group
-    (views/bs-button "Save Checklist" :onclick "checkmate.views.new_list.try_save_list();")
-    (views/bs-button "Reset Checklist" :onclick "checkmate.views.new_list.reset_view();")]])
+  ])

 (defn render [id]
   {:title "Check-Mate - Set up a checklist"
@@ -32,6 +30,10 @@
    [:div
     [:h3 "Set up a checklist"]
     [:div.row
-     [:div.col-md-12
-      (render-form)]]]
+     [:div.col-md-10
+      (render-form)]
+     [:div.col-md-2
+      [:div.btn-group-vertical
+       [:button.btn.btn-default.btn-sm {:onclick "checkmate.views.new_list.try_save_list();"} [:span.glyphicon.glyphicon-floppy-save] "Save Checklist"]
+       [:button.btn.btn-default.btn-sm {:onclick "checkmate.views.new_list.reset_view();"} [:span.glyphicon.glyphicon-repeat] "Reset Checklist"]]]]]
    :onload (format "checkmate.views.new_list.init(%s);" (if id (format "'%s'" id) id))})


Migration radius depends on society type now

--- src/civs/logic/tribe_choices.clj
+++ src/civs/logic/tribe_choices.clj
@@ -10,7 +10,12 @@
     [civs.logic.demographics :refer :all])
   (:import [civs.model.core Population Tribe]))

-(def migration-radius 3)
+(defn- migration-radius [group]
+  (cond
+    (nomadic? group) 2
+    (semi-sedentary? group) 2
+    (sedentary? group) 4
+    :default (throw (Exception. "Unexpected"))))

 (defn- discovery-population-factor [total-pop required-pop]
   (+ 1.0 (Math/log10 (/ (float total-pop) required-pop))))
@@ -91,7 +96,7 @@
     (fn [game group]
       (let [ world (.world game)
              pos (.position group)
-             possible-destinations (filter #(pos-free? game %) (land-cells-around world pos migration-radius))]
+             possible-destinations (filter #(pos-free? game %) (land-cells-around world pos (migration-radius group)))]
         (if (empty? possible-destinations)
           0.0
           (let [p (prosperity-in-pos game group pos)
@@ -104,7 +109,7 @@
       (let [ world (.world game)
              pos (.position group)
              _ (check-valid-position world pos)
-             possible-destinations (filter #(pos-free? game %) (land-cells-around world pos migration-radius))
+             possible-destinations (filter #(pos-free? game %) (land-cells-around world pos (migration-radius group)))
              preferences (map (fn [pos] {
                                      :preference (perturbate-low (prosperity-in-pos game group pos))
                                      :pos pos
@@ -132,7 +137,7 @@
             pop (-> tribe .population total-persons)
             world (.world game)
             pos (.position tribe)
-            possible-destinations (filter #(pos-free? game %) (land-cells-around world pos migration-radius))]
+            possible-destinations (filter #(pos-free? game %) (land-cells-around world pos (migration-radius group)))]
         (if
           (and (> pop 35) (< c 0.9) (not (empty? possible-destinations)))
           (/ (opposite c) 2.7)
@@ -141,7 +146,7 @@
       (let [ world (.world game)
              pos (.position tribe)
              sp (split-pop (.population tribe))
-             possible-destinations (filter #(pos-free? game %) (land-cells-around world pos migration-radius))
+             possible-destinations (filter #(pos-free? game %) (land-cells-around world pos (migration-radius group)))
              preferences (map (fn [pos] {
                                           :preference (perturbate-low (prosperity-in-pos game tribe pos))
                                           :pos pos


I'll want that someday

I'll want that someday

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -48,6 +48,7 @@
   a Handle."

   [thing]
+  {:pre [(map? thing)]}
   (or (:uri thing)
       (->> thing
            (iterate :parent)


Fixup the write-specials code

Fixup the write-specials code

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -168,7 +168,11 @@
   symbols to metadata for these symbols."
   [{:keys [groupid artifactid version platform] :as config} ?special-file]
   (assert (.exists ?special-file) "No such special symbols file!")
-  (let [specials-data (edn/read-string (slurp ?special-file))
+  (let [share         (-> (t/->Group groupid)
+                          (t/->Artifact artifactid)
+                          (t/->Version version)
+                          (t/->Platform platform))
+        specials-data (edn/read-string (slurp ?special-file))
         ?specials     (get specials-data platform)]
     (if-not ?specials
       (println "Warning: No special forms for the given platform!, continuing...")
@@ -176,8 +180,9 @@
         (if-not (namespace sym)
           (println (str "Error: namespace unqualified special symbol " sym ", continuing..."))
           (guarded-write-meta config
-                              (t/->Def groupid artifactid version
-                                       platform (namespace sym) (name sym))
+                              (-> share
+                                  (t/->Ns (namespace sym))
+                                  (t/->Def (name sym)))
                               meta))))))

 (def var-blacklist


Whitespace

Whitespace

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -215,7 +215,6 @@
   and documenting the namespaces therein. This is intended for documenting
   projects such as clojure.core which may not exist as a covenient lein project
   but which do exist as artifacts."
-
   [p-groupid p-artifactid p-version p-source-paths ;; provided by lein
    mode-selector & args ;; user provided
    ]


Add Mailgun

Add Mailgun

--- src/clj/freestuffly/notifier.clj
+++ src/clj/freestuffly/notifier.clj
@@ -1,6 +1,7 @@
 (ns freestuffly.notifier
   (:require [clj-http.client :as client])
   (:require [hickory.core :as h])
+  (:require [clj-mailgun.core :as mailgun])
   (:require [clojure.string :as string])
   (:require [hickory.select :as s]))

@@ -34,3 +35,13 @@
 (defn listen
   []
   (presentable (content-for (parsed-html (client/get my-group-urls)))))
+
+(defn send-email
+  []
+  (let [credentials {:api-key (System/getenv "MAILGUN_API_KEY") :domain (System/getenv "YOUR_DOMAIN")}
+        params {
+                :from "emile.swarts123@gmail.com"
+                :to "emile.swarts123@gmail.com"
+                :subject "Free stuffly"
+                :text (listen)}]
+    (mailgun/send-email credentials params)))


Fix docstring

Fix docstring

--- src/com/wsscode/pathom/core.cljc
+++ src/com/wsscode/pathom/core.cljc
@@ -214,7 +214,7 @@
      :else b)))

 (>defn ast->shape-descriptor
-  "Convert AST to IO-map format"
+  "Convert AST to shape descriptor format"
   [ast]
   [:edn-query-language.ast/node => ::shape-descriptor]
   (reduce


Fail fast support

Fail fast support

--- src/com/wsscode/pathom/core.cljc
+++ src/com/wsscode/pathom/core.cljc
@@ -37,6 +37,8 @@

 (s/def ::entity any?)
 (s/def ::entity-key keyword?)
+
+(s/def ::fail-fast? boolean?)

 (s/def ::js-key-transform
   (s/fspec :args (s/cat :key any?)
@@ -221,13 +223,15 @@
 ;; PLUGINS

 (defn wrap-handle-exception [reader]
-  (fn [{::keys [errors* path process-error] :as env}]
-    (try
+  (fn [{::keys [errors* path process-error fail-fast?] :as env}]
+    (if fail-fast?
       (reader env)
-      (catch Exception e
-        (swap! errors* assoc path (if process-error (process-error env e)
-                                                    (Throwable->map e)))
-        ::reader-error))))
+      (try
+        (reader env)
+        (catch Exception e
+          (swap! errors* assoc path (if process-error (process-error env e)
+                                                      (Throwable->map e)))
+          ::reader-error)))))

 (defn wrap-parser-exception [parser]
   (fn [env tx]


Remove tap

Remove tap

--- src/com/wsscode/pathom/misc.cljc
+++ src/com/wsscode/pathom/misc.cljc
@@ -66,14 +66,6 @@
 (def sconj (fnil conj #{}))
 (def vconj (fnil conj []))

-(defn tap
-  ([label x]
-   (clojure.pprint/pprint [label x])
-   x)
-  ([x]
-   (clojure.pprint/pprint x)
-   x))
-
 (defn spec-doc [spec doc]
   spec)


Make test names match assertions

Make test names match assertions

First it looked like each test name was backwards. Giving the function "C" and transcribing to "G" was named `transcribes-guanine-to-cytosine` rather than `transcribes-cytosine-to-guanine`.

Second, the assertion for "T" -> "A" appeared to be in the right order but it mentioned the wrong nucleotide.

--- rna-transcription/rna_transcription_test.clj
+++ rna-transcription/rna_transcription_test.clj
@@ -1,16 +1,16 @@
 (ns rna-transcription.test (:require [clojure.test :refer :all]))
 (load-file "rna_transcription.clj")

-(deftest transcribes-guanine-to-cytosine
+(deftest transcribes-cytosine-to-guanine
   (is (= "G" (rna-transcription/to-rna "C"))))

-(deftest transcribes-cytosine-to-guanine
+(deftest transcribes-guanine-to-cytosine
   (is (= "C" (rna-transcription/to-rna "G"))))

-(deftest transcribes-uracil-to-adenine
+(deftest transcribes-adenine-to-uracil
   (is (= "U" (rna-transcription/to-rna "A"))))

-(deftest it-transcribes-thymine-to-uracil
+(deftest it-transcribes-thymine-to-adenine
   (is (= "A" (rna-transcription/to-rna "T"))))

 (deftest it-transcribes-all-nucleotides


Add actions-column function override method

--- src/hatti/views.cljs
+++ src/hatti/views.cljs
@@ -33,6 +33,7 @@
 (defmulti table-search view-type-dispatcher)
 (defmulti label-changer view-type-dispatcher)
 (defmulti action-buttons view-type-fn-dispatcher)
+(defmulti actions-column view-type-fn-dispatcher)

 ;; MAP TABLE
 (defmulti report-view-page view-type-dispatcher)


Tidy up multiple-column details response [#1571]

--- backend/src/akvo/lumen/lib/multiple_column.clj
+++ backend/src/akvo/lumen/lib/multiple_column.clj
@@ -9,7 +9,7 @@
       (let [res (select-keys schema [:hasImage])]
         (assoc res :columns (map (fn [r]
                                    {:id   (:id r)
-                                    :name (str (:name r) " :: " (:unit r))
+                                    :name (:name r)
                                     :type "text" ;; TODO will be improved after design discussions
                                     }) (:results schema)))))))


Using ArrayList for c.c.a.concepts/in-close

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

--- src/conexp/contrib/algorithms/concepts.clj
+++ src/conexp/contrib/algorithms/concepts.clj
@@ -12,7 +12,7 @@
         conexp.contrib.algorithms.generators
         [conexp.contrib.algorithms.next-closure :only (next-closed-set)])
   (:use [conexp.fca.contexts :only (objects attributes incidence)])
-  (:import [java.util BitSet Vector])
+  (:import [java.util BitSet List ArrayList])
   (:import [java.util.concurrent SynchronousQueue]))

 (ns-doc
@@ -145,7 +145,7 @@

 (defn- in-close
   "Implements the InClose method of In-Close."
-  [attribute-count, incidence-matrix, ^Vector As, ^Vector Bs, last, current, y]
+  [attribute-count, incidence-matrix, ^List As, ^List Bs, last, current, y]
   (swap! last + 1)
   (.add As @last (BitSet.))
   (loop [j (int y)]
@@ -160,14 +160,14 @@
         (when (cannonical? incidence-matrix (.get As @last) (.get Bs current) j)
           (.add Bs @last (.clone ^BitSet (.get Bs current)))
           (.set ^BitSet (.get Bs @last) j)
-          (in-close attribute-count incidence-matrix As Bs last @last (+ j 1))))
+          (in-close attribute-count incidence-matrix As Bs last @last (inc j))))
       (recur (inc j)))))

 (defmethod concepts :in-close
   [_ context]
   (with-binary-context context
-    (let [^Vector As (Vector.),
-          ^Vector Bs (Vector.),
+    (let [^List As (ArrayList.),
+          ^List Bs (ArrayList.),
           last (atom 0)]
       (.add As 0 (BitSet.))
       (.set ^BitSet (.get As 0) 0 (int object-count))


Added print-method for models

Added print-method for models

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

--- src/conexp/contrib/dl/framework/models.clj
+++ src/conexp/contrib/dl/framework/models.clj
@@ -8,7 +8,8 @@

 (ns conexp.contrib.dl.framework.models
   (:use conexp
-	conexp.contrib.dl.framework.syntax))
+	conexp.contrib.dl.framework.syntax)
+  (:use clojure.contrib.pprint))

 ;;; Model definition

@@ -33,6 +34,13 @@
   "Returns a model for a given DL language on the given base set."
   [language base-set base-interpretation]
   (Model language base-set base-interpretation))
+
+(defmethod print-method ::Model [model out]
+  (let [#^String output (with-out-str (pprint (list 'Model
+						    (model-language model)
+						    (model-base-set model)
+						    (model-base-interpretation model))))]
+    (.write out (.trim output))))

 ;;; Interpretation


remove debugging statement

remove debugging statement

--- cimi-resources/test/com/sixsq/slipstream/ssclj/resources/spec/external_object_template_test.cljc
+++ cimi-resources/test/com/sixsq/slipstream/ssclj/resources/spec/external_object_template_test.cljc
@@ -24,9 +24,7 @@
               :acl         valid-acl
               :objectType  "alpha"
               :state       "new"}]
-
-    (print (s/explain :cimi.test/external-object-template root))
-
+
     (is (s/valid? :cimi.test/external-object-template root))

     ;;mandatory keywords


CMR-2146: Fixed sample group native-id.

CMR-2146: Fixed sample group native-id.

--- metadata-db-app/test/cmr/metadata_db/test/services/concept_validations.clj
+++ metadata-db-app/test/cmr/metadata_db/test/services/concept_validations.clj
@@ -41,7 +41,7 @@

 (def valid-group
   {:concept-id "AG1-PROV1"
-   :native-id "foo␝PROV1"
+   :native-id "foo"
    :provider-id "PROV1"
    :concept-type :access-group
    :user-id "user1"})


simple s3 list of buckets

simple s3 list of buckets

--- cljs/src/immanent/cli.cljs
+++ cljs/src/immanent/cli.cljs
@@ -2,11 +2,7 @@

 (def aws (js/require "aws-sdk"))

-(defn square [x]
-  (* x x))
-
 (defn -main [& args]
-  (-> args first js/parseInt square prn)
-  (prn aws))
+  (.listBuckets (new aws.S3 {:apiVersion "2006-03-01"}) (fn [err data] (prn data))))

 (set! *main-cli-fn* -main)


Update "no workflows" empty state

Update "no workflows" empty state

--- src-cljs/frontend/components/pages/workflow.cljs
+++ src-cljs/frontend/components/pages/workflow.cljs
@@ -290,8 +290,15 @@
                     (card/basic
                      (empty-state/empty-state
                       {:icon (icon/workflows)
-                       :heading (html [:span (empty-state/important (str org-name "/" project-name)) " has no workflows defined yet"])
-                       :subheading (str "Add a workflow section to " project-name "'s config to start running workflows.")}))}))))))
+                       :heading (html [:span (empty-state/important (str org-name "/" project-name)) " has no workflows configured"])
+                       :subheading (html
+                                    [:span
+                                     "To orchestrate multiple jobs, add the workflows key to your config.yml file."
+                                     [:br]
+                                     " See "
+                                     [:a {:href "https://circleci.com/docs/2.0/workflows"}
+                                      "the workflows documentation"]
+                                     " for examples and instructions."])}))}))))))

 (def project-workflow-runs (om-next/factory ProjectWorkflowRuns))


naive working select xhr

naive working select xhr


Output formatting tweaks

Output formatting tweaks

--- boot/pod/src/boot/pedantic.clj
+++ boot/pod/src/boot/pedantic.clj
@@ -40,14 +40,17 @@
   (->> env pod/resolve-dependencies (map #(vec (take 2 (:dep %)))) (into {})))

 (defn prn-conflicts [env]
-  (let [version (resolved-versions env)]
-    (doseq [[k v] (dep-conflicts env)]
-      (println (ansi/bold-white (str "\u2022 " k)))
+  (let [version (resolved-versions env)
+        deps    (->> env :dependencies (map #(vec (take 2 %))) (into {}))]
+    (doseq [[k v] (dep-conflicts env)
+            m     (if (deps k) "\u2714" "!")]
+      (print (ansi/bold-white (format "[%s] %s\n" m k)))
       (doseq [[k' v'] (reverse v)
               :let [v? (= k' (version k))
                     m  (if v? "\u2714" "\u2718")
-                    c1 (if v? ansi/green ansi/yellow)
+                    c1 #((cond (= k %) ansi/bold-green
+                               v?      ansi/green
+                               :else   ansi/yellow) %)
                     c2 (if v? ansi/bold-green ansi/bold-yellow)]]
-        (->> (c1 (string/join "\n    " v'))
-             (format "  %s %s\n    %s\n" (c2 m) (c2 k'))
-             print)))))
+        (print (->> (string/join "\n      " (map c1 (sort v')))
+                    (format "    %s %s\n      %s\n" (c2 m) (c2 k'))))))))


Add a note if compiling with no :namespaces specified.

--- src/leiningen/compile.clj
+++ src/leiningen/compile.clj
@@ -133,8 +133,9 @@
   (deps project :skip-dev)
   (.mkdir (file (:compile-path project)))
   (let [namespaces (namespaces-to-compile project)]
-    (when (seq namespaces)
+    (if (seq namespaces)
       (eval-in-project project
                        `(doseq [namespace# '~namespaces]
                           (println "Compiling" namespace#)
-                          (clojure.core/compile namespace#))))))
+                          (clojure.core/compile namespace#)))
+      (println "No :namespaces listed for compilation in project.clj."))))


change seq to ref (from atom) for the next step.

--- clojure/robot-name/robot.clj
+++ clojure/robot-name/robot.clj
@@ -1,6 +1,6 @@
 (ns robot)

-(def name-seq (atom (list "A" "A" 1)))
+(def name-seq (ref (list "A" "A" 1)))

 (defn- format-name
   [name-seq]
@@ -12,7 +12,8 @@

 (defn- generate-name
   []
-  (swap! name-seq inc-name-seq)
+  (dosync
+   (alter name-seq inc-name-seq))
   (format-name name-seq))

 (defn robot


Remove git controlled files first in gh-branch deploy workflow.

--- src/incise/deploy/workflows/git_branch.clj
+++ src/incise/deploy/workflows/git_branch.clj
@@ -108,6 +108,12 @@
     (when (not= exit 0)
       (warn "Failed to apply stash:" err))))

+(defn ls-files []
+  (s/split-lines (:out (sh "git" "ls-files"))))
+
+(defn rm-path [path]
+  (sh "git" "rm" path))
+
 (defn deploy
   "Deploy to the given branch. Follow options for commit and push behaviour."
   [{:keys [path remote branch commit push]
@@ -125,6 +131,7 @@
       (when stash-ref
         (debug "Stashed with reference:" stash-ref))
       (setup-branch branch)
+      (dorun (map rm-path (ls-files)))
       (->> *out-dir*
            (file-seq)
            (rest) ; Skip the out directory


Give the protocol a slightly better name.

--- namespaces/common/src/main/clojure/immutant/logging.clj
+++ namespaces/common/src/main/clojure/immutant/logging.clj
@@ -18,7 +18,7 @@
 (ns ^:no-doc immutant.logging
     "Internal logging bridge. Not for public consumption.")

-(defprotocol MockLogger
+(defprotocol Logger
   (trace [this msg])
   (debug [this msg])
   (info [this msg])
@@ -35,7 +35,7 @@
       (eval `(import 'org.immutant.core.Immutant))
       (eval '(fn [n] (Immutant/getLogger n)))
       (catch Throwable _
-        (let [l (reify MockLogger
+        (let [l (reify Logger
                   (trace [_ msg])
                   (debug [_ msg])
                   (info [_ msg]


More reasonable min/max and rate values.


Add more example

Add more example

--- src/clojure/clojure_walkthrough/cjia/ch07_xx.clj
+++ src/clojure/clojure_walkthrough/cjia/ch07_xx.clj
@@ -172,3 +172,65 @@
     `(case (rand-int ~c) ~@(interleave (range c) exprs))))

 (randomly-2 (println "Amit") (println "Deepthi" (println "Adi"))) ;; return proper result!
+
+(defn check-credentials [username password]
+  ; Just return true for now
+  true)
+
+(defn login-user [request]
+  (let [username (:username request)
+        password (:password request)]
+    (if (check-credentials username password)
+      (str "Welcome back, " username ", " password "is correct!")
+      (str "Login failed!"))))
+
+(def request {:username "amit"
+              :password "1234"})
+
+nv(login-user request) ; "Welcome back, amit, 1234is correct!"
+
+;; Let's create the macro
+(defmacro defwebmethod [name args & exprs]
+  `(defn ~name [{:keys ~args}]
+     ~@exprs))
+
+(defwebmethod login-user [username password]
+  (if (check-credentials username password)
+    (str "Welcome, " username "," password " is still correct!")
+    (str "Login failed!")))
+
+(login-user request) ; "Welcome, amit,1234 is still correct!"
+
+;; 7.3.4: defnn
+(defmacro defnn [fname [& names] & body]
+  (let [ks {:keys (vec names)}]
+    `(defn ~fname [& {:as arg-map#}]
+       (let [~ks arg-map#]
+         ~@body))))
+
+(defnn print-details [name salary start-date]
+  (println "Name     : " name)
+  (println "Salary   : " salary)
+  (println "Start on : " start-date))
+
+(print-details :start-date "10/22/2009"
+               :name "Rob"
+               :salary 1000000)
+
+;; assert-true
+(defmacro assert-true [test-expr]
+  (let [[operator lhs rhs] test-expr]
+   `(let [rhsv# ~rhs ret# ~test-expr]
+      (if-not ret#
+        (throw (RuntimeException.
+                (str '~lhs " is not " '~operator " " rhsv#)))
+        true
+        ))))
+
+; We like to use this one this way!
+(assert-true (= (* 2 4) (/ 16 2))) ; true
+
+(assert-true (< (* 2 4) (/ 18 2))) ; true
+
+(assert-true (< (* 4 5) (* 2 5))) ;; java.lang.RuntimeException
+                                  ;; (* 4 5) is not < 10


CMR-2412: Fixing the memory database so it actually cascades to delete all the concepts in the provider.

--- metadata-db-app/src/cmr/metadata_db/data/memory_db.clj
+++ metadata-db-app/src/cmr/metadata_db/data/memory_db.clj
@@ -17,8 +17,8 @@
   [db concepts concept]
   (cond (and (= :collection (:concept-type concept))
            (:deleted concept))
-          (filter #(not= (:concept-id concept) (get-in % [:extra-fields :parent-collection-id]))
-            concepts)
+        (filter #(not= (:concept-id concept) (get-in % [:extra-fields :parent-collection-id]))
+          concepts)

         ;; CMR-2520 Remove this case when asynchronous cascaded deletes are implemented.
         (and (= :tag (:concept-type concept))
@@ -123,217 +123,222 @@
   concepts/ConceptSearch

   (find-concepts
-    [db providers params]
-    (let [found-concepts (mapcat #(concepts/search-with-params @concepts-atom
-                                                               (assoc params :provider-id (:provider-id %)))
-                                 providers)]
-      (concepts->find-result found-concepts params)))
+   [db providers params]
+   (let [found-concepts (mapcat #(concepts/search-with-params @concepts-atom
+                                                              (assoc params :provider-id (:provider-id %)))
+                                providers)]
+     (concepts->find-result found-concepts params)))

   (find-latest-concepts
-    [db provider params]
-    (let [latest-concepts (latest-revisions @concepts-atom)
-          found-concepts (concepts/search-with-params latest-concepts
-                                                      (assoc params :provider-id (:provider-id provider)))]
-      (concepts->find-result found-concepts params)))
+   [db provider params]
+   (let [latest-concepts (latest-revisions @concepts-atom)
+         found-concepts (concepts/search-with-params latest-concepts
+                                                     (assoc params :provider-id (:provider-id provider)))]
+     (concepts->find-result found-concepts params)))

   concepts/ConceptsStore

   (generate-concept-id
-    [this concept]
-    (let [{:keys [concept-type provider-id]} concept
-          num (swap! next-id-atom inc)]
-      (cc/build-concept-id {:concept-type concept-type
-                            :sequence-number num
-                            :provider-id provider-id})))
+   [this concept]
+   (let [{:keys [concept-type provider-id]} concept
+         num (swap! next-id-atom inc)]
+     (cc/build-concept-id {:concept-type concept-type
+                           :sequence-number num
+                           :provider-id provider-id})))

   (get-concept-id
-    [this concept-type provider native-id]
-    (let [provider-id (:provider-id provider)
-          concept-type (if (keyword? concept-type) concept-type (keyword concept-type))]
-      (->> @concepts-atom
-           (filter (fn [c]
-                     (and (= concept-type (:concept-type c))
-                          (= provider-id (:provider-id c))
-                          (= native-id (:native-id c)))))
-           first
-           :concept-id)))
+   [this concept-type provider native-id]
+   (let [provider-id (:provider-id provider)
+         concept-type (if (keyword? concept-type) concept-type (keyword concept-type))]
+     (->> @concepts-atom
+          (filter (fn [c]
+                    (and (= concept-type (:concept-type c))
+                         (= provider-id (:provider-id c))
+                         (= native-id (:native-id c)))))
+          first
+          :concept-id)))

   (get-concept
-    [db concept-type provider concept-id]
-    (let [revisions (filter
-                      (fn [c]
-                        (and (= concept-type (:concept-type c))
-                             (= (:provider-id provider) (:provider-id c))
-                             (= concept-id (:concept-id c))))
-                      @concepts-atom)]
-      (->> revisions
-           (sort-by :revision-id)
-           last)))
+   [db concept-type provider concept-id]
+   (let [revisions (filter
+                    (fn [c]
+                      (and (= concept-type (:concept-type c))
+                           (= (:provider-id provider) (:provider-id c))
+                           (= concept-id (:concept-id c))))
+                    @concepts-atom)]
+     (->> revisions
+          (sort-by :revision-id)
+          last)))

   (get-concept
-    [db concept-type provider concept-id revision-id]
-    (if-not revision-id
-      (concepts/get-concept db concept-type provider concept-id)
-      (first (filter
-               (fn [c]
-                 (and (= concept-type (:concept-type c))
-                      (= (:provider-id provider) (:provider-id c))
-                      (= concept-id (:concept-id c))
-                      (= revision-id (:revision-id c))))
-               @concepts-atom))))
+   [db concept-type provider concept-id revision-id]
+   (if-not revision-id
+     (concepts/get-concept db concept-type provider concept-id)
+     (first (filter
+             (fn [c]
+               (and (= concept-type (:concept-type c))
+                    (= (:provider-id provider) (:provider-id c))
+                    (= concept-id (:concept-id c))
+                    (= revision-id (:revision-id c))))
+             @concepts-atom))))

   (get-concepts
-    [this concept-type provider concept-id-revision-id-tuples]
-    (filter identity
-            (map (fn [[concept-id revision-id]]
-                   (concepts/get-concept this concept-type provider concept-id revision-id))
-                 concept-id-revision-id-tuples)))
+   [this concept-type provider concept-id-revision-id-tuples]
+   (filter identity
+           (map (fn [[concept-id revision-id]]
+                  (concepts/get-concept this concept-type provider concept-id revision-id))
+                concept-id-revision-id-tuples)))

   (get-latest-concepts
-    [db concept-type provider concept-ids]
-    (let [concept-id-set (set concept-ids)
-          concept-map (reduce (fn [concept-map {:keys [concept-id revision-id] :as concept}]
-                                (if (contains? concept-id-set concept-id)
-                                  (cond
-
-                                    (nil? (get concept-map concept-id))
-                                    (assoc concept-map concept-id concept)
-
-                                    (> revision-id (:revision-id (get concept-map concept-id)))
-                                    (assoc concept-map concept-id concept)
-
-                                    :else
-                                    concept-map)
-                                  concept-map))
-                              {}
-                              @concepts-atom)]
-      (keep (partial get concept-map) concept-ids)))
+   [db concept-type provider concept-ids]
+   (let [concept-id-set (set concept-ids)
+         concept-map (reduce (fn [concept-map {:keys [concept-id revision-id] :as concept}]
+                               (if (contains? concept-id-set concept-id)
+                                 (cond
+
+                                   (nil? (get concept-map concept-id))
+                                   (assoc concept-map concept-id concept)
+
+                                   (> revision-id (:revision-id (get concept-map concept-id)))
+                                   (assoc concept-map concept-id concept)
+
+                                   :else
+                                   concept-map)
+                                 concept-map))
+                             {}
+                             @concepts-atom)]
+     (keep (partial get concept-map) concept-ids)))

   (get-transactions-for-concept
-    [db provider con-id]
-    (keep (fn [{:keys [concept-id revision-id transaction-id]}]
-            (when (= con-id concept-id)
-              {:revision-id revision-id :transaction-id transaction-id}))
-          @concepts-atom))
+   [db provider con-id]
+   (keep (fn [{:keys [concept-id revision-id transaction-id]}]
+           (when (= con-id concept-id)
+             {:revision-id revision-id :transaction-id transaction-id}))
+         @concepts-atom))

   (save-concept
-    [this provider concept]
-    {:pre [(:revision-id concept)]}
-
-    (if-let [error (validate-concept-id-native-id-not-changing this provider concept)]
-      ;; There was a concept id, native id mismatch with earlier concepts
-      error
-      ;; Concept id native id pair was valid
-      (let [{:keys [concept-type provider-id concept-id revision-id]} concept
-            concept (update-in concept [:revision-date] #(or % (f/unparse (f/formatters :date-time)
-                                                                          (tk/now))))
-            concept (assoc concept :transaction-id (swap! next-transaction-id-atom inc))
-            concept (if (= concept-type :granule)
-                      (-> concept
-                          (dissoc :user-id)
-                          ;; This is not stored in the real db.
-                          (update-in [:extra-fields] dissoc :parent-entry-title))
-                      concept)]
-        (if (or (nil? revision-id)
-                (concepts/get-concept this concept-type provider concept-id revision-id))
-          {:error :revision-id-conflict}
-          (do
-            (swap! concepts-atom (fn [concepts]
-                                   (after-save this (conj concepts concept)
-                                               concept)))
-            nil)))))
+   [this provider concept]
+   {:pre [(:revision-id concept)]}
+
+   (if-let [error (validate-concept-id-native-id-not-changing this provider concept)]
+     ;; There was a concept id, native id mismatch with earlier concepts
+     error
+     ;; Concept id native id pair was valid
+     (let [{:keys [concept-type provider-id concept-id revision-id]} concept
+           concept (update-in concept [:revision-date] #(or % (f/unparse (f/formatters :date-time)
+                                                                         (tk/now))))
+           concept (assoc concept :transaction-id (swap! next-transaction-id-atom inc))
+           concept (if (= concept-type :granule)
+                     (-> concept
+                         (dissoc :user-id)
+                         ;; This is not stored in the real db.
+                         (update-in [:extra-fields] dissoc :parent-entry-title))
+                     concept)]
+       (if (or (nil? revision-id)
+               (concepts/get-concept this concept-type provider concept-id revision-id))
+         {:error :revision-id-conflict}
+         (do
+          (swap! concepts-atom (fn [concepts]
+                                 (after-save this (conj concepts concept)
+                                             concept)))
+          nil)))))

   (force-delete
-    [db concept-type provider concept-id revision-id]
-    (swap! concepts-atom
-           #(filter
-              (fn [c]
-                (not (and (= concept-type (:concept-type c))
-                          (= (:provider-id provider) (:provider-id c))
-                          (= concept-id (:concept-id c))
-                          (= revision-id (:revision-id c)))))
-              %)))
+   [db concept-type provider concept-id revision-id]
+   (swap! concepts-atom
+          #(filter
+            (fn [c]
+              (not (and (= concept-type (:concept-type c))
+                        (= (:provider-id provider) (:provider-id c))
+                        (= concept-id (:concept-id c))
+                        (= revision-id (:revision-id c)))))
+            %)))

   (force-delete-concepts
-    [db provider concept-type concept-id-revision-id-tuples]
-    (doseq [[concept-id revision-id] concept-id-revision-id-tuples]
-      (concepts/force-delete db concept-type provider concept-id revision-id)))
+   [db provider concept-type concept-id-revision-id-tuples]
+   (doseq [[concept-id revision-id] concept-id-revision-id-tuples]
+     (concepts/force-delete db concept-type provider concept-id revision-id)))

   (get-concept-type-counts-by-collection
-    [db concept-type provider]
-    (->> @concepts-atom
-         (filter #(= (:provider-id provider) (:provider-id %)))
-         (filter #(= concept-type (:concept-type %)))
-         (group-by (comp :parent-collection-id :extra-fields))
-         (map #(update-in % [1] count))
-         (into {})))
+   [db concept-type provider]
+   (->> @concepts-atom
+        (filter #(= (:provider-id provider) (:provider-id %)))
+        (filter #(= concept-type (:concept-type %)))
+        (group-by (comp :parent-collection-id :extra-fields))
+        (map #(update-in % [1] count))
+        (into {})))

   (reset
-    [db]
-    (reset! concepts-atom [])
-    (reset! next-id-atom (dec cmr.metadata-db.data.oracle.concepts/INITIAL_CONCEPT_NUM))
-    (reset! next-transaction-id-atom 1))
+   [db]
+   (reset! concepts-atom [])
+   (reset! next-id-atom (dec cmr.metadata-db.data.oracle.concepts/INITIAL_CONCEPT_NUM))
+   (reset! next-transaction-id-atom 1))

   (get-expired-concepts
-    [db provider concept-type]
-    (->> @concepts-atom
-         (filter #(= (:provider-id provider) (:provider-id %)))
-         (filter #(= concept-type (:concept-type %)))
-         latest-revisions
-         (filter expired?)
-         (remove :deleted)))
+   [db provider concept-type]
+   (->> @concepts-atom
+        (filter #(= (:provider-id provider) (:provider-id %)))
+        (filter #(= concept-type (:concept-type %)))
+        latest-revisions
+        (filter expired?)
+        (remove :deleted)))

   (get-tombstoned-concept-revisions
-    [db provider concept-type tombstone-cut-off-date limit]
-    (->> @concepts-atom
-         (filter #(= concept-type (:concept-type %)))
-         (filter #(= (:provider-id provider) (:provider-id %)))
-         (filter :deleted)
-         (filter #(t/before? (p/parse-datetime (:revision-date %)) tombstone-cut-off-date))
-         (map #(vector (:concept-id %) (:revision-id %)))
-         (take limit)))
+   [db provider concept-type tombstone-cut-off-date limit]
+   (->> @concepts-atom
+        (filter #(= concept-type (:concept-type %)))
+        (filter #(= (:provider-id provider) (:provider-id %)))
+        (filter :deleted)
+        (filter #(t/before? (p/parse-datetime (:revision-date %)) tombstone-cut-off-date))
+        (map #(vector (:concept-id %) (:revision-id %)))
+        (take limit)))

   (get-old-concept-revisions
-    [db provider concept-type max-versions limit]
-    (letfn [(drop-highest
-              [concepts]
-              (->> concepts
-                   (sort-by :revision-id)
-                   (drop-last max-versions)))]
-      (->> @concepts-atom
-           (filter #(= concept-type (:concept-type %)))
-           (filter #(= (:provider-id provider) (:provider-id %)))
-           (group-by :concept-id)
-           vals
-           (filter #(> (count %) max-versions))
-           (mapcat drop-highest)
-           (map concept->tuple))))
+   [db provider concept-type max-versions limit]
+   (letfn [(drop-highest
+            [concepts]
+            (->> concepts
+                 (sort-by :revision-id)
+                 (drop-last max-versions)))]
+     (->> @concepts-atom
+          (filter #(= concept-type (:concept-type %)))
+          (filter #(= (:provider-id provider) (:provider-id %)))
+          (group-by :concept-id)
+          vals
+          (filter #(> (count %) max-versions))
+          (mapcat drop-highest)
+          (map concept->tuple))))

   providers/ProvidersStore

   (save-provider
-    [db {:keys [provider-id] :as provider}]
-    (swap! providers-atom assoc provider-id provider))
+   [db {:keys [provider-id] :as provider}]
+   (swap! providers-atom assoc provider-id provider))

   (get-providers
-    [db]
-    (vals @providers-atom))
+   [db]
+   (vals @providers-atom))

   (get-provider
-    [db provider-id]
-    (@providers-atom provider-id))
+   [db provider-id]
+   (@providers-atom provider-id))

   (update-provider
-    [db {:keys [provider-id] :as provider}]
-    (swap! providers-atom assoc provider-id provider))
+   [db {:keys [provider-id] :as provider}]
+   (swap! providers-atom assoc provider-id provider))

   (delete-provider
-    [db provider]
-    (swap! providers-atom dissoc (:provider-id provider)))
+   [db provider]
+   ;; Cascade to delete the concepts
+   (doseq [{:keys [concept-type concept-id revision-id]} (concepts/find-concepts
+                                                          db provider {:provider-id provider})]
+     (concepts/force-delete db concept-type provider concept-id revision-id))
+
+   (swap! providers-atom dissoc (:provider-id provider)))

   (reset-providers
-    [db]
-    (reset! providers-atom {})))
+   [db]
+   (reset! providers-atom {})))

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


Write synchronously by default

Write synchronously by default

--- modules/cache/src/main/clojure/immutant/cache/core.clj
+++ modules/cache/src/main/clojure/immutant/cache/core.clj
@@ -66,7 +66,7 @@
       (.start))))

 (defn clustered-cache
-  [name & {:keys [mode sync] :or {mode :invalidated}}]
+  [name & {:keys [mode sync] :or {mode :invalidated sync true}}]
   (if (.isRunning clustered-manager name)
     (reconfigure name (cache-mode mode sync))
     (configure name (cache-mode mode sync))))


Stop MDA during burst without hanging

Stop MDA during burst without hanging

Prevent acquisition engine from hanging due to full output queue. Also
correctly propagate exceptions and avoid spurious error messages when
terminating with an error or explicitly (via stop()).

This prevents the acquisition engine from aparently locking into
"running" state (as observed via the GUI). This is especially applicable
to out-of-memory situations, in which the output queue is full when
stop() is called to terminate the MDA.

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -29,6 +29,7 @@
     [org.micromanager.mm :as mm])
   (:import
     [ij ImagePlus]
+    [java.io EOFException] ; abused to indicate canceled burst image collection
     [java.net InetAddress]
     [java.util Date UUID]
     [java.util.concurrent CountDownLatch LinkedBlockingQueue TimeUnit]
@@ -356,18 +357,21 @@
 (defn pop-tagged-image-timeout
   [timeout-ms]
   (log "waiting for burst image with timeout" timeout-ms "ms")
-  (let [start-time (System/currentTimeMillis)]
+  (let [deadline (+ (System/currentTimeMillis) timeout-ms)]
     (loop []
+      (when (@state :stop)
+        (log "halting image collection due to engine stop")
+        (throw (EOFException. "(Aborted)")))
       (if-let [image (pop-tagged-image)]
         image
-        (if (< timeout-ms (- (System/currentTimeMillis) start-time))
-          (throw-exception "Timed out waiting for image to arrive from camera.")
-          (do
+        (if (< deadline (System/currentTimeMillis))
+          (do
+            (log "halting image collection due to timeout")
+            (throw-exception "Timed out waiting for image to arrive from camera."))
+          (do
             (when (. mmc isBufferOverflowed)
-                (println "Circular buffer overflowed")
-                (throw-exception "Circular buffer overflowed."))
-            (when (@state :stop)
-              (throw-exception "Aborted!"))
+              (log "halting image collection due to circular buffer overflow")
+              (throw-exception "Circular buffer overflowed."))
             (Thread/sleep 1)
             (recur)))))))

@@ -381,7 +385,7 @@
    Will block whenever queue reaches queue-size. If function
    throws an exception, this exception will be placed on
    the queue, the thread will stop, and the final call to .take
-   on the queue will re-throw the exception."
+   on the queue will re-throw the exception (wrapped in RuntimeException)."
   [n queue-size function]
   (let [queue (proxy [LinkedBlockingQueue] [queue-size]
                 (take [] (let [item (proxy-super take)]
@@ -391,9 +395,9 @@
     (future (try
               (dotimes [_ n]
                 (try (.put queue (function))
-                     (catch Throwable t
-                            (.put queue t)
-                            (throw t))))
+                  (catch Throwable t
+                    (.put queue t)
+                    (throw t))))
               (catch Throwable t nil)))
     queue))

@@ -425,8 +429,6 @@

 (defn burst-cleanup []
   (log "burst-cleanup")
-  (when (core isBufferOverflowed)
-    (throw-exception "Circular buffer overflowed."))
   (core stopSequenceAcquisition)
   (while (and (not (@state :stop)) (. mmc isSequenceRunning))
     (Thread/sleep 5)))
@@ -454,17 +456,26 @@
         camera-channel-name (nth camera-channel-names cam-chan)
         num-camera-channels (count camera-channel-names)
         event (-> burst-event
-                  (update-in [:channel-index]
-                             make-multicamera-channel
-                             cam-chan num-camera-channels)
-                  (update-in [:channel :name]
-                             super-channel-name
-                             camera-channel-name num-camera-channels)
-                  (assoc :camera-channel-index cam-chan))
-        time-stamp (burst-time (:tags image) @state)
-        ]
-    ;image))
+                (update-in [:channel-index]
+                           make-multicamera-channel
+                           cam-chan num-camera-channels)
+                (update-in [:channel :name]
+                           super-channel-name
+                           camera-channel-name num-camera-channels)
+                (assoc :camera-channel-index cam-chan))
+        time-stamp (burst-time (:tags image) @state)]
     (annotate-image image event @state time-stamp)))
+
+(defn send-tagged-image
+  "Send out image to output queue, but avoid hanging if we stop while blocking
+  on the output queue"
+  [out-queue tagged-image]
+  (loop []
+    (when (@state :stop)
+      (log "canceling image output due to engine stop")
+      (throw (EOFException. "(Aborted)")))
+    (when (not (.offer out-queue tagged-image 1000 (TimeUnit/MILLISECONDS)))
+      (recur))))

 (defn produce-burst-images
   "Pops images from circular buffer, tags them, and sends them to output queue."
@@ -474,15 +485,21 @@
         camera-index-tag (str (. mmc getCameraDevice) "-CameraChannelIndex")
         image-number-offset (if (first-trigger-missing?) -1 0)
         image-queue (pop-burst-images total timeout-ms)]
-    (doseq [i (range total) :while (not (@state :stop))]
-      ;(println i)
-      (.put out-queue
-            (-> (.take image-queue)
-                (tag-burst-image burst-events camera-channel-names camera-index-tag
-                                 image-number-offset)
-                make-TaggedImage
-                ))))
-  (burst-cleanup))
+    (try
+      (doseq [i (range total)]
+        (send-tagged-image
+          out-queue
+          (let [image (try
+                        (.take image-queue)
+                        (catch RuntimeException e
+                          (if (.getCause e) ; unwrap rethrown exception
+                            (throw (.getCause e))
+                            (throw e))))]
+            (-> image
+              (tag-burst-image burst-events camera-channel-names camera-index-tag
+                               image-number-offset)
+              make-TaggedImage))))
+      (finally (burst-cleanup)))))

 (defn collect-burst-images [event out-queue]
   (let [pop-timeout-ms (+ 20000 (* 10 (:exposure event)))]
@@ -498,7 +515,7 @@
     (select-keys event [:position-index :frame-index
                         :slice-index :channel-index])
     (when out-queue
-      (.put out-queue
+      (send-tagged-image out-queue
             (make-TaggedImage (annotate-image image event @state (elapsed-time @state)))))
     image))

@@ -563,10 +580,14 @@
       nil)))

 (defn collect [event out-queue]
-  (condp = (:task event)
-                :snap (doseq [sub-event (make-multicamera-events event)]
-                        (collect-snap-image sub-event out-queue))
-                :burst (collect-burst-images event out-queue)))
+  (log "collecting image(s)")
+  (try
+    (condp = (:task event)
+      :snap (doseq [sub-event (make-multicamera-events event)]
+              (collect-snap-image sub-event out-queue))
+      :burst (collect-burst-images event out-queue))
+    (catch EOFException eat
+      (log "halted image collection and output due to engine stop"))))

 (defn z-in-msp [msp z-drive]
   (-> msp MultiStagePosition-to-map :axes (get z-drive) first))
@@ -704,6 +725,8 @@
                              (when-let [t (:wait-time-ms event)]
                                (< 1000 t))))]
     (filter identity
+            ; The items of the flattened list get executed without stopping or
+            ; pausing in between (except when throwing)
             (flatten
               (list
                 #(log "#####" "BEGIN acquisition event:" event)
@@ -776,12 +799,24 @@
         (def acq-sequence acq-seq) ; for debugging
         (execute (mapcat #(make-event-fns % out-queue) acq-seq)))
       (catch Throwable t
-             (def acq-error t)
+             (def acq-error t) ; for debugging
+             ; XXX There ought to be a way to get errors programmatically...
              (future (ReportingUtils/showError t "Acquisition failed.")))
       (finally
         (when cleanup?
           (cleanup))
-        (.put out-queue TaggedImageQueue/POISON))))
+        (if (:stop @state)
+          ; In the case where we canceled the acquisition via stop, it is
+          ; possible that the out-queue is full. But we have already given up
+          ; on sending images in that case, so it can't do any further harm to
+          ; drain the queue.
+          (if (.offer out-queue TaggedImageQueue/POISON)
+            nil
+            (do
+              (.clear out-queue)
+              (.put out-queue TaggedImageQueue/POISON)))
+          (.put out-queue TaggedImageQueue/POISON))
+        (log "acquisition thread exiting"))))

 ;; generic metadata