move start/stop/etc. into test/ namespaces for use during testing, add some helpful dev fns

--- dev/user.clj
+++ dev/user.clj
@@ -4,56 +4,53 @@
             [clojure.pprint :refer (pprint)]
             [clojure.repl :refer :all]
             [clojure.test :as test]
+            [datomic.api :as d]
             [clojure.tools.namespace.repl :refer (refresh refresh-all)]
-            [hickory.core :as hickory]
-            [navigator.core :as n-core]
-            [navigator.conf :as n-conf]
-            [navigator.templates :as n-tpl]
-            [net.cgrand.enlive-html :as en]
+            [navigator]
+            [navigator.test-config :as nt-config]
+            [datomic-schematode.core :as schematode]
+            [clojure.edn :as edn]
             ))

 ;; N.B.: (ns cljs.user (:use [clojure.zip :only [insert-child]])) (see http://stackoverflow.com/questions/12879027/cannot-use-in-clojurescript-repl)

-(def system nil)
-
-(defn init! []
-  (let [home (System/getProperty "user.home")
-        mydir (format "%s/.navigator" home)
-        args ["--verbose"
-              "--config-path" mydir]
-        [opts conf] (n-core/opts-and-conf-from-args args)]
-    (alter-var-root #'system (constantly (n-core/system conf)))
-    system))
-
-(defn start!
-  "Starts the current development system."
-  []
-  (alter-var-root #'system n-core/start!))
-
-(defn stop!
-  "Shuts down and destroys the current development system."
-  []
-  (alter-var-root #'system
-                  (fn [s] (when s (n-core/stop! s)))))
-
 (defn go
   "Initializes the current development system and starts it running."
   []
-  (init!)
-  (start!))
+  (nt-config/start!))

 (defn reset []
-  (stop!)
+  (nt-config/stop!)
   (refresh :after 'user/go))

-;; Utility fns
-;; -----------------------
-(defn html->hiccup [html]
-  (-> html
-      hickory/parse-fragment
-      (->> (map hickory/as-hiccup))))
+(defn touch-that
+  "Execute the specified query on the current DB and return the
+   results of touching each entity.

-(defn renode
-  "Take a rendered enlive template (html) and turn it back into a seq of enlive nodes"
-  [template]
-  (en/html-snippet (n-tpl/render template)))
+   The first binding must be to the entity.
+   All other bindings are ignored."
+  [query & data-sources]
+  (map #(d/touch
+         (d/entity
+          (d/db (:db-conn nt-config/system))
+          (first %)))
+       (apply d/q query (d/db (:db-conn nt-config/system)) data-sources)))
+
+(defn ptouch-that
+  "Example: (ptouch-that '[:find ?e :where [?e :user/username]])"
+  [query & data-sources]
+  (pprint (apply touch-that query data-sources)))
+
+(comment
+  ;; Utility fns
+  ;; -----------------------
+  (defn html->hiccup [html]
+    (-> html
+        hickory/parse-fragment
+        (->> (map hickory/as-hiccup))))
+
+  (defn renode
+    "Take a rendered enlive template (html) and turn it back into a seq of enlive nodes"
+    [template]
+    (en/html-snippet (n-tpl/render template))))
+


add source maps for less

add source maps for less

--- src/pc/less.clj
+++ src/pc/less.clj
@@ -18,10 +18,15 @@

 (def less-dir "resources/assets/css")
 (def less-file "resources/assets/css/app.css.less")
-(def output-file "resources/public/css/app.css")
+(def output-dir "resources/public/css/")
+(def output-file (str output-dir "app.css"))

 (def lessc-path "node_modules/.bin/lessc")
-(def lessc-options "-x")
+(defn lessc-options [output-file output-dir]
+  (str "-x"
+       " --source-map=" output-file ".map"
+       " --source-map-basepath=" output-dir
+       " --source-map-less-inline"))

 (def watch-opts-cdm
   (into-array WatchEvent$Kind [StandardWatchEventKinds/ENTRY_CREATE
@@ -30,7 +35,7 @@

 (defn compile! [& {:keys [src dest]
                    :or {src less-file dest output-file}}]
-  (let [cmd (format "%s %s %s > %s" lessc-path lessc-options src dest)
+  (let [cmd (format "%s %s %s > %s" lessc-path (lessc-options dest output-dir) src dest)
         res (shell/sh "bash" "-c" cmd)]
     (if (not= 0 (:exit res))
       (throw (Exception. (format "Couldn't compile less with %s returned exit code %s: %s %s" cmd (:exit res) (:out res) (:err res))))


finish clojure version

finish clojure version

--- Nest-List/NL.clj
+++ Nest-List/NL.clj
@@ -1,9 +1,17 @@
 (def testList [1, [3, [2]], [[[5]]]])
 (def testList2 [1, [3, [2], [6, 7]], [[4, [5]]]])

-(defn NL [reLis lis]
-  (cond (empty? lis) reLis
-        (= (first lis) [])
-        (instance? clojure.lang.PersistentVector (first lis))
-        )
-)
+(defn NL [lis]
+  (let [innerList (atom lis)
+        reLis (atom [])]
+    (while (not (empty? @innerList))
+      (let [firstE (first @innerList)]
+        (cond (= firstE [])
+              (reset! innerList (into [] (rest @innerList)))
+              (instance? java.lang.Long firstE)
+              (do (swap! reLis conj firstE)
+                  (reset! innerList (into [] (rest @innerList))))
+              :else
+              (reset! innerList (into [] (concat firstE (rest @innerList))))
+              )))
+    reLis))


linear operator can do op*! even if f! is not provided

--- src/numerics/linear/operator.clj
+++ src/numerics/linear/operator.clj
@@ -11,7 +11,8 @@
             [clojure.core.matrix.operators :refer :all]
             [clojure.core.matrix.linear :as linear]
             [numerics.linear.protocols :refer :all]
-            [numerics.linear.bicg-stab :as bicg]))
+            [numerics.linear.bicg-stab :as bicg]
+            [numerics.utils :refer [unless]]))

 (def ^:dynamic *lin-operator-tol* 1.0e-8)
 (def ^:dynamic *lin-operator-max-count* 20)
@@ -55,7 +56,15 @@
   PLinOperator
   (apply-operator [A u] ((.f A) u))
   PLinOperator!
-  (apply-operator! [A u dest] ((.f! A) u dest))
+  (apply-operator! [A u dest]
+    (if-let [f! (.f! A)]
+      (f! u dest)
+      (let [v ((.f A) u)
+            n (ecount u)]
+        (loop [i 0]
+          (unless (== i n)
+                  (mset! dest i (mget v i))
+                  (recur ^long (inc i)))))))
   PInvLinOperator
   (apply-inversed [A u]
     (bicg/solve (bicg/simple-criteria *lin-operator-tol*


in add-complement-to-bolt, if no index, return null: improves performance and does not affect tests

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -205,9 +205,7 @@
                       pred-set
                       true
                       (intersection-with-identity pred-set cat-set))]
-            (if (not (empty? subset))
-              subset
-              (vals (:lexicon language-model)))))
+            subset))
         bolt-child-synsem (strip-refs (get-in bolt (concat path [:synsem]) :top))
         lexical-complements (lazy-shuffle
                              (filter (fn [lexeme]


revert incorrect change to (defn find-comp-paths)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -438,7 +438,7 @@
                  path)]
       (if (not (empty? path))
         (concat
-         (concat path [:comp])
+         [(vec (concat path [:comp]))]
          (find-comp-paths bolt (rest path)))
         [[:comp]]))))


flatten generate-all a bit

flatten generate-all a bit

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -61,19 +61,18 @@
                               each-path-through-trellis))
                     (apply combo/cartesian-product (vals each-bolt-and-comps)))))
      (map (fn [bolt-and-comps]
-            (log/debug (str "doing defaults on: " depth "/" max-depth ":" ((:morph-ps model) (get bolt-and-comps []))))
-            (do-defaults
-             (apply unify
-                    (let [bolt (get bolt-and-comps [])
-                          bolt-and-comps (dissoc bolt-and-comps [])]
-                      (cons bolt
-                            (map (fn [path]
-                                   (let [result (assoc-in bolt path (get bolt-and-comps path))]
-                                     (if (= true truncate)
-                                       (dissoc-paths result [path])
-                                       result)))
-                                 (keys bolt-and-comps)))))
-             model)))
+            (apply unify
+                   (let [bolt (get bolt-and-comps [])
+                         bolt-and-comps (dissoc bolt-and-comps [])]
+                     (cons bolt
+                           (map (fn [path]
+                                  (let [result (assoc-in bolt path (get bolt-and-comps path))]
+                                    (if (= true truncate)
+                                      (dissoc-paths result [path])
+                                      result)))
+                                (keys bolt-and-comps)))))))
+     (map (fn [expression]
+            (do-defaults expression model)))
      (filter not-fail?)
      (map (fn [final]
             (log/info (str "final: " ((:morph-ps model) final)))


remove support for lists of specs in (defn generate)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -40,49 +40,24 @@
                    :or {max-total-depth max-total-depth
                         truncate-children true}}]
   (let [morph (:morph language-model)]
-    (cond (or (vector? spec)
-              (seq? spec))
-          (let [spec (vec (set spec))]
-            (log/debug (str "generating from " (count spec) " spec(s)"))
-            (let [expression
-                  (first (take 1
-                               (lazy-mapcat (fn [each-spec]
-                                              (log/info (str "generate: generating from spec: "
-                                                             (strip-refs each-spec) " with max-total-depth: " max-total-depth))
-                                              (let [expressions
-                                                    (generate-all each-spec language-model 0
-                                                                  :max-total-depth max-total-depth
-                                                                  :truncate-children truncate-children)]
-                                                expressions))
-                                            spec)))]
-              ;; TODO: show time information
-              (if expression
-                (log/info (str "generate: generated "
-                               "'" (morph expression) "'"
-                               " from " (count spec) " spec(s)"))
-                (log/warn (str "generate: no expression could be generated for any of the "
-                               " from " (count spec) " spec(s)")))
-              expression))
-          true
-          (do
-            (log/info (str "generate: generating from spec: "
-                           (strip-refs spec) " with max-total-depth: " max-total-depth))
-            (let [expression (first (take 1 (generate-all spec language-model 0
-                                                          :max-total-depth max-total-depth
-                                                          :truncate-children truncate-children)))]
-              (if expression
-                (do
-                  (log/info (str "generate: generated "
-                                 "'" (morph expression) "'"
-                                 " for spec:" (strip-refs spec)))
-                  (log/trace (str "generate: generated "
-                                  "'" (morph expression) "';"
-                                  " expr spec: "
-                                  (unifyc
-                                   spec
-                                   {:synsem {:sem (strip-refs (get-in expression [:synsem :sem]))}}))))
-                (log/warn (str "generate: no expression could be generated for spec:" (strip-refs spec))))
-              expression)))))
+    (log/info (str "generate: generating from spec: "
+                   (strip-refs spec) " with max-total-depth: " max-total-depth))
+    (let [expression (first (take 1 (generate-all spec language-model 0
+                                                  :max-total-depth max-total-depth
+                                                  :truncate-children truncate-children)))]
+      (if expression
+        (do
+          (log/info (str "generate: generated "
+                         "'" (morph expression) "'"
+                         " for spec:" (strip-refs spec)))
+          (log/trace (str "generate: generated "
+                          "'" (morph expression) "';"
+                          " expr spec: "
+                          (unifyc
+                           spec
+                           {:synsem {:sem (strip-refs (get-in expression [:synsem :sem]))}}))))
+        (log/warn (str "generate: no expression could be generated for spec:" (strip-refs spec))))
+      expression)))

 (declare add-complements-to-bolts)
 (declare add-all-comps)


(PDB-3251) jdbc: eliminate reflection

(PDB-3251) jdbc: eliminate reflection

