better npm installs, faster reruns

better npm installs, faster reruns

--- src/lwhorton/boot_stylus/core.clj
+++ src/lwhorton/boot_stylus/core.clj
@@ -42,14 +42,14 @@
         prev (atom nil)]
     (c/with-pre-wrap [fileset]
       (let [diff (c/fileset-diff @prev fileset :hash)
-            stylus-exec (first (c/by-re [#"^node_modules/\.bin/stylus"] (c/input-files fileset)))
-            _ (println "exec" stylus-exec)
-            stylus (.getPath (c/tmp-file stylus-exec))
+            ;; find the stylus executable in our fileset, then run our stylus
+            ;; files through the executable from the parent dir so that paths
+            ;; to ./node_modules and any require('../relative-path') works
+            stylus-mods (c/by-re [#"^node_modules/stylus"] (c/input-files fileset))
+            stylus-exec (first (c/by-name ["stylus"] stylus-mods))
             in-files (c/input-files diff)
             styl-files (c/by-ext [".styl"] in-files)]
-        ;(println "in-files" (doall (map #(.getPath (c/tmp-file %)) in-files)))
         (reset! prev fileset)
-        (println "root" (.getPath tmp))

         ;; compile stylus into css
         (when (seq styl-files)
@@ -65,8 +65,11 @@
                 ;; in order for stylus to not throw, the file needs to exist
                 (doto out-file io/make-parents c/touch)
                 (when verbose (println (str "Compiling " in-path " to " out-path "...")))
-                (binding [u/*sh-dir* (.getPath tmp)]
-                  (u/dosh stylus "-o" (.getPath out-file) (.getPath in-file)))))))
+                (binding [u/*sh-dir* (.getPath (c/tmp-dir stylus-exec))]
+                  (u/dosh "./node_modules/stylus/bin/stylus"
+                          "-o"
+                          (.getPath out-file)
+                          (.getPath in-file)))))))

         (-> fileset
             (c/add-resource tmp)
@@ -84,12 +87,9 @@
     (c/with-pre-wrap [fileset]
       (let [diff (c/fileset-diff @prev fileset :hash)
             post-css (first (c/by-name ["run_postcss.js"] (c/input-files fileset)))
-            node-modules (first (c/by-re [#"^node_modules/stylus"
-                                          #"^node_modules/postcss"
-                                          #"^node_modules/postcss-modules"] (c/input-files fileset)))
+            node-modules (first (c/by-re [#"^node_modules"] (c/input-files fileset)))
             in-files (c/input-files diff)
             css (c/by-ext [".css"] (c/by-re [#"^node_modules"] in-files true))]
-        (println "postcss" post-css)
         (reset! prev fileset)

         (when (seq css)
@@ -106,19 +106,16 @@
                   (do (u/info (str "Generated namespace for \"" in-path "\" is \"" namespace "\"\n"))
                       (u/info (str "Converting " in-path " to " out-path "...\n"))))

-                (println "Executing run_postcss at " (.getPath (c/tmp-file post-css)) "in" (.getPath (c/tmp-dir node-modules))
-                         "for env" (.getPath tmp)
-                         )
-
-                ;; node scripts require that node_modules be at the root of the pwd
-                (spit (io/file (str (.getPath (c/tmp-dir node-modules)) "/run_postcss.js")) (slurp (c/tmp-file post-css)))
+                ;; we cannot ./node run_postcss.js args without the script being at a
+                ;; sibling level to our installed node_modules
+                (spit (io/file (str (.getPath (c/tmp-dir node-modules)) "/run_postcss.js"))
+                      (slurp (c/tmp-file post-css)))
                 (conch/with-programs [node]
-                  (let [stdout (node (.getPath (c/tmp-file post-css))
+                  (let [stdout (node "run_postcss.js"
                                      (.getPath in-file)
                                      (.getPath out-file)
                                      hash
-                                     {:dir (.getPath (c/tmp-dir node-modules))
-                                      :env {"NODE_PATH" (str (.getPath (c/tmp-dir node-modules)) "/node_modules")}})]
+                                     {:dir (.getPath (c/tmp-dir node-modules))})]
                     (when (or (empty? stdout) (nil? stdout))
                       (u/fail "\"" in-path "\" did not return any css..."))
                     ;; we can have two types of "errors" here -- an error emitted by the postcss parsing
@@ -154,8 +151,8 @@
           c/commit!))))

 ;(deftask install-deps
-  ;"In order to run our compilation we need the run_postcss file inside the
-  ;consumer's source dirs."
+  ;"In order to run our compilation we need these files inside the
+  ;consumer's source dirs so they can be consumed."
   ;[]
   ;(let [tmp (c/tmp-dir!)]
     ;(c/with-pre-wrap [fs]
@@ -175,11 +172,10 @@
         (-> fs
             (c/add-source tmp)
             (c/commit!))))
-    ;(npm/npm :install {:postcss "5.0.21"
-                       ;:postcss-modules "0.5.0"
-                       ;:stylus "0.54.5"}
-             ;:cache-key ::cache)
-    ))
+    (npm/npm :install {:postcss "5.0.21"
+                       :postcss-modules "0.5.0"
+                       :stylus "0.54.5"}
+             :cache-key ::cache)))

 (deftask stylus
   "Compile all .styl files into clojure modules following css-modules syntax."


Fix migrations

Fix migrations

--- src/fivethreeonern/migrations.cljs
+++ src/fivethreeonern/migrations.cljs
@@ -5,6 +5,11 @@
 (def migrations ["CREATE TABLE IF NOT EXISTS test_migrations (id INTEGER);"])

 (declare run-migrations)
+
+(defn ensure-migrations-table! [cb]
+  (query "CREATE TABLE IF NOT EXISTS migrations (id INTEGER);"
+         (fn [_]
+           (cb))))

 (defn last-migration-id
   [cb]
@@ -20,20 +25,25 @@
              (cb)
              (run-migrations rest-migrations cb)))
          (fn [error]
-           (js/console.log error))))
+           (js/console.error error))))

 (defn run-migrations
   [[[id migration] & rest-migrations] cb]
-  (js/console.log "running migration id" id)
+  (js/console.log "running migration id" id migration)
   (query migration (fn [_]
                      (insert-migration id rest-migrations cb))))

 (defn migrate
   [cb]
-  (last-migration-id
-   (fn [last-migration-id]
-     (js/console.log last-migration-id)
-     (let [to-migrate-count (or last-migration-id 0)]
-       (run-migrations (map-indexed vector
-                                    (drop to-migrate-count migrations))
-                       cb)))))
+  (letfn [(migrate-to-id [migration-id]
+            (let [migrations-to-drop (or (inc migration-id) 0)
+                  migrations-to-run (drop migrations-to-drop migrations)]
+              (if (empty? migrations-to-run)
+                (cb)
+                (run-migrations (map vector
+                                     (drop migrations-to-drop (range))
+                                     migrations-to-run)
+                                cb))))]
+    (ensure-migrations-table!
+     (fn []
+       (last-migration-id migrate-to-id)))))


close required browser on exit

close required browser on exit

--- src/jarppe/btest/local_browser.clj
+++ src/jarppe/btest/local_browser.clj
@@ -40,4 +40,5 @@
         (when (= (deref p 10000 :timeout) :timeout)
           (close-browser)
           (println "Browser timeout!")
-          (throw+ {:core/source :require-browser}))))))
+          (throw+ {:core/source :require-browser})))
+      (.addShutdownHook (Runtime/getRuntime) (Thread. close-browser)))))


Set width of sidebar items to the maximum width of their siblings

--- src/lt/objs/sidebar/workspace.cljs
+++ src/lt/objs/sidebar/workspace.cljs
@@ -67,7 +67,11 @@
                       (object/merge! this {:open? true})
                       (when-not (:realized? @this)
                         (object/merge! this {:realized? true})
-                        (object/merge! this (files-and-folders (:path @this))))))
+                        (object/merge! this (files-and-folders (:path @this)))
+                        (let [folder (dom/$ :ul (object/->content this))
+                              width (dom/scroll-width folder)]
+                          (doseq [child (dom/children folder)]
+                            (dom/css child {:width width}))))))

 (behavior ::refresh
           :triggers #{:refresh!}


Added immigrate-from

Added immigrate-from

--- src/midje/util/namespace.clj
+++ src/midje/util/namespace.clj
@@ -18,21 +18,32 @@
 (defn semi-sweet-keyword? [loc]
   (matches-symbols-in-semi-sweet-or-sweet-ns? '(expect fake not-called data-fake) loc))

-(defn immigrate
-  "Create a public var in this namespace for each public var in the
+(letfn [(move-var [var sym]
+          (let [sym (with-meta sym (assoc (meta var) :ns *ns*))]
+            (if (.hasRoot var)
+              (intern *ns* sym (var-root var))
+              (intern *ns* sym))))]
+
+  (defn immigrate
+    "Create a public var in this namespace for each public var in the
   namespaces named by ns-names. The created vars have the same name, root
   binding, and metadata as the original except that their :ns metadata
   value is this namespace."
-  [& ns-names]
-  (doseq [ns ns-names]
-    (require ns)
-    (doseq [[sym ^clojure.lang.Var var] (ns-publics ns)]
-      (let [sym (with-meta sym (assoc (meta var) :ns *ns*))]
-        (if (.hasRoot var)
-          (intern *ns* sym (var-root var))
-          (intern *ns* sym))))))
+    [& ns-names]
+    (doseq [ns ns-names]
+      (require ns)
+      (doseq [[sym ^clojure.lang.Var var] (ns-publics ns)]
+        (move-var var sym))))
+
+  (defn immigrate-from
+    "Like `immigrate`, except wth a list of named symbols."
+    [ns symbols]
+    (doseq [sym symbols]
+      (move-var (ns-resolve ns sym) sym)))
+  )
+

 (defn intern+keep-meta [ns sym v]
   (intern ns sym v)
   (let [newguy (get (ns-interns ns) sym)]
-    (alter-meta! newguy merge (meta v))))+    (alter-meta! newguy merge (meta v))))


Add more time-related functions

Add more time-related functions

--- src/clojure/clojurewerkz/cassaforte/query/query_builder.clj
+++ src/clojure/clojurewerkz/cassaforte/query/query_builder.clj
@@ -20,10 +20,21 @@
   [& column-names]
   (QueryBuilder/token (into-array column-names)))

-(defn function-call
+(defn function-call ;; Maybe rename to raw-function-call?
   [name & args]
   (QueryBuilder/fcall name (object-array args)))

+(defn now
+  []
+  (function-call "now"))
+
+(defn min-timeuuid
+  [v]
+  (function-call "minTimeuuid" v))
+
+(defn max-timeuuid
+  [v]
+  (function-call "maxTimeuuid" v))

 (defn asc
   [^String column-name]


Addressed review comments.

Addressed review comments.

--- src/cmr/search/services/aql/converters/science_keywords.clj
+++ src/cmr/search/services/aql/converters/science_keywords.clj
@@ -4,24 +4,21 @@
             [cmr.search.services.aql.conversion :as a]
             [cmr.search.models.query :as qm]))

-(defn- any-keyword-element->condition
-  "Returns the query condition for the given anyKeyword element"
+(defmulti keyword-element->condition
+  "Returns the query condition of the given keyword element"
+  (fn [concept-type keyword-elem]
+    (:tag keyword-elem)))
+
+(defmethod keyword-element->condition :anyKeyword
   [concept-type keyword-elem]
   (qm/or-conds
-    [(a/string-element->condition concept-type (assoc keyword-elem :tag :categoryKeyword))
-     (a/string-element->condition concept-type (assoc keyword-elem :tag :topicKeyword))
-     (a/string-element->condition concept-type (assoc keyword-elem :tag :termKeyword))
-     (a/string-element->condition concept-type (assoc keyword-elem :tag :variableLevel1Keyword))
-     (a/string-element->condition concept-type (assoc keyword-elem :tag :variableLevel2Keyword))
-     (a/string-element->condition concept-type (assoc keyword-elem :tag :variableLevel3Keyword))
-     (a/string-element->condition concept-type (assoc keyword-elem :tag :detailedVariableKeyword))]))
+    (map #(a/string-element->condition concept-type (assoc keyword-elem :tag %))
+         [:categoryKeyword :topicKeyword :termKeyword :variableLevel1Keyword
+          :variableLevel2Keyword :variableLevel3Keyword :detailedVariableKeyword])))

-(defn- keyword-element->condition
-  "Returns the query condition of the given keyword element"
+(defmethod keyword-element->condition :default
   [concept-type keyword-elem]
-  (if (= :anyKeyword (:tag keyword-elem))
-    (any-keyword-element->condition concept-type keyword-elem)
-    (a/string-element->condition concept-type keyword-elem)))
+  (a/string-element->condition concept-type keyword-elem))

 (defn- science-keyword-element->conditions
   "Returns the query conditions of the given scienceKeyword element"


added a docstring for contract

added a docstring for contract

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -14,7 +14,46 @@
 (ns fogus.me.trammel
   (:use fogus.me.trammel.impl))

-(defmacro contract
+(defmacro contract
+  "The base contract form returning a higher-order function that can then be partially
+   applied to an existing function to 'apply' a contract.  Take for example a simple
+   contract that describes an expectation for a function that simply takes one or two
+   numbers and returns the double:
+
+    (def doubler-contract
+       (contract doubler
+         [x]
+         :requires
+         (number? x)
+
+         :ensures
+         (= (* 2 x) %)
+
+         [x y]
+         :requires
+         (every? number? [x y])
+
+         :ensures
+         (= (* 2 (+ x y)) %))
+
+   You can then partially apply this contract with an existing function:
+
+    (def doubler (partial doubler-contract #(* 2 %)))
+    (def bad-doubler (partial doubler-contract #(* 3 %)))
+
+   And then running these functions will be checked against the contract at runtime:
+
+    (doubler 2)
+    ;=> 4
+
+    (bad-doubler 2)
+    ; java.lang.AssertionError: Assert failed: (= (* 2 x) %)
+
+   Similar results would occur for the 2-arity versions of `doubler` and `bad-doubler`.
+
+   While it's fine to use `partial` directly, it's better to use the `with-contracts` macro
+   found in this same library.
+  "
   [& forms]
   (let [name (if (symbol? (first forms))
                (first forms)


Moving the new build-contract fn into place.  Simpler, cleaner, stronger, more manly

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -67,16 +67,10 @@
         (manip-map (partial funcify '[%]) [:post])
         (manip-map (partial funcify args) [:pre]))])

-
-(defn build-contract
-  "Expects a list representing an arity-based expectation of the form:
-
-    (([x]) (:requires (foo x) :ensures (bar %)))
-
-   This form is then destructured to pull out the arglist `[x]` and the
-   contract expectation body (i.e. the constraints):
-
-    (:requires (foo x) :ensures (bar %))
+(defn- build-contract
+  "Expects a seq representing an arity-based expectation of the form:
+
+    [[x] {:pre [(foo x)] :post [(bar %)]}]

    It then uses this data to build another list reprsenting a specific arity body
    for a higher-order function with attached pre- and post-conditions that directly
@@ -84,6 +78,13 @@

     ([f x] {:pre [(foo x)] :post [(bar %)]} (f x))
   "
+  [cnstr]
+  (let [[args pre-post-map] cnstr]
+    (list (into '[f] args)
+          pre-post-map
+          (list* 'f args))))
+
+(defn build-contract
   [arity-map]
   (let [sig (first (keys arity-map))]
     (list


Test: perform path analysis through peers in order to check segment order

--- test/onyx/peer/deterministic_peer_test.clj
+++ test/onyx/peer/deterministic_peer_test.clj
@@ -39,16 +39,20 @@
 ;;;;;;;;;
 ;; Job code

-(defn add-path [job-id task+slot {:keys [n] :as segment}]
-  (update segment :path conj [job-id task+slot]))
+(defn add-path [peer-id job-id task+slot {:keys [n] :as segment}]
+  (-> segment
+      ;; Track the path that the segment took through the tasks for graph analysis
+      (update :path conj [job-id task+slot])
+      ;; Track the peer path that the segments took
+      (update :peer-path into peer-id)))

 (def add-paths-calls
   {:lifecycle/before-task-start
    (fn [event lifecycle]
      (if (= :input (:onyx/type (:task-map event)))
        ;; include slot combinations with input
-       {:params [(:job-id event) [(:task event) (:slot-id event)]]}
-       {:params [(:job-id event) [(:task event)]]}))})
+       {:params [[(:id event)] (:job-id event) [(:task event) (:slot-id event)]]}
+       {:params [[(:id event)] (:job-id event) [(:task event)]]}))})

 (defn add-paths-lifecycles [job]
   (update job
@@ -109,7 +113,7 @@
 (defn simple-job-def [job-id n-input-slots]
   (let [n-messages 200
         task-opts {:onyx/batch-size 2}
-        inputs (mapv (fn [n] {:n n :path []}) (range n-messages))
+        inputs (mapv (fn [n] {:n n :path [] :peer-path []}) (range n-messages))
         job (-> (build-job [[:in1 :inc]
                             [:in2 :inc]
                             [:inc :out]]
@@ -201,7 +205,7 @@
   (mapcat (fn [path]
             (map (fn [seg]
                    (reduce (fn [segment task]
-                             (add-path job-id task segment))
+                             (add-path [] job-id task segment))
                            seg
                            path))
                  inputs))
@@ -221,13 +225,12 @@
                      (partition-by #(= [:reset-messenger] %))
                      (remove (fn [run] (= #{[:reset-messenger]} (set run)))))]
       (let [segments (apply concat run)
-            ;; We only care about ordering of segments coming from the same input
             group-by-input (->> segments
                                 ;; Don't include messaged state
                                 (remove :state-output?)
-                                (group-by #(first (:path %))))]
+                                ;; We only care about ordering of segments that followed the same path through peers
+                                (group-by :peer-path))]
         (doseq [[input-task segments] group-by-input]
-          ;; FIXME: why less than or equal
           (prop-is (apply < (map :n segments))
                    (str (mapv :n segments))
                    (str "outputs not in order " input-task " " segments)))))))
@@ -277,15 +280,23 @@
                    :group-id g
                    :args [:add-peer p]}]))))

+(defn reset-peer-path [segment]
+  (assoc segment :peer-path []))
+
+(defn normalize-state [state]
+  (set (map (juxt key
+                  (comp set
+                        (partial map reset-peer-path)
+                        val))
+            state)))
+
 (defn job-state-properties [expected-state job-id state]
   ;(println "EXPECTED" expected-state)
   ;(println "STATE" state)
   ;let [state-values (reduce into [] state)]
   ;(prop-is (= (count (set state)) (count state-values)) "not enough state values")
-  (let [v1 (set (map (juxt key (comp set val))
-                        expected-state))
-        v2 (set (map (juxt key (comp set val))
-                        state))]
+  (let [v1 (normalize-state expected-state)
+        v2 (normalize-state state)]
     (prop-is (= v1 v2)
              "job-state-properties: trigger state is incorrect"
              (vec (take 2 (clojure.data/diff v1 v2))))))
@@ -347,7 +358,7 @@
         ;; TODO: group-by job-id so we can separate out the diff job states?
         expected-state (->> expected-outputs
                             (map (fn [v]
-                                   (update v :path butlast)))
+                                   (update v :path (comp vec butlast))))
                             (group-by :n))]
     ;(println  "jobs " jobs "comp" (:completed-jobs replica))
     ;(println "gen-cmds" gen-cmds)
@@ -357,6 +368,7 @@
     (prop-is (= (count (:peers model)) (count (:peers replica))) "peers")
     ;(println "STATE ATOM" @state-atom)
     (state-properties expected-state @state-atom)
+    ;(println "Flow outputs " flow-outputs)

     ; (prop-is (= expected-state
     ;             ;; Potentially should check for state ordering here
@@ -365,12 +377,12 @@
     ;                      (sort-by (comp count :extent-state)
     ;                               messaged-state-outputs)))))
     ;          "bad messaged state state")
-    (prop-is (= (set expected-outputs) (set flow-outputs)) "messenger flow values incorrect")
+    (prop-is (= (set expected-outputs) (set (map reset-peer-path flow-outputs))) "messenger flow values incorrect")
     ;(println "Expected: " expected-outputs)
     ;(println "Outputs:" actual-outputs)
     ;; TODO: can only guarantee outputs are in order if there is only one intermediate task
     ;; Implement a better property here
-    #_(check-outputs-in-order! peer-outputs)))
+    (check-outputs-in-order! peer-outputs)))

 (defspec deterministic-abs-test {;:seed X
                                  :num-tests (times 2000)}


CW & AB | 22 | Add test for dissocing csrf-token from session in authorise handler

--- test/stonecutter/test/controller/oauth.clj
+++ test/stonecutter/test/controller/oauth.clj
@@ -43,12 +43,15 @@
                                (r/header "accept" "text/html")
                                (assoc-in [:session :access_token] (:token access-token))
                                (assoc-in [:session :user :email] user-email)
-                               (assoc-in [:context :translator] {}))
+                               (assoc-in [:context :translator] {})
+                               ;the csrf-token key in session will stop clauth from refreshing the csrf-token in request
+                               (assoc-in [:session :csrf-token] "staleCSRFtoken"))
                    response (oauth/authorise request)]
                (:status response) => 200
                (get-in response [:session :access_token]) => (:token access-token)
                (get response :body) => (contains "Share Profile Card")
-               (get-in response [:session :user :email]) => user-email))
+               (get-in response [:session :user :email]) => user-email
+               (get-in response [:session :csrf-token]) =not=> "staleCSRFtoken"))

        (fact "posting to authorisation endpoint redirects to callback with auth code"
              (let [user-email "email@user.com"


(PDB-2905) Append .json to queue entry metadata

The metadata-parser abstraction will be used by the forthcoming
migration of the dlo to stockpile.

--- src/puppetlabs/puppetdb/queue.clj
+++ src/puppetlabs/puppetdb/queue.clj
@@ -5,12 +5,16 @@
   (:require [stockpile :as stock]
             [clj-time.coerce :as tcoerce]
             [puppetlabs.puppetdb.cheshire :as json]
-            [clojure.string :as str]
+            [puppetlabs.puppetdb.command.constants :as constants]
+            [clojure.string :as str :refer [re-quote-replacement]]
             [clj-time.core :as time]
             [puppetlabs.kitchensink.core :as kitchensink]
             [slingshot.slingshot :refer [throw+]]
             [clojure.core.async :as async]
             [clojure.core.async.impl.protocols :as async-protos]))
+
+(def metadata-command-names
+  (vals constants/command-names))

 (defn stream->json [^InputStream stream]
   (try
@@ -22,7 +26,35 @@
       (throw+ {:kind ::parse-error} e "Error parsing command"))))

 (defn metadata-str [received command version certname]
-  (format "%s_%s_%s_%s" (tcoerce/to-long received) command version certname))
+  (format "%d_%s_%d_%s.json"
+          (tcoerce/to-long received) command version certname))
+
+(defn metadata-str [received command version certname]
+  (format "%d_%s_%d_%s.json"
+          (tcoerce/to-long received) command version certname))
+
+(defn- metadata-rx [valid-commands]
+  (re-pattern (str
+               "([0-9]+)_("
+               (str/join "|" (map #(format "(?:%s)" (re-quote-replacement %))
+                                  valid-commands))
+               ")_([0-9]+)_(.*)\\.json")))
+
+(defn metadata-parser
+  ([] (metadata-parser metadata-command-names))
+  ([valid-commands]
+   ;; NOTE: changes here may affect the DLO, e.g. it currently assumes
+   ;; the trailing .json.
+   (let [rx (metadata-rx valid-commands)]
+     (fn [s]
+       (when-let [[_ stamp command version certname] (re-matches rx s)]
+         (and certname
+              {:stamp stamp
+               :version version
+               :command command
+               :certname certname}))))))
+
+(def parse-metadata (metadata-parser))

 (defrecord CommandRef [id command version certname received callback annotations delete?])

@@ -30,12 +62,13 @@
   (stock/entry id (metadata-str received command version certname)))

 (defn entry->cmdref [entry]
-  (let [[received-time-ms command version certname] (str/split (stock/entry-meta entry) #"_" 4)
-        received (-> received-time-ms
+  (let [{:keys [stamp command version certname]} (-> entry
+                                                     stock/entry-meta
+                                                     parse-metadata)
+        received (-> stamp
                      Long/parseLong
                      tcoerce/from-long
                      kitchensink/timestamp)]
-
     (map->CommandRef {:id (stock/entry-id entry)
                       :command command
                       :version (Long/parseLong version)


Fix ns

Fix ns

--- src/main/cljc/clojure_club/x124_analyze_reversi/mgrimm.cljc
+++ src/main/cljc/clojure_club/x124_analyze_reversi/mgrimm.cljc
@@ -1,4 +1,4 @@
-(ns x124-analyze-reversi.mgrimm)
+(ns clojure-club.x124-analyze-reversi.mgrimm)

 (defn analyze-reversi [board color]
   (let [moves [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]]


Catch all Throwables not just Exceptions reading a pipe.

--- src/rdf-common/grafter/rdf/io.clj
+++ src/rdf-common/grafter/rdf/io.clj
@@ -526,7 +526,7 @@
               (catch Exception ex
                 (put! ex)))))
         (let [read-rdf (fn read-rdf [msg]
-                         (if (instance? Exception msg)
+                         (if (instance? Throwable msg)
                            ;; if the other thread puts an Exception on
                            ;; the pipe, raise it here.
                            (throw (ex-info "Reading triples aborted."


Sort list of ops

Sort list of ops

This makes it easier to keep this in sync with `cljr--nrepl-ops`.

--- src/refactor_nrepl/middleware.clj
+++ src/refactor_nrepl/middleware.clj
@@ -95,20 +95,22 @@
          :status :done))

 (def refactor-nrepl-ops
-  {"resolve-missing" resolve-missing-reply
+  {
+   "artifact-list" artifact-list-reply
+   "artifact-versions" artifact-versions-reply
+   "clean-ns" clean-ns-reply
+   "configure" config-reply
+   "extract-definition" extract-definition-reply
    "find-debug-fns" find-debug-fns-reply
    "find-symbol" find-symbol-reply
-   "artifact-list" artifact-list-reply
-   "artifact-versions" artifact-versions-reply
+   "find-unbound" find-unbound-reply
    "hotload-dependency" hotload-dependency-reply
-   "clean-ns" clean-ns-reply
-   "configure" config-reply
+   "rename-file-or-dir" rename-file-or-dir-reply
+   "resolve-missing" resolve-missing-reply
+   "stubs-for-interface" stubs-for-interface-reply
    "version" version-reply
    "warm-ast-cache" warm-ast-cache-reply
-   "find-unbound" find-unbound-reply
-   "extract-definition" extract-definition-reply
-   "rename-file-or-dir" rename-file-or-dir-reply
-   "stubs-for-interface" stubs-for-interface-reply})
+   })

 (defn wrap-refactor
   [handler]


Fix a docstring

Fix a docstring

--- src/refactor_nrepl/ns/rebuild.clj
+++ src/refactor_nrepl/ns/rebuild.clj
@@ -249,8 +249,8 @@
     (cons :require-macros (rest require-form))))

 (defn- drop-dependency-clauses
-  "Drop every form from the ns-form which isn't related to bringing
-  symbols into the namespace."
+  "Drop every form from the ns-form which related to bringing symbols
+  into the namespace."
   [ns-form]
   (remove (fn [component]
             (#{:require :require-macros :use :use-macros :import}


Fix docstring typo

Fix docstring typo

--- src/puppetlabs/config/typesafe.clj
+++ src/puppetlabs/config/typesafe.clj
@@ -91,7 +91,7 @@

 (defn reader->map
   "Given any clojure object that is suitable for use with `reader`, parse the
-  configuration data and return clojure map representation of the data.
+  configuration data and return a clojure map representation of the data.

   Optional `format` arg may be one of `:conf`, `:json`, or `:properties`, to
   specify the configuration format.  Defaults to `:conf`."


Start tranistion to always call first `-fx` parameter `coeffects`,  not `world`.

--- src/re_frame/std_interceptors.cljc
+++ src/re_frame/std_interceptors.cljc
@@ -99,9 +99,9 @@
 (defn fx-handler->interceptor
   "Returns an interceptor which wraps the kind of event handler given to `reg-event-fx`.

-  These handlers take two arguments;  `world` and `event`, and they return `effects`.
-
-  (fn [world event]
+  These handlers take two arguments;  `coeffects` and `event`, and they return `effects`.
+
+  (fn [coeffects event]
      {:db ...
       :dispatch ...})


Properly daemonize background threads

Properly daemonize background threads

--- src/riemann/jvm_profiler/stack.clj
+++ src/riemann/jvm_profiler/stack.clj
@@ -143,16 +143,23 @@
   []
   (AggSample. (atom (new-agg-state (System/nanoTime)))))

+(defmacro daemon
+  "Starts a daemon thread with the given name."
+  [name & body]
+  `(doto (Thread. (fn ~'body []
+                    ~@body))
+     (.setName ~name)
+     (.setDaemon true)
+     (.start)))
+
 (defn sampler!
   "Samples the stack repeatedly, merging results into the given atom. Tries to
   only run for load-target fraction of a thread's time; 0 means never sample, 1
-  means run all the time. Returns a future."
+  means run all the time. Returns a promise which, when delivered false,
+  stops the sampler."
   [agg-sample target-load]
   (let [running (promise)]
-    (future
-      (doto (Thread/currentThread)
-        (.setDaemon true)
-        (.setName "riemann-jvm-profiler sampler"))
+    (daemon "riemann-jvm-profiler sampler"
       (loop [last-t0 (System/nanoTime)]
         (when (deref running 0 true)
           (recur
@@ -184,10 +191,7 @@
   [agg-sample dt f]
   (let [anchor  (measure/linear-time)
         running (promise)]
-    (future
-      (doto (Thread/currentThread)
-        (.setDaemon true)
-        (.setName "riemann-jvm-profiler reporter"))
+    (daemon "riemann-jvm-profiler reporter"
       (loop []
         (when (deref running
                      (* 1000 (- dt (mod (- (measure/linear-time) anchor) dt)))


Fix check for follow/unfollow in user-visibility: make sure non existing fields don't affect the filter.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -305,8 +305,6 @@
                          (r/add sort-value-base unread-cap-ms)
                          ;; The timestamp in seconds
                          sort-value-base)
-           ;; ***** Commented out since we want every entry no matter who commented *****
-           ;; ***** Uncomment this to show only entries with comments from others   *****
            ; :reply-authors (-> interactions-base
            ;                 (r/coerce-to :array)
            ;                 (r/map (r/fn [inter] (r/get-field inter [:author :user-id])))
@@ -315,14 +313,14 @@
                           (r/get-all [(r/get-field row :uuid)] {:index :resource-uuid})
                           (r/pluck relation-fields)
                           (r/coerce-to :array))
-           :debug {:unread-with-cap unread-with-cap?
-                   :unread-thread unread-thread?}})))
+           ;; FIXME: debug
+           ; :debug {:unread-with-cap unread-with-cap?
+           ;         :unread-thread unread-thread?}
+          })))
        ;; Filter by user-visibility
        (r/filter query (r/fn [row]
         (r/and (r/gt (r/get-field row [:comments-count]) 0)
                ;; Filter out threads that have comments only from the current user
-               ;; ***** Commented out since we want every entry no matter who commented *****
-               ;; ***** Uncomment this to show only entries with comments from others   *****
                ; (-> (r/get-field row [:reply-authors])
                ;  (r/filter user-id)
                ;  (r/is-empty)
@@ -333,20 +331,15 @@
                      (r/and (= direction :after)
                             (r/le start (r/get-field row :sort-value))))
                ;; Filter on the user's visibility map:
-               ;; - has :follow true
-               ;; - and has not :unfollow or :unfollow is false
-               ; (r/and (r/get-field row [:user-visibility (keyword user-id) :follow])
-               ;        (r/or (-> (r/get-field row [:user-visibility (keyword user-id)])
-               ;               (r/has-fields [:unfollow])
-               ;               r/not)
-               ;              (r/not (r/get-field row [:user-visibility (keyword user-id) :unfollow]))))
-               ;; Filter on user;s visibility map:
-               ;; - or has :follow true
-               ;; - or has :unfollow false
-               (r/or (r/get-field row [:user-visibility (keyword user-id) :follow])
-                     (r/and (-> (r/get-field row [:user-visibility (keyword user-id)])
-                             (r/has-fields [:unfollow]))
-                            (r/not (r/get-field row [:user-visibility (keyword user-id) :unfollow])))))))
+               (r/or ;; has :follow true
+                     (-> row
+                      (r/get-field [:user-visibility (keyword user-id) :follow])
+                      (r/default false))
+                     ;; has :unfollow false (key actually exists)
+                     (-> row
+                      (r/get-field [:user-visibility (keyword user-id) :unfollow])
+                      (r/default true)
+                      (r/not))))))
        ;; Sort
        (if-not count
         (r/order-by query (order-fn :sort-value))


Implement API call to get stats of a sidekiq instance

--- src/sidequarter_frontend/api.cljs
+++ src/sidequarter_frontend/api.cljs
@@ -2,9 +2,17 @@
     (:require-macros [sidequarter-frontend.env :refer [cljs-env]]
                      [cljs.core.async.macros :refer [go]])
     (:require [cljs-http.client :as http]
-              [cljs.core.async :refer [<! >! put! chan]]))
+              [cljs.core.async :refer [<! >! put! chan]]
+              [clojure.string :refer [join]]))

 (def api-url (cljs-env :api-url))

 (defn get-sidekiqs []
   (http/jsonp api-url {:callback-name "callback"}))
+
+(defn stats-path [sidekiq-id]
+  (join "/" [api-url sidekiq-id "stats"]))
+
+(defn get-stats [sidekiq-id]
+  (let [url (stats-path sidekiq-id)]
+    (http/jsonp url {:callback-name "callback"})))


docstring formatting

docstring formatting

--- src/overtone/music/pitch.clj
+++ src/overtone/music/pitch.clj
@@ -135,8 +135,8 @@
     matches))

 (defn note-map
-  "Takes a string representing a midi note such as C4 and returns a map of
-  note info"
+  "Takes a string representing a midi note such as C4 and returns a map
+  of note info"
   [midi-string]
   (let [[match pitch-class octave] (validate-midi-string! midi-string)
         pitch-class                (canonical-pitch-class-name pitch-class)


Added response namespace as a wrapper round response builder.

--- dropwizard-clojure-core/src/clojure/dropwizard_clojure/response.clj
+++ dropwizard-clojure-core/src/clojure/dropwizard_clojure/response.clj
@@ -5,8 +5,10 @@
 (defn ok []
   (.build (Response/ok)))

+(defn server-error []
+  (.build (Response/serverError)))

-(defn notFound []
+(defn not-found []
   (.build (.type (Response/status 404) javax.ws.rs.core.MediaType/APPLICATION_JSON_TYPE)))

 (defn accepted []


Fix builtin icons library data structure.

--- src/uxbox/main/library/icons.cljs
+++ src/uxbox/main/library/icons.cljs
@@ -25,62 +25,62 @@

 (def +collections+
   [{:name "Material design (actions)"
-    :builtin true
+    :type :builtin
     :id 1
     :icons md-actions/+icons+}
    {:name "Material design (alerts)"
-    :builtin true
+    :type :builtin
     :id 2
     :icons md-alerts/+icons+}
    {:name "Material design (Av)"
-    :builtin true
+    :type :builtin
     :id 3
     :icons md-av/+icons+}
    {:name "Material design (Communication)"
-    :builtin true
+    :type :builtin
     :id 4
     :icons md-comm/+icons+}
    {:name "Material design (Content)"
-    :builtin true
+    :type :builtin
     :id 5
     :icons md-content/+icons+}
    {:name "Material design (Device)"
-    :builtin true
+    :type :builtin
     :id 6
     :icons md-device/+icons+}
    {:name "Material design (Editor)"
-    :builtin true
+    :type :builtin
     :id 7
     :icons md-editor/+icons+}
    {:name "Material design (File)"
-    :builtin true
+    :type :builtin
     :id 8
     :icons md-file/+icons+}
    {:name "Material design (Hardware)"
-    :builtin true
+    :type :builtin
     :id 9
     :icons md-hardware/+icons+}
    {:name "Material design (Image)"
-    :builtin true
+    :type :builtin
     :id 10
     :icons md-image/+icons+}
    {:name "Material design (Maps)"
-    :builtin true
+    :type :builtin
     :id 11
     :icons md-maps/+icons+}
    {:name "Material design (Navigation)"
-    :builtin true
+    :type :builtin
     :id 12
     :icons md-nav/+icons+}
    {:name "Material design (Notifications)"
-    :builtin true
+    :type :builtin
     :id 13
     :icons md-not/+icons+}
    {:name "Material design (Social)"
-    :builtin true
+    :type :builtin
     :id 14
     :icons md-social/+icons+}
    {:name "Material design (Toggle)"
-    :builtin true
+    :type :builtin
     :id 15
     :icons md-toggle/+icons+}])


Remove old memory search engine code.

Remove old memory search engine code.

--- src/vault/search/engine/memory.clj
+++ src/vault/search/engine/memory.clj
@@ -1,113 +0,0 @@
-(ns vault.search.engine.memory
-  (:require
-    [puget.order :as order]))
-
-
-;;;;; HELPER FUNCTIONS ;;;;;
-
-(defn- update-vals
-  "Maps a function over the values in a map, returning a new map."
-  [m f & args]
-  (reduce (fn [acc [k v]] (assoc acc k (apply f v args))) (empty m) m))
-
-
-(defn- flatten-times
-  "Flattens a sorted map into a sequence of values n times."
-  [m n]
-  (apply concat (nth (iterate (partial mapcat vals) [m]) n)))
-
-
-(defn- update-sorted-in
-  "Like update-in, but creates intermediate maps sorted by Puget."
-  [m [k & ks] f & args]
-  (if ks
-    (assoc m k (apply update-sorted-in
-                      (get m k (sorted-map-by order/rank))
-                      ks f args))
-    (assoc m k (apply f (get m k) args))))
-
-
-
-;;;;; REGISTER METHODS ;;;;;
-
-(defn- mem-register
-  "Creates a new register map with the given attributes."
-  [attrs]
-  {:attrs (vec attrs)
-   :records (sorted-map-by order/rank)})
-
-
-(defn- update-register
-  "Updates a nested register map with the given record. Creates a sorted set as
-  the leaf value if one is not present already. Returns an updated version of
-  the register."
-  [register record]
-  (let [key-vec (vec (map record (:attrs register)))]
-    (when (some nil? key-vec)
-      (throw (IllegalArgumentException.
-               (str "Cannot update register with record missing required "
-                    "attributes " (pr-str (:attrs register)) " "
-                    (pr-str record)))))
-    (update-in register [:records]
-               update-sorted-in key-vec
-               (fnil conj (sorted-set-by order/rank))
-               record)))
-
-
-(defn- select-register
-  "Given a collection of registers and attributes being searched, select the
-  best register to query for records."
-  [registers attrs]
-  (let [leading-attrs
-        #(->> % :attrs
-              (map (set attrs))
-              (take-while some?)
-              count)]
-    (apply max-key leading-attrs registers)))
-
-
-(defn- search-register
-  "Queries a register to find records matching the given pattern. Returns a
-  sequence of the matched records."
-  [register pattern opts]
-  (loop [[attr & more :as attrs] (:attrs register)
-         records (:records register)
-         pattern pattern]
-    ; Find leading attributes present in `pattern`.
-    (if-let [value (get pattern attr)]
-      ; Narrow scope by recursively getting next level of records.
-      (recur more (get records value) (dissoc pattern attr))
-      ; Filter remaining entries by pattern attributes.
-      (filter (fn [record]
-                (every? #(= (get pattern %)
-                            (get record %))
-                        (keys pattern)))
-              (flatten-times records (count attrs))))))
-
-
-
-;;;;; MEMORY INDEX ;;;;;
-
-(defrecord MemoryEngine [registers])
-
-#_
-(extend-type MemoryEngine
-  search/SearchEngine
-
-  (update!
-    [this record]
-    (swap! (:registers this) update-vals update-register record)
-    this)
-
-  (search*
-    [this pattern opts]
-    (-> this :registers deref vals
-        (select-register (keys pattern))
-        (search-register pattern opts))))
-
-
-(defn memory-engine
-  "Creates a new memory-backed index which optimizes the given queries. The
-  argument should be a map of query keyword names to attr vectors."
-  [queries]
-  (MemoryEngine. (atom (update-vals queries mem-register))))


Add a test for a nil path to async/namespace-handler

--- spec/rook/async_spec.clj
+++ spec/rook/async_spec.clj
@@ -37,6 +37,18 @@
                  (->
                    (async/routing {})
                    <!!))))
+
+  (describe "namespace-handler"
+
+    (it "allows the path to be nil"
+        (let [handler (async/namespace-handler 'barney)]
+          (should= {:message "ribs!"}
+                   (->
+                     (mock/request :get "/")
+                     handler
+                     <!!
+                     :body)))))
+

   (describe "loopback-handler"


import clojure.string

import clojure.string

--- src/riemann/jvm_profiler.clj
+++ src/riemann/jvm_profiler.clj
@@ -1,6 +1,7 @@
 (ns riemann.jvm-profiler
   (:require [riemann.jvm-profiler.stack :as stack]
-            [riemann.client.http :as client])
+            [riemann.client.http :as client]
+            [clojure.string :as string])
   (:import (java.lang StackTraceElement)
            (java.lang.management ManagementFactory)))

@@ -18,7 +19,7 @@
          (map (fn [[^StackTraceElement frame
                     {:keys [self-time top-trace top-trace-time]}]]
                 {:host        (or host (client/localhost))
-                 :service     (str (trim prefix) " profiler fn "
+                 :service     (str (string/trim prefix) " profiler fn "
                                    (.getClassName frame) " "
                                    (.getMethodName frame))
                  :file        (.getFileName frame)


Delete persistence.clj

Delete persistence.clj

--- src/iyye/persistence.clj
+++ src/iyye/persistence.clj
@@ -1,64 +0,0 @@
- ; Iyye - AI agent
-; Copyright (C) 2016-2017  Sasha Yumzya
-
-; This program is free software: you can redistribute it and/or modify
-; it under the terms of the GNU Affero General Public License as
-; published by the Free Software Foundation, either version 3 of the
-; License, or (at your option) any later version.
-
-; This program is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU Affero General Public License for more details.
-
-; You should have received a copy of the GNU Affero General Public License
-; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-(ns iyye.persistence
-   (:require
-     [clojure.tools.logging :as log]
-     [extras.mongowrapper :as mongo]))
-
-(defn local-time-to-string []
-  (let [ date (java.util.Date.)]  (.format (java.text.SimpleDateFormat. "MM_dd_yyyy_HH_mm_ss") date)))
-
-(def iyye-name (ref ()))
-(def iyye-main "iyye_main")
-
-(defn iyye-exists? [name]
-  (let [entry (mongo/get-entry iyye-main "iyye_list" {:name name})]
-    (if (first entry)  true false)))
-
-(defn add-iyye [name]
-  (if (iyye-exists? name)
-    false
-    (mongo/add-entry iyye-main "iyye_list" {:name name :time (local-time-to-string)} )))
-
-(defn list-iyye []
-  (log/info "nothing list")
-  (let [entries (mongo/get-entry iyye-main "iyye_list" {})]
-    (if entries (map :name entries)  false)))
-
-(defn set-current-iyye [name]
-  (dorun
-    [(add-iyye name)
-    (println "iyye name is : " name)
-    (dosync (ref-set iyye-name name))]))
-
-(defn load-current-iyye [name]
-  (println "iyye name is : " name)
-  (dosync (ref-set iyye-name name)))
-
-(defn record-day [day-num]
-  (mongo/add-entry iyye-main (str "days_" @iyye-name) {:number day-num :time (local-time-to-string)}))
-(defn record-night [night-num]
-  (mongo/add-entry iyye-main (str "nights_" @iyye-name) {:number night-num :time (local-time-to-string)}))
-
-(defn load-days []
-  (mongo/get-count iyye-main (str "days_" @iyye-name) {}))
-
-(defn write-io-to-db [days IO dir input]
-  (let [doc (str "IO_day_" days)
-        dbname (str @iyye-name "_IO_" (:name IO))
-        entry {:time (str (.format (java.text.SimpleDateFormat. "MM_dd_yyyy_HH_mm_ss") (java.util.Date.))) dir input}]
-    (mongo/add-entry dbname doc entry)))


Delete error log in tests only if it already exist

Otherwise delete-file call may fail

--- test/clj_gatling/test_helpers.clj
+++ test/clj_gatling/test_helpers.clj
@@ -24,7 +24,8 @@
   (f))

 (defn delete-error-logs []
-  (io/delete-file error-file-path))
+  (when (.exists (io/file error-file-path))
+    (io/delete-file error-file-path)))

 (defn run-legacy-simulation [legacy-scenarios concurrency & [options]]
   (let [step-timeout (or (:timeout-in-ms options) 5000)


some reasonable organiziation

some reasonable organiziation

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/plugins.cljs
+++ src/lt/objs/plugins.cljs
@@ -24,6 +24,7 @@

 (def plugins-dir (files/lt-home "plugins"))
+(def plugins-url "http://plugins.lighttable.com")

 (defn EOF-read [s]
   (when (and s
@@ -35,11 +36,25 @@
     path
     (files/join (or (::dir object/*behavior-meta*) (files/lt-home)) path)))

+(defn local-module [plugin-name module-name]
+  (files/join plugins-dir plugin-name "node_modules" module-name))
+
+(cmd/command {:command :build
+              :desc "Editor: build file or project"
+              :exec (fn []
+                      (when-let [ed (pool/last-active)]
+                        (object/raise ed :build)))})
+
+;;*********************************************************
+;; Plugin reading
+;;*********************************************************
+
 (defn validate [plugin]
   (let [valid? (every? plugin [:name :author :behaviors :desc])]
     (if-not valid?
       (do
-        (console/error (str "Invalid plugin.json file: " (:dir plugin) "/plugin.json \nPlugins must include values for name, author, behaviors, and desc."))
+        (console/error (str "Invalid plugin.json file: " (:dir plugin) "/plugin.json \nPlugins
+                            must include values for name, version, author, behaviors, and desc."))
         nil)
       plugin)))

@@ -105,8 +120,317 @@
     [:div
      (reduce str (interpose " => " cycle))]))

-(defn local-module [plugin-name module-name]
-  (files/join plugins-dir plugin-name "node_modules" module-name))
+;;*********************************************************
+;; Plugin install/uninstall
+;;*********************************************************
+
+(defn fetch-and-install [url name cb]
+  (let [tmp-gz (str plugins-dir "/" name "tmp.tar.gz")
+        tmp-dir (str plugins-dir "/" name "-tmp")]
+    (notifos/working (str "Downloading plugin: " name))
+    (deploy/download-file url tmp-gz (fn []
+                                       (notifos/done-working)
+                                       (notifos/working "Extracting plugin...")
+                                       (deploy/untar tmp-gz tmp-dir
+                                                     (fn []
+                                                       (let [munged-dir (first (files/full-path-ls tmp-dir))]
+                                                         (files/move! munged-dir (str plugins-dir "/" name "/"))
+                                                         (files/delete! tmp-dir)
+                                                         (files/delete! tmp-gz)
+                                                         (notifos/done-working (str "Plugin fetched: " name))
+                                                         (object/raise manager :plugin.fetched)
+                                                         (when cb
+                                                           (cb))
+                                                         )))))))
+
+(defn install-version [plugin cb]
+  (let [name (-> plugin :info :name)
+        ver (-> plugin :version)
+        installed? (-> @app/app ::plugins (get name))]
+    (if (or (not installed?)
+            (and (:version installed?)
+                 (deploy/is-newer? (:version installed?) ver)))
+      (do
+        (object/update! app/app [::plugins] assoc name {})
+        (fetch-and-install (-> plugin :tar) name
+                           (fn []
+                             (when cb
+                               (cb true))
+                             (object/raise manager :refresh!)
+                             )))
+      (do
+        (notifos/set-msg! (str name " is already installed"))
+        (when cb
+          (cb false))))))
+
+(defn transitive-install [plugin deps cb]
+  (let [cur (or (-> plugin :name) (-> plugin :info :name))
+        others (dissoc deps cur)
+        counter (atom (count others))
+        count-down (fn []
+                     (swap! counter dec)
+                     ;;then install the actual plugin
+                     (when (<= @counter 0)
+                       (install-version (deps cur) (fn [installed?]
+                                                     (when cb
+                                                       (cb installed?))
+                                                     (when installed?
+                                                       ;;a new plugin has been installed, we should reload everything
+                                                       (cmd/exec! :behaviors.reload))))))]
+    ;;first get and install all the deps
+    ;;count them down and then install the real plugin and reload.
+    (if (seq others)
+      (doseq [[_ dep] others]
+        (install-version dep count-down))
+      (count-down))))
+
+(defn discover-deps [plugin cb]
+  (fetch/xhr [:post (str plugins-url "/install")] {:name (or (-> plugin :name) (-> plugin :info :name))
+                                                  :version (or (-> plugin :version)
+                                                               (-> plugin :info :version))}
+                                   (fn [data]
+                                     (transitive-install plugin (EOF-read data) cb))))
+
+(defn uninstall [plugin]
+  (files/delete! (:dir plugin))
+  (object/raise manager :refresh!))
+
+;;*********************************************************
+;; Manager ui
+;;*********************************************************
+
+(defui url-input []
+  [:input {:type "text" :placeholder "Github URL"}]
+  :focus (fn []
+           (ctx/in! :popup.input))
+  :blur (fn []
+          (ctx/out! :popup.input)))
+
+(defn submit-url []
+  (let [input (url-input)
+        p (popup/popup! {:header "Submit a plugin to the central repository"
+                         :body [:div
+                                [:p "You can submit a github url to add a plugin to the central repository.
+                                 All plugin repos must have at least one tag in version format, e.g. 0.1.2 and must have a plugin.json
+                                 with name, version, desc, and behaviors keys. To refresh the available versions, just resubmit the plugin."]
+                                [:label "Github URL for plugin: "]
+                                input
+                                ]
+                         :buttons [{:label "cancel"}
+                                   {:label "submit"
+                                    :action (fn []
+                                              (object/raise manager :submit-plugin! (dom/val input)))}]})]
+    (dom/focus input)
+    (.setSelectionRange input 1000 1000)))
+
+(defui tab [this tab-name label]
+  [:button {:class (bound this #(when (= tab-name (:tab %))
+                                  "active"))}
+   label]
+  :click (fn []
+           (object/merge! this {:tab tab-name})))
+
+(defui search-input [this]
+  [:input {:placeholder "Search available plugins"}]
+  :focus (fn []
+           (ctx/in! :plugin-manager.search this))
+  :blur (fn []
+           (ctx/out! :plugin-manager.search)))
+
+(defui tabs-and-search [this]
+  [:div.tabs
+   (tab this :server "Available")
+   (tab this :installed "Installed")
+   (search-input this)])
+
+(defui source-button [plugin]
+  [:span.source [:a {:href (:url plugin (:source plugin))} "source"]]
+  :click (fn [e]
+           (dom/prevent e)
+           (dom/stop-propagation e)
+           (.Shell.openExternal app/gui (:url plugin (:source plugin)))))
+
+(defui update-button [plugin]
+  [:span.update]
+  :click (fn [e]
+           (dom/prevent e)
+           (dom/stop-propagation e)
+           (discover-deps plugin nil)))
+
+(defui server-plugin-ui [plugin]
+  (let [info (:info plugin)
+        ver (:version info)
+        installed (-> @app/app ::plugins (get (:name info)))]
+    [:li
+     (when installed
+       (if (and (:version installed)
+                (deploy/is-newer? (:version installed) ver))
+         (update-button plugin)
+         [:span.installed]))
+     (source-button plugin)
+     [:h1 (:name info) [:span.version ver]]
+     [:h3 (:author info)]
+     [:p (:desc info)]])
+  :click (fn []
+           (this-as me
+                    (discover-deps plugin (fn []
+                                            (dom/append me (crate/html [:span.installed]))
+                                            )))))
+
+
+(defui uninstall-button [plugin]
+  [:span.uninstall]
+  :click (fn []
+           (popup/popup! {:header "Uninstall plugin?"
+                          :body [:div "This will delete the plugin from your system, removing any local
+                                 changes you may have made, and cannot be undone."]
+                          :buttons [{:label "Delete plugin"
+                                     :action (fn []
+                                               (uninstall plugin))}
+                                    {:label "Cancel"}]})))
+
+(defui installed-plugin-ui [plugin]
+  (let [cached (-> @manager :version-cache (get (:name plugin)))]
+    [:li
+     (if (and (deploy/is-newer? (:version plugin) cached))
+       (update-button (assoc plugin :version cached))
+       (uninstall-button plugin))
+     (source-button plugin)
+     [:h1 (:name plugin) [:span.version (:version plugin)]]
+     [:h3 (:author plugin)]
+     [:p (:desc plugin)]
+     ]))
+
+;;*********************************************************
+;; Manager object
+;;*********************************************************
+
+(object/object* ::plugin-manager
+                :tags #{:plugin-manager}
+                :name "Plugins"
+                :tab :server
+                :init (fn [this]
+                        [:div {:class (bound this #(str "plugin-manager"
+                                                        (if (= (:tab %) :server)
+                                                          " server")))}
+                         (tabs-and-search this)
+                         [:ul.server-plugins
+                          ]
+                         [:ul.plugins]]))
+
+(def manager (object/create ::plugin-manager))
+
+;;*********************************************************
+;; Manager behaviors
+;;*********************************************************
+
+(behavior ::update-server-plugins
+          :triggers #{:fetch-plugins}
+          :desc "Plugin Manager: fetch plugins"
+          :reaction (fn [this]
+                      (notifos/working "Fetching available plugins...")
+                      (fetch/xhr [:post (str plugins-url "/versions")] {:names (pr-str (-> @app/app ::plugins keys vec))}
+                                 (fn [data]
+                                   (let [cache (EOF-read data)]
+                                     (when-not (= cache (:version-cache @this))
+                                       (object/merge! this {:version-cache cache})
+                                       (object/raise this :refresh!)))))
+                      (fetch/xhr [:get plugins-url] {}
+                                 (fn [data]
+                                   (notifos/done-working "")
+                                   (when data
+                                     (object/raise this :plugin-results (EOF-read data)))
+                                   ))))
+
+(behavior ::render-server-plugins
+          :triggers #{:plugin-results}
+          :desc "Plugin Manager: render plugin results"
+          :reaction (fn [this plugins]
+                      (let [ul (dom/$ :.server-plugins (object/->content this))]
+                        (dom/empty ul)
+                        (dom/append ul (dom/fragment (map server-plugin-ui plugins))))))
+
+(behavior ::submit-plugin
+          :triggers #{:submit-plugin!}
+          :desc "Plugin Manager: submit a new plugin"
+          :reaction (fn [this url]
+                      (notifos/working (str "Submitting plugin: " url))
+                      (fetch/xhr [:post (str plugins-url "/add" )] {:url url}
+                                 (fn [data]
+                                   (notifos/done-working "")
+                                   (let [data (EOF-read data)]
+                                     (popup/popup! {:header (condp = (:status data)
+                                                              :success "Plugin added!"
+                                                              :error "There's a problem with the plugin."
+                                                              :refresh "Plugin refreshed!")
+                                                    :body [:div
+                                                           (if (= (:status data) :error)
+                                                             [:div "Url submitted: " url])
+                                                           [:p (:description data)]]
+                                                    :buttons [{:label "ok"}]}))))))
+
+(behavior ::search-server-plugins
+          :triggers #{:search-plugins!}
+          :desc "Plugin Manager: search plugins"
+          :reaction (fn [this search]
+                      (if (empty? search)
+                        (object/raise this :fetch-plugins)
+                        (do
+                          (notifos/working (str "Searching plugins for: " search))
+                          (fetch/xhr [:post (str plugins-url "/search")] {:term search}
+                                     (fn [data]
+                                       (notifos/done-working "")
+                                       (when data
+                                         (object/raise this :plugin-results (EOF-read data)))
+                                       ))))))
+
+(behavior ::render-installed-plugins
+          :triggers #{:refresh!}
+          :desc "Plugin Manager: refresh installed plugins"
+          :reaction (fn [this plugins]
+                      (object/merge! app/app {::plugins (available-plugins)})
+                      (let [ul (dom/$ :.plugins (object/->content this))]
+                        (dom/empty ul)
+                        (dom/append ul (dom/fragment (map installed-plugin-ui (-> @app/app ::plugins vals)))))))
+
+(behavior ::on-close
+          :triggers #{:close}
+          :reaction (fn [this]
+                      (tabs/rem! this)))
+
+;;*********************************************************
+;; Manager commands
+;;*********************************************************
+
+(cmd/command {:command :plugin-manager.submit
+              :desc "Plugins: Submit a plugin"
+              :exec (fn []
+                      (submit-url))})
+
+(cmd/command {:command :plugin-manager.search
+              :hidden true
+              :desc "Plugins: Search"
+              :exec (fn [term]
+                      (let [term (or term
+                                     (dom/val (dom/$ :input (object/->content manager))))]
+                        (object/merge! manager {:tab :server})
+                        (object/raise manager :search-plugins! term)))})
+
+(cmd/command {:command :plugin-manager.refresh
+              :desc "Plugins: refresh plugin list"
+              :exec (fn []
+                      (object/raise manager :refresh!)
+                      (object/raise manager :fetch-plugins))})
+
+(cmd/command {:command :plugin-manager.show
+              :desc "Plugins: Show plugin manager"
+              :exec (fn []
+                      (tabs/add-or-focus! manager)
+                      (cmd/exec! :plugin-manager.refresh))})
+
+;;*********************************************************
+;; App-level plugin behaviors
+;;*********************************************************

 (behavior ::init-plugins
           :triggers #{:pre-init}
@@ -194,310 +518,10 @@
                           (object/merge! this {::plugin-path (files/parent plugin-edn)})
                           (object/add-tags this [:plugin.file])))))

-(def plugin-url "http://plugins.lighttable.com")
-
-(behavior ::update-server-plugins
-          :triggers #{:fetch-plugins}
-          :desc "Plugin Manager: fetch plugins"
-          :reaction (fn [this]
-                      (notifos/working "Fetching available plugins...")
-                      (fetch/xhr [:post (str plugin-url "/versions")] {:names (pr-str (-> @app/app ::plugins keys vec))}
-                                 (fn [data]
-                                   (let [cache (EOF-read data)]
-                                     (when-not (= cache (:version-cache @this))
-                                       (object/merge! this {:version-cache cache})
-                                       (object/raise this :refresh!)))))
-                      (fetch/xhr [:get plugin-url] {}
-                                 (fn [data]
-                                   (notifos/done-working "")
-                                   (when data
-                                     (object/raise this :plugin-results (EOF-read data)))
-                                   ))))
-
-
-(defui source-button [plugin]
-  [:span.source [:a {:href (:url plugin (:source plugin))} "source"]]
-  :click (fn [e]
-           (dom/prevent e)
-           (dom/stop-propagation e)
-           (.Shell.openExternal app/gui (:url plugin (:source plugin)))))
-
-(defui update-button [plugin]
-  [:span.update]
-  :click (fn [e]
-           (dom/prevent e)
-           (dom/stop-propagation e)
-           (discover-deps plugin nil)))
-
-(defn install-version [plugin cb]
-  (let [name (-> plugin :info :name)
-        ver (-> plugin :version)
-        installed? (-> @app/app ::plugins (get name))]
-    (if (or (not installed?)
-            (and (:version installed?)
-                 (deploy/is-newer? (:version installed?) ver)))
-      (do
-        (object/update! app/app [::plugins] assoc name {})
-        (fetch-and-install (-> plugin :tar) name
-                           (fn []
-                             (when cb
-                               (cb true))
-                             (object/raise manager :refresh!)
-                             )))
-      (do
-        (notifos/set-msg! (str name " is already installed"))
-        (when cb
-          (cb false))))))
-
-(defn transitive-install [plugin deps cb]
-  (let [cur (or (-> plugin :name) (-> plugin :info :name))
-        others (dissoc deps cur)
-        counter (atom (count others))
-        count-down (fn []
-                     (swap! counter dec)
-                     ;;then install the actual plugin
-                     (when (<= @counter 0)
-                       (install-version (deps cur) (fn [installed?]
-                                                     (when cb
-                                                       (cb installed?))
-                                                     (when installed?
-                                                       ;;a new plugin has been installed, we should reload everything
-                                                       (cmd/exec! :behaviors.reload))))))]
-    ;;first get and install all the deps
-    ;;count them down and then install the real plugin and reload.
-    (if (seq others)
-      (doseq [[_ dep] others]
-        (install-version dep count-down))
-      (count-down))))
-
-(defn discover-deps [plugin cb]
-  (fetch/xhr [:post (str plugin-url "/install")] {:name (or (-> plugin :name) (-> plugin :info :name))
-                                                  :version (or (-> plugin :version)
-                                                               (-> plugin :info :version))}
-                                   (fn [data]
-                                     (transitive-install plugin (EOF-read data) cb))))
-
-(defui server-plugin-ui [plugin]
-  (let [info (:info plugin)
-        ver (:version info)
-        installed (-> @app/app ::plugins (get (:name info)))]
-    [:li
-     (when installed
-       (if (and (:version installed)
-                (deploy/is-newer? (:version installed) ver))
-         (update-button plugin)
-         [:span.installed]))
-     (source-button plugin)
-     [:h1 (:name info) [:span.version ver]]
-     [:h3 (:author info)]
-     [:p (:desc info)]])
-  :click (fn []
-           (this-as me
-                    (discover-deps plugin (fn []
-                                            (dom/append me (crate/html [:span.installed]))
-                                            )))))
-
-(defn uninstall [plugin]
-  (files/delete! (:dir plugin))
-  (object/raise manager :refresh!))
-
-(defui uninstall-button [plugin]
-  [:span.uninstall]
-  :click (fn []
-           (popup/popup! {:header "Uninstall plugin?"
-                          :body [:div "This will delete the plugin from your system, removing any local
-                                 changes you may have made, and cannot be undone."]
-                          :buttons [{:label "Delete plugin"
-                                     :action (fn []
-                                               (uninstall plugin))}
-                                    {:label "Cancel"}]})))
-
-(defui installed-plugin-ui [plugin]
-  (let [cached (-> @manager :version-cache (get (:name plugin)))]
-    [:li
-     (if (and (deploy/is-newer? (:version plugin) cached))
-       (update-button (assoc plugin :version cached))
-       (uninstall-button plugin))
-     (source-button plugin)
-     [:h1 (:name plugin) [:span.version (:version plugin)]]
-     [:h3 (:author plugin)]
-     [:p (:desc plugin)]
-     ]))
-
-(behavior ::render-server-plugins
-          :triggers #{:plugin-results}
-          :desc "Plugin Manager: render plugin results"
-          :reaction (fn [this plugins]
-                      (let [ul (dom/$ :.server-plugins (object/->content this))]
-                        (dom/empty ul)
-                        (dom/append ul (dom/fragment (map server-plugin-ui plugins))))))
-
-(behavior ::submit-plugin
-          :triggers #{:submit-plugin!}
-          :desc "Plugin Manager: submit a new plugin"
-          :reaction (fn [this url]
-                      (notifos/working (str "Submitting plugin: " url))
-                      (fetch/xhr [:post (str plugin-url "/add" )] {:url url}
-                                 (fn [data]
-                                   (notifos/done-working "")
-                                   (let [data (EOF-read data)]
-                                     (popup/popup! {:header (condp = (:status data)
-                                                              :success "Plugin added!"
-                                                              :error "There's a problem with the plugin."
-                                                              :refresh "Plugin refreshed!")
-                                                    :body [:div
-                                                           (if (= (:status data) :error)
-                                                             [:div "Url submitted: " url])
-                                                           [:p (:description data)]]
-                                                    :buttons [{:label "ok"}]}))))))
-
-(behavior ::search-server-plugins
-          :triggers #{:search-plugins!}
-          :desc "Plugin Manager: search plugins"
-          :reaction (fn [this search]
-                      (if (empty? search)
-                        (object/raise this :fetch-plugins)
-                        (do
-                          (notifos/working (str "Searching plugins for: " search))
-                          (fetch/xhr [:post (str plugin-url "/search")] {:term search}
-                                     (fn [data]
-                                       (notifos/done-working "")
-                                       (when data
-                                         (object/raise this :plugin-results (EOF-read data)))
-                                       ))))))
-
-(behavior ::render-installed-plugins
-          :triggers #{:refresh!}
-          :desc "Plugin Manager: refresh installed plugins"
-          :reaction (fn [this plugins]
-                      (object/merge! app/app {::plugins (available-plugins)})
-                      (let [ul (dom/$ :.plugins (object/->content this))]
-                        (dom/empty ul)
-                        (dom/append ul (dom/fragment (map installed-plugin-ui (-> @app/app ::plugins vals)))))))
-
-(behavior ::on-close
-          :triggers #{:close}
-          :reaction (fn [this]
-                      (tabs/rem! this)))
-
-(defui tab [this tab-name label]
-  [:button {:class (bound this #(when (= tab-name (:tab %))
-                                  "active"))}
-   label]
-  :click (fn []
-           (object/merge! this {:tab tab-name})))
-
-(defui search-input [this]
-  [:input {:placeholder "Search available plugins"}]
-  :focus (fn []
-           (ctx/in! :plugin-manager.search this))
-  :blur (fn []
-           (ctx/out! :plugin-manager.search)))
-
-(defui tabs-and-search [this]
-  [:div.tabs
-   (tab this :server "Available")
-   (tab this :installed "Installed")
-   (search-input this)]
-  )
-
-(object/object* ::plugin-manager
-                :tags #{:plugin-manager}
-                :name "Plugins"
-                :tab :server
-                :init (fn [this]
-                        [:div {:class (bound this #(str "plugin-manager"
-                                                        (if (= (:tab %) :server)
-                                                          " server")))}
-                         (tabs-and-search this)
-                         [:ul.server-plugins
-                          ]
-                         [:ul.plugins]]))
-
-(defn fetch-and-install [url name cb]
-  (let [tmp-gz (str plugins-dir "/" name "tmp.tar.gz")
-        tmp-dir (str plugins-dir "/" name "-tmp")]
-    (notifos/working (str "Downloading plugin: " name))
-    (deploy/download-file url tmp-gz (fn []
-                                       (notifos/done-working)
-                                       (notifos/working "Extracting plugin...")
-                                       (deploy/untar tmp-gz tmp-dir
-                                                     (fn []
-                                                       (let [munged-dir (first (files/full-path-ls tmp-dir))]
-                                                         (files/move! munged-dir (str plugins-dir "/" name "/"))
-                                                         (files/delete! tmp-dir)
-                                                         (files/delete! tmp-gz)
-                                                         (notifos/done-working (str "Plugin fetched: " name))
-                                                         (object/raise manager :plugin.fetched)
-                                                         (when cb
-                                                           (cb))
-                                                         )))))))
-
-;(object/raise manager :submit-plugin! "https://github.com/LightTable/LightTable-Rainbow")
-
-
-(def manager (object/create ::plugin-manager))
-
-(cmd/command {:command :plugin-manager.search
-              :hidden true
-              :desc "Plugins: Search"
-              :exec (fn [term]
-                      (let [term (or term
-                                     (dom/val (dom/$ :input (object/->content manager))))]
-                        (object/merge! manager {:tab :server})
-                        (object/raise manager :search-plugins! term)))})
-
-(cmd/command {:command :plugin-manager.refresh
-              :desc "Plugins: refresh plugin list"
-              :exec (fn []
-                      (object/raise manager :refresh!)
-                      (object/raise manager :fetch-plugins))})
-
-(cmd/command {:command :plugin-manager.show
-              :desc "Plugins: Show plugin manager"
-              :exec (fn []
-                      (tabs/add-or-focus! manager)
-                      (cmd/exec! :plugin-manager.refresh))})
-
-
-(defui url-input []
-  [:input {:type "text" :placeholder "Github URL"}]
-  :focus (fn []
-           (ctx/in! :popup.input))
-  :blur (fn []
-          (ctx/out! :popup.input)))
-
-(defn submit-url []
-  (let [input (url-input)
-        p (popup/popup! {:header "Submit a plugin to the central repository"
-                         :body [:div
-                                [:p "You can submit a github url to add a plugin to the central repository.
-                                 All plugin repos must have at least one tag in version format, e.g. 0.1.2 and must have a plugin.json
-                                 with name, version, desc, and behaviors keys. To refresh the available versions, just resubmit the plugin."]
-                                [:label "Github URL for plugin: "]
-                                input
-                                ]
-                         :buttons [{:label "cancel"}
-                                   {:label "submit"
-                                    :action (fn []
-                                              (object/raise manager :submit-plugin! (dom/val input)))}]})]
-    (dom/focus input)
-    (.setSelectionRange input 1000 1000)))
-
-(cmd/command {:command :plugin-manager.submit
-              :desc "Plugins: Submit a plugin"
-              :exec (fn []
-                      (submit-url)
-                      )})
-
-(cmd/command {:command :build
-              :desc "Editor: build file or project"
-              :exec (fn []
-                      (when-let [ed (pool/last-active)]
-                        (object/raise ed :build)))})
-
+;;*********************************************************
+;; App-level init
+;;*********************************************************

 ;;This call to tag-behaviors is necessary as there are no behaviors loaded when the
 ;;app is first run.
-(object/tag-behaviors :app [::init-plugins ::plugin-behavior-diffs ::plugin-keymap-diffs])
-
+(object/tag-behaviors :app [::init-plugins ::plugin-behavior-diffs ::plugin-keymap-diffs])


Fix a couple tests

Fix a couple tests

--- test/lein_fore_prob/test/core.clj
+++ test/lein_fore_prob/test/core.clj
@@ -279,10 +279,10 @@

 (deftest get-src
   (testing "empty file"
-    (is (= (with-redefs [slurp (constantly "")] (#'fp/get-src {:title "yo"})))
-        ""))
-  (is (= (with-redefs [slurp (constantly "xY3")] (#'fp/get-src {:title "yo"})))
-      "xY3"))
+    (is (= (with-redefs [slurp (constantly "")] (#'fp/get-src {:title "yo"}))
+        "")))
+  (is (= (with-redefs [slurp (constantly "xY3")] (#'fp/get-src {:title "yo"}))
+      "xY3")))

 (deftest write-problem-tests
   (with-redefs [spit (fn [f code & _]


Add test

Add test

--- test/obb_rules/game_mode_test.clj
+++ test/obb_rules/game_mode_test.clj
@@ -1,6 +1,13 @@
 (ns obb-rules.game-mode-test
   (:require [obb-rules.game :as game]
             [obb-rules.board :as board]
+            [obb-rules.game-mode :as game-mode]
             [obb-rules.turn :as turn]
             [obb-rules.stash :as stash])
   (:use clojure.test))
+
+(deftest dont-finalize-on-deploy
+  (let [game-on-deploy (game/random)
+        final-game (game-mode/process game-on-deploy)]
+    (is (not (game-mode/final? game-on-deploy)))
+    (is (= :deploy (game/state final-game)))))


Fix killed test.

Fix killed test.

--- test/onyx/log/killed_job_test.clj
+++ test/onyx/log/killed_job_test.clj
@@ -32,6 +32,6 @@

   (fact diff => #{:j1})

-  (fact a-reactions => [{:fn :volunteer-for-task :args {:id :a}}])
-  (fact d-reactions => nil))
+  (fact a-reactions => [])
+  (fact d-reactions => []))


Fixed unit test.

Fixed unit test.

--- test/pe_apptxn_core/core_test.clj
+++ test/pe_apptxn_core/core_test.clj
@@ -101,8 +101,7 @@
           (is (= t2 (c/from-sql-date (:logged_at apptxn-log-rs))))
           (is (= 32 (:event_type apptxn-log-rs)))
           (is (= 4 (:in_ctx_err_code apptxn-log-rs)))
-          (is (= "some err" (:in_ctx_err_desc apptxn-log-rs)))
-          (is (nil? ())))
+          (is (= "some err" (:in_ctx_err_desc apptxn-log-rs))))
         (core/save-new-apptxn-usecase-log conn
                                           new-user-id
                                           new-apptxn-uc-id


Updated with-redefs test override and restore

--- test/promesa/tests/core_test.cljc
+++ test/promesa/tests/core_test.cljc
@@ -474,17 +474,24 @@
     #?(:cljs (t/async done (p/do (test) (done)))
        :clj @(test))))

-
-(defn test-fn
+;; Create some test variables and a test fn
+;; These must be defined here as locals do not work
+
+(def redefs-var :original)
+(defn redefs-async-fn
   []
   (p/resolved "original"))

-(def test-var :original)
-
 (t/deftest with-redefs-macro
-  (let [p1 (p/with-redefs [test-fn  (fn [] (p/resolved "mocked"))
-                           test-var :mocked]
-             (p/then (test-fn) #(vector % test-var)))
-        test #(p/then p1 (fn [res] (t/is (= res ["mocked" :mocked]))))]
-    #?(:cljs (t/async done (p/do (test) (done)))
-       :clj @(test))))
+  (let [original-fn redefs-async-fn
+        p1 (p/with-redefs [redefs-async-fn  (fn [] (p/resolved "mocked"))
+                           redefs-var :mocked]
+             (p/then (redefs-async-fn)
+                     (fn [v]
+                       (not= redefs-async-fn original-fn)
+                       [v redefs-var])))
+        test #(p/then p1 (fn [res]
+                           (t/is (= res ["mocked" :mocked]))
+                           (t/is (= redefs-async-fn original-fn))))]
+    #?(:cljs (t/async done (p/do (test) (done)))
+       :clj @(test))))


And again

And again

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -16,8 +16,8 @@
 (defpartial wish-li-last []
   [:li.wish.last
    [:div.delete]
-   [:input {:type "text" :class "description" :value desc}]
-   [:input {:type "text" :class "url" :value url}]])
+   [:input {:type "text" :class "description"}]
+   [:input {:type "text" :class "url"}]])

 (defpartial wish-ul [wishes]
   [:ul.wishes


bug fixes on wishlist-title-changer cljs

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -114,7 +114,9 @@
 (defn wishlist-title-changer []
   (delegate $header wishlist-title :change
     (fn [e]
-      (update-wishlist-title-rem))))
+      (this-as me
+        (when-not (empty? (val ($ me)))
+          (update-wishlist-title-rem))))))

 (defn wishlist-wish-description-changer []
   (delegate $content ".description" :change


Do we need to clean the assets?

Do we need to clean the assets?

--- tasks/leiningen/compile_assets.clj
+++ tasks/leiningen/compile_assets.clj
@@ -8,6 +8,7 @@
      (require '[clojure.tools.logging :refer (info)])
      (require '[staircase.tasks.assets :as assets])
      (info "Precompiling assets...")
+     (assets/clean)
      (assets/precompile)))

 (defn precompile-assets [f & [project :as args]]


remove comment

remove comment

--- src/pc/views/content.clj
+++ src/pc/views/content.clj
@@ -102,8 +102,7 @@
     [:link {:rel "stylesheet"       :href (pc.assets/asset-path "/css/app.css")}]
     [:link {:rel "stylesheet"       :href "https://fonts.googleapis.com/css?family=Roboto:500,900,100,300,700,400"}]

-    [:style ;"#om-app{min-height:100vh;background-size:10px 10px,10px 10px,100px 100px,100px 100px;background-color:rgba(51,51,51,1);background-image:linear-gradient(to bottom,rgba(85,85,85,.25)10%,rgba(85,85,85,0)10%),linear-gradient(to right,rgba(85,85,85,.25)10%,rgba(85,85,85,0)10%),linear-gradient(to bottom,rgba(85,85,85,.57)1%,rgba(85,85,85,0)1%),linear-gradient(to right,rgba(85,85,85,.57)1%,rgba(85,85,85,0)1%);}#om-app:active{cursor:wait;}"
-     (common/head-style)]
+    [:style (common/head-style)]

     (embed-json-in-head "window.Precursor"
                         (json/encode (-> view-data


Reduce MARC parsing overhead by buffering records and batching them.

--- src/marcgrep/backends/nla.clj
+++ src/marcgrep/backends/nla.clj
@@ -7,6 +7,9 @@
            [org.apache.lucene.document FieldSelector FieldSelectorResult]
            [org.apache.lucene.index IndexReader]
            [java.util.concurrent LinkedBlockingQueue]))
+
+
+(def batch-size 64)

 (defn filter-nla-record [^Record record]
@@ -26,17 +29,21 @@

 (defn worker-job [ir ids queue running?]
   (future
-    (doseq [id ids
+    (doseq [batch (partition-all batch-size ids)
             :while @running?]
-      (when-not (.isDeleted ir id)
-        (let [doc (.document ir id)]
-          (.put queue
-                (->
-                 (.next (MarcXmlReader.
-                         (ByteArrayInputStream.
-                          (.getBytes (first (.getValues doc "fullrecord"))
-                                     "UTF-8"))))
-                 (filter-nla-record))))))
+      (let [in (MarcXmlReader.
+                (ByteArrayInputStream.
+                 (.getBytes (str "<collection>"
+                                 (apply str (keep (fn [id]
+                                                    (when-not (.isDeleted ir id)
+                                                      (let [doc (.document ir id)]
+                                                        (first (.getValues doc "fullrecord")))))
+                                                  batch))
+                                 "</collection>")
+                            "UTF-8")))]
+        (while (.hasNext in)
+          (.put queue (-> (.next in)
+                          (filter-nla-record))))))
     (when @running?
       (.put queue :eof))
     (.println System/err "NLA record reader finished")))


Throw 400 if slug name already taken :scream_cat:

--- src/metabase/models/label.clj
+++ src/metabase/models/label.clj
@@ -6,13 +6,19 @@

 (i/defentity Label :label)

+(defn- assert-unique-slug [slug]
+  (when (db/exists? Label :slug slug)
+    (throw (ex-info "Name already taken" {:status-code 400, :errors {:name "A label with this name already exists"}}))))
+
 (defn- pre-insert [{label-name :name, :as label}]
-  (assoc label :slug (u/slugify label-name)))
+  (assoc label :slug (u/prog1 (u/slugify label-name)
+                       (assert-unique-slug <>))))

 (defn- pre-update [{label-name :name, :as label}]
   (if-not label-name
     label
-    (assoc label :slug (u/slugify label-name))))
+    (assoc label :slug (u/prog1 (u/slugify label-name)
+                         (assert-unique-slug <>)))))

 (defn- pre-cascade-delete [{:keys [id]}]
   (db/cascade-delete 'CardLabel :label_id id))


(PE-6014) Removed unused requires

(PE-6014) Removed unused requires

--- test/puppetlabs/services/ca/certificate_authority_disabled_test.clj
+++ test/puppetlabs/services/ca/certificate_authority_disabled_test.clj
@@ -2,12 +2,10 @@
   (:require [clojure.test :refer :all]
             [me.raynes.fs :as fs]
             [puppetlabs.services.ca.certificate-authority-disabled-service :as disabled]
-            [puppetlabs.services.config.puppet-server-config-service :as config]
             [puppetlabs.services.jruby.testutils :as jruby-testutils]
             [puppetlabs.services.jruby.jruby-puppet-service :as jruby]
             [puppetlabs.services.puppet-profiler.puppet-profiler-service :as profiler]
             [puppetlabs.trapperkeeper.app :as tk-app]
-            [puppetlabs.trapperkeeper.services.webserver.jetty9-service :as webserver]
             [puppetlabs.trapperkeeper.testutils.logging :as logutils]
             [puppetlabs.trapperkeeper.testutils.bootstrap :as tk-testutils]))


added debug flag for outputs defaults to false

--- src/error_codes/core.clj
+++ src/error_codes/core.clj
@@ -4,6 +4,11 @@
   (:use [clojure.core.matrix]))

 (set! *warn-on-reflection* true)
+(def ^:dynamic *DEBUG* false)
+
+(defn dprintln [& args]
+  (when *DEBUG*
+    (println args)))

 (defn lev [str1 str2]
   (let [mat (new-matrix :ndarray (inc (count str1)) (inc (count str2)))]
@@ -129,13 +134,13 @@
   (let [res (let [bar-count (lookup-bar (case type
                                 :one-to-many (nth t1 a)
                                 :many-to-one (nth t2 b)))
-                  _ (prn "bar-count " bar-count (nth t1 a))]
+                  _ (dprintln "bar-count " bar-count (nth t1 a))]
     (loop [[[ia ib] & is] insdel acc 0 ret []]
       (if ia
         (let [bc (lookup-bar (case type
                                :one-to-many (nth t2 ib)
                                :many-to-one (nth t1 ia)))
-#_#_              _ (prn "bc " bc (nth t2 ib)
+#_#_              _ (dprintln "bc " bc (nth t2 ib)
                      "acc " acc " ret " ret
                      (>= (+ acc bc) bar-count)
                      "ia ib " ia ib)]
@@ -143,20 +148,20 @@
             (conj ret [ia ib])
             (recur is (+ acc bc) (conj ret [ia ib]))))
         ret)))]
-     (prn "take-bars " res)
+     (dprintln "take-bars " res)
      res))
   ;;;todo take care of how many are allowed to be extracted
   ;;;we know that count-free is > 0 at the beginning
   ;;;be careful at the start of the error
 (defn- extract [t1 t2 fl type]
   (for [[fs insdel] fl]
-    (let [_ (prn "fs " fs "insdel " insdel "count-free" (- (count insdel) (count fs)))
+    (let [_ (dprintln "fs " fs "insdel " insdel "count-free" (- (count insdel) (count fs)))
           count-freepp (- (count insdel) (count fs))]
       (loop [[[a b] & ss :as aktfs] fs extr [] insdel insdel
              count-free (- (count insdel) (count fs))]
         (if (and a (seq insdel))
           (let [ext (take-bars t1 t2 [a b] (take (inc count-free) insdel) type)
-                _ (prn "ext-after-take-bars " [a b]  ext "insdel-for-ext " insdel "count-free " count-free)]
+                _ (dprintln "ext-after-take-bars " [a b]  ext "insdel-for-ext " insdel "count-free " count-free)]
             (recur ;dont drop here
              ss
              (conj extr [[a b] ext])
@@ -183,11 +188,11 @@
 (defn extract-count-changing-errors [type edits t1 t2]
   (let [{:keys [substitutions insertions deletions]} edits
         fs (extract-following-substitutions substitutions)
-        _ (prn "fs " fs)
+        _ (dprintln "fs " fs)
         fi (add-following fs (case type :one-to-many insertions :many-to-one deletions) type)
-        _ (prn "fi " fi)
+        _ (dprintln "fi " fi)
         ext (apply concat (extract t1 t2 fi type))
-        _ (prn "ext " ext)
+        _ (dprintln "ext " ext)
         nedits (delete-from-edits edits (partition 2 (flatten ext)))
         res
         [(for [[[a b] e] ext]
@@ -199,7 +204,7 @@
                              [a (second (first e))] [(inc a) (second (last e))]]
                :many-to-one [[7 (to-code-number (nth t2 b))]
                              [(first (first e)) b] [(first (last e)) (inc b)]]))) nedits]
-        _ (prn "extr " ext "res" (first res))]
+        _ (dprintln "extr " ext "res" (first res))]
     res))

 (def extraction-list
@@ -221,7 +226,7 @@
         ocr-res (get-files-sorted "/home/kima/programming/ocr-visualizer/resources/public/ocr-results/")]
     (doall (pmap (fn [gt ocr]
                    (let [filename (str "/home/kima/programming/ocr-visualizer/resources/public/edits/" (.getName gt))]
-                     (prn "error-counts for " filename)
+                     (dprintln "error-counts for " filename)
                      (spit filename (pr-str (error-codes (slurp gt) (slurp ocr))))))
                  gts ocr-res))))

@@ -232,7 +237,7 @@
     (doall (pmap (fn [gt ocr]
                    (let [filename (file base-directory
                                         "edits/" (.getName gt))]
-                     (prn "error-counts for " filename)
+                     (dprintln "error-counts for " filename)
                      (spit filename (pr-str (error-codes (slurp gt) (slurp ocr))))))
                  gts ocr-res))))

@@ -253,7 +258,7 @@

 (defn deploy-base-direcories []
   (doseq [bd base-directories]
-    (prn "<<<<<<<<<<<<<<<<<now " bd ">>>>>>>>>>>>>>>>>>")
+    (dprintln "<<<<<<<<<<<<<<<<<now " bd ">>>>>>>>>>>>>>>>>>")
     (deploy-error-codes bd)))

 (defn word-count [text]
@@ -324,7 +329,7 @@
   (let [lines (.split gt "\n")
         end-of-first-line (count (first lines))
         start-of-last-line (- (count gt) (count (last lines)))]
-    (prn end-of-first-line start-of-last-line)
+    (dprintln end-of-first-line start-of-last-line)
     (filter (fn [[code [gt _] & rest]]
               (> start-of-last-line gt end-of-first-line)) errors)))

@@ -337,7 +342,7 @@
                            (range (dec (count ocr)) 0 -1))
         starting (or (last starting) 0)
         ending (or (last ending) (count ocr))]
-    (prn starting ending)
+    (dprintln starting ending)
     (filter (fn [[code [_ ocr] & rest]]
               (> ending ocr starting)) errors)))

@@ -371,7 +376,7 @@
            edits (map (comp read-string slurp)  (get-files-sorted (file base-directory "edits/")))
            edits (map (partial run-filters filters)
                       edits ground-truth ocr-res)
-           _ (prn (first edits))
+           _ (dprintln (first edits))
            errors (->> (mapcat #(map (partial augment-error-code %1 %2) %3) ground-truth ocr-res edits)
                        (mapcat error-code-to-matrix-entries)
                        (filter flavour))
@@ -382,10 +387,10 @@

 (defn gen-statistics-for-base-directories [bd]
   (into {} (for [d bd]
-             (do (prn "for base directory " d)
+             (do (dprintln "for base directory " d)
                  [d (into {}
                           (for [[n f] flavour-list]
-                            (do (prn "gen-statistics d n" d n)
+                            (do (dprintln "gen-statistics d n" d n)
                                 [n (apply generate-statistics d f)])))]))))


Pull user and org favs in.

Pull user and org favs in.

--- src/oc/storage/api/boards.clj
+++ src/oc/storage/api/boards.clj
@@ -20,7 +20,8 @@
             [oc.storage.resources.common :as common-res]
             [oc.storage.resources.org :as org-res]
             [oc.storage.resources.board :as board-res]
-            [oc.storage.resources.entry :as entry-res]))
+            [oc.storage.resources.entry :as entry-res]
+            [oc.storage.resources.reaction :as reaction-res]))

 ;; ----- Utility functions -----

@@ -34,8 +35,20 @@

 (defn- reactions
   "Return a sequence of just the reactions for an entry."
-  [{interactions :interactions}]
+  ([{interactions :interactions}]
   (filter :reaction interactions))
+
+  ([conn {interactions :interactions} org-id user-id]
+  (let [entry-reactions (filter :reaction interactions) ; reactions on the entry
+        ;; user's favorite reactions if we need them
+        user-faves (if (< (count entry-reactions) config/max-favorite-reaction-count)
+                      (concat entry-reactions (map #(hash-map :reaction %) (reaction-res/user-favorites conn user-id)))
+                      entry-reactions)
+        ; org's favorite reactions if we need them
+        org-faves (if (< (count user-faves) config/max-favorite-reaction-count)
+                      (concat user-faves (map #(hash-map :reaction %) (reaction-res/org-favorites conn org-id)))
+                      user-faves)]
+    org-faves)))

 (defun- assemble-board
   "Assemble the entry, author, and viewer data needed for a board response."
@@ -57,7 +70,9 @@
   ;; Regular board
   ([conn org :guard map? board :guard map? ctx]
   (let [org-slug (:slug org)
+        org-id (:uuid org)
         slug (:slug board)
+        user-id (-> ctx :user :user-id)
         entries (entry-res/list-entries-by-board conn (:uuid board)) ; all entries for the board
         board-topics (->> entries
                         (map #(select-keys % [:topic-slug :topic-name]))
@@ -69,8 +84,8 @@
                     board-topics ; just the board's topics
                     all-topics) ; board's and default
         entry-reps (map #(entry-rep/render-entry-for-collection org board %
-                            (comments %) (reactions %)
-                            (:access-level ctx) (-> ctx :user :user-id))
+                            (comments %) (reactions conn % org-id user-id)
+                            (:access-level ctx) user-id)
                       entries)]
     (assemble-board org-slug (assoc board :topics topics) entry-reps ctx)))