add a unit test for the new api endpoint scenario.

--- test/metabase/api/database_test.clj
+++ test/metabase/api/database_test.clj
@@ -41,6 +41,22 @@
       :organization_id nil
       :description     nil
       :features        (mapv name (driver/features (driver/engine->driver (:engine db))))})))
+
+(defn- table-details [table]
+  (match-$ table
+    {:description     $
+     :entity_type     $
+     :visibility_type $
+     :schema          $
+     :name            $
+     :display_name    $
+     :rows            $
+     :updated_at      $
+     :entity_name     $
+     :active          $
+     :id              $
+     :db_id           $
+     :created_at      $}))

 ;; # DB LIFECYCLE ENDPOINTS
@@ -149,6 +165,49 @@
         ;; Now hit the endpoint
         (set ((user->client :rasta) :get 200 "database")))))

+;; GET /api/databases (include tables)
+(let [db-name (str "A" (random-name))] ; make sure this name comes before "test-data"
+  (expect-eval-actual-first
+    (set (filter identity (conj (for [engine datasets/all-valid-engines]
+                                  (datasets/when-testing-engine engine
+                                                                (match-$ (get-or-create-test-data-db! (driver/engine->driver engine))
+                                                                  {:created_at      $
+                                                                   :engine          (name $engine)
+                                                                   :id              $
+                                                                   :updated_at      $
+                                                                   :name            "test-data"
+                                                                   :is_sample       false
+                                                                   :is_full_sync    true
+                                                                   :organization_id nil
+                                                                   :description     nil
+                                                                   :tables          [(table-details (Table (id :categories)))
+                                                                                (table-details (Table (id :checkins)))
+                                                                                (table-details (Table (id :users)))
+                                                                                (table-details (Table (id :venues)))]
+                                                                   :features        (mapv name (driver/features (driver/engine->driver engine)))})))
+                                ;; (?) I don't remember why we have to do this for postgres but not any other of the bonus drivers
+                                (match-$ (sel :one Database :name db-name)
+                                  {:created_at      $
+                                   :engine          "postgres"
+                                   :id              $
+                                   :updated_at      $
+                                   :name            $
+                                   :is_sample       false
+                                   :is_full_sync    true
+                                   :organization_id nil
+                                   :description     nil
+                                   :tables          []
+                                   :features        (mapv name (driver/features (driver/engine->driver :postgres)))}))))
+    (do
+      ;; Delete all the randomly created Databases we've made so far
+      (cascade-delete Database :id [not-in (set (filter identity
+                                                        (for [engine datasets/all-valid-engines]
+                                                          (datasets/when-testing-engine engine
+                                                                                (:id (get-or-create-test-data-db! (driver/engine->driver engine)))))))])
+      ;; Add an extra DB so we have something to fetch besides the Test DB
+      (create-db db-name)
+      ;; Now hit the endpoint
+      (set ((user->client :rasta) :get 200 "database" :include_tables true)))))

 ;; ## GET /api/meta/table/:id/query_metadata
 ;; TODO - add in example with Field :values


Refactor peer model playback code

Refactor peer model playback code

--- test/onyx/generative/peer_model.clj
+++ test/onyx/generative/peer_model.clj
@@ -255,6 +255,44 @@
 (defn task-component-path [peer-id]
   [:state :vpeers peer-id :virtual-peer :state :started-task-ch])

+(defn assert-correct-replicas [written new-state]
+  (assert (or (empty? written)
+              (= #{(m/replica-version (:messenger new-state))}
+                 (set (map :replica written))))
+          "something was written but replica versions weren't right"))
+
+(defn add-written [batches command prev-state new-state prev-replica-version]
+  (let [written (if (= command :task-iteration)
+                  (seq (:null/not-written (:event new-state))))]
+    (assert-correct-replicas written new-state)
+
+    (cond-> (vec batches)
+
+      (not= prev-replica-version
+            (m/replica-version (:messenger new-state)))
+      (conj [:reset-messenger])
+
+      written
+      (conj written))))
+
+(defn next-coordinator-state [coordinator command]
+  (let [state (:coordinator-thread coordinator)]
+    (if (and (coord/started? coordinator)
+             ;; Do not issue a new barrier if still offering old one
+             (or (not= command :periodic-barrier)
+                 (false? (:offering? state))))
+      (assoc coordinator
+             :coordinator-thread
+             (onyx.peer.coordinator/coordinator-action command state (:prev-replica state)))
+      coordinator)))
+
+(defn next-state [prev-state command replica]
+  (cond (= command :task-iteration)
+        (tl/next-state prev-state replica)
+
+        (#{:periodic-barrier :offer-barriers} command)
+        (update prev-state :coordinator next-coordinator-state command)))
+
 (defn apply-peer-commands [groups {:keys [command group-id peer-owner-id]}]
   (let [group (get groups group-id)
         peer-id (get-peer-id group peer-owner-id)]
@@ -267,50 +305,13 @@
                 new-allocation (common/peer->allocated-job (:allocations current-replica) peer-id)
                 prev-state (or (get-in @task-component [:task-lifecycle :prev-state])
                                init-state)
+                ;; capture replica verison here as it is mutable
                 prev-replica-version (m/replica-version (:messenger prev-state))
-                new-state (cond (= command :task-iteration)
-                                (tl/next-state prev-state current-replica)
-
-                                (#{:periodic-barrier :offer-barriers} command)
-                                (assoc prev-state
-                                       :coordinator
-                                       (let [coordinator (:coordinator prev-state)
-                                             state (:coordinator-thread coordinator)]
-                                         (if (and (coord/started? coordinator)
-                                                  ;; Do not issue a new barrier if still offering old one
-                                                  (or (not= command :periodic-barrier)
-                                                      (false? (:offering? state))))
-                                           (assoc coordinator
-                                                  :coordinator-thread
-                                                  (onyx.peer.coordinator/coordinator-action command state (:prev-replica state)))
-                                           coordinator))))]
+                new-state (next-state prev-state command current-replica)]
             (swap! task-component assoc-in [:task-lifecycle :prev-state] new-state)
-            (assoc groups
-                   group-id
-                   (-> group
-                       ;; Store the updated event in the vpeer component state, so it will be cleared when
-                       (update-in [:peer-state peer-id (:task new-allocation) :written]
-                                  (fn [batches]
-                                    (let [written (if (= command :task-iteration)
-                                                    (seq (:null/not-written (:event new-state))))]
-                                      (assert (or (empty? written)
-                                                   (= #{(m/replica-version (:messenger new-state))}
-                                                 (set (map :replica written))))
-
-                                              [command
-
-                                               #{(m/replica-version (:messenger new-state))}
-                                                 (set (map :replica written))]
-                                              )
-
-                                      (cond-> (vec batches)
-
-                                        (not= prev-replica-version
-                                              (m/replica-version (:messenger new-state)))
-                                        (conj [:reset-messenger])
-
-                                        written
-                                        (conj written))))))))
+            (update-in groups
+                       [group-id :peer-state peer-id (:task new-allocation) :written]
+                       (fn [w] (add-written w command prev-state new-state prev-replica-version))))
           groups))
       groups)))


Pass the test.

Pass the test.

--- test/onyx/peer/colors_flow_test.clj
+++ test/onyx/peer/colors_flow_test.clj
@@ -189,8 +189,14 @@
    {:lifecycle/task :green-out
     :lifecycle/calls :onyx.plugin.core-async/writer-calls}])

+(def seen-before? (atom false))
+
 (defn black? [event old {:keys [color]} all-new]
-  (= color "black"))
+  (if (and (not @seen-before?) (= color "black"))
+    (do
+      (swap! seen-before? (constantly true))
+      true)
+    false))

 (defn white? [event old {:keys [color]} all-new]
   (= color "white"))


Formatting comments (circleci run my tests plz)

--- test/onyx/peer/kw_grouping_test.clj
+++ test/onyx/peer/kw_grouping_test.clj
@@ -177,10 +177,9 @@

 (fact (not (empty? out-val)))

-;;;; We flush out each result set based on
-;;;; the peer id, then we do a diff. If the
-;;;; last collection is empty, we know that
-;;;; each map is mutually exclusive.
+;;;; We flush out each result set based on the peer id, then we do a diff. If the
+;;;; last collection is empty, we know that each map is mutually exclusive.
+
 (let [l (first (vals out-val))
       r (second (vals out-val))]
   (fact (empty? (last (clojure.data/diff l r)))))


reader fixes

reader fixes

--- src/test/rksm/cloxp_cljs/ns/internals_test.clj
+++ src/test/rksm/cloxp_cljs/ns/internals_test.clj
@@ -75,7 +75,7 @@

 (defn ^:export foo
   [x]
-  (+ x 32))\n"]
+  (+ x 32))"]
     (change-def! 'rksm.test/foo new-src true)
     (is (= expected-src (slurp test-file)))))


fix speling

fix speling

