better dofn

better dofn

--- src/datasplash/core.clj
+++ src/datasplash/core.clj
@@ -7,7 +7,7 @@
            [com.google.cloud.dataflow.sdk Pipeline]
            [com.google.cloud.dataflow.sdk.io TextIO$Read TextIO$Write]
            [com.google.cloud.dataflow.sdk.transforms
-            DoFn DoFn$Context ParDo DoFnTester Create PTransform
+            DoFn DoFn$Context DoFn$ProcessContext ParDo DoFnTester Create PTransform
             SerializableFunction WithKeys GroupByKey RemoveDuplicates
             Flatten Combine$CombineFn Combine Sum]
            [com.google.cloud.dataflow.sdk.values KV PCollection TupleTag PBegin PCollectionList]
@@ -17,26 +17,29 @@

 (def ops-counter (atom {}))

-
 (defmethod print-method KV [^KV kv ^java.io.Writer w]
   (.write w (str "[" (.getKey kv) ", " (.getValue kv) "]")))

 (defn dofn
-  ^DoFn  [f & {:keys [start-bundle finish-bundle] :as opts}]
+  ^DoFn [f & {:keys [start-bundle finish-bundle]
+              :or {start-bundle (fn [_] nil)
+                   finish-bundle (fn [_] nil)}
+              :as opts}]
   (proxy [DoFn] []
-    (processElement [context]
-      (f context))))
+    (processElement [^DoFn$ProcessContext context] (f context))
+    (startBundle [^DoFn$Context context] (start-bundle context))
+    (finishBundle [^DoFn$Context context] (finish-bundle context))))

 (defn map-fn
   [f]
-  (fn [^DoFn$Context c]
+  (fn [^DoFn$ProcessContext c]
     (let [elt (.element c)
           result (f elt)]
       (.output c result))))

 (defn mapcat-fn
   [f]
-  (fn [^DoFn$Context c]
+  (fn [^DoFn$ProcessContext c]
     (let [elt (.element c)
           result (f elt)]
       (doseq [atm result]
@@ -44,7 +47,7 @@

 (defn filter-fn
   [f]
-  (fn [^DoFn$Context c]
+  (fn [^DoFn$ProcessContext c]
     (let [elt (.element c)
           result (f elt)]
       (when result


Store elements on the context.

Store elements on the context.

--- src/datomish/query.cljc
+++ src/datomish/query.cljc
@@ -29,7 +29,7 @@
 ;; `:bindings` is a map from var to qualified columns.
 ;; `:wheres` is a list of fragments that can be joined by `:and`.
 ;;
-(defrecord Context [from bindings wheres attribute-transform constant-transform])
+(defrecord Context [from bindings wheres elements attribute-transform constant-transform])

 (defn attribute-in-context [context attribute]
   ((:attribute-transform context) attribute))
@@ -53,7 +53,7 @@
       (raise (str "Couldn't find variable " variable))))

 (defn make-context []
-  (->Context [] {} []
+  (->Context [] {} [] []
              transforms/attribute-transform-string
              transforms/constant-transform-default))

@@ -124,12 +124,15 @@
   (assoc context :wheres (concat (bindings->where (:bindings context))
                                  (:wheres context))))

+(defn apply-elements-to-context [context elements]
+  (assoc context :elements elements))
+
 (defn patterns->context
   "Turn a sequence of patterns into a Context."
   [patterns]
   (reduce apply-pattern-to-context (make-context) patterns))

-(defn elements->sql-projection
+(defn sql-projection
   "Take a `find` clause's `:elements` list and turn it into a SQL
    projection clause, suitable for passing as a `:select` clause to
    honeysql.
@@ -146,19 +149,30 @@

      [[:datoms12.e :foo] [:datoms13.e :bar]]

-   @param context A Context.
-   @param elements The input clause.
+   @param context A Context, containing elements.
    @return a sequence of pairs."
-  [context elements]
-  (when-not (every? #(instance? Variable %1) elements)
-    (raise "Unable to :find non-variables."))
-  (map (fn [elem]
-         (let [var (:symbol elem)]
-           [(lookup-variable context var) (var->sql-var var)]))
-       elements))
-
-(defn context->sql-clause [context elements]
-  {:select (elements->sql-projection context elements)
+  [context]
+  (let [elements (:elements context)]
+    (when-not (every? #(instance? Variable %1) elements)
+      (raise "Unable to :find non-variables."))
+    (map (fn [elem]
+           (let [var (:symbol elem)]
+             [(lookup-variable context var) (var->sql-var var)]))
+         elements)))
+
+(defn row-transducer [context projection rf]
+  ;; For now, we only support straight var lists, so
+  ;; our transducer is trivial.
+  (let [columns-in-order (map second projection)
+        row-mapper (fn [row] (map columns-in-order row))]
+    (fn
+      ([] (rf))
+      ([result] (rf result))
+      ([result input]
+       (rf result (row-mapper input))))))
+
+(defn context->sql-clause [context]
+  {:select (sql-projection context)
    :from (:from context)
    :where (if (empty? (:wheres context))
             nil
@@ -172,6 +186,18 @@
   (when-not (and (== 1 (count in))
                  (= "$" (name (-> in first :variable :symbol))))
     (raise (str "Complex `in` not supported: " (print-str in)))))
+
+(defn find->prepared-context [find]
+  ;; There's some confusing use of 'where' and friends here. That's because
+  ;; the parsed Datalog includes :where, and it's also input to honeysql's
+  ;; SQL formatter.
+  (let [{:keys [find in with where]} find]  ; Destructure the Datalog query.
+    (validate-with with)
+    (validate-in in)
+    (apply-elements-to-context
+      (expand-where-from-bindings
+        (patterns->context where))    ; 'where' here is the Datalog :where clause.
+      (:elements find))))

 (defn find->sql-clause
   "Take a parsed `find` expression and turn it into a structured SQL
@@ -180,13 +206,8 @@
   ;; There's some confusing use of 'where' and friends here. That's because
   ;; the parsed Datalog includes :where, and it's also input to honeysql's
   ;; SQL formatter.
-  (let [{:keys [find in with where]} find]  ; Destructure the Datalog query.
-    (validate-with with)
-    (validate-in in)
-    (context->sql-clause
-      (expand-where-from-bindings
-        (patterns->context where))    ; 'where' here is the Datalog :where clause.
-      (:elements find))))
+  (context->sql-clause
+    (find->prepared-context find)))

 (defn find->sql-string
   "Take a parsed `find` expression and turn it into SQL."


Refacto some core forms to macros

Refacto some core forms to macros

--- src/core.cljs
+++ src/core.cljs
@@ -105,26 +105,26 @@
 (defn some?
     [x] (not (nil? x)))

-(defn symbol?
-    [x] (.isSymbol js/symbols (x)))
-
-(defn keyword?
-    [x] (.isKeyword js/keywords (x)))
-
-(defn vector?
-    [x] (.isVector js/vectors (x)))
-
-(defn map?
-    [x] (.isMap js/maps (x)))
-
-(defn array?
-    [x] (.isArray js/Array (x)))
-
-(defn get
-    ([map key] (.get map (key)))
-    ([map key missing] (if (.has map (key))
-                            (.get map (key))
-                            missing)))
+(defmacro symbol?
+    [x] `(.isSymbol js/symbols (~x)))
+
+(defmacro keyword?
+    [x] `(.isKeyword js/keywords (~x)))
+
+(defmacro vector?
+    [x] `(.isVector js/vectors (~x)))
+
+(defmacro map?
+    [x] `(.isMap js/maps (~x)))
+
+(defmacro array?
+    [x] `(.isArray js/Array (~x)))
+
+(defmacro get
+    ([map key] `(.get ~map (~key)))
+    ([map key missing] `(if (.has ~map (~key))
+                            (.get ~map (~key))
+                            ~missing)))

 (defn to-object
     [value]


Remove unused checks on element existence.

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -21,7 +21,7 @@

 (defn show-harnocode! [harnocode]
   (let [output-area (dom/getElement "output")]
-    (when output-area (set! (.-value output-area) harnocode))))
+    (set! (.-value output-area) harnocode)))

 ;; Ugly, but have no time to find a better way
 (defn insert [v pos item]
@@ -170,7 +170,7 @@
 (defonce setup-stuff
  (do
   (let [button (dom/getElement "go")]
-   (when button (events/listen button "click" go-click-listener)))
+   (events/listen button "click" go-click-listener))
   (events/listen (dom/getElement "inverse") "click"
     (fn [event]
      (swap! img invert-image)
@@ -215,12 +215,9 @@
       )))

 (defn display-image-array [pixels]
-  (let [pixels-div (dom/getElement "pixels")]
-    (when pixels-div
-      (let [s (pixels-to-string pixels [])]
-        (set! (.-innerHTML pixels-div) s))
-      )
-    ))
+  (let [pixels-div (dom/getElement "pixels")
+        s          (pixels-to-string pixels [])]
+    (set! (.-innerHTML pixels-div) s)))

 (defonce max-image-dimension 224)

@@ -260,10 +257,7 @@

 (defn on-dom-loaded []
   (let [file-upload (dom/getElement "fileInput")]
-    (when file-upload
-      (print file-upload)
-      (events/listen file-upload "change" handle-files)))
-  (print "domready"))
+    (events/listen file-upload "change" handle-files)))

 (def w (dom/getWindow))
 (events/listen w (.-DOMCONTENTLOADED events/EventType) on-dom-loaded)


upd if

upd if

--- ohack/src/ohack/core.clj
+++ ohack/src/ohack/core.clj
@@ -207,6 +207,8 @@
                  (if (or (nil? last-val) ;; also short-circuits the subtraction
                          buf-full?
                          (not= 1 (- cur-val last-val)))
+                   [cur-val] ;; fresh buffer
+                   (conj buf cur-val) ;; add to buffer
                    )
                  (conj rtn (first input)))))))
   )


don't use :build-hooks in build reports

don't use :build-hooks in build reports

they may do all sorts of stuff that shouldn't be relevant for
build reports.

--- src/main/shadow/cljs/build_report.clj
+++ src/main/shadow/cljs/build_report.clj
@@ -250,7 +250,8 @@
               (assoc
                 :build-id build-id-alias
                 ;; not required, the files are never going to be used
-                :module-hash-names false))
+                :module-hash-names false)
+              (dissoc :build-hooks))

           state
           (-> (server-util/new-build build-config :release {})


condensing `best-call-action` code

condensing `best-call-action` code

--- src/midje/internal_ideas/fakes.clj
+++ src/midje/internal_ideas/fakes.clj
@@ -1,7 +1,7 @@
 ;; -*- indent-tabs-mode: nil -*-

 (ns midje.internal-ideas.fakes
-  (:use [utilize.seq :only (separate)]
+  (:use [utilize.seq :only (separate find-first)]
         [midje.util.object-utils :only [object-name]]
         [clojure.test :only [report]]
         [midje.checkers :only [exactly]]
@@ -113,9 +113,6 @@
     (= (count actual-args) (count (fake :arg-matchers )))
     (extended-list-= actual-args (fake :arg-matchers ))))

-(defn- fakes-for-call [fakes function-var actual-args]
-  (filter (partial call-handled-by-fake? function-var actual-args) fakes))
-
 (defn usable-default-function? [fake]
   (if (not (bound? (:lhs fake)))
     false
@@ -138,11 +135,8 @@
      ~@forms
      (finally (swap! *call-action-count* dec))))

-(defn- fakes-for-var [fakes function-var]
-  (filter (partial var-handled-by-fake? function-var) fakes))
-
 (defn best-call-action [function-var actual-args fakes]
-  (if (= 2 @*call-action-count*)
+  (when (= 2 @*call-action-count*)
     (throw (user-error "You seem to have created a prerequisite for"
              (str (pr-str function-var) " that interferes with that function's use in Midje's")
              (str "own code. To fix, define a function of your own that uses "
@@ -153,19 +147,18 @@
              "  (def all-even? (partial every? even?))"
              "  ;; ..."
              "  (provided (all-even? ..xs..) => true)")))
-  (let [possible-fakes (fakes-for-var fakes function-var)
-        found (first (fakes-for-call possible-fakes function-var actual-args))]
-    (cond found
-      found
-
-      (empty? possible-fakes)
-      nil
-
-      ;; For finding a default, any possible fake is as good as any other
-      (not (usable-default-function? (first possible-fakes)))
-      nil
-
-      :else (:value-at-time-of-faking (first possible-fakes)))))
+  (if-let [found (find-first (partial call-handled-by-fake? function-var actual-args)
+                             fakes)]
+    found
+    (let [possible-fakes (filter (partial var-handled-by-fake? function-var) fakes)]
+      (cond (empty? possible-fakes)
+        nil
+
+        ;; For finding a default, any possible fake is as good as any other
+        (not (usable-default-function? (first possible-fakes)))
+        nil
+
+        :else (:value-at-time-of-faking (first possible-fakes))))))

 (defn call-faker [function-var actual-args fakes]
   "This is the function that handles all mocked calls."
@@ -329,5 +322,4 @@
   (with-fresh-generated-metaconstant-names
     (translate-zipper form
       expect?
-      unfold-expect-form__then__stay_put)))
-
+      unfold-expect-form__then__stay_put)))


removed wrong parentheses

removed wrong parentheses

--- src/org/zalando/stups/friboo/user.clj
+++ src/org/zalando/stups/friboo/user.clj
@@ -60,9 +60,9 @@
    In the latter case the user must belong to at least one team."
   [{:keys [tokeninfo] :as request}]
   (when tokeninfo
-    ((let [realm (require-realms #{"employees" "services"} request)]
-       (when (= realm "employees")
-         (require-teams request))))))
+    (let [realm (require-realms #{"employees" "services"} request)]
+      (when (= realm "employees")
+        (require-teams request)))))

 (defn require-internal-team
   "Makes sure the user is an employee and belongs to the given team."


move comment into ns doc

move comment into ns doc

--- src/overtone/config.clj
+++ src/overtone/config.clj
@@ -1,11 +1,12 @@
-(ns overtone.config
+(ns
+    ^{:doc "Provides a simple key/value configuration system with support for automatically persisting to a file on disk.  The config file is serialized clojure code which is easily editable as a text file."
+      :author "Jeff Rose"}
+  overtone.config
   (:use [clojure.contrib.io :only (slurp*)])
   (:require [clojure.contrib.duck-streams :as ds])
   (:import (java.io FileOutputStream FileInputStream)))

-;; Provides a simple key/value configuration system with support for automatically
-;; persisting to a file on disk.  The config file is serialized clojure code which
-;; is easily editable as a text file.
+

 (defonce config*  (ref {}))


refactor using as->

refactor using as->

--- src/paulkrake/goals.clj
+++ src/paulkrake/goals.clj
@@ -60,16 +60,21 @@
   (let [games (dc/spieltag saison spieltag)
         spieltage (range-spieltage saison spieltag n)]
     (as-> (range 0 10) x
-          (reduce (fn [a i]
-                    (let [d1 (goals-data spieltage (goals-to-score-fn-factory i))
-                          new_score (p/predict-score d1 games)]
-                      (assoc a i new_score)))
-                  {} x)
-          (map (fn [[i data]]
-                 [i (map (fn [[h g hp gp]] [h g (* i (fire hp)) (* i(fire gp))]) data)])
-               x)
-          (map (fn [[i data]] (reduce (fn [a [h g hg gg]]
-                                       (assoc a [h g] [hg gg])) {} data)) x)
-          (apply merge-with (fn [[h1 g1] [h2 g2]] [(max h1 h2) (max g1 g2)]) x)
-          (map (fn [[h g hg gg]] [h g (first (get x [h g])) (second (get x [h g]))]) games)
-          )))
+      (reduce (fn [a i] (as-> i y
+                          (goals-to-score-fn-factory y)
+                          (goals-data spieltage y)
+                          (p/predict-score y games)
+                          (assoc a i y))
+                {} x)
+              (map (fn [[i data]]
+                     [i (map (fn [[h g hp gp]]
+                               [h g (* i (fire hp)) (* i (fire gp))])
+                             data)])
+                   x)
+              (map (fn [[i data]] (reduce (fn [a [h g hg gg]]
+                                            (assoc a [h g] [hg gg])) {} data)) x)
+              (apply merge-with (fn [[h1 g1] [h2 g2]]
+                                  [(max h1 h2) (max g1 g2)]) x)
+              (map (fn [[h g hg gg]]
+                     [h g (first (get x [h g])) (second (get x [h g]))])
+                   games))))


simplified.

simplified.

--- clojure/prime-factors/prime_factors.clj
+++ clojure/prime-factors/prime_factors.clj
@@ -7,9 +7,7 @@
     (loop [n n
            candidate 2
            acc []]
-      (let [remaining (bigint (/ n candidate))]
-        (cond (= n 1) acc
-              (= n candidate) (conj acc candidate)
-              :else (if (divisible? n candidate)
-                      (recur remaining candidate (conj acc candidate))
-                      (recur n (inc candidate) acc)))))))
+      (if (<= n 1) acc
+          (if (divisible? n candidate)
+            (recur (bigint (/ n candidate)) candidate (conj acc candidate))
+            (recur n (inc candidate) acc))))))


Fix test reference

Fix test reference

--- test/obb_rules/test_requires.cljc
+++ test/obb_rules/test_requires.cljc
@@ -28,7 +28,7 @@
     [obb-rules.ai.common-test]
     [obb-rules.ai.firingsquad-test]
     [obb-rules.ai.alamo-test]
-    [obb-rules.ai.bug-16-test]
-    [obb-rules.ai.bug-21-test]
+    [obb-rules.ai.bugs.bug-16]
+    [obb-rules.ai.bugs.bug-21]
     [obb-rules.element-test]))


Fix error-boundary stack component names on adv compilation

--- test/reagenttest/testreagent.cljs
+++ test/reagenttest/testreagent.cljs
@@ -1113,7 +1113,8 @@
                (if (dev?)
                  (is (re-find #"^\n    at reagenttest.testreagent.comp1 \([^)]*\)\n    at reagenttest.testreagent.comp2 \([^)]*\)\n    at reagent[0-9]+ \([^)]*\)\n    at reagenttest.testreagent.error_boundary \([^)]*\)"
                               (.-componentStack ^js @info)))
-                 (is (re-find #"^\n    at reagent[0-9]+. \([^)]*\)\n    at reagent[0-9]+ \([^)]*\)\n    at reagent[0-9]+ \([^)]*\)\n    at .+ \([^)]*\)"
+                 ;; Names are completely manged on adv compilation
+                 (is (re-find #"^\n    at .* \([^)]*\)\n    at .* \([^)]*\)\n    at .* \([^)]*\)\n    at .+ \([^)]*\)"
                               (.-componentStack ^js @info)))))))))))

 (u/deftest ^:dom test-dom-node


Reinstate integration tests for authentication

--- test/yada/authentication_test.clj
+++ test/yada/authentication_test.clj
@@ -302,10 +302,12 @@
             [authenticator])))))))

 ;; Resource test
+;; TODO: Combine authentcate with authorize
+

 ;; Integration test

-#_(deftest basic-auth-test
+(deftest basic-auth-test
   (let [resource
         {:methods {:get {:produces {:media-type "application/edn"}
                          :response (fn [ctx] "OK")}}}]
@@ -313,7 +315,7 @@
     (let [resource
           (assoc
            resource
-           :yada.auth/authenticators
+           :yada.authentication/authenticators
            [(basic/http-basic-authenticator
              (fn [ctx user password attributes]
                (future
@@ -328,43 +330,35 @@
                         {:headers {"authorization"
                                    (format "Basic %s" (encode-basic-authorization-token "alice" "wonderland"))}})]
           (is (= 200 (:status response)))
-          (is (= ["Basic charset=\"UTF-8\", realm=\"WallyWorld\""]
+          (is (= "Basic charset=\"UTF-8\", realm=\"WallyWorld\""
                  (get-in response [:headers "www-authenticate"])))))

-      #_(testing "basic authentication challenge in response when no credentials"
+      (testing "basic authentication challenge in response when no credentials"
+        (let [response (yada/response-for resource)]
+          (is (= 401 (:status response)))
+          (is (= "Basic charset=\"UTF-8\", realm=\"WallyWorld\""
+                 (get-in response [:headers "www-authenticate"])))))
+
+      (testing "basic authentication challenge when wrong credentials"
+        (let [response (yada/response-for
+                        resource :get "/"
+                        {:headers {"authorization"
+                                   (format "BASIC %s" (encode-basic-authorization-token "alice" "pa$$w0rd"))}})]
+          (is (= 401 (:status response)))
+          (is (= "Basic charset=\"UTF-8\", realm=\"WallyWorld\""
+                 (get-in response [:headers "www-authenticate"])))))
+
+      (testing "401 challenge due to no authorization header on a protected resource"
+        (let [resource (assoc
+                        resource
+                        :authorize (fn [ctx creds] nil)
+                        )]
           (let [response (yada/response-for resource)]
-            (is (= 200 (:status response)))
-            (is (= ["Basic charset=\"UTF-8\", realm=\"WallyWorld\""]
-                   (get-in response [:headers "www-authenticate"])))))
-
-      #_(testing "no basic authentication challenge when satisfactory credentials"
-          (let [response (yada/response-for
-                          resource :get "/"
-                          {:headers {"authorization"
-                                     (format "BASIC %s" (encode-basic-authorization-token "alice" "wonderland"))}})]
-            (is (= 200 (:status response)))
-            (is (nil? (get-in response [:headers "www-authenticate"])))))
-
-      #_(testing "basic authentication challenge when wrong credentials"
-          (let [response (yada/response-for
-                          resource :get "/"
-                          {:headers {"authorization"
-                                     (format "BASIC %s" (encode-basic-authorization-token "alice" "pa$$w0rd"))}})]
-            (is (= 200 (:status response)))
-            (is (= ["Basic charset=\"UTF-8\", realm=\"WallyWorld\""]
-                   (get-in response [:headers "www-authenticate"])))))
-
-      #_(testing "401 challenge due to no authorization header on a protected resource"
-          (let [resource (assoc
-                          resource
-                          :authorize (fn [ctx creds] nil)
-                          )]
-            (let [response (yada/response-for resource)]
-              (is (= 401 (:status response)))
-              (is (= ["Basic charset=\"UTF-8\", realm=\"WallyWorld\""]
-                     (get-in response [:headers "www-authenticate"]))))))
-
-      #_(testing "401 challenge due to bad credentials"
+            (is (= 401 (:status response)))
+            (is (= "Basic charset=\"UTF-8\", realm=\"WallyWorld\""
+                   (get-in response [:headers "www-authenticate"]))))))
+
+      (testing "401 challenge due to bad credentials"
           (let [resource (assoc
                           resource
                           :authorize (fn [ctx creds] nil)
@@ -374,10 +368,10 @@
                             {:headers {"authorization"
                                        (format "BASIC %s" (encode-basic-authorization-token "alice" "pa$$w0rd"))}})]
               (is (= 401 (:status response)))
-              (is (= ["Basic charset=\"UTF-8\", realm=\"WallyWorld\""]
+              (is (= "Basic charset=\"UTF-8\", realm=\"WallyWorld\""
                      (get-in response [:headers "www-authenticate"]))))))

-      #_(testing "forbidden when good credentials"
+      (testing "forbidden when good credentials"
           (let [resource (assoc
                           resource
                           :authorize (fn [ctx creds] nil)
@@ -386,37 +380,4 @@
                             resource :get "/"
                             {:headers {"authorization"
                                        (format "BASIC %s" (encode-basic-authorization-token "alice" "wonderland"))}})]
-              (is (= 403 (:status response)))
-              (is (nil? (get-in response [:headers "www-authenticate"])))))))))
-
-#_(let [resource
-      {:methods {:get {:produces {:media-type "application/edn"}
-                       :response (fn [ctx] (select-keys ctx [:authentication]))}}
-       :authorize (fn [_ _] true)
-       :yada.auth/authenticators
-       [{:type :yada.http-auth-schemes.basic
-         :authenticate (fn [ctx user password]
-                         (future
-                           (when (= [user password] ["alice" "wonderland"])
-                             {:user "alice"})))}]}
-      #_{:scheme "Basic"
-         :realm "WallyWorld"
-         :authenticate
-         (fn [ctx [user password] _]
-           ;; Can return ctx
-           ;; nil means no creds established
-           ;; non-ctx value means add to :authentication
-           ;; TODO: test for each of these 3 possibilities.
-           (future
-             (when (= [user password] ["alice" "wonderland"])
-               {:user "alice"})))}
-
-      #_(let [response (yada/response-for resource)]
-          (is (= 200 (:status response)))
-          (is (= ["Basic charset=\"UTF-8\", realm=\"WallyWorld\""]
-                 (get-in response [:headers "www-authenticate"]))))
-
-      ]
-  (yada/response-for resource)
-
-  )
+              (is (= 403 (:status response)))))))))


Adds multiply

Adds multiply

--- src/the_little_clojurian/chapter4.clj
+++ src/the_little_clojurian/chapter4.clj
@@ -74,3 +74,15 @@
   (is (= (addtup '(1 2 3)) 6))
   (is (= (addtup '(3 5 2 8)) 18))
   (is (= (addtup '(15 6 7 12 3)) 43)))
+
+(with-test
+  (def multiply
+    (fn [n m]
+      (cond (zero? m) 0
+            :else (pluss n (multiply n (sub1 m))))))
+
+  (is (= (multiply 0 0) 0))
+  (is (= (multiply 1 1) 1))
+  (is (= (multiply 1 0) 0))
+  (is (= (multiply 5 3) 15))
+  (is (= (multiply 13 4) 52)))


use string rather than keyword to clarify that slave will decode it to string

--- src/s7p/master/core.clj
+++ src/s7p/master/core.clj
@@ -26,7 +26,7 @@
      (recur (drop qp100ms reqs)))))

 (defn create-dsp [pub dsp]
-  (zmq/send-str pub (json/generate-string {:command :create-dsp :data dsp})))
+  (zmq/send-str pub (json/generate-string {:command "create-dsp" :data dsp})))

 (defn remove-dsp [pub id]
-  (zmq/send-str pub (json/generate-string {:command :remove-dsp :data id})))
+  (zmq/send-str pub (json/generate-string {:command "remove-dsp" :data id})))


controllable timer

controllable timer

--- src/s7p/master/core.clj
+++ src/s7p/master/core.clj
@@ -11,19 +11,18 @@
 (defn timer [ms]
   (let [c (chan)]
     (go-loop [n 0]
-      (>! c n)
       (<! (timeout ms))
-      (recur (+ n 1)))
+      (if (>! c n)
+       (recur (+ n 1))))
     c))

-(defn enqueue-query-timer [sender reqs]
-  (let [t (timer 100)]
-   (go-loop [reqs reqs]
-     (println (<! t))
-     (doall
-      (doseq [req (take @qp100ms reqs)]
-        (zmq/send-str sender (json/generate-string req))))
-     (recur (drop qp100ms reqs)))))
+(defn enqueue-query-timer [timer sender reqs]
+  (go-loop [reqs reqs]
+    (println (<! timer))
+    (doall
+     (doseq [req (take @qp100ms reqs)]
+       (zmq/send-str sender (json/generate-string req))))
+    (recur (drop qp100ms reqs))))

 (defn create-dsp [pub dsp]
   (swap! dsps conj dsp)


removing a debug log

removing a debug log

--- src/stash_bot/core.cljs
+++ src/stash_bot/core.cljs
@@ -57,7 +57,6 @@
   (.sendFile res (str root-dir "/public/index.html")))

 (defn- test-handler [req res]
-  (println (.-body req))
   (let [led-state (-> req .-body .-ledState)]
     (if led-state
       (turn-on-led)


more documentation

more documentation

--- src/such/relational.clj
+++ src/such/relational.clj
@@ -81,9 +81,10 @@
                                              {:a 2, :b 2, :c 1}
                                              {:a 2, :b 2, :c 2}}}

-   Alternately, can describe which left-hand-side keys should map to which
-   right-hand-side keys with a map. In the above case, the sharing could be
-   made explicit with `(join has-a-and-b has-b-and-c {:b :b})`.
+   Alternately, you can describe which left-hand-side keys should be
+   considered the same as which right-hand-side keys with a map. In
+   the above case, the sharing could be made explicit with `(join
+   has-a-and-b has-b-and-c {:b :b})`.

    A more likely example is one where the two relations have slightly different
    \"b\" keys, like this:
@@ -103,9 +104,41 @@

    Notice that the `:b` and `:blike` keys are duplicated.

-   For more details, you'll have to try your own examples.
+   The join when there are no keys shared is the cross-product of the relations.
+
+         (clojure.set/join [{:a 1} {:a 2}] [{:b 1} {:b 2}])
+         => #{{:a 1, :b 2} {:a 2, :b 1} {:a 1, :b 1} {:a 2, :b 2}}
+
+   The behavior when maps are missing keys is probably not something you should
+   depend on.
 ")

+(doc/update-and-make-local-copy! #'clojure.set/project
+   "`xrel` is a collection of maps (think SQL `SELECT *`). This function
+    produces a set of maps, each of which contains only the keys in `ks`.
+
+        (project [{:a 1, :b 1} {:a 2, :b 2}] [:b]) => #{{:b 1} {:b 2}}
+
+    `project` differs from `(map #(select-keys % ks) ...)` in two ways:
+
+    1. It returns a set, rather than a lazy sequence.
+    2. Any metadata on the original `xrel` is preserved. (It shares this behavior
+       with [[rename]] but with no other relational functions.)
+")
+
+(doc/update-and-make-local-copy! #'clojure.set/rename
+  "`xrel` is a collection of maps. Transform each map according to the
+   keys and values in `kmap`. Each map key that matches a `kmap` key is
+   replaced with that `kmap` key's value.
+
+        (rename [{:a 1, :b 2}] {:b :replacement}) => #{{:a 1, :replacement 2}}
+
+    `rename` differs from `(map #(rename-keys % kmap) ...)` in two ways:
+
+    1. It returns a set, rather than a lazy sequence.
+    2. Any metadata on the original `xrel` is preserved. (It shares this behavior
+       with [[project]] but with no other relational functions.)
+")

 ;;; Extensions


fix this

fix this

--- src/tabby/local_net.clj
+++ src/tabby/local_net.clj
@@ -74,12 +74,14 @@
   (kill-server [this id]
     (warn "Killing server: " id)
     (update-in this [:servers id] (fn [x]
+                                    (http/stop! x)
                                     (swap! x net/stop-server)
                                     x)))
   (rez-server [this id]
     (warn "Rezing server: " id)
     (update-in this [:servers id] (fn [x]
                                     (swap! x store/restore)
+                                    (http/start! x)
                                     (connect (start-server x) (:timeout this))
                                     x)))


Don't merge projects into builds

Don't merge projects into builds

--- src/circle/backend/build/config.clj
+++ src/circle/backend/build/config.clj
@@ -183,8 +183,7 @@
                    :vcs_revision vcs_revision
                    :job-name job-name
                    :node node
-                   :actions actions}
-                  (rename-keys {:name :project_name} project)))))
+                   :actions actions}))))

 (defn build-from-name
   "Given a project name and a build name, return a build. Helper method for repl"


saving.

saving.

--- src/clj/forma/hadoop/jobs/forma.clj
+++ src/clj/forma/hadoop/jobs/forma.clj
@@ -271,7 +271,7 @@
 (defbufferop [merge-series-wrapper [t-res nodata]]
   "defbufferop wrapper for `merge-series`."
   [tuples]
-  (let [consecutive false]
+  (let [consecutive true]
     (merge-series t-res nodata tuples :consecutive consecutive)))

 (defn array-val->series


Return a cleaner output from `create-synth-sensors`

--- src/clj/kixi/hecuba/api/devices.clj
+++ src/clj/kixi/hecuba/api/devices.clj
@@ -138,8 +138,8 @@
         new-pulse-sensors (map #(ext-type % "differenceSeries")
                                cumulative-sensors)
         new-calc-sensors (map #(calculated-sensor %) new-pulse-sensors)]
-    (vector cumulative-sensors pulse-sensors instant-sensors calc-sensors
-            new-pulse-sensors new-calc-sensors)))
+    (flatten (vector cumulative-sensors pulse-sensors instant-sensors calc-sensors
+                     new-pulse-sensors new-calc-sensors))))

 (defn create-default-sensors
   "Creates default sensors whenever new device is added: *_differenceSeries for CUMULATIVE,
@@ -147,7 +147,7 @@
   [body]
   (let [sensors        (:readings body)
         new-sensors (create-synth-sensors sensors)]
-    (update-in body [:readings] (fn [readings] (into [] (remove nil? (flatten new-sensors)))))))
+    (assoc (dissoc body :readings) :readings (into [] new-sensors))))

 (defn index-post! [store ctx]
   (db/with-session [session (:hecuba-session store)]


update about page

update about page

--- src/cljs/ikea_clojure_cup/core.cljs
+++ src/cljs/ikea_clojure_cup/core.cljs
@@ -23,9 +23,9 @@
    [:p common/welcome-note]
    [:p "There are 3 possible outcomes:"
     [:ul
-     [:li "1. It fits!  You'll fit ALL the packages for your products in your car!"]
+     [:li "1. It fits!  You'll fit ALL of the packages for your products in your car!"]
      [:li "2. It kinda fits!  You'll fit SOME of the packages in your car but may have to get creative or say goodbye to others."]
-     [:li "3. It does not!  You'll fit NONE of the packages for your products in your car."]]]
+     [:li "3. It does not fit!  You'll fit NONE of the packages for your products in your car."]]]
    [bootstrap/button {:bs-size :lg :href "/"} "Try it!"]])

 (defn current-page []


added simple dot influence display

added simple dot influence display

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -20,12 +20,14 @@
 (defn found? [query cards]
   (some #(if (= (.toLowerCase (:title %)) query) %) cards))

-(defn id-inf-limit [identity]
+(defn id-inf-limit
   "Returns influence limit of an identity or INFINITY in case of draft IDs."
+  [identity]
   (if (= (:setname identity) "Draft") INFINITY (:influencelimit identity)))

-(defn mostwanted? [card]
+(defn mostwanted?
   "Returns true if card is on Most Wanted NAPD list."
+  [card]
   (let [napdmwl '("Cerberus \"Lady\" H1" "Clone Chip" "Desperado" "Parasite" "Prepaid VoicePAD"
                    "Architect" "AstroScript Pilot Program" "Eli 1.0" "NAPD Contract" "SanSan City Grid")]
     (some #(= (:title card) %) napdmwl)))
@@ -65,12 +67,14 @@
 (defn parse-deck [side deck]
   (reduce #(if-let [card (parse-line side %2)] (conj %1 card) %1) [] (split-lines deck)))

-(defn faction-label [card]
+(defn faction-label
   "Returns faction of a card as a keyword"
+  [card]
   (-> card :faction .toLowerCase (.replace " " "-")))

-(defn allowed? [card {:keys [side faction title] :as identity}]
+(defn allowed?
   "Checks if a card is allowed in deck of a given identity - not accounting for influence"
+  [card {:keys [side faction title] :as identity}]
   (and (not= (:type card) "Identity")
        (= (:side card) side)
        (or (not= (:type card) "Agenda")
@@ -253,6 +257,16 @@
     (some #(when (and (not= (:setname %) "Alternates") (= (:title %) (:title card))) %)
           (:cards @app-state))
     card))
+
+(defn influence-dots
+  "Returns a string with UTF-8 full circles representing influence."
+  [num]
+  (apply str (conj (for [_ (range num)] "●") "")))
+
+(defn restricted-dots
+  "Returns a string with UTF-8 empty circles representing MWL restricted cards."
+  [num]
+  (apply str (conj (for [_ (range num)] "○") "")))

 (defn octgn-link [owner]
   (let [deck (om/get-state owner :deck)
@@ -411,10 +425,16 @@
                     (when (< count min-count)
                       [:span.invalid (str "(minimum " min-count ")")])])
                  (let [inf (influence-count deck)
-                       limit (deck-inf-limit deck)]
+                       limit (deck-inf-limit deck)
+                       mwl (mostwanted-count deck)]
                    [:div "Influence: "
                     [:span {:class (when (> inf limit) "invalid")} inf]
-                    "/" (if (= INFINITY limit) "∞" limit)])
+                    "/" (if (= INFINITY limit) "∞" limit)
+                    (if (< 0 (+ inf mwl))
+                      (list " " [:span.influence
+                       {:class (name :neutral)
+                        :dangerouslySetInnerHTML
+                        #js {:__html (str (influence-dots inf) (restricted-dots mwl))}}]))])
                  (when (= (:side identity) "Corp")
                    (let [min-point (min-agenda-points deck)
                          points (agenda-points deck)]
@@ -450,8 +470,8 @@
                                 [:span.influence
                                  {:class (faction-label card)
                                   :dangerouslySetInnerHTML
-                                  #js {:__html (str (if-not infaction (apply str (for [_ (range influence)] "●")))
-                                                    (if wanted (apply str (for [_ (range (:qty line))] "○"))))}}]))])
+                                  #js {:__html (str (if-not infaction (influence-dots influence))
+                                                    (if wanted (restricted-dots (:qty line))))}}]))])
                          (:card line))])])]]))]

           [:div.deckedit


Add docstrings for hmac/hmac and hmac/verify functions.

--- src/clojure/buddy/core/mac/hmac.clj
+++ src/clojure/buddy/core/mac/hmac.clj
@@ -113,15 +113,27 @@
   (verify-hmac [^java.net.URI input ^bytes signature ^String key ^Keyword alg]
     (verify-hmac-for-stream (io/input-stream input) signature key alg)))

