(maint) fix broken rollup

(maint) fix broken rollup

use realistic hashes in the resources-exist? test

--- test/puppetlabs/puppetdb/scf/storage_test.clj
+++ test/puppetlabs/puppetdb/scf/storage_test.clj
@@ -1632,9 +1632,13 @@
          resources-1
          resources-2)))

+(defn fake-hash
+  []
+  (shash/generic-identity-hash (random/random-string)))
+
 (deftest giant-resources-exist
   (testing "resources-exist?"
-    (is (= #{} (resources-exist? (set (take 40000 (repeatedly random/random-string))))))))
+    (is (= #{} (resources-exist? (set (take 40000 (repeatedly fake-hash))))))))

 (deftest test-merge-resource-hash
   (let [ref->resource {{:type "File" :title "/tmp/foo"}


Fix logged message formatting.

Fix logged message formatting.

--- src/dragon/components/httpd.clj
+++ src/dragon/components/httpd.clj
@@ -20,7 +20,7 @@
           main-handler {}
           site (ring-file/wrap-file main-handler docroot)
           server (server/run-server site {:port port})]
-      (log/debug "Serving files from % and listening on port %s"
+      (log/debugf "Serving files from %s and listening on port %s"
                   docroot port)
       (log/debug "Started httpd component.")
       (assoc component :server server)))


Use (pos? ..) instead of (> x 0) for positive checking

--- src/govuk/blinken/dashboard.clj
+++ src/govuk/blinken/dashboard.clj
@@ -11,7 +11,7 @@
        [:ul {:class "status-list"}
         [:li "Up: " [:span {:class "ok"} (count (:up status))]]
         [:li "Down: " [:span {:class "critical"} num-down]]]
-       (if (> num-down 0)
+       (if (pos? num-down)
          [:ul {:class "down-hosts"}
           (for [down-host (:down status)]
             [:li down-host])])])
@@ -41,7 +41,7 @@
         [:li "Warning: " [:span {:class "warning"} num-warning]]
         [:li "Critical: " [:span {:class "critical"} num-critical]]
         [:li "Unknown: " [:span {:class "unknown"} num-unknown]]]
-       (if (> (+ num-warning num-critical num-unknown) 0)
+       (if (pos? (+ num-warning num-critical num-unknown))
          [:table {:class "problem-alerts"}
           [:thead [:tr [:td] [:td "Host"] [:td "Name"] [:td "Info"]]]
           (list-alerts (:critical alerts) "critical")
@@ -55,8 +55,8 @@
   (let [critical-count (-> environment :alerts :critical count)
         warning-count (-> environment :alerts :warning count)
         level (cond (-> environment :alerts not) :no-data
-                    (> critical-count 0) :critical
-                    (> warning-count 0) :warning
+                    (pos? critical-count) :critical
+                    (pos? warning-count) :warning
                     :else :ok)]
     [:a {:href (str "/" (:group-id environment) "/" (:id environment))
          :class (str "environment-overview " (name level))}


add games list to new game page

add games list to new game page

--- src/greybear/pages/new_game.clj
+++ src/greybear/pages/new_game.clj
@@ -14,4 +14,6 @@
                    [:input {:type "hidden" :name "user-id"
                             :value (get-user-id request)}]
                    [:button.btn.btn-success "New Game"]]]
-                 [:div.col-md-5]])))
+                 [:div.col-md-5]]
+                [:div.row
+                 (games-partial)])))


add attribute invalidator

add attribute invalidator

--- src/domshot/core.cljs
+++ src/domshot/core.cljs
@@ -6,16 +6,30 @@

 ;; ---- Node validators ---- ;;

-(def invalidators
+(def node-invalidators
   "An atom of a list of predicates. Each takes the current node as its only arg.
   Predicates should return `true` if you want `snapshot` to ignore the node."
   (atom ()))

 (defn include-node? [node]
-  (not-any? false? (map #(% node) @invalidators)))
+  (not-any? false? (map #(% node) @node-invalidators)))

-(defn add-invalidator [fn]
-  (swap! invalidators conj fn))
+(def attr-invalidators
+  "An atom of a list of predicates. Each takes an attr name and val as its
+  args. Predicates should return `true` if you want `snapshot` to ignore the
+  attr name-val pair."
+  (atom ()))
+
+(defn include-attr? [name val]
+  (not-any? false? (map #(% name val) @attr-invalidators)))
+
+(defmulti add-invalidator (fn [_ invalidator-type] invalidator-type))
+
+(defmethod add-invalidator :attribute [fn]
+  (swap! attr-invalidators conj fn))
+
+(defmethod add-invalidator :default [fn]
+  (swap! attr-invalidators conj fn))

 ;; ---- Serializing the dom ---- ;;
@@ -27,7 +41,8 @@
             (for [i (range (.-length attrs))
                   :let [attr  (aget attrs i)
                         name  (.-name attr)
-                        value (.-value attr)]]
+                        value (.-value attr)]
+                  :when (include-attr? name value)]
               [name value])))
     {}))


Use *compiler-options* var to provide options to neko.init

--- src/leiningen/droid/compile.clj
+++ src/leiningen/droid/compile.clj
@@ -72,7 +72,7 @@
 ;;
 (def ^:private always-compile-ns
   '#{clojure.core clojure.core.protocols clojure.string
-     clojure.java.io neko.init neko.init.options})
+     clojure.java.io neko.init})

 (defn namespaces-to-compile
   "Takes project and returns a set of namespaces that should be AOT-compiled."
@@ -108,8 +108,14 @@
   (debug "Project classpath:" (get-classpath project))
   (let [nses (namespaces-to-compile project)
         dev-build (dev-build? project)
-        compiler-options (if dev-build {} {:elide-meta [:doc :file :line :added
-                                                        :arglists]})]
+        opts (cond-> {:neko.init/release-build (not dev-build)
+                      :neko.init/start-nrepl-server start-nrepl-server
+                      :neko.init/nrepl-port repl-device-port
+                      :neko.init/enable-dynamic-compilation
+                      enable-dynamic-compilation
+                      :neko.init/package-name (get-package-name manifest-path)}
+                     (not dev-build) (assoc :elide-meta
+                                       [:doc :file :line :added :arglists]))]
     (info (format "Build type: %s, dynamic compilation: %s, remote REPL: %s."
                   (if dev-build "debug" "release")
                   (if (or dev-build start-nrepl-server
@@ -117,20 +123,14 @@
                     "enabled" "disabled")
                   (if (or dev-build start-nrepl-server) "enabled" "disabled")))
     (let [form
-          `(binding [o/*release-build* ~(not dev-build)
-                     o/*start-nrepl-server* ~start-nrepl-server
-                     o/*enable-dynamic-compilation* ~enable-dynamic-compilation
-                     o/*package-name* ~(get-package-name manifest-path)
-                     o/*nrepl-port* ~repl-device-port
-                     *compiler-options* ~compiler-options]
+          `(binding [*compiler-options* ~opts]
              (doseq [namespace# '~nses]
                (println "Compiling" namespace#)
                (clojure.core/compile namespace#)))
           project (update-in project [:prep-tasks]
                              (partial remove #{"compile"}))]
       (.mkdirs (io/file (:compile-path project)))
-      (try (eval/eval-in-project project form
-                                 '(require '[neko.init.options :as o]))
+      (try (eval/eval-in-project project form)
            (info "Compilation succeeded.")
            (catch Exception e
              (abort "Compilation failed."))))))


fix a bug in the list feature that the hash of a namespace could not be showed

--- src/leiningen/leinsync/list.clj
+++ src/leiningen/leinsync/list.clj
@@ -16,7 +16,7 @@

 (defn aggregate [result [namespace project]]
   (assoc result namespace (if (contains? result namespace)
-                            (merge-with str project (get result namespace))
+                            (merge project (get result namespace))
                             project)))

 (defn merge-project-occurrence


Fixed science-keywords case sensitive parameter search.

--- src/cmr/search/services/parameters/converters/science_keyword.clj
+++ src/cmr/search/services/parameters/converters/science_keyword.clj
@@ -5,6 +5,11 @@

 (def science-keyword-fields
   [:category :topic :term :variable-level-1 :variable-level-2 :variable-level-3 :detailed-variable])
+
+(defn- science-keyword->elastic-keyword
+  "Returns the elastic keyword for the given science-keyword"
+  [science-keyword]
+  (keyword (str "science-keywords." (name science-keyword))))

 ;; Converts science keywords parameter and values into conditions
 (defmethod p/parameter->condition :science-keywords
@@ -25,8 +30,10 @@
             (map (fn [[pn pv]]
                    (if (= :any pn)
                      (qm/or-conds
-                       (map #(qm/string-condition % pv case-sensitive pattern)
+                       (map #(qm/string-condition
+                               (science-keyword->elastic-keyword %) pv case-sensitive pattern)
                             science-keyword-fields))
-                     (qm/string-condition pn pv case-sensitive pattern)))
+                     (qm/string-condition
+                       (science-keyword->elastic-keyword pn) pv case-sensitive pattern)))
                  value)))))))


conditionalize portions of the macros file

--- src/main/clojure/cljs/core.cljc
+++ src/main/clojure/cljs/core.cljc
@@ -87,25 +87,41 @@
 (defn- ^{:dynamic true} assert-valid-fdecl
   "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn."
   [fdecl]
-  (when (empty? fdecl) (throw (IllegalArgumentException.
-                                "Parameter declaration missing")))
-  (core/let [argdecls (map
-                   #(if (seq? %)
-                     (first %)
-                     (throw (IllegalArgumentException.
+  (when (empty? fdecl)
+    (throw
+      #?(:clj  (IllegalArgumentException. "Parameter declaration missing")
+         :cljs (js/Error. "Parameter declaration missing"))))
+  (core/let [argdecls
+             (map
+               #(if (seq? %)
+                 (first %)
+                 (throw
+                   #?(:clj (IllegalArgumentException.
+                             (if (seq? (first fdecl))
+                               (core/str "Invalid signature \""
+                                 %
+                                 "\" should be a list")
+                               (core/str "Parameter declaration \""
+                                 %
+                                 "\" should be a vector")))
+                      :cljs (js/Error.
                               (if (seq? (first fdecl))
                                 (core/str "Invalid signature \""
                                   %
                                   "\" should be a list")
                                 (core/str "Parameter declaration \""
                                   %
-                                  "\" should be a vector")))))
-                   fdecl)
-        bad-args (seq (remove #(vector? %) argdecls))]
+                                  "\" should be a vector"))))))
+               fdecl)
+             bad-args (seq (remove #(vector? %) argdecls))]
     (when bad-args
-      (throw (IllegalArgumentException.
-               (core/str "Parameter declaration \"" (first bad-args)
-                         "\" should be a vector"))))))
+      (throw
+        #?(:clj (IllegalArgumentException.
+                  (core/str "Parameter declaration \"" (first bad-args)
+                    "\" should be a vector"))
+           :cljs (js/Error.
+                   (core/str "Parameter declaration \"" (first bad-args)
+                     "\" should be a vector")))))))

 (def
   ^{:private true}
@@ -116,8 +132,10 @@
           (fn [fdecl]
             (core/let [arglist (first fdecl)
                   ;elide implicit macro args
-                  arglist (if (clojure.lang.Util/equals '&form (first arglist))
-                            (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist))
+                  arglist (if #?(:clj (clojure.lang.Util/equals '&form (first arglist))
+                                 :cljs (= '&form (first arglist)))
+                            #?(:clj (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist))
+                               :cljs (subvec arglist 2 (count arglist)))
                             arglist)
                   body (next fdecl)]
               (if (map? (first body))
@@ -137,12 +155,18 @@
      (def ~x ~init)))

 (core/defmacro ^{:private true} assert-args [fnname & pairs]
-  `(do (when-not ~(first pairs)
-         (throw (IllegalArgumentException.
-                  ~(core/str fnname " requires " (second pairs)))))
-     ~(core/let [more (nnext pairs)]
-        (when more
-          (list* `assert-args fnname more)))))
+  #?(:clj `(do (when-not ~(first pairs)
+                 (throw (IllegalArgumentException.
+                          ~(core/str fnname " requires " (second pairs)))))
+               ~(core/let [more (nnext pairs)]
+                  (when more
+                    (list* `assert-args fnname more))))
+     :cljs `(do (when-not ~(first pairs)
+                  (throw (js/Error.
+                           ~(core/str fnname " requires " (second pairs)))))
+                ~(core/let [more (nnext pairs)]
+                   (when more
+                     (list* `assert-args fnname more))))))

 (core/defn destructure [bindings]
   (core/let [bents (partition 2 bindings)
@@ -163,7 +187,9 @@
                                                       true)
                                  (= firstb :as) (pb ret (second bs) gvec)
                                  :else (if seen-rest?
-                                         (throw (new Exception "Unsupported binding form, only :as can follow & parameter"))
+                                         (throw
+                                           #?(:clj (new Exception "Unsupported binding form, only :as can follow & parameter")
+                                              :cljs (new js/Error "Unsupported binding form, only :as can follow & parameter")))
                                          (recur (pb ret firstb (core/list `nth gvec n nil))
                                                 (core/inc n)
                                                 (next bs)
@@ -201,12 +227,16 @@
                       (core/keyword? b) (-> bvec (conj (symbol (name b))) (conj v))
                       (vector? b) (pvec bvec b v)
                       (map? b) (pmap bvec b v)
-                      :else (throw (new Exception (core/str "Unsupported binding form: " b))))))
+                      :else (throw
+                              #?(:clj (new Exception (core/str "Unsupported binding form: " b))
+                                 :cljs (new js/Error (core/str "Unsupported binding form: " b)))))))
          process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
         (if (every? core/symbol? (map first bents))
           bindings
           (if-let [kwbs (seq (filter #(core/keyword? (first %)) bents))]
-            (throw (new Exception (core/str "Unsupported binding key: " (ffirst kwbs))))
+            (throw
+              #?(:clj (new Exception (core/str "Unsupported binding key: " (ffirst kwbs)))
+                 :cljs (new js/Error (core/str "Unsupported binding key: " (ffirst kwbs)))))
             (reduce process-entry [] bents)))))

 (core/defmacro let
@@ -1019,7 +1049,9 @@
 (defn- validate-fields
   [case name fields]
   (when-not (vector? fields)
-    (throw (AssertionError. (core/str case " " name ", no fields vector given.")))))
+    (throw
+      #?(:clj (AssertionError. (core/str case " " name ", no fields vector given."))
+         :cljs (js/Error. (core/str case " " name ", no fields vector given."))))))

 (core/defmacro deftype
   "(deftype name [fields*]  options* specs*)
@@ -1300,9 +1332,13 @@
         prefix (protocol-prefix p)
         _ (core/doseq [[mname & arities] methods]
             (when (some #{0} (map count (filter vector? arities)))
-              (throw (Exception.
-                       (core/str "Invalid protocol, " psym
-                                 " defines method " mname " with arity 0")))))
+              (throw
+                #?(:clj (Exception.
+                          (core/str "Invalid protocol, " psym
+                            " defines method " mname " with arity 0"))
+                   :cljs (js/Error.
+                           (core/str "Invalid protocol, " psym
+                             " defines method " mname " with arity 0"))))))
         expand-sig (fn [fname slot sig]
                      `(~sig
                        (if (and ~(first sig) (. ~(first sig) ~(symbol (core/str "-" slot)))) ;; Property access needed here.
@@ -1482,12 +1518,18 @@
 (defn- assoc-test [m test expr env]
   (if (contains? m test)
     (throw
-      (clojure.core/IllegalArgumentException.
-        (core/str "Duplicate case test constant '"
-          test "'"
-          (when (:line env)
-            (core/str " on line " (:line env) " "
-              cljs.analyzer/*cljs-file*)))))
+      #?(:clj (clojure.core/IllegalArgumentException.
+                (core/str "Duplicate case test constant '"
+                  test "'"
+                  (when (:line env)
+                    (core/str " on line " (:line env) " "
+                      cljs.analyzer/*cljs-file*))))
+         :cljs (js/Error.
+                 (core/str "Duplicate case test constant '"
+                   test "'"
+                   (when (:line env)
+                     (core/str " on line " (:line env) " "
+                       cljs.analyzer/*cljs-file*))))))
     (assoc m test expr)))

 (defn- const? [env x]
@@ -1868,9 +1910,9 @@
   [options & valid-keys]
   (when (seq (apply disj (apply core/hash-set (keys options)) valid-keys))
     (throw
-     (apply core/str "Only these options are valid: "
-	    (first valid-keys)
-	    (map #(core/str ", " %) (rest valid-keys))))))
+      (apply core/str "Only these options are valid: "
+        (first valid-keys)
+        (map #(core/str ", " %) (rest valid-keys))))))

 (core/defmacro defmulti
   "Creates a new multimethod with the associated dispatch function.
@@ -1903,7 +1945,9 @@
                       m)
         mm-ns (-> &env :ns :name core/str)]
     (when (= (count options) 1)
-      (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")))
+      (throw
+        #?(:clj (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")
+           :cljs (js/Error. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))))
     (let [options   (apply core/hash-map options)
           default   (core/get options :default :default)]
       (check-valid-options options :default :hierarchy)
@@ -2203,7 +2247,9 @@
          ;; Note: Cannot delegate this check to def because of the call to (with-meta name ..)
          (if (core/instance? clojure.lang.Symbol name)
            nil
-           (throw (IllegalArgumentException. "First argument to defn must be a symbol")))
+           (throw
+             #?(:clj (IllegalArgumentException. "First argument to defn must be a symbol")
+                :cljs (js/Error. "First argument to defn must be a symbol"))))
          (core/let [m (if (core/string? (first fdecl))
                         {:doc (first fdecl)}
                         {})
@@ -2230,8 +2276,10 @@
                                  ifn (first inline)
                                  iname (second inline)]
                         ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...)
-                        (if (if (clojure.lang.Util/equiv 'fn ifn)
-                              (if (core/instance? clojure.lang.Symbol iname) false true))
+                        (if (if #?(:clj (clojure.lang.Util/equiv 'fn ifn)
+                                   :cljs (= 'fn ifn))
+                              (if #?(:clj (core/instance? clojure.lang.Symbol iname)
+                                     :cljs (core/instance? Symbol iname)) false true))
                           ;; inserts the same fn name to the inline fn if it does not have one
                           (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName ^clojure.lang.Symbol name) "__inliner"))
                                                        (next inline))))


CLJS-1293: Warning settings not conveyed via REPL

Sets the binding for ana/*cljs-warnings* so that it
reflects any warnings supplied in opts.

--- src/main/clojure/cljs/repl.cljc
+++ src/main/clojure/cljs/repl.cljc
@@ -767,11 +767,19 @@
                ana/*cljs-ns* ana/*cljs-ns*
                *cljs-verbose* repl-verbose
                ana/*cljs-warnings*
-               (assoc ana/*cljs-warnings*
-                 :unprovided warn-on-undeclared
-                 :undeclared-var warn-on-undeclared
-                 :undeclared-ns warn-on-undeclared
-                 :undeclared-ns-form warn-on-undeclared)
+               (let [warnings (opts :warnings true)]
+                 (merge
+                   ana/*cljs-warnings*
+                   (if (or (true? warnings)
+                         (false? warnings))
+                     (zipmap (keys ana/*cljs-warnings*) (repeat warnings))
+                     warnings)
+                   (zipmap
+                     [:unprovided :undeclared-var
+                      :undeclared-ns :undeclared-ns-form]
+                     (repeat (if (false? warnings)
+                               false
+                               warn-on-undeclared)))))
                ana/*cljs-static-fns* static-fns
                *repl-opts* opts]
        (let [env {:context :expr :locals {}}


extension user should be a member of the group

--- src/chat/server/extensions/asana.clj
+++ src/chat/server/extensions/asana.clj
@@ -30,6 +30,7 @@
                         :password (random-nonce 50)
                         :avatar "data:image/gif;base64,R0lGODlhAQABAPAAAP///wAAACH5BAEAAAAALAAAAAABAAEAAAICRAEAOw=="
                         :nickname user-name})
+      (db/user-add-to-group! user-id group-id)
       (db/create-extension! {:id id
                              :group-id group-id
                              :user-id user-id
@@ -157,7 +158,7 @@
                                      :content (format "New issues from %s:\n%s"
                                                       (get-in task-data ["followers" 0])
                                                       (get task-data "name"))
-                                     :user-id nil ; TODO: who is this?
+                                     :user-id (extension :user-id)
                                      :created-at (java.util.Date.)
                                      :mentioned-user-ids ()
                                      :mentioned-tag-ids ()})


basic clean up

basic clean up

--- src/cljs/phonecat_re_frame/core.cljs
+++ src/cljs/phonecat_re_frame/core.cljs
@@ -122,12 +122,15 @@
        [:select {:on-change #(re-frame/dispatch [:order-prop-changed (-> % .-target .-value)])}
         [:option (mark-selected {:value "name"} @order-prop "name") "Alphabetical"]
         [:option (mark-selected {:value "age"} @order-prop "age") "Newest"]]])))
+<<<<<<< HEAD

 (defn phones-component
   []
   (let [phones (re-frame/subscribe [:phones])]
     (fn []
       [:ul (doall  (map (fn [phone] ^{:key phone} [phone-component (:name phone) (:snippet phone)]) @phones))])))
+=======
+>>>>>>> 010187c... basic clean up

 (defn home-page []
   [phones-component])


Add messaging to notify-join test. Switch defs to let

--- test/onyx/log/notify_join_cluster_test.clj
+++ test/onyx/log/notify_join_cluster_test.clj
@@ -1,24 +1,32 @@
 (ns onyx.log.notify-join-cluster-test
   (:require [onyx.extensions :as extensions]
             [onyx.log.entry :refer [create-log-entry]]
+            [onyx.messaging.aeron :as aeron]
+            [com.stuartsierra.component :as component]
             [midje.sweet :refer :all]))

-(def entry (create-log-entry :notify-join-cluster {:observer :d :subject :a}))

-(def f (partial extensions/apply-log-entry entry))
+(def peer-config
+  (:peer-config (read-string (slurp (clojure.java.io/resource "test-config.edn")))))

-(def rep-diff (partial extensions/replica-diff entry))
+(def messaging
+  (aeron/aeron {:opts peer-config}))

-(def rep-reactions (partial extensions/reactions entry))
+(component/start messaging)
+(try
+  (let [entry (create-log-entry :notify-join-cluster {:observer :d :subject :a})
+        f (partial extensions/apply-log-entry entry)
+        rep-diff (partial extensions/replica-diff entry)
+        rep-reactions (partial extensions/reactions entry)
+        old-replica {:pairs {:a :b :b :c :c :a} :prepared {:a :d} :peers [:a :b :c]}
+        new-replica (f old-replica)
+        diff (rep-diff old-replica new-replica)
+        reactions (rep-reactions old-replica new-replica diff {:id :d :messenger messaging})]
+    (fact diff => {:observer :d :subject :b :accepted-joiner :d :accepted-observer :a})
+    (fact reactions => [{:fn :accept-join-cluster :args diff :immediate? true :site-resources {:aeron/port 40201}}])
+    (fact (rep-reactions old-replica new-replica diff {:id :a}) => nil)
+    (fact (rep-reactions old-replica new-replica diff {:id :b}) => nil)
+    (fact (rep-reactions old-replica new-replica diff {:id :c}) => nil))

-(def old-replica {:pairs {:a :b :b :c :c :a} :prepared {:a :d} :peers [:a :b :c]})
-
-(let [new-replica (f old-replica)
-      diff (rep-diff old-replica new-replica)
-      reactions (rep-reactions old-replica new-replica diff {:id :d})]
-  (fact diff => {:observer :d :subject :b :accepted-joiner :d :accepted-observer :a})
-  (fact reactions => [{:fn :accept-join-cluster :args diff :immediate? true}])
-  (fact (rep-reactions old-replica new-replica diff {:id :a}) => nil)
-  (fact (rep-reactions old-replica new-replica diff {:id :b}) => nil)
-  (fact (rep-reactions old-replica new-replica diff {:id :c}) => nil))
-
+  (finally
+    (component/stop messaging)))


Positive and negative test for function rest-api/get-currently-building-jobs

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -724,3 +724,25 @@
                   "userRemoteConfigs"
                   [{"url" "git@git.domain.name:example-documentation/guide.git"}]}}])))))

+(deftest test-get-currently-building-jobs
+    "Check the function emender-jenkins.rest-api/get-currently-building-jobs."
+    (testing "the function emender-jenkins.rest-api/get-currently-building-jobs."
+    (with-redefs [jenkins-api/get-command (fn [all-jobs-url] building-jobs-jenkins-response)
+                  send-response (fn [response request] response)]
+        (let [request {:configuration {:jenkins {:currently-building-view "Building"
+                                                 :jenkins-url "http://10.20.30.40:8080/"}}}]
+             (is (= (get-currently-building-jobs request)
+                    ["test-Example_Documentation-1.0-Guide-en-US (preview)" "test-Example_Documentation-1.0-Guide-en-US (stage)"]))))))
+
+(deftest test-get-currently-building-jobs-negative
+    "Check the function emender-jenkins.rest-api/get-currently-building-jobs."
+    (testing "the function emender-jenkins.rest-api/get-currently-building-jobs."
+    (with-redefs [jenkins-api/read-list-of-all-jobs (fn [url job-part] nil)
+                  send-error-response (fn [response request http-code] response)]
+        (let [request {:configuration {:jenkins {:currently-building-view "Building"
+                                                 :jenkins-url "http://10.20.30.40:8080/"}}}]
+             (is (= (get-currently-building-jobs request)
+                    {:status  "error"
+                     :command "currently_building_jobs"
+                     :message "Can not read Jenkins view"}))))))
+


maybe an actual macro some day, but not necessary for now

--- test/push/design_spikes/dsl_macros.clj
+++ test/push/design_spikes/dsl_macros.clj
@@ -31,6 +31,8 @@
 ; - `consume-stack [stackname :as local]`
 ;    save the entire stack into `local` and clear it
 ;    raise an Exception if it's undefined
+; - `remember [args fn :as local]
+;    save the result of applying `fn` to the named `args` under key `local`
 ; - `remember [stackname :as local]`
 ;    store top item from `stackname` under key `local`
 ;    raise an Exception if it's empty or undefined
@@ -40,14 +42,21 @@
 ; - `remember-stack [stackname :as local]`
 ;    save the entire stack to the `local`
 ;    raise an Exception if it's undefined
-; - `place [stackname item]`
-;    push the item to the named stack
+; - `place [stackname args fn]`
+;    push the results of applying `fn` to the named `args` to the named stack
 ;    raise an Exception if it's undefined
 ; - `replace-stack [stackname new-stack]`
 ;    replace the indicated stack with a new list
 ;    raise an exception if it's undefined
-; - `calculate [fn :as local]
-;    save the result of `fn` under key `local`
+
+
+; restrictions are your friend:
+; every time a `consume` appears, we know one more item is needed from that stack
+; every time `consume-stack` or `count-of` appears, we know we need that type
+; every time `remember stackname :as` happens, we know we need at least 1 item
+; etc ...
+; In other words, the :needs can be inferred for each instruction from its DSL definition
+

 ;; And I THINK that supports all defined Push instructions I've ever seen....

@@ -102,6 +111,18 @@
 (fact "clear-locals also does what it's supposed to do"
   (let [foo (store-local (make-interpreter) :foo 8)]
     (:locals (clear-locals foo)) => nil))
+
+
+(defn recall
+  [interpreter k]
+  (get-in interpreter [:locals k]))
+
+
+(fact "recall retrieves a named item from :locals of its interpreter"
+  (let [foo (store-local (make-interpreter) :foo 8)]
+  (recall foo :foo) => 8))
+
+;;

 (defn consume
@@ -134,17 +155,35 @@

 (defn place
-  [interpreter stack args function]
-  (let [result (apply function (map (:locals interpreter) args))]
+  [interpreter stack function]
+  (let [result (apply function [interpreter])]
     (push-item interpreter stack result)))

-(fact "`place` will apply the specified inline function to the dslstate locals named"
+(fact "`place` will apply the specified inline function to the interpreter"
   (let [integer-added (-> six-ints
                         (consume :integer :as :int1)
                         (consume :integer :as :int2)
-                        (place :integer [:int1 :int2] #(+ %1 %2)))]
-  (get-stack integer-added :integer) => '(11 4 3 2 1))) ;;
+                        (place :integer #(+ (recall % :int1) (recall % :int2))))]
+  (get-stack integer-added :integer) => '(11 4 3 2 1)))
+
+
+(fact "`place` pays attention the argument order"
+  (let [integer-subtracted (-> six-ints
+                        (consume :integer :as :int1)
+                        (consume :integer :as :int2)
+                        (place :integer #(- (recall % :int1) (recall % :int2))))]
+  (get-stack integer-subtracted :integer) => '(1 4 3 2 1))
+  (let [integer-subtracted (-> six-ints
+                        (consume :integer :as :int1)
+                        (consume :integer :as :int2)
+                        (place :integer #(- (recall % :int2) (recall % :int1))))]
+  (get-stack integer-subtracted :integer) => '(-1 4 3 2 1)))
+
+
+;; this would be nicer if it was
+;; (place :integer #(- (my :int2) (my :int1)))
+

 ; (def-pushinstruction
@@ -177,9 +216,9 @@
 ;   :transaction
 ;     (consume :integer :as :int1)
 ;     (count-of :float :as :how-many)
-;     ????? this one's not so obvious yet
-;     (remember :float :at (mod int1 ) :as :float1)
-;     (place :float float1)]
+;     (calculate [:how-many :int1] #(mod %1 %2) :as :which)
+;     (remember :float :at :which :as :float1)
+;     (place :float (recall :float1))]
 ;     )


no longer need to pass in key and version types to select

--- src/main/java/org/dada/demo/core.clj
+++ src/main/java/org/dada/demo/core.clj
@@ -166,7 +166,7 @@
 ;; TODO :default not a good idea - would replace nulls
 ;; TODO what about type hints on lambdas ?
 (defn expand-property [src-class src-type src-name & pvec]
-  (let [pmap (apply hash-map pvec)
+  (let [pmap (apply array-map pvec)
 	tgt-type (or (pmap :type) src-type)
 	tgt-name (or (pmap :name) src-name)
 	convert (or (pmap :convert) identity)
@@ -177,12 +177,12 @@
     [tgt-type tgt-name retriever]
     ))

-(defn select [src-model output-class-name output-model-name key-type key-name version-type version-name properties]
+(defn select [src-model output-class-name output-model-name key-name version-name properties]
   (let [metadata (. src-model getMetadata)
 	src-class (. metadata getValueClass)
 	src-types (. metadata getAttributeTypes)
 	src-names (. metadata getAttributeNames)
-	src-map (apply hash-map (interleave src-names src-types))
+	src-map (apply array-map (interleave src-names src-types))
 	;; list of [tgt-type tgt-name retriever]
 	dummy (print "src-map: ")
 	dummy (println src-map)
@@ -204,14 +204,22 @@
   	output-class (apply make-class class-factory output-class-name output-properties)
 	dummy (print "output-class: ")
 	dummy (println output-class)
-   	key-getter (make-proxy-getter output-class key-type key-name)
-   	version-getter (make-proxy-getter output-class version-type version-name)
+   	output-getters (apply
+			conj
+			(array-map)
+			(map
+			 (fn [property]
+			     (let [type (nth property 0)
+				   name (nth property 1)]
+			       [name (make-proxy-getter output-class type name)]))
+			 expanded-properties))
+   	key-getter (output-getters key-name)
+   	version-getter (output-getters version-name)
 	dummy (print "version-getter: ")
 	dummy (println version-getter)
-   	output-getters (map (fn [property] (make-proxy-getter output-class (nth property 0) (nth property 1))) expanded-properties)
 	dummy (print "output-getters: ")
 	dummy (println output-getters)
-	output-metadata (new GetterMetadata output-class output-types output-names output-getters)
+	output-metadata (new GetterMetadata output-class output-types output-names (vals output-getters))
 	dummy (print "output-metadata: ")
 	dummy (println output-metadata)
 	view (new VersionedModelView output-model-name output-metadata key-getter version-getter)
@@ -245,18 +253,15 @@
   (. input-model getData)
   (. input-model getMetadata)

-  (def
-   view
-   (select
-    input-model
-    "org.dada.core.tmp.OutputItem"
-    "OutputModel"
-    (Integer/TYPE) "key"
-    (Integer/TYPE) "version"
-    (list
-     ["id" :name "key"]
-     ["version"]
-     ["amount" :name "money"])))
+  (def view
+       (select
+	input-model
+	"org.dada.core.tmp.OutputItem"
+	"OutputModel"
+	"key"
+	"version"
+	(list ["id" :name "key"] ["version"] ["amount" :name "money"])
+	))
   (insert metamodel view)

   (def item5 (make-instance input-class 3 2 2 6.0))
@@ -267,14 +272,10 @@
 	view
 	"org.dada.core.tmp.OutputItem2"
 	"OutputModel2"
-	Integer
 	"key"
-	Integer
 	"version"
-	(list
-	 ["key"]
-	 ["version"]
-	 ["money" :name "amount"])))
+	(list ["key"] ["version"] ["money" :name "amount"])
+	))

   )


Fix arity

Fix arity

--- src/org/spootnik/om_fleet/views.cljs
+++ src/org/spootnik/om_fleet/views.cljs
@@ -93,7 +93,8 @@
                                          (schedule-scenario
                                            @(om/get-shared owner :scenario)
                                            (keyword profile)
-                                           (om/get-shared owner :sync)))}
+                                           (om/get-shared owner :sync)
+                                           e))}
                             "execute")))))

 (def colors {"finished" "primary"


Fix and change obj-select(v) functions, now more keyword-y

--- src/lo_cash/core.cljs
+++ src/lo_cash/core.cljs
@@ -8,12 +8,13 @@

 (defn obj-select
   "Selects the given keys from a JS object and returns a keywordized map"
-  [obj [& keys]]
+  [obj & keys]
   (into {}
-    (map #([(keyword %) (aget obj %)])
+    (map (fn [k]
+           [(keyword k) (aget obj (name k))])
          keys)))

 (defn obj-selectv
   "Selects the given keys from a JS object and returns a vector of their values"
-  [obj [& keys]]
-  (mapv #(aget obj %) keys))
+  [obj & keys]
+  (mapv #(aget obj (name %)) keys))


Add some debug.

Add some debug.

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

 ;; A resource to retrieve entries for a given user


Removed analysis.core.clj, since I can't get it to work with current logs.

--- src/analysis/core.clj
+++ src/analysis/core.clj
@@ -1,134 +0,0 @@
-(ns analysis.core
-  (:import java.lang.Math)
-  (:require [clojure.java.io :as io]
-            [clojure.string :as s]
-            [cosmos.core :as cosmos]))
-
-(defrecord
-  ;;"Data structure for defining a single log."
-  Log [insts params reports summary])
-
-
-(defn- make-inst [inst-chunk]
-  (-> inst-chunk
-      (s/split #":")
-      (second)
-      (read-string)))
-
-(defn- make-params [param-chunk]
-  (->> param-chunk
-       (map #(s/split % #"="))
-       (map #(vector (s/trim (% 0)) (s/trim (% 1))))
-       (reduce #(assoc %1 (%2 0) (%2 1)) (sorted-map))))
-
-(defn- make-reports [reports-chunk]
-  (let [pred #(.contains % ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")]
-    (let [reports (for [chunk (remove pred (partition-by pred reports-chunk))]
-                    (->> chunk
-                         (map #(s/split % #":"))
-                         (remove #(not= 2 (count %)))
-                         (flatten)
-                         (map s/trim)
-                         (apply sorted-map)))
-          max-attributes (apply max (map count reports))]
-      (filter #(= max-attributes (count %)) reports))))
-
-(defn- make-summary [summary-chunk]
-  (let [outcome (re-find #"SUCCESS|FAILURE" (first summary-chunk))
-        final-gen (re-find #"[0-9]+" (first summary-chunk))
-        smap (->> summary-chunk
-                  (map #(s/split % #":"))
-                  (filter #(= 2 (count %)))
-                  (flatten)
-                  (map s/trim)
-                  (apply sorted-map))]
-    (assoc smap "outcome" outcome "final-gen" final-gen)))
-
-(defn parse-Log
-  "Parses a single log file (i.e. output of a Clojush run) into a Log data structure"
-  [log-file]
-  (let [lines (s/split-lines (slurp log-file))
-        inst-chunk (first (filter #(.contains % "Registered instructions:") lines))
-        param-chunk (filter #(.contains % "=") lines)
-        reports-chunk (->> lines
-                           (drop-while #(not (.contains % ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")))
-                           (take-while #(and (not (.contains % "SUCCESS")) (not (.contains % "FAILURE")))))
-        summary-chunk (drop-while #(and (not (.contains % "SUCCESS")) (not (.contains % "FAILURE"))) lines)]
-    (Log. (make-inst inst-chunk)
-          (make-params param-chunk)
-          (make-reports reports-chunk)
-          (make-summary summary-chunk))))
-(defn parse-Logs
-  "parses the contents of a log folder into a Log data structure, assuming that all files in the folder are logs"
-  [log-folder]
-  (for [log (.listFiles (io/file log-folder))]
-    (parse-Log log)))
-
-(defn Y
-  "Koza's Y - `point probability of success'"
-  [logs]
-  (assert (reduce #(and (= %1 %2) %1) (map #(get (:params %) "population-size") logs)))
-  (let [success-array (int-array (read-string (get (:params (first logs)) "population-size")) 0)]
-    (->> (reduce #(let [summary (:summary %2)]
-                    (when (= "SUCCESS" (get summary "outcome"))
-                      (let [index (read-string (get summary "final-gen"))]
-                        (aset %1 index (inc (aget %1 index)))))
-                    %1)
-                 success-array logs)
-         (map #(/ % (count logs))))))
-
-
-(defn P
-  "Koza's P - `cumulative probability of success'"
-  [logs]
-  (let [point-probs (to-array (Y logs))]
-    (doseq [i (rest (range (alength point-probs)))]
-      (aset point-probs i (+ (aget point-probs i)
-                             (aget point-probs (dec i)))))
-    (seq point-probs)))
-
-
-(defn R
-  "Koza's R - `number of independent runs needed get a success with probability z"
-  [logs z]
-  (let [enumerate (fn [lst] (map #(vector %1 %2) (range (count lst)) lst))
-        cumulative-probs (P logs)
-        calcs (map #(Math/ceil
-                     (/ (Math/log (- 1 z))
-                        (Math/log (- 1 %))))
-                   cumulative-probs)]
-    (ffirst (sort #(> (%1 1) (%2 1)) (enumerate calcs)))))
-
-
-(defn CE
-  "Koza's Computational Effort"
-  [logs z]
-  (* (R logs z)
-     (count logs)
-     (read-string (get (:params (first logs)) "population-size"))))
-
-
-(defn MBF
-  "Mean Best Fitness"
-  [logs error-key]
-  (let [best-fitnesses (->> (for [log logs]
-                              (for [report (:reports log)]
-                                (get report error-key)))
-                            flatten
-                            (remove nil?)
-                            (map read-string)
-                            flatten)]
-    (/ (apply + best-fitnesses) (count best-fitnesses))))
-
-(defn cosmos
-  "Returns a summary of the recommended runs for this data set"
-  [logs]
-  (cosmos/recommended-runs (-> (for [log logs]
-                                 (for [[report gen] (map #(vector %1 %2) (:reports log) (iterate inc 0))]
-                                   (for [[ord val] (seq (read-string (get report "Cosmos Data")))]
-                                     (struct-map cosmos/cosmos-data
-                                       :ord ord
-                                       :gen gen
-                                       :val val))))
-                               flatten
-                               cosmos/cosmos-1)))


Fixed spacing.

Fixed spacing.

--- src/open_company/api/common.clj
+++ src/open_company/api/common.clj
@@ -72,7 +72,7 @@
 (def open-company-resource {
   :available-charsets [UTF8]
   :handle-not-found (fn [_] missing-response)
-   :allowed-methods [:get :put :delete]
+  :allowed-methods [:get :put :delete]
   :respond-with-entity? (by-method {:put true :delete false})
   :malformed? (by-method {
     :get false


Sketch join

Sketch join

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -303,7 +303,7 @@

 ;; NOTE iterators are not write-safe

-(deftype Iterator [max-keys ^:mutable node ^:mutable ix ^:mutable end?]
+(deftype Iterator [max-keys ^:mutable node ^:mutable ix marked-nodes marked-ixes ^:mutable end?]
   Object
   (key [this]
        (when (false? end?)
@@ -362,14 +362,22 @@
                         (do
                           (set! node (aget (.-children node) ix))
                           (set! ix 0)
-                          (recur))))))))))))
+                          (recur)))))))))))
+  (mark [this]
+        (apush marked-nodes node)
+        (apush marked-ixes ix))
+  (reset [this]
+         (assert (> (alength marked-nodes) 0))
+         (assert (> (alength marked-ixes) 0))
+         (set! node (.pop nodes))
+         (set! ix (.pop marked-ixes))))

 (defn iterator [tree]
   (loop [node (.-root tree)]
     (if (nil? (.-children node))
       (if (> (alength (.-keys node)) 0)
-        (Iterator. (.-max-keys tree) node 0 false)
-        (Iterator. (.-max-keys tree) node 0 true))
+        (Iterator. (.-max-keys tree) node 0 #js [] #js [] false)
+        (Iterator. (.-max-keys tree) node 0 #js [] #js [] true))
       (recur (aget (.-children node) 0)))))

 (deftype Trieterator [iterator seek-key ^:mutable pinned-key ^:mutable pinned-key-ix ^:mutable moving-key-ix ^:mutable end?]
@@ -395,7 +403,7 @@
           (.maintain this)))
   (down [this]
         (assert (false? end?))
-        (assert (< moving-key-ix (alength seek-key)))
+        (assert (< moving-key-ix (- (alength seek-key) 1)))
         (let [moving-key (.key this)]
           (aset seek-key moving-key-ix moving-key)
           (set! pinned-key moving-key)
@@ -406,7 +414,11 @@
       (set! moving-key-ix pinned-key-ix)
       (set! pinned-key-ix (- pinned-key-ix 1))
       (set! pinned-key (aget seek-key pinned-key-ix))
-      (aset seek-key moving-key-ix least)))
+      (aset seek-key moving-key-ix least))
+  (mark [this]
+        (.mark iterator))
+  (reset [this]
+         (.reset iterator)))

 (defn trieterator [tree]
   (let [it (iterator tree)]
@@ -440,6 +452,8 @@
             (set! end? true)
             (.search this 1)))))

