JC | #27 | extract reset-password function in reset password POST, to make it a bit easier to read

--- src/stonecutter/controller/forgotten_password.clj
+++ src/stonecutter/controller/forgotten_password.clj
@@ -65,6 +65,13 @@
           (do (cl-store/revoke! forgotten-password-store forgotten-password-id) nil))
         (redirect-to-forgotten-password-form)))))

+(defn reset-password [forgotten-password-store user-store token-store email-address forgotten-password-id new-password]
+  (let [updated-user (user/change-password! user-store email-address new-password)]
+    (cl-store/revoke! forgotten-password-store forgotten-password-id)
+    (-> (response/redirect (r/path :show-profile))
+        (common/sign-in-user token-store updated-user)
+        (assoc :flash :password-changed))))
+
 (defn reset-password-form-post [forgotten-password-store user-store token-store clock request]
   (let [params (:params request)
         err (v/validate-reset-password params)
@@ -75,11 +82,7 @@
       (let [email-address (:login forgotten-password-record)]
         (if (user/retrieve-user user-store email-address)
           (if (empty? err)
-            (let [updated-user (user/change-password! user-store email-address new-password)]
-              (cl-store/revoke! forgotten-password-store forgotten-password-id)
-              (-> (response/redirect (r/path :show-profile))
-                  (common/sign-in-user token-store updated-user)
-                  (assoc :flash :password-changed)))
+            (reset-password forgotten-password-store user-store token-store email-address forgotten-password-id new-password)
             (show-reset-password-form forgotten-password-store user-store clock request-with-validation-errors))
           (do (cl-store/revoke! forgotten-password-store forgotten-password-id) nil)))
-      (redirect-to-forgotten-password-form))))
+      (redirect-to-forgotten-password-form))))


compute-coordinates as in paper

compute-coordinates as in paper

--- src/main/clojure/conexp/layouts/dim_draw.clj
+++ src/main/clojure/conexp/layouts/dim_draw.clj
@@ -88,27 +88,41 @@
   where e is the element, and x and y are the corresponding coordinates.

   See paper of Dominik (2019)"                              ;todo paper name