-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; High level interface
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn hmac
+  "Make hmac for arbitrary input.
+
+  Example:
+    (hmac \"foo bar\" \"secret\" :sha256)
+    ;; => #<byte[] [B@465d154e>
+  "
   [input key ^Keyword alg]
   (make-hmac input key alg))

 (defn verify
+  "Verify hmac for artbitrary input and signature.
+
+  Example:
+    (let [signature (hex->bytes \"61849448bdbb67b39d609471eead6...\")]
+      (verify \"foo bar\" signature \"secret\" :sha256))
+    ;; => true
+  "
   [input ^bytes signature key ^Keyword alg]
   (verify-hmac input signature key alg))


implement basic skeleton for Listener

implement basic skeleton for Listener

--- src/clojure/org/mobileink/antlr.clj
+++ src/clojure/org/mobileink/antlr.clj
@@ -1,6 +1,68 @@
-(ns org.mobileink.clajistics.antlr)
+(ns org.mobileink.antlr
+  (:import [org.mobileink.antlr ClojureLexer ClojureParser ClojureBaseListener]
+           [org.antlr.v4.runtime ANTLRInputStream ANTLRFileStream CommonTokenStream]
+           [org.antlr.v4.runtime.tree ParseTree ParseTreeWalker]))

-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))
+(defn- make-listener [parser]
+    (proxy [ClojureBaseListener] []
+      ;; (enterEveryRule [ctx]
+      ;;   (do
+      ;;     (println "entering rule")
+      ;;     ;; (println (format "ctx id: %s" (.Identifier ctx)))
+      ;;     ;; (println (format "form: %s" (.form ctx)))
+      ;;     ))
+      ;; (exitEveryRule [ctx] (println "exiting rule"))
+      (enterLet [ctx]
+        (do (println "entering let")
+            ;; (println (format "tok: %s" (.SYMBOL ctx)))
+            ))
+      (enterLet_form [ctx]
+        (do (println "entering let form")
+            ;; (println (format "tok: %s" (.SYMBOL ctx)))
+            ))
+      (exitLet_form [ctx] (println "exiting let form"))
+      (enterList [ctx] (println "exiting List"))
+      (exitList [ctx] (println "exiting List"))
+      (visitTerminal [ctx]
+        (do
+          (println "visiting terminal node")
+          (println "sym: " (.getText (.getSymbol ctx)))
+          ))
+      ))
+
+(defn parse-str [str]
+  "Parse string 'str using the Clojure parser."
+  (print (format "parsing %s\n" str))
+  (let [input (do ;;(println "getting stream")
+                (ANTLRInputStream. str))
+        lexer (do ;;(println "getting lexer")
+                  (ClojureLexer. input))
+        tokens (do
+                 ;;(println "getting tokens")
+                 (CommonTokenStream. lexer))
+        parser (do
+                 ;;(println "getting parser")
+                 (ClojureParser. tokens))
+        tree (do ;;(println "getting tree")
+               (.file parser))] ; "file" is the start rule of the grammar
+    (do
+      (.walk (ParseTreeWalker.) (make-listener parser) tree))))
+
+(defn parse-file [file]
+  "Parse file 'file using the Clojure parser."
+  (print (format "parsing %s\n" file))
+  (let [input (do ;;(println "getting stream")
+                ;; use ANTLRInputStream to read from a string buffer
+                (ANTLRFileStream. file))
+        lexer (do ;;(println "getting lexer")
+                  (ClojureLexer. input))
+        tokens (do
+                 ;;(println "getting tokens")
+                 (CommonTokenStream. lexer))
+        parser (do
+                 ;;(println "getting parser")
+                 (ClojureParser. tokens))
+        tree (do ;;(println "getting tree")
+               (.file parser))] ; "file" is the start rule of the grammar
+    (do
+      (.walk (ParseTreeWalker.) (make-listener parser) tree))))


implement visitor

implement visitor

--- src/clojure/org/mobileink/antlr.clj
+++ src/clojure/org/mobileink/antlr.clj
@@ -1,9 +1,72 @@
 (ns org.mobileink.antlr
-  (:import [org.mobileink.antlr ClojureLexer ClojureParser ClojureBaseListener]
+  (:import [org.mobileink.antlr ClojureLexer ClojureParser ClojureBaseVisitor ClojureBaseListener]
            [org.antlr.v4.runtime ANTLRInputStream ANTLRFileStream CommonTokenStream]
            [org.antlr.v4.runtime.tree ParseTree ParseTreeWalker]))

 ;; see also http://www.nickpascucci.com/blog/2014/03/01/using-antlr-from-clojure/
+
+(defn- visitor [parser]
+    (proxy [ClojureBaseVisitor] []
+    (visitFile [ctx]
+      (do
+        (println "visiting file")
+        (.visitChildren this ctx)
+        ))
+    (visitForm [ctx]
+      (do
+        (println (format "visiting form %s" (.getText ctx)))
+        (.visitChildren this ctx)
+        ))
+    (visitLet [ctx]
+      (do
+        (println "visiting Let")
+        (.visitChildren this ctx)
+        ))
+    (visitTerminal [ctx]
+      (do
+        (println "visiting terminal node")
+        (println "\tsym: " (.getText (.getSymbol ctx)))
+        ))
+    ))
+
+(defn visit-file [file]
+  "Parse file 'file and crawl it using active client strategy."
+  (print (format "visiting %s\n" file))
+  (let [input (do ;;(println "getting stream")
+                ;; use ANTLRInputStream to read from a string buffer
+                (ANTLRFileStream. file))
+        lexer (do ;;(println "getting lexer")
+                  (ClojureLexer. input))
+        tokens (do
+                 ;;(println "getting tokens")
+                 (CommonTokenStream. lexer))
+        parser (do
+                 ;;(println "getting parser")
+                 (ClojureParser. tokens))
+        tree (do ;;(println "getting tree")
+               (.file parser))] ; "file" is the start rule of the grammar
+    (do
+      (.visit (visitor parser) tree))))
+
+(defn visit-str [str]
+  "Parse string 'str and crawl it using active client strategy."
+  (print (format "visiting %s\n" str))
+  (let [input (do ;;(println "getting stream")
+                (ANTLRInputStream. str))
+        lexer (do ;;(println "getting lexer")
+                  (ClojureLexer. input))
+        tokens (do
+                 ;;(println "getting tokens")
+                 (CommonTokenStream. lexer))
+        parser (do
+                 ;;(println "getting parser")
+                 (ClojureParser. tokens))
+        tree (do ;;(println "getting tree")
+               (.file parser))] ; "file" is the start rule of the grammar
+    (do
+      (.visit (visitor parser) tree))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn- listener [parser]
     (proxy [ClojureBaseListener] []
@@ -32,8 +95,8 @@
           ))
       ))

-(defn parse-str [str]
-  "Parse string 'str using the Clojure parser."
+(defn listen-str [str]
+  "Parse string 'str and crawl it using a passive strategy"
   (print (format "parsing %s\n" str))
   (let [input (do ;;(println "getting stream")
                 (ANTLRInputStream. str))
@@ -50,8 +113,8 @@
     (do
       (.walk (ParseTreeWalker.) (listener parser) tree))))

-(defn parse-file [file]
-  "Parse file 'file using the Clojure parser."
+(defn listen-file [file]
+  "Parse file 'file and crawl it using a passive strategy"
   (print (format "parsing %s\n" file))
   (let [input (do ;;(println "getting stream")
                 ;; use ANTLRInputStream to read from a string buffer
@@ -68,3 +131,4 @@
                (.file parser))] ; "file" is the start rule of the grammar
     (do
       (.walk (ParseTreeWalker.) (listener parser) tree))))
+


Define next view on jump

Define next view on jump

--- src/discuss/communication/main.cljs
+++ src/discuss/communication/main.cljs
@@ -189,4 +189,4 @@
    ** TODO: Update route **"
   [slug arg-id]
   (let [url (clojure.string/join "/" ["api" slug "jump" arg-id])]
-    (ajax-get url)))+    (ajax-get-and-change-view url :discussion)))


Schema items optional.

Schema items optional.

--- src/onyx/sql/information_model.cljc
+++ src/onyx/sql/information_model.cljc
@@ -71,14 +71,16 @@

              :sql/user
              {:type :string
-              :doc "The user to authenticate with."}
-
-             :sql/password
-             {:type :string
-              :doc "The password to authenticate with."}
-
-             :sql/db-name
-             {:type :string
+              :optional? true
+              :doc "The user to authenticate with."}
+
+             :sql/password
+             {:type :string
+              :doc "The password to authenticate with."}
+
+             :sql/db-name
+             {:type :string
+              :optional? true
               :doc "The database to connect to."}

              :sql/table
@@ -105,14 +107,16 @@

              :sql/user
              {:type :string
-              :doc "The user to authenticate with."}
-
-             :sql/password
-             {:type :string
-              :doc "The password to authenticate with."}
-
-             :sql/db-name
-             {:type :string
+              :optional? true
+              :doc "The user to authenticate with."}
+
+             :sql/password
+             {:type :string
+              :doc "The password to authenticate with."}
+
+             :sql/db-name
+             {:type :string
+              :optional? true
               :doc "The database to connect to."}

              :sql/table


Fix function parameters in 'figwheel-sidecar.system/repl-function-docs' (#648)

--- sidecar/src/figwheel_sidecar/system.clj
+++ sidecar/src/figwheel_sidecar/system.clj
@@ -486,13 +486,13 @@
 (def repl-function-docs
   "Figwheel Controls:
           (stop-autobuild)                ;; stops Figwheel autobuilder
-          (start-autobuild [id ...])      ;; starts autobuilder focused on optional ids
+          (start-autobuild id ...)        ;; starts autobuilder focused on optional ids
           (switch-to-build id ...)        ;; switches autobuilder to different build
           (reset-autobuild)               ;; stops, cleans, and starts autobuilder
           (reload-config)                 ;; reloads build config and resets autobuild
-          (build-once [id ...])           ;; builds source one time
-          (clean-builds [id ..])          ;; deletes compiled cljs target files
-          (print-config [id ...])         ;; prints out build configurations
+          (build-once id ...)             ;; builds source one time
+          (clean-builds id ..)            ;; deletes compiled cljs target files
+          (print-config id ...)           ;; prints out build configurations
           (fig-status)                    ;; displays current state of system
           (figwheel.client/set-autoload false)    ;; will turn autoloading off
           (figwheel.client/set-repl-pprint false) ;; will turn pretty printing off


fixed higlighting to avoid overlapping the 'One'

--- src/unspun/screens/number_needed.cljs
+++ src/unspun/screens/number_needed.cljs
@@ -87,7 +87,7 @@
   [n cols w h]
   (->>
     (range (* cols (Math.ceil (/ n cols))))
-    (map-indexed #(if (< %1 n) 1 0))
+    (map-indexed #(if (< %1 n) (inc %2) 0))
     (partition-all cols)
     (partition-all h)
     (interpose (repeat cols 0))
@@ -156,37 +156,46 @@

 (def dice {1 [[1]]
            2 [[1 0]
-              [0 1]]
-           3 [[1 1]
-              [0 1]]
-           4 [[1 1]
-              [1 1]]
-           5 [[1 0 1]
-              [0 1 0]
-              [1 0 1]]
-           6 [[1 1 1]
+              [0 2]]
+           3 [[1 2]
+              [0 3]]
+           4 [[1 2]
+              [3 4]]
+           5 [[1 0 2]
+              [0 3 0]
+              [4 0 5]]
+           6 [[1 2 3]
               nil
-              [1 1 1]]
-           7 [[1 1 0]
-              [1 1 1]
-              [0 1 1]]
-           8 [[1 1 1]
-              [1 0 1]
-              [1 1 1]]
-           9 [[1 1 1]
-              [1 1 1]
-              [1 1 1]]
+              [4 5 6]]
+           7 [[1 2 0]
+              [3 4 5]
+              [0 6 7]]
+           8 [[1 2 3]
+              [4 0 5]
+              [6 7 8]]
+           9 [[1 2 3]
+              [4 5 6]
+              [7 8 9]]
            })

 (defn dicen
-  "layout n icons in an easy to count manner (dice-like for small n)"
+  "layout n icons in an easy to count manner (dice-like for small n).
+  Full cells are represented by a non-zero value. Positive for a normal
+  cell, and negative for a highlighted cell. A cell is highlighted if its
+  index (in 0..(n-1)) is in the highlight set."
   [n highlight]
-  (cond
-    (< n 10) (get dice n)
-    (<= n 20) (blocks n 5 5 2)
-    (<= n 100) (blocks n 10 5 2)
-    :else (blocks n 10 10 10)
-    ))
+  (mapv
+    #(mapv (fn [k] (if (highlight (dec k)) (- k) k)) %)
+    (cond
+      (< n 10) (get dice n)
+      (<= n 20) (blocks n 5 5 2)
+      (<= n 100) (blocks n 10 5 2)
+      :else (blocks n 10 10 10))))
+
+(comment
+  (dicen 5 #{0 1 3})
+  => [[-1 0 -2] [0 3 0] [-4 0 5]]
+  )

 (defn icon-top
   "Determine vertical position of icons, taking account of their size a, the layout for the number n,
@@ -279,7 +288,10 @@
                                                   "rgb(0,0,0,0)")
                                         :color  (if (and (zero? i) (zero? j))
                                                   ((if (> rr 1) :text-icons :dark-primary) palette)
-                                                  "white")     ; (if (highlight (+ j (* i rows))) "black" "white")
+                                                  (if (pos? col)
+                                                    (:light-primary palette)
+                                                    (:accent palette)
+                                                    ))  ; (if (highlight (+ j (* i rows))) "black" "white")
                                         })))))))))