+;; TODO treeterator (key-ix->take?)
+
 (defn intersection [iterators]
   (if (> (alength iterators) 1)
     (if (some #(.-end? %) iterators)
@@ -455,6 +469,40 @@
       (.push results (.key iterator))
       (.next iterator))
     results))
+
+(deftype Join [^:mutable key-ix iterators key-ix->iterators key-ix->intersection key-ix->iterator->present? ^:mutable end?]
+  Object
+  (key [this]
+       (when (false? end?)
+         (.key (aget key-ix->intersection key-ix))))
+  (maintain [this]
+            (set! end? (.-end? (aget key-ix->intersection key-ix))))
+  (next [this]
+        (when (false? end)
+          (.next (aget key-ix->intersection key-ix))
+          (.maintain this)))
+  (seek [this key]
+        (when (false? end)
+          (.seek (aget key-ix->intersection key-ix) key)
+          (.maintain this)))
+  (down [this]
+        (assert (< key-ix (- (alength key-ix->iterators) 1)))
+        (set! key-ix (+ key-ix 1))
+        (let [iterator->present? (aget key-ix->iterator->present? key-ix)]
+          (dotimes [i (alength iterator->present?)]
+            (if (aget iterator->present? i)
+              (.down (aget iterators i))
+              (.mark (aget iterators i))))
+          (.maintain this)))
+  (up [this]
+      (assert (> key-ix 0))
+      (set! key-ix (- key-ix 1))
+      (let [iterator->present? (aget key-ix->iterator->present? key-ix)]
+        (dotimes [i (alength iterator->present?)]
+          (if (aget iterator->present? i)
+            (.up (aget iterators i))
+            (.reset (aget iterators i))))
+        (.maintain this))))

 ;; TESTS


Get insert working, probably break iterators

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -1,32 +1,99 @@
 (ns aurora.btree
   (:require-macros [aurora.macros :refer [apush]]))

-(deftype Tree [min-children max-children root])
-
-(deftype Node [parent parent-ix keys vals children])
-
-(deftype Iterator [^:mutable node ^:mutable ix]
+;; NOTE iterators are not write-safe
+
+(deftype Tree [max-keys ^:mutable root]
+  Object
+  (assoc! [this key val]
+          (.assoc! root key val max-keys))
+  (insert! [this ix key val right-child max-keys]
+           (let [left-child root]
+             (set! root (Node. this 0 #js [key] #js [val] #js [left-child right-child]))
+             (set! (.-parent left-child) root)
+             (set! (.-parent-ix left-child) 0)
+             (set! (.-parent right-child) root)
+             (set! (.-parent-ix right-child) 1)))
+  (into [this result]
+        (.into root result))
+  ISeqable
+  (-seq [this]
+        (let [result #js []]
+          (.into this result)
+          (seq result))))
+
+(deftype Node [parent parent-ix keys vals children]
+  Object
+  (into [this result]
+        (dotimes [ix (alength keys)]
+          (when-not (nil? children)
+            (.into (aget children ix) result))
+          (apush result #js [(aget keys ix) (aget vals ix)]))
+        (when-not (nil? children)
+          (.into (aget children (alength keys)) result)))
+  (seek [this key ix]
+        (let [len (alength keys)]
+          (loop [ix ix]
+            (if (and (< ix len) (> key (aget keys ix)))
+              (recur (+ ix 1))
+              ix))))
+  (assoc! [this key val max-keys]
+          (let [ix (.seek this key 0)]
+            (if (nil? children)
+              (if (= key (aget keys ix))
+                (do
+                  (aset vals ix val)
+                  true)
+                (do
+                  (.insert! this ix key val nil max-keys)
+                  false))
+              (.assoc! (aget children ix) key val max-keys))))
+  (insert! [this ix key val right-child max-keys]
+           (.splice keys ix 0 key)
+           (.splice vals ix 0 val)
+           (when-not (nil? children)
+             (.splice children (+ ix 1) 0 right-child))
+           (when (> (alength keys) max-keys)
+             (.split! this max-keys)))
+  (split! [this max-keys]
+          (let [median (js/Math.floor (/ max-keys 2))
+                right-node (Node. parent (+ parent-ix 1) nil nil nil)]
+            (.insert! parent parent-ix (aget keys median) (aget vals median) right-node)
+            (set! (.-keys right-node) (.slice keys (+ median 1)))
+            (set! (.-vals right-node) (.slice vals (+ median 1)))
+            (.splice keys median (+ median 1))
+            (.splice vals median (+ median 1))
+            (when-not (nil? children)
+              (let [right-children (.slice children (+ median 1))]
+                (set! (.-children right-node) right-children)
+                (.splice children median (+ median 2))
+                (dotimes [ix (alength right-children)]
+                  (let [child (aget right-children ix)]
+                    (set (.-parent child) right-node)
+                    (set (.-parent-ix child) ix)))))
+            (assert (= (alength keys) (alength vals) (if children (dec (alength children)) (alength keys))))
+            (assert (= (alength (.-keys right-node)) (alength (.-vals right-node)) (if (.-children right-node) (dec (alength (.-children right-node))) (alength (.-keys right-node))))))))
+
+(deftype Iterator [max-keys ^:mutable node ^:mutable ix]
   Object
   (next [this]
         (if (< ix (alength (.-keys node)))
           (let [result #js [(aget (.-keys node) ix) (aget (.-vals node) ix)]]
-            ;; check for a child
             (if-let [child (and (.-children node) (aget (.-children node) ix))]
-              ;; jump into child
               (do
                 (set! node child)
                 (set! ix 0))
-              ;; move along
               (set! ix (+ ix 1)))
             result)
-          (if-let [parent (.-parent node)]
-            ;; jump into parent and start again
-            (do
-              (set! ix (+ (.-parent-ix node) 1))
-              (set! node parent)
-              (recur))
-            ;; end of tree
-            nil)))
+          (let [parent (.-parent node)]
+            (if (instance? Node parent)
+              ;; jump into parent and start again
+              (do
+                (set! ix (+ (.-parent-ix node) 1))
+                (set! node parent)
+                (recur))
+              ;; end of tree
+              nil))))
   (seek [this key] ;; move the iterator forwards until it reaches a key greater than this one
         ;; head across and upwards until we reach a greater key
         (loop []
@@ -38,21 +105,22 @@
               (do
                 (set! ix (+ ix 1))
                 (recur)))
-            (if-let [parent (.-parent node)]
-              ;; jump into parent and start again
-              (do
-                (set! ix (+ (.-parent-ix node) 1))
-                (set! node parent)
-                (recur))
-              ;; end of tree
-              nil)))
+            (let [parent (.-parent node)]
+              (if (instance? Node parent)
+                ;; jump into parent and start again
+                (do
+                  (set! ix (+ (.-parent-ix node) 1))
+                  (set! node parent)
+                  (recur))
+                ;; end of tree
+                nil))))
         ;; head downwards and across until we reach the least greater key
         (loop []
           (if (< ix (alength (.-keys node)))
             (if (<= key (aget (.-keys node) ix))
               ;; check for a child
               (if-let [child (and (.-children node) (> ix 0) (aget (.-children node) (- ix 1)))]
-                ;; jump in child and start again (assumes child cannot be empty)
+                ;; jump into child and start again (child cannot be empty if tree is correctly balanced)
                 (do
                   (set! node child)
                   (set! ix 0)
@@ -70,30 +138,68 @@
           nil)))

 (defn iterator [tree]
-  (Iterator. (.-root tree) 0))
-
-(defn tree [min-child max-children]
-  (Tree. min-children max-children (Node. nil nil #js [] #js [] #js[])))
+  (Iterator. (.-max-keys tree) (.-root tree) 0))
+
+(defn tree [min-keys]
+  (let [node (Node. nil nil #js [] #js [] nil)
+        tree (Tree. (* 2 min-keys) node)]
+    (set! (.-parent node) tree)
+    (set! (.-parent-ix node) 0)
+    tree))

 (comment
-  (let [tree (Tree. min-children max-children (Node. nil nil #js [] #js [] #js[]))
+  (let [tree (tree 1)]
+    (seq tree))
+
+  (let [tree (tree 1)]
+    (.assoc! tree :a 0)
+    (seq tree))
+
+  (let [tree (tree 1)]
+    (.assoc! tree :a 0)
+    (.assoc! tree :b 1)
+    (js/console.log tree)
+    (seq tree))
+
+  (let [tree (tree 1)]
+    (.assoc! tree :a 0)
+    (.assoc! tree :b 1)
+    (.assoc! tree :c 1)
+    (js/console.log tree)
+    (seq tree))
+
+  (let [tree (tree 1)]
+    (.assoc! tree :a 0)
+    (.assoc! tree :b 1)
+    (.assoc! tree :c 1)
+    (.assoc! tree :d 1)
+    (.assoc! tree :e 1)
+    (.assoc! tree :f 1)
+    (.assoc! tree :g 1)
+    (.assoc! tree :h 1)
+    (.assoc! tree :i 1)
+    (.assoc! tree :j 1)
+    (js/console.log tree)
+    (seq tree))
+
+  (let [tree (Tree. max-keys (Node. nil nil #js [] #js [] #js[]))
         iterator (iterator tree)]
     (take-while identity (repeatedly #(.next iterator))))

-  (let [tree (Tree. min-children max-children (Node. nil nil #js [:a :b :c] #js [0 1 2] #js[]))
+  (let [tree (Tree. max-keys (Node. nil nil #js [:a :b :c] #js [0 1 2] #js[]))
         iterator (iterator tree)]
     (take-while identity (repeatedly #(.next iterator))))

   (let [branch (Node. nil nil #js [:a :d :e] #js [0 3 4] #js[])
         _ (apush (.-children branch) (Node. branch 0 #js [:b :c] #js [1 2]))
-        tree (Tree. min-children max-children branch)
+        tree (Tree. max-keys branch)
         iterator (iterator tree)]
     (take-while identity (repeatedly #(.next iterator))))

   (let [branch (Node. nil nil #js [:a :d :f] #js [0 3 4] #js[])
         _ (apush (.-children branch) (Node. branch 0 #js [:b :c] #js [1 2]))
-        tree (Tree. min-children max-children branch)
-        iterator (iterator tree)]
-    [(.seek iterator :c) (.seek iterator :a) (.seek iterator :e) (.seek iterator :e) (.seek iterator :p)])
+        tree (Tree. max-keys branch)
+        iterator (iterator tree)]
+    [(.seek iterator :0) (.seek iterator :c) (.seek iterator :a) (.seek iterator :e) (.seek iterator :e) (.seek iterator :p)])

   )


Update tests

Update tests

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -903,10 +903,8 @@
   (let [tree (apply-to-tree (tree min-keys key-len) actions)
         solver (solver
                 key-len
-                #js [(contains (iterator tree))
-                     (contains (iterator tree))]
-                #js [(into-array (range key-len))
-                     (into-array (range key-len))])]
+                #js [(contains (iterator tree) (into-array (range key-len)))
+                     (contains (iterator tree) (into-array (range key-len)))])]
     (= (map vec (map first tree))
        (map vec solver))))

@@ -924,9 +922,8 @@
               (.assoc! product-tree (.concat (aget elems i) (aget elems j)) nil)))
         solver (solver
                 (* 2 key-len)
-                #js [(contains (iterator tree)) (contains (iterator tree))]
-                #js [(into-array (range 0 key-len))
-                     (into-array (range key-len (* 2 key-len)))])]
+                #js [(contains (iterator tree) (into-array (range 0 key-len)))
+                     (contains (iterator tree) (into-array (range key-len (* 2 key-len))))])]
     (= (map vec (map first product-tree))
        (map vec solver))))

@@ -1008,7 +1005,9 @@
                (.assoc! tree3 #js [(+ i 1) (+ i 2)] (* 2 i))))
          ]
      (perf-time
-      (let [s (solver 3 #js [(contains (iterator tree1)) (contains (iterator tree2)) (contains (iterator tree3))] #js [#js [0 1 2] #js [0 2] #js [1 2]])]
+      (let [s (solver 3 #js [(contains (iterator tree1) #js [0 1 2])
+                             (contains (iterator tree2) #js [0 2])
+                             (contains (iterator tree3) #js [1 2])])]
         (while (not (nil? (.next s)))))))

   (let [tree1 (tree 10)


use helper fn to report error on invalid argument

--- src/calfpath/core.clj
+++ src/calfpath/core.clj
@@ -12,20 +12,13 @@
   clauses imply the last argument is the default expression invoked on no-match. Even numbered clauses return HTTP 400
   by default on no-match. The dispatch happens in linear time based on URI length and number of clauses."
   [request & clauses]
-  (when-not (symbol? request)
-    (throw (IllegalArgumentException.
-             (str "Expected a symbol bound to ring request map, but found (" (class request) ") " (pr-str request)))))
+  (i/expected symbol? "a symbol bound to ring request map" request)
   (when-not (#{0 1} (rem (count clauses) 3))
-    (throw (IllegalArgumentException.
-             (str "Expected clauses in sets of 3 with an optional default expression, but found " (pr-str clauses)))))
+    (i/expected "clauses in sets of 3 with an optional default expression" clauses))
   (doseq [[uri-template dav _] (partition 3 clauses)]
-    (when-not (string? uri-template)
-      (throw (IllegalArgumentException.
-               (str "Expected a uri-template string, but found (" (class uri-template) ") " (pr-str uri-template)))))
+    (i/expected string? "a uri-template string" uri-template)
     (when-not (and (vector? dav) (every? symbol? dav))
-      (throw (IllegalArgumentException.
-               (str "Expected destructuring argument vector with symbols, but found (" (class dav) ") "
-                 (pr-str dav))))))
+      (i/expected "destructuring argument vector with symbols" dav)))
   (let [response-400 {:status 400
                       :headers {"Content-Type" "text/plain"}
                       :body "400 Bad request. URI does not match any available uri-template."}]
@@ -85,10 +78,7 @@
   by default on no-match. The dispatch happens in constant time."
   [request & clauses]
   (doseq [[method-key _] (partition 2 clauses)]
-    (when-not (i/valid-method-keys method-key)
-      (throw (IllegalArgumentException.
-               (str "Expected method-key to be either of " i/valid-method-keys ", but found (" (class method-key) ") "
-                 (pr-str method-key))))))
+    (i/expected i/valid-method-keys (str "method-key to be either of " i/valid-method-keys) method-key))
   (let [valid-method-keys-str (->> (partition 2 clauses)
                                 (map first)
                                 (map name)


fix typo

fix typo

--- src/metabase/task.clj
+++ src/metabase/task.clj
@@ -44,7 +44,7 @@
   A hook is simply an atom storing a set of functions that you can run at any time with `run-hook`."
   [hook-name & [docstr?]]
   {:arglists '([hook-name docstr?])}
-  `(defonce ~(vary-meta hook-name
+  `(defonce ~(vary-meta hook-name assoc
                         :doc docstr?
                         :type ::hook)
      (atom #{})))


Expose binding ip for web server

Expose binding ip for web server

--- src/civil_ci/core.clj
+++ src/civil_ci/core.clj
@@ -18,6 +18,7 @@
 Options:
   -h --help                     Show this screen.
   -v --version                  Show version.
+  --ip=<ip>                     IP for web server. [default:0.0.0.0]
   --port=<port>                 Port for web server. [default:8080]
   --config-template=<url|path>  Git repo to clone when create a config directory
                                 [default:https://github.com/tombooth/civil-ci-template.git]
@@ -37,6 +38,7 @@

      :else (let [path (arg-map "<config-path>")
                  port (Integer/parseInt (arg-map "--port"))
+                 ip (arg-map "--ip")
                  num-workers (Integer/parseInt (arg-map "--workers"))
                  docker-path (arg-map "--docker-path")]
              (if-let [repo (git/get-or-create-config-repo path (arg-map "--config-template"))]
@@ -51,7 +53,7 @@
                                                                job-config job-history
                                                                build-channel build-buffer
                                                                workers)
-                                             {:port port})
+                                             {:port port :ip ip})
                          (println "Started"))
                  (println "Failed to load server.json"))
                (println "Failed to load configuration repository"))))))


Shrink to an earlier generator with one-of

`one-of` will now shrink both the value generated by the chosen
generator, as well as shrinking toward choosing an earlier generator in
the provided generator collection.

h/t @cstorey for pointing this out.
Fixes #28

--- src/simple_check/generators.clj
+++ src/simple_check/generators.clj
@@ -274,7 +274,8 @@

 (defn one-of
   "Create a generator that randomly chooses a value from the list of
-  provided generators.
+  provided generators. Shrinks toward choosing an earlier generator,
+  as well as shrinking the value generated by the chosen generator.

   Examples:

@@ -282,8 +283,8 @@

   "
   [generators]
-  (gen-bind (choose 0 (dec (count generators)))
-            #(nth generators (rose-root %))))
+  (bind (choose 0 (dec (count generators)))
+        (partial nth generators)))

 (defn- pick
   [[h & tail] n]


fix inaccuracies in special-forms docs

fix inaccuracies in special-forms docs

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -817,7 +817,7 @@
         :doc "Evaluates test. If not the singular values nil or false,
   evaluates and yields then, otherwise, evaluates and yields else. If
   else is not supplied it defaults to nil."}
-    new {:forms [(Classname. args*) (new Classname args*)]
+    new {:forms [(Constructor. args*) (new Constructor args*)]
          :url "java_interop#new"
          :doc "The args, if any, are evaluated from left to right, and
   passed to the JavaScript constructor. The constructed object is
@@ -829,7 +829,7 @@
   the bindings of the recursion point to the values of the exprs.
   Execution then jumps back to the recursion point, a loop or fn method."}
     set! {:forms[(set! var-symbol expr)
-                 (set! (. instance-expr instanceFieldName-symbol) expr)]
+                 (set! (.- instance-expr instanceFieldName-symbol) expr)]
           :url "vars#set"
           :doc "Used to set vars and JavaScript object fields"}
     throw {:forms [(throw expr)]


c2.core#read-data takes only one argument, a live node.

--- src/cljs/c2/core.cljs
+++ src/cljs/c2/core.cljs
@@ -12,7 +12,7 @@
 (defn attach-data [$node d]
   (set! (.-__c2data__ $node) d)
   $node)
-(defn read-data [$node d]
+(defn read-data [$node]
   (let [d (.-__c2data__ $node)]
     (if (undefined? d) nil d)))


concat with media styles at compile-time

--- src/cljss/builder.clj
+++ src/cljss/builder.clj
@@ -23,10 +23,10 @@
                      (mapcat second)
                      (into vals)
                      (concat mvals)
-                     (into []))]
-    [cls
-     `(cljs.core/str ~(apply str static (map first pstyles)) ~mstatic)
-     vals]))
+                     (into []))
+        static  (apply str static (map first pstyles))
+        static  (str static mstatic)]
+    [cls static vals]))

 (comment
   (build-styles


Add docstring

Add docstring

--- src/nightmod/core.clj
+++ src/nightmod/core.clj
@@ -24,10 +24,9 @@
   java.awt.Component (children [this] nil))

 (defn set-hint-container!
+  "Sets the container in which the hints will be stored."
   [container]
-  (intern 'nightcode.shortcuts
-          '*hint-container*
-          container))
+  (intern 'nightcode.shortcuts '*hint-container* container))

 (defn create-layered-pane
   "Returns the layered pane holding the editor pane."


logging

logging

--- src/ophion/ingest.clj
+++ src/ophion/ingest.clj
@@ -33,6 +33,7 @@

 (defn ingest-vertex
   [graph data]
+  (log/info "vertex" (:gid data))
   (let [vertex (query/add-vertex! graph data)
         id (.id vertex)]
     (merge
@@ -42,12 +43,14 @@

 (defn ingest-edge
   [graph data]
+  (log/info "edge" (:gid data))
   (let [edge (query/add-edge! graph data)
         id (.id edge)
         from-id (.getOutVertexId id)
         type-id (.getTypeId id)
         edge-id (.getRelationId id)
         to-id (.getInVertexId id)]
+    (log/info "ingesting" (.getName file))
     (merge
      (lift-properties data)
      {:_janusId edge-id
@@ -84,6 +87,7 @@
 (defn ingest-file
   [path graph continuation]
   (doseq [file (kafka/dir->files path)]
+    (log/info "ingesting" (.getName file))
     (let [label (kafka/path->label (.getName file))
           lines (line-seq (io/reader file))]
       (doseq [line lines]


pipeline could accept clojure function and wrap it as a stage

--- src/papaline/core.clj
+++ src/papaline/core.clj
@@ -37,7 +37,8 @@

 (defn pipeline [stages]
   (let [entry (-> stages first second)
-        done (chan)]
+        done (chan)
+        stages (mapv #(if (fn? %) (stage %) %) stages)]
     (loop [stages* stages]
       (when (first stages*)
         (let [[stage* in] (first stages*)


fix find container

fix find container

--- src/synthesis_crawlers/core.clj
+++ src/synthesis_crawlers/core.clj
@@ -235,13 +235,20 @@
                                          attr-nodes))))
                (vals attributed-nodes-in-pages))))

+(s/fdef find-container-node
+        :args (s/cat :node-attrs (s/map-of element? ::attributes)
+                     :all-attrs ::attributes))
 (defn find-container-node
   [node-attrs all-attrs]
+  (println "node-attrs: " node-attrs)
+  (println "all-attrs " all-attrs)
   (set
     (reduce (fn [acc e]
+              (println "find-container-node " (type acc) ": " acc )
+              (println "find-container-node"(type e) ": " e )
               (let [removed (remove #(reach? % e) acc)]
                 (if-not (seq removed)
-                  (conj (filter #(not (reach? %) e) acc) e)
+                  (conj (filter #(not (reach? % e)) acc) e)
                   acc)))
             #{}
             (keys (into {}


add test testTypeCalculationOnReferencesToInheritedField

--- test/app/test/symbol_solver_test.clj
+++ test/app/test/symbol_solver_test.clj
@@ -140,14 +140,13 @@
     (is (primitive? (getType sym)))
     (is (= "int" (typeName (getType sym))))))

-;(deftest testTypeCalculationOnReferencesToInheritedField
-;  (let [aClass (sampleClass "ReferencesToFieldExtendingClass")
-;        method (getMethodDeclaration aClass "method2")
-;        refI (getNameExprFor method "i")
-;        sym (solveNameExpr refI)]
-;    (is (not (nil? sym)))
-;    (print "SYM IS " sym)
-;    (is (not (nil? (getType sym))))
-;    (is (fieldRef? sym))
-;    (is (primitive? (getType sym)))
-;    (is (= "int" (typeName (getType sym))))))+(deftest testTypeCalculationOnReferencesToInheritedField
+  (let [aClass (sampleClass "ReferencesToFieldExtendingClass")
+        method (getMethodDeclaration aClass "method2")
+        refI (getNameExprFor method "i")
+        sym (solveNameExpr refI)]
+    (is (not (nil? sym)))
+    (is (not (nil? (getType sym))))
+    (is (fieldRef? sym))
+    (is (primitive? (getType sym)))
+    (is (= "int" (typeName (getType sym))))))


Random gender, number etc

Random gender, number etc

--- src/test_utils/word_source.cljc
+++ src/test_utils/word_source.cljc
@@ -47,12 +47,26 @@
   ([] (rand-words 3))
   ([n] (repeatedly n rand-word)))

-(defn noun [declension]
-  (println (case declension
-             1 (clj-str/join "\n" ["Maria, queen of reggae, gave Fannie Mae some jam for her bananā.",
-                                   "Fannie Mae, fond of ā rum, gave the Israelīs some bananās from the delīs."])
-             2 (clj-str/join "\n" ["Gus and Peter, friends of Luigī, gave Mariō some gum for his burritō.",
-                                   "He and Ī, kings of the quōrum, gave the Israelīs some burritōs from the delīs."])
-             3 (clj-str/join "\n" ["The Black Hole Gang*, friends of Beavis, gave Bambī a gem from Chile.",
-                                   "The Apachēs, masters of the drum, gave the minibus some tamalēs from the omnibus."]))))
+(defn noun-mnemonic [declension]
+  (println
+    (case declension
+      1 (clj-str/join "\n" ["Maria, queen of reggae, gave Fannie Mae some jam for her bananā.",
+                            "Fannie Mae, fond of ā rum, gave the Israelīs some bananās from the delīs."])
+      2 (clj-str/join "\n" ["Gus and Peter, friends of Luigī, gave Mariō some gum for his burritō.",
+                            "He and Ī, kings of the quōrum, gave the Israelīs some burritōs from the delīs."])
+      3 (clj-str/join "\n" ["The Black Hole Gang*, friends of Beavis, gave Bambī a gem from Chile.",
+                            "The Apachēs, masters of the drum, gave the minibus some tamalēs from the omnibus."]))))

+(defn grammar-gender [] (rand-nth [:m :f :n]))
+
+(defn grammar-number [] (rand-nth [:s :pl]))
+
+(defn grammar-case [] (rand-nth [:nom :gen :dat :acc :abl :voc]))
+
+(defn grammar-mood [] (rand-nth [:indicative :subjunctive :imperative :infinitive]))
+
+(defn grammar-tense [] (rand-nth [:present :imperfect :future :perfect :pluperfect :future-perfect]))
+
+(defn declension [] [(grammar-gender) (grammar-number) (grammar-case)])
+
+(defn conjugation [] [(grammar-mood) (grammar-number) (grammar-tense)])


src/riemann/xymon.clj: host->xymon, service->xymon: minor docstring updates

--- src/riemann/xymon.clj
+++ src/riemann/xymon.clj
@@ -8,12 +8,12 @@

 (defn host->xymon
-  "Format an hostname for Xymon. Basically, replace all dot chars by commas."
+  "Formats an hostname for Xymon. Basically, replaces all dot chars by commas."
   [host]
   (s/replace host "." ","))

 (defn service->xymon
-  "Format a service name to be understood by Xymon."
+  "Formats a service name to be understood by Xymon."
   [service]
   (s/replace service #"(\.| )" "_"))


hard coded bars added

hard coded bars added

--- src/unspun/components/bars.cljs
+++ src/unspun/components/bars.cljs
@@ -19,12 +19,59 @@
 (defc page < rum/reactive []
   (let [palette (get-palette (rum/react palette-index))
         page-style {:flex             1
-                    :backgroundColor (:text-icons palette)
-                    :paddingTop header-height
+                    :backgroundColor (:primary palette)
+
                     }]
     (view {:style {:flex 1}}
           (header)
           (view {:style page-style}
-                (text {:style {:color      (:primary-text palette)
-                               :fontWeight "400"
-                               :fontSize   26}} "Hi")))))+                (view {:style {:flex 0.3
+                               :backgroundColor (:dark-primary palette)}}
+                      (text {:style {:color      (:light-primary palette)
+                                     :fontWeight "400"
+                                     :padding 20
+                                     :fontSize   26}}
+                            "Without treatment, the risk of heart damage is 70%, decreasing to 60% with treatment"))
+                (view {:style {:flex          0.6
+                               :flexDirection "row"
+                               ;:backgroundColor "pink"
+                               }}
+                      (view {:style {:flex 0.3
+                                     :justifyContent "center"}}
+                            (text {:style {:color (:text-icons palette)
+                                           :fontSize 24
+                                           :textAlign "right"
+                                           :paddingRight 10}}
+                                  "Without"))
+                      (view {:style {:flex 0.2}}
+                            (view {:style {:flex 0.3
+                                           :position "relative"}}
+                                  (text {:style {:color (:text-icons palette)
+                                                 :position "absolute"
+                                                 :bottom 0
+                                                 :fontSize 30
+                                                 :fontWeight "400"}
+                                         } "70%"))
+                            (view {:style {:flex 0.7
+                                           :backgroundColor (:light-primary palette)}}))
+                      (view {:style {:flex 0.04}})
+                      (view {:style {:flex 0.2}}
+                            (view {:style {:flex 0.4}}
+                                  (text {:style {:color (:text-icons palette)
+                                                 :position "absolute"
+                                                 :bottom 0
+                                                 :fontSize 30
+                                                 :fontWeight "400"
+                                                 :textAlign "center"}
+                                         } "60%"))
+                            (view {:style {:flex 0.6
+                                           :backgroundColor (:light-primary palette)}}))
+                      (view {:style {:flex 0.3
+                                     :justifyContent "center"}}
+                            (text {:style {:color (:text-icons palette)
+                                           :fontSize 24
+                                           :padding 10
+                                           :textAlign "left"}}
+                                  "With")))
+                (view {:style {:flex 0.1
+                               :backgroundColor (:dark-primary palette)}})))))


lowercased argument

lowercased argument

--- src/selmer/parser.clj
+++ src/selmer/parser.clj
@@ -111,15 +111,15 @@
 ;; map and potentially opts. Smart (last-modified timestamp)
 ;; auto-memoization of compiler output.

-(defn render-file [filename-or-URL context-map & [{:keys [cache custom-resource-path]
+(defn render-file [filename-or-url context-map & [{:keys [cache custom-resource-path]
                                             :or  {cache @cache?
                                                   custom-resource-path *custom-resource-path*}
                                             :as opts}]]
   " Parses files if there isn't a memoized post-parse vector ready to go,
   renders post-parse vector with passed context-map regardless. Double-checks
-  last-modified on files. Uses classpath for filename-or-URL path "
+  last-modified on files. Uses classpath for filename-or-url path "
   (binding [*custom-resource-path* custom-resource-path]
-    (if-let [resource (resource-path filename-or-URL)]
+    (if-let [resource (resource-path filename-or-url)]
       (let [{:keys [template last-modified]} (get @templates resource)
             ;;for some resources, such as ones inside a jar, it's
             ;;not possible to check the last modified timestamp
@@ -128,12 +128,12 @@
         (check-template-exists resource)
         (if (and cache last-modified (= last-modified last-modified-time))
           (render-template template context-map)
-          (let [template (parse parse-file filename-or-URL opts)]
+          (let [template (parse parse-file filename-or-url opts)]
             (swap! templates assoc resource {:template template
                                              :last-modified last-modified-time})
             (render-template template context-map))))
       (validation-error
-       (str "resource-path for " filename-or-URL " returned nil, typically means the file doesn't exist in your classpath.")
+       (str "resource-path for " filename-or-url " returned nil, typically means the file doesn't exist in your classpath.")
        nil nil nil))))

 ;; For a given tag, get the fn handler for the tag type,


Article and paragraph component

Article and paragraph component

--- src/stratus/core.cljs
+++ src/stratus/core.cljs
@@ -16,8 +16,9 @@
 (defcomponent article [data owner]
   (render [this]
           (dom/div nil
-           (om/build-all paragraph
-                         (repeatedly (:number data) (constantly {:text "Hello, world!"}))))))
+                   (om/build-all paragraph
+                                 (repeatedly (:number data)
+                                             (constantly {:text "Hello, world!"}))))))

 (om/root article {:number 5}
          {:target (. js/document (getElementById "stratus"))})


Add hyper simple get doc route

Add hyper simple get doc route

--- src/datemo/routes.clj
+++ src/datemo/routes.clj
@@ -4,8 +4,7 @@
         datemo.arb)
   (:require [clojure.edn :as edn]
             [compojure.route :as route]
-            [compojure.handler :as handler]
-            [ring.middleware.json :refer [wrap-json-response]]
+            [ring.middleware.json :refer :all]
             [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
             [datomic.api :as d]))

@@ -41,14 +40,20 @@
   (edn/read-string {:readers *data-readers*} (prn-str edn)))

 (defn get-doc [eid]
+  (pprint (type eid))
   (let [doc-tx (d/pull (d/db conn) '[*] eid)
-        doc-html (tx->html doc-tx)]))
+        doc-html (tx->html doc-tx)]
+    (pprint doc-tx)
+    {:status 200
+     :headers {"Content-Type" "application/hal+json; charset=utf-8"}
+     :body doc-html}))

 (defn post-doc [doc-string]
  (let [tx (-> (html->tx doc-string) (add-tempid) (edn->clj))
        [eid db-after] (save-arb-tx tx)
        tx-from-db (d/pull db-after '[*] eid)
        html (-> tx-from-db (tx->arb) (arb->hiccup) (html))]
+   (pprint (type eid))
    {:status 201
     :headers {"Content-Type" "application/hal+json; charset=utf-8"}
     :body {:_links {:self (apply str "/documents/" (str eid))}
@@ -57,11 +62,19 @@

 (defroutes app-routes
   (GET "/" [] {:body {:_links {:documents {:href "/docs"}}}})
-  (POST "/documents" [doc-string] (post-doc doc-string))
+  (POST "/documents" [body :as {body :body}] (post-doc (:doc-string body)))
+  (GET "/documents/:eid" [eid] (get-doc (bigint eid)))
   (route/not-found "Not found"))
+
+(defn wrap-with-logger [handler]
+  (fn [request]
+    (pprint request)
+    (handler request)))

 (def app
   (-> app-routes
+      (wrap-with-logger)
+      (wrap-json-body {:keywords? true})
       (wrap-json-response)
       (wrap-defaults api-defaults)))


Clarity.

Clarity.

--- src/drake/fs/hive.clj
+++ src/drake/fs/hive.clj
@@ -49,14 +49,14 @@
              (.getString tables 3)))))

 (defn table-exists? [path]
-  (let [{ds :datasource db :database table :table} (hive-path path)]
-    (boolean (first (list-tables ds db table)))))
+  (let [{:keys [datasource database table]} (hive-path path)]
+    (boolean (first (list-tables datasource database table)))))

 (defn table-info [path]
   (when (table-exists? path)
-    (let [{ds :datasource db :database table :table} (hive-path path)
-          sql (format "describe extended %s.%s" db table)
-          [_ meta] (->> (jdbc/query ds [sql] :as-arrays? true)
+    (let [{:keys [datasource database table]} (hive-path path)
+          sql (format "describe extended %s.%s" database table)
+          [_ meta] (->> (jdbc/query datasource [sql] :as-arrays? true)
                         (rest)
                         (filter #(= "Detailed Table Information" (first %)))
                         (first))


oops, fix tiny bug

oops, fix tiny bug

--- src/tictag/client.clj
+++ src/tictag/client.clj
@@ -80,7 +80,7 @@
           (when-let [tags (request-tags
                            (format "[%s] PING!"
                                    (utils/local-time time)))]
-            (send-tags-to-server shared-secret server-url time tags))
+            (send-tags-to-server server-url shared-secret time tags))
           (recur)))
       (assoc component :stop #(a/close! chimes))))
   (stop [component]


Magic

Magic

--- src/icecap/schema.clj
+++ src/icecap/schema.clj
@@ -4,7 +4,8 @@
             [schema.utils :refer [validation-error-explain]]
             [icecap.handlers.http]
             [icecap.handlers.delay]
-            [icecap.handlers.core :refer [get-schema]]            ))
+            [icecap.handlers.core :refer [get-schema]]
+            [clojure.tools.reader.edn :as edn]))

 (def Step
   "The schema for the description of a single step.


Add validation for uri-root config option.

--- src/incise/config.clj
+++ src/incise/config.clj
@@ -31,10 +31,19 @@
   (when-let [config-file (file (or @config-path (resource "incise.edn")))]
     (reset! config (edn/read (PushbackReader. (reader config-file))))))

+(defn- str-starts-or-ends-with-slash?
+  [a-str]
+  {:pre [(string? a-str)]}
+  (some #(= \/ %) [(last a-str) (first a-str)]))
+
 (defmannerisms config
-  [:in-dir "must have an in-dir"]
+  [(comp (some-fn nil? string?) :uri-root) "uri-root must be a string"]
+  [(comp (complement (every-pred string? str-starts-or-ends-with-slash?))
+         :uri-root)
+   "uri-root must not start or end with a \"/\""]
+  [:in-dir "must have an input directory (in-dir)"]
   [(comp string? :in-dir) "in-dir must be a string (like a path)"]
-  [:out-dir "must have an output dir"]
+  [:out-dir "must have an output directory (out-dir)"]
   [(comp string? :out-dir) "out-dir must be a string (like a path)"])

 (defn avow! [] (avow-config! @config))


:bug: Fix bug on undo deletion of canvas with shapes.

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -1257,6 +1257,8 @@
       (let [objects (get-in state [:workspace-data :objects])
             session-id (:session-id state)

+            ids (seq ids)
+
             rchanges (mapv #(array-map :type :del-obj :id %) ids)
             uchanges (mapv (fn [id]
                              (let [obj (get objects id)
@@ -1267,7 +1269,7 @@
                                 :frame-id (:id frm)
                                 :index idx
                                 :obj obj}))
-                           ids)]
+                           (reverse ids))]
         (rx/of (commit-changes rchanges uchanges {:commit-local? true}))))))

 (defn- delete-frame


Don't need to generate "Installation" section in skeleton readme.

--- src/leiningen/new.clj
+++ src/leiningen/new.clj
@@ -34,7 +34,6 @@
         (join "\n\n" [(str "# " artifact-id)
                       "FIXME: write description"
                       "## Usage" "FIXME: write"
-                      "## Installation" "FIXME: write"
                       "## License" "Copyright (C) 2010 FIXME"
                       (str "Distributed under the Eclipse Public"
                            " License, the same as Clojure.\n")])))


Oops; new is shadowed by a macro; can't call it like that.

--- src/leiningen/new.clj
+++ src/leiningen/new.clj
@@ -39,4 +39,5 @@
                                  "## Installation" "FIXME: write"
                                  "## License" "FIXME: write\n"]))
          (println "Created new project in:" project-dir))))
-  ([project-name] (new project-name (name (symbol project-name)))))
+  ([project-name] (leiningen.new/new project-name
+                                     (name (symbol project-name)))))


fixing test

fixing test

--- test/celestial/features/kvm.clj
+++ test/celestial/features/kvm.clj
@@ -17,7 +17,7 @@
     (fact "legal instance spec" :kvm
       (let [domain (vconstruct (assoc redis-kvm :system-id 1))]
         (:system-id domain ) => 1
-        (:node domain)  => (just {:username "ronen" :host "localhost" :ssh-port 22})
+        (:node domain)  => (just {:username "ronen" :host "localhost" :port 22})
         (:domain domain) =>
           (just {
             :user "celestial" :name "red1.local"


up lang again

up lang again

--- src/ysmiraak/lang.clj
+++ src/ysmiraak/lang.clj
@@ -3,11 +3,11 @@
 ;; https://ncatlab.org/nlab/show/pure+type+system

 (defrecord V [name])            (defn v? [x] (instance? V x))
-(defrecord A [vars form])       (defn a? [x] (instance? A x))
+(defrecord A [vars expr args])  (defn a? [x] (instance? A x))
 (defrecord F [vars expr pars])  (defn f? [x] (instance? F x))
 ;; vars : Set V
 ;; pars : Vec V
-;; form : Vec Expr
+;; args : Vec Expr

 (defprotocol Expr
   "an expression satisfies the following protocol.
@@ -26,11 +26,13 @@
   (fv [this])
   (ev [this dict]))

-(defn- fv- [pars expr & exprs]
-  (loop [exprs exprs  vars (transient (fv expr))]
-    (if-let [[expr & exprs] exprs]
-      (recur exprs (reduce conj! vars (fv expr)))
-      (persistent! (reduce disj! vars pars)))))
+(defn- ff [expr pars]
+  (-> (reduce disj (fv expr) pars)
+      (F. expr (vec pars))))
+
+(defn- aa [expr args]
+  (-> (reduce into (fv expr) (map fv args))
+      (A. expr (vec args))))

 (extend-protocol Expr
   F
@@ -42,38 +44,42 @@
         ;; F without pars evals to its expr
         (empty? pars) expr
         ;; uncurries immediately nested F
-        (f? expr) (F. (fv- pars expr) (:expr expr) (into pars (:pars expr)))
-        :else     (F. (fv- pars expr)        expr        pars))))
+        (f? expr) (ff (:expr expr) (into pars (:pars expr)))
+        :else     (ff        expr        pars))))
   A
   (fv [this] (:vars this))
-  (ev [{:keys [vars form]} dict]
+  (ev [{:keys [vars expr args]} dict]
     (let [dict (select-keys dict vars)
-          [func & args :as form] (cond->> form (seq dict) (mapv #(ev % dict)))]
-      (if (f? func)
+          mbev #(cond-> % (some (fv %) (keys dict)) (ev dict))
+          expr (mbev expr)]
+      (if (f? expr)
         ;; asap beta-reduces val/var args
-        (let [{:keys [pars expr]} func
+        (let [{:keys [pars expr]} expr
+              ;; todo
+              ;; - eval args in parallel
+              ;; - skip eval if par not in fv
+              ;; - skip eval if par is overwritten
               [args pars dict]
               , (loop [args (seq args)  args' []
                        pars (seq pars)  pars' []
                        dict {}]
-                  (if-let   [[arg & args] args]
-                    (if-let [[par & pars] pars]
-                      (if (or (empty? (fv arg)) (v? arg))
-                        (recur args       args'      pars       pars'      (assoc  dict par arg))
-                        (recur args (conj args' arg) pars (conj pars' par) (dissoc dict par)))
-                      (throw (ex-info "arity error" {:form form})))
+                  (if-let [[arg & args] args]
+                    (let [arg (mbev arg)]
+                      (if-let [[par & pars] pars]
+                        (if (or (v? arg) (empty? (fv arg))) ; todo or when par is used only once in expr
+                          (recur args       args'      pars       pars'      (assoc  dict par arg))
+                          (recur args (conj args' arg) pars (conj pars' par) (dissoc dict par)))
+                        [(into (conj args' arg) (map mbev args)) pars' dict]))
                     [args' (into pars' pars) (reduce dissoc dict pars)]))
-              func (-> (fv- pars expr)
-                       (F.  expr pars)
+              expr (-> (ff expr pars)
                        (ev dict))]
           (if (seq args)
-            (A. (apply fv- [] func args) (into [func] args))
-            func))
-        ;; defers application or applies primitive func
-        (let [vars (apply fv- [] form)]
-          (if (seq vars)
-            (A. vars form)
-            (apply func args))))))
+            (aa expr args)
+            expr))
+        ;; defers application or applies primitive expr
+        (let [args (pmap mbev args)]
+          ((if (some (comp seq fv) (cons expr args)) aa apply)
+           expr args)))))
   V
   (fv [this] #{this})
   (ev [this dict] (dict this this))
@@ -98,19 +104,15 @@

 (defn ?
   "funcall, the counit of product-exponential adjunction"
-  ([& form]
-   (-> (apply fv- [] form)
-       (A. (vec form))
-       (ev {})))
-  ([]))
+  ([expr & args]
+   (-> (aa expr args)
+       (ev {}))))

 (defn %
   "forall"
   ([expr & pars] ; currently pars can only be vars
-   (-> (fv- pars expr)
-       (F. expr (vec pars))
-       (ev {})))
-  ([expr] expr))
+   (-> (ff expr pars)
+       (ev {}))))

 (defn !
   "produces a fresh or named var"
@@ -159,6 +161,9 @@
   (? (% (? ? a a) a)
      (% (? ? a a) a))

-  ;; todo test recursion
+  ;; todo
+  ;; - exception propogation
+  ;; - test recursion
+  ;; - types

   )


Fix database tests

Fix database tests

--- test/doctopus/doctopus_test.clj
+++ test/doctopus/doctopus_test.clj
@@ -13,34 +13,24 @@
            [doctopus.doctopus.head Head]))

 (use-fixtures :once database-fixture)
+
 (storage/set-backend! :temp-fs)

-(def doctopus-test-configs
-  {:heads-dir (io/resource "test/heads")})
-
-(def test-tent-props
-  (edn/read-string (slurp (io/resource "test/heads/test/doctopus-test.edn"))))
-
-(def stunt-doctopus (Doctopus. doctopus-test-configs {}))
+(def stunt-doctopus (Doctopus. {} {}))

 (deftest doctopus-test
-  (let [test-head (Head. "test")
-        test-tent (t/map->Tentacle test-tent-props)]
-    (db/save-head! test-head)
-    (db/save-tentacle! test-tent)
-    (db/create-mapping! test-head test-tent)
-    (testing "Can we list heads?"
-      (is (not (empty? (list-heads stunt-doctopus))))
-      (is (= "test" (:name (first (list-heads stunt-doctopus))))))
-    (testing "Can we list tentacles?"
-      (let [tent-list (list-tentacles stunt-doctopus)]
-        (is (= 1 (count tent-list))
-            "We should only have one of these")
-        (is (= "doctopus-test" (:name (first tent-list)))
-            "Would sure be weird if we got a different tentacle here")))
-    (testing "Can we get a tentacle by its head?"
-      (is (= 1 (count (list-tentacles-by-head stunt-doctopus "test")))
-          "This should get one tentacle")
-      (is (empty? (list-tentacles-by-head stunt-doctopus "HOOBASTANK"))
-          "There should never, ever be a tentacle with this name. Ever.")))
-  (utils/clean-up-test-html "doctopus-test"))
+  (testing "Can we list heads?"
+    (is (not (empty? (list-heads stunt-doctopus))))
+    (is (= "main" (:name (first (list-heads stunt-doctopus))))))
+  (testing "Can we list tentacles?"
+    (let [tent-list (list-tentacles stunt-doctopus)]
+      (is (= 1 (count tent-list))
+          "We should only have one of these")
+      (is (= "doctopus" (:name (first tent-list)))
+          "Would sure be weird if we got a different tentacle here")))
+  (testing "Can we get a tentacle by its head?"
+    (is (= 1 (count (list-tentacles-by-head stunt-doctopus "main")))
+        "This should get one tentacle")
+    (is (empty? (list-tentacles-by-head stunt-doctopus "HOOBASTANK"))
+        "There should never, ever be a tentacle with this name. Ever."))
+  (utils/clean-up-test-html "doctopus"))


Fix riak_test

Fix riak_test

--- test/icecap/store/riak_test.clj
+++ test/icecap/store/riak_test.clj
@@ -1,7 +1,7 @@
 (ns icecap.store.riak-test
   (:require [icecap.store.riak :as riak]
             [icecap.store.test-props :as props]
-            [clojure.test :refer [deftest is]]
+            [clojure.test :refer [deftest is testing use-fixtures]]
             [clojure.test.check.clojure-test :refer [defspec]]
             [clojurewerkz.welle.kv :as kv]))

@@ -84,7 +84,7 @@
   (partial with-redefs-fn (fake-riak-redefs)))

 (def ^:private riak-test-store
-  (riak-store fake-riak-conn "test-bucket"))
+  (riak/riak-store fake-riak-conn "test-bucket"))

 (defspec ^:riak riak-store-roundtrip
   (props/roundtrip-prop riak-test-store))


Improved tests

Improved tests

--- test/stub_http/headers_test.clj
+++ test/stub_http/headers_test.clj
@@ -3,10 +3,24 @@
             [stub-http.core :refer :all]
             [clj-http.lite.client :as client]))

-(deftest MethodMatching
-  (testing "routes can match on method"
+(deftest HeaderMatching
+  (testing "headers can be defined as string - string pairs"
     (with-routes!
       {"/something" {:status 200 :content-type "text/plain" :body "hello" :headers {"john" "doe" "ikk" "ikk2"}}}
       (let [headers (:headers (client/get (str uri "/something")))]
         (is (= "doe" (get headers "john")))
-        (is (= "ikk2" (get headers "ikk")))))))+        (is (= "ikk2" (get headers "ikk"))))))
+
+  (testing "headers can be defined as keyword - string pairs"
+    (with-routes!
+      {"/something" {:status 200 :content-type "text/plain" :body "hello" :headers {:john "doe" :ikk "ikk2"}}}
+      (let [headers (:headers (client/get (str uri "/something")))]
+        (is (= "doe" (get headers "john")))
+        (is (= "ikk2" (get headers "ikk"))))))
+
+  (testing "headers can be defined as keyword - int pairs"
+    (with-routes!
+      {"/something" {:status 200 :content-type "text/plain" :body "hello" :headers {"john" 2 :ikk 3}}}
+      (let [headers (:headers (client/get (str uri "/something")))]
+        (is (= "2" (get headers "john")))
+        (is (= "3" (get headers "ikk")))))))


colorize config check on initialization only

--- src/metabase/util.clj
+++ src/metabase/util.clj
@@ -420,23 +420,23 @@
      ~@body
      ~'<>))

-(defn ^String format-color
+(def ^String ^{:style/indent 2} format-color
   "Like `format`, but uses a function in `colorize.core` to colorize the output.
    COLOR-SYMB should be a quoted symbol like `green`, `red`, `yellow`, `blue`,
    `cyan`, `magenta`, etc. See the entire list of avaliable colors
    [here](https://github.com/ibdknox/colorize/blob/master/src/colorize/core.clj).

      (format-color 'red \"Fatal error: %s\" error-message)"
-  {:style/indent 2}
-  ([color-symb x]
-   {:pre [(symbol? color-symb)]}
-   (if (config/config-bool :mb-colorize-logs)
-     ((ns-resolve 'colorize.core color-symb) x)
-     x))
-  ([color-symb format-string & args]
-   (if (config/config-bool :mb-colorize-logs)
-     (format-color color-symb (apply format format-string args))
-     (apply format format-string args))))
+  (if (config/config-bool :mb-colorize-logs)
+    (fn
+      ([color-symb x]
+       {:pre [(symbol? color-symb)]}
+       ((ns-resolve 'colorize.core color-symb) x))
+      ([color-symb format-string & args]
+       (format-color color-symb (apply format format-string args))))
+    (fn
+      ([_ x] x)
+      ([_ format-string & args] (apply format format-string args)))))

 (defn pprint-to-str
   "Returns the output of pretty-printing X as a string.


Clean-up.

Clean-up.

--- src/notes/handler.clj
+++ src/notes/handler.clj
@@ -5,7 +5,6 @@
         [hiccup.page]
         [hiccup.element]
         [ring.util.response])
-
   (:require [compojure.handler :as handler]
             [compojure.route :as route]
             [monger.core :as mg]
@@ -57,11 +56,11 @@
                                                        (text-area {:rows 5} :body )
                                                        [:button.btn {:type "submit"} "Create Note!"]])]]

-         [:div.span8 (for [note notes]
-           [(if (:added note) :div#added.note :div.note) [:div.row-fluid [:div.span11 [:legend (:heading note)]]
-                                      [:div.span1 [:div.del (form-to [:delete "/"] (hidden-field :id (:_id note)) [:button.btn.btn-mini.btn-link {:type "submit"} [:i.icon-remove ]])]]]
-                      [:div (:body note)]
-                      [:p.text-info [:small (:ts note)]]])]]]
+         [:div.span8 (for [{:keys [_id, heading, body, added? ts]} notes]
+           [(if added? :div#added.note :div.note) [:div.row-fluid [:div.span11 [:legend heading]]
+                                      [:div.span1 [:div.del (form-to [:delete "/"] (hidden-field :id _id) [:button.btn.btn-mini.btn-link {:type "submit"} [:i.icon-remove ]])]]]
+                      [:div body]
+                      [:p.text-info [:small ts]]])]]]

       [:footer
        [:div.container
@@ -81,7 +80,7 @@
     (do
       (save-note! {:heading heading :body body :ts (DateTime.)})
       (let [notes (find-notes)]
-        (front-page (cons (assoc (first notes) :added true) (rest notes))))))
+        (front-page (cons (assoc (first notes) :added? true) (rest notes))))))

   (DELETE "/" [id]
     (do


set! *e *1 *2 *3 in eval command

set! *e *1 *2 *3 in eval command

--- src/portal/server.clj
+++ src/portal/server.clj
@@ -41,13 +41,21 @@
       (dissoc contexts id)
       contexts)))

+(defn prn-val [val]
+  (set! *3 *2)
+  (set! *2 *1)
+  (set! *1 val)
+  (prn-str val))
+
 (defn read-eval-print [data]
   (try (let [forms (read-seq data)]
-         (try ["result" (apply str (map (comp prn-str eval) forms))]
+         (try ["result" (apply str (map (comp prn-val eval) forms))]
               (catch Exception e
+                (set! *e e)
                 (let [e (root-cause e)]
                   ["error" (str (.getName (class e)) " " (.getMessage e))]))))
        (catch LispReader$ReaderException e
+         (set! *e e)
          ["read-error" (.getMessage (root-cause e))])))

 (defn handler [channel client-info]


Function to print actual configuration

Function to print actual configuration

--- src/cloverage_jenkins_reporter/config.clj
+++ src/cloverage_jenkins_reporter/config.clj
@@ -1,7 +1,7 @@
 ;;;
 ;;;   Statistic about code coverage measured by Cloverage reporter.
 ;;;
-;;; Copyright (c) 2015  Pavel Tisnovsky, Red Hat
+;;; Copyright (c) 2015, 2016  Pavel Tisnovsky, Red Hat
 ;;; All rights reserved.
 ;;;
 ;;; Redistribution and use in source and binary forms, with or without
@@ -46,6 +46,11 @@
     [config-file-name]
     (let [configuration (config-loader/load-configuration-file config-file-name)]
         (reset! jenkins-url            (:jenkins-url configuration))
-        (reset! jenkins-job-prefix-url (:jenkins-job-prefix-url-url configuration))
+        (reset! jenkins-job-prefix-url (:jenkins-job-prefix-url configuration))
         (reset! jenkins-job-list-url   (:jenkins-job-list-url configuration))))

+(defn print-configuration
+    []
+    (println "jenkins-url:            " @jenkins-url)
+    (println "jenkins-job-prefix-url: " @jenkins-job-prefix-url)
+    (println "jenkins-job-list-url:   " @jenkins-job-list-url))