-  [P <=]
-  (let [<=as-set (map edge->vec (lg/edges (make-digraph-from-condition P <=)))
-        <=C
-        (let [<=C' (atom (compute-conjugate-order P <=))]
-          (println "<=C': " @<=C')
-          (while (= @<=C' nil)
-            (swap! <=C'
-                   (fn [<=C''] (let [I (incompatibility-graph P <=) ; the loop cannot terminate as "<=C'" depends on constant parameters
-                         C (sat-reduction I)
-                         C-bar-graph (transitive-closure (apply uber/digraph C))]
-                     (uber/pprint I)
-                     (println C-bar-graph)
-                     (compute-conjugate-order P #(or (<= %1 %2) (lg/has-edge? C-bar-graph %1 %2)))))))
-          @<=C')
-        <=1 (union <=as-set <=C)
-        <=2 (union <=as-set (map reverse <=C))
-        elements-less (fn [le elem] (- (count (filter #(some #{[% elem]} le) P)) 1))
-        coords (map #(let
-                       [x1 (elements-less <=1 %) x2 (elements-less <=2 %)]
-                       [% [x1 x2]]) P)]
-    coords))
+  ([graph]
+   (compute-coordinates (lg/nodes graph) #(lg/has-edge? graph %1 %2)))
+  ([P <=]
+   (let [<=as-set (map edge->vec (lg/edges (make-digraph-from-condition P <=)))
+         <=C (let [<=CAtom (atom (compute-conjugate-order P <=))
+                   CAtom (atom ())]
+               (println "<=CAtom: " @<=CAtom)
+               (while (= @<=CAtom nil)
+                 (swap! CAtom
+                        (fn [C] (let [I (incompatibility-graph (transitive-edge-union P <= C))]
+                                  (println "(transitive-edge-union P <= C):")
+                                  (uber/pprint (transitive-edge-union P <= C))
+                                  (println "I:")
+                                  (uber/pprint I)
+                                  (println C (sat-reduction I))
+                                  (union C (sat-reduction I)))))
+                 (let [C @CAtom
+                       C-bar-graph (transitive-closure (apply uber/digraph C))
+                       ;<=CNew (compute-conjugate-order P #(or (<= %1 %2) (lg/has-edge? C-bar-graph %2 %1)))] ;why \bar C? why not union?
+                       ;<=CNew (compute-conjugate-order (transitive-edge-union P <= #(lg/has-edge? C-bar-graph %1 %2)))]
+                       <=CNew (compute-conjugate-order (transitive-edge-union P <= #(lg/has-edge? C-bar-graph %2 %1)))]
+                   (println "C: " C)
+                   (println "C-bar-graph:")
+                   (uber/pprint C-bar-graph)
+                   (println "<=CNew: " <=CNew)
+                   (reset! <=CAtom
+                           <=CNew)))
+               @<=CAtom)
+         <=1 (map edge->vec (lg/edges (transitive-edge-union P <= <=C)))
+         <=2 (map edge->vec (lg/edges (transitive-edge-union P <= (map reverse <=C))))
+         elements-less (fn [le elem] (- (count (filter #(some #{[% elem]} le) P)) 1))
+         coords (map #(let
+                        [x1 (elements-less <=1 %) x2 (elements-less <=2 %)]
+                        [% [x1 x2]]) P)]
+     coords)))

 ;(println (compute-conjugate-order
 ;           #{1 2 3 4 5} (non-strict #(or (= 1 %1) (= 5 %2)))))


Parametrise mongodb connection

Parametrise mongodb connection

--- src/eventstore/mongo.clj
+++ src/eventstore/mongo.clj
@@ -4,6 +4,9 @@
             [somnium.congomongo :as m]))

 (def page-size 100)
+
+(defn mongo-conn []
+  (m/make-connection "eventstore" :host 10.90.228.88))

 (defrecord LocalMongoDB [db collection]
   db/DB
@@ -47,18 +50,18 @@

 (defn m-mongo
   ([collection]
-   (->LocalMongoDB (m/make-connection "eventstore") collection))
+   (->LocalMongoDB (mongo-conn) collection))
   ([]
    (m-mongo :events)))

 (def mongo (memoize m-mongo))

-#_(m/with-mongo (m/make-connection "eventstore")
+#_(m/with-mongo (mongo-conn)
   (let [everything (m/fetch :events :where {})]
     (dorun (map #(m/insert! :new-events {:stream-name "cambio"
                                          :server_timestamp (:server_timestamp %)
                                          :payload %}) everything))))

-(m/with-mongo (m/make-connection "eventstore")
+(m/with-mongo (mongo-conn)
   (m/distinct-values :events "stream-name"))


Perform all db maintenance tasks serially

These were being managed individually, since they are logically
distinct, but they require coordinated access to a shared resource (the
db). It's simpler to just run them serially, so we now have a
`perform-db-maintenance!` function, which simply accepts a set of
functions and applies them to the database. This keeps the functions
still primarily distinct, but also runs them the way they need to be
run.

Also reordered the arguments to the db maintenance tasks, since it makes
more sense to partially apply them with a given interval to get a new
maintenance task than to partially apply them with a database.

--- src/com/puppetlabs/puppetdb/cli/services.clj
+++ src/com/puppetlabs/puppetdb/cli/services.clj
@@ -97,7 +97,7 @@
 (defn auto-deactivate-nodes!
   "Deactivate nodes which haven't had any activity (catalog/fact submission)
   for more than `node-ttl`."
-  [db node-ttl]
+  [node-ttl db]
   {:pre [(map? db)
          (period? node-ttl)]}
   (try
@@ -112,7 +112,7 @@

 (defn purge-nodes!
   "Delete nodes which have been *deactivated* longer than `node-purge-ttl`."
-  [db node-purge-ttl]
+  [node-purge-ttl db]
   {:pre [(map? db)
          (period? node-purge-ttl)]}
   (try
@@ -126,7 +126,7 @@

 (defn sweep-reports!
   "Delete reports which are older than than `report-ttl`."
-  [db report-ttl]
+  [report-ttl db]
   {:pre [(map? db)
          (period? report-ttl)]}
   (try
@@ -162,6 +162,16 @@
         (scf-store/garbage-collect!)))
     (catch Exception e
       (log/error e "Error during garbage collection"))))
+
+(defn perform-db-maintenance!
+  "Runs the full set of database maintenance tasks in `fns` on `db` in order.
+  Has no error-handling of its own, so all `fns` must handle their own errors.
+  The purpose of this function is primarily to serialize these tasks, to avoid
+  concurrent long-running database tasks."
+  [db & fns]
+  {:pre [(map? db)]}
+  (doseq [f fns]
+    (f db)))

 (defn check-for-updates
   "This will fetch the latest version number of PuppetDB and log if the system
@@ -411,22 +421,17 @@

       ;; Pretty much this helper just knows our job-pool and gc-interval
       (let [gc-interval-millis (to-millis gc-interval)
-            gc-task (fn [f & args] (apply interspaced gc-interval-millis f job-pool args))]
-
-        (gc-task #(garbage-collect! db))
-
-        (when (pos? (to-secs dlo-compression-threshold))
-          (gc-task #(compress-dlo! discard-dir dlo-compression-threshold)))
-
-        ;; We splay these a bit to hopefully reduce DB contention.
-        (when (pos? (to-secs node-ttl))
-          (gc-task #(auto-deactivate-nodes! db node-ttl) :initial-delay (* gc-interval-millis 1/4)))
-
-        (when (pos? (to-secs node-purge-ttl))
-          (gc-task #(purge-nodes! db node-purge-ttl) :initial-delay (* gc-interval-millis 2/4)))
-
-        (when (pos? (to-secs report-ttl))
-          (gc-task #(sweep-reports! db report-ttl) :initial-delay (* gc-interval-millis 3/4))))
+            gc-task (fn [f] (apply interspaced gc-interval-millis f job-pool))
+            db-maintenance-tasks [garbage-collect!
+                                  (when (pos? (to-secs node-ttl))
+                                    (partial auto-deactivate-nodes! node-ttl))
+                                  (when (pos? (to-secs node-purge-ttl))
+                                    (partial purge-nodes! node-purge-ttl))
+                                  (when (pos? (to-secs report-ttl))
+                                    (partial sweep-reports! report-ttl))]]
+
+        (gc-task #(apply perform-db-maintenance! db (remove nil? db-maintenance-tasks)))
+        (gc-task #(compress-dlo! dlo-compression-threshold discard-dir )))

       ;; Start debug REPL if necessary
       (let [{:keys [enabled type host port] :or {type "nrepl" host "localhost"}} (:repl config)]


Re-enable connection pooling

Re-enable connection pooling

--- src/engulf/ning_client.clj
+++ src/engulf/ning_client.clj
@@ -46,7 +46,7 @@
      {:max-conns-per-host 4
       :timeout 90000
       :executor-service (Executors/newFixedThreadPool 1)
-      :connection-pooling false})
+      :connection-pooling true})

 (defn create-client
   (^AsyncHttpClient


wip: type system - enum types

wip: type system - enum types

--- src/graphql_clj/type.clj
+++ src/graphql_clj/type.clj
@@ -149,14 +149,14 @@
         type-fields (:type-fields definition)
         fields (create-type-system-fields type-fields)]
     [name {:name name
-           :kind :OBJECT
+           :kind :INPUT_OBJECT
            :fields fields}]))

 (defn create-type-system-union [definition]
   (let [name (:name definition)
         fields (:type-fields definition)]
     [name {:name name
-           :kind :OBJECT
+           :kind :UNION
            :fields fields}]))

 (defn create-type-system-interface [definition]
@@ -164,8 +164,16 @@
         type-fields (:type-fields definition)
         fields (create-type-system-fields type-fields)]
     [name {:name name
-           :kind :OBJECT
+           :kind :INTERFACE
            :fields fields}]))
+
+(defn create-type-system-enum [definition]
+  (let [name (:name definition)
+        enum-fields (:enum-fields definition)
+        fields (create-type-system-fields enum-fields)]
+    [name {:name name
+           :kind :ENUM
+           :fields (create-type-system-fields enum-fields)}]))

 (defn create-type-system-definition [definition]
   (let [type (:type-system-type definition)]
@@ -173,7 +181,8 @@
       :type  (create-type-system-type definition)
       :input (create-type-system-input definition)
       :union  (create-type-system-union definition)
-      :interface (create-type-system-interface definition))))
+      :interface (create-type-system-interface definition)
+      :enum (create-type-system-enum definition))))

 (defn type-system-type-definitions
   [type]
@@ -187,12 +196,14 @@
         types ((type-system-type-definitions :type) definitions)
         interfaces ((type-system-type-definitions :interface) definitions)
         unions ((type-system-type-definitions :union) definitions)
-        inputs ((type-system-type-definitions :input) definitions)]
+        inputs ((type-system-type-definitions :input) definitions)
+        enums ((type-system-type-definitions :enum) definitions)]
     (println types)
     {:types (into {} types)
      :interfaces (into {} interfaces)
      :unions (into {} unions)
-     :inputs (into {} inputs)}))
+     :inputs (into {} inputs)
+     :enums (into {} enums)}))


format code

format code

--- src/graphql_clj/type.clj
+++ src/graphql_clj/type.clj
@@ -55,20 +55,20 @@

 (def ^{:private true} system-schema
   {:GraphQLString {:name "String"
-                    :kind :SCALAR}
-    :TypeType {:name "Type"
-               :kind :OBJECT
-               :fields {:name {:type :GraphQLString}}}
-    :TypeListType {:name "TypeList"
-                   :kind :LIST
-                   :innerType :TypeType
-                   :resolve-fn (fn [& args]
-                                 (println "TOBEUPDATED"))}
-    :SchemaType {:name "Schema"
-                 :kind :OBJECT
-                 :fields {:types {:type :TypeListType}}
-                 :args {}
-                 :resolve-fn identity}})
+                   :kind :SCALAR}
+   :TypeType {:name "Type"
+              :kind :OBJECT
+              :fields {:name {:type :GraphQLString}}}
+   :TypeListType {:name "TypeList"
+                  :kind :LIST
+                  :innerType :TypeType
+                  :resolve-fn (fn [& args]
+                                (println "TOBEUPDATED"))}
+   :SchemaType {:name "Schema"
+                :kind :OBJECT
+                :fields {:types {:type :TypeListType}}
+                :args {}
+                :resolve-fn identity}})

 (defn create-type-meta-fn [schema]
   (let [updated-schema (update-in schema [:query :fields]


Replace help url and failed media upload error message with the ones from constants file

--- src/hatti/ona/forms.cljs
+++ src/hatti/ona/forms.cljs
@@ -1,8 +1,6 @@
 (ns hatti.ona.forms
   (:require [chimera.js-interop :refer [format]]
             [chimera.urls :refer [last-url-param]]
-            [ona.utils.urls :as urls]
-            [ona.utils.i18n :refer [translate]]
             [chimera.date :as chimera-date]
             [cljs.pprint :refer [cl-format]]
             [clojure.string :as string]
@@ -10,7 +8,10 @@
                                      _submitted_by
                                      _last_edited
                                      _id
-                                     _media_all_received]]))
+                                     _media_all_received
+                                     help-base-url
+                                     failed-media-upload-help-url
+                                     failed-media-upload-error-message]]))

 ;; CONSTANTS
 (def currency-regex #"£|$")
@@ -40,7 +41,7 @@
 (def media_received_field {:name      _media_all_received
                            :full-name _media_all_received
                            :label     "All media received?"
-                           :type      "boolean"})
+                           :type      "text"})

 (def extra-submission-details [last_edited
                                submission-time-field
@@ -224,17 +225,17 @@

 (defn media-files-upload-error-component
   "Displays tip question and tooltip msg for failed media files uploads"
-  [answer & {:keys [hlp-url translation-txt record-modal?]}]
+  [answer & {:keys [help-url error-message record-modal?]}]
   (if record-modal?
     [:span.image-name answer
-     [:a.tooltip {:href hlp-url :target "_blank"}
-      [:span.tip-info translation-txt]
+     [:a.tooltip {:href help-url :target "_blank"}
+      [:span.tip-info error-message]
       [:span.tip-question "?"]]]
     (format " %s

           %s
           ?"
-            answer hlp-url translation-txt)))
+            answer help-url error-message)))

 (defn format-answer
   "String representation for a particular field datapoint (answer).
@@ -264,21 +265,16 @@
     (or (image? field)
         (video? field)) (let [image (:download_url answer)
                               thumb (or (:small_download_url answer) image)
-                              media-upload-fail-hlp-url
-                              urls/media-upload-fail-during-submission-help
-                              media-upload-fail-translation-txt
-                              (translate
-                               :table-data-view-page/media-upload-fail-err-msg)
                               fname (last-url-param (:filename answer))]
                           (cond
                             (and (string? answer)
                                  (not= answer "null") (nil? thumb))
                             (media-files-upload-error-component
                              answer
-                             :hlp-url
-                             media-upload-fail-hlp-url
-                             :translation-txt
-                             media-upload-fail-translation-txt
+                             :help-url
+                             (help-base-url failed-media-upload-help-url)
+                             :error-message
+                             failed-media-upload-error-message
                              :record-modal?
                              record-modal?)
                             (= answer "null") answer


Add configure! and :auth-query configuration option for defentity

--- src/main/workflo/macros/entity.clj
+++ src/main/workflo/macros/entity.clj
@@ -3,6 +3,29 @@
             [clojure.string :as string]
             [workflo.macros.command.util :as util]
             [workflo.macros.specs.entity]))
+
+;;;; Configuration
+
+(defonce ^:private +configuration+
+  (atom {:auth-query nil}))
+
+(defn configure!
+  "Configures how entities are created with defentity and how aspects
+   like authorization are performed against them. Supports the
+   following options:
+
+   :auth-query - a function that takes a parsed query and entity data;
+                 this query result from this function is then passed to
+                 the entity's auth function to perform authorization."
+  [{:keys [auth-query] :as options}]
+  (swap! +configuration+ assoc
+         :auth-query auth-query))
+
+(defn get-config
+  "Returns the configuration for a given configuration key, e.g.
+   :auth-query."
+  [key]
+  (@+configuration+ key))

 ;;;; Entity registry


include cljs.reader in hello sample for Closure Module testing purposes

--- samples/hello/src/hello/core.cljs
+++ samples/hello/src/hello/core.cljs
@@ -1,5 +1,6 @@
 (ns hello.core
-  (:require [hello.foo.bar :as bar]))
+  (:require [hello.foo.bar :as bar]
+            [cljs.reader :as reader]))

 (defn ^{:export greet} greet [n]
   (str "Hello " n))


Testutils for reports should munge resource events to a set

The order of the resource events returned by an event query
does not guarantee order; thus, we need to munge the results
into a set before we do comparisons in tests.

--- test/com/puppetlabs/puppetdb/testutils/report.clj
+++ test/com/puppetlabs/puppetdb/testutils/report.clj
@@ -14,12 +14,12 @@
   "Munges event objects in a way that is suitable for equality comparisons in tests"
   [events]
   {:pre  [(vector? events)]
-   :post [(vector? %)]}
-  (mapv
-    #(-> %
-      (update-in ["timestamp"] time-coerce/to-string)
-      (dissoc "report"))
-    events))
+   :post [(set? %)]}
+  (set (map
+      #(-> %
+        (update-in ["timestamp"] time-coerce/to-string)
+        (dissoc "report"))
+      events)))

 (defn munge-report-for-comparison
   "Given a report object (represented as a map, either having come out of a
@@ -30,7 +30,8 @@
   JSON doesn't have a data type for)."
   [report]
   {:pre  [(map? report)]
-   :post [(map? %)]}
+   :post [(map? %)
+          (set? (% "resource-events"))]}
   (-> report
     (clojure.walk/stringify-keys)
     (update-in ["start-time"] time-coerce/to-string)


marking a lot of fns private. Converting some private fns to locally letted fns.I'm experimenting with code clarity ideas: a.k.a. I think it makes the intent of the code clearer if the structure of the file isn't so flat.

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

 (ns midje.internal-ideas.fakes
-  (:use
-    [utilize.seq :only (separate)]
-    [midje.util.object-utils :only [object-name]]
-    [clojure.test :only [report]]
-    [midje.checkers :only [exactly]]
-    [midje.checkers.defining :only [checker? checker-makers]]
-    [midje.internal-ideas.expect :only [expect? up-to-full-expect-form]]
-    [midje.util.form-utils :only [first-named?
-                                  translate-zipper
-                                  map-difference
-                                  hash-map-duplicates-ok]]
-    [midje.ideas.metaconstants :only [metaconstant-for-form
-                                      with-fresh-generated-metaconstant-names]]
-    [midje.checkers.extended-equality :only [extended-= extended-list-= extended-fn?]]
-    [midje.internal-ideas.file-position :only [user-file-position]]
-    [midje.util.thread-safe-var-nesting :only [namespace-values-inside-out
-                                               with-pushed-namespace-values
-                                               with-altered-roots]]
-    [midje.util.exceptions :only [user-error]]
-    [midje.internal-ideas.wrapping :only [with-wrapping-target]]
-    [midje.ideas.arrow-symbols])
+  (:use [utilize.seq :only (separate)]
+        [midje.util.object-utils :only [object-name]]
+        [clojure.test :only [report]]
+        [midje.checkers :only [exactly]]
+        [midje.checkers.defining :only [checker? checker-makers]]
+        [midje.internal-ideas.expect :only [expect? up-to-full-expect-form]]
+        [midje.util.form-utils :only [first-named?
+                                      translate-zipper
+                                      map-difference
+                                      hash-map-duplicates-ok]]
+        [midje.ideas.metaconstants :only [metaconstant-for-form
+                                          with-fresh-generated-metaconstant-names]]
+        [midje.checkers.extended-equality :only [extended-= extended-list-= extended-fn?]]
+        [midje.internal-ideas.file-position :only [user-file-position]]
+        [midje.util.thread-safe-var-nesting :only [namespace-values-inside-out
+                                                   with-pushed-namespace-values
+                                                   with-altered-roots]]
+        [midje.util.exceptions :only [user-error]]
+        [midje.internal-ideas.wrapping :only [with-wrapping-target]]
+        [midje.ideas.arrow-symbols])
   (:require [clojure.zip :as zip])
   (:import midje.ideas.metaconstants.Metaconstant))

- ;;; Questions to ask of fakes // accessors

 (defn implements-a-fake? [function]
   (:midje/faked-function (meta function)))

-(defn function-fake? [form]
+(defn- function-fake? [form]
   (first-named? form "fake"))

-(defn data-fake? [form]
+(defn- data-fake? [form]
   (first-named? form "data-fake"))

 (defn fake? [form]
   (or (function-fake? form)
-      (data-fake? form)))
-
-(defn fake-form-funcall [[fake funcall => value & overrides]]
+    (data-fake? form)))
+
+(defn- fake-form-funcall [[fake funcall => value & overrides]]
   funcall)

-(defn fake-form-funcall-arglist [fake-form]
+(defn- fake-form-funcall-arglist [fake-form]
   (rest (fake-form-funcall fake-form)))

- ;;; Creation

-(defn common-to-all-fakes [var-sym]
+(defn- common-to-all-fakes [var-sym]
   `{:lhs (var ~var-sym)
     :count-atom (atom 0)
     :position (user-file-position)})

-(defn make-fake-map
+(defn make-fake-map
   [var-sym special-to-fake-type user-override-pairs]
   (merge
-   (common-to-all-fakes var-sym)
-   special-to-fake-type
-   (apply hash-map-duplicates-ok user-override-pairs)))
-
-(defn arg-matcher-maker
+    (common-to-all-fakes var-sym)
+    special-to-fake-type
+    (apply hash-map-duplicates-ok user-override-pairs)))
+
+(defn arg-matcher-maker
   "Based on an expected value, generates a function that returns true if the
-   actual value matches it."
+actual value matches it."
   [expected]
   (if (and (extended-fn? expected)
-           (not (checker? expected)))
+        (not (checker? expected)))
     (fn [actual] (extended-= actual (exactly expected)))
     (fn [actual] (extended-= actual expected))))

-(defmulti make-result-supplier (fn [arrow & _]  arrow))
+(defmulti make-result-supplier (fn [arrow & _] arrow))

 (defmethod make-result-supplier => [arrow result] #(identity result))

 (defmethod make-result-supplier =streams=> [arrow result-stream]
-           (let [current-stream (atom result-stream)]
-             #(let [current-result (first @current-stream)]
-                (swap! current-stream rest)
-                current-result)))
+  (let [current-stream (atom result-stream)]
+    #(let [current-result (first @current-stream)]
+       (swap! current-stream rest)
+       current-result)))

 (defmethod make-result-supplier :default [arrow result-stream]
   (throw (user-error (str "It's likely you misparenthesized your metaconstant prerequisite."))))

-(defn fake* [ [[var-sym & args :as call-form] arrow result & overrides] ]
+(defn fake* [[[var-sym & args :as call-form] arrow result & overrides]]
   ;; The (vec args) keeps something like (...o...) from being
   ;; evaluated as a function call later on. Right approach would
   ;; seem to be '~args. That causes spurious failures. Debug
   ;; someday.
   (make-fake-map var-sym
-                 `{:arg-matchers (map midje.internal-ideas.fakes/arg-matcher-maker ~(vec args))
-                   :call-text-for-failures (str '~call-form)
-                   :value-at-time-of-faking (if (bound? (var ~var-sym)) ~var-sym)
-                   :result-supplier (make-result-supplier ~arrow ~result)
-                   :type :fake}
-                 overrides))
-
-(defn data-fake* [ [metaconstant arrow contained & overrides] ]
+    `{:arg-matchers (map midje.internal-ideas.fakes/arg-matcher-maker ~(vec args))
+      :call-text-for-failures (str '~call-form)
+      :value-at-time-of-faking (if (bound? (var ~var-sym)) ~var-sym)
+      :result-supplier (make-result-supplier ~arrow ~result)
+      :type :fake}
+    overrides))
+
+(defn data-fake* [[metaconstant arrow contained & overrides]]
   (make-fake-map metaconstant
-                 `{:contained ~contained
-                  :count-atom (atom 1)  ;; CLUDKJE!
-                  :type :fake
-                  :data-fake :data-fake}
-                 overrides))
+    `{:contained ~contained
+      :count-atom (atom 1) ;; CLUDKJE!
+      :type :fake
+      :data-fake :data-fake}
+    overrides))

 (defn tag-as-background-fake [fake]
-  (concat fake
-          '(:background :background)
-          '(:times (range 0))))
-
-+  (concat fake `(:background :background :times (~'range 0))))
+
 ;;; Binding

-(defn var-handled-by-fake? [function-var fake]
-  (= function-var (fake :lhs)))
-
-(defn- fakes-for-var [fakes function-var]
-  (filter (partial var-handled-by-fake? function-var) fakes))
-
-(defmulti call-handled-by-fake? (fn [function-var actual-args fake] (:type fake)))
-
-(defmethod call-handled-by-fake? :not-called
-  [function-var actual-args fake]
+(defn- var-handled-by-fake? [function-var fake]
+  (= function-var (fake :lhs )))
+
+(defmulti ^{:private true} call-handled-by-fake? (fn [function-var actual-args fake] (:type fake)))
+
+(defmethod ^{:private true} call-handled-by-fake? :not-called [function-var actual-args fake]
   (var-handled-by-fake? function-var fake))

-(defmethod call-handled-by-fake? :default
-  [function-var actual-args fake]
+(defmethod ^{:private true} call-handled-by-fake? :default [function-var actual-args fake]
   (and (var-handled-by-fake? function-var fake)
-       (= (count actual-args) (count (fake :arg-matchers)))
-       (extended-list-= actual-args (fake :arg-matchers))))
-
-(defn fakes-for-call [fakes function-var actual-args]
+    (= (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]
@@ -142,79 +131,77 @@
           stashed-value (var-get function-var)
           unfinished-fun (:midje/unfinished-fun (meta function-var))]
       (cond (not (extended-fn? stashed-value))
-            false
-
-            (nil? unfinished-fun)
-            true
-
-            :else
-            (not= unfinished-fun stashed-value)))))
-
-
-(def ^{:dynamic true} *call-action-count* (atom 0))
-(defmacro counting-nested-calls-calls [& forms]
+        false
+
+        (nil? unfinished-fun)
+        true
+
+        :else (not= unfinished-fun stashed-value)))))
+
+
+(def ^{:dynamic true :private true} *call-action-count* (atom 0))
+(defmacro ^{:private true} counting-nested-calls-calls [& forms]
   `(try
-     (swap! *call-action-count* inc)
+     (swap! *call-action-count* inc)
      ~@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*)
     (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 "
-                            (or (:name (meta function-var)) function-var) ", then")
-                       "describe that function in a provided clause. For example, instead of this:"
-                       "  (provided (every? even? ..xs..) => true)"
-                       "do this:"
-                       "  (def all-even? (partial every? even?))"
-                       "  ;; ..."
-                       "  (provided (all-even? ..xs..) => true)")))
+             (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 "
+               (or (:name (meta function-var)) function-var) ", then")
+             "describe that function in a provided clause. For example, instead of this:"
+             "  (provided (every? even? ..xs..) => true)"
+             "do this:"
+             "  (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)))))
+      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)))))

 (defn call-faker [function-var actual-args fakes]
   "This is the function that handles all mocked calls."
   (let [action (counting-nested-calls-calls (best-call-action function-var actual-args fakes))]
     (cond (nil? action)
-          (clojure.test/report {:type :mock-argument-match-failure
-                                :lhs function-var
-                                :actual actual-args
-                                :position (:position (first fakes))})
-
-          (extended-fn? action)
-          (apply action actual-args)
-
-          :else
-          (do
-            (swap! (action :count-atom) inc)
-            ((action :result-supplier))))))
+      (clojure.test/report {:type :mock-argument-match-failure
+                            :lhs function-var
+                            :actual actual-args
+                            :position (:position (first fakes))})
+
+      (extended-fn? action)
+      (apply action actual-args)
+
+      :else (do
+              (swap! (action :count-atom ) inc)
+              ((action :result-supplier ))))))

 (defn unique-vars [fakes]
   (distinct (map :lhs fakes)))

-(defn binding-map-with-function-fakes [fakes]
+(defn- binding-map-with-function-fakes [fakes]
   (letfn [(fn-that-implements-a-fake [function]
             (vary-meta function assoc :midje/faked-function true))
           (make-faker [var]
             (fn-that-implements-a-fake (fn [& actual-args] (call-faker var actual-args fakes))))]
     (into {}
       (for [var (unique-vars fakes)]
-        {var (make-faker var)}))))
+        [var (make-faker var)]))))

 (defn data-fakes-to-metaconstant-bindings [fakes]
   (for [{var :lhs, contents :contained} fakes]
@@ -223,58 +210,54 @@
 (defn merge-metaconstant-bindings [bindings]
   (apply merge-with (fn [v1 v2]
                       (Metaconstant. (.name v1) (merge (.storage v1) (.storage v2))))
-         bindings))
-
-(defn- binding-map-with-data-fakes [fakes]
-  (merge-metaconstant-bindings (data-fakes-to-metaconstant-bindings fakes)))
+    bindings))
+
+(defn- binding-map-with-data-fakes [data-fakes]
+  (merge-metaconstant-bindings (data-fakes-to-metaconstant-bindings data-fakes)))

 (defn binding-map [fakes]
   (let [[data-fakes function-fakes] (separate :data-fake fakes)]
     (merge (binding-map-with-function-fakes function-fakes)
-           (binding-map-with-data-fakes data-fakes))))
+      (binding-map-with-data-fakes data-fakes))))

 (defmacro with-installed-fakes [fakes & forms]
   `(with-altered-roots (binding-map ~fakes) ~@forms))

- ;;; Checking

 (defn fake-count [fake] (deref (:count-atom fake)))

-(defmulti call-count-incorrect? :type)
-
-(defmethod call-count-incorrect? :fake
-  [fake]
-  (let [method (or (:times fake) :default)
+(defmulti call-count-incorrect? :type )
+
+(defmethod call-count-incorrect? :fake [fake]
+  (let [method (or (:times fake) :default )
         count (fake-count fake)]
-    (cond (= method :default)
-          (zero? count)
-
-          (number? method)
-          (not= method count)
-
-          (coll? method)
-          (not (some #{count} method))
-
-          (fn? method)
-          (not (method count)))))
-
-(defmethod call-count-incorrect? :not-called
-  [fake]
+    (cond (= method :defaul t )
+      (zero? count)
+
+      (number? method)
+      (not= method count)
+
+      (coll? method)
+      (not (some #{count} method))
+
+      (fn? method)
+      (not (method count)))))
+
+(defmethod call-count-incorrect? :not-called [fake]
   (not (zero? (fake-count fake))))

 (defn check-call-counts [fakes]
   (doseq [fake fakes]
     (when (call-count-incorrect? fake)
       (report {:type :mock-incorrect-call-count
-               :actual-count @(fake :count-atom)
-               :expected-call (fake :call-text-for-failures)
+               :actual-count @(fake :count-atom )
+               :expected-call (fake :call-text-for-failures )
                :position (:position fake)
-               :expected (fake :call-text-for-failures)}))))
-
-
-
-+               :expected (fake :call-text-for-failures )}))))
+
+
+
 ;; Folded prerequisites

 ;; Note that folded prerequisites are in semi-sweet-style. (That is, they can only
@@ -285,33 +268,27 @@
 ;; mapping. These substitutions are used both to "flatten" a fake form and also
 ;; to generate new fakes.

-(def special-forms '[quote fn let new])
-
-(defn- constructor? [symbol]
-  (.endsWith (name symbol) "."))
-
-(defn- mockable-function-symbol? [symbol]
-  (not (or (some #{symbol} special-forms)
-           (some #{symbol} checker-makers)
-           (constructor? symbol)
-           (checker? (resolve symbol)))))
-
-
-
 (defn mockable-funcall? [thing]
-  (and (list? thing)
-       (mockable-function-symbol? (first thing))))
-
+  (let [constructor? (fn [symbol]
+                       (.endsWith (name symbol) "."))
+        special-forms '[quote fn let new]
+        mockable-function-symbol? (fn [symbol]
+                                    (not (or (some #{symbol} special-forms)
+                                           (some #{symbol} checker-makers)
+                                           (constructor? symbol)
+                                           (checker? (resolve symbol)))))]
+    (and (list? thing)
+      (mockable-function-symbol? (first thing)))))

 (defn folded-fake? [form]
   (and (sequential? form)
-       (= 'midje.semi-sweet/fake (first form))
-       ;; We now know this: (fake (f ...arg... ...arg...) ...)
-       (some mockable-funcall? (fake-form-funcall-arglist form))))
+    (= 'midje.semi-sweet/fake (first form))
+    ;; We now know this: (fake (f ...arg... ...arg...) ...)
+    (some mockable-funcall? (fake-form-funcall-arglist form))))

 (defn augment-substitutions [substitutions fake-form]
   (let [needed-keys (filter mockable-funcall?
-                            (fake-form-funcall-arglist fake-form))]
+    (fake-form-funcall-arglist fake-form))]
     (reduce (fn [substitutions needed-key]
               ;; Note: because I like for a function's metaconstants to be
               ;; easily mappable to the original fake, I don't make one
@@ -319,10 +296,10 @@
               (if (get substitutions needed-key)
                 substitutions
                 (assoc substitutions needed-key (metaconstant-for-form needed-key))))
-            substitutions
-            needed-keys)))
-
-(defn flatten-fake [ [fake [fun & args] & rest] substitutions]
+      substitutions
+      needed-keys)))
+
+(defn flatten-fake [[fake [fun & args] & rest] substitutions]
   (let [new-args (for [a args] (get substitutions a a))]
     `(~fake (~fun ~@new-args) ~@rest)))

@@ -343,15 +320,15 @@
             augmented-substitutions (augment-substitutions substitutions target)
             flattened-target (flatten-fake target augmented-substitutions)
             generated-fakes (generate-fakes
-                             (map-difference augmented-substitutions substitutions)
-                             overrides)]
-        [ (conj finished flattened-target)
-          (concat generated-fakes (rest pending))
-          augmented-substitutions])
-    [(conj finished target), (rest pending), substitutions])))
-
-(defn unfold-expect-form__then__stay_put [loc]
-  (loop [ [finished pending substitutions] [ [] (zip/node loc) {} ]]
+          (map-difference augmented-substitutions substitutions)
+          overrides)]
+        [(conj finished flattened-target)
+         (concat generated-fakes (rest pending))
+         augmented-substitutions])
+      [(conj finished target), (rest pending), substitutions])))
+
+(defn- unfold-expect-form__then__stay_put [loc]
+  (loop [[finished pending substitutions] [[] (zip/node loc) {}]]
     (if (empty? pending)
       (zip/replace loc (apply list finished))
       (recur (unfolding-step finished pending substitutions)))))
@@ -359,6 +336,6 @@
 (defn unfold-fakes [form]
   (with-fresh-generated-metaconstant-names
     (translate-zipper form
-        expect?
-        unfold-expect-form__then__stay_put)))
-
+      expect?
+      unfold-expect-form__then__stay_put)))
+


fixing fact by moving operations into vec

--- test/celestial/test/api.clj
+++ test/celestial/test/api.clj
@@ -59,9 +59,10 @@
      (s/get-system "1" :env)  => :dev
      (jobs/enqueue "create" {:identity "1" :args [{:system-id 1}] :tid nil :env :dev :user nil}) => nil))

-(let [user (merge d/admin {:roles ["admin"] :envs ["dev" "qa"]})]
+(let [user (merge d/admin {:roles ["admin"] :envs ["dev" "qa"]})
+      ops-vec (into []  m/operations)]
   (fact "user conversion"
-     (dissoc (into-persisted user) :password) =>
-       {:envs [:dev :qa] :roles #{:celestial.roles/admin} :username "admin" :operations m/operations}
-     (into-persisted (dissoc user :password)) =>
-       {:envs [:dev :qa] :roles #{:celestial.roles/admin} :username "admin" :operations m/operations}))
+    (dissoc (into-persisted user) :password) =>
+      {:envs [:dev :qa] :roles #{:celestial.roles/admin} :username "admin" :operations ops-vec}
+    (into-persisted (dissoc user :password)) =>
+      {:envs [:dev :qa] :roles #{:celestial.roles/admin} :username "admin" :operations ops-vec}))


Mirror the Long test from custom to core

--- test/cheshire/test/core.clj
+++ test/cheshire/test/core.clj
@@ -17,6 +17,9 @@
 (deftest t-ratio
   (let [n 1/2]
     (is (= (double n) (:num (json/decode (json/encode {:num n}) true))))))
+
+(deftest t-long-wrap-around
+  (is (= 2147483648 (json/decode (json/encode 2147483648)))))

 (deftest t-bigint
   (let [n 9223372036854775808]


refactored tests

refactored tests

--- test/complico/core_test.clj
+++ test/complico/core_test.clj
@@ -8,17 +8,27 @@
 (def host "http://somelink.com/")

 (deftest build-link-replacements
-  (def ungreased-html
-    "<link href=\"duff.css\"/>
-
-
-    ")

-  (def expected-link-replacements
-    [["a href=\"http://anotherhost.com/duff\"" "a href=\"http://localhost:3000/convert?url=http://anotherhost.com/duff\""]
-      ["a href=\"duff\""                        "a href=\"http://localhost:3000/convert?url=http://somelink.com/duff\""]
-      ["a href=\"/duff\""                       "a href=\"http://localhost:3000/convert?url=http://somelink.com/duff\""]])
+  (testing "Dont grease the link elements"
+    (is (= (let [html "<link href=\"duff.css\"/>"]
+              (replace-all-in-string html
+                 (build-link-replacement-map html server-name server-port host)))
+            "<link href=\"duff.css\"/>")))

-  (testing "Greasing the new links"
-    (is (= (build-link-replacement-map ungreased-html server-name server-port host) expected-link-replacements))))
+  (testing "Grease the anchor (full link)"
+    (is (= (let [html ""]
+              (replace-all-in-string html
+                 (build-link-replacement-map html server-name server-port host)))
+            "")))

+  (testing "Grease the anchor (relative link no slash)"
+    (is (= (let [html ""]
+              (replace-all-in-string html
+                 (build-link-replacement-map html server-name server-port host)))
+            "")))
+
+  (testing "Grease the anchor (relative link with slash)"
+    (is (= (let [html ""]
+              (replace-all-in-string html
+                 (build-link-replacement-map html server-name server-port host)))
+            ""))))


Add basic logging to sync job to understand failures when loading deps

--- scripts/gosync.clj
+++ scripts/gosync.clj
@@ -1,3 +1,6 @@
+(println "Syncing Go.cd builds to buildviz")
+
+(println "Loading dependencies...")
 (use '[leiningen.exec :only (deps)])
 (deps '[[clj-http "1.1.2"]
         [clj-time "0.9.0"]
@@ -7,10 +10,13 @@
          '[clj-http.client :as client]
          '[clj-time.format :as tf]
          '[clj-time.coerce :as tc])
+(println "Loading dependencies done")

 (def server-url (second *command-line-args*))

 (def selected-pipeline-group-names (set (drop 2 *command-line-args*)))
+
+(println "Reading groups" selected-pipeline-group-names "from url" server-url)

 ;; util


One state update per log message. If multiple entries are required, then this can be unrolled via the apply function

--- src/onyx/windowing/aggregation.clj
+++ src/onyx/windowing/aggregation.clj
@@ -23,18 +23,18 @@

 (defn sum-aggregation-fn [state window segment]
   (let [k (second (:window/aggregation window))]
-    [[:set-value (+ state (get segment k))]]))
+    [:set-value (+ state (get segment k))]))

 (defn count-aggregation-fn [state window segment]
   [:set-value (inc state)])

 (defn min-aggregation-fn [state window segment]
   (let [k (second (:window/aggregation window))]
-    [[:set-value (clojure.core/min state (get segment k))]]))
+    [:set-value (clojure.core/min state (get segment k))]))

 (defn max-aggregation-fn [state window segment]
   (let [k (second (:window/aggregation window))]
-    [[:set-value (clojure.core/max state (get segment k))]]))
+    [:set-value (clojure.core/max state (get segment k))]))

 (defn average-aggregation-fn [state window segment]
   (let [k (second (:window/aggregation window))


Template version 0.2.0

Template version 0.2.0

--- template/project.clj
+++ template/project.clj
@@ -1,4 +1,4 @@
-(defproject cljs-lambda/lein-template "0.1.3"
+(defproject cljs-lambda/lein-template "0.2.0"
   :description "Clojurescript on AWS Lambda"
   :url "https://github.com/nervous-systems/cljs-lambda"
   :license {:name "Unlicense" :url "http://unlicense.org/UNLICENSE"}


(PDB-2474) engine: don't sort columns/projections

Leave them alone, so that their order matches that in the original
query.

--- src/puppetlabs/puppetdb/query_eng/engine.clj
+++ src/puppetlabs/puppetdb/query_eng/engine.clj
@@ -873,26 +873,20 @@
   [{:keys [projections]}]
   (->> projections
        (remove (comp :query-only? val))
-       keys
-       sort))
-
-(defn extract-fields
-  "Returns all fields from a projection.  Returns nil for fields which
-  are query-only? since these can't be projected either."
-  [[name {:keys [field]}] entity]
-  [field name])
+       keys))

 (defn honeysql-from-query
   "Convert a query to honeysql format"
-  [{:keys [projected-fields group-by call selection projections entity]}]
+  [{:keys [projected-fields group-by call selection projections]}]
   (let [fs (seq (map (fn [f]
                        [(apply hcore/call f) (first f)]) call))
         select (if (and fs
                         (empty? projected-fields))
                  (vec fs)
-                 (vec (concat (->> (sort projections)
+                 (vec (concat (->> projections
                                    (remove (comp :query-only? val))
-                                   (mapv #(extract-fields % entity)))
+                                   (mapv (fn [[name {:keys [field]}]]
+                                           [field name])))
                               fs)))
         new-selection (cond-> (assoc selection :select select)
                         group-by (assoc :group-by group-by))]
@@ -1331,7 +1325,7 @@
   ; and had the InExpression use that to generate the sql, but as it is the zipper we
   ; use to walk the plan won't see instances of hashes and uuids among fields that have
   ; gone through this function
-  (map #(get-in query-rec [:projections % :field]) (sort columns)))
+  (map #(get-in query-rec [:projections % :field]) columns))

 (defn strip-function-calls
   [column-or-columns]


removed rooms-test

removed rooms-test

--- test/server/rooms-test.cljs
+++ test/server/rooms-test.cljs
@@ -1,6 +0,0 @@
-(ns moomoo.rooms-test
-  (:require [cljs.test :refer-macros [async deftest is testing]]
-            [moomoo.rooms :as rooms]))
-
-(deftest foo
-  (is (= 1 1)))


fix clean task to be more verbose and delete *.jar/war

--- src/cake/tasks/clean.clj
+++ src/cake/tasks/clean.clj
@@ -3,13 +3,19 @@
   (:import (org.apache.tools.ant.taskdefs Delete Mkdir)))

 (defn clean-dir [dir]
-  (ant Delete {:include-empty-dirs true}
-       (add-fileset {:dir dir :includes "**/*"})))
+  (when (seq (rest (file-seq dir)))
+    (log "Deleting" (str (.getPath dir) "/*"))
+    (ant Delete {:include-empty-dirs true}
+      (add-fileset {:dir dir :includes "**/*"}))))

 (deftask clean
   "Remove cake build artifacts."
+  (ant Delete {:verbose true}
+    (add-fileset {:dir (file) :includes "*.jar"})
+    (add-fileset {:dir (file) :includes "*.war"}))
   (doseq [dir ["classes" "build"]]
-    (clean-dir dir))
+    (clean-dir (file dir)))
   (when (= ["deps"] (:clean *opts*))
-    (clean-dir "lib")
-    (ant Delete {:file "pom.xml"})))
+    (clean-dir (file "lib"))
+    (ant Delete {:verbose}
+      (add-fileset {:dir (file) :includes "pom.xml"}))))


fix bug where nil could be a path in source map

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -736,10 +736,12 @@
                     (if-let [url (:url source)]
                       (let [path (.getPath ^URL url)]
                         (if-let [compiled (get @compiled-cljs path)]
-                          (assoc merged (when-let [source-url (:source-url source)] (.getPath ^URL source-url))
-                            (sm/merge-source-maps
-                              (:source-map compiled)
-                              (get closure-source-map path)))
+                          (if-let [source-url (:source-url source)]
+                            (assoc merged (.getPath ^URL source-url)
+                              (sm/merge-source-maps
+                                (:source-map compiled)
+                                (get closure-source-map path)))
+                            merged)
                           (assoc merged path (get closure-source-map path))))
                       merged)))
                 (spit (io/file name)


Other route fix

Other route fix

--- src/clj/notes/server.clj
+++ src/clj/notes/server.clj
@@ -23,6 +23,7 @@
   (DELETE "/notes/:id" {params :params edn-params :edn-params} (delete-note edn-params))
   (resources "/react" {:root "react"})
   (files "/" {:root "resources/public"})
+  (files "/" {:root "public"})
   (GET "/*" req (page)))

 (defn logging-middleware [chain] (fn [req] (do (println (str "REQUEST: " req)) (chain req))))


Fix core namespace

Fix core namespace

--- src/cljs/gtfve/core.cljs
+++ src/cljs/gtfve/core.cljs
@@ -1,11 +1,14 @@
 (ns gtfve.core
-    (:require [reagent.core :as reagent :refer [atom]]
-              [reagent.session :as session]
-              [secretary.core :as secretary :include-macros true]
-              [goog.events :as events]
-              [goog.history.EventType :as EventType]
-              [cljsjs.react :as react])
-    (:import goog.History))
+  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
+  (:require [reagent.core :as reagent :refer [atom]]
+            [reagent.session :as session]
+            [secretary.core :as secretary :include-macros true]
+            [cljs.core.async :as async :refer [put! chan <! close!]]
+            [goog.events :as events]
+            [goog.history.EventType :as EventType]
+            [cljsjs.react :as react]
+            [gtfve.data :as data])
+  (:import goog.History))

 ;; -------------------------
 ;; Maps


Cleanup - long lines

Cleanup - long lines

--- src/cljs/ufo/client.cljs
+++ src/cljs/ufo/client.cljs
@@ -135,8 +135,6 @@
                trows)]))))

 (defui Table
-  ;; static om/Ident (ident [this {:keys [id]}] [:rows/by-id id])
-  ;; static om/IQuery (query [this] `[:id {:list/rows ~(om/get-query TBodyRow)}])
   Object
   (render
    [this]
@@ -148,21 +146,29 @@
         [:thead (thead-row prm)]
         (let [hm {:keyfn :sqlfn}
               tbody-fn (or (tid {:salaries (om/factory TBodySalaries hm)})
-                           (fn [_] (str "ERROR: Unknown tid: '" tid "'. tbody-fn undefined.")))]
-          ;; the map {:cols cols :fname fname} must be reconstructed; can't use 'prm'
+                           (fn [_] (str "ERROR: Unknown tid: '" tid "'."
+                                       " tbody-fn undefined.")))]
+          ;; the map {:cols cols :fname fname} must be reconstructed
+          ;; can't use 'prm'
           (tbody-fn {:tname tname :cols cols :sqlfn sqlfn}))]]))))
 (def table (om/factory Table {:keyfn :tid}))

 (defui RootView
-  static om/IQuery ;; the query-tree is static
-  (query [this] `[{:list/tables ~(om/get-query TTable)}])
+  ;; the query-tree is static
+  static om/IQuery (query [this] `[{:list/tables ~(om/get-query TTable)}])
   Object
-  #_(componentWillReceiveProps [this next-props]            (println "RootView" "WillReceiveProps"))
-  #_(componentWillUpdate       [this next-props next-state] (println "RootView" "WillUpdate"))
-  #_(componentDidUpdate        [this prev-props prev-state] (println "RootView" "DidUpdate"))
-  #_(componentWillMount        [this]                       (println "RootView" "WillMount"))
-  #_(componentDidMount         [this]                       (println "RootView" "DidMount"))
-  #_(componentWillUnmount      [this]                       (println "RootView" "WillUnmount"))
+  #_(componentWillReceiveProps
+     [this next-props]            (println "RootView" "WillReceiveProps"))
+  #_(componentWillUpdate
+     [this next-props next-state] (println "RootView" "WillUpdate"))
+  #_(componentDidUpdate
+     [this prev-props prev-state] (println "RootView" "DidUpdate"))
+  #_(componentWillMount
+     [this]                       (println "RootView" "WillMount"))
+  #_(componentDidMount
+     [this]                       (println "RootView" "DidMount"))
+  #_(componentWillUnmount
+     [this]                       (println "RootView" "WillUnmount"))
   (render
    [this]
    (let [{:keys [list/tables]} (om/props this)]


Revert "flip mapcat == lazyseq bind"

Revert "flip mapcat == lazyseq bind"

This reverts commit fe94b83a01a49eeebf9355471dbeff90e6b3dbcd.

--- src/cljx/cats/types.cljx
+++ src/cljx/cats/types.cljx
@@ -200,8 +200,7 @@
 (extend-type #+clj  clojure.lang.LazySeq
              #+cljs cljs.core.LazySeq
   proto/Functor
-  (fmap [self f]
-    (map f self))
+  (fmap [self f] (map f self))

   proto/Applicative
   (pure [_ v] (lazy-seq [v]))
@@ -212,7 +211,7 @@

   proto/Monad
   (bind [self f]
-    (mapcat f self)))
+    (apply concat (map f self))))

 ; TODO: test & document
 (extend-type #+clj clojure.lang.PersistentVector
@@ -230,7 +229,7 @@
   proto/Monad
   (bind [self f]
     (into []
-          (mapcat f self)))
+          (apply concat (map f self))))

   proto/MonadZero
   (mzero [_] [])