@@ -316,13 +328,15 @@

-(rum/defc page < rum/reactive (rum/local 0 ::icon-index) []
+(rum/defc page < rum/reactive []
   (let [scenar ((rum/react stories) (rum/react story-index))
         palette (get-palette (rum/react palette-index))
         br (:baseline-risk scenar)
         rr (:relative-risk scenar)
         nn (number-needed rr br)
-        highlight (ffloyd-sample nn (max 0 ((if (> rr 1) identity dec) (anyway rr br))))
+        ; we don't want to highlight the first icon - as that is already allocated to be the 'one'.
+        highlight (into #{} (map inc (ffloyd-sample (- nn 2)
+                                                    (max 0 ((if (> rr 1) identity dec) (anyway rr br))))))
         [w h] (screen-w-h)
         w (- w 0)
         h (- h 168)                                         ; adjustment for existing header and footer


Adding new components

Adding new components

--- src/warehouse/core.cljs
+++ src/warehouse/core.cljs
@@ -151,7 +151,7 @@

 (defn item [data k]
   (let [editing (atom false)]
-    (fn [data]
+    (fn []
       [:div
        [:ul {:class (when @editing "hide")}
         [:li
@@ -188,16 +188,29 @@
         (recur (rest indexes) (conj res [(first indexes) (get (:components @app-state) (first indexes))]))))))

 (defn page []
-  [:div
-   [:label "Search: "
-    [:input {:name "search",
-             :type "search"
-             :on-change (fn [e]
-                          (swap! app-state assoc-in [:filter :val] (.-target.value e))
-                          (swap! app-state assoc-in [:filter :search] (js->clj (.search index (.-target.value e)))))}]]
-   [:button "Add new"]
-   (for [[k v] (get-visible-components)]
-     ^{:key (:name v)} [item v k])])
+  (let [adding (atom false)
+        new-item (atom {:name "" :tags "" :amount 1})]
+    (fn []
+      [:div
+       [:label "Search: "
+        [:input {:name "search",
+                 :type "search"
+                 :on-change (fn [e]
+                              (swap! app-state assoc-in [:filter :val] (.-target.value e))
+                              (swap! app-state assoc-in [:filter :search] (js->clj (.search index (.-target.value e)))))}]]
+         (if (true? @adding)
+           [:form
+             [form new-item]
+             [:button {:type "button"
+                       :on-click (fn []
+                                   (let [k (inc (apply max (keys (:components @app-state))))]
+                                     (swap! app-state assoc-in [:components k] (assoc @new-item :id k :tags (mapv clojure.string/trim (clojure.string/split (:tags @new-item) #",")))))
+                                   (reset! adding false))} "Save"]
+             [:button {:type "button" :on-click #(reset! adding false)} "Cancel"]]
+           [:button {:on-click (fn [e]
+                                 (reset! adding true))} "Add new"])
+       (for [[k v] (get-visible-components)]
+         ^{:key (:name v)} [item v k])])))

 (reagent/render-component [page]
                           (.getElementById js/document "app"))


make json response 'pretty' for now

make json response 'pretty' for now

--- src/wb_es/web/index.clj
+++ src/wb_es/web/index.clj
@@ -18,6 +18,6 @@
 (defn handler [request]
   (let [enhanced-handler
         (-> app
-            (wrap-json-response)
+            (wrap-json-response {:pretty true})
             (wrap-defaults api-defaults))]
     (enhanced-handler request)))


remove unecessary backround color

remove unecessary backround color

--- src/zombie_run/quil.clj
+++ src/zombie_run/quil.clj
@@ -78,8 +78,7 @@
                          (let [game @game]
                            (display-game game)))
                  :setup (fn []
-                          (q/frame-rate 20)                 ; Set FPS
-                          (q/background 200))
+                          (q/frame-rate 20))                ; Set FPS
                  :key-pressed (fn []
                                 (if (= \newline (q/raw-key))
                                   (reset! game default-game)


(SERVER-1183) Move mark-environment-expired functions down in core ns

This commit moves the `mark-environment-expired!` and
`mark-all-environments-expired!` calls in the jruby-puppet-core
namespace down a little in anticipation of being able to have them call
some of the environment class cache related functions in the core
namespace in a later commit.

--- src/clj/puppetlabs/services/jruby/jruby_puppet_core.clj
+++ src/clj/puppetlabs/services/jruby/jruby_puppet_core.clj
@@ -244,23 +244,6 @@
   @(:state jruby-puppet))

 (schema/defn ^:always-validate
-  mark-environment-expired!
-  [context :- jruby-schemas/PoolContext
-   env-name :- schema/Str]
-  (doseq [jruby-instance (registered-instances context)]
-    (-> jruby-instance
-      :environment-registry
-      (puppet-env/mark-environment-expired! env-name))))
-
-(schema/defn ^:always-validate
-  mark-all-environments-expired!
-  [context :- jruby-schemas/PoolContext]
-  (doseq [jruby-instance (registered-instances context)]
-    (-> jruby-instance
-        :environment-registry
-        puppet-env/mark-all-environments-expired!)))
-
-(schema/defn ^:always-validate
   borrow-from-pool :- jruby-schemas/JRubyPuppetInstanceOrPill
   "Borrows a JRubyPuppet interpreter from the pool. If there are no instances
   left in the pool then this function will block until there is one available."
@@ -431,3 +414,20 @@
          #(if (contains? % env-name)
            %
            (assoc % env-name (environment-class-info-entry)))))
+
+(schema/defn ^:always-validate
+  mark-environment-expired!
+  [context :- jruby-schemas/PoolContext
+   env-name :- schema/Str]
+  (doseq [jruby-instance (registered-instances context)]
+    (-> jruby-instance
+        :environment-registry
+        (puppet-env/mark-environment-expired! env-name))))
+
+(schema/defn ^:always-validate
+  mark-all-environments-expired!
+  [context :- jruby-schemas/PoolContext]
+  (doseq [jruby-instance (registered-instances context)]
+    (-> jruby-instance
+        :environment-registry
+        puppet-env/mark-all-environments-expired!)))


(PDB-4372) Log 'replace catalog inputs' command name

An incorrect keyword used to look up the command name
for 'replace catalog inputs' commands caused a log message like
"'null' command processed for new-host" to be printed.

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -315,7 +315,7 @@
         (scf-storage/maybe-activate-node! certname stamp)
         (scf-storage/replace-catalog-inputs! certname catalog_uuid inputs stamp))
       (log-command-processed-messsage id received start-time
-                                      :catalog-inputs certname))))
+                                      :replace-catalog-inputs certname))))

 ;; Fact replacement


Disallow recovering of an existing multiaccount

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/multiaccounts/recover/core.cljs
+++ src/status_im/multiaccounts/recover/core.cljs
@@ -20,7 +20,7 @@

 (defn existing-account?
   [root-key multiaccounts]
-  (contains? multiaccounts (:key-uid root-key)))
+  (contains? multiaccounts (:keyUid root-key)))

 (re-frame/reg-fx
  ::validate-mnemonic
@@ -130,7 +130,7 @@

 (fx/defn on-import-multiaccount-success
   {:events [::import-multiaccount-success]}
-  [{:keys [db] :as cofx} {:keys [key-uid] :as root-data} derived-data]
+  [{:keys [db] :as cofx} root-data derived-data]
   (let [multiaccounts (:multiaccounts/multiaccounts db)]
     (fx/merge
      cofx
@@ -140,7 +140,7 @@
                   :step :recovery-success
                   :forward-action :multiaccounts.recover/re-encrypt-pressed)}
      (when (existing-account? root-data multiaccounts)
-       (show-existing-multiaccount-alert key-uid))
+       (show-existing-multiaccount-alert (:keyUid root-data)))
      (navigation/navigate-to-cofx :recover-multiaccount-success nil))))

 (fx/defn enter-phrase-pressed


remove unnecessary filter-out-fails

remove unnecessary filter-out-fails

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -198,60 +198,50 @@
                                        (and (not-fail? (unify (strip-refs (get-in lexeme [:synsem] :top))
                                                               bolt-child-synsem))))
                                      complement-candidate-lexemes))]
