various:

various:

* add get-module-name
* support --unit-test flag for building and running
* make build assemble config-app pipeline work for service apps
* rename service-app to config-app
* code cleanup

Signed-off-by: Gregg Reynolds <d0f77bc71a9867acdcb4f62f012b858edad79160@norc.org>

--- src/migae/boot_gae.clj
+++ src/migae/boot_gae.clj
@@ -45,32 +45,64 @@
   [fileset servlet]
   (if servlet
     "target"
-    (let [boot-config-edn-files (->> (boot/input-files fileset)
-                                     (boot/by-name [boot-config-edn]))
-          boot-config-edn-f (condp = (count boot-config-edn-files)
-                              0 nil
-                              1 (first boot-config-edn-files)  ;; this is a boot.tmpdir.TmpFile
-                              (throw (Exception.
-                                      (str "only one _boot_config.edn file allowed, found "
-                                           (count boot-config-edn-files)))))
-          boot-config-edn-map (if boot-config-edn-f
-                                (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
-                                nil)]
-      (if boot-config-edn-map
-        (str "target/" (-> boot-config-edn-map :module :name))
+    ;; (let [boot-config-edn-files (->> (boot/input-files fileset)
+    ;;                                  (boot/by-name [boot-config-edn]))
+    ;;       boot-config-edn-f (condp = (count boot-config-edn-files)
+    ;;                           0 (throw (Exception. (str boot-config-edn " file not found")))
+    ;;                           1 (first boot-config-edn-files)  ;; this is a boot.tmpdir.TmpFile
+    ;;                           (throw (Exception.
+    ;;                                   (str "only one _boot_config.edn file allowed, found "
+    ;;                                        (count boot-config-edn-files)))))
+    ;;       boot-config-edn-map (if boot-config-edn-f
+    ;;                             (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
+    ;;                             nil)]
+    ;;   (if boot-config-edn-map
+    ;;     (str "target/" (-> boot-config-edn-map :module :name))
         (let [appengine-edn-fs (->> fileset
                                     boot/input-files
                                     (boot/by-name [appengine-edn]))

+              appengine-edn-f (condp = (count appengine-edn-fs)
+                                0 (throw (Exception. (str appengine-edn " file not found")))
+                                1 (first appengine-edn-fs)
+                                (throw (Exception. (str "Only one " appengine-edn " file allowed"))))
+
+              appengine-config-map (-> (boot/tmp-file appengine-edn-f) slurp read-string)]
+          (if servlet "target" (if (-> appengine-config-map :services)
+                                 "target/default"
+                                 (str "target/" (-> appengine-config-map :module :name)))))))
+
+(defn get-module-name
+  [fileset servlet]
+  (if servlet
+    "default"
+    ;; (let [boot-config-edn-files (->> (boot/input-files fileset)
+    ;;                                  (boot/by-name [boot-config-edn]))
+    ;;       boot-config-edn-f (condp = (count boot-config-edn-files)
+    ;;                           0 (throw (Exception. boot-config-edn " file not found"))
+    ;;                           1 (first boot-config-edn-files)  ;; this is a boot.tmpdir.TmpFile
+    ;;                           (throw (Exception.
+    ;;                                   (str "only one _boot_config.edn file allowed, found "
+    ;;                                        (count boot-config-edn-files)))))
+    ;;       boot-config-edn-map (if boot-config-edn-f
+    ;;                             (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
+    ;;                             nil)]
+    ;;   (if boot-config-edn-map
+    ;;           (-> boot-config-edn-map :module :name)
+        (let [appengine-edn-fs (->> fileset
+                                    boot/input-files
+                                    (boot/by-name [appengine-edn]))
               appengine-edn-f (condp = (count appengine-edn-fs)
                                 0 (throw (Exception. appengine-edn " file not found"))
                                 1 (first appengine-edn-fs)
                                 (throw (Exception. (str "Only one " appengine-edn " file allowed"))))

-              appengine-config-map (-> (boot/tmp-file appengine-edn-f) slurp read-string)]
-          (if servlet "target" (if (-> appengine-config-map :services)
-                                 "target/default"
-                                 (str "target/" (-> appengine-config-map :module :name)))))))))
+              appengine-config-map (-> (boot/tmp-file appengine-edn-f) slurp read-string)
+              module (if servlet "default"
+                         (if (-> appengine-config-map :services)
+                           "default"
+                           (-> appengine-config-map :module :name)))]
+          module)))

 (defn expand-home [s]
   (if (or (.startsWith s "~") (.startsWith s "$HOME"))
@@ -303,6 +335,7 @@
    k keep bool "keep intermediate .clj files"
    m module MODULE str "module dirpath"
    s servlet bool "generate config for servlet app instead of service component DEPRECATED"
+   u unit-test bool "configure for unit testing (module: 'default')"
    v verbose bool "Print trace messages."]
   ;; boolean hasUppercase = !password.equals(password.toLowerCase());
   (let [workspace (boot/tmp-dir!)
@@ -335,7 +368,8 @@

              appengine-config-map (-> (boot/tmp-file appengine-edn-f) slurp read-string)

-             module (if servlet "default"
+             module (if unit-test "default" (get-module-name fileset servlet))
+             #_(if servlet "default"
                         (if (-> appengine-config-map :services)
                           "default"
                           (if (-> appengine-config-map :module)
@@ -475,45 +509,49 @@
 (boot/deftask assemble
   "assemble a service-based app (ear)"
   [v verbose bool "Print trace messages."]
-  (let [tmpdir (boot/tmp-dir!)
-        dfl-scopes #{"compile" "runtime" "provided"}
-        scopes dfl-scopes
-        ;; scopes     (-> dfl-scopes
-        ;;                (set/union include-scope)
-        ;;                (set/difference exclude-scope))
-        scope?     #(contains? scopes (:scope (util/dep-as-map %)))
-        checkouts  (->> (boot/get-checkouts)
-                        (filter (comp scope? :dep val))
-                        (into {}))
-        co-jars    (->> checkouts (map (comp :jar val)))
-        co-dirs    (->> checkouts (map (comp :dir val)))
-
-        checkout-vec (-> (boot/get-env) :checkouts)
-        cos (map #(assoc (apply hash-map %) :coords [(first %) (second %)]) checkout-vec)
-        ]
-    (comp
-     (earxml)
-     (boot/with-pre-wrap [fileset]
-       (doseq [co cos]
-         (let [mod (if (:default co) "default" (if-let [mod (:module co)] mod "default"))]
-           (let [corec (get checkouts (first (:coords co)))
-                 co-dir (:dir corec)
-                 jar-path (.getPath (:jar corec))
-                 out-dir (doto (io/file tmpdir mod) io/make-parents)]
-             ;; (println "co-dir: " co-dir)
-             ;; (println "out-dir: " out-dir)
-             (fs/copy-dir co-dir out-dir))))
-       (-> fileset
-           (boot/add-asset tmpdir :exclude #{(re-pattern (str "/META-INF/.*"))})
-           (boot/commit!)))
-     (target)
-     )))
+  (fn middleware [next-handler]
+    (fn handler [fileset]
+      (if verbose (util/info "Assembling application"))
+      (let [workspace (boot/tmp-dir!)
+            appengine-config-edn-files (->> (boot/input-files fileset)
+                                            (boot/by-re [(re-pattern (str appengine-edn "$"))]))
+            ;; (if (> (count services-fs) 1) (throw (Exception. "Only one " appengine-edn " file allowed")))
+            ;; (if (= (count services-fs) 0)
+            appengine-config-edn-f (condp = (count appengine-config-edn-files)
+                                     0 (throw (Exception. appengine-edn " file not found"))
+                                     1 (first appengine-config-edn-files)
+                                     (throw (Exception.
+                                             (str "Only one " appengine-edn " file allowed; found "
+                                                  (count appengine-config-edn-files)))))
+
+            appengine-cfg (-> (boot/tmp-file appengine-config-edn-f) slurp read-string)
+            services (:services appengine-cfg)
+
+            target-middleware identity
+            target-handler (target-middleware next-handler)]
+        (doseq [service services]
+          (let [coord (pod/map->coord service)
+                jar-path (pod/resolve-dependency-jar (boot/get-env) coord)
+                out-dir (io/file workspace)]
+                ;;(doto (io/file workspace (:name service)) io/make-parents)]
+            (pod/unpack-jar jar-path out-dir)))
+        (target-handler (-> fileset ;; (boot/new-fileset)
+                            (boot/add-asset workspace :exclude #{(re-pattern (str "/META-INF/.*"))})
+                            (boot/commit!)))))))

 (boot/deftask build-sift
-  []
-  (comp
-   (builtin/sift :move {#"(.*clj$)" (str classes-dir "/$1")})
-   (builtin/sift :move {#"(.*\.class$)" (str classes-dir "/$1")})))
+  [u unit-test bool "sift for unit-test config"]
+  (fn middleware [next-handler]
+    (fn handler [fileset]
+      (let [module (if unit-test "default" (get-module-name fileset false))
+            target-middleware (comp
+                               (builtin/sift :move {#"(.*clj$)" (str classes-dir "/$1")})
+                               (builtin/sift :move {#"(.*\.class$)" (str classes-dir "/$1")})
+                               (builtin/sift :move {#"(.+$)" (str module "/$1")})
+                               )
+            target-handler (target-middleware next-handler)]
+        (target-handler fileset)))))
+

 (boot/deftask build
   "Configure and build servlet or service app"
@@ -542,7 +580,7 @@
             (comp
              (builtin/pom)
              (builtin/jar)))
-          (target :servlet servlet :verbose verbose)
+          #_(target :servlet servlet :verbose verbose)
           #_(builtin/sift :include #{(re-pattern (str mod ".*jar"))})
           #_(builtin/install)
           #_(target :verbose verbose)
@@ -590,12 +628,13 @@
   [d dir DIR str "output dir"
    c config-syms SYMS #{sym} "namespaced symbols bound to meta-config data"
    k keep bool "keep intermediate .clj files"
+   u unit-test bool "configure for unit testing (module = 'default')"
    v verbose bool "Print trace messages."]
   (comp
    (webxml :verbose verbose)
-   (appengine :verbose verbose)))
-
-(boot/deftask service-app
+   (appengine :unit-test unit-test :verbose verbose)))
+
+(boot/deftask config-app
   "generate xml config files for microservices app"
   [d dir DIR str "output dir"
    c config-syms SYMS #{sym} "namespaced symbols bound to meta-config data"
@@ -650,7 +689,9 @@
           (spit appengine-application-out-file appengine-application-cfg)
           (spit services-app-out-file services-app-cfg)
           (spit manifest-out-file manifest-cfg)))
-      (-> fileset (boot/add-resource workspace) boot/commit!))))
+      (-> fileset ;; (boot/new-fileset)
+          (boot/add-resource workspace)
+          boot/commit!))))

 (boot/deftask deploy
   "Installs a new version of the application onto the server, as the default version for end users."
@@ -820,6 +861,7 @@
             jar-name (.getName jar-jfile)
             target-middleware (comp
                                (builtin/install :file jar-path)
+                               (builtin/sift :to-source #{(re-pattern (str ".*META-INF.*"))})
                                (builtin/sift :to-source #{(re-pattern (str ".*" jar-name))}))
             target-handler (target-middleware next-handler)]
         (target-handler fileset)))))
@@ -1009,14 +1051,15 @@
    v verbose bool "verbose"]
   (fn middleware [next-handler]
     (fn handler [fileset]
-      (let [dir (or dir (get-target-dir fileset servlet))
-            _ (println "TARGET DIR: " dir)
+      (let [target-dir (get-target-dir fileset servlet)
+            target-dir (if dir (str dir "/" target-dir) target-dir)
+            _ (println "TARGET DIR: " target-dir)
             target-middleware (comp (builtin/watch)
                                     (builtin/notify :audible true)
                                     (builtin/sift :move {#"(.*\.clj$)" (str classes-dir "/$1")})
                                     (if servlet
                                       (target :no-clean true :servlet servlet)
-                                      (target :no-clean true :servlet servlet :dir dir)))
+                                      (target :no-clean true :servlet servlet :dir target-dir)))
             target-handler (target-middleware next-handler)]
         (target-handler fileset)))))

@@ -1032,6 +1075,7 @@
    n gen-reloader-ns NS sym "ns for gen-reloader"
    r reloader-impl-ns NS sym "ns for reloader"
    s servlet bool "build as servlet"
+   u unit-test bool "configure for unit testing"
    w web-inf WEB-INF str "WEB-INF dir, default: WEB-INF"
    v verbose bool "Print trace messages."]
   (let [workspace (boot/tmp-dir!)
@@ -1059,7 +1103,8 @@
                                    (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
                                    {})

-             module (if-let [module (-> boot-config-edn-map :module :name)]
+             module (get-module-name fileset false)
+             #_(if-let [module (-> boot-config-edn-map :module :name)]
                       module
                       (let [appengine-config-edn-files
                             (->> (boot/fileset-diff @prev-pre fileset)
@@ -1077,8 +1122,9 @@
                             appengine-config-edn-map
                             (-> (boot/tmp-file boot-config-edn-f) slurp read-string)]
                         (-> appengine-config-edn-map :module :name)))
+
+             module (if unit-test "./" (get-module-name fileset false))
              ]
-         (println "MODULE: " module)

          (if (:reloader boot-config-edn-map)
            fileset
@@ -1089,9 +1135,10 @@
                    m (-> boot-config-edn-map (assoc-in [:reloader]
                                                        {:ns reloader-impl-ns
                                                         :name "reloader"
+                                                        :module module
                                                         :display {:name "Clojure reload filter"}
-                                                        :urls (if (empty? urls) [{:url "/*"}]
-                                                                  (vec urls))
+                                                        ;; :urls (if (empty? urls) [{:url "/*"}]
+                                                        ;;           (vec urls))
                                                         :desc {:text "Clojure reload filter"}}))
                    boot-config-edn-s (with-out-str (pp/pprint m))
                    boot-config-edn-out-file (io/file workspace
@@ -1103,7 +1150,7 @@

              (let [reloader-impl-content (stencil/render-file "migae/templates/reloader-impl.mustache"
                                                               {:reloader-ns reloader-impl-ns
-                                                               :module (or module "./")})
+                                                               :module module})

                    gen-reloader-content (stencil/render-file "migae/templates/gen-reloader.mustache"
                                                              {:gen-reloader-ns gen-reloader-ns
@@ -1140,6 +1187,7 @@
 (boot/deftask run
   "Run devappserver"
   [;; DevAppServerMain.java
+   u unit-test bool "run in unit-testing config"
    _ sdk-server VAL str "--server"
    _ http-address VAL str "The address of the interface on the local machine to bind to (or 0.0.0.0 for all interfaces).  Default: 127.0.0.1"
    _ http-port VAL int "The port number to bind to on the local machine. Default: 8080"
@@ -1191,10 +1239,11 @@
           ;; _ (println "ARGS: " args)
           ;; jargs (into-array String (conj jargs "build/exploded-app"))

-          target-dir (if servlet "target"
-                         (if (-> appengine-config-map :services)
-                           "target/default"
-                           (str "target/" (-> appengine-config-map :module :name))))
+          target-dir (if unit-test "target/default" "target") ;; (get-target-dir fileset servlet))
+          #_(if servlet "target"
+                                    (if (-> appengine-config-map :services)
+                                      "target/default"
+                                      (str "target/" (-> appengine-config-map :module :name))))

           checkout-vec (-> (boot/get-env) :checkouts)
           cos (map #(assoc (apply hash-map %) :coords [(first %) (second %)]) checkout-vec)
@@ -1255,10 +1304,10 @@
   {:servlets
    (vec (flatten (for [config (:servlets configs)]
           (let [urls (into [] (for [url (:urls config)]
-                                {:url (str url)}))
+                                {:path (str url)}))
                 ns (if (:ns config) (:ns config) (:class config)) ]
             (merge config {:urls urls
-                           :ns ns})))))})
+                           :servlet {:ns ns}})))))})

 (boot/deftask servlets
   "generate servlets class files"
@@ -1381,32 +1430,57 @@
         odir (if dir dir web-inf-dir)]
     ;; (println "ODIR: " odir)
     (boot/with-pre-wrap fileset
-      (let [boot-config-edn-fs (->> (boot/fileset-diff @prev-pre fileset)
-                                boot/input-files
-                                (boot/by-re [(re-pattern (str boot-config-edn "$"))]))]
-            ;; (boot/by-name [boot-config-edn]))]
-        (if (> (count boot-config-edn-fs) 1) (throw (Exception. "only one _boot_config.edn file allowed")))
-        (if (= (count boot-config-edn-fs) 0) (throw (Exception. "_boot_config.edn file not found")))
-
-        (let [boot-config-edn-f (first boot-config-edn-fs)
-              web-xml (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
-              path     (boot/tmp-path boot-config-edn-f)
-              in-file  (boot/tmp-file boot-config-edn-f)
-              out-file (io/file workspace path)]
-          (let [content (stencil/render-file
-                         "migae/templates/xml.web.mustache"
-                         web-xml)]
-            (let [;;tmp-dir (boot/tmp-dir!)
-                  xml-out-path (str odir "/web.xml")
-                  xml-out-file (doto (io/file workspace xml-out-path) io/make-parents)
-                  ;; reloader (doto (io/file tmp-dir "foobar.xml") io/make-parents)
-                  ]
-           ;; web.xml always
-           ;; (if (.exists reloader)
-           ;;   nop
-           ;;   create empty reloader
-              (if verbose (util/info "Configuring web.xml\n"))
-              (spit xml-out-file content)))))
+       (let [boot-config-edn-files (->> (boot/fileset-diff @prev-pre fileset)
+                                    boot/input-files
+                                    (boot/by-re [(re-pattern (str boot-config-edn "$"))]))
+             boot-config-edn-f (condp = (count boot-config-edn-files)
+                             0 (do (if verbose (util/info (str "Creating " boot-config-edn "\n")))
+                                   (io/file boot-config-edn)) ;; this creates a java.io.File
+                             1 (first boot-config-edn-files)  ;; this is a boot.tmpdir.TmpFile
+                             (throw (Exception.
+                                     (str "only one " boot-config-edn " file allowed; found "
+                                          (count boot-config-edn-files)))))
+             boot-config-edn-map (if (instance? boot.tmpdir.TmpFile boot-config-edn-f)
+                                   (-> (boot/tmp-file boot-config-edn-f) slurp read-string)
+                                   {})
+             path     (boot/tmp-path boot-config-edn-f)
+             in-file  (boot/tmp-file boot-config-edn-f)
+             out-file (io/file workspace path)
+
+             webapp-edn-files (->> (boot/fileset-diff @prev-pre fileset)
+                                        boot/input-files
+                                        (boot/by-re [(re-pattern (str webapp-edn "$"))]))
+             webapp-edn-f (condp = (count webapp-edn-files)
+                            0 (throw (Exception. (str "Cannot find " webapp-edn " file.")))
+                            1 (first webapp-edn-files)
+                            (throw (Exception.
+                                    (str "only one " webapp-edn " file allowed; found "
+                                         (count webapp-edn-files)))))
+             webapp-edn-map (-> (boot/tmp-file webapp-edn-f) slurp read-string)
+
+             ;; inject webapp config map into master config map
+             master-config (merge boot-config-edn-map webapp-edn-map)
+             ;; _ (println "master config: " master-config)
+
+             content (stencil/render-file
+                      "migae/templates/xml.web.mustache"
+                      master-config)
+             ;; _ (println "web.xml content: " content)
+
+             ;; step 3: create new master config file
+             boot-config-edn-out-file (io/file workspace (boot/tmp-path boot-config-edn-f))
+
+             xml-out-path (str odir "/web.xml")
+             xml-out-file (doto (io/file workspace xml-out-path) io/make-parents)]
+
+         ;; web.xml always
+         ;; (if (.exists reloader)
+         ;;   nop
+         ;;   create empty reloader
+         (if verbose (util/info "Configuring web.xml\n"))
+         (io/make-parents boot-config-edn-out-file)
+         (spit boot-config-edn-out-file master-config)
+         (spit xml-out-file content))
       (-> fileset (boot/add-resource workspace) boot/commit!))))


watch-iref clean up on unmount

watch-iref clean up on unmount

--- src/minreact/core.cljs
+++ src/minreact/core.cljs
@@ -141,5 +141,7 @@
       (when-not (= selector next-selector)
         (uninstall-watch this selector)
         (install-watch this next-selector))))
+  (fn componentWillUnmount []
+    (uninstall-watch this (normalize-selector selecttor)))
   (fn render []
     (render-child value)))


got specify-files done

got specify-files done

--- src/duffel/fs.clj
+++ src/duffel/fs.clj
@@ -50,3 +50,67 @@
         (partial util/index-when fdqn-matches)
         (partial util/index-when hostname-matches)
         (partial util/index-when #(= "_default" %))))
+
+(defn explode-files-in-list
+    "Take a list of filenames and turn them into file structs containing info
+    about their real name, extension, and host specifier"
+    [file-list]
+    (map #(
+        let [spec-split-ret (host-specifier-split %)
+              specifier      (last spec-split-ret)
+              ext-split-ret  (extension-split (first spec-split-ret))
+              extension      (last  ext-split-ret)
+              base-name      (first ext-split-ret)]
+        { :base-name base-name
+          :specifier specifier
+          :extension extension
+          :file-name %        }
+    ) file-list))
+
+(defn remove-empty-file-structs
+    "Looks through list of file structs and removes any with empty names"
+    [file-structs]
+    (remove #(empty? (% :base-name)) file-structs))
+
+(defn add-to-basename-group
+    "Given a map and a file struct, creates a list with the file-struct
+    as the only item for the index of the map corresponding to the file-
+    struct's :base-name. If the list already exists in the given map,
+    append to it instead"
+    [file-map file-struct]
+    (let [base-name (file-struct :base-name)
+          base-name-seq (file-map base-name '())
+          new-seq (cons file-struct base-name-seq)]
+        (assoc file-map base-name new-seq)))
+
+(defn group-by-basename
+    "Goes through file structs and groups them into a map by basename
+    { <base-name> <list of structs> }"
+    [file-structs]
+    (reduce add-to-basename-group {} file-structs))
+
+(defn narrow-group
+    "Given a list of file-structs, returns the struct with the most specific
+    specifier"
+    [group-seq]
+    (let [specifiers (map #(% :specifier) group-seq)]
+        (when-let [i (index-of-specified-entry specifiers)]
+            (nth group-seq i))))
+
+(defn narrow-groups
+    "Given a map of basename groups, returns a list of all the most specific
+    structs from each basename group"
+    [file-map]
+    (map #(narrow-group (val %)) file-map))
+
+(defn specify-files
+    "Given a list of file names (presumably all in the same folder) goes and performs
+    all the steps needed to narrow down which files we want to actually use for this
+    particular node, and identifies which extension we want to process them with.
+    Returns a list of file-structs"
+    [file-list]
+    (->> file-list
+         (explode-files-in-list)
+         (remove-empty-file-structs)
+         (group-by-basename)
+         (narrow-groups)))


Make search bar more responsive to quick typing

Use local state for search query input, in addition to dispatching;
just dispatching and referring to the sub can drop keystrokes and is
generally annoying when typing quickly

--- src/braid/search/ui/search_bar.cljs
+++ src/braid/search/ui/search_bar.cljs
@@ -1,18 +1,20 @@
 (ns braid.search.ui.search-bar
   (:require
-    [re-frame.core :refer [subscribe dispatch]]
-    [braid.core.client.routes :as routes]
-    [braid.lib.color :as color]))
+   [reagent.core :as r]
+   [re-frame.core :refer [subscribe dispatch]]
+   [braid.core.client.routes :as routes]
+   [braid.lib.color :as color]))

 (defn search-bar-view
   []
-  (let [search-query @(subscribe [:braid.search/query])]
+  (r/with-let [search-query (r/atom @(subscribe [:braid.search/query]))]
     [:div.search-bar
      [:input {:type "text"
               :placeholder "Search..."
-              :value search-query
+              :value @search-query
               :on-change
               (fn [e]
+                (reset! search-query (.. e -target -value))
                 (dispatch [:braid.search/update-query! (.. e -target -value)]))}]
      (if search-query
        [:a.action.clear


cleanup

cleanup

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

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

 (defn get-current-time-str []
   (. iso8601modified format (Date.)))
-
+
 (defn get-pixel-type []
   (str ({1 "GRAY", 4 "RGB"} (int (core getNumberOfComponents))) (* 8 (core getBytesPerPixel))))

@@ -130,7 +130,7 @@
   (apply swap! state assoc args))

 ;; metadata
-
+
 (defn annotate-image [img event state]
   (TaggedImage. img (JSONObject.
     (merge
@@ -196,10 +196,10 @@

 (defn set-property
   ([prop] (core setProperty (prop 0) (prop 1) (prop 2))))
-
+
 (defn send-device-action [dev action]
   (send-off (device-agents dev) (fn [_] (action))))
-
+
 (defn create-presnap-actions [event]
   (concat
     (for [[axis pos] (:axes (MultiStagePosition-to-map (get-msp (:position event)))) :when pos]
@@ -249,7 +249,7 @@
   (while (and (core isSequenceRunning) (zero? (core getRemainingImageCount)))
     (Thread/sleep 5))
   (core popNextImage))
-
+
 (defn collect-snap-image []
   (core getImage))

@@ -259,7 +259,7 @@
                 :init-burst (collect-burst-image)
                 :collect-burst (collect-burst-image))]
     (.put out-queue (annotate-image image event @state))))
-
+
 (defn compute-z-position [event]
   (if-let [z-drive (:z-drive event)]
     (+ (or (get-in event [:channel :z-offset]) 0)
@@ -268,7 +268,7 @@
          0
          (or (get-z-position (:position event) z-drive)
              (@state :reference-z-position))))))
-
+
 (defn make-event-fns [event out-queue]
   (let [task (:task event)]
     (cond
@@ -276,7 +276,7 @@
         (list #(collect-image event out-queue))
       (or (= task :snap) (= task :init-burst))
         (list
-          #(log event)
+          #(log event)
           #(when-let [wait-time-ms (event :wait-time-ms)]
             (acq-sleep wait-time-ms))
           #(run-actions (create-presnap-actions event))
@@ -298,7 +298,7 @@
 (defn return-config []
   (dorun (map set-property
     (clojure.set/difference
-      (set (@state :init-system-state))
+      (set (@state :init-system-state))
       (set (get-system-config-cached))))))

 (defn prepare []
@@ -336,8 +336,8 @@
       :init-continuous-focus (core isContinuousFocusEnabled)
       :init-width (core getImageWidth)
       :init-height (core getImageHeight))))
-
-(defn run-acquisition [this settings out-queue]
+
+(defn run-acquisition [this settings out-queue]
   (def acq-settings settings)
   (prepare-state this)
   (binding [state (.state this)]
@@ -374,7 +374,7 @@
 (defn get-z-step-um [slices]
   (if (and slices (< 1 (count slices)))
     (- (second slices) (first slices))
-    0))
+    0))

 (defn make-summary-metadata [settings]
   (let [depth (int (core getBytesPerPixel))
@@ -413,14 +413,14 @@
       "Width" (core getImageWidth)
       "z-step_um" (get-z-step-um (settings :slices))
      })))
-
+
 (defn acquire-single [position-index]
   (core snapImage)
   (let [w (core getImageWidth)
         h (core getImageHeight)
         summary {:interval-ms 0.0, :use-autofocus false, :autofocus-skip 0,
                  :relative-slices true, :keep-shutter-open-slices false, :comment "",
-                 :prefix "Untitled", :root "/Users/arthur/AcquisitionData",
+                 :prefix "Untitled", :root "/Users/arthur/AcquisitionData",
                  :time-first false, :positions (), :channels (), :slices-first true,
                  :slices nil, :numFrames 0, :keep-shutter-open-channels false,
                  :zReference 0.0, :frames (), :save false}
@@ -430,7 +430,7 @@
                  :exposure (core getExposure), :relative-z true,
                  :task :snap, :z-drive (core getFocusDevice), :wait-time-ms 0}
         state   {:init-width w :init-height h}]
-    ;(let [cache (MMImageCache. ]
+    ;(let [cache (MMImageCache. ]
     (annotate-image (collect-snap-image) event state)))

 ;; java interop
@@ -443,19 +443,19 @@
   (def eng acq-eng)
   (load-mm)
   (create-device-agents)
-  (swap! (.state this) assoc :stop false :pause false)
+  (swap! (.state this) assoc :stop false :pause false)
   (let [out-queue (GentleLinkedBlockingQueue.)
         settings (convert-settings acq-settings)
-        acq-thread (Thread. #(run-acquisition this
+        acq-thread (Thread. #(run-acquisition this
           settings out-queue))
-        processors (ProcessorStack. out-queue (.getTaggedImageProcessors acq-eng))
+        processors (ProcessorStack. out-queue (.getTaggedImageProcessors acq-eng))
         out-queue-2 (.begin processors)
         display (LiveAcqDisplay. mmc out-queue-2 (make-summary-metadata settings)
                   (:save settings) acq-eng)]
     (def outq out-queue)
     ;(.addImageProcessor acq-eng
       ;(proxy [TaggedImageAnalyzer] []
-        ;(analyze [img] (log "pretending to analyze"))))
+        ;(analyze [img] (log "pretending to analyze"))))
     (when-not (:stop @(.state this))
       (.start acq-thread)
       (swap! (.state this) assoc :display display)
@@ -464,27 +464,27 @@
 (defn -pause [this]
   (log "pause requested!")
   (swap! (.state this) assoc :pause true))
-
+
 (defn -resume [this]
   (log "resume requested!")
   (swap! (.state this) assoc :pause false))
-
+
 (defn -stop [this]
   (log "stop requested!")
   (let [state (.state this)]
     (swap! state assoc :stop true)
     (do-when #(.countDown %) (:sleepy @state))
     (log @state)))
-
+
 (defn -isRunning [this]
-  (:running @(.state this)))
+  (:running @(.state this)))

 (defn -isPaused [this]
-  (:pause @(.state this)))
+  (:pause @(.state this)))

 (defn -stopHasBeenRequested [this]
   (:stop @(.state this)))
-
+
 (defn -nextWakeTime [this]
   (or (:next-wake-time @(.state this)) -1))

@@ -518,4 +518,4 @@
 (defn run-test []
   (test-dialog (create-acq-eng)))

-
+


Fix typo (acq engine thread name).

Fix typo (acq engine thread name).

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -883,7 +883,7 @@
     (let [out-queue (LinkedBlockingQueue. 10)
           acq-thread (Thread. #(binding [state (.state this)]
                                  (run-acquisition settings out-queue cleanup? position-list autofocus-device))
-                              "AcquisitionSequence2010 Thread (Clojure)")]
+                              "AcquisitionEngine2010 Thread (Clojure)")]
       (reset! (.state this)
               {:stop false
                :pause false


avoid NullPointerException in compute-time-from-core

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -151,10 +151,10 @@

 (defn compute-time-from-core [tags]
   ; (log "core tags: " tags)
-  (if (@state :burst-init-time)
-    (+ (Double/parseDouble (tags "ElapsedTime-ms"))
-       (@state :burst-init-time))
-    nil))
+  (when (@state :burst-init-time)
+    (when-let [t (tags "ElapsedTime-ms")]
+      (+ (Double/parseDouble t)
+         (@state :burst-init-time)))))

 (defn elapsed-time [state]
   (if (state :start-time) (- (clock-ms) (state :start-time)) 0))


Make side-effecting fns bang-suffixed.

Make side-effecting fns bang-suffixed.

--- src/clj/com/draines/postal/core.clj
+++ src/clj/com/draines/postal/core.clj
@@ -5,14 +5,14 @@
            [javax.mail Session Transport Message$RecipientType]
            [javax.mail.internet MimeMessage InternetAddress]))

-(defn add-recipient [jmsg rtype addr]
+(defn add-recipient! [jmsg rtype addr]
   (doto jmsg (.addRecipient rtype (InternetAddress. addr))))

-(defn add-recipients [jmsg rtype addrs]
+(defn add-recipients! [jmsg rtype addrs]
   (if (string? addrs)
-    (add-recipient jmsg rtype addrs)
+    (add-recipient! jmsg rtype addrs)
     (doseq [addr addrs]
-      (add-recipient jmsg rtype addr)))
+      (add-recipient! jmsg rtype addr)))
   jmsg)

 (defn make-jmessage [msg]
@@ -22,9 +22,9 @@
                 (.put "mail.from" from))
         session (Session/getInstance props)
         jmsg (MimeMessage. (:Session msg))]
-    (add-recipients jmsg Message$RecipientType/TO to)
-    (add-recipients jmsg Message$RecipientType/CC cc)
-    (add-recipients jmsg Message$RecipientType/BCC bcc)
+    (add-recipients! jmsg Message$RecipientType/TO to)
+    (add-recipients! jmsg Message$RecipientType/CC cc)
+    (add-recipients! jmsg Message$RecipientType/BCC bcc)
     (.setFrom jmsg (InternetAddress. from))
     (.setSubject jmsg subject)
     (.setText jmsg body)


add metric helper fn for setting state to conf

--- src/clj/marceline/storm/metrics.clj
+++ src/clj/marceline/storm/metrics.clj
@@ -89,3 +89,10 @@
          ~nm (:fn m#)]
      (register-metrics ~topology-context [[(str (quote ~nm)) (:m m#) 30]])
      (do ~@body)))
+
+
+;; helper fns
+(defn conf-state!
+  "Sets a consumer's state to be the conf map."
+  [this-consumer conf]
+  (reset! (. this-consumer state) conf))


Flip fullscreen expand/shrink icons vertically


CLJS-751: fix typo that causes reducers.cljs to blow up.

--- src/cljs/clojure/core/reducers.cljs
+++ src/cljs/clojure/core/reducers.cljs
@@ -298,7 +298,7 @@
   ;;can't fold, single reduce
   (reduce reducef (combinef) coll))

- cljs.core/IPersistentVector
+ cljs.core/PersistentVector
  (coll-fold
   [v n combinef reducef]
   (foldvec v n combinef reducef))


Fixed footer for mobile

Fixed footer for mobile

--- src/cljs/ikea_clojure_cup/core.cljs
+++ src/cljs/ikea_clojure_cup/core.cljs
@@ -54,8 +54,8 @@
     [:br]
     [:sup "© "]
     [:a {:href "http://www.icm-consulting.com.au/"} "ICM Consulting Pty Ltd B.V 2010"]
-    [:div.serial-text.pull-right "AA-498638-1"]
-    [:div.serial-number.pull-right (first (shuffle (range 10000 20000)))]]])
+    [:div.serial-text.pull-right.hidden-xs "AA-498638-1"]
+    [:div.serial-number.pull-right.hidden-xs (first (shuffle (range 10000 20000)))]]])

 ;; -------------------------


Fixed influence limit in deck builder for draft identities

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -11,6 +11,7 @@

 (def select-channel (chan))
 (def zoom-channel (chan))
+(def INFINITY 2147483647)

 (defn identical-cards? [cards]
   (let [name (:title (first cards))]
@@ -18,6 +19,10 @@

 (defn found? [query cards]
   (some #(if (= (.toLowerCase (:title %)) query) %) cards))
+
+(defn influencelimit [identity]
+  "Returns influence limit of an identity or INFINITY in case of draft IDs."
+  (if (= (:setname identity) "Draft") INFINITY (:influencelimit identity)))

 (defn search [query cards]
   (filter #(if (= (.indexOf (.toLowerCase (:title %)) query) -1) false true) cards))
@@ -51,11 +56,13 @@
   (reduce #(if-let [card (parse-line side %2)] (conj %1 card) %1) [] (split-lines deck)))

 (defn allowed? [card {:keys [side faction title] :as identity}]
+  "Checks if a card is allowed in deck of a given identity - not accounting for influence"
   (and (not= (:type card) "Identity")
        (= (:side card) side)
        (or (not= (:type card) "Agenda")
            (= (:faction card) "Neutral")
-           (= (:faction card) faction))
+           (= (:faction card) faction)
+           (= title "The Shadow: Pulling the Strings"))
        (or (not= title "Custom Biotics: Engineered for Success")
            (not= (:faction card) "Jinteki"))))

@@ -127,7 +134,7 @@

 (defn valid? [{:keys [identity cards] :as deck}]
   (and (>= (card-count cards) (:minimumdecksize identity))
-       (<= (influence deck) (:influencelimit identity))
+       (<= (influence deck) (influencelimit identity))
        (every? #(and (allowed? (:card %) identity)
                      (<= (:qty %) (or (get-in % [:card :limited]) 3))) cards)
        (or (= (:side identity) "Runner")
@@ -357,10 +364,10 @@
                     (when (< count min-count)
                       [:span.invalid (str "(minimum " min-count ")")])])
                  (let [inf (influence deck)
-                       limit (:influencelimit identity)]
+                       limit (influencelimit identity)]
                    [:div "Influence: "
                     [:span {:class (when (> inf limit) "invalid")} inf]
-                    "/" (:influencelimit identity)])
+                    "/" (if (= INFINITY limit) "∞" limit)])
                  (when (= (:side identity) "Corp")
                    (let [min-point (min-agenda-points deck)
                          points (agenda-points deck)]


give narrative priority

give narrative priority

--- src/cljs/salava/badge/ui/modal.cljs
+++ src/cljs/salava/badge/ui/modal.cljs
@@ -19,7 +19,7 @@
             [salava.admin.ui.reporttool :refer [reporttool1]]
             [salava.badge.ui.verify :refer [check-badge]]
             [salava.core.ui.tag :as tag]
-            [clojure.string :refer [blank?]]
+            [clojure.string :refer [blank? starts-with?]]
             [salava.badge.ui.evidence :refer [evidence-icon]]))

@@ -230,7 +230,12 @@
          [:div.col-md-12
           [:h2.uppercase-header (if (= (count evidences) 1)  (t :badge/Evidence) (str (t :badge/Evidence) " (" (count evidences) ")") ) ]
           (reduce (fn [r evidence]
-                    (let [{:keys [description name evidence_type id url mtime ctime properties]} evidence]
+                    (let [{:keys [narrative description name evidence_type id url mtime ctime properties]} evidence
+                          desc (cond
+                                 (not (blank? narrative)) narrative
+                                 (and (not (blank? description)) (not (starts-with? description "Evidence added by badge owner from"))) description
+                                 :else nil
+                                 )]
                       (conj r
                             [:div.modal-evidence
                              (if (empty? properties) [:span.label.label-success (t :user/verified)])
@@ -238,7 +243,7 @@
                              [:div.content

                               (when-not (blank? name) [:div.content-body.name name])
-                              (when-not (blank? description) [:div.content-body.description description])
+                              (when-not (blank? desc) [:div.content-body.description desc])
                               [:div.content-body.url (hyperlink url)]]
                              ])))
                   [:div ] evidences)]])]]))


reduce verbosity of debug

reduce verbosity of debug

--- src/clojure/redis_protocol/core.clj
+++ src/clojure/redis_protocol/core.clj
@@ -20,11 +20,13 @@
 (def OP_WRITE (SelectionKey/OP_WRITE))

 (set! *warn-on-reflection* true)
-;; (set! *unchecked-math* :warn-on-boxed)

 (timbre/refer-timbre)

 (def cluster-hash-slots 16384)
+
+(defn address? [x]
+  (instance? InetSocketAddress x))

 (defn drain
   "Drains items from q into a new collection."
@@ -222,10 +224,12 @@
    (let [timeout (ex-info "Operation timed out" {:timeout? true :args args})
          fut     (.schedule scheduled-executor ^Runnable (fn [] (f timeout)) 10000 (TimeUnit/MILLISECONDS))
          op      (write-operation args f fut)
-         op      (if-let [slot (routable-slot (spy :debug args) @command-cache)]
+         op      (if-let [slot (routable-slot (spy :trace args) @command-cache)]
                    (assoc op :slot slot)
                    op)]
-     (.addLast dispatch-queue (if (instance? InetSocketAddress address) [:resolve op address] [:resolve op]))
+     (.addLast dispatch-queue (if (address? address)
+                                [:resolve op address]
+                                [:resolve op]))
      (.wakeup selector)
      f)))

@@ -285,7 +289,7 @@
   (let [current-ops (.interestOps k)
         new-ops     (bit-or current-ops x)]
     (when (not= current-ops new-ops)
-      (debug (remote-address k) "adding op" (ops->str current-ops) "->" (ops->str new-ops))
+      (trace (remote-address k) "adding op" (ops->str current-ops) "->" (ops->str new-ops))
       (.interestOps k new-ops))))

 (defn ignore-op!
@@ -294,7 +298,7 @@
    (let [current-ops (.interestOps k)
          new-ops     (bit-and current-ops (bit-not x))]
      (when (not= current-ops new-ops)
-       (debug (remote-address k) "ignoring op" (ops->str current-ops) "->" (ops->str new-ops)))
+       (trace (remote-address k) "ignoring op" (ops->str current-ops) "->" (ops->str new-ops)))
      (.interestOps k new-ops))))

 (defmulti dispatch
@@ -331,7 +335,7 @@
                             (= ReplyParser/PARSE_OVERFLOW outcome)
                             (do (debug (remote-address k) "completed parsing op, but more byte(s) remain")
                                 (when overflow
-                                  (warn (remote-address k) "buffer has an additional" (alength overflow) "byte(s)")
+                                  (debug (remote-address k) "buffer has an additional" (alength overflow) "byte(s)")
                                   (trace-bytes overflow (str (remote-address k) " remaining byte(s) in receive buffer")))
                                 (.removeFirst read-queue)
                                 (complete op client)
@@ -396,9 +400,9 @@
 (defn open-connection [{:keys [seeds ^Selector selector connections] :as client} address]
   (let [{:keys [^SocketChannel channel ^InetSocketAddress address] :as conn} (socket-connection address)]
     (if (.connect channel address)
-      (do (debug address "connection has been established immediately, registering" (ops->str OP_READ))
+      (do (trace address "connection has been established immediately, registering" (ops->str OP_READ))
           (.register channel selector OP_READ conn))
-      (do (debug address "connection cannot be established immediately, registering" (ops->str OP_CONNECT))
+      (do (trace address "connection cannot be established immediately, registering" (ops->str OP_CONNECT))
           (.register channel selector OP_CONNECT conn)))
     (swap! connections assoc address conn)
     conn))
@@ -407,9 +411,10 @@
   (or (get @connections address)
       (open-connection client address)))

-(defmethod dispatch :resolve [connections {:keys [seeds ^Selector selector ^ConcurrentLinkedDeque dispatch-queue slot-cache command-cache] :as client} [_ op addr]]
+(defmethod dispatch :resolve [connections {:keys [seeds ^Selector selector ^ConcurrentLinkedDeque dispatch-queue cluster? slot-cache command-cache] :as client} [_ op addr]]
   (let [conns         @connections
-        resolved-conn (if-let [address (or addr (spy :debug (get @slot-cache (:slot op))))]
+        slot          (:slot op)
+        resolved-conn (if-let [address (or addr (get @slot-cache (:slot op)))]
                         (resolve-connection client address)
                         (or (rand-nth (vals conns))
                             (resolve-connection client (rand-seed client))))]
@@ -423,7 +428,7 @@

           (.isConnected channel)
           (let [k (.keyFor channel selector)]
-            (do (debug address "op is incomplete" (:write-buffer op))
+            (do (trace address "op is incomplete" (:write-buffer op))
                 (.addLast write-queue op)
                 (set-op! k OP_WRITE)))

@@ -546,7 +551,7 @@
 (defn connect
   "Creates and attempts to establish a connection to Redis"
   ([{:keys [seeds] :as config}]
-   {:pre [(seq seeds) (every? #(instance? InetSocketAddress %) seeds)]}
+   {:pre [(seq seeds) (every? address? seeds)]}
    (let [client (create-connection config)]
      (loop [[seed & more] (seq seeds)]
        (debug "attempting to connect to" seed)


Fix arity error in command parsing error handler

Signed-off-by: Deepak Giridharagopal <d11186354d1ef01ca06ae37d7e23e827da13e85f@puppetlabs.com>

--- src/com/puppetlabs/cmdb/command.clj
+++ src/com/puppetlabs/cmdb/command.clj
@@ -274,7 +274,7 @@
       (if (instance? Throwable parse-result)
         (do
           (mark! (global-metric :fatal))
-          (on-failure parse-result))
+          (on-failure msg parse-result))
         (f parse-result)))))

 (defn wrap-with-discard


CMR-4343: Where were you Parinfer?

CMR-4343: Where were you Parinfer?

--- bootstrap-app/src/cmr/db.clj
+++ bootstrap-app/src/cmr/db.clj
@@ -4,10 +4,10 @@
    [cmr.bootstrap.config :as bootstrap-config]
    [cmr.common.log :refer (debug info warn error)]
    [cmr.oracle.config :as oracle-config]
-   [cmr.oracle.sql-utils :as su])
+   [cmr.oracle.sql-utils :as su]
    [cmr.oracle.user :as o]
    [config.migrate-config :as mc]
-   [drift.execute :as drift]
+   [drift.execute :as drift])
   (:gen-class))

 (defn create-user


Fix no op strings (they should be doc strings).

--- src/swiss/core.clj
+++ src/swiss/core.clj
@@ -11,7 +11,7 @@
 (defn- compress-javascript*
   "Calls the YUI compressor and returns the compressed js as a string.

-Input is a vector with the filename as the first value and file's contents as the second value."
+  Input is a vector with the filename as the first value and file's contents as the second value."
   [input &
    [{:keys
      [disable-optimizations?
@@ -45,7 +45,7 @@
 (defn- compress-stylesheet*
   "Calls the YUI compressor and returns the compressed css as a string.

-Input is a vector with the filename as the first value and file's contents as the second value."
+  Input is a vector with the filename as the first value and file's contents as the second value."
   [input &
    [{:keys
      [line-break
@@ -62,91 +62,99 @@
      line-break)
     {(first input) (.toString (.getBuffer writer))}))

-(defn- get-previous-output [swiss-map]
+(defn- get-previous-output
   "Returns the return value of the previous function via the
-swiss-map."
+  swiss-map."
+  [swiss-map]
   ((:prev-fn swiss-map) swiss-map))

-(defn- current-working-directory []
+(defn- current-working-directory
   "Returns the directory the project is located in."
+  []
   (System/getProperty "user.dir"))

-(defn- file-path->file-name [relative-file-path]
+(defn- file-path->file-name
   "Takes a relative-file-path from the project's directory, return the
-file's name."
+  file's name."
+  [relative-file-path]
   (let [current-working-directory (current-working-directory)
         absolute-path (str current-working-directory "/" relative-file-path)]
     (.getName (File. absolute-path))))

-(defn- read-file [file-path]
+(defn- read-file
   "Takes a file-path as a string and returns a map with the file name
   as the key, with the file's contents as the value."
+  [file-path]
   {(file-path->file-name file-path) (slurp file-path)})

 (defn src
   "Takes a vector of files as strings to be read in and returned as
-map of the file-name to its content.
+  map of the file-name to its content.

-Optionally give it a swiss-map and it'll replae the :src value with
-the new ones."
+  Optionally give it a swiss-map and it'll replae the :src value with
+  the new ones."
   ([files]
-     (src {} files))
+   (src {} files))
   ([swiss-map files]
-     (merge swiss-map
-            {:src (into {} (map read-file files))
-             :prev-fn :src})))
+   (merge swiss-map
+          {:src (into {} (map read-file files))
+           :prev-fn :src})))

 (defn compress-javascript
   "Takes a swiss-map and optionally yui compressor options as a map
-and returns a map of the file-name to its compressed content."
+  and returns a map of the file-name to its compressed content."
   ([swiss-map]
-     (compress-javascript swiss-map nil))
+   (compress-javascript swiss-map nil))
   ([swiss-map yui-options]
-     (merge swiss-map
-            {:compress-javascript (into {} (map #(compress-javascript* % yui-options)
-                                                (get-previous-output swiss-map)))
-             :prev-fn :compress-javascript})))
+   (merge swiss-map
+          {:compress-javascript (into {} (map #(compress-javascript* % yui-options)
+                                              (get-previous-output swiss-map)))
+           :prev-fn :compress-javascript})))

 (defn compress-stylesheet
   "Takes a swiss-map and optionally yui compressor options as a map
-and returns a map of the file-name to its compressed content."
+  and returns a map of the file-name to its compressed content."
   ([swiss-map]
-     (compress-stylesheet swiss-map nil))
+   (compress-stylesheet swiss-map nil))
   ([swiss-map yui-options]
-     (merge swiss-map
-            {:compress-javascript (into {} (map #(compress-stylesheet* % yui-options)
-                                                (get-previous-output swiss-map)))
-             :prev-fn :compress-javascript})))
+   (merge swiss-map
+          {:compress-javascript (into {} (map #(compress-stylesheet* % yui-options)
+                                              (get-previous-output swiss-map)))
+           :prev-fn :compress-javascript})))

-(defn concat [swiss-map file-name]
+(defn concat
   "Concatenates the values of the file-map of the previous output and
-returns a map with the concatenated file-name as a key to the new
-concanted content as a value."
+  returns a map with the concatenated file-name as a key to the new
+  concanted content as a value."
+  [swiss-map file-name]
   (merge swiss-map
          {:concat {file-name
                    (apply str (vals (get-previous-output swiss-map)))}
           :prev-fn :concat}))

-(defn- output-to-file* [file-path file-vec]
+(defn- output-to-file*
   "Takes in a file vector, which is a vector with the first value
   being the filename and second value being the file's contents."
+  [file-path file-vec]
   (let [filename (first file-vec)
         contents (last file-vec)]
     (spit (str file-path "/" filename) contents)
     {filename contents}))

-(defn output-to-file [swiss-map file-path]
+(defn output-to-file
   "Takes a swiss-map with a file-map as its previous output, which is
-a map of keys consisting of a file's name as a string to its content
-as a value. Spits it out to the file-path."
+  a map of keys consisting of a file's name as a string to its content
+  as a value. Spits it out to the file-path."
+  [swiss-map file-path]
   (merge swiss-map
          {:output-to-file (into {} (map #(output-to-file* file-path %)
                                         (get-previous-output swiss-map)))
           :prev-fn :output-to-file}))

-(defn rename [swiss-map new-file-name]
+(defn rename
   "Renames a file. If there are multiple files, it renames the first
-one and returns it as a file-map."
+  one and returns it as a file-map."
+  [swiss-map new-file-name]
   (merge swiss-map
          {:rename
           {new-file-name (first (vals (get-previous-output swiss-map)))}


Refactoring expert interaction

Refactoring expert interaction

First step.  The final goal is to have almost everything in
one function, and to implement revoking ones opinion on
rejecting an implication

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

--- src/conexp/fca/exploration/repl.clj
+++ src/conexp/fca/exploration/repl.clj
@@ -63,38 +63,42 @@

 ;;

+(defn- expert-interaction [initial-state result-fns]
+  "Implements expert interaction.  The initial state is given by «initial-state», from
+   which on the expert is queried for commands that modify this state.  If eventually one
+   command returns nil, a vector is returned which arises from applying all functions in
+   the sequence «result-fns» to state, collecting the return values in the vector.  In
+   other words, «result-fns» is a sequence of functions, which are applied to the final
+   state in the sequence given, and their return values (collected in a vector) constitute
+   the return value of the call to this function."
+  (loop [state initial-state]
+    (let [result (eval-command (ask "counterexample> "
+                                    #(read-string (str (read-line)))
+                                    (constantly true)
+                                    "counterexample> ")
+                               state)]
+      (if result
+        (recur result)
+        (vec (map (fn [f] (f state)) result-fns))))))
+
 (defn counterexample-via-repl
   "Starts a repl for counterexamples, which must be specified completely."
   [ctx knowledge impl]
-  (loop [state {:context ctx,
-                :knowledge knowledge,
-                :implication impl
-                :complete-counterexamples? true}]
-    (let [query  (ask "counterexample> "
-                      #(read-string (str (read-line)))
-                      (constantly true)
-                      "counterexample> "),
-          result (eval-command query state)]
-      (if result
-        (recur result)
-        [(:object state) (set (:positives state))]))))
+  (expert-interaction {:context ctx,
+                       :knowledge knowledge,
+                       :implication impl
+                       :complete-counterexamples? true}
+                      [:object (comp set :positives)]))

 (defn incomplete-counterexample-via-repl
   "Starts a repl for counterexamples, which may be incomplete."
   [possible-ctx certain-ctx knowledge impl]
-  (loop [state {:possible-context possible-ctx,
-                :certain-context certain-ctx,
-                :knowledge knowledge,
-                :implication impl
-                :complete-counterexamples? false}]
-    (let [query  (ask "counterexample> "
-                      #(read-string (str (read-line)))
-                      (constantly true)
-                      "counterexample> "),
-          result (eval-command query state)]
-      (if result
-        (recur result)
-        [(:object state) (set (:positives state)) (set (:negatives state))]))))
+  (expert-interaction {:possible-context possible-ctx,
+                       :certain-context certain-ctx,
+                       :knowledge knowledge,
+                       :implication impl
+                       :complete-counterexamples? false}
+                      [:object (comp set :positives) (comp set :negatives)]))

 ;; REPL commands


Allow new-time and new-date to have 0-arity forms

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -15,19 +15,6 @@
        [java.time.format DateTimeFormatter]
        [java.time.temporal ChronoUnit ChronoField TemporalAdjusters]
        [clojure.lang ILookup Seqable])))
-
-(defn new-time
-  ([hour minute] (. LocalTime of hour minute))
-  ([hour minute second] (. LocalTime of hour minute second))
-  ([hour minute second nano] (. LocalTime of hour minute second nano)))
-
-(defn new-date
-  ([year month day-of-month]
-   (. LocalDate of year month day-of-month))
-  ([year day-of-year]
-   (. LocalDate ofYearDay year day-of-year))
-  ([epoch-day]
-   (. LocalDate ofEpochDay epoch-day)))

 (def ^{:dynamic true} *clock* nil)

@@ -149,6 +136,21 @@
   (offset-date-time [_] "Make a java.time.OffsetDateTime instance.")
   (date-time [_] "Make a java.time.LocalDateTime instance.")
   (temporal-value [_] "Coerce to a preferred value"))
+
+(defn new-time
+  ([] (time (now)))
+  ([hour minute] (. LocalTime of hour minute))
+  ([hour minute second] (. LocalTime of hour minute second))
+  ([hour minute second nano] (. LocalTime of hour minute second nano)))
+
+(defn new-date
+  ([] (today))
+  ([year month day-of-month]
+   (. LocalDate of year month day-of-month))
+  ([year day-of-year]
+   (. LocalDate ofYearDay year day-of-year))
+  ([epoch-day]
+   (. LocalDate ofEpochDay epoch-day)))

 (defn current-zone
   "Return the current zone, which can be overridden by the *clock* dynamic var"


add back the outer-page doc for backwards compat

--- src/pc/http/routes.clj
+++ src/pc/http/routes.clj
@@ -307,8 +307,13 @@
     ;; TODO: figure out what to do with outer pages on subdomains, need to
     ;;       solve the extraneous entity-id problem first
     (custom-domain/redirect-to-main req)
-    (let [cust-uuid (get-in req [:auth :cust :cust/uuid])]
-      (content/app (common-view-data req)))))
+    (let [cust-uuid (get-in req [:auth :cust :cust/uuid])
+          ;;TODO: remove this once frontend is deployed
+          doc (doc-model/create-public-doc!
+               (merge {:document/chat-bot (rand-nth chat-bot-model/chat-bots)}
+                      (when cust-uuid {:document/creator cust-uuid})))]
+      (content/app (merge (common-view-data req)
+                          {:initial-document-id (:db/id doc)})))))

 (defpage single-issue "/issues/:issue-uuid" [req]
   (if (:subdomain req)


provide a view of current-player as well

--- src/vigil/core.clj
+++ src/vigil/core.clj
@@ -73,18 +73,14 @@
   (fn [e & args]
     (->error "attacking-player and target-team must both be in game.")))

+(defn player-view [game player]
+  "Use the sally information in game to mark player alive or dead."
+  (assoc player :alive (nil? (killed-by game player))))

 (defn game-view [game]
   "Transform game to a structure easily parsed by templates. Right now this
   means use the sally information in game to mark each player alive or dead."
   (assoc game
-         :teams (map
-                 (fn [team]
-                   (assoc
-                    team
-                    :players (map
-                              (fn [player]
-                                (assoc player
-                                       :alive (nil?  (killed-by game player))))
-                              (:players team))))
-                 (:teams game))))
+         :teams (map #(assoc % :players (map (partial player-view game)
+                                             (:players %)))
+                     (:teams game))))


add to order module

add to order module

--- src/forex/module/account/common.clj
+++ src/forex/module/account/common.clj
@@ -1,5 +1,4 @@
 ;;forex.module.order.common - api for creating/modify orders
-
 ;;TODO: what happends when a metatrader error is thrown?
 (ns forex.module.account.common
   (:use utils.general emacs
@@ -14,24 +13,32 @@
 		    :price 1.31133
 		    :type :sell-stop
 		    :lots 0.1}))))
-
+
 (def- value-to-order-type
   {0 :buy 1 :sell 2 :buy-limit
    3 :sell-limit 4 :buy-stop
    5 :sell-stop})

-(defn time-close [{id :id}]
+(defn order-close-time [{id :id}]
   (is (string? id))
   (core/order-close-time id))

 (defn open? [order]
-  (= (time-close order) 0))
-
-(defn type-of
+  (= (order-close-time order) 0))
+
+(defn order-type
   "type of order, even if it is already closed"
   [o]
   (is (string? (:id o)))
   (value-to-order-type (int (core/order-type (:id o)))))
+
+(defn market?
+  "determine if order is market order"
+  [order]
+  (let [type (order-type order)]
+    (or (= type :sell) (= type :buy))))
+(defn entry? [order]
+  (not (market? order)))

 ;;BUG: somehow, metatrader sometimes freezes when making an order. hmmm...... not good!
 ;;or wait, maybe this is the other bug?


missing closing bracket in dispatch example

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -33,7 +33,7 @@
   added to the end of a FIFO queue which already contain events.

   Usage:
-     (dispatch [:order-pizza {:supreme 2 :meatlovers 1 :veg 1})"
+     (dispatch [:order-pizza {:supreme 2 :meatlovers 1 :veg 1}])"
   [event]
   (router/dispatch event))


Доработка карты на параметры center и zoom

--- radiolamp-6P3S/src/r6p3s/yandex/ymap.cljs
+++ radiolamp-6P3S/src/r6p3s/yandex/ymap.cljs
@@ -45,8 +45,8 @@
                    :or   {type "Point"}}]
   (new js/ymaps.GeoObject
        ;;feature
-       (clj->js { "geometry"   (clj->js {:coordinates coordinates
-                                         :type          type})
+       (clj->js {"geometry"   (clj->js {:coordinates coordinates
+                                        :type        type})
                  "properties" (clj->js {:balloonContentHeader balloon-content-header
                                         :balloonContentBody   balloon-content-body
                                         :iconContent          icon-content
@@ -65,9 +65,13 @@
                               chan-update
                               click-fn click-coords-fn
                               width
-                              height]
+                              height
+                              center
+                              zoom]
                        :or   {width "100%"
-                              height  "600px"}}]
+                              height  "600px"
+                              center [59.95  30.316666666666666]
+                              zoom 8}}]
   (reify
     om/IInitState
     (init-state [_]
@@ -83,8 +87,8 @@
          js/ymaps
          (fn []
            (let [map-object (new js/ymaps.Map id
-                                 (clj->js {"center" (clj->js [59.95  30.316666666666666])
-                                           "zoom"   8
+                                 (clj->js {"center" (clj->js center)
+                                           "zoom"   zoom
                                            }))]


Add tests

Add tests

--- test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
+++ test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
@@ -180,6 +180,19 @@
                  (values {"asd" "bsd"}))))

+  (is (= "INSERT INTO foo(a,b,\"C\",d) VALUES (123,'127.0.0.1','foo''bar',{'x':3,'y':2}) USING TIMESTAMP 42 AND TTL 24;"
+         (insert :foo
+                 (value "a" 123)
+                 (value "b" (java.net.InetAddress/getByName "127.0.0.1"))
+                 (value (quote* "C") "foo'bar")
+                 (value "d" (doto (java.util.TreeMap.)
+                              (.put "x" 3)
+                              (.put "y" 2)))
+                 (using (array-map :timestamp 42
+                                   :ttl       24))
+
+                 )
+         ))
   )


BugFix: fix expected pandoc markdown output

Environment:

OS: Debian GNU/Linux (amd64)
package: pandoc
version: 2.2.1-3+b2

% pandoc -v
pandoc 2.2.1
Compiled with pandoc-types 1.17.5.1, texmath 0.11.1, skylighting 0.7.5
[...]

--- test/io/perun_test.clj
+++ test/io/perun_test.clj
@@ -218,7 +218,7 @@

 (def parsed-md-basic "
Hello there
\n
This --- be markdown.
\n")

-(def parsed-pandoc-basic "
Hello there
\n
This --- be markdown.
\n")
+(def parsed-pandoc-basic "
Hello there
\n
This — be markdown.
\n")

 (def parsed-asciidoctor-md "
\n
This --- be markdown.
\n
")


rollbar's down, stop them from breaking our deploys

--- src/pc/assets.clj
+++ src/pc/assets.clj
@@ -222,8 +222,9 @@
       (validate-manifest! (fetch-specific-manifest cdn-bucket manifest-key))
       (log/infof "moving manifest pointer to %s" manifest-key)
       (move-manifest-pointer cdn-bucket manifest-key)
-      (log/infof "uploading sourcemap to rollbar")
-      (upload-sourcemap sha1 manifest))))
+      (log/infof "skipping uploading sourcemap to rollbar, cause they're down")
+      ;(upload-sourcemap sha1 manifest)
+      )))

 ;; single agent to prevent dos
 (defonce reload-agent (agent nil :error-handler (fn [a e]


Call dissoc with apply to delete keys in the rest arguments

--- src/clj/backtype/storm/daemon/worker.clj
+++ src/clj/backtype/storm/daemon/worker.clj
@@ -252,7 +252,7 @@
                 (.close (get @(:cached-node+port->socket worker) endpoint)))
               (apply swap!
                      (:cached-node+port->socket worker)
-                     #(HashMap. (dissoc (into {} %1) %&))
+                     #(HashMap. (apply dissoc (into {} %1) %&))
                      remove-connections)

               (let [missing-tasks (->> needed-tasks


use ZMQ/NOBLOCK when sending messages. this fixes #420

--- src/clj/backtype/storm/messaging/zmq.clj
+++ src/clj/backtype/storm/messaging/zmq.clj
@@ -26,6 +26,8 @@
 (defprotocol ZMQContextQuery
   (zmq-context [this]))

+(def NOBLOCK-SNDMORE (bit-or ZMQ/SNDMORE ZMQ/NOBLOCK))
+
 (deftype ZMQConnection [socket ^ByteBuffer bb]
   Connection
   (recv-with-flags [this flags]
@@ -37,8 +39,8 @@
   (send [this task message]
     (.clear bb)
     (.putShort bb (short task))
-    (mq/send socket (.array bb) ZMQ/SNDMORE)
-    (mq/send socket message)) ;; TODO: temporarily remove the noblock flag
+    (mq/send socket (.array bb) NOBLOCK-SNDMORE)
+    (mq/send socket message ZMQ/NOBLOCK)) ;; TODO: how to do backpressure if doing noblock?... need to only unblock if the target disappears
   (close [this]
     (.close socket)
     ))


more consolidation of static functions.

more consolidation of static functions.

--- src/clj/forma/hadoop/jobs/preprocess.clj
+++ src/clj/forma/hadoop/jobs/preprocess.clj
@@ -76,6 +76,7 @@
           (sparse-windower src
                            ["?sample" "?line"] "?val" width height
                            -9999)))))
+
 (defn modis-main
   "Example usage:

@@ -92,10 +93,6 @@
   "TODO: Example usage."
   [path output-path & tiles]
   (rain-chunker "1000"
-<<<<<<< HEAD
-=======
-                0.5
->>>>>>> Moved lots of stuff from static to preprocess.
                 static/chunk-size
                 (map read-string tiles)
                 (s3-path path)


Fix column alignment in name->fn.

Fix column alignment in name->fn.

--- src/clj/org/openforis/ceo/remote_api.clj
+++ src/clj/org/openforis/ceo/remote_api.clj
@@ -26,47 +26,47 @@
                "/send-to-mailing-list"           users/submit-email-for-mailing-list ; TODO conform route and fn
                "/unsubscribe-mailing-list"       users/unsubscribe-from-mailing-list ; TODO conform route and fn
                ;; Projects API
-               "/dump-project-aggregate-data" projects/dump-project-aggregate-data
-               "/dump-project-raw-data"       projects/dump-project-raw-data
-               "/get-all-projects"            projects/get-all-projects
-               "/get-project-by-id"           projects/get-project-by-id
-               "/get-project-stats"           projects/get-project-stats
-               "/archive-project"             projects/archive-project
-               "/close-project"               projects/close-project
-               "/create-project"              projects/create-project
-               "/publish-project"             projects/publish-project
-               "/update-project"              projects/update-project
+               "/dump-project-aggregate-data"    projects/dump-project-aggregate-data
+               "/dump-project-raw-data"          projects/dump-project-raw-data
+               "/get-all-projects"               projects/get-all-projects
+               "/get-project-by-id"              projects/get-project-by-id
+               "/get-project-stats"              projects/get-project-stats
+               "/archive-project"                projects/archive-project
+               "/close-project"                  projects/close-project
+               "/create-project"                 projects/create-project
+               "/publish-project"                projects/publish-project
+               "/update-project"                 projects/update-project
                ;; Plots API
-               "/get-next-plot"      plots/get-next-plot
-               "/get-plot-by-id"     plots/get-plot-by-id
-               "/get-prev-plot"      plots/get-prev-plot
-               "/get-project-plots"  plots/get-project-plots
-               "/get-proj-plot"      plots/get-project-plot
-               "/add-user-samples"   plots/add-user-samples
-               "/flag-plot"          plots/flag-plot
-               "/release-plot-locks" plots/release-plot-locks
-               "/reset-plot-lock"    plots/reset-plot-lock
+               "/get-next-plot"                  plots/get-next-plot
+               "/get-plot-by-id"                 plots/get-plot-by-id
+               "/get-prev-plot"                  plots/get-prev-plot
+               "/get-project-plots"              plots/get-project-plots
+               "/get-proj-plot"                  plots/get-project-plot
+               "/add-user-samples"               plots/add-user-samples
+               "/flag-plot"                      plots/flag-plot
+               "/release-plot-locks"             plots/release-plot-locks
+               "/reset-plot-lock"                plots/reset-plot-lock
                ;; Institutions API
-               "/get-all-institutions"    institutions/get-all-institutions
-               "/get-institution-details" institutions/get-institution-details
-               "/archive-institution"     institutions/archive-institution
-               "/create-institution"      institutions/create-institution
-               "/update-institution"      institutions/update-institution
+               "/get-all-institutions"           institutions/get-all-institutions
+               "/get-institution-details"        institutions/get-institution-details
+               "/archive-institution"            institutions/archive-institution
+               "/create-institution"             institutions/create-institution
+               "/update-institution"             institutions/update-institution
                ;; Imagery API
-               "/get-institution-imagery"     imagery/get-institution-imagery
-               "/get-project-imagery"         imagery/get-project-imagery
-               "/get-public-imagery"          imagery/get-public-imagery
-               "/add-geodash-imagery"         imagery/add-geodash-imagery
-               "/add-institution-imagery"     imagery/add-institution-imagery
-               "/update-institution-imagery"  imagery/update-institution-imagery
-               "/archive-institution-imagery" imagery/archive-institution-imagery
+               "/get-institution-imagery"        imagery/get-institution-imagery
+               "/get-project-imagery"            imagery/get-project-imagery
+               "/get-public-imagery"             imagery/get-public-imagery
+               "/add-geodash-imagery"            imagery/add-geodash-imagery
+               "/add-institution-imagery"        imagery/add-institution-imagery
+               "/update-institution-imagery"     imagery/update-institution-imagery
+               "/archive-institution-imagery"    imagery/archive-institution-imagery
                ;; GeoDash API
                ;; TODO flatten routes, conform names and functions
-               "/geo-dash/get-by-projid"   geodash/geodash-id
-               "/geo-dash/create-widget"   geodash/create-dashboard-widget-by-id
-               "/geo-dash/delete-widget"   geodash/delete-dashboard-widget-by-id
-               "/geo-dash/gateway-request" geodash/gateway-request
-               "/geo-dash/update-widget"   geodash/update-dashboard-widget-by-id})
+               "/geo-dash/get-by-projid"         geodash/geodash-id
+               "/geo-dash/create-widget"         geodash/create-dashboard-widget-by-id
+               "/geo-dash/delete-widget"         geodash/delete-dashboard-widget-by-id
+               "/geo-dash/gateway-request"       geodash/gateway-request
+               "/geo-dash/update-widget"         geodash/update-dashboard-widget-by-id})

 (defn fn->sym [f]
   (-> (str f)


fix time/delay regression

fix time/delay regression

--- src/cljx/jamesmacaulay/zelkova/time.cljx
+++ src/cljx/jamesmacaulay/zelkova/time.cljx
@@ -82,7 +82,7 @@
 (defn delay
   "Delay a signal by `ms` milliseconds."
   [ms sig]
-  (z/splice (fn [to from]
+  (z/splice (fn [from to]
               (let [waiting (async/chan (+ 1000 ms))
                     fire! #(async/take! waiting (partial async/put! to))]
                 (go-loop []


Allow collection of rates for uniform-addition-rate.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -341,9 +341,14 @@
   "Returns the individual with each element of its genome possibly preceded or followed by
   a new gene, with probability given by uniform-addition-rate."
   [ind {:keys [uniform-addition-rate maintain-ancestors atom-generators] :as argmap}]
-  (let [new-genome (vec (apply concat
-                               (map #(if (< (lrand) uniform-addition-rate)
-                                      (lshuffle [% (random-plush-instruction-map atom-generators argmap)])
+  (let [rate (if (number? uniform-addition-rate)
+               uniform-addition-rate
+               (lrand-nth uniform-addition-rate))
+        new-genome (vec (apply concat
+                               (map #(if (< (lrand) rate)
+                                      (lshuffle [%
+                                                 (random-plush-instruction-map
+                                                   atom-generators argmap)])
                                       [%])
                                     (:genome ind))))]
     (make-individual :genome new-genome
@@ -765,3 +770,4 @@

+


Added :fidelity age-combining-function to hijack AMPS for FLiPS.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -44,7 +44,9 @@
                                  (- (inc (:age p2))
                                     (inc (:age p1)))))))))
     :first (fn [p1 p2 g]
-             (inc (:age p1)))))
+             (inc (:age p1)))
+    :fidelity (fn [p1 p2 g]
+                (sequence-similarity g (:genome p1)))))

 ;; test effects of :proportionate with expressions like this:
 ;(float ((age-combining-function {:age-combining-function :proportionate})
@@ -966,3 +968,4 @@

+


Reproductive incompetence is not an option for autoconstruction.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -258,7 +258,7 @@
 (defn autoconstruction
   "Returns a genome for child produced by autoconstruction by executing parent1 with parent1,
 and parent2 on top of the genome stack. EXPERIMENTAL AND SUBJECT TO CHANGE."
-  [parent1 parent2 {:keys [maintain-ancestors atom-generators max-points-in-initial-program]
+  [parent1 parent2 {:keys [maintain-ancestors atom-generators max-points-in-initial-program error-function]
                     :as argmap}]
   (let [parent1-genome (:genome parent1)
         parent2-genome (:genome parent2)
@@ -266,13 +266,24 @@
                           (produce-child-genome-by-autoconstruction parent1-genome parent2-genome))
         child1-genome (child-genome-fn)
         other-child-genomes (repeatedly 2 child-genome-fn)
-        reproductively-incompetent (some #{child1-genome}
-                                         (concat [parent1-genome parent2-genome]
-                                                 other-child-genomes))
+        clone (some #{child1-genome}
+                    (concat [parent1-genome parent2-genome]
+                            other-child-genomes))
+        child1-errors (if clone nil (error-function (translate-plush-genome-to-push-program {:genome child1-genome})))
+        reproductively-incompetent (or clone
+                                       (= child1-errors
+                                          (error-function
+                                            (translate-plush-genome-to-push-program
+                                              {:genome (produce-child-genome-by-autoconstruction
+                                                         child1-genome
+                                                         (random-plush-genome
+                                                           max-points-in-initial-program atom-generators argmap))}))))
         new-genome (if reproductively-incompetent
                      (random-plush-genome max-points-in-initial-program atom-generators argmap)
                      child1-genome)]
     (assoc (make-individual :genome new-genome
+                            ;:errors (if reproductively-incompetent nil child1-errors)
+                            ;:total-errors (if reproductively-incompetent (reduce + child1-errors)
                             :history (:history parent1)
                             :ancestors (if maintain-ancestors
                                          (cons (:genome parent1) (:ancestors parent1))


update checkpointing settings (#1568)

update checkpointing settings (#1568)

--- scheduler/src/cook/kubernetes/api.clj
+++ scheduler/src/cook/kubernetes/api.clj
@@ -587,7 +587,7 @@
   "Get custom volume mounts needed for checkpointing"
   [{:keys [mode volume-mounts]} checkpointing-tools-volume]
   (when mode
-    (map (fn [{:keys [path sub-path]}] (make-volume-mount checkpointing-tools-volume path sub-path true)) volume-mounts)))
+    (map (fn [{:keys [path sub-path]}] (make-volume-mount checkpointing-tools-volume path sub-path false)) volume-mounts)))

 (defn checkpoint->env
   "Get environment variables needed for checkpointing"
@@ -611,10 +611,12 @@

 (def default-checkpoint-failure-reasons
   "Default set of failure reasons that should be counted against checkpointing attempts"
-  #{:mesos-unknown
+  #{:max-runtime-exceeded
     :mesos-command-executor-failed
+    :mesos-container-launch-failed
     :mesos-container-limitation-memory
-    :mesos-container-launch-failed})
+    :mesos-unknown
+    :straggler})

 (defn calculate-effective-checkpointing-config
   "Given the job's checkpointing config, calculate the effective config. Making any adjustments such as defaults,


CMR-3931: Fixed another typo.

CMR-3931: Fixed another typo.

--- umm-spec-lib/src/cmr/umm_spec/umm_spec_core.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_spec_core.clj
@@ -24,7 +24,7 @@
    ;; Added this to force the loading of the class, so that in CI build, it won't complain about
    ;; "No implementation of method: :validate of protocol: #'cmr.spatial.validation/SpatialValidation
    ;; found for class: cmr.spatial.cartesian_ring.CartesianRing."
-   [cmr.spatial-ring-validations])
+   [cmr.spatial.ring-validations])
   (:import
    (cmr.umm_spec.models.umm_collection_models UMM-C)
    (cmr.umm_spec.models.umm_service_models UMM-S)


Updated front page text a little bit to make the cash prizes sound a bit less like a joke.

--- src/sdos_site/core.clj
+++ src/sdos_site/core.clj
@@ -68,7 +68,8 @@

 ### Did I hear that there might be cash prizes???

-Yes. There might be... stay tuned for a final answer.")}])
+As a matter of fact, we are currently discussing the possibility of offering
+cash prizes for winners. Stay tuned!")}])

 (defn home-page


Update filters.clj

Update filters.clj

--- src/selmer/filters.clj
+++ src/selmer/filters.clj
@@ -215,9 +215,7 @@
             ;;; Default if x is falsey
             :default
             (fn [x default]
-              (if x
-                x
-                default))
+              (or x default))

             ;;; Default if coll is empty
             :default-if-empty


Fix the way CLJS errors are thrown when a screen cannot be resolved

--- src/main/workflo/macros/screen.cljs
+++ src/main/workflo/macros/screen.cljs
@@ -40,7 +40,7 @@
   (let [screen-sym (get @+registry+ screen-name)]
     (when (nil? screen-sym)
       (let [err-msg (str "Failed to resolve screen '" screen-name "'")]
-        (throw (js/Exception. err-msg))))
+        (throw (js/Error. err-msg))))
     screen-sym))

 (defn resolve-screen


Replace svg rgba, opcity

Replace svg rgba, opcity

--- src/export_server/utils/rasterizator.clj
+++ src/export_server/utils/rasterizator.clj
@@ -19,12 +19,23 @@
 (defn- remove-empty-img [svg]
   (clojure.string/replace svg #"<image[^>]*xlink:href=\"data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7\"[^\<]*" ""))

-;; remove paths with 0.00001 opacity - cause of some other labels invisibility
+;; remove paths with 0.00001 (1e-005 for IE) opacity - cause of some other labels invisibility
 (defn- remove-opacity [svg]
-  (clojure.string/replace svg #"<path[^>]*fill-opacity=\"0\.0+1\"[^<]*" ""))
+  (-> svg
+      (clojure.string/replace #"<path[^>]*fill-opacity=\"0\.0+1\"[^<]*" "")
+      (clojure.string/replace #"<path[^>]*fill-opacity=\"1e-005\"[^<]*" "")))
+
+;; fill="rgba(0,232,121,0.05)" --> fill="rgba(0,232,121)" fill-opacity="0.05"
+;; stroke="rgba(0,232,121,0.05)" --> stroke="rgba(0,232,121)" stroke-opacity="0.05"
+(defn replace-rgba [svg]
+  (-> svg
+      (clojure.string/replace #"fill=\"rgba\(([^,\)]*),([^,\)]*),([^,\)]*),([^,\)]*)\)\""
+                              "fill=\"rgb($1,$2,$3)\" fill-opacity=\"$4\"")
+      (clojure.string/replace #"stroke=\"rgba\(([^,\)]*),([^,\)]*),([^,\)]*),([^,\)]*)\)\""
+                              "stroke=\"rgb($1,$2,$3)\" stroke-opacity=\"$4\"")))

 (defn- clear-svg [svg]
-  (-> svg remove-empty-img remove-opacity))
+  (-> svg remove-empty-img remove-opacity replace-rgba))

 (defn- trim-svg-string [str]
   (let [left-trim-str (clojure.string/replace str #"^\"" "")
@@ -53,7 +64,7 @@
 (defn svg-to-jpg [svg widht height force-transparent-white quality]
   (try
     (with-open [out (new ByteArrayOutputStream)]
-      (let [svg (remove-empty-img (remove-cursor svg))
+      (let [svg (-> svg remove-cursor remove-empty-img replace-rgba)
             string-reader (new StringReader svg)
             transcoder-input (new TranscoderInput string-reader)
             transcoder-output (new TranscoderOutput out)
@@ -72,7 +83,7 @@
 (defn svg-to-png [svg widht height force-transparent-white]
   (try
     (with-open [out (new ByteArrayOutputStream)]
-      (let [svg (remove-empty-img (remove-cursor svg))
+      (let [svg (-> svg remove-cursor remove-empty-img replace-rgba)
             string-reader (new StringReader svg)
             transcoder-input (new TranscoderInput string-reader)
             transcoder-output (new TranscoderOutput out)


fixing topo sort

fixing topo sort

--- sidecar/src/figwheel_sidecar/core.clj
+++ sidecar/src/figwheel_sidecar/core.clj
@@ -287,7 +287,8 @@
   (cond
     (= nm nm2) 0
     (get (*transitive-dep-fn* nm) nm2) -1
-    :else 1))
+    (get (*transitive-dep-fn* nm2) nm) 1
+    :else 0))

 (defn topo-sort [ns-syms]
   (vec (sort topo-compare ns-syms)))


fixing choice loop to handle ctrl-D

fixing choice loop to handle ctrl-D

--- sidecar/src/figwheel_sidecar/repl.clj
+++ sidecar/src/figwheel_sidecar/repl.clj
@@ -121,7 +121,7 @@
         (recur)))))

 (defn add-repl-print-callback! [{:keys [browser-callbacks]}]
-  (let [pr-fn (resolve-repl-println)]
+  (let [pr-fn (resolve-repl-println)]
     (swap! browser-callbacks assoc "figwheel-repl-print"
            (fn [args] (apply pr-fn args)))))

@@ -362,8 +362,10 @@
       (print (str "Choose focus build for CLJS REPL (" (clojure.string/join ", " choices) ") > "))
       (flush)
       (let [res (read-line)]
-        (if (choices res)
-          res
+        (cond
+          (nil? res) false
+          (choices res) res
+          :else
           (do
             (println (str "Error: " res " is not a valid choice"))
             (recur)))))))
@@ -413,9 +415,11 @@
      (loop [build start-build]
        (cljs-repl (:id build))
        (let [chosen-build-id (get-build-choice
-                              (keep :id (filter config/optimizations-none? all-builds)))
-             chosen-build (first (filter #(= (name (:id %)) chosen-build-id) all-builds))]
-         (recur chosen-build))))))
+                              (keep :id (filter config/optimizations-none? all-builds)))]
+         (if (false? chosen-build-id)
+           false ;; quit
+           (let [chosen-build (first (filter #(= (name (:id %)) chosen-build-id) all-builds))]
+             (recur chosen-build))))))))

 (defn start-nrepl-server [figwheel-options autobuild-options]
   (when (:nrepl-port figwheel-options)


internal option passed down to ELB

internal option passed down to ELB

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -155,14 +155,16 @@
 (defn elb [name cluster-resource spec]
   (let [defaults {:cert_name false
                   :instances []
-                  :lb_protocol "http"}
+                  :lb_protocol "http"
+                  :internal false}
         spec (merge-in defaults spec)
         {:keys [health_check
                 lb_protocol
                 instances
                 cert_name
                 subnets
-                sgs]} spec
+                sgs
+                internal]} spec
         secure_protocol (if (= lb_protocol "http")
                           "https"
                           "ssl")
@@ -191,6 +193,7 @@
                                       :idle_timeout 60
                                       :connection_draining true
                                       :connection_draining_timeout 60
+                                      :internal internal
                                       :tags {:Name name}})))

 (defn asg [name


Add some logging when processing reservation.

--- src/vacation2/main.clj
+++ src/vacation2/main.clj
@@ -161,18 +161,23 @@
   "Process a reservation: find a car, flight, and room for the reservation and
   update the data structures."
   (dosync
+    (log "start tx for reservation" (:id @reservation))
     (let [n-people     (:n-people @reservation)
           found-car    (look-for-seats (random-subset n-queries cars) n-people)
           found-flight (look-for-seats (random-subset n-queries flights) n-people)
           found-room   (look-for-seats (random-subset n-queries rooms) n-people)
           pnr          (generate-pnr reservation)]
+      (log "reserving:"
+        (if found-car    (str "car "    (:id @found-car))    "no car")    "-"
+        (if found-flight (str "flight " (:id @found-flight)) "no flight") "-"
+        (if found-room   (str "room "   (:id @found-room))   "no room"))
       (when found-car    (reserve-relation reservation found-car n-people))
       (when found-flight (reserve-relation reservation found-flight n-people))
       (when found-room   (reserve-relation reservation found-room n-people))
       (alter reservation assoc
         :status :in-process
-        :pnr    pnr))))
-; TODO: add some logging
+        :pnr    pnr)))
+  (log "finished reservation" (:id @reservation)))

 ; BEHAVIORS


Support localization for the list of country/languages options.

* handler.clj (wlmmap.handler): Import java.io File.
(db-options): Use destructuring.
(set-db-options-from-lang): New `defremote` to set `db-options`
depending on the language as returned by the browser.  This uses
a filtered copy of CLDR internally.

--- src/wlmmap/handler.clj
+++ src/wlmmap/handler.clj
@@ -1,4 +1,5 @@
 (ns wlmmap.handler
+  (import '(java.io File))
   (:require [clojure.data.json :as json]
             [clojure.string :as str]
             [cemerick.friend :as friend]
@@ -125,7 +126,33 @@
   "http://toolserver.org/~erfgoed/api/api.php?action=search&format=json&limit=5000&props=lat|lon|name|registrant_url|id|image|lang|monument_article")

 (def db-options
-  (sort (map #(str (first (val %)) "/" (last (val %))) lang-pairs)))
+  (sort (map #(let [[_ [cntry lng]] %] (str cntry " / " lng)) lang-pairs)))
+
+(defremote set-db-options-from-lang [lang]
+  (let [languages-json
+        (json/read-str (slurp (str "/cldr/" lang "/languages.json"))
+                       :key-fn keyword)
+        languages
+        (get-in languages-json
+                [:main (keyword lang) :localeDisplayNames :languages])
+        territories-json
+        (json/read-str (slurp (str "/cldr/" lang "/territories.json"))
+                       :key-fn keyword)
+        countries
+        (get-in territories-json
+                [:main (keyword lang) :localeDisplayNames :territories])]
+    ;; Check if localization is available for the language
+    (when (.exists (str "/cldr/" lang))
+      (set! db-options
+            (sort (map #(let [[_ [cntry lng]] %
+                              cplx (re-seq #"([^-]+)-(.+)" cntry)]
+                          (if cplx
+                            (let [[_ bare suffix] (first cplx)]
+                              (str ((keyword (clojure.string/upper-case bare)) countries)
+                                   " (" suffix ") / " ((keyword lng) languages)))
+                            (str ((keyword (clojure.string/upper-case cntry)) countries)
+                                 " / " ((keyword lng) languages))))
+                       lang-pairs))))))

 (defremote get-lang-list [lang]
   (remove nil?


Filter dashboard refresh on mine/all builds

--- src-cljs/frontend/controllers/ws.cljs
+++ src-cljs/frontend/controllers/ws.cljs
@@ -181,6 +181,7 @@
       :build (when (get-in current-state state/show-usage-queue-path)
                (api/get-usage-queue (get-in current-state state/build-path) api-ch))
       :dashboard (api/get-dashboard-builds (assoc (:navigation-data current-state)
-                                             :builds-per-page (:builds-per-page current-state))
+                                             :builds-per-page (:builds-per-page current-state)
+                                             :all? (get-in current-state state/show-all-builds-path))
                                            api-ch)
       nil)))


renamed -> resolve-aliases

renamed -> resolve-aliases

--- src-cljs/jasons-game/ui/pjs/main.cljs
+++ src-cljs/jasons-game/ui/pjs/main.cljs
@@ -52,14 +52,14 @@
                                                                      [:source {:src (str "data:audio/ogg;base64," response), :type "audio/ogg"}]]))
                                          :error-handler alert-handler}))

-(defn bind-to-env [sentence env]
+(defn resolve-aliases [sentence env]
   (reduce
     (fn [s [key val]] (clojure.string/replace s (str ":" (name key)) (:name val)))
     sentence
     env))

 (defn say-something [env sts]
-  (let [words (bind-to-env (:sentence sts) env)
+  (let [words (resolve-aliases (:sentence sts) env)
         audio (:audio sts)]
     ; add word balloon to the world
     (w/add-thing world {:type :word-balloon


speed up tool slide speed, and revise typescript & cljs captions

--- src/solar_system_of_js/actions.cljs
+++ src/solar_system_of_js/actions.cljs
@@ -228,7 +228,7 @@
     [:cam :x]                  {:a :_ :b 200 :duration 1}
     [:cam :zoom]               {:a :_ :b 1.3 :duration 1}
     [:transpiler :x]           {:a :_ :b 450 :duration 0.2}
-    [:transpiler :alpha]       {:a :_ :b 1 :duration 1}
+    [:transpiler :alpha]       {:a :_ :b 1 :duration 0.2}
     [:transpiler :font-alpha]  {:a :_ :b 1 :duration 0.1}

     :highlight-layer
@@ -246,7 +246,7 @@

     [:transpiler :highlight] false
     [:linter :highlight] true
-    [:linter :alpha]      {:a :_ :b 1 :duration 1}
+    [:linter :alpha]      {:a :_ :b 1 :duration 0.2}
     [:linter :font-alpha] {:a :_ :b 1 :duration 0.1}
     [:linter :x]          {:a :_ :b 450 :duration 0.2}}

@@ -261,7 +261,7 @@
     [:linter :highlight] false
     [:modulesys :highlight] true

-    [:modulesys :alpha]      {:a :_ :b 1 :duration 1}
+    [:modulesys :alpha]      {:a :_ :b 1 :duration 0.2}
     [:modulesys :font-alpha] {:a :_ :b 1 :duration 0.1}
     [:modulesys :x]          {:a :_ :b 450 :duration 0.2}}

@@ -299,7 +299,7 @@
    ;; show typescript
    {:caption
     (str "Microsoft's [TypeScript](http://www.typescriptlang.org/)"
-         " extends ES6 with optional type annotation syntax and interfaces.")
+         " extends ES6 with optional type annotation syntax and interfaces, and extra editor support.")
     [:cam :x]                    {:a :_ :b 300 :duration 1}
     [:static :typescript :alpha] {:a :_ :b 1 :duration 1}
     [:static :sphere :angle]     {:a :_ :b static-angle :duration 1}}
@@ -361,7 +361,7 @@

    ;; show clojurescript
    {:caption
-    "[ClojureScript](http://clojurescript.org) eschews traditional OO in favor of immutability, plain data, and a more expressive syntax."
+    "[ClojureScript](http://clojurescript.org) eschews imperative/OO in favor of immutability, plain data, and a more expressive syntax."
     [:dart :highlight] false
     [:clojurescript :highlight] true
     [:clojurescript :angle] (- (/ PI 10))


clarify dox

clarify dox

--- src/metabase/driver/generic_sql/sync.clj
+++ src/metabase/driver/generic_sql/sync.clj
@@ -84,7 +84,7 @@
     (table-pk-names @test-db \"VENUES\") -> [\"ID\"]"
   [database table-name]
   (with-jdbc-metadata [^java.sql.DatabaseMetaData md database]
-    (->> (jdbc/result-set-seq (.getPrimaryKeys md nil nil table-name)) ; ResultSet getPrimaryKeys
+    (->> (jdbc/result-set-seq (.getPrimaryKeys md nil nil table-name)) ; ResultSet getPrimaryKeys(String catalog, String schema, String table)
          (map :column_name)
          doall
          set)))
@@ -113,7 +113,7 @@
 ;; ## SET TABLE PK

 (defn- set-table-pks-if-needed!
-  "If TABLE does not already "
+  "Mark primary-key `Fields` for TABLE as `special_type = id` if they don't already have a `special_type`."
   {:arglists '([table])}
   [{table-name :name table-id :id :keys [db pk_field]}]
   (->> (sel :many :fields [Field :name :id] :table_id table-id :special_type nil :name [in (table-pk-names @db table-name)])


Removed dependency to m.p.u.zip.

Removed dependency to m.p.u.zip.

--- src/midje/parsing/util/file_position.clj
+++ src/midje/parsing/util/file_position.clj
@@ -1,8 +1,7 @@
 (ns midje.parsing.util.file-position
   "Functions to help in finding the lines you care about."
   (:require [clojure.string :as str]
-            [clojure.zip :as zip]
-            [midje.parsing.util.zip :refer [skip-to-rightmost-leaf]]))
+            [clojure.zip :as zip]))

 ;; COMPILE-TIME POSITIONS.
@@ -74,32 +73,44 @@
   [number]
   `[(current-file-name) ~number])

-(letfn [(replace-loc-line [loc loc-with-line]
-          (let [m (fn [loc] (meta (zip/node loc)))
-                transferred-meta (if (contains? (m loc-with-line) :line )
-                                   (assoc (m loc) :line (:line (m loc-with-line)))
-                                   (dissoc (m loc) :line ))]
-            (zip/replace loc (with-meta (zip/node loc) transferred-meta))))]

-  (defn form-with-copied-line-numbers [line-number-source form]
-    (loop [loc (zip/seq-zip form)
-           line-loc (zip/seq-zip line-number-source)]
-      (cond (zip/end? line-loc)
-            (zip/root loc)
+(defn- skip-to-rightmost-leaf
+  "When positioned at leftmost position of branch, move to the end form.
+   In a tree, that's the rightmost leaf."
+  [loc]
+  (let [end-form (zip/rightmost loc)]
+    (if (zip/branch? end-form)
+      (recur (zip/down end-form))
+      end-form)))

-            (zip/branch? line-loc)
-            (recur (zip/next (replace-loc-line loc line-loc))
-                   (zip/next line-loc))

-            ;; the form has a tree in place of a non-tree
-            (zip/branch? loc)
-              (recur (zip/next
-                      (skip-to-rightmost-leaf (zip/down (replace-loc-line loc line-loc))))
-                     (zip/next line-loc))
+(defn- replace-loc-line [loc loc-with-line]
+  (let [m (fn [loc] (meta (zip/node loc)))
+        transferred-meta (if (contains? (m loc-with-line) :line )
+                           (assoc (m loc) :line (:line (m loc-with-line)))
+                           (dissoc (m loc) :line ))]
+    (zip/replace loc (with-meta (zip/node loc) transferred-meta))))

-            :else
-            (recur (zip/next loc)
-                   (zip/next line-loc))))))
+
+(defn form-with-copied-line-numbers [line-number-source form]
+  (loop [loc (zip/seq-zip form)
+         line-loc (zip/seq-zip line-number-source)]
+    (cond (zip/end? line-loc)
+          (zip/root loc)
+
+          (zip/branch? line-loc)
+          (recur (zip/next (replace-loc-line loc line-loc))
+                 (zip/next line-loc))
+
+          ;; the form has a tree in place of a non-tree
+          (zip/branch? loc)
+          (recur (zip/next
+                  (skip-to-rightmost-leaf (zip/down (replace-loc-line loc line-loc))))
+                 (zip/next line-loc))
+
+          :else
+          (recur (zip/next loc)
+                 (zip/next line-loc)))))

 (defn positioned-form