[skip ci] whitespace changes

[skip ci] whitespace changes

--- src/spec/cljc/mikron/compiler/core_spec.cljc
+++ src/spec/cljc/mikron/compiler/core_spec.cljc
@@ -85,13 +85,17 @@
                  :true        true?)
            (s/conformer second)))

-  (s/def :paths/all ::paths)
+  (s/def :paths/all
+    ::paths)

-  (s/def ::diff-paths ::paths)
+  (s/def ::diff-paths
+    ::paths)

-  (s/def ::interp-paths ::paths)
+  (s/def ::interp-paths
+    ::paths)

-  (s/def ::processor-types (s/coll-of keyword? :kind set?))
+  (s/def ::processor-types
+    (s/coll-of keyword? :kind set?))

   (s/def ::compile-schema-args
     (s/and (s/cat :schema ::schema


[#11222] Add aUSDC token and optimize search for Aave (LEND) (aka Ethlend)

--- src/status_im/ethereum/tokens.cljs
+++ src/status_im/ethereum/tokens.cljs
@@ -736,7 +736,11 @@
                    {:address  "0x8ab7404063ec4dbcfd4598215992dc3f8ec853d7"
                     :symbol   :AKRO
                     :name     "Akropolis"
-                    :decimals 18}])
+                    :decimals 18}
+                   {:address  "0x9ba00d6856a4edf4665bca2c2309936572473b7e"
+                    :symbol   :aUSDC
+                    :name     "Aave Interest bearing USDC"
+                    :decimals 6}])
    :testnet
    (resolve-icons :testnet
                   [{:name     "Status Test Token"


Set beats-per-cell during grid build.

Set beats-per-cell during grid build.

--- sonic-jam/src/sonic_jam/core.cljs
+++ sonic-jam/src/sonic_jam/core.cljs
@@ -85,12 +85,11 @@
                                  (go (>! set-state-ch id)))
                       "grid" (let [track {"type" "grid"
                                           "id" (:text state)
-                                          "bpc" (:width state) ;; should be separate parameter
                                           "beats" (repeat (:width state) [0])}
                                    tracks (clj->js (conj cursor track))
                                    grid (clj->js {"name" (:text state)
                                                   "id" (:text state)
-                                                  "bpc" (:width state)
+                                                  "bpc" (:bpc state)
                                                   "tracks" []})]
                                (transition {:state :init})
                                (let [grids (om/observe owner (grids))]
@@ -112,13 +111,28 @@
                     (dom/span nil "}"))
           :type (p (dom/span #js {:onClick #(transition {:state :init})} (str "{- " (:width state) " ... "))
                    (dom/span #js {:onClick #(transition {:state :sample :type "sample"})} " sample ")
-                   (dom/span #js {:onClick #(transition {:state :grid :type "grid"})} " grid ")
+                   (dom/span #js {:onClick #(transition {:state :bpc :type "grid"})} " grid ")
                    (dom/span nil "}"))
           :sample (p (dom/span #js {:onClick #(transition {:state :init})} (str "{- " (:width state) " sample ... "))
                      (apply dom/select #js {:onChange #(transition {:state :commit :sample (-> % .-target .-value)})}
                             (map #(dom/option nil %) (om/observe owner (samples))))
                      (dom/span nil "}"))
-          :grid (p (dom/span #js {:onClick #(transition {:state :init})} (str "{- " (:width state) " grid ..."))
+          :bpc (p (dom/span #js {:onClick #(transition {:state :init})} (str "{- " (:width state) " grid ... "))
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "1/32"})} " 1/32 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "1/16"})} " 1/16 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "1/8"})} " 1/8 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "1/4"})} " 1/4 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "1/2"})} " 1/2 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "1"})} " 1 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "2"})} " 2 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "4"})} " 4 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "8"})} " 8 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "16"})} " 16 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "32"})} " 32 ")
+                  (dom/span #js {:onClick #(transition {:state :grid :bpc "64"})} " 64 ")
+                  (dom/span nil "}"))
+          :grid (p (dom/span #js {:onClick #(transition {:state :init})}
+                             (str "{- " (:width state) " (" (:bpc state) ") ... "))
                    (dom/input #js {:type "text" :value (:text state)
                                    :onChange #(handle-change % owner state)})
                    (dom/span #js {:onClick commit} " commit? ")
@@ -146,7 +160,7 @@
                    (dom/div nil
                             (dom/p #js {:onClick #(om/set-state! owner :grid-expanded false)
                                         :style #js {:color "#999"}}
-                                   (str "[-] " id " (" (get cursor "bpc") " )"))
+                                   (str "[-] " id " (" (get cursor "bpc") ")"))
                             (apply dom/table nil
                                    (let [cursors (map #(hash-map :cursor %1 :id %2)
                                                       (get cursor "tracks")


Make sure changes to state in render fn don't cause disaster

--- test/testcloact.cljs
+++ test/testcloact.cljs
@@ -220,6 +220,24 @@
               (rflush))
           (is (= @child-ran 7)))))))

+(deftest dirty-test
+  (when isClient
+    (let [ran (atom 0)
+          state (atom 0)
+          really-simple (fn [props children this]
+                          (swap! ran inc)
+                          (if (= @state 1)
+                            (reset! state 3))
+                          [:div (str "state=" @state)])]
+      (with-mounted-component [really-simple nil nil]
+        (fn [c div]
+          (is (= 1 @ran))
+          (is (found-in #"state=0" div))
+          (reset! state 1)
+          (rflush)
+          (is (= 2 @ran))
+          (is (found-in #"state=3" div))))
+      (is (= 2 @ran)))))

 (defn as-string [comp]
   (reagent/render-component-to-string comp))


Fix follow-up email links.

Fix follow-up email links.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -778,7 +778,7 @@

 (defn- follow-up-notification-content [msg]
   (let [notification (:notification msg)
-        org (:org notification)
+        org (:org msg)
         logo-url (:logo-url org)
         logo-width (:logo-width org)
         logo-height (:logo-height org)


Somehow the kill docstring had survived from the dark ages of Overtone. Fix it up.

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -593,24 +593,15 @@
       (node-control n args))
     (node-control node args)))

-
-
 (defn kill
-  "Free one or more synth nodes.
-  Functions that create instance of synth definitions, such as hit,
-  return a handle for the synth node that was created.
-  (let [handle (hit :sin)] ; returns => synth-handle
-  (kill (+ 1000 (now)) handle))
-
-  ; a single handle without a time kills immediately
-  (kill handle)
-
-  ; or a bunch of synth handles can be removed at once
-  (kill (hit) (hit) (hit))
-
-  ; or a seq of synth handles can be removed at once
-  (kill [(hit) (hit) (hit)])
-  "
+  "Multi-purpose killing function.
+
+  * running synths - Stop and removes the node from the node
+                     tree.
+  * groups         - Stops all synths within the group (and
+                     subgroups) but will leave the group structure
+                     intact.
+"
   [& nodes]
   (doseq [node (flatten nodes)]
     (kill* node)))


Use 'do' to group items in let blocks instead of binding to '_'

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -275,8 +275,8 @@
   [node names]
   (ensure-connected!)
   (let [res (recv "/n_set")
-        _ (apply snd "/s_get" (to-synth-id node) (stringify names))
-        cvals (:args (deref! res))]
+        cvals (do (apply snd "/s_get" (to-synth-id node) (stringify names))
+                  (:args (deref! res)))]
     (apply hash-map (keywordify (drop 1 cvals)))))

 ; This can be extended to support setting multiple ranges at once if necessary...
@@ -294,8 +294,8 @@
   [node name-index n]
   (ensure-connected!)
   (let [res (recv "/n_setn")
-        _ (snd "/s_getn" (to-synth-id node) (to-str name-index) n)
-        cvals (:args (deref! res))]
+        cvals (do (snd "/s_getn" (to-synth-id node) (to-str name-index) n)
+                  (:args (deref! res)))]
     (vec (drop 3 cvals))))

 (defn- bussify


Fix race condition in node creation:

Fix race condition in node creation:

/s_new could occasionally trigger the handler fn before the node id is added to active-synth-nodes*

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -138,8 +138,8 @@
            arg-map  (map-and-check-node-args arg-map)
            args     (flatten (seq arg-map))
            snode    (SynthNode. synth-name id target position arg-map sdef (atom :loading))]
+       (swap! active-synth-nodes* assoc id snode)
        (apply snd "/s_new" synth-name id pos-id (to-synth-id target) args)
-       (swap! active-synth-nodes* assoc id snode)
        snode)))

 ;; ### Synth node callbacks