-    (filter #(not-fail? %)
-            (mapfn (fn [complement]
-                     (let [unified
-                           (unify (copy bolt)
-                                  (assoc-in {} path
-                                            (copy complement)))]
-                       (if truncate-children
-                         (truncate unified [path] language-model)
-                         unified)))
-                  (let [debug (log/trace (str "add-complement-to-bolt(total-depth=" total-depth
-                                              ",path=" path ",bolt=(" (show-bolt bolt language-model)
-                                              "): calling generate-all(" (strip-refs spec) ");"
-                                              "spec: " spec))
-                        phrasal-complements (if (and (> max-total-depth total-depth)
-                                                     (= true (get-in spec [:phrasal] true)))
-                                              (generate-all spec language-model (+ (count path) total-depth)
-                                                            :max-total-depth max-total-depth))
-                        lexemes-before-phrases (lexemes-before-phrases total-depth max-total-depth)]
-                    (cond (and lexemes-before-phrases
-                               (empty? lexical-complements)
-                               (= false (get-in spec [:phrasal] true)))
-                          (log/warn (str "failed to generate any lexical complements with spec: "
-                                         (strip-refs spec)))
-
-                          (and lexemes-before-phrases
-                               (= true (get-in spec [:phrasal] false))
-                               (empty? phrasal-complements))
-                          (log/warn (str "failed to generate any phrasal complements with spec: "
-                                         (strip-refs spec)))
-
-                          (and (empty? lexical-complements)
-                               (empty? phrasal-complements))
-
-                          (let [message (str "add-complement-to-bolt: could generate neither phrasal "
-                                         "nor lexical complements for "
-                                         "bolt:" (show-bolt bolt language-model) "; immediate parent: "
-                                          (get-in bolt (concat (butlast path) [:rule]) :norule) " "
-                                          "while trying to create a complement: "
-                                          (spec-info spec)
-                                          )]
-                            (log/warn message)
-                            (if error-if-no-complements (exception message)))
-
-                          lexemes-before-phrases
-                          (take max-generated-complements
-                                (lazy-cat lexical-complements phrasal-complements))
-                          true
-                          (do
-                            (log/trace (str "successfully generated some complements for bolt:"
-                                            (show-bolt bolt language-model)
-                                            " matching spec:"
-                                            (spec-info spec)))
-
-                            (take max-generated-complements (lazy-cat phrasal-complements lexical-complements)))))))))
+    (mapfn (fn [complement]
+             (let [unified
+                   (unify (copy bolt)
+                          (assoc-in {} path
+                                    (copy complement)))]
+               (if truncate-children
+                 (truncate unified [path] language-model)
+                 unified)))
+           (let [phrasal-complements (if (and (> max-total-depth total-depth)
+                                              (= true (get-in spec [:phrasal] true)))
+                                       (generate-all spec language-model (+ (count path) total-depth)
+                                                     :max-total-depth max-total-depth))
+                 lexemes-before-phrases (lexemes-before-phrases total-depth max-total-depth)]
+             (cond (and lexemes-before-phrases
+                        (empty? lexical-complements)
+                        (= false (get-in spec [:phrasal] true)))
+                   (log/warn (str "failed to generate any lexical complements with spec: "
+                                  (strip-refs spec)))
+
+                   (and lexemes-before-phrases
+                        (= true (get-in spec [:phrasal] false))
+                        (empty? phrasal-complements))
+                   (log/warn (str "failed to generate any phrasal complements with spec: "
+                                  (strip-refs spec)))
+
+                   (and (empty? lexical-complements)
+                        (empty? phrasal-complements))
+
+                   (let [message (str "add-complement-to-bolt: could generate neither phrasal "
+                                      "nor lexical complements for "
+                                      "bolt:" (show-bolt bolt language-model) "; immediate parent: "
+                                      (get-in bolt (concat (butlast path) [:rule]) :norule) " "
+                                      "while trying to create a complement: "
+                                      (spec-info spec)
+                                      )]
+                     (log/warn message)
+                     (if error-if-no-complements (exception message)))
+
+                   lexemes-before-phrases
+                   (take max-generated-complements
+                         (lazy-cat lexical-complements phrasal-complements))
+                   true
+                   (take max-generated-complements
+                         (lazy-cat phrasal-complements lexical-complements)))))))

 (defn bolt-depth [bolt]
   (if-let [head (get-in bolt [:head] nil)]


checking unify result value properly

checking unify result value properly

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -136,8 +136,8 @@
   (log/trace (str "candidate-parents: spec: " (strip-refs spec)))
   (filter #(not (fail? %))
           (mapfn (fn [rule]
-                   (if (unifyc (get-in rule [:synsem :cat] :top)
-                               (get-in spec [:synsem :cat] :top))
+                   (if (not (fail? (unifyc (get-in rule [:synsem :cat] :top)
+                                           (get-in spec [:synsem :cat] :top))))
                      (unifyc spec rule)
                      :fail))
                  (shuffle rules))))


let's see if (reduce concat) is faster than (mapcat ..)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -60,14 +60,20 @@
                        (comp-paths-to-complements bolt model depth max-depth)
                        [] (list bolt))))

