show warnings as well as errors

show warnings as well as errors

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

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -52,8 +52,13 @@
                log-text)
     true false))

-(defn visual-studio-errors [bits]
-  (filter contains-errors? (map vs-log-text (vs-log-files bits))))
+(defn contains-warnings? [log-text]
+  (if (re-find #"\: warning" log-text)
+    true false))
+
+(defn visual-studio-errors-and-warnings [bits]
+  (let [texts (map vs-log-text (vs-log-files bits))]
+    (filter #(or (contains-warnings? %) (contains-errors? %)) texts)))

 (defn javac-errors [result-text]
   (map first
@@ -184,7 +189,7 @@
   (let [f (result-file bits mode)
         svn-confs (svn-conflicts)
         result-txt (slurp f)
-        vs-errors (visual-studio-errors bits)
+        vs-errors (visual-studio-errors-and-warnings bits)
         outdated-dlls (map #(.getName %) (old-dlls (bin-dir bits) 24))
         javac-errs (javac-errors result-txt)
         outdated-jars (map #(.getName %)
@@ -205,7 +210,7 @@
           " BUILD ERROR REPORT\n"
         "For the full build output, see " (.getAbsolutePath f)
         (report-segment "Subversion conflicts" svn-confs)
-        (report-segment "Visual Studio reported errors" vs-errors)
+        (report-segment "Visual Studio reported errors and warnings" vs-errors)
         (report-segment "Outdated device adapter DLLs" outdated-dlls)
         (report-segment "Errors reported by java compiler" javac-errs)
         (report-segment "Outdated jar files" outdated-jars)


Fixed typo.

Fixed typo.

--- system-int-test/src/cmr/system_int_test/utils/ingest_util.clj
+++ system-int-test/src/cmr/system_int_test/utils/ingest_util.clj
@@ -210,9 +210,9 @@

 (defn concept
   "Returns the concept map for ingest"
-  [concetp-type provider-id native-id format-key metadata]
+  [concept-type provider-id native-id format-key metadata]
   (let [mime-type (mt/format->mime-type format-key)]
-    {:concept-type concetp-type
+    {:concept-type concept-type
      :provider-id provider-id
      :native-id native-id
      :metadata metadata


deflakes test-instance-reservation (#321)


[#38] Remove blank lines

[#38] Remove blank lines

--- priv/clojure/core.clj
+++ priv/clojure/core.clj
@@ -4396,8 +4396,7 @@
      ([& keyvals]
       (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array keyvals)))))

-;;redefine let and loop  with destructuring
-
+;redefine let and loop  with destructuring
 (defn destructure [bindings]
   (let [bents (partition 2 bindings)
         pb (fn pb [bvec b v]
@@ -4495,9 +4494,7 @@
           (let ~lets
             ~@body))))))

-;;redefine fn with destructuring and pre/post conditions
-
-
+;redefine fn with destructuring and pre/post conditions
 (defmacro fn
   "params => positional-params* , or positional-params* & next-param
   positional-param => binding-form


Remove extra testing commands

Remove extra testing commands

--- src/atom_finder/core.clj
+++ src/atom_finder/core.clj
@@ -73,32 +73,9 @@
   [& args]

   (def root (tu (resource-path "if-starts-in-expression.c")))
-  (def root (tu (expand-home "~/opt/src/gcc/libgcc/memmove.c")))
-  (def root (tu (expand-home "~/opt/src/gcc/libgcc/unwind-dw2.c")))
-  (def root (tu (expand-home "~/opt/src/emscripten/system/include/EGL/egl.h")))

   (def github-top-c (map #(.getPath %) (.listFiles (io/file (expand-home "~/opt/src/github-top-c")))))

-  (pprint (map write (filter-type "IdExpression" root)))
-  (pprint (map write (filter-type "Name" root)))
-  (pprint (map write (filter-type "ExpressionStatement" root)))
-  (pprint (map write (filter-type "FieldReference" root)))
-  (pprint (map write (filter-type "SimpleDeclSpecifier" root)))
-  (pprint (map write (filter-type "Declarator" root)))
-  (pprint (map write (filter-type "SimpleDeclaration" root)))
-  (pprint (map write (filter-type "NamedTypeSpecifier" root)))
-  (pprint (map write (filter-type "ParameterDeclaration" root)))
-  (pprint (map write (filter-type "CompoundStatement" root)))
-  (pprint (map #(->> % .getFileLocation .getStartingLineNumber) (filter-type "Problem" root)))
-
-  (->> (mapcat #(do (prn %1) (->> %1 .getPath tu (filter-type "Problem")))
-               (c-files (expand-home "~/opt/src/emscripten/")))
-       (map #(.getContainingFilename %))
-       (take 10)
-       )
-
-  ; (time (count-nodes-in-dirs github-top-c))
-
   ;; the place where all test-files live
   (def resource-dir (.getParent (java.io.File. (resource-path "define-in-if-loop.c"))))


Dont create new output indexes if one already exists

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -46,6 +46,10 @@
                                (-add-facts (.keys other-index) (into-array other-fields) index fields))
                              (set! kind->name->fields->index (assoc-in kind->name->fields->index [kind name (vec fields)] index))
                              index)))
+  (ensure-index [this kind name default-fields]
+                (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
+                (when (empty? (get-in kind->name->fields->index [kind name]))
+                  (.get-or-create-index this kind name default-fields)))
   (add-facts [this kind name fields facts]
              (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
              (let [changed? false
@@ -275,15 +279,16 @@
             (let [kind (aget output-kinds i)
                   name (aget output-names i)
                   fields (aget output-fields i)
+                  filtered-fields (into-array (filter #(not (nil? %)) fields))
                   transient? (identical? kind "know")]
               ;; TODO get transient? from schema instead
               (assert (not= (not transient?) (get @name->transient? name)) name)
               (swap! name->transient? assoc name transient?)
               (swap! kind->name->rules update-in [kind name] #(or % #{}))
-              (.get-or-create-index kn "know" name (into-array (filter #(not (nil? %)) (aget output-fields i))))
+              (.ensure-index kn "know" name filtered-fields)
               (when (false? transient?)
-                (.get-or-create-index kn "forget" name (into-array (filter #(not (nil? %)) (aget output-fields i))))
-                (.get-or-create-index kn "remember" name (into-array (filter #(not (nil? %)) (aget output-fields i)))))))
+                (.ensure-index kn "forget" name filtered-fields)
+                (.ensure-index kn "remember" name filtered-fields))))

           (swap! rule->flow assoc rule-id (Flow. solver output-kinds output-names output-fields)))))


Remove debug statements.

Remove debug statements.

--- src/oc/storage/api/activity.clj
+++ src/oc/storage/api/activity.clj
@@ -360,9 +360,6 @@
                              board-slugs-and-names (map #(array-map :slug (:slug %) :access (:access %) :name (:name %)) boards)
                              board-by-uuids (zipmap board-uuids board-slugs-and-names)
                              items (assemble-replies conn params org board-by-uuids allowed-boards user-id)]
-                          (println "DBG replies api")
-                          (println "DBG    container-id" config/seen-replies-container-id)
-                          (println "DBG    user container seen" container-seen)
                           (activity-rep/render-activity-list params org "replies" items boards user))))

 ;; A resource to retrieve entries for a given user


jobs/genhtml.clj: use jobconf for system properties

--- src/org/altlaw/jobs/genhtml.clj
+++ src/org/altlaw/jobs/genhtml.clj
@@ -3,6 +3,11 @@
             [org.altlaw.www.case-pages :as cases]))

 (hadoop/setup-mapreduce)
+
+(defn mapper-configure [this jobconf]
+  (alter-var-root #'org.altlaw.util.context/get-property
+                  (fn [_] (fn [name] (or (.get jobconf name)
+                                         (throw (Exception. (str "Missing property " name))))))))

 (defn mapper-map [this wkey wvalue output reporter]
   (let [docid (.get wkey)


util/crawler.clj: handle download log of redirects correctly

--- src/org/altlaw/util/crawler.clj
+++ src/org/altlaw/util/crawler.clj
@@ -104,14 +104,17 @@
   (merge (basic-response-map response)
          (extended-response-map response)))

-(declare handle-download-request)
+(declare crawl)

 (defn- handle-redirect [result new-location]
-  (let [code (:response_status_code result)
-        new-request {:request_uri new-location}]
-    (log/info "Got HTTP redirect for " (pr-str result))
-    (log/info "Redirecting to " new-location)
-    (assoc (handle-download-request new-request) :redirect_from result)))
+  (log/info "Got HTTP redirect for " (pr-str result))
+  (log/info "Redirecting to " new-location)
+  (assoc (crawl new-location) :redirect_from result))
+
+(defn- log-downloaded [download]
+  (dl/log-download (:request_uri download))
+  (when-let [redirect (:redirect_from download)]
+    (recur redirect)))

 (defn- execute-request
   "Calls the client to handle the request, logs the URL in the
@@ -122,12 +125,15 @@
         result (merge (request-map request)
                       (response-map response))
         code (:response_status_code result)]
-    ;; Only log URL on success or NOT FOUND
-    (when (#{200 404} code)
-      (dl/log-download (:request_uri result)))
     (if (#{301 302 303 307} code)
       (handle-redirect result (str (.getLocationRef response)))
       result)))
+
+(defn- log-result [result]
+  (let [code (:response_status_code result)]
+    ;; Only log URL on success or NOT FOUND
+    (when (#{200 404} code) (log-downloaded result))
+    result))

 (defn crawl
   "Given a URL, downloads it and returns a download record as a
@@ -135,9 +141,9 @@
   parameters.  Logs the URL in the download log, but does not save the
   download log."
   ([url]
-     (execute-request (make-request url)))
+     (log-result (execute-request (make-request url))))
   ([url form-fields]
-     (execute-request (make-request url form-fields))))
+     (log-result (execute-request (make-request url form-fields)))))

 (defn handle-download-request
   "Given a partial download record as a keyword=>value map, runs


Fixes normalize-search-args

Fixes normalize-search-args

--- src/overtone/libs/freesound.clj
+++ src/overtone/libs/freesound.clj
@@ -90,9 +90,8 @@
                (rest args)
                args)]
     (-> (apply hash-map args)
-        (assoc :ks ks
-               :q (or q "")
-               :sounds_per_page 100))))
+        (assoc :ks ks :sounds_per_page 100)
+        (update-in [:q] #(or q %)))))

 (defn- freesound-search*
   [params]


Let simple val rules fall through to case default in nml-str

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -151,12 +151,8 @@
                  :r        (strfirst val)
                  :real     (delegate val)
                  :sect     ["(" (list2str val) ")"]
-                 :sep      val
-                 :sign     val
                  :stmt     ["&" (strfirst val) " " (list2str (rest val)) " /"]
-                 :string   val
                  :true     "t"
-                 :uint     val
                  :valopt   (cjoin (delegate val))
                  :value    (delegate val)
                  :values   (cjoin (delegate val))


indenting

indenting

--- src/celestial/config.clj
+++ src/celestial/config.clj
@@ -102,7 +102,8 @@
   [hypervisor]
   (let [hvs [proxmox-v aws-v vcenter-v docker-v] ks (map (comp first keys) hvs)
         envs (map (fn [v] (fn [env] {:hypervisor {env v}})) hvs)]
-    (first (map (fn [[e hs]] (map #(((zipmap ks envs) %) e) (filter (into #{} ks) (keys hs)))) hypervisor))))
+    (first
+      (map (fn [[e hs]] (map #(((zipmap ks envs) %) e) (filter (into #{} ks) (keys hs)))) hypervisor))))

 (defn celestial-validations [{:keys [log job] :as celestial}]


formatting

formatting

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -269,7 +269,9 @@
                               :user-groups (db/get-groups-for-user user-id)
                               :user-threads (db/get-open-threads-for-user user-id)
                               :user-subscribed-tag-ids (db/get-user-subscribed-tag-ids user-id)
-                              :users (into () (map #(assoc % :status (if (connected (% :id)) :online :offline)))
+                              :users (into ()
+                                           (map #(assoc % :status
+                                                   (if (connected (% :id)) :online :offline)))
                                            (db/fetch-users-for-user user-id))
                               :invitations (db/fetch-invitations-for-user user-id)
                               :tags (db/fetch-tags-for-user user-id)})]))))


Fix possible deadlock in await job completion.

--- src/onyx/api.clj
+++ src/onyx/api.clj
@@ -31,14 +31,14 @@
   (future
     (loop []
       (let [ch (chan 1)
-            task-path (extensions/resolve-node sync :task job-id)
-            task-nodes (extensions/bucket-at sync :task job-id)
-            task-nodes (filter #(not (impl/completed-task? %)) task-nodes)]
+            task-path (extensions/resolve-node sync :task job-id)]
         (extensions/on-child-change sync task-path (fn [_] (>!! ch true)))
-        (if (every? (partial impl/task-complete? sync) task-nodes)
-          true
-          (do (<!! ch)
-              (recur)))))))
+        (let [task-nodes (extensions/bucket-at sync :task job-id)
+              task-nodes (filter #(not (impl/completed-task? %)) task-nodes)]
+          (if (every? (partial impl/task-complete? sync) task-nodes)
+            true
+            (do (<!! ch)
+                (recur))))))))

 ;; A coordinator that runs strictly in memory. Peers communicate with
 ;; the coordinator by directly accessing its channels.


onyx.api/job-snapshot-coordinates rets nil on missing resume point.

--- src/onyx/api.clj
+++ src/onyx/api.clj
@@ -274,7 +274,8 @@
   [onyx-client tenancy-id job-id]
   (let [{:keys [log]} onyx-client]
     (info "Reading checkpoint coordinate at: " tenancy-id job-id)
-    (checkpoint/read-checkpoint-coordinate log tenancy-id job-id)))
+    (try (checkpoint/read-checkpoint-coordinate log tenancy-id job-id)
+         (catch org.apache.zookeeper.KeeperException$NoNodeException nne nil))))

 (defmethod job-snapshot-coordinates :default
   [peer-client-config tenancy-id job-id]


CLJS-77: support Closure defines

CLJS-77: support Closure defines

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -135,10 +135,18 @@
                 :simple CompilationLevel/SIMPLE_OPTIMIZATIONS)
         compiler-options (doto (CompilerOptions.)
                            (.setCodingConvention (ClosureCodingConvention.)))]
-    (when (contains? opts :closure-warnings)
-      (doseq [[type level] (:closure-warnings opts)]
-        (. compiler-options
-          (setWarningLevel (type warning-types) (level check-level)))))
+    (doseq [[key val] (:closure-defines opts)]
+      (let [key (name key)]
+        (cond
+          (string? val) (.setDefineToStringLiteral compiler-options key val)
+          (integer? val) (.setDefineToIntegerLiteral compiler-options key val)
+          (float? val) (.setDefineToDoubleLiteral compiler-options key val)
+          (or (true? val)
+              (false? val)) (.setDefineToBooleanLiteral compiler-options key val)
+          :else (println "value for" key "must be string, int, float, or bool"))))
+    (doseq [[type level] (:closure-warnings opts)]
+      (. compiler-options
+        (setWarningLevel (type warning-types) (level check-level))))
     (when (contains? opts :source-map)
       (set! (.sourceMapOutputPath compiler-options)
             (:source-map opts))


reformatting continued

reformatting continued

--- src/clj/libsearch/db.clj
+++ src/clj/libsearch/db.clj
@@ -133,16 +133,20 @@
   [['?repo :repo/created-at '?created] [(list f '?created val)]])

 (defn created> [val]
-  (created #(> (coerce/to-long %1) %2) (coerce/to-long val)))
+  (created #(> (coerce/to-long %1) %2)
+           (coerce/to-long val)))

 (defn created< [val]
-  (created #(< (coerce/to-long %1) %2) (coerce/to-long val)))
+  (created #(< (coerce/to-long %1) %2)
+           (coerce/to-long val)))

 (defn updated [f val]
-  [['?repo :repo/updated-at '?updated] [(list f '?updated val)]])
+  [['?repo :repo/updated-at '?updated]
+   [(list f '?updated val)]])

 (defn mapize-results [ks results]
-  (map #(apply assoc {} (interleave ks (take (count ks) %))) results))
+  (map #(apply assoc {} (interleave ks (take (count ks) %)))
+       results))

 (defn with-count-and-offset [count offset results]
   (->> results


local volumes in stack fix, showing volumes not present in volume api

--- src/clj/swarmpit/api.clj
+++ src/clj/swarmpit/api.clj
@@ -540,6 +540,17 @@
          (filter #(contains? ids (:id %)))
          (vec))))

+(defn volumes-by-services
+  [services]
+  (let [volumes (->> (volumes)
+                     (group-by :id))]
+    (->> services
+         (map :mounts)
+         (flatten)
+         (filter #(= "volume" (:type %)))
+         (map #(assoc % :volumeName (:host %)))
+         (map #(merge (first (get volumes (:id %))) %)))))
+
 (def services-memo (memo/ttl services :ttl/threshold 1000))

 (defn- services-by
@@ -777,7 +788,7 @@
        :stackFile (some? (stackfile stack-name))
        :services  services
        :networks  (resources-by-services services :networks networks)
-       :volumes   (resources-by-services services :mounts volumes)
+       :volumes   (volumes-by-services services)
        :configs   (resources-by-services services :configs configs)
        :secrets   (resources-by-services services :secrets secrets)})))


added support for exposable ports in API

#58

--- src/clj/swarmpit/api.clj
+++ src/clj/swarmpit/api.clj
@@ -218,6 +218,15 @@
     (->> (drc/tags token repository-name)
          :tags)))

+(defn dockerhub-ports
+  [repository-name repository-tag dockeruser-name]
+  (let [user (dockeruser-by-username dockeruser-name)
+        token (:token (dac/token user repository-name))]
+    (-> (drc/manifest token repository-name repository-tag)
+        (rmi/->repository-config)
+        :config
+        (dmi/->image-ports))))
+
 (defn public-repositories
   [repository-query repository-page]
   (-> (dhc/repositories repository-query repository-page)
@@ -280,11 +289,25 @@
       (rc/tags repository-name)
       :tags))

+(defn registryy-ports
+  [registry-name repository-name repository-tag]
+  (-> (registry-by-name registry-name)
+      (rc/manifest repository-name repository-tag)
+      (rmi/->repository-config)
+      :config
+      (dmi/->image-ports)))
+
 ;;; Image API

 (defn image
-  [image]
-  (dc/image image))
+  [img]
+  (dc/image img))
+
+(defn image-ports
+  [img]
+  (-> (image img)
+      :Config
+      (dmi/->image-ports)))

 ;;; Service API


Remove useless reading

Remove useless reading

--- src/cljam/bam/reader.clj
+++ src/cljam/bam/reader.clj
@@ -207,15 +207,8 @@
             _           (lsb/skip buffer 3)
             n-cigar-op  (lsb/read-ushort buffer)
             flag        (lsb/read-ushort buffer)
-            l-seq       (lsb/read-int buffer)
-            _           (lsb/skip buffer (+ 12 l-read-name))
+            _           (lsb/skip buffer (+ 16 l-read-name))
             cigar       (decode-cigar (lsb/read-bytes buffer (* n-cigar-op 4)))
-            _           (lsb/skip buffer (+ (/ (inc l-seq) 2)
-                                            l-seq
-                                            (options-size block-size
-                                                          l-read-name
-                                                          n-cigar-op
-                                                          l-seq)))
             pointer-end (.getFilePointer ^BGZFInputStream (.reader bam-reader))]
         {:flag flag, :rname rname, :pos pos,:cigar cigar,
          :meta {:chunk {:beg pointer-beg, :end pointer-end}}}))))


Adding a proper fork of this file, as it's easier to diff and track the entire thing.

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -6,17 +6,70 @@
 ;   the terms of this license.
 ;   You must not remove this notice, or any other, from this software.

-;; Go emitter. Forked from f0dcc75573a42758f8c39b57d1747a2b4967327e
-;; References to js in the public API are retained.
-
-(require 'cljs.compiler)
-(in-ns 'cljs.compiler)
+-;; Go emitter. Forked from f0dcc75573a42758f8c39b57d1747a2b4967327e
+-;; References to js in the public API are retained.
+
+(ns cljs.compiler
+  (:refer-clojure :exclude [munge macroexpand-1])
+  (:require [clojure.java.io :as io]
+            [clojure.string :as string]
+            [clojure.tools.reader :as reader]
+            [cljs.env :as env]
+            [cljs.tagged-literals :as tags]
+            [cljs.analyzer :as ana]
+            [cljs.source-map :as sm])
+  (:import java.lang.StringBuilder
+           java.io.File))
+
+(set! *warn-on-reflection* true)
+
+;; next line is auto-generated by the build-script - Do not edit!
+(def ^:dynamic *clojurescript-version*)
+
+(defn clojurescript-version
+  "Returns clojurescript version as a printable string."
+  []
+  (str
+    (:major *clojurescript-version*)
+    "."
+    (:minor *clojurescript-version*)
+    (when-let [i (:incremental *clojurescript-version*)]
+      (str "." i))
+    (when-let [q (:qualifier *clojurescript-version*)]
+      (str "-" q))
+    (when (:interim *clojurescript-version*)
+      "-SNAPSHOT")))

 (def js-reserved
   #{"break" "case" "chan" "const" "continue" "default"
     "defer" "else" "fallthrough" "for" "func" "go" "goto"
     "if" "import" "interface" "map" "package" "range"
     "return" "select" "struct" "switch" "type" "var"})
+
+(def ^:dynamic *source-map-data* nil)
+(def ^:dynamic *lexical-renames* {})
+
+(def cljs-reserved-file-names #{"deps.cljs"})
+
+(def ^:dynamic *go-return* nil)
+(def ^:dynamic *go-line-numbers* false) ;; https://golang.org/cmd/gc/#hdr-Compiler_Directives
+
+(defmacro ^:private debug-prn
+  [& args]
+  `(.println System/err (str ~@args)))
+
+(defn ns-first-segments []
+  (letfn [(get-first-ns-segment [ns] (first (string/split (str ns) #"\.")))]
+    (map get-first-ns-segment (keys (::ana/namespaces @env/*compiler*)))))
+
+; Helper fn
+(defn shadow-depth [s]
+  (let [{:keys [name info]} s]
+    (loop [d 0, {:keys [shadow]} info]
+      (cond
+       shadow (recur (inc d) shadow)
+       (some #{(str name)} (ns-first-segments)) (inc d)
+       :else d))))

 (defn munge
   ([s] (munge s js-reserved))
@@ -49,8 +102,71 @@
 (defn go-public [s]
   (str (string/upper-case (subs (name s) 0 1)) (subs (name s) 1)))

-(def ^:dynamic *go-return* nil)
-(def ^:dynamic *go-line-numbers* false) ;; https://golang.org/cmd/gc/#hdr-Compiler_Directives
+(defn- comma-sep [xs]
+  (interpose "," xs))
+
+(defn- escape-char [^Character c]
+  (let [cp (.hashCode c)]
+    (case cp
+      ; Handle printable escapes before ASCII
+      34 "\\\""
+      92 "\\\\"
+      ; Handle non-printable escapes
+      8 "\\b"
+      12 "\\f"
+      10 "\\n"
+      13 "\\r"
+      9 "\\t"
+      (if (< 31 cp 127)
+        c ; Print simple ASCII characters
+        (format "\\u%04X" cp))))) ; Any other character is Unicode
+
+(defn- escape-string [^CharSequence s]
+  (let [sb (StringBuilder. (count s))]
+    (doseq [c s]
+      (.append sb (escape-char c)))
+    (.toString sb)))
+
+(defn- wrap-in-double-quotes [x]
+  (str \" x \"))
+
+(defmulti emit* :op)
+
+(defn emit [ast]
+  (env/ensure
+    (when *source-map-data*
+      (let [{:keys [env]} ast]
+        (when (:line env)
+          (let [{:keys [line column]} env]
+            (swap! *source-map-data*
+              (fn [m]
+                (let [minfo (cond-> {:gcol (:gen-col m)
+                                     :gline (:gen-line m)}
+                              (= (:op ast) :var)
+                              (assoc :name (str (-> ast :info :name))))]
+                  ; Dec the line/column numbers for 0-indexing.
+                  ; tools.reader uses 1-indexed sources, chrome
+                  ; expects 0-indexed source maps.
+                  (update-in m [:source-map (dec line)]
+                    (fnil (fn [line]
+                            (update-in line [(if column (dec column) 0)]
+                              (fnil (fn [column] (conj column minfo)) [])))
+                      (sorted-map))))))))))
+    (emit* ast)))
+
+(defn emits [& xs]
+  (doseq [x xs]
+    (cond
+     (nil? x) nil
+     (map? x) (emit x)
+     (seq? x) (apply emits x)
+     (fn? x)  (x)
+     :else (let [s (print-str x)]
+             (when *source-map-data*
+               (swap! *source-map-data*
+                 update-in [:gen-col] #(+ % (count s))))
+             (print s))))
+  nil)

 (defn emitln [& xs]
   (when-let [line (and *go-line-numbers* (some (comp :line :env) xs))]
@@ -59,11 +175,17 @@
   (println)
   nil)

+(defn ^String emit-str [expr]
+  (with-out-str (emit expr)))
+
+(defmulti emit-constant class)
 (defmethod emit-constant nil [x] (emits "nil"))
 (defmethod emit-constant Long [x] (emits "float64(" x ")"))
 (defmethod emit-constant Integer [x] (emits "float64(" x ")")) ; reader puts Integers in metadata
+(defmethod emit-constant Double [x] (emits x))
 (defmethod emit-constant String [x]
   (emits (wrap-in-double-quotes (escape-string x))))
+(defmethod emit-constant Boolean [x] (emits (if x "true" "false")))
 (defmethod emit-constant Character [x]
   (emits (str "'" (escape-char x) "'")))

@@ -160,7 +282,14 @@
 (defmethod emit* :meta
   [{:keys [expr meta env]}]
   (emit-wrap env
-    (emits "with_meta(" expr "," meta ")")))
+    (emits "With_meta(" expr "," meta ")")))
+
+(def ^:private array-map-threshold 8)
+(def ^:private obj-map-threshold 8)
+
+(defn distinct-keys? [keys]
+  (and (every? #(= (:op %) :constant) keys)
+       (= (count (into #{} keys)) (count keys))))

 (defmethod emit* :map
   [{:keys [env keys vals]}]
@@ -203,6 +332,10 @@
           (emits "PersistentVector{nil, " cnt
             ", 5, PersistentVector.EMPTY_NODE, []interface{}{"  (comma-sep items) "}, nil}")
           (emits "PersistentVector.fromArray([]interface{}{" (comma-sep items) "}, true)"))))))
+
+(defn distinct-constants? [items]
+  (and (every? #(= (:op %) :constant) items)
+       (= (count (into #{} items)) (count items))))

 (defmethod emit* :set
   [{:keys [items env]}]
@@ -235,6 +368,20 @@
   [{:keys [form env]}]
   (when-not (= :statement (:context env))
     (emit-wrap env (emit-constant form))))
+
+(defn truthy-constant? [{:keys [op form]}]
+  (and (= op :constant)
+       form
+       (not (or (and (string? form) (= form ""))
+                (and (number? form) (zero? form))))))
+
+(defn falsey-constant? [{:keys [op form]}]
+  (and (= op :constant)
+       (or (false? form) (nil? form))))
+
+(defn safe-test? [env e]
+  (let [tag (ana/infer-tag env e)]
+    (or (#{'boolean 'seq} tag) (truthy-constant? e))))

 (defmethod emit* :if
   [{:keys [test then else env unchecked]}]
@@ -281,6 +428,21 @@
   (if (= :expr (:context env))
     (emits "func() interface{} {panic(" throw ")}()")
     (emitln "panic(" throw ")")))
+
+(defn emit-comment
+  "Emit a nicely formatted comment string."
+  [doc jsdoc]
+  (let [docs (when doc [doc])
+        docs (if jsdoc (concat docs jsdoc) docs)
+        docs (remove nil? docs)]
+    (letfn [(print-comment-lines [e] (doseq [next-line (string/split-lines e)]
+                                       (emitln "* " (string/trim next-line))))]
+      (when (seq docs)
+        (emitln "/**")
+        (doseq [e docs]
+          (when e
+            (print-comment-lines e)))
+        (emitln "*/")))))

 (defmethod emit* :def
   [{:keys [name var init env doc export]}]
@@ -339,6 +501,13 @@
         (emitln ")")))
     (emits "}")))

+(defn emit-fn-params [params]
+  (doseq [param params]
+    (emit param)
+    ; Avoid extraneous comma (function greet(x, y, z,)
+    (when-not (= param (last params))
+      (emits ","))))
+
 (defn emit-fn-method
   [{:keys [type name variadic params expr env recurs max-fixed-arity]}]
   (emit-wrap env
@@ -417,10 +586,10 @@
                            seq)]
       (when loop-locals
         (when (= :return (:context env))
-            (emits "return "))
+          (emits "return "))
         (emitln "func (" (comma-sep (map munge loop-locals)) " interface{}){")
         (when-not (= :return (:context env))
-            (emits "return ")))
+          (emits "return ")))
       (if (= 1 (count methods))
         (if variadic
           (emit-variadic-fn-method (assoc (first methods) :name name))
@@ -429,10 +598,10 @@
               mname (munge name)
               maxparams (apply max-key count (map :params methods))
               mmap (into {}
-                     (map (fn [method]
-                            [(munge (symbol (str mname "__" (count (:params method)))))
-                             method])
-                          methods))
+                         (map (fn [method]
+                                [(munge (symbol (str mname "__" (count (:params method)))))
+                                 method])
+                              methods))
               ms (sort-by #(-> % second :params count) (seq mmap))]
           (when (= :return (:context env))
             (emits "return "))
@@ -469,7 +638,7 @@
               (let [pcnt (count (:params meth))]
                 (emitln "case " pcnt ":")
                 (emitln "return " n "(" (if (zero? pcnt) nil
-                                                (list (comma-sep (take pcnt maxparams)))) ")"))))
+                                            (list (comma-sep (take pcnt maxparams)))) ")"))))
           (emitln "}")
           (emitln "panic(js.Error{fmt.Sprint(\"Invalid arity: \", len(arguments))})")
           (emitln "}")
@@ -501,6 +670,7 @@
     (emit ret)
     (when (and statements (= :expr context)) (emits "}()"))))

+
 (defmethod emit* :try
   [{:keys [env try catch name finally]}]
   (let [context (:context env)]
@@ -568,6 +738,9 @@
       (emitln "var " (munge binding) " = " init))
     (emits expr)
     (when (= :expr context) (emits "}()"))))
+
+(defn protocol-prefix [psym]
+  (symbol (str (-> (str psym) (.replace \. \$) (.replace \/ \$)) "$")))

 (defmethod emit* :invoke
   [{:keys [f args env] :as expr}]
@@ -754,6 +927,179 @@
   [file-str]
   (clojure.string/replace file-str #"\.cljs$" ".go"))

+(defn mkdirs
+  "Create all parent directories for the passed file."
+  [^File f]
+  (.mkdirs (.getParentFile (.getCanonicalFile f))))
+
+(defmacro with-core-cljs
+  "Ensure that core.cljs has been loaded."
+  [& body]
+  `(do (when-not (get-in @env/*compiler* [::ana/namespaces 'cljs.core :defs])
+         (ana/analyze-file "cljs/core.cljs"))
+       ~@body))
+
+(defn url-path [^File f]
+  (.getPath (.toURL (.toURI f))))
+
+(defn compile-file*
+  ([src dest] (compile-file* src dest nil))
+  ([src dest opts]
+    (env/ensure
+      (with-core-cljs
+        (with-open [out ^java.io.Writer (io/make-writer dest {})]
+          (binding [*out* out
+                    ana/*cljs-ns* 'cljs.user
+                    ana/*cljs-file* (.getPath ^File src)
+                    reader/*alias-map* (or reader/*alias-map* {})
+                    *source-map-data* (when (:source-map opts)
+                                        (atom
+                                          {:source-map (sorted-map)
+                                           :gen-col 0
+                                           :gen-line 0}))]
+            (emitln "// Compiled by ClojureScript " (clojurescript-version))
+            (loop [forms (ana/forms-seq src)
+                   ns-name nil
+                   deps nil]
+              (if (seq forms)
+                (let [env (ana/empty-env)
+                      ast (ana/analyze env (first forms))]
+                  (do (emit ast)
+                    (if (= (:op ast) :ns)
+                      (recur (rest forms) (:name ast) (merge (:uses ast) (:requires ast)))
+                      (recur (rest forms) ns-name deps))))
+                (let [sm-data (when *source-map-data* @*source-map-data*)
+                      ret (merge
+                            {:ns (or ns-name 'cljs.user)
+                             :provides [ns-name]
+                             :requires (if (= ns-name 'cljs.core)
+                                         (set (vals deps))
+                                         (cond-> (conj (set (vals deps)) 'cljs.core)
+                                           (get-in @env/*compiler* [:opts :emit-constants])
+                                           (conj 'constants-table)))
+                             :file dest
+                             :source-file src}
+                            (when sm-data
+                              {:source-map (:source-map sm-data)}))]
+                  (when (and sm-data (= (:optimizations opts) :none))
+                    (let [sm-file (io/file (str (.getPath ^File dest) ".map"))]
+                      (emits "\n//# sourceMappingURL=" (.getName sm-file))
+                      (spit sm-file
+                        (sm/encode {(url-path src) (:source-map sm-data)}
+                          {:lines (+ (:gen-line sm-data) 2)
+                           :file (url-path dest)}))))
+                  (let [path (.getPath (.toURL ^File dest))]
+                    (swap! env/*compiler* assoc-in [::compiled-cljs path] ret)
+                    (swap! env/*compiler* assoc-in [::ana/analyzed-cljs path] true))
+                  ret)))))))))
+
+(defn compiled-by-version [^File f]
+  (with-open [reader (io/reader f)]
+    (let [match (->> reader line-seq first
+                     (re-matches #".*ClojureScript (.*)$"))]
+      (and match (second match)))))
+
+(defn requires-compilation?
+  "Return true if the src file requires compilation."
+  ([src dest] (requires-compilation? src dest nil))
+  ([^File src ^File dest opts]
+    (env/ensure
+      (or (not (.exists dest))
+          (> (.lastModified src) (.lastModified dest))
+          (let [version' (compiled-by-version dest)
+                version  (clojurescript-version)]
+            (and version (not= version version')))
+          (and opts
+            (:source-map opts)
+            (if (= (:optimizations opts) :none)
+              (not (.exists (io/file (str (.getPath dest) ".map"))))
+              (not (get-in @env/*compiler* [::compiled-cljs (.getAbsolutePath dest)]))))))))
+
+(defn parse-ns
+  ([src] (parse-ns src nil nil))
+  ([src dest opts]
+    (env/ensure
+      (let [namespaces' (::ana/namespaces @env/*compiler*)
+            ret
+            (binding [ana/*cljs-ns* 'cljs.user
+                      ana/*analyze-deps* false]
+              (loop [forms (ana/forms-seq src)]
+                (if (seq forms)
+                  (let [env (ana/empty-env)
+                        ast (ana/no-warn (ana/analyze env (first forms)))]
+                    (if (= (:op ast) :ns)
+                      (let [ns-name (:name ast)
+                            deps    (merge (:uses ast) (:requires ast))]
+                        (merge
+                          {:ns (or ns-name 'cljs.user)
+                           :provides [ns-name]
+                           :requires (if (= ns-name 'cljs.core)
+                                       (set (vals deps))
+                                       (cond-> (conj (set (vals deps)) 'cljs.core)
+                                         (get-in @env/*compiler* [:opts :emit-constants])
+                                         (conj 'constants-table)))
+                           :file dest
+                           :source-file src}
+                          (when (and dest (.exists ^File dest))
+                            {:lines (with-open [reader (io/reader dest)]
+                                      (-> reader line-seq count))})))
+                      (recur (rest forms)))))))]
+        ;; TODO this _was_ a reset! of the old ana/namespaces atom; should we capture and
+        ;; then restore the entirety of env/*compiler* here instead?
+        (swap! env/*compiler* assoc ::ana/namespaces namespaces')
+        ret))))
+
+(defn compile-file
+  "Compiles src to a file of the same name, but with a .js extension,
+   in the src file's directory.
+
+   With dest argument, write file to provided location. If the dest
+   argument is a file outside the source tree, missing parent
+   directories will be created. The src file will only be compiled if
+   the dest file has an older modification time.
+
+   Both src and dest may be either a String or a File.
+
+   Returns a map containing {:ns .. :provides .. :requires .. :file ..}.
+   If the file was not compiled returns only {:file ...}"
+  ([src]
+    (let [dest (rename-to-js src)]
+      (compile-file src dest nil)))
+  ([src dest]
+    (compile-file src dest nil))
+  ([src dest opts]
+    (let [src-file (io/file src)
+          dest-file (io/file dest)]
+      (if (.exists src-file)
+        (try
+          (let [{ns :ns :as ns-info} (parse-ns src-file dest-file opts)]
+            (if (requires-compilation? src-file dest-file opts)
+              (do (mkdirs dest-file)
+                (when (contains? (::ana/namespaces @env/*compiler*) ns)
+                  (swap! env/*compiler* update-in [::ana/namespaces] dissoc ns))
+                (compile-file* src-file dest-file opts))
+              (do
+                (when-not (contains? (::ana/namespaces @env/*compiler*) ns)
+                  (with-core-cljs
+                    (ana/analyze-file src-file)))
+                ns-info)))
+          (catch Exception e
+            (throw (ex-info (str "failed compiling file:" src) {:file src} e))))
+        (throw (java.io.FileNotFoundException. (str "The file " src " does not exist.")))))))
+
+(defn path-seq
+  [file-str]
+  (->> File/separator
+       java.util.regex.Pattern/quote
+       re-pattern
+       (string/split file-str)))
+
+(defn to-path
+  ([parts]
+     (to-path parts File/separator))
+  ([parts sep]
+    (apply str (interpose sep parts))))
+
 (defn ^File to-target-file
   [target cljs-file]
   (let [relative-path (string/split
@@ -764,6 +1110,36 @@
       (io/file (to-path (cons target parents)))
       (str (last relative-path) ".go"))))

+(defn cljs-files-in
+  "Return a sequence of all .cljs files in the given directory."
+  [dir]
+  (filter #(let [name (.getName ^File %)]
+             (and (.endsWith name ".cljs")
+                  (not= \. (first name))
+                  (not (contains? cljs-reserved-file-names name))))
+          (file-seq dir)))
+
+(defn compile-root
+  "Looks recursively in src-dir for .cljs files and compiles them to
+   .js files. If target-dir is provided, output will go into this
+   directory mirroring the source directory structure. Returns a list
+   of maps containing information about each file which was compiled
+   in dependency order."
+  ([src-dir]
+     (compile-root src-dir "out"))
+  ([src-dir target-dir]
+     (compile-root src-dir target-dir nil))
+  ([src-dir target-dir opts]
+     (swap! env/*compiler* assoc :root src-dir)
+     (let [src-dir-file (io/file src-dir)]
+       (loop [cljs-files (cljs-files-in src-dir-file)
+              output-files []]
+         (if (seq cljs-files)
+           (let [cljs-file (first cljs-files)
+                 output-file (to-target-file target-dir cljs-file)
+                 ns-info (compile-file cljs-file output-file opts)]
+             (recur (rest cljs-files) (conj output-files (assoc ns-info :file-name (.getPath output-file)))))
+           output-files)))))

 ;; TODO: needs fixing, table will include other things than keywords - David

@@ -772,3 +1148,8 @@
     (emits value " = ")
     (emits-keyword keyword)
     (emitln)))
+
+(defn emit-constants-table-to-file [table dest]
+  (with-open [out ^java.io.Writer (io/make-writer dest {})]
+    (binding [*out* out]
+      (emit-constants-table table))))


Experiment with variations of case-stagnation meta-error

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -165,9 +165,9 @@
                            (let [improvements (mapv (fn [[newer-error older-error]]
                                                       (if (< newer-error older-error)
                                                         1.0
-                                                        (if (= newer-error older-error)
-                                                          -1.0
-                                                          0.0)))
+                                                        (if true ;(= newer-error older-error) ;for now only improvement counts
+                                                          0.0
+                                                          -1.0)))
                                                     (partition 2 1 case-history))
                                  weights (take (count improvements)
                                                (iterate (partial * (- 1 improvement-discount)) 1))


Add BMI-calculator

Add BMI-calculator

--- test/demo.cljs
+++ test/demo.cljs
@@ -36,6 +36,13 @@
 (defn src-for [{:keys [defs]}]
   [:pre (src-for-names defs)])

+(defn demo-component [props]
+  [:div.example
+   [:h3 "Example"]
+   [(:comp props)]
+   [:h3 "Source"]
+   [src-for props]])
+
 (defn simple-component []
   [:div
    [:h3 "I am a component!"]
@@ -47,12 +54,56 @@
 (defn demo-simple []
   [:div
    [:h2 "This is a simple component"]
-   [simple-component]
-   [:p "Source:"
-    [src-for {:defs [:ns :simple-component]}]]])
+   [demo-component {:comp simple-component
+                    :defs [:ns :simple-component]}]])
+
+(defn calc-bmi [{:keys [height weight bmi] :as params}]
+  (let [h (/ height 100)]
+    (if (nil? bmi)
+      (assoc params :bmi (/ weight (* h h)))
+      (assoc params :weight (* bmi h h)))))
+
+(def bmi-data (atom (calc-bmi {:height 180 :weight 80})))
+
+(defn set-bmi [key val clear]
+  (swap! bmi-data #(calc-bmi (merge % {key val, clear nil}))))
+
+(defn slider [{:keys [value key clear min max]}]
+  [:div
+   [:input {:type "range" :min min :max max :value value
+            :style {:width "100%"}
+            :on-change #(set-bmi key (-> % .-target .-value)
+                                 (or clear :bmi))}]])
+
+(defn bmi-component []
+  (let [{:keys [weight height bmi]} @bmi-data
+        [color diagnose] (cond
+                          (< bmi 18.5) ["orange" "underweight"]
+                          (< bmi 25) ["inherit" "normal"]
+                          (< bmi 30) ["orange" "overweight"]
+                          :else ["red" "obese"])]
+    [:div
+     [:div
+      "Height: " (int height) "cm"
+      [slider {:value height :min 100 :max 220 :key :height}]]
+     [:div
+      "Weight: " (int weight) "kg"
+      [slider {:value weight :min 50 :max 200 :key :weight}]]
+     [:div
+      "BMI: " (int bmi) " "
+      [:span {:style {:color color}} diagnose]
+      [slider {:value bmi :min 10 :max 50 :key :bmi :clear :weight}]]]))
+
+(defn bmi-demo []
+  [:div
+   [:h2 "Simple BMI calculator"]
+   [demo-component {:comp bmi-component
+                    :defs [:ns :calc-bmi :bmi-data :set-bmi :slider
+                           :bmi-component]}]])

 (defn demo []
   [:div
    [:h1 "This will become a demo"]
    [demo-simple]
+   [bmi-demo]
    [:p "WIP"]])


Move styles into own CSS file

Move styles into own CSS file

--- src/archi/core.clj
+++ src/archi/core.clj
@@ -117,27 +117,7 @@
           )]))

 (defn make-styles []
-  [:style
-   "text {\n"
-   "  font-size: 14;\n"
-   "  fill: #000;\n"
-   "}\n"
-   ".node polygon {\n"
-   "  fill: none;\n"
-   "}\n"
-   ".node .highlight {\n"
-   "  fill: #000;\n"
-   "}\n"
-   ".node text.highlight {\n"
-   "  fill: #fff;\n"
-   "  stroke: #fff;\n"
-   "}\n"
-   ".edge .highlight {\n"
-   "  stroke-width: 8;\n"
-   "}\n"
-   ".edge text.highlight {\n"
-   "  font-size: 24;\n"
-   "}\n"])
+  [:style (slurp "src/archi/highlight.css")])

 (defn wrap-html [filename svg styles scripts]
   (html [:html


add a cheap html5 autocomplete

add a cheap html5 autocomplete

because it's cheap :heart:

--- src/bolt/core.cljs
+++ src/bolt/core.cljs
@@ -24,15 +24,6 @@
                   .-value)])
   false)

-(defn search-form [app owner {:keys [chan]}]
-  (om/component
-   (dom/form #js {:onSubmit #(submit-search chan %)
-                  :className "jumbotron"}
-             (dom/input #js {:id "search_term" :type "text" :autoFocus "autofocus"})
-             (dom/a #js {:className "btn btn-default mic" :href "#" :onClick speech/toggle-speech }
-                         (dom/img #js {:id "mic" :src "img/mic.gif"}))
-             (dom/input #js {:type "submit" :value "Search" :className "btn btn-default btn-lg"}))))
-
 (def commands-index
   (memoize (fn []
              (merge
@@ -44,6 +35,20 @@
                     (filter :alias)
                     (map (fn [cmd] [(keyword (:alias cmd)) (:url cmd)]))
                     (into {}))))))
+
+(defn search-form [app owner {:keys [chan]}]
+  (om/component
+   (dom/form #js {:onSubmit #(submit-search chan %)
+                  :className "jumbotron"}
+             (apply dom/datalist #js {:id "commands"}
+                    (map #(dom/option #js {:value (name %)})
+                         (sort (keys (commands-index)))))
+             (dom/input #js {:id "search_term" :type "text" :autoFocus "autofocus" :list "commands"})
+             (dom/a #js {:className "btn btn-default mic" :href "#" :onClick speech/toggle-speech }
+                         (dom/img #js {:id "mic" :src "img/mic.gif"}))
+             (dom/input #js {:type "submit" :value "Search" :className "btn btn-default btn-lg"}))))
+
+

 (defn process-search*
   "For now this is just a local config lookup but this could interact


Different display of which ago's are waiting.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -94,18 +94,17 @@
           children (:children d)
           wait-chs (:wait-chs d)]
       ["
" (string/join ":" (last actx))
+       (if (not-empty wait-chs)
+         ["(waiting: "
+          (map (fn [kv] [(second kv) ", "]) wait-chs)
+          ")"]
+         [])
        "
"
        (if (not-empty children)
          ["
children...
"
           (map (fn [kv] ["
" (vis-html vis (first kv)) "
"]) children)
           "

"]
          [])
-       (if (not-empty wait-chs)
-         ["
waiting...
"
-          (map (fn [kv] ["
" (second kv) "
"]) wait-chs)
-          "

"]
-         [])
-       "
"
        "
"])
     "no actx"))


More obvious delta / close styling.

More obvious delta / close styling.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -241,7 +241,7 @@
                               (vis-svg-arrow "delta" 0 0 100 (- cy ay)) "</g>"])
                       :take (when (get chs (:ch delta))
                               ["<g transform='translate(600," cy ")'>"
-                               (vis-svg-arrow (str "delta" (when (not (:msg delta)) " close"))
+                               (vis-svg-arrow (if (:msg delta) "delta" "delta close")
                                               0 0 -100 (- ay cy)) "</g>"])
                       :actx-start (when (> childy line-height)
                                     ["<g transform='translate(30," ay ")'>"


shorten url in table

shorten url in table

--- src/semtag_web/client/main.cljs
+++ src/semtag_web/client/main.cljs
@@ -18,13 +18,19 @@

 (def $button ($ :#url_search_button))

+(defn- shorten-to [s max-length]
+  (let [s-length (count s)]
+    (if (> s-length max-length)
+      (str (.substring s 0 (- max-length 3)) "...")
+      s)))
+
 (defpartial generate-rows [data]
   [:tbody
     (map
       #(vec
          [:tr
            [:td (:namespace %)]
-           [:td [:a {:href (:url %)} (:url %)]]
+           [:td [:a {:href (:url %)} (shorten-to (:url %) 40)]]
            [:td (:desc %)]
            [:td (:tags %)]])
       data) ])


Fix var name.

Fix var name.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -192,14 +192,13 @@
       (count filtered-comments))))

 (defn- unseen-comments? [entry user-id container-seen-at]
-  (let [all-comments (filterv :body (:interactions entry))
-        filtered-comments (filterv #(not= (-> % :author :user-id) user-id) all-comments)
+  (let [all-comments (filter :body (:interactions entry))
+        filtered-comments (filter #(not= (-> % :author :user-id) user-id) all-comments)
         all-unseens (if (and filtered-comments
                              (seq container-seen-at))
                       (filter #(pos? (compare (:created-at %) container-seen-at)) filtered-comments)
                       filtered-comments)]
-
-    (pos? (count filtered-comments))))
+    (pos? (count all-unseens))))

 (defn- entry-last-activity-at
   "Return the most recent created-at of the comments, exclude comments from current user if needed."


cosets.clj: small bug fix

cosets.clj: small bug fix

--- clojure/org/gavrog/clojure/cosets.clj
+++ clojure/org/gavrog/clojure/cosets.clj
@@ -130,9 +130,7 @@
                            [k g]))]
     (make-backtracker
       {:root {0 {}}
-       :extract (fn [table]
-                  (println "  " table)
-                  (when (empty? (free table)) table))
+       :extract (fn [table] (when (empty? (free table)) table))
        :children (fn [table]
                    (if-let [[k g] (first (free table))]
                      (let [g* (- g)
@@ -147,6 +145,6 @@
                                       (assoc-in [k g] k*)
                                       (assoc-in [k* g*] k))
                                   [t equiv]
-                                  (scan-relations rels [] table pempty k)]
+                                  (scan-relations rels [] t pempty k)]
                                   :when (empty? equiv)]
                              t))))})))


fix issue where models lifecycle methods are defined differently now.

--- src/metabase/models/table.clj
+++ src/metabase/models/table.clj
@@ -41,7 +41,7 @@
        :description         (u/jdbc-clob->str description)
        :pk_field            (delay (:id (sel :one :fields [Field :id] :table_id id (where {:special_type "id"})))))))

-  (defmethod pre-insert Table [_ table]
+  (pre-insert [_ table]
     (let [defaults {:display_name (common/name->human-readable-name (:name table))}]
       (merge defaults table)))


defined collecting fact configuration.

defined collecting fact configuration.


Update pattern match to make Eastwood happy.

--- src/open_company/resources/company.clj
+++ src/open_company/resources/company.clj
@@ -58,7 +58,7 @@
   "Given the ticker symbol of the company and a company property map, create or update the company
   and return `true` on success.
   TODO: handle case of ticker symbol change."
-  ([ticker :guard get-company company] (update-company company))
+  ([_ :guard get-company company] (update-company company))
   ([_ company] (create-company company)))

 (defn delete-company


Fix path-exists? to look at the canonical-path

--- src/overtone/helpers/file.clj
+++ src/overtone/helpers/file.clj
@@ -324,7 +324,7 @@
 (defn path-exists?
   "Returns true if file or dir specified by path exists"
   [path]
-  (let [path (resolve-tilde-path path)
+  (let [path (canonical-path path)
         f (file path)]
     (.exists f)))


Fix regression bug introduced when renaming internal metro fns.

Thanks to Ian Davies for the fix.

--- src/overtone/music/rhythm.clj
+++ src/overtone/music/rhythm.clj
@@ -96,9 +96,9 @@
   (invoke [this arg]
     (cond
      (number? arg) (metro-beat this arg)
-     (= :bpm arg) (.bpm this) ;; (bpm this) fails.
+     (= :bpm arg) (metro-bpm this) ;; (bpm this) fails.
      :else (throw (Exception. (str "Unsupported metronome arg: " arg)))))
-  (invoke [this _ new-bpm] (.bpm this new-bpm)))
+  (invoke [this _ new-bpm] (metro-bpm this new-bpm)))

 (defn metronome
   "A metronome is a beat management function.  Tell it what BPM you want,


Added some splice-sep variations for testing

--- src/paredit/core_commands.clj
+++ src/paredit/core_commands.clj
@@ -445,7 +445,10 @@
                 "(foo (b|ar baz) quux)" "(foo b|ar baz quux)"
                 "(bar| baz)" "bar| baz"
                 "(bar | baz)" "bar | baz"
+                "(foo (ba|r) baz)" "(foo ba|r baz)"
                 ; TODO Following edge case tests do not pass
+                ;"(foo \"bar|\" baz)" "(foo bar| baz)"
+                ;"(foo \"ba|r\" baz)" "(foo ba|r baz)"
                 ;"(foo (|) baz)" "(foo | baz)"
                 ;"(foo (bar|) baz)" "(foo bar| baz)"
                 }]


Fix domain/main indentation

Fix domain/main indentation

--- src/trustroots/domain/main.cljs
+++ src/trustroots/domain/main.cljs
@@ -1,46 +1,37 @@
 (ns trustroots.domain.main
-  (:require
-    [schema.core :as s :include-macros true]
-    [trustroots.domain.auth :as auth]))
-
-
+  (:require [schema.core :as s :include-macros true]
+            [trustroots.domain.auth :as auth]))

 ;; schema of app-db
 (def schema
   (merge auth/schema
-         {
-          :services {
-                     :toaster (s/maybe s/Any)
-                     :navigator (s/maybe s/Any)}
+         {:services                     {:toaster (s/maybe s/Any)
+                                         :navigator (s/maybe s/Any)}

-          :off-line s/Bool
-          :page     (s/enum :login :inbox :conversation)
-          :network-state s/Any
+          :off-line                     s/Bool
+          :page                         (s/enum :login :inbox :conversation)
+          :network-state                s/Any
+
           ;; user inbox from /api/messages
-          :message/inbox [s/Any]
-          :message/conversation-with
-          {
-            ;user-id | Messages (from /api/messages/{user-id})
-            (s/maybe s/Str) [s/Any]}
+          :message/inbox                [s/Any]
+          :message/conversation-with    {;;user-id | Messages (from /api/messages/{user-id})
+                                         (s/maybe s/Str) [s/Any]}

           :message/current-conversation (s/maybe s/Str)
-          :request-in-progress [s/Keyword]}))
-
+          :request-in-progress          [s/Keyword]}))

 ;; initial state of app-db
 (def app-db
   (merge auth/app-db
-         {
-          :services {:toaster   nil
-                     :navigator nil}
-          :off-line   true
-          :page       :login
-          :network-state :not-initialized
-          :message/inbox []
-          :message/conversation-with {}
+         {:services                     {:toaster   nil
+                                         :navigator nil}
+          :off-line                     true
+          :page                         :login
+          :network-state                :not-initialized
+          :message/inbox                []
+          :message/conversation-with    {}
           :message/current-conversation nil
-          :request-in-progress []}))
-
+          :request-in-progress          []}))

 (defn set-offline! [db state]
   (assoc db :off-line state))


clean ns :)

clean ns :)

--- src/refactor_nrepl/ns/dependencies.clj
+++ src/refactor_nrepl/ns/dependencies.clj
@@ -1,9 +1,7 @@
 (ns refactor-nrepl.ns.dependencies
   (:require [cider.nrepl.middleware.info :refer [info-clj]]
-            [clojure
-             [edn :as edn]
-             [string :as str]]
             [clojure.java.io :as io]
+            [clojure.string :as str]
             [clojure.tools.analyzer.ast :refer [nodes]]
             [instaparse.core :refer [parse parser]]
             [refactor-nrepl.analyzer :refer [ns-ast]]


fix get-performance-logs (#288)

fix get-performance-logs (#288)

--- src/etaoin/dev.clj
+++ src/etaoin/dev.clj
@@ -197,7 +197,7 @@
   was set (see the `:dev` key when running a driver).
   "
   [driver]
-  (->> (api/get-logs* driver "performance")
+  (->> (api/get-logs driver "performance")
        (mapv (comp process-log api/process-log))))


Log db error

Log db error

Signed-off-by: Andrea Maria Piana <39e16ece3c2d27e1889178b15ddb376e524032f8@gmail.com>

--- src/status_im/data_store/realm/core.cljs
+++ src/status_im/data_store/realm/core.cljs
@@ -202,8 +202,9 @@
          (encrypted-realm-version file-name new-key)
          (log/info "try to encrypt with password success")
          (on-success))
-       (catch :default _
+       (catch :default e
          (do
+           (log/warn "failed checking db encryption with" e)
            (log/info "try to encrypt with old key")
            (encrypted-realm-version file-name old-key)
            (log/info "try to encrypt with old key success")


failed attempt at passing object constructor in 1

--- statspop/src/statspop/core.cljs
+++ statspop/src/statspop/core.cljs
@@ -17,18 +17,20 @@

 (defn show-line-chart
   [chart-data]
-  (let [{:keys [data options]} chart-data]
+  (let [{:keys [func data options]} chart-data]
     (.log js/console (str "showing line chart with: " data))
-    (js/Chartist.Line. ".ct-chart" (clj->js data) (clj->js options))))
+    (func ".ct-chart" (clj->js data) (clj->js options))))

-(def test-line-data1 {:data {:labels ["Mar-2012" "Jun-2012" "Nov-2012" "Oct-2013" "Nov-2014"]
+(def test-line-data1 {:func js/Chartist.Line.
+                      :data {:labels ["Mar-2012" "Jun-2012" "Nov-2012" "Oct-2013" "Nov-2014"]
                              :series [[1 1 6 15 25]]}
                       :options {:width  "700px"
                                 :height "380px"}
                        :class "ct-chart ct-perfect-fourth"})

-(def test-line-data2 {:data {:labels ["Mar-2013" "Jun-2013" "Nov-2013" "Oct-2014" "Nov-2015"]
+(def test-line-data2 {:func js/Chartist.Line.
+                      :data {:labels ["Mar-2013" "Jun-2013" "Nov-2013" "Oct-2014" "Nov-2015"]
                              :series [[25 15 6 1 1]]}
                       :options {:width  "700px"
                                 :height "380px"}


typical-stage-length returns measurement

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -111,8 +111,12 @@
 (defn typical-toe-measured-depth []
   (tuc/draw-normal 18000 1500))

-(defn typical-stage-top []
-  (tuc/draw-normal 13750 2150))
+(defn typical-stage-top
+  ([] (typical-stage-top (rand-length-unit)))
+  ([length-unit]
+   (condp = length-unit
+     :ft (make-measurement (tuc/draw-normal 13750 2150) :ft)
+     :m (length-as (typical-stage-top :ft) :m))))

 (defn typical-stage-length
   ([] (typical-stage-length (rand-length-unit)))


Fix seq convertion

Fix seq convertion

--- src/qcast/feed/ext/itunes.clj
+++ src/qcast/feed/ext/itunes.clj
@@ -20,7 +20,8 @@
 ;; Channel

 (defn owner [name email]
-  [:itunes:owner '([:itunes:name name] [:itunes:email email])])
+  [:itunes:owner (seq [[:itunes:name (escape-html name)]
+                       [:itunes:email email]])])

 (defn categories [& cats]
   (map #(vector :itunes:category {:text (escape-html %)}) cats))


CMR-6287: update science keyword response

--- indexer-app/src/cmr/indexer/services/index_service.clj
+++ indexer-app/src/cmr/indexer/services/index_service.clj
@@ -198,24 +198,15 @@
         terminal-key (->> keyword-hierarchy
                           (map #(get science-keywords %))
                           (positions nil?))
-        keyword-field (if (empty? terminal-key)
-                        (-> keyword-hierarchy
-                            last
-                            name
-                            csk/->snake_case)
-                        (->> terminal-key
-                             first
-                             (nth keyword-hierarchy)
-                             name
-                             csk/->snake_case))
         keyword-string (->> keyword-hierarchy
                             (map #(get science-keywords %))
                             (remove nil?)
-                            (s/join ":"))]
+                            (s/join ":"))
+        keyword-value (get science-keywords terminal-key)]
      {:type "science_keywords"
       :_id (str keyword-string "_science_keywords")
-       :value keyword-string
-       :field keyword-field
+       :value keyword-value
+       :field keyword-string
        :_index "1_autocomplete"
        :_type "suggestion"}))


Version 0.1.1

Version 0.1.1

--- metlog-agent/project.clj
+++ metlog-agent/project.clj
@@ -1,4 +1,4 @@
-(defproject metlog-agent "0.1.1-SNAPSHOT"
+(defproject metlog-agent "0.1.1"
   :description "Metlog agent - polls data sources for upload to vault."

   :license {:name "Eclipse Public License"


Add fn to Room to get item.

Add fn to Room to get item.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -16,7 +16,8 @@
 (defrecord Flower [name summary])

 (defprotocol QueryableRoom
-  (connected-rooms [this story]))
+  (connected-rooms [this story])
+  (item [this name]))

 (defprotocol QueryableStory
   (items [this])
@@ -33,7 +34,9 @@
     (let [this-as-exits (filter (fn [x] (= this (:exit x))) (vals (:rooms story)))]
       (if (not= :undefined (:exit this))
         (conj this-as-exits (:exit this))
-        this-as-exits))))
+        this-as-exits)))
+  (item [this name]
+    (first (filter (fn [x] (= (:name x) name)) items))))

 (defrecord Story [player rooms]
   QueryableStory


Don't do api fetch for top bar in v2

Don't do api fetch for top bar in v2

--- src-cljs/frontend/components/app.cljs
+++ src-cljs/frontend/components/app.cljs
@@ -108,7 +108,7 @@
     (will-mount [_]
       (let [logged-in? (boolean (get-in app state/user-path))
             api-ch (get-in app [:comms :api])]
-        (if (and logged-in? (feature/enabled? :ui-v2))
+        (if (and logged-in? (feature/enabled? :ui-fp-top-bar))
           (api/get-orgs api-ch))))
     om/IRender
     (render [_]


fix relative-to's accidental quoting of special characters

relative-to used to convert paths to URIs, which resulted in some
special characters being quoted.

This led to errors like the following when trying to start a repl:
,----
|             clojure.lang.ExceptionInfo: java.io.FileNotFoundException: /home/ralf/.boot/tmp/home/ralf/boot-sandbox/dsn/-x24pa9/%23core.clj%23 (No such file or directory)
|     data: {:file "../tmp/boot.user3335412700912634473.clj", :line 41}
| java.util.concurrent.ExecutionException: java.io.FileNotFoundException: /home/ralf/.boot/tmp/home/ralf/boot-sandbox/dsn/-x24pa9/%23core.clj%23 (No such file or directory)
|           java.io.FileNotFoundException: /home/ralf/.boot/tmp/home/ralf/boot-sandbox/dsn/-x24pa9/%23core.clj%23 (No such file or directory)
`----

Here, relative-to quoted an emacs created backup file. So, this may be
someone's master plan to convert people to vim.

Anyway, we can now use JDK 7's nio Path class in order to relativize
Paths.

Note that nio's Path class now throws an error when called with a
relative and an absolute Path. The old relative-to returned a wrong
result in that case. So, this change may reveal more bugs...

--- boot/pod/src/boot/file.clj
+++ boot/pod/src/boot/file.clj
@@ -68,16 +68,14 @@
 (defn parent? [parent child]
   (contains? (set (parent-seq child)) parent))

-(defn relative-to
+(defn ^java.io.File relative-to
   "Return relative path to f from directory base."
-  [base f]
-  (loop [base base
-         parts []]
-    (if base
-      (if (parent? base f)
-        (apply io/file (concat parts [(str (.relativize (.toURI base) (.toURI f)))]))
-        (recur (parent base) (conj parts "..")))
-      (apply io/file (concat parts (split-path f))))))
+  [^java.io.File base ^java.io.File f]
+  {:pre [(not (nil? base)) (not (nil? f))]}
+  (let [base-path (.toPath base)
+        f-path (.toPath f)
+        relpath (.relativize base-path f-path)]
+    (.toFile relpath)))

 (defn lockfile
   [f]


Work on fixing "big-package" EOF breakages (WIP)

It basically works, except for combining the stream I've received so I
can compare it against what was sent.

--- test/frereth_cp/message/message_test.clj
+++ test/frereth_cp/message/message_test.clj
@@ -432,7 +432,7 @@
   ;; a single message packet.
   (let [test-run (gensym)
         prelog (utils/pre-log test-run)]
-    (log/info prelog "Start testing writing big chunk of outbound data")
+    (log/info prelog "Start test writing big chunk of outbound data")
     ;; TODO: split this into 2 tests
     ;; 1 should stall out like the current implementation,
     ;; waiting for ACKs (maybe drop every other packet?
@@ -445,19 +445,18 @@
     (let [start-time (System/nanoTime)
           packet-count 9  ; trying to make life interesting
           ;; Add an extra quarter-K just for giggles
-          msg-len (+ (* (dec packet-count) K/k-div2) K/k-div4)
+          msg-len (+ (* (dec packet-count) K/k-1) K/k-div4)
           response (promise)
-          srvr-child-state (atom {:count 0
-                                  :buffer []})
+          srvr-child-state (atom {:address 0
+                                  :buffer []
+                                  :count 0})
+          srvr-io-atom (atom nil)
           ;; I have a circular dependency between
           ;; the client's child-cb, server-parent-cb,
           ;; and initialized.
-          ;; The callbacks get called inside an
-          ;; agent send handler,
-          ;; which means I have the agent state
-          ;; directly available, but not the actual
-          ;; agent.
-          ;; That's what it needs, because child->!
+          ;; The callbacks have access to the state
+          ;; value, but not the io-loop handle.
+          ;; They need that, because child->!
           ;; is going to trigger another send.
           ;; Wrapping it inside an atom is obnoxious, but
           ;; it works.
@@ -470,6 +469,7 @@
                              (log/info (utils/pre-log test-run)
                                        "Message from server to client."
                                        "\nThis really should just be an ACK")
+                             ;; This is simulating the network
                              (message/parent->! @client-io-atom bs))
           server-child-cb (fn [incoming]
                             (let [prelog (utils/pre-log test-run)]
@@ -489,43 +489,41 @@
                               ;; TODO: Check out the history, make sure this comment is
                               ;; in the correct vicinity, and then hopefully delete them both.

-                              (let [response-state @srvr-child-state]
+                              (let [packet-size (if (keyword? incoming)
+                                                  0
+                                                  (count incoming))
+                                    response-state @srvr-child-state]
                                 (if (keyword? incoming)
                                   (do
+                                    (log/warn prelog "Server child received EOF" incoming)
                                     (is (s/valid? ::specs/eof-flag incoming))
                                     (message/close! @client-io-atom))
-                                  (log/debug (str test-run
-                                                  "::server-child-cb ("
-                                                  (count incoming)
+                                  (log/debug prelog
+                                             (str "::server-child-cb ("
+                                                  packet-size
                                                   " bytes): "
                                                   (-> response-state
                                                       (dissoc :buffer)
                                                       (assoc :buffer-size (count (:buffer response-state)))))))
-                                ;; The first few blocks should max out the message size.
-                                ;; The way the test is set up, the last will be
-                                ;; (+ 512 64).
-                                ;; It doesn't seem worth the hoops it would take to validate that.
                                 (swap! srvr-child-state
                                        (fn [cur]
                                          (log/info prelog "Incrementing state count")
-                                         (-> cur
-                                             (update :count inc)
-                                             ;; Seems a little silly to include the ACKs.
-                                             ;; Should probably think this through more thoroughly
-                                             (update :buffer conj (vec incoming)))))
-                                ;; I would like to get 8 callbacks here:
-                                ;; 1 for each message packet the child tries to send.
-                                ;; I'm actually receiving 6:
-                                ;; 4 1K blocks, 256 bytes, and an EOF indicator.
-                                ;; It seems like this almost definitely involves
-                                ;; PipedStream buffering.
-                                ;; TODO: Need to double-check that and consider
-                                ;; very diligently what I think about it.
-                                ;; (At first glance, it seems totally incorrect).
-                                (when (= packet-count (:count @srvr-child-state))
+                                         (let [incoming (if (keyword? incoming)
+                                                          [incoming]
+                                                          incoming)]
+                                           (-> cur
+                                               (update :count inc)
+                                               ;; Seems a little silly to include the ACKs.
+                                               ;; Should probably think this through more thoroughly
+                                               ;; ACKs shouldn't get here.
+                                               ;; TODO: Verify that.
+                                               (update :buffer conj (vec incoming))
+                                               (update :address + packet-size)))))
+                                (when (= msg-len (:address @srvr-child-state))
                                   (log/info prelog
-                                            "::srvr-child-cb Received all expected packets")
-                                  (deliver response @srvr-child-state)))))
+                                            "::srvr-child-cb Received all expected bytes")
+                                  (deliver response @srvr-child-state)
+                                  (message/close! @srvr-io-atom)))))
           srvr-initialized (message/initial-state (str "(test " test-run ") Server w/ Big Inbound")
                                                   true
                                                   {})
@@ -543,20 +541,24 @@
                       (message/parent->! srvr-io-handle bs))
           child-message-counter (atom 0)
           strm-address (atom 0)
-          child-cb (fn [bs]
+          child-cb (fn [eof]
                      ;; This is for messages from elsewhere to the child.
-                     ;; This test is all about the child spewing "lots" of data
+                     ;; This test is all about the *child* spewing "lots" of data.
+                     ;; So I don't expect it to ever receive anything except the EOF
+                     ;; marker.
+
                      ;; TODO: Honestly, need a test that really does just start off by
                      ;; sending megabytes (or gigabytes) of data as soon as the connection
                      ;; is warmed up.
-                     ;; Library should be robust enough to handle that failure.
-                     ;; Q: (which failure? feature?)
-                     (is (not bs) "This should never get called"))
+                     ;; Library should be robust enough to handle that.
+                     (is (s/valid? ::specs/eof-flag eof) "This should only get called for EOF"))
           client-initialized (message/initial-state (str "(test " test-run ") Client w/ Big Outbound")
                                                     false
                                                     {})
           client-io-handle (message/start! client-initialized parent-cb child-cb)]
+      (reset! srvr-io-atom srvr-io-handle)
       (reset! client-io-atom client-io-handle)
+
       (try
         (let [;; Note that this is what the child sender should be supplying
               message-body (byte-array (range msg-len))]
@@ -574,6 +576,7 @@
           (message/close! client-io-handle)
           (let [outcome (deref response 10000 ::timeout)
                 end-time (System/nanoTime)]
+            (is (not= outcome ::timeout))
             (log/info prelog
                       "Verifying that state hasn't errored out after"
                       (float (utils/nanos->millis (- end-time start-time))) "milliseconds")
@@ -584,25 +587,26 @@
               (when (not= ::timeout outcome)
                 (is (not (instance? Exception outcome)))
                 (when-not (= outcome ::timeout)
-                  (let [result-buffer (:buffer outcome)]
-                    (is (= packet-count (count result-buffer)))
-                    (is (= K/max-bytes-in-initiate-message (count (first result-buffer))))
-                    (doseq [packet (butlast result-buffer)]
-                      (is (= (count packet) K/k-div2)))
-                    (let [final (last result-buffer)]
-                      (is (= (count final) K/k-div4)))
-                    (let [rcvd-strm
-                          (reduce (fn [acc block]
-                                    (conj acc block))
-                                  []
-                                  result-buffer)]
-                      (is (b-t/bytes= (->> rcvd-strm
-                                           first
-                                           byte-array)
-                                      (->> message-body
-                                           vec
-                                           (take K/max-bytes-in-initiate-message)
-                                           byte-array))))))))))
+                  (let [stream-address (:address outcome)]
+                    (is (= msg-len stream-address))
+                    (let [rcvd-blocks (:buffer outcome)
+                          ;; This is not working at all.
+                          ;; Q: Why not?
+                          byte-seq (concat (concat rcvd-blocks))
+                          _ (log/debug prelog
+                                       "Trying to recreate the incoming stream from"
+                                       (count byte-seq)
+                                       "'somethings' in a"
+                                       (class byte-seq)
+                                       "that looks like\n"
+                                       byte-seq
+                                       "\nBased upon"
+                                       (count rcvd-blocks)
+                                       "instances of"
+                                       (class (first rcvd-blocks)))
+                          rcvd-strm (byte-array (first byte-seq))]
+                      (is (= (count message-body) (count rcvd-strm)))
+                      (is (b-t/bytes= message-body rcvd-strm)))))))))
         (let [{:keys [::specs/incoming
                       ::specs/outgoing]
                :as outcome} (message/get-state client-io-handle 500 ::time-out)]
@@ -610,11 +614,8 @@
           (when (not= outcome ::time-out)
             (is outgoing)
             (is (= msg-len (::specs/ackd-addr outgoing)))
-            (let [n-m-id (::specs/next-message-id outgoing)]
-              (is (= (inc packet-count) n-m-id)))
             (is (= 0 (from-child/buffer-size outcome)))
-            ;; TODO: I do need a test that triggers EOF
-            (is (= ::specs/false (::specs/send-eof outgoing)))
+            (is (= ::specs/normal (::specs/send-eof outgoing)))
             ;; Keeping around as a reminder for when the implementation changes
             ;; and I need to see what's really going on again
             (comment (is (not outcome) "What should we have here?"))))


clutering works

clutering works

--- test/celestial/integration/proxmox.clj
+++ test/celestial/integration/proxmox.clj
@@ -4,7 +4,7 @@
      [supernal.sshj :refer (execute)]
      [flatland.useful.map :refer (dissoc-in*)]
      [celestial.common :refer (slurp-edn)]
-     [celestial.fixtures :refer (with-conf redis-prox-spec redis-bridged-prox)]
+     [celestial.fixtures :refer (with-conf redis-prox-spec redis-bridged-prox clustered-prox)]
      [celestial.model :refer (vconstruct)])
   (:use midje.sweet proxmox.provider))

@@ -42,3 +42,7 @@
 (fact "bridged" :integration :proxmox :bridge
    (with-conf
       (running-seq (vconstruct redis-bridged-prox))))
+
+(fact "cluster" :integration :proxmox :bridge :cluster
+   (with-conf clustered-prox
+      (running-seq (vconstruct (assoc-in redis-bridged-prox [:proxmox :node] "proxmox-b")))))


Updated the runner to use new functionality in ltest.

--- test/clj/cmr/client/testing/runner.clj
+++ test/clj/cmr/client/testing/runner.clj
@@ -1,19 +1,37 @@
 (ns cmr.client.testing.runner
-  #_(:require
+  (:require
+   [cmr.client.tests]
    [ltest.core :as ltest])
-  #_(:gen-class))
+  (:gen-class))

-#_(defn run-tests
+(def tests-regex #"cmr\.client\.tests\..*")
+
+(defn run-tests
   ([]
-   (ltest/run-all-tests #"cmr.client.tests.*"))
+   (ltest/run-all-tests tests-regex))
   ([arg]
    (cond
     (coll? arg) (ltest/run-tests arg)
     (var? arg) (ltest/run-test arg))))

-#_(defn -main
+(defn print-header
+  []
+  (println)
+  (println (apply str (repeat 80 "=")))
+  (println "CMR Client Test Runner")
+  (println (apply str (repeat 80 "=")))
+  (println))
+
+(defn -main
+  "This can be run from `lein` in the following ways:
+
+  * `lein run-tests unit`"
   [& args]
-  (println "main args:" args)
-  (if (nil? args)
-    (run-tests)
-    (run-tests args)))
+  (print-header)
+  (case (keyword (first args))
+    :unit (ltest/run-unit-tests tests-regex)
+    :integration (ltest/run-integration-tests tests-regex)
+    :system (ltest/run-system-tests tests-regex)
+    (if (nil? args)
+      (run-tests)
+      (run-tests args))))


Get rid of refer-all in web-app-test

Get rid of refer-all in web-app-test

--- test/clj/comic_reader/web_app_test.clj
+++ test/clj/comic_reader/web_app_test.clj
@@ -1,7 +1,7 @@
 (ns comic-reader.web-app-test
   (:require [clojure.test :as t]
             [comic-reader.site-scraper :as site-scraper]
-            [comic-reader.web-app :refer :all]
+            [comic-reader.web-app :as sut]
             [comic-reader.comic-repository.scraper :refer [new-scraper-repo]]
             [comic-reader.mock-site-scraper :refer [mock-scraper]]
             [com.stuartsierra.component :as component]
@@ -14,7 +14,7 @@
                       (new-scraper-repo)
                       {:scraper :site-scraper})
    :web-app (component/using
-             (new-web-app)
+             (sut/new-web-app)
              {:repository :comic-repository})))

 (defn test-system [scraper]
@@ -22,7 +22,7 @@
       (component/start)))

 (defn app-routes [system]
-  (get-routes (:web-app system)))
+  (sut/get-routes (:web-app system)))

 (t/deftest test-home-page
   (t/is (= (:status


fix gnucash tests

fix gnucash tests

--- test/clj_money/import/gnucash_test.clj
+++ test/clj_money/import/gnucash_test.clj
@@ -22,7 +22,7 @@
   [{:record-type :commodity
     :record-count 1}
    {:record-type :account
-    :record-count 4}
+    :record-count 9}
    {:record-type :transaction
     :record-count 6}
    {:record-type :budget
@@ -177,9 +177,11 @@
                  input
                  (fn [record record-type]
                    (swap! found (fn [f]
-                                  (update-in f
-                                             [record-type]
-                                             #((fnil conj []) % record))))))
+                                  (if record
+                                    (update-in f
+                                               [record-type]
+                                               #((fnil conj []) % record))
+                                    f)))))
     (is (= declarations (:declaration @found)) "The correct declarations are found")
     (is (= accounts (:account @found)) "The correct accounts are found")
     (is (= budgets (:budget @found)) "The current budgets are found")


Add with-test-db macro to simplify test fixtures

The macro will set a thread-local binding containing the current database, and
will execute the supplied body against that database. Tear-down is automatic,
and as long as the body is executing the database will remain alive.

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

--- test/com/puppetlabs/cmdb/testutils.clj
+++ test/com/puppetlabs/cmdb/testutils.clj
@@ -1,6 +1,7 @@
 (ns com.puppetlabs.cmdb.testutils
   (:import (org.apache.activemq.broker BrokerService))
   (:require [com.puppetlabs.mq :as mq]
+            [clojure.java.jdbc :as sql]
             [clojure.tools.logging.impl :as impl]
             [fs.core :as fs]))

@@ -12,6 +13,14 @@
    :subname     (str "mem:"
                      (java.util.UUID/randomUUID)
                      ";shutdown=true;hsqldb.tx=mvcc;sql.syntax_pgs=true")})
+
+(defmacro with-test-db
+  "Creates a binding for `db` pointing to a fresh database, and
+  executes `body`. When `body` returns, the database will be destroyed."
+  [db & body]
+  `(binding [~db (test-db)]
+     (sql/with-connection ~db
+       ~@body)))

 (defmacro with-test-broker
   "Constructs and starts an embedded MQ, and evaluates `body` inside a


Remove usage of deprecated tmp-dir util

Remove usage of deprecated tmp-dir util

--- test/lambdacd_cctray/sample_pipeline.clj
+++ test/lambdacd_cctray/sample_pipeline.clj
@@ -5,11 +5,12 @@
             [lambdacd.steps.manualtrigger :as manualtrigger]
             [lambdacd.core :as lambdacd]
             [ring.server.standalone :as ring-server]
-            [lambdacd.util :as util]
             [lambdacd.ui.ui-server :as ui]
             [lambdacd.runners :as runners]
             [lambdacd-cctray.core :as cctray]
-            [ring.util.response :as resp]))
+            [ring.util.response :as resp])
+  (:import (java.nio.file.attribute FileAttribute)
+           (java.nio.file Files)))

 (defn some-slow-step [args ctx]
   (shell/bash ctx "/"
@@ -41,6 +42,8 @@
                              some-failing-step
                              some-successful-step)))

+(defn create-temp-dir []
+  (str (Files/createTempDirectory "lambdacd-cctest-sample" (into-array FileAttribute []))))

 (defn mk-routes [pipeline-routes cctray-pipeline-handler]
   (routes
@@ -49,7 +52,7 @@
     (GET "/cctray/pipeline.xml" [] cctray-pipeline-handler)))

 (defn -main [& args]
-  (let [home-dir (if (not (empty? args)) (first args) (util/create-temp-dir))
+  (let [home-dir (if (not (empty? args)) (first args) (create-temp-dir))
         config {:home-dir home-dir
                 :name     "some sample pipeline"
                 :ui-url   "http://localhost:8081/pipeline"}
@@ -58,4 +61,4 @@
     (runners/start-one-run-after-another pipeline)
     (ring-server/serve (mk-routes (ui/ui-for pipeline) cctray-pipeline-handler)
                        {:open-browser? true
-                        :port          8081})))+                        :port          8081})))


finally got make-draggable working.

finally got make-draggable working.

--- src/app/cljs/one/sample/dragdrop.cljs
+++ src/app/cljs/one/sample/dragdrop.cljs
@@ -4,13 +4,21 @@
             [clojure.browser.dom :as dom]
             [cljs.core :as core]))

-(defn make-draggable [id {:keys target id &listeners} ]
+(defn make-draggable [id target & events]
                 (let [drag  (goog.fx.DragDrop. (core/name id) "")
                       drop  (goog.fx.DragDrop. (core/name target) "")]
-                  (.addTarget drag drop)
-                  (.init drag)
-                  (.init drop)
-                 ;(events/listen drag "dragstart" #(dom/log "salam"))
+                 (.addTarget drag drop)
+                 (.init drag)
+                 (.init drop)
+                  (map #(events/listen drag (first %) (second %))
+                       (first events))
                   ))
-(make-draggable "blue" {:target "drop-target"})
-(events/listen (dom/get-element :yellow) "click" #(dom/log "clicked"))+(make-draggable :yellow :drop-target {"dragstart" #(dom/log "dragged1")})
+(events/listen (dom/get-element :blue) "click" #(dom/log "clicked"))
+(events/listen (dom/get-element :yellow) "dragstart" #(dom/log "dragge1111d"))
+
+(defn f[drag target & events]
+  (map #(print %1 "\n") (first events)))
+
+(map #(let [[name age] %1]  (print  "name" name  age "\n")) {:arash :40 :ooldooz 28})
+(f "bbbb" :aaa {"a" "b" "v" "d"})


Bumps version to 1.58.10-SNAPSHOT

Bumps version to 1.58.10-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.58.9"
+(defproject cook "1.58.10-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.10.3"]


extracing system-val

extracing system-val

--- src/celestial/persistency/systems.clj
+++ src/celestial/persistency/systems.clj
@@ -193,3 +193,8 @@
    [name {:keys [env] :as provided}]
    (let [{:keys [defaults] :as t} (get-template! name)]
      (add-system (merge-with merge t (defaults env) provided))))
+
+(defn system-val
+  "grabbing instance id of spec"
+   [spec ks]
+  (get-in (get-system (spec :system-id)) ks))


Refactor templates

Refactor templates

--- src/circle/backend/build/template.clj
+++ src/circle/backend/build/template.clj
@@ -36,8 +36,13 @@
 (defn find! [name]
   (assert! (find name) "could not find template %s" name))

+(defn load-actions [section]
+  (->> section
+       (map #(apply % []))
+       (map #(merge % {:type :infrastructure}))))
+
 (defn apply-template [template-name actions]
   (let [template (find! template-name)
-        before (map #(apply % []) (-> template :prefix))
-        after (map #(apply % []) (-> template :suffix))]
+        before (-> template :prefix (load-actions))
+        after (-> template :suffix (load-actions))]
     (concat before actions after)))


Bump version to be consistent with build.boot

--- src/pamela/cli.clj
+++ src/pamela/cli.clj
@@ -223,7 +223,7 @@
 (defn pamela
   "PAMELA command line processor. (see usage for help)."
   {:added "0.2.0"
-   :version "0.4.2"}
+   :version "0.5.0"}
   [& args]
   (when (and (:pamela-version env)
           (not= (:pamela-version env) (:version (meta #'pamela))))


Formatting on `new` special form

Formatting on `new` special form

--- src/clj/clojuredocs/search/static.clj
+++ src/clj/clojuredocs/search/static.clj
@@ -117,7 +117,8 @@
 locking macro. See http://clojure.org/special_forms for more information."}
         {:name 'new
          :ns "clojure.core"
-         :doc "Instantiate a class. See http://clojure.org/java_interop#new for more information."}]
+         :doc "Instantiate a class. See http://clojure.org/java_interop#new for
+more information."}]
        (map #(assoc % :type "special-form"))))

 (def concept-pages


Fix typo

Fix typo

--- src/clj/conference_rating/handler.clj
+++ src/clj/conference_rating/handler.clj
@@ -69,10 +69,10 @@

 (defn get-conferences [db]
   (let [conferences (db/get-conferences-list db)
-        complete-confernces (->> conferences
+        complete-conferences (->> conferences
                                 (map :_id)
                                 (map #(get-conference % db)))]
-    complete-confernces))
+    complete-conferences))

 (defn- escape-string [x]
   (if (string? x)


more doc fixes

more doc fixes

--- src/clojure/com/zensol/cisql/conf.clj
+++ src/clojure/com/zensol/cisql/conf.clj
@@ -27,11 +27,11 @@
 (def ^:private help-commands
   {:cf "<variable value>  configure (set) a 'variable' to 'value' (ie 'tg gui')"
    :sh "[variable]        show 'variable', or show them all if not given"
-   :tg "[variable]        toggle a boolean variable"
+   :tg "<variable>        toggle a boolean variable"
    :shtab "[table]        show table metdata or all if no table given"
    :orph "[label]         orphan (spawn new next) window in GUI mode"
-   :cfcat "[catalog]      configure (set) the database (like 'use <db name>')"
-   :export "[filename]    export the last query as a CSV file"})
+   :cfcat "<catalog>      configure (set) the database (like 'use <db name>')"
+   :export "<filename>    export the last query as a CSV file"})

 (defn set-config [key value]
   (log/tracef "%s -> %s" key value)


helper fn to turn datom into a transaction

--- src/pc/datomic.clj
+++ src/pc/datomic.clj
@@ -51,6 +51,12 @@
         transaction (d/transact conn (mapv (fn [tempid] {:db/id tempid :dummy :dummy/dummy}) tempids))]
     (mapv (fn [tempid] (d/resolve-tempid (:db-after @transaction) (:tempids @transaction) tempid)) tempids)))

+;; should we convert a to its name (it's currently using its eid)?
+;; Would require a reference to the db
+(defn datom->transaction [datom]
+  (let [{:keys [a e v tx added]} datom]
+    [(if added :db/add :db/retract) e a v]))
+
 (defn init []
   (infof "Creating default database if it doesn't exist: %s"
          (d/create-database default-uri))


uuid helper

uuid helper

--- src/pc/datomic.clj
+++ src/pc/datomic.clj
@@ -1,6 +1,7 @@
 (ns pc.datomic
   (:require [clojure.tools.logging :refer (infof)]
-            [datomic.api :refer [db q] :as d]))
+            [datomic.api :refer [db q] :as d])
+  (:import java.util.UUID))

 (def default-uri "datomic:free://localhost:4334/pc")

@@ -41,6 +42,9 @@
   [query & query-args]
   (first (apply touch-all query query-args)))

+(defn uuid []
+  (UUID/randomUUID))
+
 (defn init []
   (infof "Creating default database if it doesn't exist: %s"
          (d/create-database default-uri))


Update generator.clj

Update generator.clj

--- src/swagger_gen/generator.clj
+++ src/swagger_gen/generator.clj
@@ -15,7 +15,7 @@

    (render-swagger spec template
      (fn [spec]
-       (assoc :spec :foo :bar)))
+       (assoc spec :paths {:foo 1})))

    Any template being rendered will have access to the new :foo :bar key value pair"
   ([swagger-spec path-to-template transformer]


Added re-frame to the cljs.user namespace

--- dev/cljs/cljs/user.cljs
+++ dev/cljs/cljs/user.cljs
@@ -1,5 +1,6 @@
 (ns cljs.user
-  (:require [figwheel.client :as fw :include-macros true]
+  (:require [re-frame.core :as rf]
+            [figwheel.client :as fw :include-macros true]
             [blocks-editor.async-events :refer [w-load-c]]
             [cljs.core.async :as async
              :refer [put! chan tap mult <! >! timeout close!]])


bugfix :trimesh emitter: inject face tessellator

--- src/thi/ng/luxor/compiler.clj
+++ src/thi/ng/luxor/compiler.clj
@@ -2,6 +2,7 @@
   (:require
    [thi.ng.luxor.config :as conf]
    [thi.ng.luxor.color :as col]
+   [thi.ng.geom.gmesh :as gm]
    [thi.ng.geom.meshio :as mio]
    [clojure.java.io :as io]))

@@ -172,7 +173,9 @@
   [_ scene id {:keys [__mesh]}]
   (let [verts (vec (keys (:vertices __mesh)))
         vidx (zipmap verts (range))
-        indices (mapcat (fn [[a b c]] [(vidx a) (vidx b) (vidx c)]) (:faces __mesh))]
+        indices (->> (:faces __mesh)
+                    (mapcat gm/tessellate-face1)
+                    (mapcat (fn [[a b c]] [(vidx a) (vidx b) (vidx c)])))]
     (luxentity
      scene "Shape" "trianglemesh"
      {:indices [:int-vec (vec indices)]


fix missing macros

fix missing macros

--- src/thinking/transducers.cljc
+++ src/thinking/transducers.cljc
@@ -3,7 +3,7 @@
      (:require-macros [cljs.core.async.macros :refer [go go-loop]]))
   (:require
    #?(:clj  [clojure.core.async :as async :refer [<! <!! >! >!! timeout chan]]
-      :cljs [cljs.core.async    :as async :refer [<! <!! >! >!! timeout chan]])))
+      :cljs [cljs.core.async    :as async :refer [<! >! timeout chan]])))

 ;; map, filter


add a zero so that auto format doesn't much up the substraction

--- src-cljs/hello.cljs
+++ src-cljs/hello.cljs
@@ -17,7 +17,7 @@
     :rockets []))

 (defn random-angle-vector []
-  {:x (- .5 (rand))
+  {:x (- 0.5 (rand))
    :y (- -2.5 (rand))})

 (defn spawn-random-rocket [game-world]


No need to update import data with a dispatch when we can use a r/atom

--- src/ui/relevance/display.cljs
+++ src/ui/relevance/display.cljs
@@ -330,8 +330,7 @@
        ])))

 (defn data-import []
-  (let [path        [:app-state :import]
-        import-data (subscribe path)]
+  (let [import-data (reagent/atom "")]
     (fn []
       [:div {:class "col-sm-10 col-sm-offset-1"}
        [:div {:class "page-header"} [:h2 "Import data"]]
@@ -341,7 +340,7 @@
        [:textarea {:class     "form-control"
                    :rows      30
                    :value     @import-data
-                   :on-change #(dispatch [:app-state-item path (-> % .-target .-value)])}]
+                   :on-change #(reset! import-data (-> % .-target .-value))}]
        [:a {:class    "btn btn-danger btn-sm"
             :on-click #(dispatch [:data-import @import-data])} "Import"]
        ])))


Fix group deletion mechanism.

Fix group deletion mechanism.

--- src/uxbox/data/workspace.cljs
+++ src/uxbox/data/workspace.cljs
@@ -156,18 +156,23 @@

 (defn delete-shape
   "Remove the shape using its id."
-  [sid]
-  (reify
-    rs/UpdateEvent
-    (-apply-update [_ state]
-      (let [pageid (get-in state [:shapes-by-id sid :page])
-            shapes (as-> state $
-                     (get-in $ [:pages-by-id pageid :shapes])
-                     (remove #(= % sid) $)
-                     (into [] $))]
+  [id]
+  (letfn [(dissoc-shape [state {:keys [id] :as shape}]
+            (if (= (:type shape) :builtin/group)
+              (let [state (update-in state [:shapes-by-id] dissoc id)]
+                (->> (map #(get-in state [:shapes-by-id %]) (:items shape))
+                     (reduce dissoc-shape state)))
+              (update-in state [:shapes-by-id] dissoc id)))]
+    (reify
+      rs/UpdateEvent
+      (-apply-update [_ state]
+      (let [shape (get-in state [:shapes-by-id id])
+            pageid (:page shape)
+            shapes (get-in state [:pages-by-id pageid :shapes])
+            shapes (into [] (remove #(= % id) shapes))]
         (as-> state $
           (assoc-in $ [:pages-by-id pageid :shapes] shapes)
-          (update-in $ [:shapes-by-id] dissoc sid))))))
+          (dissoc-shape $ shape)))))))

 (defn move-shape
   "Mark a shape selected for drawing in the canvas."


Improved edition text handler.

Improved edition text handler.

--- src/uxbox/ui/shapes/text.cljs
+++ src/uxbox/ui/shapes/text.cljs
@@ -130,7 +130,7 @@
 (def ^:const +select-rect-attrs+
   {:stroke-dasharray "5,5"
    :style {:stroke "#333" :fill "transparent"
-           :stroke-opacity "1"}})
+           :stroke-opacity "0.4"}})

 (defmethod uusc/render-shape :builtin/text
   [{:keys [id x1 y1 x2 y2 content drawing? editing?] :as shape}]


follow-map and bind-map

follow-map and bind-map

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

--- plugins/SlideExplorer2/src/slide_explorer/canvas1.clj
+++ plugins/SlideExplorer2/src/slide_explorer/canvas1.clj
@@ -654,14 +654,19 @@
    value at address1 in ref1."
   [[ref1 address1] function [ref2 address2]]
   (handle-change-at ref1 address1 [ref2 address2]
-                    #(swap! ref2 assoc-at address2
-                            (function %))))
+                    #(let [val (function %)]
+                       (when-not (= val ::?)
+                         (swap! ref2 assoc-at address2 val)))))

 (defn follow-linear
   [[ref1 address1] [factor offset] [ref2 address2]]
   (follow-function [ref1 address1]
                    #(+ offset (* factor %))
                    [ref2 address2]))
+
+(defn follow-map
+  [[ref1 address1] m [ref2 address2]]
+  (follow-function [ref1 address1] #(m % ::?) [ref2 address2]))

 (defn follow
   [[ref1 address1] [ref2 address2]]
@@ -684,6 +689,11 @@
     (bind-linear [ref1 address1]
                  [factor offset]
                  [ref2 address2])))
+
+(defn bind-map [[ref1 address1] m [ref2 address2]]
+  (let [m-inverse (clojure.set/map-invert m)]
+    (follow-map [ref1 address1] m [ref2 address2])
+    (follow-map [ref2 address2] m-inverse [ref1 address1])))

 (defn bind [[ref1 address1] [ref2 address2]]
   (follow [ref1 address1] [ref2 address2])


The struggle is real.

The struggle is real.

--- src/lambda_blog/templates/entries.clj
+++ src/lambda_blog/templates/entries.clj
@@ -64,7 +64,7 @@
               title))
        (p "Posted on " (time (format-time "YYYY-MM-dd HH:mm" timestamp))
           " by " (or author (:author ent))) ;; KLUDGE :(
-       (entry-tags ent)))))
+       (entry-tags entry)))))
    contents)) ;; FIXME This should be shortened somehow.

 (defn recent-entries


fix bad :fn-arity warning

fix bad :fn-arity warning

--- src/main/shadow/build/cljs_hacks.cljc
+++ src/main/shadow/build/cljs_hacks.cljc
@@ -746,7 +746,7 @@

     (when (:fn-var info)
       (when (invalid-arity? (:info fexpr) argc)
-        (ana/warning :fn-arity env {:name name :argc argc})))
+        (ana/warning :fn-arity env {:name (:name info) :argc argc})))

     (let [deprecated? (-> fexpr :info :deprecated)
           no-warn? (-> form meta :deprecation-nowarn)]