Remove unused.

Remove unused.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -102,8 +102,6 @@
   (vertex-id->points edges (mapv second vertices)))

-(defn make-vertices [vertices])
-

 (defn make-svg [[width height] {:keys [vertices edges] :as world-state}]
   [:svg:svg {:width width :height height}


Add statistics counting -- runs and successes

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -75,6 +75,14 @@
   (merge state {:editing? false
                 :selected nil}))

+
+(defn reset-stats
+  [world-state]
+  (merge world-state
+         {:stats {:runs 0,
+                  :success 0}}))
+
+
 (defn toggle-button-text
   [buttid condition valid invalid]
   (dommy/set-text! (dommy.core/sel1 buttid)
@@ -125,6 +133,7 @@
 (defn reset-to-initial
   [world-state]
   (merge (:initial world-state)
+         {:stats (:stats world-state)}
          {:random? (:random? world-state)}
          {:initial (:initial world-state)}))

@@ -201,20 +210,30 @@
          (:edges world-state))))

+(defn any-target-flipped?
+  [world-state]
+  (->>
+   [(:initial world-state) world-state]
+   (map get-target-edges)
+   (apply merge-with not=)
+   vals
+   (some true?)))
+
+
 (defn move-randomly
   [world-state]
   (swap! ticker dec)
   (if (neg? @ticker)
     (do
       (reset! ticker @interval)
-      (let [old     (get-target-edges (:initial world-state))
-            current (get-target-edges world-state)]
-        (if (some true? (vals (merge-with not= old current)))
-          (reset-to-initial world-state)
-          (if-let [m (get-random-legal-move-name world-state)]
-            (flip-update-edge m world-state)
-            (reset-to-initial world-state)
-            ))))
+      (if (any-target-flipped? world-state)
+        (update-in (reset-to-initial world-state)
+                   [:stats] (partial  merge-with + {:runs 1, :success 1}))
+        (if-let [m (get-random-legal-move-name world-state)]
+          (flip-update-edge m world-state)
+          (update-in (reset-to-initial world-state)
+                     [:stats :runs] inc)
+          )))
     world-state))