-     ;; For each such map:complement-position -> complements, find all possible combinations of complements, taking one complement per position.
-     ;; The result is a trellis for each bolt, and a path through this trellis is a generated expression, with one complement for each complement position.
-     (mapcat (fn [each-bolt-and-comps]
-               (let [paths-to-comps (keys each-bolt-and-comps)
-                     vals (vals each-bolt-and-comps)]
-                 (map (fn [each-path-through-trellis]
-                        (zipmap paths-to-comps each-path-through-trellis))
-                      (apply combo/cartesian-product vals)))))
+     ;; For each such map:complement-position -> complements, find all
+     ;; possible combinations of complements, taking one complement
+     ;; per position.
+     ;; The result is a trellis for each bolt, and a path through this
+     ;; trellis is a generated expression, with one complement for
+     ;; each complement position.
+     (map (fn [each-bolt-and-comps]
+            (let [paths-to-comps (keys each-bolt-and-comps)
+                  vals (vals each-bolt-and-comps)]
+              (map (fn [each-path-through-trellis]
+                     (zipmap paths-to-comps each-path-through-trellis))
+                   (apply combo/cartesian-product vals)))))
+
+     (reduce concat)

      ;; for each such path through a trellis, unify the bolt with all of its complements to create a final expression tree.
      (map (fn [bolt-and-comps]


fix typo in use of index-fn

fix typo in use of index-fn

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -46,7 +46,8 @@
              lexicon (or lexicon
                          (:lexicon (:generate model))
                          (:lexicon model))
-             index-fn (or (and index-fn (:index-fn model))
+             index-fn (or index-fn
+                          (:index-fn model)
                           (do
                             (log/warn (str "no index available for this model: using entire lexicon."))
                             (fn [spec]


move logging code out of (defn generate-all) for clarity

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -38,6 +38,7 @@
 (declare find-comp-paths)
 (declare get-lexemes)
 (declare lexemes-before-phrases)
+(declare log-unification-failure)
 (declare lightning-bolts)
 (declare not-fail?)

@@ -70,35 +71,26 @@
                (map (fn [bolt-and-comps]
                       (let [bolt (get bolt-and-comps [])
                             paths-and-comps (dissoc bolt-and-comps [])
-                            paths-to-comps (keys paths-and-comps)]
-                        (log/debug (str "generate-all paths: " (clojure.string/join "," paths-to-comps)))
-                        (log/debug (str "generate-all vals: " (clojure.string/join "," (map #((:morph model) %) (vals paths-and-comps)))))
-                        (let [result
-                              (reduce (fn [a b]
-                                        (let [result
-                                              (cond (or (= :fail a)
-                                                        (= :fail b)) :fail
-                                                    true (unify a b))]
-                                          (when (and (not (= :fail a)) (not (= :fail b)))
-                                            (if (= :fail result)
-                                              ;; warn because fails are expensive and should be filtered out before hitting this.
-                                              (do
-                                                (log/warn (str "failed to unify("))
-                                                (log/warn (str "  a: " ((:morph-ps model) a) ","))
-                                                (log/warn (str "  b: " ((:morph-ps model) b)))
-                                                (log/debug (str "  ser a: (def a (dag_unify.core/deserialize '(" (string/join "" (:dag_unify.core/serialized a)) ")))"))
-                                                (log/debug (str "  ser b: (def b (dag_unify.core/deserialize '(" (string/join "" (:dag_unify.core/serialized b)) ")))"))
-                                                (log/warn (str ") => fail@" (fail-path a b))))
-                                              (log/debug (str "unify(" ((:morph-ps model) a) " , " ((:morph-ps model) b) ") => "
-                                                              ((:morph-ps model) result)))))
-                                          result))
-                                      (cons bolt
-                                            (map (fn [path-to-comp]
-                                                   (let [complement (get paths-and-comps path-to-comp)]
-                                                     (assoc-in bolt path-to-comp complement)))
-                                                 paths-to-comps)))]
-                          (log/debug (str "generate-all: result: " ((:morph model) result)))
-                          result)))
+                            paths-to-comps (keys paths-and-comps)
+                            result (reduce (fn [a b]
+                                             (let [result
+                                                   (cond (or (= :fail a)
+                                                             (= :fail b)) :fail
+                                                         true (unify a b))]
+                                               (when (and (not (= :fail a)) (not (= :fail b)))
+                                                 (if (= :fail result)
+                                                   (log-unification-failure a b model)
+                                                   (log/debug (str "unify(" ((:morph-ps model) a)
+                                                                   " , " ((:morph-ps model) b) ") => "
+                                                                   ((:morph-ps model) result)))))
+                                               result))
+                                           (cons bolt
+                                                 (map (fn [path-to-comp]
+                                                        (let [complement (get paths-and-comps path-to-comp)]
+                                                          (assoc-in bolt path-to-comp complement)))
+                                                      paths-to-comps)))]
+                        (log/debug (str "generate-all: result: " ((:morph model) result)))
+                        result))
                     bolt-groups)))
      (map #(do-defaults % model)) ;; for each tree, run model defaults.

@@ -281,3 +273,13 @@
                     (string/join "," (map :rule result))
                     " for: " (spec-info spec))))
     result))
+
+(defn log-unification-failure [a b model]
+  ;; warn because fails are expensive and should be filtered out before hitting this.
+  (log/warn (str "failed to unify("))
+  (log/warn (str "  a: " ((:morph-ps model) a) ","))
+  (log/warn (str "  b: " ((:morph-ps model) b)))
+  (log/debug (str "  ser a: (def a (dag_unify.core/deserialize '(" (string/join "" (:dag_unify.core/serialized a)) ")))"))
+  (log/debug (str "  ser b: (def b (dag_unify.core/deserialize '(" (string/join "" (:dag_unify.core/serialized b)) ")))"))
+  (log/warn (str ") => fail@" (fail-path a b))))
+


remove need to call (vals)

remove need to call (vals)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -106,23 +106,21 @@
 (defn comp-paths-to-bolts-map
   "return a map between the set of all complements in the given _bolt_,and the lazy sequence of bolts for that spec."
   [bolt comp-paths model depth max-depth]
-  (if (and (not (nil? bolt)))
-    (if (not (empty? comp-paths))
-      (zipmap
-       comp-paths
-       (mapfn #(let [spec (get-in bolt %)
-                     lexemes (get-lexemes model spec)
-                     bolts-at (if (< depth max-depth)
-                                  (lightning-bolts
-                                   model
-                                   (get-in bolt %)
-                                   depth max-depth))
-                     lexemes-before-phrases
-                     (lexemes-before-phrases depth max-depth)]
-                 (if lexemes-before-phrases
-                   (lazy-cat lexemes bolts-at)
-                   (lazy-cat bolts-at lexemes)))
-              comp-paths)))))
+  (when (and (not (nil? bolt))
+             (not (empty? comp-paths)))
+    (mapfn #(let [spec (get-in bolt %)
+                  lexemes (get-lexemes model spec)
+                  bolts-at (if (< depth max-depth)
+                             (lightning-bolts
+                              model
+                              (get-in bolt %)
+                              depth max-depth))
+                  lexemes-before-phrases
+                  (lexemes-before-phrases depth max-depth)]
+              (if lexemes-before-phrases
+                (lazy-cat lexemes bolts-at)
+                (lazy-cat bolts-at lexemes)))
+           comp-paths)))

 (defn add-comps
   "given a bolt, return the lazy sequence of all bolts derived from this bolt after adding,
@@ -145,7 +143,7 @@
                     (if (= false (get-in bolt-at [:phrasal]))
                       [(do-defaults (assoc-in bolt path bolt-at) model)]
                       (let [comp-paths (find-comp-paths bolt-at)
-                            comp-bolts (vals (comp-paths-to-bolts-map bolt-at comp-paths model (+ 1 depth) max-depth))]
+                            comp-bolts (comp-paths-to-bolts-map bolt-at comp-paths model (+ 1 depth) max-depth)]
                         (when (not (some empty? comp-bolts))
                           (mapfn #(do-defaults (assoc-in bolt path %) model)
                                  (add-comps bolt-at
@@ -163,7 +161,7 @@
   (flatten
    (mapfn (fn [bolt]
             (let [comp-paths (find-comp-paths bolt)
-                  comp-bolts (vals (comp-paths-to-bolts-map bolt comp-paths model 0 max-total-depth))]
+                  comp-bolts (comp-paths-to-bolts-map bolt comp-paths model 0 max-total-depth)]
               ;; filter by the following constraint:
               ;; that for every path that points to a complement of a bolt,
               ;; there is a non-empty set of bolts that satisfies


clean up some unused code

clean up some unused code

--- src/vignette/api/legacy/routes.clj
+++ src/vignette/api/legacy/routes.clj
@@ -4,23 +4,8 @@
 (declare route->revision
          route->dimensions
          route->thumb-mode
-         route->options
-         add-request-type)
+         route->options)

-;29 {
-;30    "width" : "185px",
-;31    "archive" : "",
-;32    "wikia" : "happywheels",
-;33    "input" : "/happywheels/images/thumb/b/bb/SuperMario64_20.png/185px-SuperMario64_20.webp",
-;34    "hook_name" : "image thumbnailer",
-;35    "thumbpath" : "happywheels/images/thumb/b/bb/SuperMario64_20.png",
-;36    "thumbname" : "185px-SuperMario64_20.webp",
-;37    "filename" : "SuperMario64_20",
-;38    "thumbext" : "SuperMario64_20",
-;39    "type" : "images",
-;40    "fileext" : "png"
-;41 }
-; qr{ \/((?!\w\/)?(.+)\/(images|avatars)\/thumb((?!\/archive).*|\/archive)?\/\w\/\w{2}\/(.+)\.(jpg|jpeg|png|gif{1,}))\/((\d+px|\d+x\d+|\d+x\d+x\d+|)\-(.*)\.(jpg|jpeg|jpe|png|gif|webp))(\?.*)?$ }xi,
 (def thumbnail-route
   (route-compile "/:wikia:lang/:image-type/thumb:archive/:top-dir/:middle-dir/:original/:thumbname"
                  {:wikia #"[\w-]+"
@@ -44,7 +29,7 @@
 (defn route->thumb-map
   [route-params]
   (let [map (-> route-params
-                (add-request-type :thumbnail)
+                (assoc :request-type :thumbnail)
                 (assoc :thumbnail-mode "thumbnail")
                 (route->dimensions)
                 (route->revision)
@@ -54,16 +39,10 @@
 (defn route->original-map
   [route-params]
   (let [map (-> route-params
-                (add-request-type :original)
+                (assoc :request-type :original)
                 (route->revision)
                 (route->options))]
     map))
-
-(defn add-request-type
-  [m request-type]
-  {:pre [(map? m)]
-   :post [(map? %)]}
-  (merge m {:request-type request-type}))

 (defn route->revision
   [map]
@@ -83,9 +62,7 @@
     (assoc map :options {:format format
                          :lang lang})))

-(defmulti route->dimensions :request-type)
-
-(defmethod route->dimensions :thumbnail
+(defn route->dimensions
   [route]
   "Add the :width field to a request map based on the legacy parsing methods."
   (if-let [thumb-name (:thumbname route)]
@@ -102,91 +79,3 @@
                         :thumbnail-mode "zoom-crop"})
           route)))
     route))
-
-(defmethod route->dimensions nil
-  [map]
-  map)
-
-(defn request-map->thumbpath
-  [m]
-  (format "%s/%s/%s/%s/%s/%s"
-          (:wikia m)
-          (:image-type m)
-          (:uri-request-type m)
-          (:top-dir m)
-          (:middle-dir m)
-          (:original m)))
-
-(defn request-map-add-thumbpath
-  [m]
-  (assoc m :thumbpath (request-map->thumbpath m)))
-
-;;;;;
-
-(defmulti request-map->dimensions :request-type)
-
-(defmethod request-map->dimensions :image-thumbnail
-  [m])
-
-
-(defn remove-extension
-  "Remove the extension from a filename."
-  [filename]
-  (clojure.string/replace filename #"\.\w+$" ""))
-
-(declare seq-of-strings->seq-of-integers)
-
-(def width-px-regex #"^(\d+)px$")
-(def width-x-height-regex #"^(\d+)x(\d+)$")
-(def width-x-height-x-scale-regex #"^(\d+)x(\d+)x(\d+)$")
-;(def color-width-regex #"^v,([0-9a-f]{6},)?(\d+)px$")
-
-; these probably need to be dispatched based on the type
-; e.g. image thumbnailer, SVG thumbnailer, etc
-
-(defn thumbnail-path->dimensions
-  "Given a thumb path, extract the dimensions.
-  For example, from \"130px-102,382,0,247-Brain_Attack.PNG\", it will
-  extract the \"130px\" and decode it to a width.
-
-  The return value is a vector with the type of dimension matched followed by
-  a sequence with the extracted dimensions.
-
-  Note that the current implementation favors clarity over efficiency. We end up with, in the worst
-  case, 5 calls to `re-find` and in the best case 2.
-
-  Source: backend:lib/Wikia/Thumbnailer/File.pm
-  See has thumb_size declaration.
-
-  TODO: Defaults and config checks that are currently used in File.pm?
-  "
-  [thumb-path]
-  (let [matches (re-find #"(?ix)(\d+px|\d+x\d+|\d+x\d+x\d+|)\-(.*)\.(jpg|jpeg|jpe|png|gif|webp)" thumb-path)]
-    (when-let [[_ width _ _] matches]
-      (cond
-        (empty? width) nil
-        (re-find width-px-regex width) [:width (seq-of-strings->seq-of-integers (rest (re-find width-px-regex width)))]
-        (re-find width-x-height-regex width) [:width-height (seq-of-strings->seq-of-integers (rest (re-find width-x-height-regex width)))]
-        (re-find width-x-height-x-scale-regex width) [:width-height-scale (seq-of-strings->seq-of-integers (rest (re-find width-x-height-x-scale-regex width)))]
-        ; doesn't belong here-- goes with images without extensions
-        ;(re-find color-width-regex width) [:width-color (let [[_ color w] (re-find color-width-regex width)]
-                                                       ;(list color (Integer. w)))]
-        :else [:default (seq-of-strings->seq-of-integers (list width))]))))
-
-
-(defn thumbnail-path->coordinates
-  "Given a thumbnail path, extract the centering coordinates.
-  For example, from \"130px-102,382,0,247-Brain_Attack.PNG\", it will
-  extract the \"102,382,0,247\" and decode it to a set of coordinates.
-
-  Source: backend:lib/Wikia/Thumbnailer/File.pm
-  See the 'has' thumb_name of thumb_path.
-  "
-  [thumb-path]
-  (let [matches (re-find #"(\d+),(\d+),(\d+),(\d+)" thumb-path)]
-    (when-let [[_ & coordinates] matches]
-      (zipmap [:x1 :x2 :y1 :y2] (map #(Integer. %) coordinates)))))
-
-(defn seq-of-strings->seq-of-integers
-  [s]
-  (map #(Integer. %) s))


Placeholder render-net callback.

Placeholder render-net callback.

--- src/cbfg/world-net.cljs
+++ src/cbfg/world-net.cljs
@@ -50,6 +50,28 @@
                                                         conj [ts v])))
                  (recur num-requests (inc num-responses)))))))

+(defn render-net [vis]
+  (let [net-state (:loop-state (second (first (filter (fn [[actx actx-info]]
+                                                        (= (last actx) "net-1"))
+                                                      (:actxs vis)))))
+        addrs (atom {})]
+    (doseq [[[addr port] accept-chs] (:listens net-state)]
+      (swap! addrs #(assoc-in % [addr :listens port] true)))
+    (doseq [[send-ch stream] (:streams net-state)]
+      (if (= (:side stream) :client)
+        (swap! addrs #(assoc-in % [(:client-addr stream) :outs
+                                   [(:accept-addr stream) (:accept-port stream)]
+                                   (:client-port stream)
+                                   (:server-addr stream)
+                                   (:server-port stream)] (:msgs stream)))
+        (swap! addrs #(assoc-in % [(:server-addr stream) :outs
+                                   [(:accept-addr stream) (:accept-port stream)]
+                                   (:server-port stream)
+                                   (:client-addr stream)
+                                   (:client-port stream)] (:msgs stream)))))
+    (set-el-innerHTML "net"
+                      (str net-state "<hr/>" @addrs))))
+
 (defn world-vis-init [el-prefix init-event-delay]
   (let [cmd-inject-ch (chan)
         cmd-ch (replay-cmd-ch cmd-inject-ch (keys cmd-handlers)
@@ -76,14 +98,7 @@
                                                client-hist
                                                client-send-ch client-recv-ch
                                                vis-chs world-vis-init el-prefix))))))))
-              el-prefix
-              (fn [vis]
-                (let [net-state (:loop-state (second (first (filter (fn [[actx actx-info]]
-                                                                      (= (last actx) "net-1"))
-                                                                    (:actxs vis)))))]
-                  (set-el-innerHTML "net"
-                                    (str "hi" net-state))))
-              init-event-delay)
+              el-prefix render-net init-event-delay)
     cmd-inject-ch))

 (start-test "net-test" cbfg.net-test/test)


get-config function has been added to component ns

--- core/src/cljc/hellhound/component.cljc
+++ core/src/cljc/hellhound/component.cljc
@@ -51,6 +51,7 @@
    [hellhound.streams :as streams]
    [hellhound.components.protocols :as impl]
    [hellhound.components.impl.persistent-map :as component-impl]
+   [hellhound.async :as async]
    [hellhound.logger :as logger]))

@@ -172,6 +173,10 @@
                                        processed-v#))))
           (hellhound.component/input component#))))}))

+;; Helpers -------------------------------------------------
+(defn get-config
+  [component]
+  (:config (:context component)))

 ;; IO helpers ----------------------------------------------
 (defn io
@@ -224,4 +229,4 @@
   [component delay f]
   (let [[_ out] (io component)]
     (async/schedule-fixedrate-interval delay
-                                       #(>> out (f)))))
+                                       #(streams/>> out (f)))))


Removed incorrect statement about pop on empty collection

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -406,9 +406,8 @@

 (defn pop
   "For a list or queue, returns a new list/queue without the first
-  item, for a vector, returns a new vector without the last item. If
-  the collection is empty, throws an exception.  Note - not the same
-  as next/butlast."
+  item, for a vector, returns a new vector without the last item.
+  Note - not the same as next/butlast."
   [coll]
   (-pop coll))


Add :vcs-type to event properties

Add :vcs-type to event properties

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -175,7 +175,8 @@
                                                                            :org (:username project)
                                                                            :repo (:reponame project)})
                                   :on-click #((om/get-shared owner :track-event) {:event-type :project-clicked
-                                                                                :properties {:org org-name
+                                                                                :properties {:vcs-type (:vcs_type project)
+                                                                                :org org-name
                                                                                :repo repo-name
                                                                                :component "branch-picker"}})}
                  (project-model/project-name project)]


experimenting

experimenting

--- examples/src/famous_examples/core.cljs
+++ examples/src/famous_examples/core.cljs
@@ -20,9 +20,18 @@
     (setOrigin 0.5 0.5)
     )

-(def spinner (.. logo (addComponent (clj->js {"onUpdate" (fn [time]
-                                                               (.. logo (setRotation 0 (/ time 1000.0))
-                                                                   (requestUpdateOnNextTick spinner)))}))))
+(def spinner (.. logo (addComponent (clj->js {:onUpdate          (fn [time]
+                                                                     (.. logo
+                                                                         (setRotation 0 (/ time 1000.0))
+                                                                         (requestUpdateOnNextTick spinner))
+                                                                     (println "time=" time))
+                                              :onMount           (fn [node]
+                                                                     (println "onMount called: " (.. node getLocation))
+                                                                     )
+                                              :onTransformChange (fn []
+                                                                     (println "onTransformChange called")
+                                                                     )}
+                                             ))))

 (.. logo (requestUpdate spinner))
 (.. FamousEngine init)


add lein-light

add lein-light

--- profiles.clj
+++ profiles.clj
@@ -4,5 +4,5 @@
      (use '[table.core :only (table)])
      (use '[clojure.repl :only (dir-fn)])
      (load-file (str (System/getProperty "user.home") "/.lein/user.clj")))}
-  :plugins  [[lein-clojars "0.9.0"]]
+  :plugins  [[lein-clojars "0.9.0"] [lein-light "0.0.4"]]
   :dependencies  {table "0.2.0"}}}


DatomicConnection fix

DatomicConnection fix

--- modules/datomic/src/modular/datomic.clj
+++ modules/datomic/src/modular/datomic.clj
@@ -39,21 +39,21 @@
       (->EphemeralDatabase uri)
       (->DurableDatabase uri))))