--- src/puppetlabs/puppetdb/jdbc.clj
+++ src/puppetlabs/puppetdb/jdbc.clj
@@ -1,6 +1,7 @@
 (ns puppetlabs.puppetdb.jdbc
   "Database utilities"
   (:import (com.zaxxer.hikari HikariDataSource HikariConfig)
+           [java.sql Connection SQLException]
            (java.util.concurrent TimeUnit))
   (:require [clojure.java.jdbc :as sql]
             [clojure.string :as string]
@@ -47,7 +48,7 @@
   (sql/db-do-prepared *db* true (into [sql] params) {:multi? true}))

 (defn do-commands-outside-txn [& commands]
-  (let [conn (:connection *db*)
+  (let [^Connection conn (:connection *db*)
         orig (.getAutoCommit conn)]
     (.setAutoCommit conn true)
     (try
@@ -138,7 +139,7 @@
   ([convert x]
    (cond
      (kitchensink/array? x) (convert x)
-     (isa? (class x) java.sql.Array) (convert (.getArray x))
+     (isa? (class x) java.sql.Array) (convert (.getArray ^java.sql.Array x))
      :else x)))

 (defn call-with-query-rows
@@ -156,7 +157,7 @@
     {:keys [as-arrays? identifiers qualifier read-columns] :as opts}
     f]
    (with-db-transaction []
-     (with-open [stmt (.prepareStatement (:connection *db*) sql)]
+     (with-open [stmt (.prepareStatement ^Connection (:connection *db*) sql)]
        (doall (map-indexed (fn [i param] (.setObject stmt (inc i) param))
                            params))
        (.setFetchSize stmt 500)
@@ -292,7 +293,7 @@
    If there are still retries to perform, returns false."
   [remaining :- s/Int
    current :- s/Int
-   exception]
+   ^SQLException exception]
   (cond
    (zero? remaining)
    (do


[fix 6034] remove "thanks for..." popup on desktop

Signed-off-by: yenda <96f164ad4d9b2b0dacf8ebee2bb1eeb3aa69adf1@status.im>

--- src/status_im/accounts/core.cljs
+++ src/status_im/accounts/core.cljs
@@ -6,12 +6,14 @@
             [status-im.ui.screens.wallet.settings.models :as wallet.settings.models]
             [status-im.utils.config :as config]
             [status-im.utils.utils :as utils]
-            [status-im.utils.fx :as fx]))
+            [status-im.utils.fx :as fx]
+            [status-im.utils.platform :as platform]))

 (fx/defn show-mainnet-is-default-alert [{:keys [db]}]
   (let [enter-name-screen? (= :enter-name (get-in db [:accounts/create :step]))
         shown? (get-in db [:account/account :mainnet-warning-shown?])]
-    (when (and config/mainnet-warning-enabled?
+    (when (and platform/mobile?
+               config/mainnet-warning-enabled?
                (not shown?)
                (not enter-name-screen?))
       (utils/show-popup


cleaning up

cleaning up

--- src/celestial/redis.clj
+++ src/celestial/redis.clj
@@ -21,8 +21,6 @@
     [taoensso.carmine.locks :only (with-lock)]
     [taoensso.timbre :only (debug trace info error warn)])
   (:require
-    [taoensso.nippy :as nippy]
-    [clojure.data.json :as json]
     [taoensso.carmine.message-queue :as carmine-mq]
     [taoensso.carmine :as car])
   (:import java.util.Date))


Changing more funcs to use maps

Changing more funcs to use maps

--- src/wishlistd/models/queries.clj
+++ src/wishlistd/models/queries.clj
@@ -30,16 +30,16 @@
   (sql/with-connection db
 	(sql/insert-records :wishlist wishlist)))

-(defn delete-wishlist [code]
+(defn delete-wishlist [{:keys [code]}]
   (sql/with-connection db
     (sql/delete-rows :wishlist ["code=?" code])))

-(defn get-wishes-for-wishlist [id]
+(defn get-wishes-for-wishlist [{:keys [id]}]
   (sql/with-connection db
     (sql/with-query-results results
 	  ["select * from wish where wishlist=?" id]
-	  (into [] results))))
+	  (first (into [] results)))))

-(defn insert-wish [wish id]
+(defn insert-wish [wish {:keys [id]}]
   (sql/with-connection db
     (sql/insert-records :wish (assoc wish :wishlist id))))


Page stories order fixed

Page stories order fixed

--- src/zerohedgecl/models/pageM.clj
+++ src/zerohedgecl/models/pageM.clj
@@ -198,7 +198,21 @@
         pageid
     )
     page (
-      if (< (count (filter #(= (compare (% :pageid) id) 0 ) @pages )) 1)
+      if (
+        or
+          (< (count (filter #(= (compare (% :pageid) id) 0 ) @pages )) 1)
+          (
+            >
+            (t/in-minutes
+              (t/interval
+                (f/parse  (f/formatters :date-hour-minute-second-ms) (.format (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS") (:downloaded (first (filter #(= (compare (% :pageid) id) 0 ) @pages ) ))))
+                (f/parse  (f/formatters :date-hour-minute-second-ms) (.format (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS") (now)) )
+
+              )
+            )
+            (pagelifetime)
+          )
+        )
         (slurp (str "http://www.zerohedge.com/?page=" id))

     )
@@ -206,10 +220,13 @@

     outarr (into []
         (
-        if (> (count (filter #(= (compare (% :pageid) id) 0 ) @pages )) 0)
-          (
-            if (
-                <
+
+
+          if (
+            or
+              (< (count (filter #(= (compare (% :pageid) id) 0 ) @pages )) 1)
+              (
+                >
                 (t/in-minutes
                   (t/interval
                     (f/parse  (f/formatters :date-hour-minute-second-ms) (.format (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS") (:downloaded (first (filter #(= (compare (% :pageid) id) 0 ) @pages ) ))))
@@ -219,16 +236,10 @@
                 )
                 (pagelifetime)
               )
-
-              (filter #(= (compare (% :pageid) id) 0 ) @pages )
-          )
-
-          (take-last (- (count (map get-introduction (str/split page #"
"))) 1)
-            (map get-introduction (str/split page #"
")))
-
-
-
-
+            )
+              (take-last (- (count (map get-introduction (str/split page #"
"))) 1)
+                (map get-introduction (str/split page #"
")))
+              (reverse(filter #(= (compare (% :pageid) id) 0 ) @pages ))

         )

@@ -251,13 +262,37 @@
             )
             (pagelifetime)
            )
-          )
-          (delete-page-by-number id)
+        )
+
+        (delete-page-by-number id)
+
+
+        ; (doseq [x outarr]
+
+        ;    (swap! pages conj
+
+        ;       ;{:pageid pageid :updated "jhkjh"}
+        ;       {:pageid id :downloaded (now) :updated (:updated x) :introduction (:introduction x) :title (:title x) :reference (:reference x) }
+        ;    )
+        ; )
     )

     (
-      if (< (count (filter #(= (compare (% :pageid) id) 0 ) @pages )) 1)
+      if (or
+           ( < (count (filter #(= (compare (% :pageid) id) 0 ) @pages )) 5)
+           (
+            >
+            (t/in-minutes
+              (t/interval
+                (f/parse  (f/formatters :date-hour-minute-second-ms) (.format (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS") (:downloaded (first (filter #(= (compare (% :pageid) id) 0 ) @pages ) ))))
+                (f/parse  (f/formatters :date-hour-minute-second-ms) (.format (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS") (now)) )
+
+              )
+            )
+            (pagelifetime)
+           )
+        )
         (doseq [x outarr]

            (swap! pages conj


fix polyfill $jscomp scoping issue

fix polyfill $jscomp scoping issue

really need to figure out how to teach the closure-compiler
about our output-wrapper and secondary JS output properly.

--- src/main/shadow/build/targets/browser.clj
+++ src/main/shadow/build/targets/browser.clj
@@ -695,6 +695,30 @@
       state
       build-modules)))

+
+;; closure compiler emits
+;;   var $jscomp=$jscomp||{};
+;; in the output of the compilation containing polyfills
+;; but we wrap the output via :output-wrapper so it is declared in the wrong scope
+;; and not using the one we already set up
+;; need to figure out how to make closure not emit that in the first place
+;; until then just fix is by replacing the code
+(defn fix-jscomp-scoping-issue [{::closure/keys [modules] :as state}]
+  (update state ::closure/modules
+    (fn [modules]
+      (->> modules
+           (map (fn [mod]
+                  (update mod :output str/replace
+                    ;; replace with same length so source maps don't get messed up
+                    ;; we the modules already make sure var $jscomp is declared properly
+                    ;; outside the output-wrapper
+                    "$jscomp=$jscomp||{}"
+                    ;; must not break code semantics, might be in
+                    ;; var $jscomp=$jscomp||{};
+                    ;; var $jscomp=$jscomp||{},
+                    ;; var x=1,$jscomp=$jscomp||{},
+                    "$js_fixpolyscope={}")))))))
+
 (defn flush [state mode {:keys [module-loader module-hash-names] :as config}]
   (-> state
       (cond->
@@ -724,6 +748,7 @@

               (get-in state [:compiler-options :output-wrapper])
               (apply-output-wrapper))
+            (fix-jscomp-scoping-issue)
             (output/flush-optimized)
             (cond->
               module-loader


Implemented pattern parsing

Implemented pattern parsing

--- parser/parser.clj
+++ parser/parser.clj
@@ -24,6 +24,8 @@
                    (FunctionType         (list type) type range))
 (typ constructor   (SimpleConstructor    (list int32) range)
                    (ComplexConstructor   (list int32) (list type) range))
+(typ pattern       (Capture              (list int32) range)
+                   (ConstructorPattern   (list int32) (list pattern) range))
 (typ expression    (IntegerConstant      int32 range)
                    (Identifier           (list int32) range)
                    (Lambda               (list (list int32))
@@ -163,6 +165,19 @@
                               (FunctionApplication expressions range))))
          expressions))

+(def sexp-to-pattern (sexp)
+     (match sexp
+            (List (Cons name rest) range)
+                  (result-flatmap (fn (patterns)
+                  (result-first   (fn (name)
+                                      (ConstructorPattern name patterns range))
+                                (symbol-to-string name)))
+                                (result-of-list (list-map sexp-to-pattern rest)))
+            (List Empty range)
+                  (Error (MalformedExpressionError range))
+            (Symbol name range)
+                  (Result (Capture name range))))
+
 (def sexp-to-match-pair (pair)
      (match pair
             (Pair pattern expression)
@@ -170,7 +185,7 @@
                 (result-first   (fn (expression)
                                     (Pair pattern expression))
                                 (sexp-to-expression expression)))
-                                (sexp-to-expression pattern))))
+                                (sexp-to-pattern pattern))))

 (def collect-pairs (list)
      (match list
@@ -267,6 +282,7 @@

+
 (def type-to-sexp (type)
      (match type
             (SimpleType name range)
@@ -300,10 +316,19 @@
 (def function-arguments-to-sexp (arguments range)
      (List (list-map (fn (name) (Symbol name range)) arguments) range))

+(def pattern-to-sexp (pattern)
+     (match pattern
+            (ConstructorPattern name Empty range)
+                (Symbol name range)
+            (ConstructorPattern name patterns range)
+                (List (Cons (Symbol name range) (list-map pattern-to-sexp patterns)) range)
+            (Capture name range)
+                (Symbol name range)))
+
 (def match-pair-to-sexp (pair)
      (match pair
             (Pair pattern expression)
-               (Cons (expression-to-sexp pattern)
+               (Cons (pattern-to-sexp pattern)
                (Cons (expression-to-sexp expression) Empty))))

 (def expression-to-sexp (expression)


show the account settings link in the aside for customers

was accidentally removed in launching top bar v1, so adding it back
wrapped in a when-not top-bar-v1

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -509,9 +509,17 @@
               [:i.material-icons "group_add"]
               [:div.nav-label "Team"]])

-            [:hr]
-
-           (when (not (ld/feature-on? "top-bar-ui-v-1"))
+           (when-not (ld/feature-on? "top-bar-ui-v-1")
+             [:a.aside-item {:data-placement "right"
+                             :data-trigger "hover"
+                             :title "Account Settings"
+                             :href "/account"}
+              [:i.material-icons "settings"]
+              [:div.nav-label "Account Settings"]])
+
+           [:hr]
+
+           (when-not (ld/feature-on? "top-bar-ui-v-1")
              [:a.aside-item (open-ext {:title "Documentation"
                                        :data-placement "right"
                                        :data-trigger "hover"
@@ -519,7 +527,7 @@
               [:i.material-icons "description"]
               [:div.nav-label "Docs"]])

-           (when (not (ld/feature-on? "top-bar-ui-v-1"))
+           (when-not  (ld/feature-on? "top-bar-ui-v-1")
              [:a.aside-item (merge (common/contact-support-a-info owner)
                                    {:title "Support"
                                     :data-placement "right"
@@ -528,7 +536,7 @@
               [:i.material-icons "chat"]
               [:div.nav-label "Support"]])

-           (when (not (ld/feature-on? "top-bar-ui-v-1"))
+           (when-not (ld/feature-on? "top-bar-ui-v-1")
              (when-not (config/enterprise?)
                [:a.aside-item (open-ext {:data-placement "right"
                                          :data-trigger "hover"
@@ -537,17 +545,17 @@
                 [:i.material-icons "receipt"]
                 [:div.nav-label "Changelog"]]))

-            [:hr]
-
-            (when (:admin user)
-              [:a.aside-item {:data-placement "right"
-                              :data-trigger "hover"
-                              :title "Admin"
-                              :href "/admin"}
+           [:hr]
+
+           (when (:admin user)
+             [:a.aside-item {:data-placement "right"
+                             :data-trigger "hover"
+                             :title "Admin"
+                             :href "/admin"}
                 [:i.material-icons "build"]
                 [:div.nav-label "Admin"]])

-           (when (not (ld/feature-on? "top-bar-ui-v-1"))
+           (when-not (ld/feature-on? "top-bar-ui-v-1")
             [:a.aside-item.push-to-bottom {:data-placement "right"
                                            :data-trigger "hover"
                                            :title "Logout"


Introduce the notion of function references that can be either symbols or vars

--- src/midje/internal_ideas/fakes.clj
+++ src/midje/internal_ideas/fakes.clj
@@ -68,8 +68,15 @@
   (throw (user-error "It's likely you misparenthesized your metaconstant prerequisite,"
                      "or that you forgot to use an arrow in your provided form.")))

-(def #^:private disallowed-prerequisite-functions-that-cannot-be-dynamically-detected
-     #{'deref})
+
+(defn #^:private
+  statically-disallowed-prerequisite-function
+  "To prevent people from mocking functions that Midje itself uses,
+   we mostly rely on dynamic checking. But there are functions within
+   the dynamic checking code that must also not be replaced. These are
+   the ones that are known."
+  [some-var]
+  (#{#'deref} some-var))

 (defn #^:private
   raise-disallowed-prerequisite-error [function-name]
@@ -87,8 +94,33 @@
     "  (provided (all-even? ..xs..) => true)")))

-(letfn [(make-fake-map [call-form arrow rhs var-sym special-to-fake-type user-override-pairs]
-          (let [common-to-all-fakes `{:var (var ~var-sym)
+
+;; Function references. These are usually symbols but are sometimes vars.
+;; This isn't a collection because I don't want to allow vars in some cases
+;; that call common code.
+(defn classify-function-reference [reference]
+  ;; Not sure we're supposed to depend on java.lang.Symbol
+  (if (symbol? reference) :symbol :var))
+
+(defmulti fnref-symbol classify-function-reference)
+(defmethod fnref-symbol :symbol [reference] reference)
+
+(defmulti fnref-var classify-function-reference)
+(defmethod fnref-var :symbol [reference]
+  ((ns-map *ns*) reference))
+
+(defmulti fnref-call-form classify-function-reference)
+(defmethod fnref-call-form :symbol [reference]
+  `(var ~reference))
+
+(defmulti fnref-callable classify-function-reference)
+(defmethod fnref-callable :symbol [reference] reference)
+
+
+
+
+(letfn [(make-fake-map [call-form arrow rhs fnref special-to-fake-type user-override-pairs]
+          (let [common-to-all-fakes `{:var ~(fnref-call-form fnref)
                                       :call-count-atom (atom 0)
                                       :position (user-file-position)

@@ -101,18 +133,19 @@
               special-to-fake-type
               (apply hash-map-duplicates-ok user-override-pairs)))) ]

-  (defn fake* [ [[var-sym & args :as call-form] arrow result & overrides] ]
+  (defn fake* [ [[fnref & args :as call-form] arrow result & overrides] ]
     ;; The (vec args) keeps something like (...o...) from being
     ;; evaluated as a function call later on. Right approach would
     ;; seem to be '~args. That causes spurious failures. Debug
     ;; someday.
-    (when (disallowed-prerequisite-functions-that-cannot-be-dynamically-detected var-sym)
-      (raise-disallowed-prerequisite-error var-sym))
+    (when (statically-disallowed-prerequisite-function (fnref-var fnref))
+      (raise-disallowed-prerequisite-error (fnref-var fnref)))
     (make-fake-map call-form arrow (cons result overrides)
-      var-sym
+      fnref
       `{:arg-matchers (map midje.internal-ideas.fakes/arg-matcher-maker ~(vec args))
         :call-text-for-failures (str '~call-form)
-        :value-at-time-of-faking (if (bound? (var ~var-sym)) ~var-sym)
+        :value-at-time-of-faking (if (bound? ~(fnref-call-form fnref))
+                                   ~(fnref-callable fnref))
         :result-supplier (fn-fake-result-supplier ~arrow ~result)
         :type :fake}
       overrides))


⚡ Use pre-calculated lookup indexes for creatable and deletable

Why:
- Changes the algorithm from O(n) to O(1).

--- src/territory_bro/todo_tracker.clj
+++ src/territory_bro/todo_tracker.clj
@@ -8,6 +8,15 @@
 (defn merge-state [m k new-state]
   (update-in m [::todo k ::state] merge new-state))

+(def ^:private conj-set (fnil conj #{}))
+
+(declare get)
+(defn- update-indexes [m k]
+  (let [action (:action (get m k))]
+    (-> m
+        (update ::creatable (if (= :create action) conj-set disj) k)
+        (update ::deletable (if (= :delete action) conj-set disj) k))))
+
 (defn- assert-presence [presence]
   (assert (or (= :present presence)
               (= :absent presence))
@@ -15,11 +24,15 @@

 (defn set-desired [m k presence]
   (assert-presence presence)
-  (assoc-in m [::todo k ::desired] presence))
+  (-> m
+      (assoc-in [::todo k ::desired] presence)
+      (update-indexes k)))

 (defn set-actual [m k presence]
   (assert-presence presence)
-  (assoc-in m [::todo k ::actual] presence))
+  (-> m
+      (assoc-in [::todo k ::actual] presence)
+      (update-indexes k)))

 (defn get [m k]
   (let [{::keys [state desired actual]
@@ -33,13 +46,9 @@
                :ignore)}))

 (defn creatable [m]
-  (->> (keys (::todo m))
-       (map #(get m %))
-       (filter #(= :create (:action %)))
-       (map :state)))
+  (->> (::creatable m)
+       (map #(get-in m [::todo % ::state]))))

 (defn deletable [m]
-  (->> (keys (::todo m))
-       (map #(get m %))
-       (filter #(= :delete (:action %)))
-       (map :state)))
+  (->> (::deletable m)
+       (map #(get-in m [::todo % ::state]))))


missing defstate added

missing defstate added

--- src/cerber/oauth2/standalone/config.clj
+++ src/cerber/oauth2/standalone/config.clj
@@ -2,7 +2,7 @@
   (:require [cprop.core :as cprop]
             [cprop.source :refer [from-env from-resource from-system-props]]
             [failjure.core :as f]
-            [mount.core :as mount]))
+            [mount.core :as mount :refer [defstate]]))

 (defn load-resource
   "Loads single configuration resource.


Add missing deprecation comment

Add missing deprecation comment

--- src/clj/lambdacd/internal/execution.clj
+++ src/clj/lambdacd/internal/execution.clj
@@ -299,6 +299,7 @@
 (defn execute-steps [steps args ctx & {:keys [step-result-producer is-killed unify-status-fn unify-results-fn retrigger-predicate]
                                        :or   {step-result-producer (serial-step-result-producer)
                                               is-killed            (atom false)
+                                              ; unify-status-fn is DEPRECATED since 0.9.4
                                               unify-status-fn      status/successful-when-all-successful
                                               unify-results-fn     nil ; dependent on unify-status-fn, can't have it here for now
                                               retrigger-predicate  sequential-retrigger-predicate}}]


Remove debug call

Remove debug call

--- src/clj_chrome_devtools/impl/define.clj
+++ src/clj_chrome_devtools/impl/define.clj
@@ -62,8 +62,6 @@
                                     :error error#}))
                    (:result result#)))))))))

-(define-command-functions "Page")
-
 (comment
   ;; To regenerate the command namespaces, run this
   (doseq [{:keys [domain description]} (proto/all-domains)]


fix link to home

fix link to home

--- src/cljs/daveconservatoire/site/ui.cljs
+++ src/cljs/daveconservatoire/site/ui.cljs
@@ -295,7 +295,7 @@
               (dom/span #js {:className "icon-bar"})
               (dom/span #js {:className "icon-bar"})
               (dom/span #js {:className "icon-bar"}))
-            (dom/a #js {:className "brand mobilenav" :href "http://daveconservatoire.org"}
+            (link {:className "brand mobilenav", ::r/handler ::r/home}
               (dom/span #js {:className "mobiledc"} "Dave Conservatoire"))
             (dom/div #js {:className "nav-collapse navbar-responsive-collapse collapse"
                           :id        "mainfoldout"


cleanup editor

cleanup editor

--- src/cljs/swarmpit/component/editor.cljs
+++ src/cljs/swarmpit/component/editor.cljs
@@ -9,14 +9,14 @@
   (js/CodeMirror.fromTextArea
     (.getElementById js/document editor-id)
     (clj->js
-      {:lineNumbers       true
-       :viewportMargin    (.-Infinity js/window)
-       :matchBrackets     true
-       :autofocus         true
-       :autoCloseBrackets true
-       :gutters           ["CodeMirror-lint-markers"]
-       :lint              true
-       :mode              editor-mode})))
+      {:lineNumbers        true
+       :viewportMargin     (.-Infinity js/window)
+       :matchBrackets      true
+       :autofocus          true
+       :autoCloseBrackets  true
+       :gutters            ["CodeMirror-lint-markers"]
+       :lint               true
+       :mode               editor-mode})))

 (defn yaml
   [editor-id]


Add alignment to resize.

Add alignment to resize.

--- src/uxbox/ui/workspace/resize.cljs
+++ src/uxbox/ui/workspace/resize.cljs
@@ -10,7 +10,8 @@
             [uxbox.rstore :as rs]
             [uxbox.data.shapes :as uds]
             [uxbox.ui.core :as uuc]
-            [uxbox.ui.workspace.base :as uuwb]
+            [uxbox.ui.workspace.base :as wb]
+            [uxbox.ui.workspace.align :as align]
             [uxbox.util.geom.point :as gpt]))

 (declare initialize)
@@ -33,11 +34,21 @@
         stoper (->> uuc/actions-s
                     (rx/map :type)
                     (rx/filter #(empty? %))
-                    (rx/take 1))]
-    (as-> uuwb/mouse-delta-s $
-      (rx/take-until stoper $)
-      (rx/with-latest-from vector uuwb/mouse-ctrl-s $)
-      (rx/subscribe $ #(handle-resize payload %)))))
+                    (rx/take 1))
+
+        align? @wb/alignment-l
+        stream (->> wb/mouse-viewport-s
+                    (rx/sample 10)
+                    (rx/mapcat (fn [point]
+                                 (if align?
+                                   (align/translate point)
+                                   (rx/of point))))
+                    (rx/buffer 2 1)
+                    (rx/map wb/coords-delta)
+                    (rx/take-until stoper)
+                    (rx/map #(gpt/divide % @wb/zoom-l))
+                    (rx/with-latest-from vector wb/mouse-ctrl-s))]
+    (rx/subscribe stream #(handle-resize payload %))))

 (defn- handle-resize
   [{:keys [vid shape]} [delta ctrl?]]


Remove not needed require.

Remove not needed require.

--- src/oc/storage/util/migrate_bookmarks.clj
+++ src/oc/storage/util/migrate_bookmarks.clj
@@ -12,19 +12,11 @@

   Use -s/--self-only to create bookmarks only for self created follow-ups."

-  (:require [clojure.string :as s]
-            [rethinkdb.query :as r]
-            [clojure.walk :refer (keywordize-keys)]
+  (:require [rethinkdb.query :as r]
             [clojure.tools.cli :refer (parse-opts)]
-            [defun.core :refer (defun-)]
             [oc.lib.db.migrations :as m]
-            [clj-http.client :as http]
-            [cheshire.core :as json]
-            [clj-time.core :as t]
-            [clj-time.format :as f]
             [oc.lib.db.pool :as db]
             [oc.lib.db.common :as db-common]
-            [oc.storage.resources.common :as common]
             [oc.storage.resources.entry :as entry]
             [oc.storage.resources.org :as org]
             [oc.storage.config :as c])


fix cluster?

fix cluster?

--- src/edu/berkeley/ai/scripts/cluster.clj
+++ src/edu/berkeley/ai/scripts/cluster.clj
@@ -25,7 +25,7 @@
 	(apply util/sh
 	 (concat ["qsub" "-N" name]
 		*default-qsub-options*
-		[:in (str *default-clj* " "f) :dir (dirname f)]))))))
+		[:in (str *default-clj* " "f) :dir (util/dirname f)]))))))

 (defn run-experiment-set-subprocesses [es]
   (run-files-subprocesses


CLJS-1037: cls.analyzer/ns-dependents fails for common cases

Showing failing test case

--- test/clj/cljs/analyzer_tests.clj
+++ test/clj/cljs/analyzer_tests.clj
@@ -287,3 +287,31 @@

     (is (= (meta (:name (a/analyze ns-env '(ns ^{:foo bar} weeble {:foo baz}))))
            {:foo 'baz}))))
+
+(def test-deps-env (atom
+                    {:cljs.analyzer/namespaces
+                     {'file-reloading {:requires {'utils 'utils}}
+                      'core           {:requires {'file-reloading 'file-reloading}}
+                      'dev            {:requires {'client 'client
+                                                  'core 'core}}
+                      'client         {:requires {'utils 'utils}}
+                      'utils          {:requires {}}}}))
+
+(deftest test-ns-dependents
+  (binding [env/*compiler* test-deps-env]
+    (is (= (set (a/ns-dependents 'client))
+           #{'dev}))
+    (is (= (set (a/ns-dependents 'core))
+           #{'dev}))
+    (is (= (set (a/ns-dependents 'dev))
+           #{}))
+
+    ;; if 'file-reloading returns 'core
+    (is (= (set (a/ns-dependents 'file-reloading))
+           #{'dev 'core}))
+
+    ;; how can 'utils include 'file-reloading but not 'core
+    ;; FAILS with
+    ;; actual: (not (= #{file-reloading dev client} #{file-reloading dev client core}))
+    (is (= (set (a/ns-dependents 'utils))
+           #{'file-reloading 'dev 'client 'core}))))


Add a test cleanup util

Add a test cleanup util

--- test/doctopus/test_utilities.clj
+++ test/doctopus/test_utilities.clj
@@ -1,5 +1,6 @@
 (ns doctopus.test-utilities
   (:require [clojure.test :refer :all]
+            [doctopus.storage :refer [remove-from-storage backend]]
             [doctopus.test-utilities :refer :all])
   (:import [org.joda.time DateTime]
            [org.joda.time.format DateTimeFormat]))
@@ -10,3 +11,7 @@
   []
   (let [today (DateTime.)]
     (.print iso-formatter today)))
+
+(defn clean-up-test-html
+  [k]
+  (remove-from-storage backend k))


Fixed sum fn.

Fixed sum fn.

--- test/onyx/peer/grouping_test.clj
+++ test/onyx/peer/grouping_test.clj
@@ -30,8 +30,7 @@
   name)

 (defn sum-balance [state {:keys [name amount] :as segment}]
-  (prn "State: " state " :: " segment)
-  (swap! state (fn [v] (assoc v name (+ (get v :name 0) amount))))
+  (swap! state (fn [v] (assoc v name (+ (get v name 0) amount))))
   [])

 (def workflow {:in {:group-by-name {:sum-balance :out}}})
@@ -100,14 +99,14 @@

 (onyx.api/submit-job conn {:catalog catalog :workflow workflow})

-(def results (hq-util/read! hq-config out-queue (inc (count data)) 1))
+#_(def results (hq-util/read! hq-config out-queue (inc (count data)) 1))

-(doseq [v-peer v-peers]
-        (try
-          ((:shutdown-fn v-peer))
-          (catch Exception e (prn e))))
+#_(doseq [v-peer v-peers]
+  (try
+    ((:shutdown-fn v-peer))
+    (catch Exception e (prn e))))

-(try
+#_(try
   (onyx.api/shutdown conn)
   (catch Exception e (prn e)))


Remove temporary code

Remove temporary code

--- test/photon/current/sql_test.clj
+++ test/photon/current/sql_test.clj
@@ -1,19 +0,0 @@
-(ns photon.current.sql-test
-  (:require [photon.sql :as sql]
-            [midje.sweet :refer :all]))
-
-(fact "SELECT WITH not allowed"
-      (sql/execute "WITH dept_count AS (SELECT e.name AS employee_name FROM emp e) SELECT a.* FROM events a;")
-      => (throws UnsupportedOperationException))
-
-(fact "INSERT not allowed"
-      (sql/execute "INSERT INTO events VALUES(1,2,3)")
-      => (throws AbstractMethodError))
-
-(fact "UPDATE not allowed"
-      (sql/execute "UPDATE events SET a = 1")
-      => (throws AbstractMethodError))
-
-(fact "DELETE not allowed"
-      (sql/execute "DELETE events")
-      => (throws AbstractMethodError))


remove not used test

remove not used test

--- test/sushi_machine/core_test.clj
+++ test/sushi_machine/core_test.clj
@@ -1,7 +0,0 @@
-(ns sushi-machine.core-test
-  (:require [clojure.test :refer :all]
-            [sushi-machine.core :refer :all]))
-
-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))


Cleanup

Cleanup

--- src/tailrecursion/boot/middleware/jar.clj
+++ src/tailrecursion/boot/middleware/jar.clj
@@ -35,9 +35,7 @@
   (printf "Adding '%s' to jar.\n" (.getPath src))
   (if (.isDirectory src)
     (doall (map (partial add! target base) (.listFiles src)))
-    (let [target (doto target (.putNextEntry (make-entry base src)))]
-      (write! target src)
-      (.closeEntry target))))
+    (doto target (.putNextEntry (make-entry base src)) (write! src) (.closeEntry))))

 (defn jar [handler]
   (fn [spec]


Improve algorithm, it was swapping too many times

--- clojure/anagrams.clj
+++ clojure/anagrams.clj
@@ -6,10 +6,11 @@
     (println (apply str v))

     (loop [i 0 a v]
-      (if (<= i n)
+      (if (< i n)
         (do
           (generatePermutations a (dec n))
-          (recur (inc i) (swap a (if (even? n) i 0) n)))))))
+          (recur (inc i) (swap a (if (even? n) i 0) n)))
+        (generatePermutations a (dec n))))))

 (if (not= (count *command-line-args*) 1)
   (do


Fix connection failed screen

Fix connection failed screen

--- src/robinson/ui/components/robinson.clj
+++ src/robinson/ui/components/robinson.clj
@@ -1763,7 +1763,9 @@
             [:view {:style {:width "100%" :height "100%" :background-color (rcolor/color->rgb :black)}} [
               [:view {:style {:position :absolute
                               :top 10
-                              :left 36}} [
+                              :left 34
+                              :width 80
+                              :height 24}} [
                 [:text {} ["Connection Failed."]]
                 [:text {} [""]]
                 [:text {} [[:text {} ["Play again? ["]]


Updating qsort driver for demo.

Updating qsort driver for demo.

--- viz/qsort/driver.clj
+++ viz/qsort/driver.clj
@@ -5,7 +5,8 @@

 (comment
-  (use 'qsort.driver)
+  (require 'qsort.driver)
+  (def server (vdd/start-viz))
   (viz-qsort (shuffle (range 50)))
 )


Properly attach z-position metadata to triggered z-stacks

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -126,6 +126,7 @@
       })))

 (defn annotate-image [img event state elapsed-time-ms]
+  (println (:tags img))
   {:pix (:pix img)
    :tags
    (merge
@@ -238,9 +239,9 @@
     (println slice-sequence relative-z)
     (let [z (core getFocusDevice)
           ref (@state :reference-z)
-          adjusted-slices (if relative-z
-                            (map #(+ ref %) slice-sequence)
-                            slice-sequence)
+          adjusted-slices (vec (if relative-z
+                                 (map #(+ ref %) slice-sequence)
+                                 slice-sequence))
           new-seq (not= [z adjusted-slices] @active-slice-sequence)]
       (println "adjusted-slices: " adjusted-slices ";" "reference-z" (@state :reference-z))
       (when new-seq
@@ -281,21 +282,25 @@
 (defn collect-burst-images [event out-queue]
   (when (first-trigger-missing?) (pop-burst-image)) ; drop first image if first trigger doesn't happen
   (swap! state assoc :burst-time-offset nil)
-  (dorun
-    (map-indexed
-      (fn [i evt]
-        (when-not (@state :stop)
-          (let [image (pop-burst-image)]
-            (when (zero? i)
-              (swap! state assoc
-                     :burst-time-offset (- (elapsed-time @state)
-                                           (core-time-from-tags (image :tags)))))
-            (.put out-queue (make-TaggedImage (annotate-image image evt @state
-                                                              (burst-time (:tags image) @state)))))
-          (when (core isBufferOverflowed)
-            (swap! state assoc :stop true)
-            (ReportingUtils/showError "Circular buffer overflowed."))))
-      (event :burst-data)))
+  (let [slices (second @active-slice-sequence)]
+    (println "slices: " slices)
+    (dorun
+      (map-indexed
+        (fn [i evt]
+          (when-not (@state :stop)
+            (let [image (pop-burst-image)
+                  image+ (if-not slices image (assoc-in image [:tags "ZPositionUm"] (get slices i)))]
+              (println image+)
+              (when (zero? i)
+                (swap! state assoc
+                       :burst-time-offset (- (elapsed-time @state)
+                                             (core-time-from-tags (image :tags)))))
+              (.put out-queue (make-TaggedImage (annotate-image image+ evt @state
+                                                                (burst-time (:tags image) @state)))))
+            (when (core isBufferOverflowed)
+              (swap! state assoc :stop true)
+              (ReportingUtils/showError "Circular buffer overflowed."))))
+        (event :burst-data))))
   (while (and (not (@state :stop)) (. mmc isSequenceRunning))
     (Thread/sleep 5)))


make sure we get through all images

make sure we get through all images

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -331,30 +331,31 @@
         camera-index (str (core getCameraDevice) "-CameraChannelIndex")
         camera-channel-count (core getNumberOfCameraChannels)
         bursts-per-camera-channel (vec (repeat camera-channel-count burst-events))]
-    (doall (loop [burst-seqs bursts-per-camera-channel i 0]
-             (let [image (pop-burst-image)
-                   cam-chan (if-let [cam-chan-str (get-in image [:tags camera-index])]
-                              (Long/parseLong cam-chan-str)
-                              0)
-                   event (first (burst-seqs cam-chan))]
-               (println i ": " cam-chan ": " event)
-               (when (zero? i)
-                 (swap! state assoc
-                        :burst-time-offset (- (elapsed-time @state)
-                                              (core-time-from-tags (image :tags)))))
-               (when (and (not (@state :stop))
-                          (core isBufferOverflowed))
-                 (swap! state assoc
-                        :stop true
-                        :circular-buffer-overflow true))
-               (if (and (not (@state :stop))
-                        (not (apply = nil burst-seqs))
-                        (or (pos? (core getRemainingImageCount))
-                            (core isSequenceRunning)))
-                 (let [event+ (update-in event [:channel-index] make-multicamera-channel cam-chan)]
-                   (.put out-queue (make-TaggedImage (annotate-image image event+ @state (burst-time (:tags image) @state))))
-                   (recur (update-in burst-seqs [cam-chan] next) (inc i)))
-                 nil)))))
+    (doall
+      (loop [burst-seqs bursts-per-camera-channel i 0]
+        (if (and (not (@state :stop))
+                 (not (apply = nil burst-seqs))
+                 (or (pos? (core getRemainingImageCount))
+                     (core isSequenceRunning)))
+          (let [image (pop-burst-image)
+                cam-chan (if-let [cam-chan-str (get-in image [:tags camera-index])]
+                           (Long/parseLong cam-chan-str)
+                           0)
+                event (first (burst-seqs cam-chan))]
+            (println i ": " cam-chan ": " event)
+            (when (zero? i)
+              (swap! state assoc
+                     :burst-time-offset (- (elapsed-time @state)
+                                           (core-time-from-tags (image :tags)))))
+            (when (and (not (@state :stop))
+                       (core isBufferOverflowed))
+              (swap! state assoc
+                     :stop true
+                     :circular-buffer-overflow true))
+            (let [event+ (update-in event [:channel-index] make-multicamera-channel cam-chan)]
+              (.put out-queue (make-TaggedImage (annotate-image image event+ @state (burst-time (:tags image) @state))))
+              (recur (update-in burst-seqs [cam-chan] next) (inc i))))
+          nil))))
   (burst-cleanup)) ;; burst is done!

 (defn collect-snap-image [event out-queue]


Minor ns reorg in colors page namespace.

--- src/uxbox/main/ui/dashboard/colors.cljs
+++ src/uxbox/main/ui/dashboard/colors.cljs
@@ -6,28 +6,26 @@
 ;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

 (ns uxbox.main.ui.dashboard.colors
-  (:require [sablono.core :refer-macros [html]]
-            [rum.core :as rum]
-            [cuerdas.core :as str]
+  (:require [cuerdas.core :as str]
             [lentes.core :as l]
+            [uxbox.main.data.colors :as dc]
+            [uxbox.main.data.dashboard :as dd]
+            [uxbox.main.data.lightbox :as udl]
+            [uxbox.main.library :as library]
+            [uxbox.main.state :as st]
+            [uxbox.main.ui.colorpicker :refer (colorpicker)]
+            [uxbox.main.ui.dashboard.header :refer (header)]
+            [uxbox.main.ui.forms :as form]
+            [uxbox.main.ui.icons :as i]
+            [uxbox.main.ui.keyboard :as k]
+            [uxbox.main.ui.lightbox :as lbx]
+            [uxbox.util.color :refer (hex->rgb)]
+            [uxbox.util.dom :as dom]
             [uxbox.util.i18n :as t :refer (tr)]
-            [uxbox.main.state :as st]
+            [uxbox.util.lens :as ul]
+            [uxbox.util.mixins :as mx]
             [uxbox.util.rstore :as rs]
-            [uxbox.util.schema :as sc]
-            [uxbox.main.library :as library]
-            [uxbox.main.data.dashboard :as dd]
-            [uxbox.main.data.colors :as dc]
-            [uxbox.main.data.lightbox :as udl]
-            [uxbox.main.ui.icons :as i]
-            [uxbox.main.ui.forms :as form]
-            [uxbox.main.ui.lightbox :as lbx]
-            [uxbox.main.ui.colorpicker :refer (colorpicker)]
-            [uxbox.util.mixins :as mx]
-            [uxbox.main.ui.dashboard.header :refer (header)]
-            [uxbox.main.ui.keyboard :as k]
-            [uxbox.util.dom :as dom]
-            [uxbox.util.lens :as ul]
-            [uxbox.util.color :refer (hex->rgb)]))
+            [uxbox.util.schema :as sc]))

 ;; --- Refs

@@ -52,7 +50,7 @@
 ;; --- Page Title

 (mx/defcs page-title
-  {:mixins [(rum/local {}) mx/static mx/reactive]}
+  {:mixins [(mx/local {}) mx/static mx/reactive]}
   [own {:keys [id] :as coll}]
   (let [local (:rum/local own)
         dashboard (mx/react dashboard-ref)
@@ -192,7 +190,7 @@
   [type selected]
   (let [own? (= type :own)
         builtin? (= type :builtin)
-        collections (cond->> (rum/react collections-ref)
+        collections (cond->> (mx/react collections-ref)
                       own? (filter #(= :own (:type %)))
                       builtin? (filter #(= :builtin (:type %)))
                       own? (sort-by :id))]
@@ -212,7 +210,7 @@
   {:mixins [mx/static mx/reactive]}
   []
   (let [dashboard (mx/react dashboard-ref)
-        collections (rum/react collections-ref)
+        collections (mx/react collections-ref)
         selected (:id dashboard)
         type (:type dashboard)
         own? (= type :own)
@@ -265,7 +263,7 @@
 ;; --- Colors Lightbox (Component)

 (mx/defcs color-lightbox
-  {:mixins [(rum/local {}) mx/static]}
+  {:mixins [(mx/local {}) mx/static]}
   [own {:keys [coll color]}]
   (let [local (:rum/local own)]
     (letfn [(on-submit [event]


~(defn prepare-array): turn down logging when using default type (text) for annotating array elements

--- src/babel/korma.clj
+++ src/babel/korma.clj
@@ -47,14 +47,18 @@
               {:type "jsonb"
                :map-fn json/write-str}

+              ;; TODO: add support integers or other types. On the other hand,
+              ;; it seems to work fine to use {:type "text"} for integers, so no need to do
+              ;; any additional work for them here.
+
               true
               (do
                 (if (not (empty? sequence))
-                  (log/info (str "using default of 'text' as SQL type for"
-                                 " sequence of type:" (type sequence)
-                                 (str " whose first member is of type:"
-                                      (type (first sequence)))
-                                 ".")))
+                  (log/debug (str "using default of 'text' as SQL type for"
+                                  " sequence of type:" (type sequence)
+                                  (str " whose first member is of type:"
+                                       (type (first sequence)))
+                                  ".")))
                 {:type "text"
                  :map-fn (fn [x] x)}))
         sql-type (:type sql-type-and-map-fn)


formatting

formatting

--- src/carry/core.cljc
+++ src/carry/core.cljc
@@ -29,17 +29,20 @@
        (f @r))

      IWatchable
-     (-add-watch [this key callback]
+     (-add-watch
+       [this key callback]
        (add-watch r
                   [this key]
                   (fn [_key _ref old-state new-state]
                     (callback key this (f old-state) (f new-state)))))

-     (-remove-watch [this key]
+     (-remove-watch
+       [this key]
        (remove-watch r [this key]))

      IPrintWithWriter
-     (-pr-writer [this writer _opts]
+     (-pr-writer
+       [this writer _opts]
        (-write writer (str "#<Entangled reference: " @this ">")))))

 (alter-meta! #'->-EntangledReference assoc :no-doc true)
@@ -82,4 +85,5 @@
     (letfn [(dispatch-action [action] (reset! model-atom (reconcile @model-atom action)) nil)
             (dispatch-signal [signal] (control read-only-model-atom signal dispatch-signal dispatch-action) nil)]
       {:model           read-only-model-atom
+       :-model          model-atom
        :dispatch-signal dispatch-signal})))


Fix matrix/probemap cgdata to use :rows.

--- src/cgdata/core.clj
+++ src/cgdata/core.clj
@@ -173,7 +173,7 @@
       {:field (String. ^String (first cols)) ; copy, because split is evil.
        :feature feature
        :valueType "float"
-       :scores (mapv parseFloatNA (rest cols))}) ; eager
+       :rows (mapv parseFloatNA (rest cols))}) ; eager
     (catch NumberFormatException e
       (data-line features cols "category"))))

@@ -209,7 +209,7 @@
     {:field (String. ^String name) ; copy the string. string/split is evil.
      :feature feature
      :valueType "category"
-     :scores vals}))
+     :rows vals}))

 (defmulti matrix-data
   "Return seq of scores, probes X samples"
@@ -315,7 +315,7 @@
      [{:field "name"
        :valueType "category"
        :feature probe-feature
-       :scores probe-vals}
+       :rows probe-vals}
       {:field "position"
        :valueType "position"
        :rows (map #(select-keys % [:chrom :chromStart :chromEnd :strand]) columns)}


Add line separator.

Add line separator.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -151,6 +151,7 @@
         adjusted-prompt-string (str "\u001B[" (- height alternate-height) ";0H"
                                     "\u001B[2K"
                                     prompt-string
+                                    "\u001B[" (- height alternate-height 1) ";0H" (apply str (repeat width "\u203E"))
                                     "\u001B[1;" (- height alternate-height 2) "r"
                                     "\u001B[" (- height alternate-height) ";" (+ prompt-width 1) "H")]
 	(print (str "\u001B[2J\u001B[1;" (- height alternate-height 2) "r"))


Removing schema from stream row view

Removing schema from stream row view

--- src-cljs/photon/ui/frontend.cljs
+++ src-cljs/photon/ui/frontend.cljs
@@ -419,7 +419,7 @@
                                         :active-stream (val %)))}
                          (val %))
                        (val %)))
-                  (:stream data))))))
+                  (dissoc (:stream data) :schema))))))

 (defn widget-streams [data owner]
   (reify


Use a double-column layout.

Use a double-column layout.

--- src/airhead_frontend/components.cljs
+++ src/airhead_frontend/components.cljs
@@ -140,7 +140,7 @@

 (defn library-section []
   (let [tracks (@app-state :library)]
-    [:section#library
+    [:section#library.pure-u-1-2
      [:h2 "Library"]
      [search-form]
      [:table.tracks
@@ -156,9 +156,10 @@
 ;; Main

 (defn page-component []
-  [:main
-   [header]
-   [player-section]
-   [upload-section]
-   [playlist-section]
+ [:main
+   [:div.pure-u-1-2
+     [header]
+     [player-section]
+     [upload-section]
+     [playlist-section]]
    [library-section]])


by host searching

by host searching

--- test/celestial/integration/es/systems.clj
+++ test/celestial/integration/es/systems.clj
@@ -15,7 +15,7 @@
    []
   (sys/initialize)
   (sys/put "1" (assoc redis-prox-spec :owner "admin"))
-  (sys/put "2" redis-ec2-spec)
+  (sys/put "2" (assoc-in redis-ec2-spec [:machine :hostname] "foo-1" ))
   (sys/put "3" (assoc redis-ec2-spec :env :prod-1))
   (sys/put "4" redis-prox-spec :flush? true)
   )
@@ -43,6 +43,12 @@
    (fact "find proxmox systems for su user" :integration :elasticsearch
        (total (sys/systems-for "admin" {:bool {:must {:term {:machine.cpus "4" }}}} 0 5)) => 2)

+   (fact "find by hostname" :integration :elasticsearch
+       (total (sys/systems-for "admin" {:bool {:must {:term {:machine.hostname "red1" }}}} 0 5)) => 2
+       (total (sys/systems-for "admin" {:bool {:must [{:term {:machine.hostname "foo-1" }}]}} 0 5)) => 1
+
+         )
+
    (fact "find proxmox systems for non su user" :integration :elasticsearch
       (total (sys/systems-for "ronen" {:bool {:must {:term {:machine.cpus "4" }}}} 0 5)) => 1)


Add docstrings to dsl ns

Add docstrings to dsl ns

--- src/clj/precept/dsl.clj
+++ src/clj/precept/dsl.clj
@@ -1,9 +1,11 @@
 (ns precept.dsl)

 (defmacro entity
- [e]
- `['(clara.rules.accumulators/all) :from ['~e :all]])
+  "Accumulates all facts for entity with eid `e`"
+  [e]
+  `['(clara.rules.accumulators/all) :from ['~e :all]])

 (defmacro <-
- [fact-binding form]
- `(into ['~fact-binding '~'<-] ~form))
+  "Binds the result of `form` to `fact-binding`"
+  [fact-binding form]
+  `(into ['~fact-binding '~'<-] ~form))


simplify PersistentVector -kv-reduce, no more mutating local arrays just use more loop bindings. Use the exact same logic for -reduce instead of delegating to ci-reduce. Significant performance boost when reducing vectors.

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -4108,30 +4108,41 @@

   IReduce
   (-reduce [v f]
-    (ci-reduce v f))
-  (-reduce [v f start]
-    (ci-reduce v f start))
+    (-reduce v f (f)))
+  (-reduce [v f init]
+    (loop [i 0 step 0 init init]
+      (if (< i cnt)
+        (let [arr (unchecked-array-for v i)
+              len (alength arr)]
+          (let [init (loop [j 0 init init]
+                       (if (< j len)
+                         (let [init (f init (aget arr j))]
+                           (if (reduced? init)
+                             init
+                             (recur (inc j) init)))
+                         init))]
+            (if (reduced? init)
+              @init
+              (recur (+ i len) len init))))
+        init)))

   IKVReduce
   (-kv-reduce [v f init]
-    (let [step-init (array 0 init)] ; [step 0 init init]
-      (loop [i 0]
-        (if (< i cnt)
-          (let [arr (unchecked-array-for v i)
-                len (alength arr)]
-            (let [init (loop [j 0 init (aget step-init 1)]
-                         (if (< j len)
-                           (let [init (f init (+ j i) (aget arr j))]
-                             (if (reduced? init)
-                               init
-                               (recur (inc j) init)))
-                           (do (aset step-init 0 len)
-                               (aset step-init 1 init)
-                               init)))]
-              (if (reduced? init)
-                @init
-                (recur (+ i (aget step-init 0))))))
-          (aget step-init 1)))))
+    (loop [i 0 step 0 init init]
+      (if (< i cnt)
+        (let [arr (unchecked-array-for v i)
+              len (alength arr)]
+          (let [init (loop [j 0 init init]
+                       (if (< j len)
+                         (let [init (f init (+ j i) (aget arr j))]
+                           (if (reduced? init)
+                             init
+                             (recur (inc j) init)))
+                         init))]
+            (if (reduced? init)
+              @init
+              (recur (+ i len) len init))))
+        init)))

   IFn
   (-invoke [coll k]


reduced handling fixes, same as https://github.com/clojure/clojure/commit/eccff113e7d68411d60f7204711ab71027dc5356

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -781,6 +781,16 @@
   "Returns true if x is the result of a call to reduced"
   [r]
   (instance? Reduced r))
+
+(defn ensure-reduced
+  "If x is already reduced?, returns it, else returns (reduced x)"
+  [x]
+  (if (reduced? x) x (reduced x)))
+
+(defn unreduced
+  "If x is reduced?, returns (deref x), else returns x"
+  [x]
+  (if (reduced? x) (deref x) x))

 ;; generic to all refs
 ;; (but currently hard-coded to atom!)
@@ -3590,7 +3600,7 @@
                              (rf result input)
                              result)]
                 (if (not (pos? nn))
-                  (reduced result)
+                  (ensure-reduced result)
                   result)))))))
   ([n coll]
      (lazy-seq
@@ -7441,7 +7451,7 @@
                            (let [v (vec (.toArray a))]
                              ;;clear first!
                              (.clear a)
-                             (rf result v)))]
+                             (unreduced (rf result v))))]
               (rf result)))
          ([result input]
             (.add a input)
@@ -7660,7 +7670,7 @@
                              (let [v (vec (.toArray a))]
                                ;;clear first!
                                (.clear a)
-                               (rf result v)))]
+                               (unreduced (rf result v))))]
                 (rf result)))
            ([result input]
               (let [pval @pa


increase clojars badge field size

increase clojars badge field size

--- src/clojars/web/jar.clj
+++ src/clojars/web/jar.clj
@@ -198,7 +198,7 @@
           (link-to {:target "_blank"} (version-badge-url jar) "latest version")
           " of your project on Github? Use the markdown code below!"]
          [:textarea#version-badge
-          {:readonly "readonly" :rows 4 :onClick "selectText('version-badge')"}
+          {:readonly "readonly" :rows 6 :onClick "selectText('version-badge')"}
           (badge-markdown jar)]]]])))

 (defn show-versions [account jar versions]


Return config function for setting attributes to an existing widget

--- src/clojure/neko/ui.clj
+++ src/clojure/neko/ui.clj
@@ -99,3 +99,10 @@
      (make-ui-element context/context tree {}))
   ([context tree]
      (make-ui-element context tree {})))
+
+(defn config
+  "Takes a widget and key-value pairs of attributes, and applies these
+  attributes to the widget."
+  [widget & {:as attributes}]
+  (apply-attributes (kw/keyword-by-classname (type widget))
+                    widget attributes {}))


Use referenced sequence strings when a reference file is specified

--- src/clojure/cljam/pileup/mpileup.clj
+++ src/clojure/cljam/pileup/mpileup.clj
@@ -4,8 +4,6 @@
             [cljam.sequence :as cseq]
             [cljam.io :as io]
             [cljam.fasta :as fa]
-            [cljam.util :refer [ubyte]]
-            [cljam.util.sam-util :refer [phred->fastq fastq->phred]]
             [cljam.pileup.common :refer [window-width step center]]
             [cljam.pileup.pileup :refer [rpositions]])
   (:import cljam.fasta.FASTAReader))
@@ -57,12 +55,40 @@

 (defrecord ^:private PileupStatus [count seq qual])

+(defn- ref-wrap
+  "Modify sequence strings to referenced version.
+  e.g. ({:n 2, :op \\M :seq [\\T \\A]} ...)
+       => ({:n 2, :op \\M :seq [\\. \\.] :pos 7} ...)"
+  [seq* ref-seq left]
+  (let [positioned-seq (loop [ret     []
+                              [f & r] seq*
+                              pos     left]
+                         (if (nil? f)
+                           ret
+                           (recur (conj ret (assoc f :pos pos))
+                                  r
+                                  (if-not (nil? (#{\M \D \N \= \X} (:op f)))
+                                    (+ pos (count (:seq f)))
+                                    pos))))]
+    (map (fn [s]
+           (if-not (nil? (#{\M \D \N \= \X} (:op s)))
+             (update-in s [:seq] (partial map-indexed
+                                          (fn [idx itm]
+                                            (if (= itm (nth ref-seq (+ (dec (:pos s)) idx)))
+                                              \.
+                                              itm))))
+             s))
+         positioned-seq)))
+
 (defn- count-for-alignment
-  [aln rname positions]
+  [aln ref-seq rname positions]
   (if (= rname (:rname aln))
     (let [left  (:pos aln)
           right (dec (+ left (cgr/count-ref (:cigar aln))))
-          seq*  (encode-seq (cseq/parse (:seq aln) (:cigar aln)))]
+          seq** (cseq/parse (:seq aln) (:cigar aln))
+          seq*  (encode-seq (if (nil? ref-seq)
+                              seq**
+                              (ref-wrap seq** ref-seq left)))]
       (map (fn [p]
              (if (<= left p right)
                (PileupStatus. 1 (nth seq* (- p left)) (pickup-qual aln (- p left)))
@@ -70,32 +96,32 @@
     (repeat (count positions) (PileupStatus. 0 nil nil))))

 (defn- pickup-ref
-  [ref-line pos]
-  (if (nil? ref-line)
+  [ref-seq pos]
+  (if (nil? ref-seq)
     \N
     (let [idx (dec pos)]
       (if (neg? idx)
         \N
-        (if-let [ref (nth (:seq ref-line) idx)]
+        (if-let [ref (nth ref-seq idx)]
           ref
           \N)))))

 (defn- count-for-positions
   [alns ref-line rname positions]
   (if (pos? (count alns))
-    (let [cfas (map #(count-for-alignment % rname positions) alns)
+    (let [cfas (map #(count-for-alignment % (:seq ref-line) rname positions) alns)
           plp1 (apply map (fn [& a]
                             {:rname rname
                              :count (reduce + (map :count a))
                              :seq   (str/join (map :seq a))
                              :qual  (str/join (map :qual a))}) cfas)]
-      (map #(assoc %2 :pos %1 :ref (pickup-ref ref-line %2))
+      (map #(assoc %2 :pos %1 :ref (pickup-ref (:seq ref-line) %1))
            positions plp1))
     (let [plp1 (repeat (count positions) {:rname rname
                                           :count 0
                                           :seq   nil
                                           :qual  nil})]
-      (map #(assoc %2 :pos %1 :ref (pickup-ref ref-line %2))
+      (map #(assoc %2 :pos %1 :ref (pickup-ref (:seq ref-line) %1))
            positions plp1))))

 (defn- read-alignments
@@ -116,8 +142,8 @@
 (defn- read-ref-fasta-line
   [fa-rdr rname]
   (if-not (nil? fa-rdr)
-   (first
-    (filter #(= (:rname %) rname) (fa/read fa-rdr)))))
+    (first
+     (filter #(= (:rname %) rname) (fa/read fa-rdr)))))

 (defn- search-ref
   [refs rname]


CMR-663: Added message.

CMR-663: Added message.

--- src/cmr/common/services/messages.clj
+++ src/cmr/common/services/messages.clj
@@ -63,4 +63,12 @@
   "Creates a message saying supplied option is not allowed for parameter."
   [param option]
   (str "Option [" (csk/->snake_case_string option)
-       "] is not supported for param [" (csk/->snake_case_string param) "]"))+       "] is not supported for param [" (csk/->snake_case_string param) "]"))
+
+(defn mixed-arity-parameter-msg
+  "Creates a message saying the given parameter should not appear as both a single value and
+  a multivalue."
+  [param]
+  (str "Parameter ["
+       (csk/->snake_case_string param)
+       "] may be either single valued or multivalued, but not both."))


Remove tap

Remove tap

--- test/com/wsscode/pathom/system_test.clj
+++ test/com/wsscode/pathom/system_test.clj
@@ -167,7 +167,6 @@
                                            :mutate     pt/mutate-fn})

           {:keys [async-reader] :as env} (cond-> env errors? (assoc ::pt/throw-errors? true))]
-      #nu/tapd
       [(catch-run-parser parser env query)
        (catch-run-parser (comp <!! async-parser) (assoc env ::p/reader async-reader) query)
        (catch-run-parser fulcro-parser env query)]))


fix typo in test

fix typo in test

--- test/freecoin/journey/activitystreams.clj
+++ test/freecoin/journey/activitystreams.clj
@@ -40,7 +40,7 @@
             [midje.sweet :refer :all]
             [simple-time.core :as time]
             [stonecutter-oauth.client :as soc]))
-`
+
 (ih/setup-db)

 (def stores-m (s/create-mongo-stores (ih/get-test-db)))


thread title, url and author

thread title, url and author

--- src/bonews_rest/scraper/forums.clj
+++ src/bonews_rest/scraper/forums.clj
@@ -15,10 +15,15 @@
       (utils/fetch-url)
       (html/select [:div#phorum :table])))

+(defn get-thread-author
+  [col]
+  (let [title-node (html/select col [[:a (html/attr? :href)]])]
+  (first (first (rest (last (last title-node)))))))

 (defn get-thread-title
   [col]
-  (html/select col [:h4 [:a (html/attr? :content)]]))
+  (let [title-node (html/select col [:h4 [:a (html/attr? :href)]])]
+  (first (first (rest (first (rest (rest (first title-node)))))))))

 (defn get-thread-url
   [col]
@@ -29,8 +34,9 @@
   [row]
   (let [cols (rest (html/select row [:td]))
         thread-title (get-thread-title (first cols))
-        thread-url (get-thread-url (first cols))]
-  {:url thread-url}))
+        thread-url (get-thread-url (first cols))
+        thread-author (get-thread-author (first cols))]
+  {:url thread-url :title thread-title :author thread-author}))

 (defn get-rows
   [table]


add transform to bold *starred* words

add transform to bold *starred* words

--- src/chat/client/views/helpers.cljs
+++ src/chat/client/views/helpers.cljs
@@ -110,6 +110,10 @@
   (make-delimited-processor {:delimiter "`"
                              :result-fn (partial dom/code #js {:className "inline-code"})}))

+(def extract-emphasized
+  (make-delimited-processor {:delimiter "*"
+                             :result-fn (partial dom/strong #js {:className "starred"})}))
+
 (defn format-message
   "Given the text of a message body, turn it into dom nodes, making urls into
   links"
@@ -120,7 +124,7 @@
                                    tag-replace
                                    emoji-shortcodes-replace
                                    emoji-ascii-replace))
-        statefull-transform (comp extract-code-blocks extract-code-inline)]
+        statefull-transform (comp extract-code-blocks extract-code-inline extract-emphasized)]
     (->> (into [] (comp statefull-transform stateless-transform) (string/split text #" "))
          (interleave (repeat " "))
          rest)))


Whitespace

Whitespace

--- src/circle/backend/build/email.clj
+++ src/circle/backend/build/email.clj
@@ -62,8 +62,6 @@
                          project-name)]
     (send-hipchat-message project message)))

-
-
 (defn notify-build-results [build]
   (ruby/require-rails)
   (ruby/ruby-require :build)


Moved code

Moved code


Implement cloud breaker

Implement cloud breaker

--- src/clj/game/cards-icebreakers.clj
+++ src/clj/game/cards-icebreakers.clj
@@ -30,6 +30,20 @@
                               :run-ends breaker-auto-pump :ice-strength-changed breaker-auto-pump
                               :breaker-strength-changed breaker-auto-pump :approach-ice breaker-auto-pump })))

+(defn cloud-icebreaker [cdef]
+  (assoc cdef :effect (req (add-watch state (keyword (str "cloud" (:cid card)))
+                        (fn [k ref old new]
+                          (when (and (< (get-in old [:runner :link]) 2)
+                                     (> (get-in new [:runner :link]) 1))
+                            (gain state :runner :memory (:memoryunits card)))
+                          (when (and (> (get-in old [:runner :link]) 1)
+                                     (< (get-in new [:runner :link]) 2))
+                            (gain state :runner :memory (* -1 (:memoryunits card)))))))
+              :leave-play (req (remove-watch state (keyword (str "cloud" (:cid card))))
+                               (when (> (get-in @state [:runner :link]) 1)
+                                 (lose state :runner :memory (:memoryunits card))))
+              :install-cost-bonus (req (if (> (get-in @state [:runner :link]) 1) [:memory (* -1 (:memoryunits card))]))))
+
 (def cards-icebreakers
   {"Alpha"
    (auto-icebreaker ["All"]
@@ -103,16 +117,17 @@
                                  {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]})

    "Creeper"
-   (auto-icebreaker ["Sentry"]
-                    {:abilities [{:cost [:credit 2] :msg "break 1 sentry subroutine"}
-                                 {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]})
+   (cloud-icebreaker
+     (auto-icebreaker ["Sentry"]
+                      {:abilities [{:cost [:credit 2] :msg "break 1 sentry subroutine"}
+                                   {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]}))

    "Crowbar"
-   {:abilities [{:msg "break up to 3 code gate subroutines" :effect (effect (trash card {:cause :ability-cost}))}]
-    :events (let [cloud {:req (req (has? target :subtype "Icebreaker"))
-                         :effect (effect (update-breaker-strength card))}]
-              {:runner-install cloud :trash cloud :card-moved cloud})
-    :strength-bonus (req (count (filter #(has? % :subtype "Icebreaker") (all-installed state :runner))))}
+   (cloud-icebreaker {:abilities [{:msg "break up to 3 code gate subroutines" :effect (effect (trash card {:cause :ability-cost}))}]
+                      :events (let [cloud {:req (req (has? target :subtype "Icebreaker"))
+                                           :effect (effect (update-breaker-strength card))}]
+                                {:runner-install cloud :trash cloud :card-moved cloud})
+                      :strength-bonus (req (count (filter #(has? % :subtype "Icebreaker") (all-installed state :runner))))})

    "Crypsis"
    (auto-icebreaker ["All"]
@@ -198,19 +213,22 @@
                                  {:cost [:credit 2] :msg "add 3 strength" :effect (effect (pump card 3)) :pump 3}]})

    "GS Sherman M3"
-   (auto-icebreaker ["Barrier"]
-                    {:abilities [{:cost [:credit 2] :msg "break any number of barrier subroutines"}
-                                 {:cost [:credit 2] :msg "add 3 strength" :effect (effect (pump card 3)) :pump 3}]})
+   (cloud-icebreaker
+     (auto-icebreaker ["Barrier"]
+                      {:abilities [{:cost [:credit 2] :msg "break any number of barrier subroutines"}
+                                   {:cost [:credit 2] :msg "add 3 strength" :effect (effect (pump card 3)) :pump 3}]}))

    "GS Shrike M2"
-   (auto-icebreaker ["Sentry"]
-                    {:abilities [{:cost [:credit 2] :msg "break any number of sentry subroutines"}
-                                 {:cost [:credit 2] :msg "add 3 strength" :effect (effect (pump card 3)) :pump 3}]})
+   (cloud-icebreaker
+     (auto-icebreaker ["Sentry"]
+                      {:abilities [{:cost [:credit 2] :msg "break any number of sentry subroutines"}
+                                   {:cost [:credit 2] :msg "add 3 strength" :effect (effect (pump card 3)) :pump 3}]}))

    "GS Striker M1"
-   (auto-icebreaker ["Code Gate"]
-                    {:abilities [{:cost [:credit 2] :msg "break any number of code gate subroutines"}
-                                 {:cost [:credit 2] :msg "add 3 strength" :effect (effect (pump card 3)) :pump 3}]})
+   (cloud-icebreaker
+     (auto-icebreaker ["Code Gate"]
+                      {:abilities [{:cost [:credit 2] :msg "break any number of code gate subroutines"}
+                                   {:cost [:credit 2] :msg "add 3 strength" :effect (effect (pump card 3)) :pump 3}]}))

    "Inti"
    (auto-icebreaker ["Barrier"]
@@ -299,18 +317,18 @@
                                  {:cost [:credit 1] :msg "add 2 strength" :effect (effect (pump card 2)) :pump 2}]})

    "Shiv"
-   {:abilities [{:msg "break up to 3 sentry subroutines" :effect (effect (trash card {:cause :ability-cost}))}]
-    :events (let [cloud {:req (req (has? target :subtype "Icebreaker"))
-                         :effect (effect (update-breaker-strength card))}]
-              {:runner-install cloud :trash cloud :card-moved cloud})
-    :strength-bonus (req (count (filter #(has? % :subtype "Icebreaker") (all-installed state :runner))))}
+   (cloud-icebreaker {:abilities [{:msg "break up to 3 sentry subroutines" :effect (effect (trash card {:cause :ability-cost}))}]
+                      :events (let [cloud {:req (req (has? target :subtype "Icebreaker"))
+                                           :effect (effect (update-breaker-strength card))}]
+                                {:runner-install cloud :trash cloud :card-moved cloud})
+                      :strength-bonus (req (count (filter #(has? % :subtype "Icebreaker") (all-installed state :runner))))})

    "Spike"
-   {:abilities [{:msg "break up to 3 barrier subroutines" :effect (effect (trash card {:cause :ability-cost}))}]
-    :events (let [cloud {:req (req (has? target :subtype "Icebreaker"))
-                         :effect (effect (update-breaker-strength card))}]
-              {:runner-install cloud :trash cloud :card-moved cloud})
-    :strength-bonus (req (count (filter #(has? % :subtype "Icebreaker") (all-installed state :runner))))}
+   (cloud-icebreaker {:abilities [{:msg "break up to 3 barrier subroutines" :effect (effect (trash card {:cause :ability-cost}))}]
+                      :events (let [cloud {:req (req (has? target :subtype "Icebreaker"))
+                                           :effect (effect (update-breaker-strength card))}]
+                                {:runner-install cloud :trash cloud :card-moved cloud})
+                      :strength-bonus (req (count (filter #(has? % :subtype "Icebreaker") (all-installed state :runner))))})

    "Study Guide"
    {:abilities [{:cost [:credit 1] :msg "break 1 code gate subroutine"}
@@ -346,6 +364,7 @@
    {:abilities [{:msg "break 1 code gate subroutine"}]}

    "ZU.13 Key Master"
-   (auto-icebreaker ["Code Gate"]
-                    {:abilities [{:cost [:credit 1] :msg "break 1 code gate subroutine"}
-                                 {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]})})
+   (cloud-icebreaker
+     (auto-icebreaker ["Code Gate"]
+                      {:abilities [{:cost [:credit 1] :msg "break 1 code gate subroutine"}
+                                   {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]}))})


Add a set-token function to history ns

Add a set-token function to history ns

--- src/cljs/comic_reader/history.cljs
+++ src/cljs/comic_reader/history.cljs
@@ -20,3 +20,6 @@
           (dispatch! (.-token event))))
       (doto hist
         (.setEnabled true)))))
+
+(defn set-token [token]
+  (.setToken @goog-history (str token)))


BUG FIX

BUG FIX

--- src/cljs/om_next_leaflet/core.cljs
+++ src/cljs/om_next_leaflet/core.cljs
@@ -99,12 +99,12 @@
           lines-layer (get-lines-layer this)
           lines-chan (chan)]
       (leaflet/init-station-markers stations-layer stations)
-      (leaflet/init-polylines lines-layer lines)
       (go-loop []
         (let [data (<! lines-chan)]
           (if (= (:result data) :success)
             (let [lines-data (:data data)]
-              (om/transact! this `[(app/update-lines {:new-lines ~lines-data}) :app/lines]))
+              ;; (om/transact! this `[(app/update-lines {:new-lines ~lines-data}) :app/lines])
+              (leaflet/init-polylines lines-layer lines-data))
             ;; TODO: error handling
             )
           (recur)))


threading macro

threading macro

--- src/cljs/tictactoe/logic/turn.cljs
+++ src/cljs/tictactoe/logic/turn.cljs
@@ -62,6 +62,6 @@
   "Convert a cell to the player color and switch player"
   [turn coord]
   (if-not (or (game-over? turn) (invalid-move? turn coord))
-    (update
-      (update turn :board board/convert-cell (:player turn) coord)
-      :player next-player)))
+    (-> turn
+      (update :board board/convert-cell (:player turn) coord)
+      (update :player next-player))))


Rewrite the REPL reloader

Rewrite the REPL reloader

--- src/clojure/nightcode/builders.clj
+++ src/clojure/nightcode/builders.clj
@@ -38,12 +38,17 @@

 (defn eval-in-repl
   [console path timestamp]
-  (doseq [code (if-let [selected (editors/get-editor-selected-text)]
-                 [selected]
-                 (for [source (-> (lein/read-project-clj path)
-                                  (lein/stale-clojure-sources timestamp))]
-                   (str (slurp source) " nil")))]
-    (->> (str "(do " (clojure.string/replace code "\n" " ") ")")
+  (let [source-paths (-> (lein/read-project-clj path)
+                         (lein/stale-clojure-sources timestamp))
+        contents (for [source-path source-paths]
+                   (slurp source-path))
+        names (for [source-path source-paths]
+                (.getName (io/file source-path)))]
+    (->> (format "(do %s\n\"%s\")"
+                 (clojure.string/join "\n" contents)
+                 (clojure.string/join ", " names))
+         read-string
+         pr-str
          (.enterLine console)))
   (s/request-focus! (-> console .getViewport .getView)))


Fix indentation for testutils/with-puppet-conf-files

--- test/integration/puppetlabs/testutils.clj
+++ test/integration/puppetlabs/testutils.clj
@@ -103,37 +103,37 @@
   (count (filter #(catalog-contains? % resource-type resource-title) catalogs)))

 (schema/defn ^:always-validate with-puppet-conf-files
-             "Test fixture; Accepts a map with the following characteristics:
+  "Test fixture; Accepts a map with the following characteristics:

-             * keys are simple filenames (no paths) that will be created in puppet's $confdir
-             * values are paths to a test-specific file that should be copied to puppet's confdir,
-               a la `$confdir/<key>`.
+  * keys are simple filenames (no paths) that will be created in puppet's $confdir
+  * values are paths to a test-specific file that should be copied to puppet's confdir,
+    a la `$confdir/<key>`.

-             For each entry in the map, copies the files into $confdir, runs the test function,
-             and then deletes all of the files from $confdir.
+  For each entry in the map, copies the files into $confdir, runs the test function,
+  and then deletes all of the files from $confdir.

-             Optionally accepts a second argument `dest-dir`, which specifies the location
-             of Puppet's $confdir.  If this argument is not provided, defaults to
-             `testutils/conf-dir`."
-             ([puppet-conf-files]
-              (with-puppet-conf-files puppet-conf-files conf-dir))
-             ([puppet-conf-files :- {schema/Str (schema/pred (some-fn string? #(instance? File %)))}
-               dest-dir :- schema/Str]
+  Optionally accepts a second argument `dest-dir`, which specifies the location
+  of Puppet's $confdir.  If this argument is not provided, defaults to
+  `testutils/conf-dir`."
+  ([puppet-conf-files]
+   (with-puppet-conf-files puppet-conf-files conf-dir))
+  ([puppet-conf-files :- {schema/Str (schema/pred (some-fn string? #(instance? File %)))}
+    dest-dir :- schema/Str]

-              (let [target-paths (reduce
-                                  (fn [acc filename]
-                                    (assoc acc filename (fs/file dest-dir filename)))
-                                  {}
-                                  (keys puppet-conf-files))]
-                (fn [f]
-                  (doseq [filename (keys puppet-conf-files)]
-                    (fs/copy+ (get puppet-conf-files filename)
-                              (get target-paths filename)))
-                  (try
-                    (f)
-                    (finally
-                      (doseq [target-path (vals target-paths)]
-                        (fs/delete target-path))))))))
+   (let [target-paths (reduce
+                       (fn [acc filename]
+                         (assoc acc filename (fs/file dest-dir filename)))
+                       {}
+                       (keys puppet-conf-files))]
+     (fn [f]
+       (doseq [filename (keys puppet-conf-files)]
+         (fs/copy+ (get puppet-conf-files filename)
+                   (get target-paths filename)))
+       (try
+         (f)
+         (finally
+           (doseq [target-path (vals target-paths)]
+             (fs/delete target-path))))))))

 (defn with-puppet-conf
   "This function returns a test fixture that will copy a specified puppet.conf


Fix percent format.

Fix percent format.

--- src/oc/storage/representations/org.clj
+++ src/oc/storage/representations/org.clj
@@ -332,7 +332,7 @@
                             (s/join "\n" [(str "Title: " (:headline entry))
                                           (str "Published on: " (lib-time/csv-date-time (:published-at entry) user-tz))
                                           (str "Link: " (:url entry))
-                                          (str "Reads: " reads-count " of " (count csv-users) (when reads-percent " (" reads-percent ")"))
+                                          (str "Reads: " reads-count " of " (count csv-users) (when reads-percent (str " (" reads-percent ")")))
                                           "-"
                                           "Name, Email, Read"
                                           (s/join "\n"


Simplify link creation for digest with replacements map.

--- src/oc/storage/representations/org.clj
+++ src/oc/storage/representations/org.clj
@@ -79,8 +79,8 @@
    :replace {:author-uuid "$0"}))

 (defn- digest-partial-link [org]
-  (assoc (hateoas/link-map "digest" hateoas/GET (str (url org) "/digest?direction=after&start=$0") {:accept mt/entry-collection-media-type})
-   :replace {:start "$0"}))
+  (hateoas/link-map "digest" hateoas/GET (str (url org) "/digest?direction=after&start=$0") {:accept mt/entry-collection-media-type
+                                                                                :replace {:start "$0"}}))

 (defn secure-url [org-slug secure-uuid] (str (url org-slug) "/entries/" secure-uuid))


make fns in resources.company take explicit conn arg

--- src/open_company/resources/company.clj
+++ src/open_company/resources/company.clj
@@ -64,13 +64,13 @@

 (defn taken-slugs
   "Return all slugs which are in use as a set."
-  []
-  (into reserved-slugs (map :slug (list-companies))))
+  [conn]
+  (into reserved-slugs (map :slug (list-companies conn))))

 (defn slug-available?
   "Return true if the slug is not used by any company in the database."
-  [slug]
-  (not (contains? (taken-slugs) slug)))
+  [conn slug]
+  (not (contains? (taken-slugs conn) slug)))

 ;; ----- Validations -----

@@ -81,9 +81,9 @@

 (defn get-company
   "Given the slug of the company, retrieve it from the database, or return nil if it doesn't exist."
-  [slug]
+  [conn slug]
   {:pre [(string? slug)]}
-  (common/read-resource table-name slug))
+  (common/read-resource conn table-name slug))

 (defn- core-placeholder-sections
   "Return a map of section-name -> section containing just the core
@@ -157,15 +157,16 @@

 (schema/defn ->company :- common/Company
   "Take a minimal map describing a company and a user and 'fill the blanks'"
-  [company-props user]
-  (let [slug (or (:slug company-props) (slug/find-available-slug (:name company-props) (taken-slugs)))]
-    (-> company-props
-        (assoc :slug slug)
-        (update :currency #(or % "USD"))
-        (assoc :org-id (:org-id user))
-        (complete-real-sections user)
-        (categories-for)
-        (sections-for))))
+  ([company-props user]
+   (->company company-props user (:slug company-props)))
+  ([company-props user slug]
+   (-> company-props
+       (assoc :slug slug)
+       (update :currency #(or % "USD"))
+       (assoc :org-id (:org-id user))
+       (complete-real-sections user)
+       (categories-for)
+       (sections-for))))

 (schema/defn ^:private add-updated-at
   "Add `:updated-at` key with `ts` as value to a given section.
@@ -177,13 +178,13 @@

 (schema/defn ^:always-validate create-company!
   "Create a company document in RethinkDB. Add `updated-at` keys where necessary."
-  [company :- common/Company]
+  [conn company :- common/Company]
   (let [real-sections (real-sections company)
         ts (common/current-timestamp)
         rs-w-ts (med/map-vals #(add-updated-at % ts) real-sections)]
     (doseq [[_ section] real-sections]
-      (common/create-resource common/section-table-name section ts))
-    (common/create-resource table-name (merge company rs-w-ts) ts)))
+      (common/create-resource conn common/section-table-name section ts))
+    (common/create-resource conn table-name (merge company rs-w-ts) ts)))

 (defn update-company
   "
@@ -192,9 +193,9 @@
   TODO: handle case of slug change.
   TODO: handle new and updated sections.
   "
-  [slug company]
+  [conn slug company]
   {:pre [(string? slug) (map? company)]}
-  (if-let [original-company (get-company slug)]
+  (if-let [original-company (get-company conn slug)]
     (let [org-id (:org-id company)
           updated-company (-> company
                             (clean)
@@ -202,60 +203,62 @@
                             (remove-sections)
                             (assoc :org-id org-id)
                             (assoc :slug slug))]
-      (common/update-resource table-name primary-key original-company updated-company))))
-
-(defun put-company
+      (common/update-resource conn table-name primary-key original-company updated-company))))
+
+(defn put-company
   "Given the slug of the company and a company property map, create or update the company
   and return `true` on success.
   TODO: handle case of slug mismatch between URL and properties.
   TODO: handle case of slug change."
-  ([slug :guard get-company company _user] (update-company slug company))
-  ([_slug company user] (create-company! (->company company user))))
+  [conn slug company user]
+  (if (get-company conn slug)
+    (update-company conn slug company)
+    (create-company! conn (->company company user))))

 (defn delete-company
   "Given the slug of the company, delete it and all its sections and return `true` on success."
-  [slug]
+  [conn slug]
   {:pre [(string? slug)]}
   (try
-    (common/delete-resource common/section-table-name :company-slug slug)
+    (common/delete-resource conn common/section-table-name :company-slug slug)
     (catch java.lang.RuntimeException e)) ; it's OK if there are no sections to delete
   (try
-    (common/delete-resource table-name slug)
+    (common/delete-resource conn table-name slug)
     (catch java.lang.RuntimeException e))) ; it's OK if there is no company to delete

 ;; ----- Company revisions -----

 (defn list-revisions
   "Given the slug of the company retrieve the timestamps and author of the revisions from the database."
-  [slug]
+  [conn slug]
   {:pre [(string? slug)]}
   (common/updated-at-order
-    (common/read-resources common/section-table-name "company-slug" slug [:updated-at :author])))
+    (common/read-resources conn common/section-table-name "company-slug" slug [:updated-at :author])))

 ;; ----- Collection of companies -----

 (defn list-companies
   "Return a sequence of company property maps with slugs and names, sorted by slug.
   Note: if additional-keys are supplied only documents containing those keys will be returned"
-  ([] (list-companies []))
-  ([additional-keys]
+  ([conn] (list-companies conn []))
+  ([conn additional-keys]
     (->> (into [primary-key "name"] additional-keys)
-      (common/read-resources table-name)
+      (common/read-resources conn table-name)
       (sort-by primary-key)
       vec)))

 (defn get-companies-by-index
   "Given the name of a secondary index and a value, retrieve all matching companies"
   ;; e.g.: (get-companies-by-index "org-id" "slack:T06SBMH60")
-  [index-key v]
+  [conn index-key v]
   {:pre [(string? index-key)]}
-  (common/read-resources table-name index-key v))
+  (common/read-resources conn table-name index-key v))

 ;; ----- Armageddon -----

 (defn delete-all-companies!
   "Use with caution! Failure can result in partial deletes of sections and companies. Returns `true` if successful."
-  []
+  [conn]
   ;; Delete all sections and all companies
-  (common/delete-all-resources! common/section-table-name)
-  (common/delete-all-resources! table-name))+  (common/delete-all-resources! conn common/section-table-name)
+  (common/delete-all-resources! conn table-name))


Fix typo in `hierarchy`

Fix typo in `hierarchy`

--- test/puppetlabs/kitchensink/core_test.clj
+++ test/puppetlabs/kitchensink/core_test.clj
@@ -81,7 +81,7 @@
           (is (= :io-error (without-ns (:type m))))
           (is (contains? m :message))
           (is (re-find #"foo/bar' is a file" (:message m)))))))
-  (testing "Permission denied on some directory in the heirarchy"
+  (testing "Permission denied on some directory in the hierarchy"
     (let [tmpdir (testutils/temp-dir)]
       (fs/mkdirs (fs/file tmpdir "foo"))
       (fs/chmod "-w" (fs/file tmpdir "foo"))


Update scala_test.clj

Update scala_test.clj

--- test/swagger_gen/rendering/scala_test.clj
+++ test/swagger_gen/rendering/scala_test.clj
@@ -21,5 +21,4 @@
 (deftest test-render-case-class
   (testing "should render a Scala case class"
     (is (= model1-expected (render-case-class model1)))
-    (is (= model2-expected (render-case-class model2)))
-    ))
+    (is (= model2-expected (render-case-class model2)))))


updated deps

updated deps

--- project.clj
+++ project.clj
@@ -22,7 +22,7 @@
                    :dependencies
                    [[org.clojure/test.check "0.10.0-alpha3"]
                     [dda/pallet "0.9.0" :classifier "tests"]
-                    [dda/dda-pallet-commons "1.3.1" :classifier "tests"]
+                    [dda/dda-pallet-commons "1.4.0" :classifier "tests"]
                     [ch.qos.logback/logback-classic "1.3.0-alpha4"]
                     [org.slf4j/jcl-over-slf4j "1.8.0-beta2"]]
                    :plugins


bump version

bump version

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject twarc "0.1.13"
+(defproject twarc "0.1.14"
   :description "Doing Quartz the right way"
   :url "https://github.com/prepor/twarc"
   :license {:name "Eclipse Public License",


Update postgresql driver

Update postgresql driver

--- project.clj
+++ project.clj
@@ -5,7 +5,7 @@
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.7.0"]
                  [org.clojure/java.jdbc "0.4.1"]
-                 [postgresql "9.1-901.jdbc4"]
+                 [org.postgresql/postgresql "9.4-1202-jdbc42"]
                  [ring/ring-jetty-adapter "1.2.1"]
                  [compojure "1.1.6"]
                  [hiccup "1.0.4"]


update alia / hayt

update alia / hayt

--- project.clj
+++ project.clj
@@ -34,9 +34,9 @@
                  [potemkin "0.4.3"]
                  [prismatic/plumbing "0.5.3"]
                  [clj-time "0.12.0"]
-                 [cc.qbits/alia "3.1.10"]
-                 [cc.qbits/alia-manifold "3.1.4"]
-                 [cc.qbits/hayt "3.1.0"]
+                 [cc.qbits/alia "3.2.0"]
+                 [cc.qbits/alia-manifold "3.2.0"]
+                 [cc.qbits/hayt "3.2.0"]
                  [environ "1.1.0"]
                  [drift "1.5.3"]
                  [manifold "0.1.5"]