@@ -257,8 +276,9 @@
    reader/read-string
    reset-edit
    reset-random
-   remember-initial-state
-   make-flips-matter))
+   make-flips-matter
+   reset-stats
+   remember-initial-state))

 (go
   (listen-on-slider-change)


Much improved printer

Much improved printer

 - Now prints file, namespace, lineno
 - Now handles multiple args reasonably
 - Now paragraph wraps long args and prefixes

--- src/detritus/logging.clj
+++ src/detritus/logging.clj
@@ -4,7 +4,8 @@

   Note that the API here is likely very volatile and subject to
   change due to being bare bones to the point of trivial."
-  (:require [detritus.text :as text]))
+  (:require [detritus.text :as text])
+  (:require [detritus.pred :refer [maybe-fix]]))

 ;; Logging levels
@@ -29,46 +30,39 @@
 ;;--------------------------------------------------------------------

 (defn do-print
-  [prefix args]
-  (->> args
-     (apply str)
-     (text/wrap-lines 70)
-     (map (fn [line] (str prefix line "\n")))
-     (apply str)
-     println))
+  [log-level message prefix args]
+  (when (>= log-level *log-level*)
+    (->> args
+       (map str)
+       (map text/lines)
+       (apply concat)
+       (map (partial (fn format-line [spacing line]
+                 (if (>= (+ (count prefix) (count line)) *log-width*)
+                   (->> line
+                      (text/wrap-lines (- *log-width* 7 (count prefix)))
+                      (map (partial format-line "     : "))
+                      (apply str))
+                   (str prefix spacing line "\n")))
+               "     "))
+       (cons (str prefix " [" message "]\n"))
+       (apply str)
+       print)))