--- src/cljs/ikea_clojure_cup/pack_it.cljs
+++ src/cljs/ikea_clojure_cup/pack_it.cljs
@@ -18,7 +18,7 @@
     [:section
      (case (:result @result-state)
        :yes (heading "It'll fit!")
-       :no (heading "It won't fix :(")
+       :no (heading "It won't fit :(")
        :partial [:div
                  (heading "...kinda fits")
                  [:p "It'll should fit better if you remove: " (cs/join "," (map #(-> % :id str) (:missing @result-state)))]])]))


cleanup

cleanup

--- src/clojure/zensols/nlparse/config.clj
+++ src/clojure/zensols/nlparse/config.clj
@@ -267,18 +267,6 @@
   This context is optionally configured.  Without this macro the default
   context is used as described in the [usage section](#usage) section."
   {:style/indent 1}
-  [exprs & forms]
-  (let [[raw-context- & ckeys-] exprs]
-    `(let [qkeys# (apply hash-map (quote ~ckeys-))
-           context# (merge ~raw-context- qkeys#)]
-       (binding [*parse-context* context#]
-         ~@forms))))
-
-(defmacro with-context
-  "Use the parser with a context created with [[create-context]].
-  This context is optionally configured.  Without this macro the default
-  context is used as described in the [usage section](#usage) section."
-  {:style/indent 1}
   [context & forms]
   `(let [context# ~context]
      (binding [*parse-context* context#]


Opening external links in a new tab

Opening external links in a new tab


Fixing durations within a pluck to be relative.


Populate functions map in defhash macro.

--- src/multihash/core.clj
+++ src/multihash/core.clj
@@ -172,27 +172,28 @@
     (.digest algo)))

+(def functions
+  "Map of supported multihash functions."
+  {})
+
+
 (defmacro ^:private defhash
   "Defines a new convenience hashing function for the given algorithm and system
   digest name."
   [algorithm digest-name]
-  `(defn ~(symbol (name algorithm))
-     ~(str "Calculates the " digest-name " digest of the given byte array or "
-           "buffer and returns a multihash.")
-     [~'content]
-     (create ~algorithm (digest-content ~digest-name ~'content))))
+  (let [fn-sym (symbol (name algorithm))]
+    `(do
+       (defn ~fn-sym
+         ~(str "Calculates the " digest-name " digest of the given byte array or "
+               "buffer and returns a multihash.")
+         [~'content]
+         (create ~algorithm (digest-content ~digest-name ~'content)))
+       (alter-var-root #'functions assoc ~algorithm ~fn-sym))))

 (defhash :sha1     "SHA-1")
 (defhash :sha2-256 "SHA-256")
 (defhash :sha2-512 "SHA-512")
-
-
-(def functions
-  "Map of supported multihash functions."
-  {:sha1     sha1
-   :sha2-256 sha2-256
-   :sha2-512 sha2-512})


working logistic-beta-vector function

working logistic-beta-vector function

--- src/clj/forma/classify/logistic.clj
+++ src/clj/forma/classify/logistic.clj
@@ -130,25 +130,51 @@
 ;; (beta-update b lab feat 1e-4)
 ;; [-4500000.112138934 -3109448.5835883324 -1718897.0550377304 -328345.52648712834 1062206.0020634746]

+(defn initial-beta
+  [^DoubleMatrix feature-mat]
+  (let [n (.columns feature-mat)]
+    (to-double-rowmat (repeat n 0))))

 (defn logistic-beta-vector
   "return the estimated parameter vector; which is used, in turn, to
-  calculate the estimated probability of the binary label"
-  [label-seq feature-mat rdg-cons converge-threshold max-iter]
-  (let [beta-init (repeat (count (first feature-mat)) 0)]
+  calculate the estimated probability of the binary label; the initial
+  beta-diff value is an arbitrarily large value."
+  [^DoubleMatrix label-row ^DoubleMatrix feature-mat
+   rdg-cons converge-threshold max-iter]
+  (let [beta-init (initial-beta feature-mat)]
     (loop [beta beta-init
            iter max-iter
            beta-diff 100]
       (if (or (zero? iter)
               (< beta-diff converge-threshold))
         beta
-        (let [update (beta-update beta label-seq feature-mat rdg-cons)
-              beta-new (map + beta update)
-              diff (reduce + (map (comp abs -) beta beta-new))]
+        (let [update (beta-update beta label-row feature-mat rdg-cons)
+              beta-new (.addRowVector beta update)
+              diff (.norm1 (.subRowVector beta beta-new))]
           (recur
            beta-new
            (dec iter)
            diff))))))
+
+
+;; (defn logistic-beta-vector
+;;   "return the estimated parameter vector; which is used, in turn, to
+;;   calculate the estimated probability of the binary label"
+;;   [label-seq feature-mat rdg-cons converge-threshold max-iter]
+;;   (let [beta-init (repeat (count (first feature-mat)) 0)]
+;;     (loop [beta beta-init
+;;            iter max-iter
+;;            beta-diff 100]
+;;       (if (or (zero? iter)
+;;               (< beta-diff converge-threshold))
+;;         beta
+;;         (let [update (beta-update beta label-seq feature-mat rdg-cons)
+;;               beta-new (map + beta update)
+;;               diff (reduce + (map (comp abs -) beta beta-new))]
+;;           (recur
+;;            beta-new
+;;            (dec iter)
+;;            diff))))))


debugged basic native loading

debugged basic native loading

--- src/clj/onyx_java/instance/bind.clj
+++ src/clj/onyx_java/instance/bind.clj
@@ -1,6 +1,6 @@
 (ns onyx-java.instance.bind
   (:gen-class)
-  #_(:import java.lang.reflect.Constructor))
+  (:import org.onyxplatform.api.java.instance.Loader))

 (defn exists?  [c]
   (let [loader (.getContextClassLoader (Thread/currentThread))]
@@ -9,25 +9,13 @@
       true
       (catch ClassNotFoundException cnfe false))))

-
-(defn new-instance [fq-class-name ctr-args]
-  (if-not (exists? fq-class-name)
-    nil ; Throw ClassNotFoundException?
-    (let [fn-clazz  (Class/forName fq-class-name)
-          ; Create IPersistentMap ctr
-          ipm-ctr-array (into-array  [clojure.lang.IPersistentMap])
-          inst-ctr (.getConstructor fn-clazz ipm-ctr-array)
-          inst-args () ; into array so its [Ljava.lang.Object
-          ]
-      (.newInstance inst-ctr inst-args))))
-
 (def instances (atom {}))

 (defn instance [id fq-class-name ctr-args]
   (let [k (keyword (str id))]
     (if (contains? @instances k)
-      (get @instances k)
-      (let [i (new-instance fq-class-name ctr-args)]
+      (get @instances k)
+      (let [i (Loader/loadOnyxMethod fq-class-name ctr-args)]
         (swap! instances assoc k i)
         i))))


Put a "waiting" key into the db

Put a "waiting" key into the db

This is so we don't try and load all the images just because the user
scrolled again.

--- src/cljs/comic_reader/handlers.cljs
+++ src/cljs/comic_reader/handlers.cljs
@@ -10,8 +10,9 @@
                        {:keys [chapter]} :location
                        :as db}]
   (api/get-img-tag site (first url-list))
-  (let [{:keys [url-list] :as db} (assoc db :url-list
-                                         (next url-list))
+  (let [{:keys [url-list] :as db} (assoc db
+                                         :url-list (next url-list)
+                                         :waiting true)
         new-location (assoc location :chapter
                             (inc
                              (read-string chapter)))]
@@ -73,8 +74,9 @@
   (rf/register-handler
    :scroll
    (fn [db _]
-     (if (= (:page db)
-            :read)
+     (if (and (not (:waiting db))
+              (= (:page db)
+                 :read))
        (let [scroll-y (.-scrollY js/window)
              window-height (.-innerHeight js/window)
              screen-bottom (+ scroll-y window-height)
@@ -89,5 +91,6 @@
    :next-image
    (fn [db [_ img-tag]]
      (-> db
+         (assoc :waiting false)
          (update-in [:url-list] rest)
          (update-in [:comic-imgs] conj img-tag)))))


core instrumentation: fix hostname for events

--- src/riemann/instrumentation.clj
+++ src/riemann/instrumentation.clj
@@ -55,7 +55,7 @@
   doubles in milliseconds."
   ([event] (rate+latency event [0.0 0.5 0.95 0.99 0.999]))
   ([ev quantiles]
-   (let [ev (event (merge ev {:service (str "riemann " (:service ev))}))]
+   (let [ev (merge ev {:service (str "riemann " (:service ev))})]
      (RateLatency. ev quantiles (rate) (uniform-reservoir)))))

 (defn instrumented?


Import difference.

Import difference.

--- src/postal/message.clj
+++ src/postal/message.clj
@@ -1,5 +1,6 @@
 (ns postal.message
-  (:use [postal.date :only [make-date]])
+  (:use [clojure.set :only [difference]]
+        [postal.date :only [make-date]])
   (:import [java.util Properties UUID]
            [javax.mail Session Message$RecipientType]
            [javax.mail.internet MimeMessage InternetAddress
@@ -68,7 +69,7 @@

 (defn drop-keys [m ks]
   (select-keys m
-               (clojure.set/difference (set (keys m)) (set ks))))
+               (difference (set (keys m)) (set ks))))

 (defn make-auth [user pass]
   (proxy [javax.mail.Authenticator] []


Remove monad namespace.

Remove monad namespace.

--- src/promesa/monad.cljc
+++ src/promesa/monad.cljc
@@ -1,74 +0,0 @@
-(ns promesa.monad
-  "An optional cats integration."
-  (:require [cats.core :as m]
-            [cats.context :as mc]
-            [cats.protocols :as mp]
-            [promesa.core :as p])
-  #?(:clj
-     (:import java.util.concurrent.CompletionStage)))
-
-(declare promise-context)
-
-#?(:cljs
-   (extend-type p/Promise
-     mp/Contextual
-     (-get-context [_] promise-context)
-
-     mp/Extract
-     (-extract [it]
-       (p/-extract it)))
-
-   :clj
-   (extend-type CompletionStage
-     mp/Contextual
-     (-get-context [_] promise-context)
-
-     mp/Extract
-     (-extract [it]
-       (p/-extract it))))
-
-(def ^:no-doc promise-context
-  (reify
-    mp/Context
-    (-get-level [_] mc/+level-default+)
-
-    mp/Functor
-    (-fmap [mn f mv]
-      (p/-map mv f))
-
-    mp/Bifunctor
-    (-bimap [_ err succ mv]
-      (-> mv
-          (p/-map succ)
-          (p/-catch err)))
-
-    mp/Monad
-    (-mreturn [_ v]
-      (p/-promise v))
-
-    (-mbind [mn mv f]
-      (p/-bind mv f))
-
-    mp/Applicative
-    (-pure [_ v]
-      (p/-promise v))
-
-    (-fapply [_ pf pv]
-      (p/-map (p/all [pf pv])
-              (fn [[f v]]
-                (f v))))
-
-    mp/Semigroup
-    (-mappend [_ mv mv']
-      (p/-map (m/sequence [mv mv'])
-              (fn [[mvv mvv']]
-                (let [ctx (mp/-get-context mvv)]
-                  (mp/-mappend ctx mvv mvv')))))))
-
-
-
-
-
-
-
-


Validate defresolver option keys and fix aliases on docstring

--- src/com/wsscode/pathom/connect.cljc
+++ src/com/wsscode/pathom/connect.cljc
@@ -1573,7 +1573,7 @@
          (s/cat :name simple-symbol?
                 :docstring (s/? string?)
                 :arglist ::operation-args
-                :options (s/? map?)
+                :options (s/? (s/keys))
                 :body (s/+ any?))
          (fn must-have-output-visible-map-or-options [{:keys [body options]}]
            (or (map? (last body)) options)))))
@@ -1638,41 +1638,41 @@

      The verbose example:

-         (pco/defresolver song-by-id [env {:acme.song/keys [id]}]
-           {::pco/input     #{:acme.song/id}
-            ::pco/output    [:acme.song/title :acme.song/duration :acme.song/tone]
-            ::pco/params    []
-            ::pco/transform identity}
+         (pc/defresolver song-by-id [env {:acme.song/keys [id]}]
+           {::pc/input     #{:acme.song/id}
+            ::pc/output    [:acme.song/title :acme.song/duration :acme.song/tone]
+            ::pc/params    []
+            ::pc/transform identity}
            (fetch-song env id))

      The previous example demonstrates the usage of the most common options in defresolver.

      But we don't need to write all of that, for example, instead of manually saying
-     the ::pco/input, we can let the defresolver infer it from the param destructuring, so
-     the following code works the same (::pco/params and ::pco/transform also removed, since
+     the ::pc/input, we can let the defresolver infer it from the param destructuring, so
+     the following code works the same (::pc/params and ::pc/transform also removed, since
      they were no-ops in this example):

-         (pco/defresolver song-by-id [env {:acme.song/keys [id]}]
-           {::pco/output [:acme.song/title :acme.song/duration :acme.song/tone]}
+         (pc/defresolver song-by-id [env {:acme.song/keys [id]}]
+           {::pc/output [:acme.song/title :acme.song/duration :acme.song/tone]}
            (fetch-song env id))

      This makes for a cleaner write, now lets use this format and write a new example
      resolver:

-         (pco/defresolver full-name [env {:acme.user/keys [first-name last-name]}]
-           {::pco/output [:acme.user/full-name]}
+         (pc/defresolver full-name [env {:acme.user/keys [first-name last-name]}]
+           {::pc/output [:acme.user/full-name]}
            {:acme.user/full-name (str first-name \" \" last-name)})

      The first thing we see is that we don't use env, so we can omit it.

-         (pco/defresolver full-name [{:acme.user/keys [first-name last-name]}]
-           {::pco/output [:acme.user/full-name]}
+         (pc/defresolver full-name [{:acme.user/keys [first-name last-name]}]
+           {::pc/output [:acme.user/full-name]}
            {:acme.user/full-name (str first-name \" \" last-name)})

      Also, when the last expression of the defresolver is a map, it will infer the output
      shape from it:

-         (pco/defresolver full-name [{:acme.user/keys [first-name last-name]}]
+         (pc/defresolver full-name [{:acme.user/keys [first-name last-name]}]
            {:acme.user/full-name (str first-name \" \" last-name)})

      You can always override the implicit input and output by setting on the configuration
@@ -1680,10 +1680,10 @@

      Standard options:

-       ::pco/output - description of resolver output, in EQL format
-       ::pco/input - description of resolver input, as a set
-       ::pco/params - description of resolver parameters, in EQL format
-       ::pco/transform - a function to transform the resolver configuration before instantiating the resolver
+       ::pc/output - description of resolver output, in EQL format
+       ::pc/input - description of resolver input, as a set
+       ::pc/params - description of resolver parameters, in EQL format
+       ::pc/transform - a function to transform the resolver configuration before instantiating the resolver

      Note that any other option that you send to the resolver config will be stored in the
      index and can be read from it at any time.


create and edit requests should be POSTs

backend-request can now take any $.ajax options

--- src/semtag_web/client/main.cljs
+++ src/semtag_web/client/main.cljs
@@ -20,14 +20,18 @@
     (alert (error-msg path msg))))

 (defn backend-request
-  ([path f] (backend-request path f alert-error))
-  ([path f alert-fn]
+  "Given a path and success fn makes a request using $.ajax. Additional arguments are
+  interpreted as options to $.ajax. Also accepts a :alert-fn option to create a
+  specialized error fn."
+  [path f & {:keys [type alert-fn] :or {type "GET" alert-fn alert-error} :as options}]
   (jq/ajax
     (str "http://localhost:3000/api" path)
-    {:dataType "edn"
-     :error #(apply alert-fn path %&)
-     :success f
-     })))
+    (merge
+      {:dataType "edn"
+       :error #(apply alert-fn path %&)
+       :type type
+       :success f
+       } options)))

 ;;; js update fns
 (defn- add-sort-to [parent-div]
@@ -51,12 +55,14 @@
         value (jq/text $elem)]
     (.blur $elem)
     (backend-request
-      (path-to "/edit?id=" id "&" field "=" value)
+      (path-to "/edit")
       (fn [data]
         (log "Received from server:")
         (log-clj data)
         (set-edit-state "edit-completed" event))
-      (fn [& args]
+      :type "POST"
+      :data {:id id field value}
+      :alert-fn (fn [& args]
         (set-edit-state "edit-failed" event)
         (apply alert-error args)
         ))))
@@ -93,16 +99,18 @@
     (-> (jq/find search-box :h2)
       (inner (str "Search results for '" query "'")))
     (.blur text-field)
-    (backend-request (path-to "/mls?query=" query) (partial create-search-table search-box))
+    (backend-request (path-to "/mls") (partial create-search-table search-box) :data {:query query})
     (when callback (callback query))))

 (defn create-url [$text $button]
-  (backend-request (path-to "/add?input=" (jq/val $text))
+  (backend-request (path-to "/add")
     (fn [data]
       (alert (format "Added '%s'" (jq/val $text)) :info)
       (jq/text $button "Add Url")
       (jq/val $text "")
-      (jq/hide $text))))
+      (jq/hide $text))
+    :type "POST"
+    :data {:input (jq/val $text)}))

 (defn add-url [$text $button event]
   (if (jq/is $text ":visible")
@@ -115,7 +123,7 @@
 (defn ^:export tag-show []
   (let [$tag-box ($ :#tag_box)
         tag (util/match-from-current-uri #"[^\/]+$")]
-    (backend-request (path-to "/tag?tag=" tag)
+    (backend-request (path-to "/tag")
       (fn [data]
         (if (string? data)
           (alert data)
@@ -127,7 +135,8 @@
                                    :row-partial view/tag-row
                                    :fields [:attribute :value]))
             (make-table-editable))
-          )))))
+          ))
+       :data {:tag tag})))

 (defn ^:export tag-stats []
   (backend-request (path-to "/tag-stats")
@@ -155,7 +164,7 @@

     (backend-request (path-to "/tags")
       #(jq/after $text-field (view/generate-datalist %))
-      console-error)
+      :alert-fn console-error)

     (when-let [query (when (seq query-param) (second query-param))]
       (jq/val $text-field query)
@@ -163,14 +172,15 @@

 (defn ^:export model-show []
   (let [model (util/match-from-current-uri #"[^\/]+$")]
-    (backend-request (path-to "/model?model=" model)
+    (backend-request (path-to "/model")
       (fn [data]
         (create-sort-table ($ :#model_show_box)
               (generate-table "model_show_table" data
                               :row-partial view/model-row
                               :caption (str "Total: " (count data))
                               :fields [:name :url :desc :tags]))
-        (make-table-editable)))))
+        (make-table-editable))
+      :data {:model model})))

 (defn ^:export model-stats []
   (backend-request (path-to "/models")


fix two warnings, one which fixes model show count

--- src/semtag_web/client/main.cljs
+++ src/semtag_web/client/main.cljs
@@ -64,7 +64,7 @@
 (defn- saves-edit [event]
   (.preventDefault event)
   (let [$elem ($ (.-target event))
-        id (.data (jq/parent $elem "tr") "id")
+        id (.data (jq/parent $elem) "id")
         field (.data $elem "field")
         value (jq/text $elem)]
     (.blur $elem)
@@ -175,7 +175,7 @@
         (create-sort-table ($ :#model_show_box)
               (generate-table "model_show_table" data
                               :row-partial view/model-row
-                              :caption (str "Total: " (count %))
+                              :caption (str "Total: " (count data))
                               :fields [:name :url :desc :tags]))
         (make-table-editable)))))


use master branch for meta pipeline

use master branch for meta pipeline

--- src/devops_101_pipeline/meta/steps.clj
+++ src/devops_101_pipeline/meta/steps.clj
@@ -5,7 +5,7 @@
             [lambdacd.steps.git :as git]))

 (def devops-101-repo "https://github.com/flosell/devops-101-lambdacd.git") ;; change this if you want to make your own changes
-(def devops-101-branch "digitalocean")
+(def devops-101-branch "master")
 (defn wait-for-repo [_ ctx]
   (git/wait-for-git ctx devops-101-repo devops-101-branch))


Added a tiny refactoring of code that generates elided description of
columns in error messages.

(if (seq foo)) is more idiomatic than (if (not (empty? foo)))

--- src/tabular/grafter/tabular.clj
+++ src/tabular/grafter/tabular.clj
@@ -144,10 +144,14 @@
         val
         ::not-found))))

-(defn- elided-col-description [coll]
-  (let [[examples more] (take 2 (partition 3 3 nil coll))
+(defn- elided-col-description
+  "Print elided descriptions of columns for error messages with a sample set and
+  the rest hidden behind an elipsis, e.g. \":one, :two, :three ...\""
+  [coll]
+  (let [[examples more] (take 2 (partition-all 3 coll))
         csv (str/join ", " examples)
-        ellision (if (not (nil? more)) " ..." nil)]
+        ellision (when (seq more)
+                   " ...")]
     (str csv ellision)))

 (defn columns
@@ -171,7 +175,7 @@
                                    (map (partial col-position col-names)))
         valid-positions (filterv #(not= ::not-found %) matched-col-positions)
         selected-cols (map #(nth col-names %) valid-positions)]
-    (if (not (empty? selected-cols))
+    (if (seq selected-cols)
       (all-columns dataset selected-cols)
       (throw (IndexOutOfBoundsException. (str "The columns: "
                                               (elided-col-description cols)


added filtering module

added filtering module

--- src/crawler/rich_char_extractor.clj
+++ src/crawler/rich_char_extractor.clj
@@ -4,7 +4,9 @@

 (defn leaf?
   [src-num target-num]
-  (<= 0.5 (/ target-num src-num)))
+  (and
+   (-> src-num nil? not)
+   (<= 0.5 (/ target-num src-num))))

 (defn state-action
   "Args:
@@ -33,7 +35,7 @@
                                                (not (some #{href} template-links)))
                                              infos)]))
                                  xpaths-hrefs-text)
-
+
            xpaths-anchors-chars (map
                                  (fn [[xpath nodes]]
                                    [xpath (map
@@ -71,14 +73,28 @@
                                                (+ acc (:num-chars an-info)))
                                              0
                                              info)
-
+
                                      :hrefs (reduce
                                              (fn [acc an-info]
                                                (cons (:href an-info) acc))
                                              '()
                                              info)})
                                   xpaths-anchors-chars))]
-
+
        {:total-nav-info page-wide-nav-chars
         :xpath-nav-info (sort-by :score xpath-nav-info)})))

+(defn filter-content
+  "Helper routine you can use to filter
+   content that the extractor mined.
+   Threshold determined by training"
+  [content]
+  (filter
+   (fn [x]
+     (->> x :score (<= 0.1)))
+   (map
+    (fn [{xpath :xpath score :score hrefs :hrefs}]
+      {:xpath xpath
+       :score (/ score (:total-nav-info content))
+       :hrefs hrefs})
+    (:xpath-nav-info content))))


[PDOK-1021] emits meta close-all feature for current nested features * {:action :close-all, :collection VALUE :parent-id VALUE :end-time VALUE} * not implemented yet

--- src/main/clojure/pdok/featured/processor.clj
+++ src/main/clojure/pdok/featured/processor.clj
@@ -59,7 +59,7 @@
                   (assoc! :dataset dataset)
                   (assoc! :parent-collection collection)
                   (assoc! :parent-id id)
-                  (assoc! :action action)
+                  (assoc! :action :new)
                   (assoc! :id child-id)
                   (assoc! :validity validity)
                   (assoc! :collection (str collection "$" (name child-collection-key))))]
@@ -79,22 +79,30 @@
                      (assoc! :dataset dataset)
                      (assoc! :parent-collection collection)
                      (assoc! :parent-id id)
-                     (assoc! :collection (str collection "$" child-collection-key))
-                     (assoc! :action action)
+                     (assoc! :collection (str collection "$" (name child-collection-key)))
+                     (assoc! :action :new)
                      (assoc! :id child-id)
                      (assoc! :validity validity)
                      (assoc! :attributes (merge (:attributes child) parent-attributes)))]
    (persistent! enriched) ))
+
+(defn- meta-close-all-features [features]
+  (let [grouped (group-by #(select-keys % [:dataset :collection :parent-id :validity]) features)]
+    (letfn [(meta [d col pid v] {:action :close-all, :dataset d, :collection col, :parent-id pid :end-time v})]
+      (map (fn [[{:keys [dataset collection parent-id validity]} _]]
+             (meta dataset collection parent-id validity)) grouped)
+      )))

 (defn- flatten-with-geometry [feature]
   (let [attributes (:attributes feature)
         nested (nested-features attributes)
         without-nested (apply dissoc attributes (map #(first %) nested))
         flat (assoc feature :attributes without-nested)
-        linked-nested (map #(link-parent % feature) nested)]
+        linked-nested (map #(link-parent % feature) nested)
+        close-all (meta-close-all-features linked-nested)]
     (if (empty? linked-nested)
       flat
-      (cons flat linked-nested))
+      (cons flat (concat close-all linked-nested)))
     )
   )

@@ -103,10 +111,11 @@
   (let [attributes (:attributes feature)
         nested (nested-features attributes)
         attributes-without-nested (apply dissoc attributes (map #(first %) nested))
-        enriched-nested (map #(enrich % feature attributes-without-nested) nested)]
+        enriched-nested (map #(enrich % feature attributes-without-nested) nested)
+        close-all (meta-close-all-features enriched-nested)]
     (if (empty? enriched-nested)
       (assoc feature :action :drop)
-      enriched-nested))
+      (concat close-all enriched-nested)))
   )

 (defn- flatten [feature]
@@ -124,9 +133,6 @@
         no-attributes (select-keys feature pdok-fields)]
     (assoc no-attributes :attributes collected)))

-;; TODO parent velden persisten
-;; TODO change flatten moet nested closen bij nested met geometry
-;; TODO alles wijzigen bij change bij nested zonder geometry
 (defn process [processor feature]
   "Processes feature event. Returns nil or error reason"
   (let [flat-feature (flatten (collected-attributes feature))]
@@ -136,6 +142,7 @@
           (condp = (:action feature)
             :new (process-new-feature processor flat-feature)
             :change (process-change-feature processor flat-feature)
+            :close-all nil
             (str "Cannot process: " flat-feature))))))

 (defn shutdown [{:keys [persistence projectors]}]


Set objects properly, not with aset

Set objects properly, not with aset

--- src/day8/re_frame/trace/events.cljs
+++ src/day8/re_frame/trace/events.cljs
@@ -5,6 +5,7 @@
             [day8.re-frame.trace.utils.localstorage :as localstorage]
             [clojure.string :as str]
             [reagent.core :as r]
+            [goog.object]
             [re-frame.db]
             [day8.re-frame.trace.components.container :as container]
             [day8.re-frame.trace.styles :as styles]))
@@ -49,7 +50,7 @@
   (let [app (.getElementById popup-document "--re-frame-trace--")
         doc js/document]
     (styles/inject-trace-styles popup-document)
-    (aset popup-window "onunload" #(rf/dispatch [:global/external-closed]))
+    (goog.object/set popup-window "onunload" #(rf/dispatch [:global/external-closed]))
     (r/render
       [(r/create-class
          {:display-name   "devtools outer external"
@@ -67,7 +68,7 @@
         d (.-document w)]
     (.open d)
     (.write d "

")
-    (aset w "onload" #(mount w d))
+    (goog.object/set w "onload" #(mount w d))
     (.close d)))

 (rf/reg-event-fx


uniform fix

uniform fix

--- src/gamma_driver/drivers/basic.cljs
+++ src/gamma_driver/drivers/basic.cljs
@@ -28,7 +28,7 @@

 (defn default-input-fn [driver program binder-fn variable old-spec new-spec]
   (let [t (:tag new-spec)]
-    (if (and old-spec new-spec (= (old-spec t) (new-spec t)))
+    (if (and old-spec new-spec (not= :uniform new-spec) (= (old-spec t) (new-spec t)))
       new-spec
       (binder-fn (gd/gl driver) program variable new-spec))))


add scm info to pom task, set `:ensure-clean` to false

--- build.boot
+++ build.boot
@@ -36,7 +36,9 @@

 (task-options!
   pom {:project 'compassus
-       :version +version+})
+       :version +version+
+       :scm {:url "https://github.com/anmonteiro/compassus"}}
+  push {:ensure-clean false})

 (deftask build-jar []
   (set-env! :resource-paths #{"src/main"})


set-env! vals can be functions

set-env! vals can be functions

--- build.boot
+++ build.boot
@@ -36,8 +36,7 @@
 (deftask development
   "watch and compile cljx, css, cljs, init cljs-repl and push changes to browser"
   []
-  (let [src (:source-paths (get-env))]
-    (set-env! :source-paths (conj src "dev" "examples")))
+  (set-env! :source-paths #(conj % "dev" "examples"))
   (apply set-refresh-dirs (get-env :source-paths))
   (comp (serve :dir "target")
         (watch)


Indent.

Indent.

--- src/videotest/falling/fall_core.clj
+++ src/videotest/falling/fall_core.clj
@@ -90,7 +90,7 @@
                          (assoc-in memo [coords] (cam->color col row)))
                        {}
                        (keys triangle-points))]
-   (assoc-in state [:color-record] colors)))
+    (assoc-in state [:color-record] colors)))

 (defn draw-mosaic
   [tri-points tri-glyphs drawn-mat color-record [col row :as coords]]


Add to pollock blog post

Add to pollock blog post

This includes:
   - Switching the metre->pixel code to use the width of the canvas and
     the width of the space,
   - A whole bunch of writing
   - Switching starting-point to use map
   - Picking colours out of number 8 pallete and using them to render

--- src/uk/co/tombooth/pollock.cljs
+++ src/uk/co/tombooth/pollock.cljs
@@ -2,49 +2,110 @@
   (:require [quil.core :as q :include-macros true]))

 ;; ---
-;; title: Painting by Clojure
+;; title: Painting in Clojure
 ;; ...

-;; Learning Clojure by build a digital Jackson Pollock.
-
-
-;; <canvas id="pollock"></canvas>
+;; Learning Clojure by building a digital Jackson Pollock.
+
+
+;; <canvas id="pollock" style="width: 100%; border: 5px solid #eee"></canvas>
 ;; <button id="add">Add stroke</button>
 ;; <button id="fill">Fill canvas</button>

-;; Dimensions of space
+
+;; ## Setting the scene
+
+;; We want to define some facts about the space that our digital
+;; Pollock will work in. Clojure will let us define facts using one of
+;; the following value types:
+;;
+;;    - Number
+;;       + 102
+;;       + 1.5
+;;       + 1/2
+;;    - String ""
+;;    - List (...). You may notice all of the code written takes for
+;;      form of lists. By default if you have written (...) Clojure
+;;      will assume the first item is a function and the rest are
+;;      arguments to be passed in. In order for the list not to be
+;;      executed you should prefix it with a '.
+;;    - Vector [...]. A lot like a list except they are optimised for
+;;      appending to the end of the list rather than the front
+;;    - Hash Map
+;;    - Hash Set
+
+;; The most important fact about the space is its size. We will use
+;; metres to measure the size only converting to pixels when we need
+;; to draw to the screen. We are going to define size as a vector
+;; containing its width, height and depth.

 (def space [8   ;; width
             5   ;; height
             6]) ;; depth

-(def pixels-per-metre 100)
-
-;; How would you convert from metres to pixels?
-
-(defn metres-to-pixels [metres]
-  (* metres pixels-per-metre))
-
-;; Mainly want to be working in pixels so store the space in pixels
-
-(def space-in-pixels (map metres-to-pixels space))
-
-;; We need to pick a place to start the stroke. It will be somewhere
-;; inside of the space
-
-(defn starting-point []
-  (let [[width height depth] space]
-    [(rand width)
-     (rand height)
-     (rand depth)]))
+;; We need to know the gravity of the space so it can influence the
+;; flow of paint as it leaves the brush. This will be defined as a
+;; vector that represents acceleration influenced by gravity.
+
+(def gravity [0 -9.8 0])
+
+;; Lastly, we need to know the normal of the surface of the canvas that
+;; the paint will impact with. This will be used to dictate how paint
+;; acts when it spatters from the impact with the canvas. (Maybe it
+;; should be used to define what the coords are that the paint has to
+;; impact with, it doesn't at the moment)
+
+(def canvas-normal [0 1 0])
+
+
+
+
+
+
+
+;; ## Starting points and projection
+
+;; Our digital Pollock is going to start a stroke of the brush by
+;; picking a random point in space. This point will then be projected
+;; to find where it impacts with the canvas.
+
+;; In order to generate a random point inside of the space we need to
+;; define a function that each time it is called will emit a vector
+;; containing the position of the point. Function values can be
+;; created by calling `(fn [...] ...)` with the first vector being the
+;; arguments the function should receive and any follow items in the
+;; list are the body of the function and executed with the arguments
+;; bound. Rather than calling `(def name (fn ...))` Clojure has provided a
+;; shortcut function `(defn name [...] ...)`. An example of a defined
+;; function is `(defn say-hello [name] (str "Hello " name))`, this
+;; creates a function called say-hello that when called `(say-hello
+;; "James")` it will return the string "Hello James".
+
+;; We are going to cover a common functional idiom when dealing with
+;; lists to change the dimensions of the space above into a random
+;; point inside that space. To do this we want to iterate over each
+;; dimension of the size of space, generate a random number between 0
+;; and the magnitude of each dimension and then return the resultant
+;; list of random numbers as a list. To generate a random number in
+;; Clojure we can use the `(rand)` function, which will return a
+;; random number between 0 (inclusive) and 1 (exclusive). The rand
+;; function can take an optional parameter `(rand 100), this will
+;; define the bounds of the number generated to 0 and 100.
+
+;; The function map `(map [fn] [sequence])` will iterate through the
+;; sequence executing the function with the current value of the
+;; sequence as its first parameter, the values returned from the
+;; function will be stored in a list the same length as the sequence
+;; and returned by the function.
+
+;; We can now define a random point inside of space as follows
+
+(defn starting-point [] (map rand space))

 ;; To start off with lets assume that the paint is falling and has 0
 ;; velocity of its own when it starts from the brush
-
-;; We need to know gravity, measured in metres per second
-(def gravity [0 -9.8 0])

 ;; we need to know the amount of time it is going to take the paint to
@@ -111,7 +172,13 @@
      projected-velocity]))

-;; splatter
+
+
+
+
+
+;; ## Paint splatter
+
 ;; now that we know the impact velocity of a point, we know need to
 ;; work out whether that impact should splatter

@@ -154,8 +221,6 @@
 ;;
 ;;  R = V - (2 * (V.N) * N)

-(def canvas-normal [0 1 0])
-
 ;; dot product is he sum of the multiples of the dimensions

 (defn dot-product [vector1 vector2]
@@ -187,7 +252,12 @@
                                  splatter-dampening-constant)))

-;; doing paths
+
+
+
+
+;; ## Paths vs Points
+
 ;; having all the code for dealing with a point is all well and good,
 ;; but we need to be dealing with paths

@@ -277,6 +347,13 @@
   (map (fn [[i j k]] [i (if (< j 0) 0 j) k]) path))

+
+
+
+
+
+;; ## Motion, going through the paces
+
 ;; all the points along the generated path should have an associated
 ;; velocity. To start with we can generate a linear velocity along the
 ;; path, given a randomised total time to traverse the path and the
@@ -342,13 +419,34 @@
     (take number-of-points (range initial-mass 0 step))))

+
+
+
+
+;; ## Putting it all together
+
+;; I've pulled a bunch of colours that Pollock used in his seminal
+;; work "Number 8" so that each flick of paint can be rendered in a
+;; random colour out of this pallete
+
+(def canvas-colour [142 141 93])
+
+(def paint-colours
+  [[232 51 1]
+   [248 179 10]
+   [247 239 189]
+   [29 16 8]])
+
+(defn pick-a-colour []
+  (nth paint-colours (rand-int (count paint-colours))))
+
 ;; now we need to assemble all of the above functions into something
 ;; that will work out everything

-(defn do-the-things []
+(defn fling-paint []
   (let [position       (starting-point)
         total-time     (random-between 1 5)
-        path           (ensure-above-canvas (de-casteljau (anchor-points position 0.1 2 3 15 0.4) 0.005))
+        path           (ensure-above-canvas (de-casteljau (anchor-points position 0.1 2 3 15 0.4) 0.01))
         velocities     (path-velocities path total-time)
         masses         (path-masses path (random-between 5 30))
         projected-path (map #(project-point %1 %2) path velocities)
@@ -362,21 +460,71 @@
                                     nil
                                     (conj (vec (project-point position velocity)) mass)))
                                 splatter)]
-    {:air path
-     :path (map #(conj %1 %2) projected-path masses)
+    {:colour (pick-a-colour)
+     :air-path path
+     :canvas-path (map #(conj %1 %2) projected-path masses)
      :splatter (filter #(not-any? nil? %) (partition-by nil? projected-splatter))}))

-;; lets draw these things
+
+
+
+
+;; ## Rendering the canvas
+
+;; We need to know the available size for the outputted image to fit
+;; in. To work this out we are going to have to interface with
+;; JavaScript directly. Luckily ClojureScript makes this very easy
+;; using the js namespace.
+
+(def image-width (.-clientWidth (.querySelector js/document "#pollock")))
+
+;; Now we have the width of the image we can use the dimensions of the
+;; space to work out the pixel size of the image and how to convert
+;; between metres and pixels.
+
+(def pixels-in-a-metre
+  (let [[width _ _] space]
+    (/ image-width width)))
+
+(defn metres-to-pixels [metres]
+  (Math/floor (* metres pixels-in-a-metre)))
+
+;; We can now use this function to work out the size the sketch should
+;; be and how to convert a position in metres over to a position to be
+;; drawn in the image.

 (def sketch-size
-  (let [[width _ height] space-in-pixels]
-    [width height]))
+  (let [[width _ height] space]
+    [(metres-to-pixels width)
+     (metres-to-pixels height)]))

 (defn position-to-pixel [[i j k]]
-  [(Math/floor (metres-to-pixels i))
-   (Math/floor (metres-to-pixels k))])
-
+  [(metres-to-pixels i)
+   (metres-to-pixels k)])
+
+
+;; Now the dimensions of the image our calculated we can use Quil to
+;; define the sketch that we will draw into. We also need to define a
+;; function that will initialise the image into the state we want it.
+;; This function will be run when the sketch is defined.
+
+(defn setup-image []
+  (apply q/background canvas-colour)
+  (q/fill 0))
+
+(q/defsketch pollock
+  :setup setup-image
+  :host "pollock"     ;; the id of the <canvas> element
+  :size sketch-size)
+
+;; To draw the trails of paint across the canvas we need draw a path
+;; following the defined positions, which takes into account the
+;; amount of paint at each position and uses this to set with width of
+;; the path. In order to do this cleanly in Quil we need to consider
+;; the path as pairs of positions that we shall draw paths between
+;; using the initial paint amount as the stroke-weight. This allows
+;; for a smooth decrease in the width of the path.

 (defn draw-path [path]
   (doall
@@ -385,32 +533,32 @@
             (apply q/line (concat (position-to-pixel position1) (position-to-pixel position2))))
           path)))

+;; For splatter we are just going to draw a point that has a stroke-weight
+;; proportional to the amount of paint.
+
 (defn draw-splats [path]
   (doall (map (fn [[position _ mass]]
                 (q/stroke-weight mass)
                 (apply q/point (position-to-pixel position)))
               path)))

-(defn make-shape [& any]
+;; Now that we can render the result of flinging some paint around we
+;; need a function that will fling the paint and render the result.
+
+(defn fling-and-render [& any]
   (q/with-sketch (q/get-sketch-by-id "pollock")
-    (let [{:keys [path splatter] :as path-hash} (do-the-things)]
-      (.log js/console (clj->js path-hash))
-      (q/stroke (q/color (rand-int 256) (rand-int 256) (rand-int 256)))
-      (draw-path path)
+    (let [{:keys [colour canvas-path splatter]} (fling-paint)]
+      (q/stroke (apply q/color colour))
+      (draw-path canvas-path)
       (doall (map draw-splats splatter)))))

-(defn draw []
-  (q/background 255)
-  (q/fill 0))
-
-(q/defsketch pollock
-  :setup draw
-  :host "pollock"
-  :size sketch-size)
+
+;; Lastly, we shall attach to the buttons and cause our image to come
+;; to life.

 (.addEventListener (.querySelector js/document "#add")
                    "click"
-                   make-shape)
+                   fling-and-render)

 (def interval-ref (atom nil))
 (def fill-count (atom 0))
@@ -421,5 +569,5 @@
                              (js/setInterval (fn []
                                                (if (> @fill-count 500)
                                                  (js/clearInterval @interval-ref)
-                                                 (do (make-shape) (swap! fill-count inc)))) 100))))
-
+                                                 (do (fling-and-render) (swap! fill-count inc)))) 100))))
+


make the tests pass again

make the tests pass again

--- test/flambo/api_test.clj
+++ test/flambo/api_test.clj
@@ -80,19 +80,18 @@
       "map-to-pair returns an RDD of (K, V) pairs formed by passing each element of the source
         RDD through a pair function"
       (-> (f/parallelize c ["a" "b" "c" "d"])
-          (f/map-to-pair (f/fn [x] [x 1]))
+          (f/map-to-pair (f/fn [x] (ft/tuple x 1)))
           (f/map f/untuple)
           f/collect
           vec) => [["a" 1] ["b" 1] ["c" 1] ["d" 1]])

      (fact
       "reduce-by-key returns an RDD of (K, V) when called on an RDD of (K, V) pairs"
-      (-> (f/parallelize c [["key1" 1]
-                            ["key1" 2]
-                            ["key2" 3]
-                            ["key2" 4]
-                            ["key3" 5]])
-          (f/map-to-pair identity)
+      (-> (f/parallelize-pairs c [(ft/tuple "key1" 1)
+                                  (ft/tuple "key1" 2)
+                                  (ft/tuple "key2" 3)
+                                  (ft/tuple "key2" 4)
+                                  (ft/tuple "key3" 5)])
           (f/reduce-by-key (f/fn [x y] (+ x y)))
           (f/map f/untuple)
           f/collect
@@ -116,16 +115,16 @@

      (fact
       "join returns an RDD of (K, (V, W)) pairs with all pairs of elements of each key when called on RDDs of type (K, V) and (K, W)"
-      (let [LDATA (f/parallelize c [["key1" [2]]
-                                    ["key2" [3]]
-                                    ["key3" [5]]
-                                    ["key4" [1]]
-                                    ["key5" [2]]])
-            RDATA (f/parallelize c [["key1" [22]]
-                                    ["key3" [33]]
-                                    ["key4" [44]]])
+      (let [LDATA (f/parallelize-pairs c [(ft/tuple "key1" [2])
+                                          (ft/tuple "key2" [3])
+                                          (ft/tuple "key3" [5])
+                                          (ft/tuple "key4" [1])
+                                          (ft/tuple "key5" [2])])
+            RDATA (f/parallelize-pairs c [(ft/tuple "key1" [22])
+                                          (ft/tuple "key3" [33])
+                                          (ft/tuple "key4" [44])])
             ]
-        (-> (f/join (f/map-to-pair LDATA identity) (f/map-to-pair RDATA identity))
+        (-> (f/join LDATA RDATA)
             (f/map f/double-untuple)
             f/collect
             vec)) => (just [["key3" [[5] [33]]]
@@ -134,15 +133,15 @@

      (fact
       "left-outer-join returns an RDD of (K, (V, W)) when called on RDDs of type (K, V) and (K, W)"
-      (let [LDATA (f/parallelize c [["key1" [2]]
-                                    ["key2" [3]]
-                                    ["key3" [5]]
-                                    ["key4" [1]]
-                                    ["key5" [2]]])
-            RDATA (f/parallelize c [["key1" [22]]
-                                    ["key3" [33]]
-                                    ["key4" [44]]])]
-        (-> (f/left-outer-join (f/map-to-pair LDATA identity) (f/map-to-pair RDATA identity))
+      (let [LDATA (f/parallelize-pairs c [(ft/tuple "key1" [2])
+                                          (ft/tuple "key2" [3])
+                                          (ft/tuple "key3" [5])
+                                          (ft/tuple "key4" [1])
+                                          (ft/tuple "key5" [2])])
+            RDATA (f/parallelize-pairs c [(ft/tuple "key1" [22])
+                                          (ft/tuple "key3" [33])
+                                          (ft/tuple "key4" [44])])]
+        (-> (f/left-outer-join LDATA RDATA)
             ;; how to unwrap a left-outer-join
             (f/map (f/fn [t]
                      (let [[x t2] (f/untuple t)
@@ -170,10 +169,9 @@
      (fact
       "combine-by-key returns an RDD by combining the elements for each key using a custom
         set of aggregation functions"
-      (-> (f/parallelize c [["key1" 1]
-                            ["key2" 1]
-                            ["key1" 1]])
-          (f/map-to-pair identity)
+      (-> (f/parallelize-pairs c [(ft/tuple "key1" 1)
+                                  (ft/tuple "key2" 1)
+                                  (ft/tuple "key1" 1)])
           (f/combine-by-key identity + +)
           (f/map f/untuple)
           f/collect
@@ -181,10 +179,10 @@

      (fact
       "sort-by-key returns an RDD of (K, V) pairs sorted by keys in asc or desc order"
-      (-> (f/parallelize c [[2 "aa"]
-                            [5 "bb"]
-                            [3 "cc"]
-                            [1 "dd"]])
+      (-> (f/parallelize-pairs c [(ft/tuple 2 "aa")
+                                  (ft/tuple 5 "bb")
+                                  (ft/tuple 3 "cc")
+                                  (ft/tuple 1 "dd")])
           (f/sort-by-key compare false)
           (f/map f/untuple)
           f/collect
@@ -207,12 +205,11 @@

      (fact
       "group-by-key"
-      (-> (f/parallelize c [["key1" 1]
-                            ["key1" 2]
-                            ["key2" 3]
-                            ["key2" 4]
-                            ["key3" 5]])
-          (f/map-to-pair identity)
+      (-> (f/parallelize-pairs c [(ft/tuple "key1" 1)
+                                  (ft/tuple "key1" 2)
+                                  (ft/tuple "key2" 3)
+                                  (ft/tuple "key2" 4)
+                                  (ft/tuple "key3" 5)])
           f/group-by-key
           (f/map f/group-untuple)
           f/collect
@@ -222,7 +219,7 @@
       "flat-map-to-pair"
       (-> (f/parallelize c [["Four score and seven"]
                             ["years ago"]])
-          (f/flat-map-to-pair (f/fn [x] (map (fn [y] [y 1])
+          (f/flat-map-to-pair (f/fn [x] (map (fn [y] (ft/tuple y 1))
                                              (clojure.string/split (first x) #" "))))
           (f/map f/untuple)
           f/collect
@@ -270,12 +267,11 @@

      (fact
       "count-by-key returns a hashmap of (K, int) pairs with the count of each key; only available on RDDs of type (K, V)"
-      (-> (f/parallelize c [["key1" 1]
-                            ["key1" 2]
-                            ["key2" 3]
-                            ["key2" 4]
-                            ["key3" 5]])
-          (f/map-to-pair identity)
+      (-> (f/parallelize-pairs c [(ft/tuple "key1" 1)
+                                  (ft/tuple "key1" 2)
+                                  (ft/tuple "key2" 3)
+                                  (ft/tuple "key2" 4)
+                                  (ft/tuple "key3" 5)])
           (f/count-by-key)) => {"key1" 2 "key2" 2 "key3" 1})

      (fact
@@ -289,12 +285,11 @@

      (fact
       "values returns the values (V) of a hashmap of (K, V) pairs from a JavaPairRDD"
-      (-> (f/parallelize c [["key1" 11]
-                            ["key1" 11]
-                            ["key2" 12]
-                            ["key2" 12]
-                            ["key3" 13]])
-          (f/map-to-pair identity)
+      (-> (f/parallelize-pairs c [(ft/tuple "key1" 11)
+                                  (ft/tuple "key1" 11)
+                                  (ft/tuple "key2" 12)
+                                  (ft/tuple "key2" 12)
+                                  (ft/tuple "key3" 13)])
           (f/values)
           (f/collect)
           vec) => [11 11 12 12 13])


Handle seal-task too.

Handle seal-task too.

--- src/clj/onyx_dashboard/http/server.clj
+++ src/clj/onyx_dashboard/http/server.clj
@@ -64,43 +64,58 @@
         (let [entry (extensions/read-log-entry log position)
               new-replica (try (extensions/apply-log-entry entry replica)
                                (catch Throwable t
+                                 ; Send a crashy message via sente here
                                  (error (str "Could not apply log entry: " entry) t)
                                  (throw t)))
               diff (extensions/replica-diff entry replica new-replica)
               job-id (:job (:args entry))
               ;complete-tasks (get (:completions new-replica) job-id)
               tasks (get (:tasks new-replica) job-id)]
-          (case (:fn entry)
-            :submit-job (let [job-id (:id (:args entry))
-                              catalog (extensions/read-chunk log :catalog job-id)
-                              workflow (extensions/read-chunk log :workflow job-id)]
-                          (send-fn! uid [:job/submitted-job {:tracking-id tracking-id
-                                                             :id job-id
-                                                             :entry entry
-                                                             :catalog catalog
-                                                             :pretty-catalog (with-out-str (fipp (into [] catalog)))
-                                                             :pretty-workflow (with-out-str (fipp (into [] workflow)))
-                                                             :created-at (:created-at entry)}]))
-            ; TODO: check if newly submitted jobs will result in peer assigned messages being sent.
-            :volunteer-for-task (let [peer-id (:id (:args entry))
-                                      task (task-allocated-to-peer (:allocations new-replica) peer-id)]
-                                  (when task
-                                    (send-fn! uid
-                                              [:job/peer-assigned {:tracking-id tracking-id
-                                                                   :job (:job task)
-                                                                   :task (:task task)
-                                                                   :peer peer-id}])))
-
-            :complete-task (let [task (extensions/read-chunk log :task (:task (:args entry)))
-                                 task-name (:name task)]
-                             (send-fn! uid [:job/completed-task {:tracking-id tracking-id
-                                                                 :name task-name}]))
-            (info "Unable to custom handle entry"))
+          ; Split into multimethods
+          (cond (= :submit-job (:fn entry))
+                (let [job-id (:id (:args entry))
+                      catalog (extensions/read-chunk log :catalog job-id)
+                      workflow (extensions/read-chunk log :workflow job-id)]
+                  (send-fn! uid [:job/submitted-job {:tracking-id tracking-id
+                                                     :id job-id
+                                                     :entry entry
+                                                     :catalog catalog
+                                                     :pretty-catalog (with-out-str (fipp (into [] catalog)))
+                                                     :pretty-workflow (with-out-str (fipp (into [] workflow)))
+                                                     :created-at (:created-at entry)}]))
+                ; TODO: check if newly submitted jobs will result in peer assigned messages being sent.
+                ; This might be doing more work than required
+                (= :volunteer-for-task (:fn entry))
+                (let [peer-id (:id (:args entry))
+                      task (task-allocated-to-peer (:allocations new-replica) peer-id)
+                      ;task-chunk (extensions/read-chunk log :task (:task task))
+                      ]
+                  (try (extensions/read-chunk log :task (:task task))
+                       (println "Replica " replica)
+                       (catch Exception e (println " Couldn't read " e)))
+                  (when task
+                    (send-fn! uid [:job/peer-assigned {:tracking-id tracking-id
+                                                       :job (:job task)
+                                                       ;:name (:name task-chunk)
+                                                       :task (:task task)
+                                                       :peer peer-id}])))
+
+                (#{:seal-task :complete-task} (:fn entry))
+                (let [task (extensions/read-chunk log :task (:task (:args entry)))
+                      task-name (:name task)]
+                  (send-fn! uid [:job/completed-task {:tracking-id tracking-id
+                                                      :job (:job (:args entry))
+                                                      ;:task-data task
+                                                      :task (:id task)
+                                                      :name task-name}]))
+                :else
+                (println "Unable to custom handle entry " entry))
           (send-fn! uid [:job/entry (assoc entry :tracking-id tracking-id)])
           (reset! up-to-date? false)
           ;(send-fn! uid [:deployment/replica {:replica new-replica :diff diff}])
           (recur new-replica))
         (do
+          ; send current max id with it
           (send-fn! uid [:deployment/up-to-date {:tracking-id tracking-id}])
           (reset! up-to-date? true)
           (recur replica))))))


more boid functionality

more boid functionality

--- src/cljs/infinitelives/utils/boid.cljs
+++ src/cljs/infinitelives/utils/boid.cljs
@@ -58,3 +58,44 @@
                  (* 4)                  ; 4 = c (T=Dc)
                  (vec2/scale target-vel)
                  (vec2/add target))))
+
+;;
+;; wander helpers
+;;
+(defn constrain
+  "old-poss is the last position constrained to the circle
+  delta is a vector of the change
+  center is the circles center
+  radius is the radius of the circle
+  returns the vector from the boid to the new point on the circle.
+  "
+  [pos center radius]
+  (-> pos
+      (vec2/sub center)
+      (vec2/unit)
+      (vec2/scale radius)
+      (vec2/add center)))
+
+(defn wander [{:keys [mass pos vel max-force max-speed last-steer]
+               :as boid}
+              d r delta]
+  (let [last-steer (or last-steer
+                       ;; front of circle to initialise
+                       (vec2/vec2 (+ d r) 0))
+        delta-vec (-> (vec2/random-unit)
+                      (vec2/scale delta))
+        new-steer (-> last-steer
+                      (vec2/add delta-vec)
+                      (constrain (vec2/vec2 d 0) r))
+        direction (if (vec2/almost (vec2/zero) vel)
+                    (vec2/random-unit)
+                    (vec2/unit vel))
+
+        ;; rotate into frame of reference of boid heading
+        rotated-new-steer (vec2/rotate new-steer (vec2/heading direction))
+        steering (-> rotated-new-steer
+                     (vec2/sub vel)
+                     (vec2/truncate max-force))]
+    (assoc
+     (apply-steering boid steering)
+     :last-steer steering)))


simplify name transforming in cljsdoc

simplify name transforming in cljsdoc

--- src/cljs_api_gen/cljsdoc/transform.clj
+++ src/cljs_api_gen/cljsdoc/transform.clj
@@ -26,18 +26,6 @@
          (dissoc key-))
      doc)))

-(defn transform-name [doc]
-  (if-let [body (get doc "name")]
-    (let [[full-name & search-terms] (section-as-list body)
-          [ns- name-] (fullname->ns-name full-name)]
-      (-> doc
-          (assoc :ns ns-
-                 :name name-
-                 :full-name full-name
-                 :search-terms (vec search-terms))
-          (dissoc "name")))
-    doc))
-
 (def markdown-sections
   [:summary
    :summary-library
@@ -64,7 +52,7 @@

 (defn transform-doc [doc]
   (-> doc
-      transform-name
+      (transform-key "name" :full-name)
       (transform-key "examples" :examples)
       (transform-key "known as" :known-as)
       (transform-key "display" :display)


partial rewrite deep-trace2

partial rewrite deep-trace2

--- src/com/billpiel/sayid/deep_trace2.clj
+++ src/com/billpiel/sayid/deep_trace2.clj
@@ -1,6 +1,10 @@
 (ns com.billpiel.sayid.deep-trace2
   (require [com.billpiel.sayid.util.other :as util]
            [com.billpiel.sayid.trace :as trace]))
+
+(defn prs
+  [v]
+  (subs (with-out-str (clojure.pprint/pprint v)) 0 1000 ))

 ;; TODO exceptions

@@ -196,29 +200,27 @@

 (defn mk-tree-template
   [src-map fn-meta path parent-path]
-  (let [sub-src-map (-> path
+  (let [sub-src-map (-> #spy/d path
                         path->sym
                         src-map)
-        form (:orig sub-src-map)]
+        form (:orig #spy/d sub-src-map)]
     {:parent-path parent-path
-     :name (if (seq? form)
-             (first form)
-             form)
+     :name #spy/d (if (seq? form)
+                    (first form)
+                    form)
      :form form
      :inner-path path
      :parent-name (:name fn-meta)
      :ns (-> fn-meta :ns str symbol)
-     :arg-forms (-> sub-src-map
-                    :xp
-                    rest)}))
+     :xpanded-parent (:xp sub-src-map)
+     :xpanded-frm (:x sub-src-map)}))

 (defn get-temp-root-parent
   []
   (-> trace/*trace-log-parent*
       (select-keys [:depth :path])
       (assoc :children (atom [])
-             :inner-path nil
-             :return ::placeholder)
+             :inner-path nil)
       atom))

 (declare produce-recent-parent-tree-atom!)
@@ -240,6 +242,10 @@
          (:inner-path @tree-atom)
          tree-atom)
   (when parent-tree-atom
+    (println "vvvvv")
+    #spy/d tree-atom
+    #spy/d parent-tree-atom
+    (println "^^^^^")
     (swap! (-> @parent-tree-atom
                :inner-path
                (@recent-trees)
@@ -253,26 +259,26 @@
   (if (nil? inner-path)
     (let [new-parent (get-temp-root-parent)]
       (assoc-to-recent-trees! new-parent
-                                nil
-                                recent-trees)
+                              nil
+                              recent-trees)
       new-parent)
     (let [new-grandparent (produce-recent-parent-tree-atom! inner-path
-                                                    recent-trees)
+                                                            recent-trees)
           new-parent (-> (trace/mk-tree :parent new-grandparent)
                          (assoc :inner-path inner-path)
                          atom)]
       (assoc-to-recent-trees! new-parent
-                                new-grandparent
-                                recent-trees)
+                              new-grandparent
+                              recent-trees)
       new-parent)))

 (defn produce-recent-tree-atom!
   [inner-path recent-trees]
   (if-let [tree-atom (get-recent-tree-at-inner-path inner-path
-                                                      recent-trees)]
+                                                    recent-trees)]
     tree-atom
     (mk-recent-tree-at-inner-path inner-path
-                                    recent-trees)))
+                                  recent-trees)))

 (defn produce-recent-parent-tree-atom!
   [inner-path recent-trees]
@@ -281,16 +287,17 @@
                                   drop-last
                                   vec)]
     (if-let [parent (get-recent-tree-at-inner-path parent-inner-path
-                                                     recent-trees)]
+                                                   recent-trees)]
       parent
       (mk-recent-tree-at-inner-path parent-inner-path recent-trees))))

-(defn capture-fn
+(defn tr-fn
   [inner-path [recent-trees src-map] template f]
   (fn [& args]
     (let [parent (produce-recent-parent-tree-atom! inner-path
                                                    recent-trees)
           this (-> (trace/mk-tree :parent @parent)
+                   (merge template)
                    (assoc :args (vec args)
                           :arg-map (delay (zipmap (:arg-forms template)
                                                   args))
@@ -305,20 +312,25 @@
                        :return value
                        :throw throw ;;TODO not right
                        :ended-at (trace/now))]
-      (assoc-to-recent-trees! (atom this')
+      (assoc-to-recent-trees! #spy/d (atom this')
                               parent
                               recent-trees)
       value)))

 (defn tr-macro
-  [path [recent-trees] mcro v]
+  [path [recent-trees] template mcro v]
+  (def rt' @recent-trees)
+
   (let [tree-atom (produce-recent-tree-atom! path
-                                    recent-trees)])
-  (swap!
-         assoc
-         :return v
-         :inner-tags [:macro mcro])
-  v)
+                                             recent-trees)]
+
+    (swap! (@recent-trees path)
+           assoc
+           :return v
+           :inner-tags [:macro mcro])
+
+
+    v))

 (defn tr-if-ret
   [path [recent-trees] v]
@@ -354,7 +366,7 @@

 (defn xpand-fn-form
   [head form path template]
-  (cons (list `capture-fn
+  (cons (list `tr-fn
               path
               '$$
               `'~template
@@ -395,6 +407,11 @@

 (defn xpand-fn
   [head form src-map fn-meta path parent-path]
+  #spy/d head
+  #spy/d form
+  #spy/d path
+  #spy/d parent-path
+
   (xpand-fn-form head
                  (xpand-all form
                             src-map
@@ -460,7 +477,7 @@
        ~'$return)))

 #(do
-   (def form1 '(-> 1 inc keyword))
+   (def form1 '(-> 1 inc str))

    (-/p (xpand form1 {:name "name1" :ns "ns1"} ))

@@ -545,8 +562,9 @@

 (defn record-trace-tree
   [[log src-map]]
-(-/p log)
-  #_ (loop [[head & body] log
+  (-/p (@log nil))
+  (def log' @log)
+#_  (loop [[head & body] log
          tree-map {}
          mailbox {}]
     (if head


Message queue: code formatting

Message queue: code formatting

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -174,38 +174,43 @@
 (defn handle1 "Implementation detail!"
   [conn-opts qname handler [mid mcontent attempt :as poll-reply]]
   (when (and poll-reply (not= poll-reply "eoq-backoff"))
-    (let [qk   (partial qkey qname)
-          done (fn [status mid & [backoff-ms]]
-                 ;; TODO Switch to Lua script
-                 (car/atomic conn-opts 100
-                   (car/watch (qk :requeue))
-                   (let [requeue?
-                         (car/with-replies (->> (car/sismember (qk :requeue) mid)
-                                                (car/parse-bool)))
-                         status (if (and (= status :success) requeue?)
-                                  :requeue status)]
-                     (car/multi)
-                     (when backoff-ms ; Retry or dedupe backoff, depending on type
-                       (car/hset (qk :backoffs) mid (+ (enc/now-udt) backoff-ms)))
-
-                     (car/hdel (qk :locks) mid)
-                     (case status
-                       (:success :error) (car/sadd (qk :done) mid)
-                       :requeue          (do (car/srem (qk :requeue)   mid)
-                                             (car/hdel (qk :nattempts) mid))
-                       nil))))
-
-          error (fn [mid poll-reply & [throwable]]
-                  (done :error mid)
-                  (timbre/errorf
-                    (if throwable throwable
-                      (ex-info ":error handler response" {}))
-                    "Error handling %s queue message:\n%s" qname poll-reply))
+    (let [qk (partial qkey qname)
+          done
+          (fn [status mid & [backoff-ms]]
+            ;; TODO Switch to Lua script
+            (car/atomic conn-opts 100
+              (car/watch (qk :requeue))
+              (let [requeue?
+                    (car/with-replies (->> (car/sismember (qk :requeue) mid)
+                                           (car/parse-bool)))
+                    status (if (and (= status :success) requeue?)
+                             :requeue status)]
+                (car/multi)
+                (when backoff-ms ; Retry or dedupe backoff, depending on type
+                  (car/hset (qk :backoffs) mid (+ (enc/now-udt) backoff-ms)))
+
+                (car/hdel (qk :locks) mid)
+                (case status
+                  (:success :error) (car/sadd (qk :done) mid)
+                  :requeue          (do (car/srem (qk :requeue)   mid)
+                                        (car/hdel (qk :nattempts) mid))
+                  nil))))
+
+          error
+          (fn [mid poll-reply & [throwable]]
+            (done :error mid)
+            (timbre/errorf
+             (if throwable throwable
+                 (ex-info ":error handler response" {}))
+             "Error handling %s queue message:\n%s" qname poll-reply))

           {:keys [status throwable backoff-ms]}
-          (let [result (try (handler {:qname   qname    :mid     mid
-                                      :message mcontent :attempt attempt})
-                            (catch Throwable t {:status :error :throwable t}))]
+          (let [result
+                (try (handler {:qname   qname    :mid     mid
+                               :message mcontent :attempt attempt})
+                     (catch Throwable t
+                       {:status :error :throwable t}))]
+
             (when (map? result) result))]

       (case status


testing autocompletion by disease name using 'park'

--- test/wb_es/core_test.clj
+++ test/wb_es/core_test.clj
@@ -103,3 +103,35 @@
                     hits))))
       ))
   )
+
+(deftest disease-type-test
+  (testing "autocomplete by disease name using \"park\" as an example"
+    (let [db (d/db datomic-conn)
+          disease-parks (->> (d/datoms db :aevt :do-term/name)
+                             (keep (fn [[e _ v]]
+                                     (if (re-matches #".*park.*" (clojure.string/lower-case v))
+                                       e)))
+                             (map (partial d/entity db))
+                             (shuffle))]
+      (do
+        (apply index-datomic-entity disease-parks)
+        (let [hits (-> (autocomplete "park" {:size (count disease-parks)})
+                       (get-in [:hits :hits]))]
+
+          (testing "match Parkinson's disease"
+            (some (fn [hit]
+                    (= "Parkinson's disease"
+                       (get-in hit [:_source :label])))
+                  hits))
+          (testing "matching early-onset Parkinson disease"
+            (some (fn [hit]
+                    (= "early-onset Parkinson disease"
+                       (get-in hit [:_source :label])))
+                  hits))
+          (testing "X-linked dystonia-parkinsonism"
+            (some (fn [hit]
+                    (= "X-linked dystonia-parkinsonism"
+                       (get-in hit [:_source :label])))
+                  hits))
+
+          )))))


Correctly pass all params in form 2 component

--- src/day8/re_frame/trace/app_state.cljs
+++ src/day8/re_frame/trace/app_state.cljs
@@ -22,7 +22,7 @@
 (defn data-structure
   [jsonml]
   (let [expand? (r/atom true)]
-    (fn []
+    (fn [jsonml]
       [:span
         {:class (str/join " " ["re-frame-trace--object"
                                (when @expand? "expanded")])


Updated r.m.cookies to take advantage of new 'name' functionality

--- ring-core/src/ring/middleware/cookies.clj
+++ ring-core/src/ring/middleware/cookies.clj
@@ -1,7 +1,6 @@
 (ns ring.middleware.cookies
   "Cookie manipulation."
   (:use [clojure.contrib.def :only (defvar-)]
-        [clojure.contrib.java-utils :only (as-str)]
         ring.util.codec))

 (defvar- re-token #"[!#$%&'*\-+.0-9A-Z\^_`a-z\|~]+"
@@ -76,8 +75,8 @@

 (defn- write-value
   "Write the main cookie value."
-  [name value]
-  (str (as-str name) "=" (url-encode value)))
+  [key value]
+  (str (name key) "=" (url-encode value)))

 (defn- valid-attr?
   "Is the attribute valid?"
@@ -89,20 +88,20 @@
   [attrs]
   {:pre [(every? valid-attr? attrs)]}
   (for [[key value] attrs]
-    (let [name (set-cookie-attrs key)]
+    (let [attr-name (name (set-cookie-attrs key))]
       (cond
-        (true? value)  (str ";" (as-str name))
+        (true? value)  (str ";" attr-name)
         (false? value) ""
-        :else          (str ";" (as-str name) "=" value)))))
+        :else          (str ";" attr-name "=" value)))))

 (defn- write-cookies
   "Turn a map of cookies into a seq of strings for a Set-Cookie header."
   [cookies]
-  (for [[name value] cookies]
+  (for [[key value] cookies]
     (if (map? value)
-      (apply str (write-value name (:value value))
+      (apply str (write-value key (:value value))
                  (write-attr-map (dissoc value :value)))
-      (write-value name value))))
+      (write-value key value))))

 (defn- set-cookies
   "Add a Set-Cookie header to a response if there is a :cookies key."


further failed update experiments

further failed update experiments

--- statspop/src/statspop/core.cljs
+++ statspop/src/statspop/core.cljs
@@ -50,6 +50,7 @@
 (defn show-line-chart
   [chart-data]
   (let [{:keys [data options]} chart-data]
+    (.log js/console "showing line chart")
     (js/Chartist.Line. ".ct-chart" (clj->js data) (clj->js options))))

 (defn line-component
@@ -59,17 +60,19 @@
      {:component-did-mount #(show-line-chart chart-state)
       :component-will-update #(show-line-chart chart-state)
       :component-will-receive-props #(show-line-chart chart-state)
+      :component-did-update #(show-line-chart chart-state)
       :display-name        "chart-component"
       :reagent-render      (fn []
                              [:div {:class "ct-chart ct-perfect-fourth"}])})))

 (defn switch-line-chart [datom]
-  (let [chart-state @datom
+  (let [chart-state @datom
         new-datom (condp = chart-state
       test-line-data1 test-line-data2
       test-line-data2 test-line-data1)]
     (.log js/console (str "switching to" new-datom))
     (reset! datom new-datom)))
+

 ;; -------------------------
 ;; Views


It's a spec!

It's a spec!

--- test/cljc/spec_tools/core_test.cljc
+++ test/cljc/spec_tools/core_test.cljc
@@ -41,7 +41,8 @@

     (testing "creation"
       (testing "succeeds"
-        (is (= (st/spec integer?)
+        (is (= spec/integer?
+               (st/spec integer?)
                (st/spec {:spec integer?})
                (st/spec {:spec integer?, :type :long})
                (st/spec integer? {:type :long})


Add detailed note about GC assumptions in test

--- test/com/climate/claypoole_test.clj
+++ test/com/climate/claypoole_test.clj
@@ -568,7 +568,11 @@

 (defn check-holding-thread
   "Verify that this pmap function does not hold onto the head of the sequence,
-  so if no one else uses the results, they're garbage collected."
+  so if no one else uses the results, they're garbage collected.
+
+  Note: This test assumes that calling (System/gc) will cause un-referenced
+  objects to be finalized. So far, that seems to be true, though the JVM does
+  not guarantee that as a contract."
   [pmap-fn]
   (let [a (atom nil)
         p (promise)


simplified test

simplified test

--- test/forma/postprocess/select_test.clj
+++ test/forma/postprocess/select_test.clj
@@ -76,12 +76,9 @@
 final, final step of forma, which is the country time series of
 clearing activity."
   (fact
-   (let [sig-tap (<- [?cntry ?pd ?prob]
+   (let [agg-pix (<- [?cntry ?pd ?tot-prob]
                      (sample-output-map ?m)
                      (grab-sig-pixels "16" ?m :> ?cntry ?pd ?prob)
-                     (:distinct false))
-         agg-pix (<- [?cntry ?pd ?tot-prob]
-                     (sig-tap ?cntry ?pd ?prob)
                      (c/sum ?prob :> ?tot-prob))]
      agg-pix => (produces [["IDN" 830 1.4]
                            ["IDN" 831 1.8]


Check for errors.

Check for errors.

--- test/klangmeister/test/processing.cljs
+++ test/klangmeister/test/processing.cljs
@@ -23,4 +23,7 @@
     (is
       (=
        (framework/process (action/->Refresh "(phrase [1] [69])" :foo) ignore! {})
-       {:foo {:value [{:time 0 :pitch 69 :duration 1}] :text "(phrase [1] [69])" :error nil}}))))
+       {:foo {:value [{:time 0 :pitch 69 :duration 1}] :text "(phrase [1] [69])" :error nil}}))
+    (is
+      ((comp :error :foo)
+       (framework/process (action/->Refresh "(phrase [1] [6" :foo) ignore! {})))))


Test the case of already being stopped.

Test the case of already being stopped.

--- test/klangmeister/test/processing.cljs
+++ test/klangmeister/test/processing.cljs
@@ -1,5 +1,5 @@
 (ns klangmeister.test.processing
-  (:require [cljs.test :refer-macros [deftest is]]
+  (:require [cljs.test :refer-macros [deftest testing is]]
             [klangmeister.processing :as processing]
             [klangmeister.framework :as framework]
             [klangmeister.actions :as action]))
@@ -7,7 +7,12 @@
 (def ignore! (constantly nil))

 (deftest stopping
-  (is
-    (=
-     (framework/process (action/->Stop :foo) ignore! {:foo {:looping? true}})
-     {:foo {:looping? false}})))
+  (testing
+    (is
+      (=
+       (framework/process (action/->Stop :foo) ignore! {:foo {:looping? true}})
+       {:foo {:looping? false}}))
+    (is
+      (=
+       (framework/process (action/->Stop :foo) ignore! {:foo {:looping? false}})
+       {:foo {:looping? false}}))))


Do not depend on message order.

Do not depend on message order.

--- test/onyx/peer/catalog_params_test.clj
+++ test/onyx/peer/catalog_params_test.clj
@@ -93,7 +93,8 @@

 (def results (take-segments! out-chan))

-(fact results => (conj (vec (map (fn [x] {:n (+ x 42)}) (range n-messages))) :done))
+(fact (set results) => (conj (set (map (fn [x] {:n (+ x 42)}) (range n-messages)))
+                       :done))

 (doseq [v-peer v-peers]
   (onyx.api/shutdown-peer v-peer))


Added new tests: test-read-products-existence, test-read-from-product-table-existence, test-read-product-name-existence, and test-read-product-description-existence

--- test/hurvinek/db_interface_test.clj
+++ test/hurvinek/db_interface_test.clj
@@ -23,3 +23,31 @@
     [function-name]
     (clojure.test/function? function-name))

+;
+; Tests for various function definitions
+;
+
+(deftest test-read-products-existence
+    "Check that the hurvinek.db-interface/read-products definition exists."
+    (testing "if the hurvinek.db-interface/read-products definition exists."
+        (is (callable? 'hurvinek.db-interface/read-products))))
+
+
+(deftest test-read-from-product-table-existence
+    "Check that the hurvinek.db-interface/read-from-product-table definition exists."
+    (testing "if the hurvinek.db-interface/read-from-product-table definition exists."
+        (is (callable? 'hurvinek.db-interface/read-from-product-table))))
+
+
+(deftest test-read-product-name-existence
+    "Check that the hurvinek.db-interface/read-product-name definition exists."
+    (testing "if the hurvinek.db-interface/read-product-name definition exists."
+        (is (callable? 'hurvinek.db-interface/read-product-name))))
+
+
+(deftest test-read-product-description-existence
+    "Check that the hurvinek.db-interface/read-product-description definition exists."
+    (testing "if the hurvinek.db-interface/read-product-description definition exists."
+        (is (callable? 'hurvinek.db-interface/read-product-description))))
+
+


don't crash if there isn't a solid block to attack

--- clojure/src/dnd/actionHandlers/attack_handler.cljs
+++ clojure/src/dnd/actionHandlers/attack_handler.cljs
@@ -6,7 +6,8 @@
 (defn attack-block [block]
   (let [{solid :solid} block]
   (if solid
-    (assoc block :solid false))))
+    (assoc block :solid false)
+    block)))

 (defn attack-handler [term level character]
   (if-let [can-move (:can-move @character)]


PDOK-1599: template for one-feature test

--- src/test/clojure/pdok/featured/extracts_test.clj
+++ src/test/clojure/pdok/featured/extracts_test.clj
@@ -20,15 +20,12 @@
                              (test-feature "name2" "C" "D")))

 (deftest test-one-feature
-  (let [[error features] (features-for-extract "test" "one-feature" "gml2extract" (two-features) "src/test/resources/templates")
+  (let [[error features] (features-for-extract "test" "one-feature" "gml2extract" (one-feature) "src/test/resources/templates")
         _ (println (str "error: " error))
         _ (println (str "features" (first features)))
         [tiles feature] (first features)]
     (is (boolean (re-find #"<geo><gml:Polygon" feature)))))

-(deftest test-two-rendered-features
-  (let [[error features] (features-for-extract "test" "dummy" "gml2extract" (two-features) "src/test/resources/templates")]
-    (is (= 2 )(count features))))

 (def ^{:private true} extract-type-citygml "citygml")


[PDOK-2477] change/renamed :dataset -> :dataset-name, so the templates are registered with the correct name

--- src/test/clojure/pdok/featured/extracts_test.clj
+++ src/test/clojure/pdok/featured/extracts_test.clj
@@ -7,8 +7,6 @@
              [pdok.featured.projectors :as p]
              [clojure.test :refer :all]
              [clojure.java.io :as io]))
-
-

 (defn- test-feature [name something other]
               {"name" name
@@ -25,17 +23,16 @@
 (def test-gml2extract-start-partial (slurp (io/resource "templates/test/gml2extract/partials/start.mustache")))
 (def test-gml2extract-end-partial (slurp (io/resource "templates/test/gml2extract/partials/end.mustache")))

-
 (deftest test-two-rendered-features
-  (let [_ (template/add-or-update-template {:dataset "test"
+  (let [_ (template/add-or-update-template {:dataset-name "test"
                                             :extract-type "gml2extract"
                                             :name "dummy"
                                             :template test-gml2extract-dummy-template})
-        _ (template/add-or-update-template {:dataset "test"
+        _ (template/add-or-update-template {:dataset-name "test"
                                             :extract-type "gml2extract"
                                             :name "start"
                                             :template test-gml2extract-start-partial})
-        _ (template/add-or-update-template {:dataset "test"
+        _ (template/add-or-update-template {:dataset-name "test"
                                             :extract-type "gml2extract"
                                             :name "end"
                                             :template test-gml2extract-end-partial})
@@ -44,17 +41,13 @@
     (is (= 2 (count features)))
     (is (= test-expected-rendered-feature rendered-feature))))

-
-
-
 (def ^{:private true} extract-type-citygml "citygml")

-(defn write-xml-to-database [dataset feature-type path template-dir]
+(defn write-xml-to-database [dataset feature-type path]
   "Helper function to write features to an extract-schema."
   (let [features (file-to-features path dataset)
-       [error features-for-extract] (features-for-extract dataset feature-type extract-type-citygml features template-dir)]
-    (add-extract-records config/extracts-db dataset feature-type extract-type-citygml 14 features-for-extract)))
-
+        [error features-for-extract] (features-for-extract dataset feature-type extract-type-citygml features)]
+    (add-extract-records config/extracts-db dataset extract-type-citygml 14 )))

 ;; The -elem-at- construction can be used in mustache templates to get an element from a specific position in a list. For instance elem-at-1 returns the second element in list.
 ;; In the example template 3 elements are used. In the example input data there are two elements in "nummeraanduidingreeks" present. In the output only these two elements can be found.
@@ -62,14 +55,13 @@
 (def test-indexed-section (slurp (io/resource "templates/test/elemat/indexedsection.mustache")))
 (def elem-at-expectedoutput "<imgeo-s:Pand><elem1>1111111111111111<hoek1>A</hoek1><hoek2>B</hoek2></elem1><elem2>9999999999999999<hoek3>C</hoek3></elem2></imgeo-s:Pand>")
 (deftest test-elem-at
-  (let [_ (template/add-or-update-template {:dataset "bgtmutatie"
+  (let [_ (template/add-or-update-template {:dataset-name "bgtmutatie"
                                             :extract-type "testing"
                                             :name "indexedsection"
                                             :template test-indexed-section})
         [error features] (features-for-extract "bgtmutatie" "indexedsection" "testing" elem-at-inputdata)]
   (is (= elem-at-expectedoutput (clojure.string/replace (nth (first features) 3) " " "")))))

-
 ;(write-xml-to-database "bgt" "bord" "D:\\data\\pdok\\bgt\\mutatie-leveringen\\bord\\973140-Bord-1.json" "D:\\projects\\featured\\src\\main\\resources\\pdok\\featured\\templates")

 ;(with-open [s (file-stream ".test-files/new-features-single-collection-100000.json")] (time (last (features-from-package-stream s))))


cleanup

cleanup

--- Clojure-Websockets/MainApp/src/clj/birdwatch/persistence/elastic.clj
+++ Clojure-Websockets/MainApp/src/clj/birdwatch/persistence/elastic.clj
@@ -18,11 +18,6 @@
         hits (esrsp/hits-from search)
         source (pt/get-source hits)
         res (vec source)]
-    (inspect :elastic/query-res {:query query
-                                 :total-hits (esrsp/total-hits search)
-                                 :retrieved (count hits)
-                                 :first-hit (first hits)
-                                 :chars (count (str res))})
     res))

 (defn query-xf