-(defrecord DatomicConnection []
+(defrecord DatomicConnection [connection]
   component/Lifecycle
-  (start [this] (d/connect (get-in this [:database :uri])))
-  (stop [this] this))
+  (start [this] (assoc this :connection (d/connect (get-in this [:database :uri]))))
+  (stop [this] (d/release connection) (dissoc this :connection)))

-(defn new-datomic-connection []
+(defn new-datomic-connection
   (component/using
-   (->DatomicConnection)
+   (->DatomicConnection nil)
    [:database]))

 (defrecord DatomicSchema [res]
   component/Lifecycle
   (start [this]
     (with-open [rdr (java.io.PushbackReader. (io/reader res))]
-      @(d/transact (:connection this)
+      @(d/transact (get-in this [:connection :connection])
                    (binding [clojure.tools.reader/*data-readers*
                              {'db/id datomic.db/id-literal
                               'db/fn datomic.function/construct
@@ -79,7 +79,7 @@
 (defrecord DatomicFunctions [functions]
   component/Lifecycle
   (start [this]
-    @(d/transact (:connection this) (create-functions functions))
+    @(d/transact (get-in this [:connection :connection]) (create-functions functions))
     this)
   (stop [this] this))


Yet another eight tests created in metadata_reader_test.clj

--- test/emender_jenkins/metadata_reader_test.clj
+++ test/emender_jenkins/metadata_reader_test.clj
@@ -111,6 +111,52 @@
         (is (callable? 'emender-jenkins.metadata-reader/parse-first-number-from-stream))))

+(deftest test-read-file-from-artifact-existence
+    "Check that the emender-jenkins.metadata-reader/read-file-from-artifact definition exists."
+    (testing "if the emender-jenkins.metadata-reader/read-file-from-artifact definition exists."
+        (is (callable? 'emender-jenkins.metadata-reader/read-file-from-artifact))))
+
+
+(deftest test-read-and-parse-first-number-from-jenkins-existence
+    "Check that the emender-jenkins.metadata-reader/read-and-parse-first-number-from-jenkins definition exists."
+    (testing "if the emender-jenkins.metadata-reader/read-and-parse-first-number-from-jenkins definition exists."
+        (is (callable? 'emender-jenkins.metadata-reader/read-and-parse-first-number-from-jenkins))))
+
+
+(deftest test-read-and-parse-entities-count-existence
+    "Check that the emender-jenkins.metadata-reader/read-and-parse-entities-count definition exists."
+    (testing "if the emender-jenkins.metadata-reader/read-and-parse-entities-count definition exists."
+        (is (callable? 'emender-jenkins.metadata-reader/read-and-parse-entities-count))))
+
+
+(deftest test-read-and-parse-entities-uniq-existence
+    "Check that the emender-jenkins.metadata-reader/read-and-parse-entities-uniq definition exists."
+    (testing "if the emender-jenkins.metadata-reader/read-and-parse-entities-uniq definition exists."
+        (is (callable? 'emender-jenkins.metadata-reader/read-and-parse-entities-uniq))))
+
+
+(deftest test-read-and-parse-used-graphics-count-existence
+    "Check that the emender-jenkins.metadata-reader/read-and-parse-used-graphics-count definition exists."
+    (testing "if the emender-jenkins.metadata-reader/read-and-parse-used-graphics-count definition exists."
+        (is (callable? 'emender-jenkins.metadata-reader/read-and-parse-used-graphics-count))))
+
+
+(deftest test-read-and-parse-word-count-existence
+    "Check that the emender-jenkins.metadata-reader/read-and-parse-word-count definition exists."
+    (testing "if the emender-jenkins.metadata-reader/read-and-parse-word-count definition exists."
+        (is (callable? 'emender-jenkins.metadata-reader/read-and-parse-word-count))))
+
+
+(deftest test-read-and-parse-xincludes-count-existence
+    "Check that the emender-jenkins.metadata-reader/read-and-parse-xincludes-count definition exists."
+    (testing "if the emender-jenkins.metadata-reader/read-and-parse-xincludes-count definition exists."
+        (is (callable? 'emender-jenkins.metadata-reader/read-and-parse-xincludes-count))))
+
+
+(deftest test-read-and-parse-zpage-count-existence
+    "Check that the emender-jenkins.metadata-reader/read-and-parse-zpage-count definition exists."
+    (testing "if the emender-jenkins.metadata-reader/read-and-parse-zpage-count definition exists."
+        (is (callable? 'emender-jenkins.metadata-reader/read-and-parse-zpage-count))))

 (deftest test-job-results->job-names-existence


CMR-1695: Removing TODOs.

CMR-1695: Removing TODOs.

--- system-int-test/test/cmr/system_int_test/virtual_product_test.clj
+++ system-int-test/test/cmr/system_int_test/virtual_product_test.clj
@@ -7,7 +7,10 @@
             [cmr.system-int-test.data2.collection :as dc]
             [cmr.system-int-test.data2.granule :as dg]
             [cmr.virtual-product.config :as vp-config]
-            [cmr.system-int-test.utils.dev-system-util :as dev-sys-util]))
+            [cmr.system-int-test.utils.dev-system-util :as dev-sys-util]
+            [cmr.system-int-test.system :as s]
+            [cmr.common.time-keeper :as tk]
+            [clj-time.core :as t]))

 (def virtual-product-providers
   "Returns a list of the provider ids of the providers with virtual products."
@@ -83,14 +86,6 @@
   )

 ;; TODO when testing a failure case we can delete the virtual collection. This would make the granule fail ingest.
-
-;; TODO add test where source granule is cleaned up by delete time.
-;; Add a separate test with multiple source granules
-
-;; TODO Is there any other way a granule will be deleted?
-;; - parent collection is deleted
-;; TODO document these decisions and any others in the README
-

 (deftest specific-granule-in-virtual-product-test
   (let [ast-coll (d/ingest "LPDAAC_ECS"


prepare dynamic reporter

prepare dynamic reporter

--- trackit-core/src/samsara/trackit/reporter.clj
+++ trackit-core/src/samsara/trackit/reporter.clj
@@ -1,15 +1,8 @@
 (ns samsara.trackit.reporter
   (:import  [java.util.concurrent TimeUnit]
             [com.codahale.metrics MetricFilter])
-  (:require [metrics.reporters.graphite :as graphite]
-            [metrics.reporters.console :as console]
-            #_[metrics.reporters.ganglia :as ganglia])
-  (:import  [com.codahale.metrics.ganglia GangliaReporter]
-            [info.ganglia.gmetric4j.gmetric GMetric GMetric$UDPAddressingMode])
-  (:import  [com.codahale.metrics.riemann RiemannReporter Riemann]
-            [com.aphyr.riemann.client RiemannClient TcpTransport])
+  (:require [metrics.reporters.console :as console]))

-  #_(:import  [com.bealetech.metrics.reporting StatsdReporter Statsd]))

 (defmulti start-reporting (fn [registry cfg] (:type cfg)))

@@ -37,9 +30,7 @@
     :or  {reporting-frequency-seconds 10, host "localhost", port 2003, prefix "trackit"
           rate-unit TimeUnit/SECONDS, duration-unit TimeUnit/MILLISECONDS} :as cfg}]

-  (graphite/start
-   (graphite/reporter registry cfg)
-   reporting-frequency-seconds))
+)

 (comment
   (defmethod start-reporting :statsd
@@ -48,49 +39,23 @@
       :or  {reporting-frequency-seconds 10, host "localhost", port 8125, prefix "trackit"
             rate-unit TimeUnit/SECONDS, duration-unit TimeUnit/MILLISECONDS} :as cfg}]

-    (-> (StatsdReporter/forRegistry registry)
-        (.prefixedWith prefix)
-        (.convertDurationsTo duration-unit)
-        (.convertRatesTo rate-unit)
-        (.filter MetricFilter/ALL)
-        (.build (Statsd. host port))
-        (.start reporting-frequency-seconds TimeUnit/SECONDS))))
-
+))

 (defmethod start-reporting :riemann
-    [registry
-     {:keys [reporting-frequency-seconds host port prefix rate-unit duration-unit]
-      :or  {reporting-frequency-seconds 10, host "localhost", port 5555, prefix "trackit"
-            rate-unit TimeUnit/SECONDS, duration-unit TimeUnit/MILLISECONDS} :as cfg}]
+  [registry
+   {:keys [reporting-frequency-seconds host port prefix rate-unit duration-unit]
+    :or  {reporting-frequency-seconds 10, host "localhost", port 5555, prefix "trackit"
+          rate-unit TimeUnit/SECONDS, duration-unit TimeUnit/MILLISECONDS} :as cfg}]

-  (let [;; tell Riemann client to do not cache the dns name
-        rc (Riemann.
-            (RiemannClient.
-             (doto
-                 (TcpTransport. host (int port))
-               (-> .-cacheDns (.set false)))))]
-    (-> (RiemannReporter/forRegistry registry)
-        (.prefixedWith prefix)
-        (.convertDurationsTo duration-unit)
-        (.convertRatesTo rate-unit)
-        (.useSeparator ".")
-        (.filter MetricFilter/ALL)
-        (.build rc)
-        (.start reporting-frequency-seconds TimeUnit/SECONDS))))
+)

 (defmethod start-reporting :ganglia
   [registry
    {:keys [reporting-frequency-seconds host port prefix rate-unit duration-unit]
-      :or  {reporting-frequency-seconds 60, host "localhost", port 8649, prefix "trackit"
-            rate-unit TimeUnit/SECONDS, duration-unit TimeUnit/MILLISECONDS} :as cfg}]
+    :or  {reporting-frequency-seconds 60, host "localhost", port 8649, prefix "trackit"
+          rate-unit TimeUnit/SECONDS, duration-unit TimeUnit/MILLISECONDS} :as cfg}]

-    (-> (GangliaReporter/forRegistry registry)
-        (.prefixedWith prefix)
-        (.convertDurationsTo duration-unit)
-        (.convertRatesTo rate-unit)
-        (.filter MetricFilter/ALL)
-        (.build (GMetric. host (int port) GMetric$UDPAddressingMode/MULTICAST 1))
-        (.start reporting-frequency-seconds TimeUnit/SECONDS)))
+)