-(defn debug [& args]
-  (when (>= 0 *log-level*)
-    (with-bindings {#'clojure.core/*out* *log-stream*}
-      (do-print "[DEBUG   ]" args))))
+(defmacro defdebug [symbol level prefix]
+  `(defmacro ~symbol [~'& args#]
+     (let [meta# (meta ~'&form)]
+       (list 'with-bindings '{#'clojure.core/*out* *log-stream*}
+             (list 'do-print
+                   ~level
+                   (str "ns " (name (.name *ns*)) " | file " *file* ":" (:line meta#))
+                   ~prefix
+                   (vec args#))))))

-(defn info [& args]
-  (when (>= 1 *log-level*)
-    (with-bindings {#'clojure.core/*out* *log-stream*}
-      (do-print "[INFO    ]" args))))
-
-
-(defn message [& args]
-  (when (>= 2 *log-level*)
-    (with-bindings {#'clojure.core/*out* *log-stream*}
-      (do-print "[MESSAGE ]" args))))
-
-
-(defn warn [& args]
-  (when (>= 3 *log-level*)
-    (with-bindings {#'clojure.core/*out* *log-stream*}
-      (do-print "[WARN    ]" args))))
-
-
-(defn error [& args]
-  (when (>= 4 *log-level*)
-    (with-bindings {#'clojure.core/*out* *log-stream*}
-      (do-print "[ERROR   ]" args))))
-
-
-(defn fatal [args]
-  (when (>= 5 *log-level*)
-    (with-bindings {#'clojure.core/*out* *log-stream*}
-      (do-print "[FATAL   ]" args))))
+(defdebug debug   0 "[DEBUG   ]")
+(defdebug info    1 "[INFO    ]")
+(defdebug message 2 "[MESSAGE ]")
+(defdebug warn    3 "[WARN    ]")
+(defdebug error   4 "[ERROR   ]")
+(defdebug fatal   5 "[FATAL   ]")


Fix stupid mistake

Fix stupid mistake

--- worker/project.clj
+++ worker/project.clj
@@ -10,7 +10,7 @@
                  [cheshire "5.2.0"]
                  [org.rosuda/REngine "1.7.1-SNAPSHOT"]]
   :plugins [[lein-daemon "0.5.4"]]
-  :daemon {:server {:ns clinicico.worker.main
+  :daemon {:worker {:ns clinicico.worker.main
                     :pidfile "./worker.pid"}}
   :profiles {:uberjar {:aot :all}
              :dev {:resource-paths ["resources-dev" "resources"]


Add black background to fullscreen mode.

--- src/videotest/coral/coral_core.clj
+++ src/videotest/coral/coral_core.clj
@@ -15,6 +15,7 @@
    [org.opencv.core Core CvType Mat MatOfKeyPoint Point Size]
    [org.opencv.features2d FeatureDetector KeyPoint]
    [org.opencv.imgproc Imgproc]
+   [java.awt Color]
    [java.nio ByteBuffer ByteOrder]))

 (def CAM-DEV-NUM 0)
@@ -183,6 +184,8 @@
   :on-close on-close
   :middleware [m/fun-mode])

-(.setResizable (.frame videotest) true)
+(def frame (.frame videotest))
+(.setResizable frame true)
+(.setBackground (.getContentPane frame) Color/black)
 (defn close [] (applet-close videotest))
 (def x close)


Use ring's nrepl port setting if present

--- modules/core/src/main/clojure/immutant/repl.clj
+++ modules/core/src/main/clojure/immutant/repl.clj
@@ -89,7 +89,11 @@
   "Looks for nrepl-port value in the given config, and starts
 the appropriate servers."
   [config]
-  (let [port (:nrepl-port config (if (util/dev-mode?) 0 nil))
+  (let [ring-nrepl-config (-> (registry/get :project) :ring :nrepl)
+        port (or (:nrepl-port config)
+                 (and (:start? ring-nrepl-config)
+                      (:port ring-nrepl-config))
+                 (if (util/dev-mode?) 0 nil))
         interface (:nrepl-interface config)]
     (if (or port interface)
       (if-let [nrepl (start-nrepl interface (or port 0))]


Adding byte version for json string

Adding byte version for json string

--- src/riak_loader/core.clj
+++ src/riak_loader/core.clj
@@ -14,7 +14,7 @@
 ;; limitations under the License.

 (ns ^{  :doc "Loading data into Riak"
-        :author "Istvan Szukacs"}
+        :author "Istvan Szukacs"  }
   riak-loader.core
   (:require
     [clojure.java.io        :as   io    ]
@@ -23,6 +23,7 @@
     [clojure.tools.cli      :as   cli   ]
     [clojure.tools.logging  :as   log   ]
     [clojure.edn            :as   edn   ]
+    [cheshire.core          :as   ches  ]
     [clojure.core.async     :refer
       [alts! chan go thread timeout
        >! >!! <! <!! go-loop]           ]
@@ -132,7 +133,8 @@
                               (StoreValue$Builder. riak-object) riak-key)
                                 StoreValue$Option/N_VAL (Integer. 1)))
         exx             (.execute riak-client store)
-      ]))
+      ]
+    {:ok :ok}))

 (def blocking-producer >!!)
 (def blocking-consumer <!!)
@@ -190,9 +192,7 @@
         json-key        (get-in config [:ok :json-keys (keyword bucket-type)])
         _               (log/debug (str "json-key: " json-key))
         lines           (lazy-lines (:file options))
-        ;;              mem leak?
-        jsons           (map json/read-str lines)
-        ;;              mem leak?
+        json-hmps       (map ches/parse-string lines)
         riak-cluster    (riak-connect2!
                           (get-in config [:ok :env env :conn-string]))
         _               (.start riak-cluster)
@@ -223,13 +223,12 @@
                         doc-key     (get-doc-key json-key doc)
                         _           (log/debug (str "doc-key: " doc-key))
                         riak-key    (Location. riak-bucket doc-key)
-                        riak-value  (BinaryValue/create
-                                      ;; mem leak?
-                                      (json/write-str doc :escape-unicode false))
-                                      ;; mem leak ?
+                        json-byte   (.getBytes (ches/generate-string doc))
+                        riak-value  (BinaryValue/unsafeCreate json-byte)
                         start       (. System (nanoTime))
                         ; check if this returns an error
                         _           (log/debug (str riak-client riak-bucket riak-key "riak-value"))
+                        ;returns {:ok ...} || {:err ...} could be checked
                         _           (riak-store! riak-client riak-bucket riak-key riak-value)
                         exec-time   (with-precision 3
                                       (/ (- (. System (nanoTime)) start) 1000000.0)) ]
@@ -245,7 +244,7 @@

         (thread
           (Thread/sleep 100)
-          (doseq [json-doc jsons]
+          (doseq [json-doc json-hmps]
             (blocking-producer work-chan json-doc)))

         ;; end of sending thread


Sort people by name

Sort people by name

--- frontend/src/faceboard/views/boards/people.cljs
+++ frontend/src/faceboard/views/boards/people.cljs
@@ -130,10 +130,11 @@
   (render [_]
     (let [{:keys [ui anims]} data
           people (:content data)
+          sorted-people (sort #(compare (get-in %1 [:bio :name]) (get-in %2 [:bio :name])) people)
           extended-set (:extended-set ui)]
       (dom/div {}
-        (for [i (range (count people))]
-          (let [person (nth people i)
+        (for [i (range (count sorted-people))]
+          (let [person (nth sorted-people i)
                 data {:person    person
                       :extended? (contains? extended-set i)
                       :anim      (:person anims)


save event functions in component state

save event functions in component state

--- src/hatti/map/utils.cljs
+++ src/hatti/map/utils.cljs
@@ -453,51 +453,58 @@
 (defn register-mapboxgl-mouse-events
   "Register map mouse events."
   [owner map event-chan id_string style]
-  (.off map "mousemove")
-  (.off map "click")
-  (.on map "mousemove"
-       (fn [e]
-         (let [layer-id id_string
-               features
-               (.queryRenderedFeatures
-                map (.-point e) (clj->js {:layers [layer-id]}))
-               no-of-features (.-length features)
-               view-by (om/get-props owner [:map-page :view-by])
-               selected-id (om/get-props
-                            owner [:map-page :submission-clicked :id])]
-           (set! (.-cursor (.-style (.getCanvas map)))
-                 (if (pos? (.-length features)) "pointer" ""))
-           (when-not view-by
-             (if (= no-of-features 1)
-               (set-mapboxgl-paint-property
-                map layer-id
-                (get-style-properties
-                 style :hover :selected-id (get-id-property features)))
-               (do
-                 (set-mapboxgl-paint-property
-                  map layer-id
-                  (get-style-properties style :normal))
-                 (when selected-id
-                   (set-mapboxgl-paint-property
-                    map layer-id
-                    (get-style-properties
-                     style :clicked :selected-id selected-id)))))))))
-  (.on map "click"
-       (fn [e]
-         (let [layer-id id_string
-               features
-               (.queryRenderedFeatures
-                map (.-point e) (clj->js {:layers [layer-id]}))
-               no-of-features (.-length features)
-               view-by (om/get-props owner [:map-page :view-by])]
-           (when (pos? no-of-features)
-             (let [feature-id (get-id-property features)]
-               (put! event-chan {:mapped-submission-to-id feature-id})
-               (when-not view-by
-                 (set-mapboxgl-paint-property
-                  map layer-id
-                  (get-style-properties
-                   style :clicked :selected-id feature-id)))))))))
+  (let [mousemove-fn
+        (fn [e]
+          (let [layer-id id_string
+                features
+                (.queryRenderedFeatures
+                 map (.-point e) (clj->js {:layers [layer-id]}))
+                no-of-features (.-length features)
+                view-by (om/get-props owner [:map-page :view-by])
+                selected-id (om/get-props
+                             owner [:map-page :submission-clicked :id])]
+            (set! (.-cursor (.-style (.getCanvas map)))
+                  (if (pos? (.-length features)) "pointer" ""))
+            (when-not view-by
+              (if (= no-of-features 1)
+                (set-mapboxgl-paint-property
+                 map layer-id
+                 (get-style-properties
+                  style :hover :selected-id (get-id-property features)))
+                (do
+                  (set-mapboxgl-paint-property
+                   map layer-id
+                   (get-style-properties style :normal))
+                  (when selected-id
+                    (set-mapboxgl-paint-property
+                     map layer-id
+                     (get-style-properties
+                      style :clicked :selected-id selected-id))))))))
+        click-fn
+        (fn [e]
+          (let [layer-id id_string
+                features
+                (.queryRenderedFeatures
+                 map (.-point e) (clj->js {:layers [layer-id]}))
+                no-of-features (.-length features)
+                view-by (om/get-props owner [:map-page :view-by])]
+            (when (pos? no-of-features)
+              (let [feature-id (get-id-property features)]
+                (put! event-chan {:mapped-submission-to-id feature-id})
+                (when-not view-by
+                  (set-mapboxgl-paint-property
+                   map layer-id
+                   (get-style-properties
+                    style :clicked :selected-id feature-id)))))))]
+    ;; Remove existing event functions
+    (.off map "mousemove" (om/get-state owner :mousemove-fn))
+    (.off map "click" (om/get-state owner :click-fn))
+    ;; Set new event functions
+    (.on map "mousemove" mousemove-fn)
+    (.on map "click" click-fn)
+    ;; Update map component state with new event functions
+    (om/set-state! owner :mousemove-fn mousemove-fn)
+    (om/set-state! owner :click-fn click-fn)))

 (defn fitMapBounds
   "Fits map boundaries on rendered features."


Add new media received metadata column and a tooltip message for media files not uploaded successfully

--- src/hatti/ona/forms.cljs
+++ src/hatti/ona/forms.cljs
@@ -1,13 +1,16 @@
 (ns hatti.ona.forms
   (:require [chimera.js-interop :refer [format]]
             [chimera.urls :refer [last-url-param]]
+            [ona.utils.urls :as urls]
+            [ona.utils.i18n :refer [translate]]
             [chimera.date :as chimera-date]
             [cljs.pprint :refer [cl-format]]
             [clojure.string :as string]
             [hatti.constants :refer [_submission_time
                                      _submitted_by
                                      _last_edited
-                                     _id]]))
+                                     _id
+                                     _media_all_received]]))

 ;; CONSTANTS
 (def currency-regex #"£|$")
@@ -34,9 +37,15 @@
                   :label     "Last Edited"
                   :type      "date"})

+(def media_received_field {:name      _media_all_received
+                           :full-name _media_all_received
+                           :label     "All media received?"
+                           :type      "boolean"})
+
 (def extra-submission-details [last_edited
                                submission-time-field
-                               submitted-by-field])
+                               submitted-by-field
+                               media_received_field])

 ;; Formatting helpers
 (defn- format-multiline-answer
@@ -108,7 +117,8 @@
                             "instanceID"
                             "__version__"
                             "_duration"
-                            "_submitted_by"}
+                            "_submitted_by"
+                            "_media_all_received"}
                           field)
       (field-type-in-set? #{"deviceid"
                             "end"
@@ -119,7 +129,8 @@
                             "start"
                             "subscriberid"
                             "today"
-                            "uuid"}
+                            "uuid"
+                            "_media_all_received"}
                           field)))

 (defn geofield?
@@ -211,12 +222,26 @@
   (and (string? appearance-value)
        (re-matches #"^search\(.*\)$" appearance-value)))

+(defn media-files-upload-error-component
+  "Displays tip question and tooltip msg for failed media files uploads"
+  [answer & {:keys [hlp-url translation-txt record-modal?]}]
+  (if record-modal?
+    [:span.image-name answer
+     [:a.tooltip {:href hlp-url :target "_blank"}
+      [:span.tip-info translation-txt]
+      [:span.tip-question "?"]]]
+    (format " %s
+
+          %s
+          ?"
+            answer hlp-url translation-txt)))
+
 (defn format-answer
   "String representation for a particular field datapoint (answer).
    re-formatting depends on field type, eg. name->label substitution.
    Optional: compact? should be true if a short string needs to be returned."
-  [field answer & {:keys [language compact? label field-key]
-                   :or {field-key :name}}]
+  [field answer & {:keys [language compact? label field-key media record-modal?]
+                   :or {field-key :name record-modal? false}}]
   (cond
     (string/blank? answer) no-answer
     (select-one? field) (let [option (->> (:children field)
@@ -239,13 +264,27 @@
     (or (image? field)
         (video? field)) (let [image (:download_url answer)
                               thumb (or (:small_download_url answer) image)
+                              media-upload-fail-hlp-url
+                              urls/media-upload-fail-during-submission-help
+                              media-upload-fail-translation-txt
+                              (translate
+                               :table-data-view-page/media-upload-fail-err-msg)
                               fname (last-url-param (:filename answer))]
                           (cond
-                            (string? answer) answer
+                            (and (string? answer)
+                                 (not= answer "null") (nil? thumb))
+                            (media-files-upload-error-component
+                             answer
+                             :hlp-url
+                             media-upload-fail-hlp-url
+                             :translation-txt
+                             media-upload-fail-translation-txt
+                             :record-modal?
+                             record-modal?)
+                            (= answer "null") answer
                             compact? (format "

                                       %s " image fname)
-                            (nil? thumb) answer
                             :else [:a {:href image :target "_blank"}
                                    (if (image? field)
                                      [:img {:width "80px" :src thumb}]
@@ -292,10 +331,11 @@
                   "uuid"          "UUID"
                   "instanceID"    "Instance ID"
                   "phonenumber"   "Phone number"
+                  "_media_all_received"    "All media received?"
                   name)
                 (case name
-                  _submission_time "Submission time"
-                  _submitted_by    "Submitted by"
+                  _submission_time       "Submission time"
+                  _submitted_by          "Submitted by"
                   ""))]
     (cond-> field (not label) (assoc :label label))))


Enable this to work when using the lein plugin to test

--- integration-tests/apps/tx/test/tx/test/core.clj
+++ integration-tests/apps/tx/test/tx/test/core.clj
@@ -43,4 +43,4 @@
   (doseq [db dbs]
     (define-tests db)))

-(apply testes (str/split (:databases (immutant.registry/get :config)) #","))
+(apply testes (str/split (:databases (immutant.registry/get :config) "h2") #","))


added test of multiple tasks per executor

--- test/clj/backtype/storm/integration_test.clj
+++ test/clj/backtype/storm/integration_test.clj
@@ -33,6 +33,30 @@
         (is (= [[1] [2] [3] [4]]
                (read-tuples results "4")))
         ))))
+
+(defbolt emit-task-id ["tid"] {:prepare true}
+  [conf context collector]
+  (let [tid (.getThisTaskIndex context)]
+    (bolt
+      (execute [tuple]
+        (emit-bolt! collector [tid] :anchor tuple)
+        (ack! collector tuple)
+        ))))
+
+(deftest test-multi-tasks-per-executor
+  (with-simulated-time-local-cluster [cluster :supervisors 4]
+    (let [topology (thrift/mk-topology
+                    {"1" (thrift/mk-spout-spec (TestWordSpout. true))}
+                    {"2" (thrift/mk-bolt-spec {"1" :shuffle} emit-task-id
+                      :parallelism-hint 3
+                      :conf {TOPOLOGY-TASKS 6})
+                     })
+          results (complete-topology cluster
+                                     topology
+                                     :mock-sources {"1" [["a"] ["a"] ["a"] ["a"] ["a"] ["a"]]})]
+      (is (ms= [[0] [1] [2] [3] [4] [5]]
+               (read-tuples results "2")))
+      )))

 (defbolt ack-every-other {} {:prepare true}
   [conf context collector]


RS & ML | 161 | Update oauth test to use stonecutter's index page which now has sign-in form and registration form

--- test/stonecutter_journey_test/oauth_test.clj
+++ test/stonecutter_journey_test/oauth_test.clj
@@ -41,15 +41,13 @@
 (def scheme (get env/env :scheme "https"))

 (def stonecutter-url (get env/env :stonecutter-url "sso-staging.dcentproject.eu"))
-(def stonecutter-sign-in-page-body ".func--sign-in-page")
-(def stonecutter-sign-in-page-register-link ".func--register__link")
-(def stonecutter-sign-in-email-input ".func--email__input")
-(def stonecutter-sign-in-password-input ".func--password__input")
+(def stonecutter-index-page-body ".func--index-page")
+(def stonecutter-sign-in-email-input ".func--sign-in-email__input")
+(def stonecutter-sign-in-password-input ".func--sign-in-password__input")
 (def stonecutter-sign-in-button ".func--sign-in__button")
-(def stonecutter-register-page-body ".func--register-page")
-(def stonecutter-register-email-input ".func--email__input")
-(def stonecutter-register-password-input ".func--password__input")
-(def stonecutter-register-confirm-password-input ".func--confirm-password__input")
+(def stonecutter-register-email-input ".func--registration-email__input")
+(def stonecutter-register-password-input ".func--registration-password__input")
+(def stonecutter-register-confirm-password-input ".func--registration-confirm-password__input")
 (def stonecutter-register-create-profile-button ".func--create-profile__button")
 (def stonecutter-profile-page-body ".func--profile-page")
 (def stonecutter-profile-unshare-profile-card-link ".func--app-item__unshare-link")
@@ -77,8 +75,8 @@
   (wd/click stonecutter-sign-in-button))

 (defn attempt-sign-in []
-  (wd/to (str scheme "://" stonecutter-url "/sign-in"))
-  (wait-for-selector stonecutter-sign-in-page-body)
+  (wd/to (str scheme "://" stonecutter-url "/"))
+  (wait-for-selector stonecutter-index-page-body)
   (input-sign-in-credentials-and-submit))

 (defn go-to-delete-account []
@@ -115,14 +113,8 @@
     (fact "can register a stonecutter account"
           ;; Go to home page and get redirected to sign-in
           (wd/to (str scheme "://" stonecutter-url))
-          (wait-for-selector stonecutter-sign-in-page-body)
-          (wd/current-url) => (contains (str stonecutter-url "/sign-in"))
-
-          ;; Click through to register page
-          (wd/click stonecutter-sign-in-page-register-link)
-          (wait-for-selector stonecutter-register-page-body)
-          (screenshot "stonecutter_register_page")
-          (wd/current-url) => (contains (str stonecutter-url "/register"))
+          (wait-for-selector stonecutter-index-page-body)
+          (wd/current-url) => (contains (str stonecutter-url "/"))

           ;; Enter user details to register
           (wd/input-text stonecutter-register-email-input "stonecutter-journey-test@tw.com")
@@ -137,8 +129,8 @@

     (fact "can sign out of stonecutter"
           (wd/to (str scheme "://" stonecutter-url "/sign-out"))
-          (wait-for-selector stonecutter-sign-in-page-body)
-          (wd/current-url) => (contains (str stonecutter-url "/sign-in")))
+          (wait-for-selector stonecutter-index-page-body)
+          (wd/current-url) => (contains (str stonecutter-url "/")))

     (fact "can go to client page"
           (wd/to (str scheme "://" stonecutter-client-url))
@@ -148,9 +140,9 @@

     (fact "'sign in to vote' redirects to stonecutter"
           (wd/click "button")
-          (wait-for-selector stonecutter-sign-in-page-body)
+          (wait-for-selector stonecutter-index-page-body)
           (screenshot "stonecutter_sign_in")
-          (wd/current-url) => (contains (str stonecutter-url "/sign-in")))
+          (wd/current-url) => (contains (str stonecutter-url "/")))

     (fact "can sign in with existing user credentials and redirects to authorisation form page"
           (input-sign-in-credentials-and-submit)
@@ -224,9 +216,7 @@
     (fact "can continue to authorise app even when registering a new account"
           (wd/to (str scheme "://" stonecutter-client-url))
           (logout-of-client-and-click-sign-in-to-vote)
-          (wait-for-selector stonecutter-sign-in-page-body)
-          (wd/click stonecutter-sign-in-page-register-link)
-          (wait-for-selector stonecutter-register-page-body)
+          (wait-for-selector stonecutter-index-page-body)

           ;; Enter user details to register
           (wd/input-text stonecutter-register-email-input "stonecutter-journey-test@tw.com")


Allow `with-parser` to cancel current parsers with a nil arg

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -65,11 +65,14 @@

 (defmacro with-parser
   "Wraps body so that replies to any wrapped Redis commands will be parsed with
-  (parser-fn reply). Composable."
+  (parser-fn reply). Composable. When `parser-fn` is nil, clears any current
+  parsers."
   [parser-fn & body]
-  `(if-let [current-parser# protocol/*parser*]
-     (binding [protocol/*parser* (comp current-parser# ~parser-fn)] ~@body)
-     (binding [protocol/*parser* ~parser-fn] ~@body)))
+  `(if-not ~parser-fn
+     (binding [protocol/*parser* nil] ~@body)
+     (if-let [current-parser# protocol/*parser*]
+       (binding [protocol/*parser* (comp current-parser# ~parser-fn)] ~@body)
+       (binding [protocol/*parser* ~parser-fn] ~@body))))

 (defmacro with-mparser
   "Wraps body so that multi-bulk (vector) replies to any wrapped Redis commands


Fix `describe-table` bug (missing `catch` body)

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -287,7 +287,7 @@
   [creds table]
   (try (as-map (.describeTable (db-client creds)
                 (doto (DescribeTableRequest.) (.setTableName (name table)))))
-       (catch ResourceNotFoundException _)))
+       (catch ResourceNotFoundException _ nil)))

 (defn ensure-table "Creates a table iff it doesn't already exist."
   [creds {table-name :name :as opts}]


return html

return html

--- src/tic_tac_toe/core.clj
+++ src/tic_tac_toe/core.clj
@@ -155,7 +155,9 @@
        (let [board (if (contains? session :board)
                       (:board session)
                       blank-board)]
-         (assoc (response/response (get-board board)) :session (assoc session :board board))))
+         (response/content-type
+          (assoc (response/response (get-board board))
+            :session (assoc session :board board)) "text/html" )))
   (GET "/dump-session" {session :session} {:body (str "waaaaaa " session)
                                            :session (assoc session :1 1)})
   (GET "/place-piece/:pos/:piece" [pos piece]
@@ -163,6 +165,10 @@
          (swap! board place-piece (keyword piece) (Integer/parseInt pos))
          (when (= :ongoing (get-game-state @board))
            (swap! board place-piece :o (rand-nth (available-squares @board ))))
+
+         (let [players-turn  (place-piece (keyword piece) (Integer/parseInt pos))
+               computer-turn (place-piece :o (rand-nth (available-squares players-turn)))]
+
          (resp/redirect "/")))
   (POST "/post" [] (do
                      (reset! board blank-board)


remove whitespace

remove whitespace

--- src/timber/selectors.clj
+++ src/timber/selectors.clj
@@ -20,4 +20,3 @@
 (def script-template [[:script (html/attr? :template)]])

 (def content [:div#content])
-


Add :auth key on the load data pipeline.

--- src/uxbox/data/load.cljs
+++ src/uxbox/data/load.cljs
@@ -51,6 +51,7 @@
           (reduce stpr/assoc-project $ (:projects data))
           (reduce stpr/assoc-page $ (:pages data))
           (reduce assoc-color $ (:color-collections data))
-          (reduce assoc-shape $ (:shapes data)))
+          (reduce assoc-shape $ (:shapes data))
+          (assoc $ :auth (:auth data)))
         state))))


update date sample player docstring

update date sample player docstring

--- src/overtone/sc/sample.clj
+++ src/overtone/sc/sample.clj
@@ -143,13 +143,16 @@
     :sample-freed))

 (defn sample-player
-  [smpl & pargs]
-  {:pre [(sample? smpl)]}
+  "Play the specified sample with either a mono or stereo player
+  depending on the number of channels in the sample. Accepts same args
+  as both players, namely:
+  [buf 0 rate 1.0 start-pos 0.0 loop? 0 vol 1]"
+  [smpl & pargs] {:pre [(sample? smpl)]}
   (let [{:keys [path args]}     smpl
         {:keys [id n-channels]} (get @loaded-samples* [path args])]
     (cond
-     (= n-channels 1) (apply mono-player id pargs)
-     (= n-channels 2) (apply stereo-player id pargs))))
+      (= n-channels 1) (apply mono-player id pargs)
+      (= n-channels 2) (apply stereo-player id pargs))))

 (defrecord-ifn PlayableSample
   [id size n-channels rate allocated-on-server path args name]


minor bits of code cleanup

minor bits of code cleanup

--- src/overtone/viz/scope.clj
+++ src/overtone/viz/scope.clj
@@ -27,10 +27,11 @@
 (defonce Y-PADDING 10)
 (defonce scope-group* (ref 0))

-(on-deps :studio-setup-completed ::create-scope-group #(dosync
-                                                        (ref-set scope-group* (group :tail (main-monitor-group)))
-                                                        (satisfy-deps :scope-group-created)))
-
+(on-deps :studio-setup-completed
+         ::create-scope-group #(dosync
+                                (ref-set scope-group*
+                                         (group :tail (main-monitor-group)))
+                                (satisfy-deps :scope-group-created)))

 (defn- ensure-internal-server!
   "Throws an exception if the server isn't internal - scope relies on fast
@@ -51,17 +52,17 @@
   [s]
   (let [{:keys [buf size width height panel y-arrays x-array panel]} s
         frames    (if @(:update? s) (buffer-data buf) @(:frames s))
-        step      (int (/ (buffer-size buf) width))
+        step      (/ (buffer-size buf) width)
         y-scale   (- height (* 2 Y-PADDING))
         [y-a y-b] @y-arrays]
-    (if-not (empty? frames)
+
+    (when-not (empty? frames)
       (dotimes [x width]
         (aset ^ints y-b x
               (int (* y-scale
-                      (aget ^floats frames (unchecked-multiply x step)))))))
-
-    (reset! y-arrays [y-b y-a])
-    (.repaint panel)
+                      (aget ^floats frames (unchecked-multiply x step))))))
+      (reset! y-arrays [y-b y-a])
+      (.repaint panel))

     (when (and (not (:bus-synth s))
                @(:update? s))


Fix Reddit user URL

Fix Reddit user URL

/users/<username>.json gives the user's most recent comments;
/users/<username>/about.json gives information about the account,
including karma scores.

--- src/karmanaut/client.clj
+++ src/karmanaut/client.clj
@@ -3,7 +3,7 @@
   (:require [clojure.data.json :as json]))

 (defn url [username]
-  (str "http://www.reddit.com/user/" username ".json"))
+  (str "http://www.reddit.com/user/" username "/about.json"))

 (defn resp [username]
   (client/get (url username)))


It's a matter of when, not if.

It's a matter of when, not if.

--- src/podload/downloader.clj
+++ src/podload/downloader.clj
@@ -52,11 +52,11 @@
    copies infile to outfile, and adds the album tag to it"
   [infile outfile album-name]
   (let [f (Mp3File.  infile)]
-    (if (.hasId3v1Tag f)
+    (when (.hasId3v1Tag f)
       (.removeId3v1Tag f))
-    (if (.hasId3v2Tag f)
+    (when (.hasId3v2Tag f)
       (.removeId3v2Tag f))
-    (if (.hasCustomTag f)
+    (when (.hasCustomTag f)
       (.removeCustomTag f))
     (let [t (ID3v24Tag.)]
       (.setId3v2Tag f t)


Added basic types migration

Added basic types migration

--- src/lobos/migrations.clj
+++ src/lobos/migrations.clj
@@ -2,7 +2,8 @@
   (:refer-clojure :exclude [alter drop
                             bigint boolean char double float time])
   (:use (lobos [migration :only [defmigration]] core schema
-               config helpers)))
+               config helpers))
+  (:require [clojure.java.jdbc :as sql]))

 (defmigration add-places-table
@@ -19,3 +20,11 @@
                                   (refer-to :types))))
               (down [] (drop (table :places) :cascade)
                     (drop (table :types) :cascade)))
+
+(defmigration add-basic-types
+              (up [] (sql/insert! lobos.config/db :types
+                                  {:name "Bar"}
+                                  {:name "Pub"}
+                                  {:name "Take Away"} ))
+              (down [] (sql/delete! lobos.config/db :types [])))
+