Changing connection pool destroy to not fail if the UniversalConnectionPoolManager is not available.

--- src/cmr/oracle/connection.clj
+++ src/cmr/oracle/connection.clj
@@ -72,9 +72,16 @@
            this))

   (stop [this system]
-        (let [pool-name (get-in this [:spec :connection-pool-name])
-              ucp-manager (UniversalConnectionPoolManagerImpl/getUniversalConnectionPoolManager)]
-          (.destroyConnectionPool ucp-manager pool-name))
+
+        (try
+          ;; Cleanup the connection pool
+          (let [pool-name (get-in this [:spec :connection-pool-name])
+                ucp-manager (UniversalConnectionPoolManagerImpl/getUniversalConnectionPoolManager)]
+            (.destroyConnectionPool ucp-manager pool-name))
+          (catch Exception e
+            (warn (str "Unable to destroy connection pool. It may not have started. Error: "
+                       (.getMessage e)))))
+
         (dissoc this :datasource)))


we have never returned a 400 response on dataset queries so there's no reason to start now.

--- src/metabase/api/meta/dataset.clj
+++ src/metabase/api/meta/dataset.clj
@@ -11,9 +11,7 @@
   "Execute an MQL query and retrieve the results as JSON."
   [:as {{:keys [database] :as body} :body}]
   (read-check Database database)
-  (let [{:keys [status] :as response} (driver/dataset-query body {:executed_by *current-user-id*})]
-    {:status (if (= status :completed) 200 400)
-     :body response}))
+  (driver/dataset-query body {:executed_by *current-user-id*}))

 (defendpoint GET "/csv"
   "Execute an MQL query and download the result data as a CSV file."


Allow custom push instructions to be set

--- src/search/graphs/push.clj
+++ src/search/graphs/push.clj
@@ -1,7 +1,7 @@
 (ns search.graphs.push
   "Adds the ability to use the push interpreter to evaluate your programs."
   (:require [plumbing.graph :as g]
-            [plumbing.core :refer [fnk]]
+            [plumbing.core :refer [fnk defnk]]
             [push.core :as push]
             [schema.core :as s]
             [push.interpreter.templates.one-with-everything :refer [make-everything-interpreter]]
@@ -10,13 +10,23 @@
             [search.utils :refer [defnk-fn] :as utils]
             [search.graphs.seq :as seq]))

+(defnk instructions
+  "Returns all the instructions for the interpreter"
+  [interpreter]
+  (push/known-instructions interpreter))
+
+(defnk interpreter
+  "Returns the push interpreter we should be using"
+  [push-bindings]
+  (make-everything-interpreter :bindings (zipmap push-bindings (repeat nil))))
+
 (defnk-fn ->instruction :- s/Any
   "Returns a random push instruction from those defined in the `push-interpreter`
    and the bindings names.`"
-  [interpreter]
+  [interpreter instructions]
   []
   (let [bindings (push/binding-names interpreter)]
-    (-> {(push/known-instructions interpreter) 5
+    (-> {instructions 5
          bindings (if (empty? bindings) 0 1)}
       clojure.data.generators/weighted
       clojure.data.generators/rand-nth)))
@@ -37,8 +47,8 @@
    push instruction. It also provides `:push-evaluate`."
   (g/graph
     :step-limit (utils/v->fnk 500)
-    :interpreter (fnk [push-bindings]
-                  (make-everything-interpreter :bindings (zipmap push-bindings (repeat nil))))
+    :interpreter interpreter
+    :instructions instructions
     :push-evaluate evaluate
     :->gene ->instruction
     seq/graph))


Fix error with re-find

Fix error with re-find

--- src/org/spootnik/cyanite/util.clj
+++ src/org/spootnik/cyanite/util.clj
@@ -188,7 +188,8 @@
 (def agg-fn-map (zipmap agg-methods
                         (map #(partial aggregate-with (keyword %)) agg-methods)))

-(def agg-path-re (format "^(%s)(\\.|\\-).*" (str/join "|" agg-methods)))
+(def agg-path-re (re-pattern
+                  (format "^(%s)(\\.|\\-).*" (str/join "|" agg-methods))))

 (defn agg-fn-by-path
   [path]


Shortens the 'writing tasks' log (#1710)

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -860,7 +860,16 @@
   [matches conn db fenzo mesos-run-as-user pool-name]
   (let [matches (map #(update-match-with-task-metadata-seq % db mesos-run-as-user) matches)
         task-txns (matches->task-txns matches)]
-    (log/info "In" pool-name "pool, writing tasks" task-txns)
+    (log/info "In" pool-name "pool, writing tasks"
+              {:first-10-tasks
+               (take
+                 10
+                 (for [{:keys [task-metadata-seq]} matches
+                       {:keys [task-id task-request]} task-metadata-seq]
+                   {:job-uuid (-> task-request (get-in [:job :job/uuid]) str)
+                    :task-id task-id}))
+               :number-tasks
+               (count task-txns)})
     (timers/time!
       (timers/timer (metric-title "launch-matched-tasks-all-duration" pool-name))
       (locking cc/kill-lock-object


Better exception reporting on what row the quad is derived from.

--- src/rdf-common/grafter/rdf/io.clj
+++ src/rdf-common/grafter/rdf/io.clj
@@ -178,6 +178,22 @@
   (sesame-rdf-type->type [this]
     this))

+(defn IStatement->sesame-statement
+  "Convert a grafter IStatement into a Sesame statement."
+  [^IStatement is]
+  (try
+    (if (pr/context is)
+      (ContextStatementImpl. (->sesame-rdf-type (pr/subject is))
+                             (->sesame-rdf-type (pr/predicate is))
+                             (->sesame-rdf-type (pr/object is))
+                             (->sesame-rdf-type (pr/context is)))
+      (StatementImpl. (->sesame-rdf-type (pr/subject is))
+                      (->sesame-rdf-type (pr/predicate is))
+                      (->sesame-rdf-type (pr/object is))))
+    (catch Exception ex
+      (throw (ex-info "Error outputing Quad" {:error :statement-conversion-error
+                                              :quad-meta (meta is)} ex)))))
+
 (extend-protocol ISesameRDFConverter

   java.lang.Boolean
@@ -218,17 +234,11 @@

   Triple
   (->sesame-rdf-type [this]
-    (StatementImpl. (->sesame-rdf-type (pr/subject this))
-                    (->sesame-rdf-type (pr/predicate this))
-                    (->sesame-rdf-type (pr/object this))))
+    (IStatement->sesame-statement this))

   Quad
   (->sesame-rdf-type [this]
-    (ContextStatementImpl. (->sesame-rdf-type (pr/subject this))
-                           (->sesame-rdf-type (pr/predicate this))
-                           (->sesame-rdf-type (pr/object this))
-                           (when-let [context (pr/context this)]
-                             (->sesame-rdf-type context))))
+    (IStatement->sesame-statement this))

   Value
   (->sesame-rdf-type [this]
@@ -285,19 +295,6 @@
   clojure.lang.Keyword
   (->sesame-rdf-type [this]
     (BNodeImpl. (name this))))
-
-(defn IStatement->sesame-statement
-  "Convert a grafter IStatement into a Sesame statement."
-  [^IStatement is]
-  (if (pr/context is)
-    (do
-      (ContextStatementImpl. (->sesame-rdf-type (pr/subject is))
-                             (URIImpl. (pr/predicate is))
-                             (->sesame-rdf-type (pr/object is))
-                             (URIImpl. (pr/context is))))
-    (StatementImpl. (->sesame-rdf-type (pr/subject is))
-                    (URIImpl. (pr/predicate is))
-                    (->sesame-rdf-type (pr/object is)))))

 (defn sesame-statement->IStatement
   "Convert a sesame Statement into a grafter Quad."


Tag metadata onto reductions.

Tag metadata onto reductions.

--- src/smallex/reductions.clj
+++ src/smallex/reductions.clj
@@ -180,9 +180,12 @@
 (defn- invert-not
   "Inverses the not operation to a char-set."
   [not-op]
-  {:type :char-set
-   :value (set/difference full-char-set
-                          (get-in not-op [:args 0 :value]))})
+  (with-meta
+    {:type :char-set
+     :value (set/difference full-char-set
+                            (get-in not-op [:args 0 :value]))}
+    (merge (meta not-op)
+           {:type :char-set})))

 (defn- flatten-cat
   "Flattens a `cat` inside a `cat`, whenever possible."
@@ -200,7 +203,11 @@
   (cond (every? #(= :string (:type %)) (:args cat-op))
         ;; This is not general enough. (cat "f" "g" expr [x] "y") could be
         ;; reduced to (cat "fg" expr "xy")
-        {:type :string, :value (apply str (map :value (:args cat-op)))}
+        (with-meta
+          {:type :op, :value :cat,
+           :args (apply str (map :value (:args cat-op)))}
+          (merge (meta cat-op)
+                 {:type :string}))
         (= 1 (count (:args cat-op)))
         (first (:args cat-op))
         :else
@@ -220,34 +227,48 @@
   "Reduces an `or` whenever possible."
   [or-op]
   (cond (every? #(= :char-set (:type %)) (:args or-op))
-        {:type :char-set,
-         :value (apply set/union (map :value (:args or-op)))}
+        (with-meta
+          {:type :char-set,
+           :value (apply set/union (map :value (:args or-op)))}
+          (merge (meta or-op)
+                 {:type :char-set}))
         (= 1 (count (:args or-op)))
         (first (:args or-op))
         :else
         (let [grouped (group-by (comp :type meta) (:args or-op))
               char-sets (apply set/union (map :value (:char-set grouped)))]
-          {:type :string ;; <- exists at least one :string
-           :value (vec
-                   (cond-> (:string grouped)
-                           (seq char-sets)
-                           (conj {:type :char-set
-                                  :value char-sets})))})))
+          (with-meta
+            {:type :op, :value :or
+             :args (vec
+                    (cond-> (concat (grouped nil) (:string grouped))
+                            (seq char-sets)
+                            (conj {:type :char-set
+                                   :value char-sets})))}
+            (merge (meta or-op)
+                    {:type :string}))))) ;; <- exists at least one :string

 (defn- expand-opt
   "Expands (opt x) to (or \"\" x)."
   [opt-op]
-  {:type :op, :value :or
-   :args [{:type :string, :value ""}
-          (get-in opt-op [:args 0])]})
+  (with-meta
+    {:type :op, :value :or
+     :args [(with-meta {:type :string, :value ""}
+              {:type :string})
+            (get-in opt-op [:args 0])]}
+    {:type :string}))

 (defn- expand-plus
   "Expands (plus x) to (cat x (star x))."
   [plus-op]
-  {:type :op, :value :cat
-   :args [(get-in plus-op [:args 0])
-          {:type :op, :value :star,
-           :args (:args plus-op)}]})
+  (with-meta
+    {:type :op, :value :cat
+     :args [(get-in plus-op [:args 0])
+            (with-meta
+              {:type :op, :value :star,
+               :args (:args plus-op)}
+              {:type :string})]}
+    (merge (meta plus-op)
+           {:type :string})))

 (defn- reduce-expression
   "Reduces an expression."


hide color picker tooltip

hide color picker tooltip

--- src/uxbox/ui/workspace/sidebar/options.cljs
+++ src/uxbox/ui/workspace/sidebar/options.cljs
@@ -128,7 +128,7 @@
          [:span.number "F1F1F1"]]

         ;; COLOR PICKER TOOLTIP
-        [:div.colorpicker-tooltip
+        [:div.colorpicker-tooltip.hide
          [:div.color-picker-small
           (colorpicker
            :theme :small


The client now knows that a realtime record has changed

It knows the table name and the record ID

--- src/webapp/framework/client/coreclient.cljs
+++ src/webapp/framework/client/coreclient.cljs
@@ -1357,10 +1357,10 @@

    (let [realtime-update-check-response            (remote  !check-for-server-updates  {:client-data-session-id  @data-session-id} )
          changed-realtime-queries                  (-> realtime-update-check-response :queries keys)
-         changed-realtime-records                  (-> realtime-update-check-response :records keys)
+         list-of-tables                            (-> realtime-update-check-response :records keys)
          ]
      (do
-       (log "Client realtime queries: " changed-realtime-queries)
+       ;(log "Client realtime queries: " changed-realtime-queries)
        (doseq [single-changed-realtime-query    changed-realtime-queries]
          (let [
                xxx          (merge single-changed-realtime-query {:data-source (keyword (get single-changed-realtime-query :db-table)) :realtime true :table nil})
@@ -1382,25 +1382,29 @@

-       (log "Client realtime records: " changed-realtime-records)
-       (doseq [single-changed-realtime-record    changed-realtime-records]
-         (let [
-               ;xxx          (merge single-changed-realtime-query {:data-source (keyword (get single-changed-realtime-query :db-table)) :realtime true :table nil})
-               ;new-key2     (dissoc (dissoc xxx :start) :end)
-               ]
-
-           (comment >! client-query-cache-requests  {
-                                             :query-key     new-key2
-
-                                             :subset-range  {
-                                                             :start   (:start  single-changed-realtime-query)
-                                                             :end     (:end    single-changed-realtime-query)
-                                                             ;:start    1
-                                                             ;:end      20
-                                                             } })
-           nil
-
-           ))
+       (log "Client realtime records: " )
+       (doseq [the-table    list-of-tables]
+         (let [list-of-ids      (keys (get (-> realtime-update-check-response :records) the-table))]
+         (doseq [id     list-of-ids]
+           (let [record    (get (get (-> realtime-update-check-response :records) the-table) id)]
+             (let [
+                   ;xxx          (merge single-changed-realtime-query {:data-source (keyword (get single-changed-realtime-query :db-table)) :realtime true :table nil})
+                   ;new-key2     (dissoc (dissoc xxx :start) :end)
+                   ]
+
+               (log "               : " the-table ", " id " = " record)
+               (comment >! client-query-cache-requests  {
+                                                         :query-key     new-key2
+
+                                                         :subset-range  {
+                                                                         :start   (:start  single-changed-realtime-query)
+                                                                         :end     (:end    single-changed-realtime-query)
+                                                                         ;:start    1
+                                                                         ;:end      20
+                                                                         } })
+               nil
+
+               )))))


fix redirect-uri

fix redirect-uri

--- src-cljs/frontend/auth.cljs
+++ src-cljs/frontend/auth.cljs
@@ -6,7 +6,8 @@
 (def google-client-id (aget js/window "Precursor" "google-client-id"))

 (defn google-redirect-uri []
-  (str (.getScheme utils/parsed-uri) "://" (.getDomain utils/parsed-uri) ":" (.getPort utils/parsed-uri) "/auth/google"))
+  (let [port (.getPort utils/parsed-uri)]
+    (str (.getScheme utils/parsed-uri) "://" (.getDomain utils/parsed-uri) (when port (str ":" port)) "/auth/google")))

 (defn auth-url [& {:keys [redirect-path scopes]
                    :or {scopes ["openid" "email"]}}]


(PDB-2252) command-app: reject large commands earlier

--- src/puppetlabs/puppetdb/http/command.clj
+++ src/puppetlabs/puppetdb/http/command.clj
@@ -128,7 +128,6 @@
   (-> (routes enqueue-fn get-response-pub)
       mid/make-pdb-handler
       validate-command-version
-      (mid/fail-when-payload-too-large reject-large-commands? max-command-size)
       mid/verify-accepts-json
       mid/verify-checksum
       add-received-param ;; must be (temporally) after validate-query-params
@@ -136,5 +135,6 @@
                                              "certname" "command" "version"]})
       mid/payload-to-body-string
       (mid/verify-content-type ["application/json"])
+      (mid/fail-when-payload-too-large reject-large-commands? max-command-size)
       (mid/wrap-with-metrics (atom {}) http/leading-uris)
       (mid/wrap-with-globals get-shared-globals)))


♻ Use swap-vals! for updating projections

Why:
- Makes it more resilient to being called concurrently.
- In normal use it should not be called concurrently, but always from
  a single thread, but on startup we'll want to call it from the main
  thread, so resilience is better.

--- src/territory_bro/projections.clj
+++ src/territory_bro/projections.clj
@@ -49,7 +49,6 @@

 ;;; Refreshing

-(declare refresh-async!)
 (def db-admin-injections
   {:migrate-tenant-schema! db/migrate-tenant-schema!
    :ensure-gis-user-present! (fn [args]
@@ -73,19 +72,20 @@
     (seq @*transient-events)))

 (defn refresh-now! []
-  (let [cached @*cache
-        updated (db/with-db [conn {:read-only? true}]
-                  (apply-new-events cached conn))]
-    (when-not (identical? cached updated)
-      ;; with concurrent requests, only one of them will update the cache
-      (when (compare-and-set! *cache cached updated)
-        (log/info "Updated from revision" (:event/global-revision (:last-event cached))
-                  "to" (:event/global-revision (:last-event updated)))))
+  (let [[old new] (swap-vals! *cache (fn [cached]
+                                       ;; Though this reads the database and is thus a slow
+                                       ;; operation, retries on updating the atom should not
+                                       ;; happen because it's called from a single thread.
+                                       (db/with-db [conn {:read-only? true}]
+                                         (apply-new-events cached conn))))]
+    (when-not (identical? old new)
+      (log/info "Updated from revision" (:event/global-revision (:last-event old))
+                "to" (:event/global-revision (:last-event new)))))

-    (when-some [transient-events (run-process-managers! (cached-state))]
-      (swap! *cache apply-events transient-events)
-      (log/info "Updated with" (count transient-events) "transient events")
-      (recur))))
+  (when-some [transient-events (run-process-managers! (cached-state))]
+    (swap! *cache apply-events transient-events)
+    (log/info "Updated with" (count transient-events) "transient events")
+    (recur)))

 (mount/defstate refresher
   :start (poller/create (fn []


Keep definitions and paths alpha-sorted

Keep definitions and paths alpha-sorted

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -26,9 +26,11 @@
   "A base skeleton for a Swagger Object (as per the Swagger 2.0 specification), that is further populated from Rook namespace
   and schema data."
   {
-   :swagger "2.0"
-   :info    {:title   "<UNSPECIFIED>"
-             :version "<UNSPECIFIED>"}})
+   :swagger     "2.0"
+   :paths       (sorted-map)
+   :definitions (sorted-map)
+   :info        {:title   "<UNSPECIFIED>"
+                 :version "<UNSPECIFIED>"}})

 (defn keyword->path?
   [v]
@@ -310,7 +312,7 @@
                     (remove-nil-vals {:description     description
                                       :summary         summary
                                       ;; This is required inside a Operation object:
-                                      :responses       {}
+                                      :responses       (sorted-map)
                                       :x-rook-endpoint (:function endpoint-meta)}))
           (path-params-injector swagger-options % routing-entry params-key)
           (query-params-injector swagger-options % routing-entry params-key)


fix typo

fix typo

--- src/leiningen/new/tenzing.clj
+++ src/leiningen/new/tenzing.clj
@@ -214,7 +214,7 @@
                            ["resources/index.html" (render "index.html" data)]

                            (when-let [boot-props (render-boot-properties)]
-                             ["boot.properties" (silence-implicit-target-warning boot-props)])
+                             ["boot.properties" (mute-implicit-target-warning boot-props)])

                            ["build.boot" (render "build.boot" data)]
                            [".gitignore" (render "gitignore" data)])))))


Fix async TTL tests

Fix async TTL tests

--- test/clojurewerkz/cassaforte/async_cql_test.clj
+++ test/clojurewerkz/cassaforte/async_cql_test.clj
@@ -20,8 +20,8 @@

   (deftest test-insert-batch-with-ttl
     (th/test-combinations
-     (let [input [[{:name "Alex" :city "Munich" :age (int 19)} (using :ttl 350)]
-                  [{:name "Alex" :city "Munich" :age (int 19)} (using :ttl 350)]]]
+     (let [input [[{:name "Alex" :city "Munich" :age (int 19)} (using :ttl (int 350))]
+                  [{:name "Alex" :city "Munich" :age (int 19)} (using :ttl (int 350))]]]
        (insert-batch-async s :users input)
        (is (= (first (first input)) (first @(select-async s :users))))
        (truncate s :users))))


Minor: rename/reformat

Minor: rename/reformat

--- src/yadic/component.clj
+++ src/yadic/component.clj
@@ -16,7 +16,7 @@
                              (zipmap dependencies dependencies))]
       (reify
         yadic/Activator
-        (activate [this container]
+        (activate [_this container]
           (->> dependencies-map
                (map (fn [[alias k]]
                       [alias (get container k)]))
@@ -25,7 +25,7 @@
                  component)
                (start)))

-        (close [this instance]
+        (close [_this instance]
           (stop instance))))))

 (defn using [component dependencies]
@@ -43,24 +43,25 @@
   (stop [^AutoCloseable this]
     this))

-(defn- components->container* [m]
+(defn- system-map->container* [m]
   (yadic/->container
     (reduce-kv
       (fn [as k x]
         (assoc as
-          k (cond (satisfies? yadic/Activator x) x
-                  (satisfies? Lifecycle x) (component->activator x [])
-                  true (throw (UnsupportedOperationException.)))))
+          k (if (satisfies? yadic/Activator x)
+              x
+              (component->activator x []))))
       (yadic/->activators)
       m)))

 (defn start-system [system]
-  (yadic/eagerly-instantiate (if (instance? Container system)
-                               system
-                               (components->container* system))))
+  (-> (if (instance? Container system)
+        system
+        (system-map->container* system))
+      (yadic/eagerly-instantiate)))

 (defn stop-system [^AutoCloseable system]
   (.close system))

 (defn system-map [& keyvals]
-  (components->container* (apply hash-map keyvals)))
+  (system-map->container* (apply hash-map keyvals)))


Initial for lexer

Initial for lexer

--- src/teach_friends/core.clj
+++ src/teach_friends/core.clj
@@ -45,9 +45,19 @@
 (defn make-search-tree [phrases]
   (reduce (fn [acc phrase] (insert-phrase-into-tree acc phrase)) {} phrases))

+(def CHAR #"[a-zA-Z']")
+(def END_OF_WORD #"\s,\n")
+(def LINE_BREAKER #"\n")
+
+(defn character? [x] )
+
+(defn analyze-symbol [])
+
+(defn lexer [] )
+
 (defn -main
   "I don't do a whole lot ... yet."
   [& args]
-  (println (make-search-tree (get-idioms))))
+  (println (make-search-tree (get-stopwords))))
   ;(println (string/join "\n" (get-all-words-from-srt (get-srt) (get-stopwords)))))
   ;(println (set/intersection (set (get-stopwords)) (get-all-words-from-srt (get-srt) (get-stopwords)))))


fix error in reagent app

fix error in reagent app

--- resources/leiningen/new/tenzing/reagent-app.cljs
+++ resources/leiningen/new/tenzing/reagent-app.cljs
@@ -13,5 +13,5 @@
   [:div "Parent component"
    [some-component]])

-(reagent/render-component [childcaller]
+(reagent/render-component [calling-component]
                           (.getElementById js/document "container"))


minor refactor and delete an unused function

--- src/cljx/jamesmacaulay/zelkova/impl/signal.cljx
+++ src/cljx/jamesmacaulay/zelkova/impl/signal.cljx
@@ -146,25 +146,19 @@
                       (zipmap parents (repeat #{this-sig})))
           next-sig)))))

-(defn calculate-graph-meta
-  [signal]
-  (let [{:keys [parents-map] :as dep-maps} (calculate-dependency-maps signal)]
-    (assoc dep-maps :topsort (-> parents-map kahn/kahn-sort reverse))))
-
-(defn output-node->dependency-map
-  "Takes a signal and returns a map of signals to sets of signal dependencies."
-  [output-node]
-  (-> output-node calculate-dependency-maps :parents-map))
+(defn parents-map->topsort
+  [pm]
+  (->> pm (kahn/kahn-sort) (reverse) (into [])))

 (defrecord SignalDefinitionMetadata
   [parents-map kids-map topsort])

-(defn- setup-metadata
+(defn- attach-delayed-metadata
   [sig]
-  (let [delayed-graph-meta (delay (calculate-graph-meta sig))
-        delayed-parents-map (delay (:parents-map @delayed-graph-meta))
-        delayed-kids-map (delay (:kids-map @delayed-graph-meta))
-        delayed-topsort (delay (:topsort @delayed-graph-meta))]
+  (let [delayed-dep-maps (delay (calculate-dependency-maps sig))
+        delayed-parents-map (delay (:parents-map @delayed-dep-maps))
+        delayed-kids-map (delay (:kids-map @delayed-dep-maps))
+        delayed-topsort (delay (parents-map->topsort @delayed-parents-map))]
     (with-meta sig (->SignalDefinitionMetadata delayed-parents-map
                                                delayed-kids-map
                                                delayed-topsort))))
@@ -197,7 +191,7 @@
   (-> opts
       (setup-event-relay)
       (map->SignalDefinition)
-      (setup-metadata)))
+      (attach-delayed-metadata)))

 ; dealing with multiple outputs:


use delays for memoizing metadata

use delays for memoizing metadata

(thanks @AdamSpitz!)

--- src/cljx/jamesmacaulay/zelkova/impl/signal.cljx
+++ src/cljx/jamesmacaulay/zelkova/impl/signal.cljx
@@ -94,8 +94,7 @@
   (signal-deps [s] "returns the set of \"parent\" signals on which this signal depends")
   (parents-map [s])
   (kids-map [s])
-  (topsort [s])
-  (-get-graph-meta [s k]))
+  (topsort [s]))

 (defn signal?
   "returns `true` if the argument satisfies `SignalProtocol`, `false` otherwise"
@@ -160,6 +159,16 @@
 (defrecord SignalDefinitionMetadata
   [parents-map kids-map topsort])

+(defn- setup-metadata
+  [sig]
+  (let [delayed-graph-meta (delay (calculate-graph-meta sig))
+        delayed-parents-map (delay (:parents-map @delayed-graph-meta))
+        delayed-kids-map (delay (:kids-map @delayed-graph-meta))
+        delayed-topsort (delay (:topsort @delayed-graph-meta))]
+    (with-meta sig (->SignalDefinitionMetadata delayed-parents-map
+                                               delayed-kids-map
+                                               delayed-topsort))))
+
 (defrecord SignalDefinition
   [init-fn sources relayed-event-topic msg-fn deps event-sources]
   SignalProtocol
@@ -167,20 +176,9 @@
     (into #{}
           (filter signal?)
           (or deps sources)))
-  (-get-graph-meta [s k]
-    (let [meta-atom (-> s meta (get k))
-          memoized @meta-atom]
-      (if-not (nil? memoized)
-        memoized
-        (let [{:keys [parents-map kids-map topsort]} (calculate-graph-meta s)
-              m (meta s)]
-          (-> m :parents-map (reset! parents-map))
-          (-> m :kids-map (reset! kids-map))
-          (-> m :topsort (reset! topsort))
-          @meta-atom))))
-  (parents-map [s] (-get-graph-meta s :parents-map))
-  (kids-map [s] (-get-graph-meta s :kids-map))
-  (topsort [s] (-get-graph-meta s :topsort)))
+  (parents-map [s] (-> s meta :parents-map deref))
+  (kids-map [s] (-> s meta :kids-map deref))
+  (topsort [s] (-> s meta :topsort deref)))

 (defn- setup-event-relay
   "Takes a topic, and returns an input signal which relays matching events as messages to its children"
@@ -192,10 +190,6 @@
                 (when (= relayed-topic (topic event))
                   (fresh (value event)))))
     opts))
-
-(defn- setup-metadata
-  [sig]
-  (with-meta sig (->SignalDefinitionMetadata (atom nil) (atom nil) (atom nil))))

 (defn make-signal
   "Takes a map of opts and returns a signal."


Comment out defsketch to work with scheduler

--- spectacles/src/spectacles/kaleidoscope.clj
+++ spectacles/src/spectacles/kaleidoscope.clj
@@ -81,13 +81,13 @@
     (assoc state :ldots (update-dots ldots)
                  :rdots (update-dots rdots))))

-(q/defsketch practice
-     :title "Kaleidoscope"
-     :size [800 600]
-     :setup setup
-     :draw draw
-     :update update
-     :features [:keep-on-top]
-     :middleware [m/fun-mode m/navigation-2d])
+;; (q/defsketch practice
+;;      :title "Kaleidoscope"
+;;      :size [800 600]
+;;      :setup setup
+;;      :draw draw
+;;      :update update
+;;      :features [:keep-on-top]
+;;      :middleware [m/fun-mode m/navigation-2d])


Remove obs info log

Remove obs info log

--- src/yetibot/core/hooks.clj
+++ src/yetibot/core/hooks.clj
@@ -111,7 +111,6 @@
     #'yetibot.core.handler/handle-raw
     (let [event-types (set event-types)]
       (fn [callback chat-source user event-type body]
-        (info "obs" event-type body)
         (when (contains? event-types event-type)
           (with-fresh-db
             (observer {:chat-source chat-source


CMR-1335: Added test for boosting keyword searches

--- system-int-test/test/cmr/system_int_test/search/collection_keyword_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_keyword_search_test.clj
@@ -40,6 +40,7 @@
                          :instruments [(dc/instrument {:short-name "SMAP L-BAND RADIOMETER"})]})
         p5 (dc/platform {:short-name "fo&nA"})
         p6 (dc/platform {:short-name "spo~nA"})
+        psn (dc/platform {:short-name "boost"})
         pr1 (dc/projects "project-short-name")
         sk1 (dc/science-keyword {:category "Cat1"
                                  :topic "Topic1"
@@ -237,7 +238,7 @@
            ;; - detailed-variable
            "SUPER" [coll9]

-            ;; Special characters are escaped before sending to Elastic
+           ;; Special characters are escaped before sending to Elastic
            "ABC~ZYX" []
            "ABC~" []
            "spo~nA" [coll11]
@@ -303,6 +304,54 @@

            ;; science-keywords
            (:category sk1) [k2e/science-keywords-boost]))
+
+    (testing "Specified boosts on fields"
+      (are [params scores] (= (map #(/ % 2.0) scores)
+                              (map :score (:refs (search/find-refs :collection params))))
+           ;; short-name
+           {:keyword "SNFoobar":boost {:short-name 2.0}} [2.0]
+
+           ;; project short-name
+           {:keyword (:short-name (first pr1)) :boost {:project 2.0}} [2.0]
+
+           ;; platform short-name
+           {:keyword (:short-name p1) :boost {:platform 2.0}} [2.0]
+
+           ;; instrument short-name
+           {:keyword (:short-name (first (:instruments p1))) :boost {:platorm 2.0}} [2.0]
+
+           ;; sensor short-name
+           {:keyword (:short-name (first (:sensors (first (:instruments p1))))) :boost {:sensor 2.0}} [2.0]
+
+           ;; temporal-keywords
+           {:keyword "tk1" :boost {:temporal-keywords 2.0}} [2.0]
+
+           ;; spatial-keyword
+           {:keyword "in out" :boost {:spatial-keyword 2.0}} [2.0]
+
+           ;; science-keywords
+           {:keyword (:category sk1) :boost {:science-keywords-boost 2.0}} [2.0]
+
+           ;; mixed boosts
+           {:keyword "spoonA" :boost {:short-name 2.0 :science-keywords 5.0}} [5.0 2.0]))
+
+    (testing "Setting boosts without keyword search is an error"
+      (let [resp (search/find-refs :collection {:provider "PROV1"
+                                                :page_size 5
+                                                :short_name "SNFoobar"
+                                                :boost {:short-name 2.0}})
+            {:keys [status errors]} resp]
+        (is (= 400 status))
+        (is (= "Parameter [boost] is only valid for keyword queries." (first errors)))))
+
+    (testing "Boosting on invalid field"
+      (let [resp (search/find-refs :collection {:provider "PROV1"
+                                                :page_size 5
+                                                :keyword "Laser"
+                                                :boost {:foo 2.0}})
+            {:keys [status errors]} resp]
+        (is (= 400 status))
+        (is (= "Cannot set boost on field [foo]." (first errors)))))

     (testing "sorted search by keywords."
       (are [keyword-str items]


Revert "State."

Revert "State."

This reverts commit d6734019119666b6b8f5092e55cef6e9a73dc7f5.

--- test/com/nomistech/clojure_the_language/c_400_state_and_concurrency/s_030_refs.clj
+++ test/com/nomistech/clojure_the_language/c_400_state_and_concurrency/s_030_refs.clj
@@ -16,10 +16,11 @@
 ;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ;;;; `ref`, `dosync`, `alter`

+(def bank-account-1-atom (ref 100))
+(def bank-account-2-atom (ref 200))
+
 (fact
-  (let [bank-account-1-atom (ref 100)
-        bank-account-2-atom (ref 200)
-        amount 20]
+  (let [amount 20]
     (dosync
      (alter bank-account-1-atom + amount)
      (alter bank-account-2-atom - amount))


CMR-5071 Resolves Leo's merge conflict comment.

--- umm-spec-lib/src/cmr/umm_spec/umm_g/granule.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_g/granule.clj
@@ -58,19 +58,21 @@
      {:granule-ur (:GranuleUR umm-g-json)
       :data-provider-timestamps (umm-g->DataProviderTimestamps umm-g-json)
       :collection-ref coll-ref
+      ; :data-granule (xml-elem->DataGranule umm-g-json)
+      ; :access-value (cx/double-at-path umm-g-json [:RestrictionFlag])
       :temporal (umm-g->Temporal umm-g-json)
+      ; :orbit-calculated-spatial-domains (ocsd/xml-elem->orbit-calculated-spatial-domains umm-g-json)
       :platform-refs (platform/umm-g-platforms->PlatformRefs (:Platforms umm-g-json))
       :project-refs (project/umm-g-projects->ProjectRefs (:Projects umm-g-json))
       :cloud-cover (:CloudCover umm-g-json)
       :two-d-coordinate-system (tiling-system/umm-g-tiling-identification-system->TwoDCoordinateSystem
-                                (:TilingIdentificationSystem umm-g-json))})))
-      ; :access-value (cx/double-at-path umm-g-json [:RestrictionFlag])
-      ; :data-granule (xml-elem->DataGranule umm-g-json)
-      ; :measured-parameters (mp/xml-elem->MeasuredParameters umm-g-json)
-      ; :orbit-calculated-spatial-domains (ocsd/xml-elem->orbit-calculated-spatial-domains umm-g-json)
-      ; :product-specific-attributes (psa/xml-elem->ProductSpecificAttributeRefs umm-g-json)
+                                (:TilingIdentificationSystem umm-g-json))
+      ; :two-d-coordinate-system (two-d/xml-elem->TwoDCoordinateSystem umm-g-json)
       ; :related-urls (ru/xml-elem->related-urls umm-g-json)
       ; :spatial-coverage (xml-elem->SpatialCoverage umm-g-json)
+      ; :measured-parameters (mp/xml-elem->MeasuredParameters umm-g-json)
+      ; :product-specific-attributes (psa/xml-elem->ProductSpecificAttributeRefs umm-g-json)
+      })))

 (defn Granule->umm-g
   "Returns UMM-G JSON from a umm-lib Granule"


remove an unused test (#1600)

remove an unused test (#1600)

--- test-cljs/frontend/models/test_feature.cljs
+++ test-cljs/frontend/models/test_feature.cljs
@@ -31,13 +31,3 @@
                                             false :x-no}
                                         :y {true :y-yes
                                             false :y-no}})))))
-
-(deftest ab-test-buckets-works
-  (bond/with-stub [[feature/enabled? (fn [feature]
-                                       (= :x feature))]]
-
-    (is (= {:x true :y false}
-           (feature/ab-test-buckets {:x {true :x-yes
-                                         false :x-no}
-                                     :y {true :y-yes
-                                         false :y-no}})))))


correct test error

correct test error

--- test/clj_money/models/transactions_test.clj
+++ test/clj_money/models/transactions_test.clj
@@ -254,7 +254,10 @@
   (let [context (serialization/realize storage-spec balance-context)
         [checking-items
          salary-items
-         groceries-items] (map #(transactions/items-by-account storage-spec (:id %))
+         groceries-items] (map #(transactions/items-by-account
+                                  storage-spec
+                                  (:id %)
+                                  [(t/local-date 2016 1 1) (t/local-date 2016 12 31)])
                                (:accounts context))]
     (is (= [1 0] (map :index checking-items)) "The checking transaction items have correct indexes")
     (is (= [0] (map :index salary-items)) "The salary transaction items have the correct indexes")


Improve exception formatting tests

Improve exception formatting tests

Tests are more strict, though probably harder to follow now.

--- test/implementation/util/fim_exceptions.clj
+++ test/implementation/util/fim_exceptions.clj
@@ -48,21 +48,40 @@
   (let [lines (friendly-exception-lines (Error. "message") ">>>")]
     (first lines) => #"Error.*message"
     (re-find #"^>>>" (first lines)) => falsey
-    (count (remove nil? (map #(re-find #">>>implementation.util.fim_exceptions" %) (rest lines)))) => (count (rest lines))))
+    (count (keep #(re-find #">>>implementation.util.fim_exceptions" %) (rest lines))) => (count (rest lines))))

-(def nested-exception
-  (ex-info "Found a NPE" {:info "wrapped throw of an NPE"} (NullPointerException.)))
+(defn innermost-exception []
+  (NullPointerException.))

-(fact
-  "Check that exceptions with 'cause' data show the 'cause' stacktrace"
-  (let [lines (friendly-exception-lines nested-exception ">>>")]
-    (count (remove nil? (map #(re-find #">>>Caused by:" %) lines))) => 1))
+(defn nested-exception []
+  (ex-info "Found a NPE" {:info "wrapped throw of an NPE"} (innermost-exception)))
+
+(defn call-nested-exception []
+  (nested-exception))
+
+(fact "exceptions with 'cause' data show the 'cause' stacktrace"
+  (let [lines (friendly-exception-lines (call-nested-exception) ">>>")]
+    (clojure.string/join "&" lines) => #"(?x)^clojure.lang.ExceptionInfo:\ Found\ a\ NPE\ \{:info\ \"wrapped\ throw\ of\ an\ NPE\"\}
+                                            (&>>>.*nested.exception.*)+
+                                            (&>>>.*call.nested.exception.*)+
+                                             &
+                                             &>>>Caused\ by:\ java.lang.NullPointerException
+                                            (&>>>.*innermost.exception.*)+
+                                            (&>>>.*nested.exception.*)+
+                                            (&>>>.*call.nested.exception.*)+"))

 (def double-nested-exception
-  (ex-info "Exception with a cause chain 2 deep" {:info "2 deep"} nested-exception))
+  (ex-info "Exception with a cause chain 2 deep" {:info "2 deep"} (call-nested-exception)))

-(fact
-  "Check that exceptions with nested 'cause' data more than 1 level deep, shows
-  all 'cause' stacktraces"
+(fact "exceptions with nested 'cause' data more than 1 level deep, shows all 'cause' stacktraces"
   (let [lines (friendly-exception-lines double-nested-exception ">>>")]
-    (count (remove nil? (map #(re-find #">>>Caused by:" %) lines))) => 2))
+    (clojure.string/join "&" lines) => #"(?x)^clojure.lang.ExceptionInfo:\ Exception\ with\ a\ cause\ chain\ 2\ deep\ \{:info\ \"2\ deep\"\}
+                                             &
+                                             &>>>Caused\ by:\ clojure.lang.ExceptionInfo:\ Found\ a\ NPE\ \{:info\ \"wrapped\ throw\ of\ an\ NPE\"\}
+                                             (&>>>.*nested.exception.*)+
+                                            (&>>>.*call.nested.exception.*)+
+                                             &
+                                             &>>>Caused\ by:\ java.lang.NullPointerException
+                                            (&>>>.*innermost.exception.*)+
+                                            (&>>>.*nested.exception.*)+
+                                            (&>>>.*call.nested.exception.*)+"))


More tests for with-let

More tests for with-let

--- test/reagenttest/testwithlet.cljs
+++ test/reagenttest/testwithlet.cljs
@@ -40,8 +40,13 @@
     (swap! a inc)
     (flush)
     (is (= [[11 1] 1 2 1] [@r @n1 @n2 @n3]))
+
     (is (= [12 2] @t))
     (is (= [[12 2] 2 3 2] [@r @n1 @n2 @n3]))
+
+    (is (= [12 3] (f1)))
+    (is (= [[12 2] 3 4 3] [@r @n1 @n2 @n3]))
+
     (is (= runs (running)))))

@@ -129,3 +134,85 @@
                           expected)))
     (is (= @n2 28))
     (is (= runs (running)))))
+
+(deftest non-reactive-with-let
+  (let [n1 (atom 0)
+        n2 (atom 0)
+        n3 (atom 0)
+        n4 (atom 0)
+        f1 (fn []
+             (with-let []
+               (swap! n2 inc)))
+        f2 (fn []
+             (with-let [v (swap! n1 inc)]
+               v))
+        f3 (fn []
+             (with-let [v (swap! n1 inc)]
+               (swap! n2 inc)
+               (finally (swap! n3 inc))))
+        f4 (fn []
+             (with-let []
+               (finally (swap! n3 inc)
+                        (swap! n4 inc))))
+        f5 (fn []
+             [(f1) (f2) (f4)])
+        tst (fn [f]
+              [(f) @n1 @n2 @n3])]
+    (is (= [1 0 1 0] (tst f1)))
+    (is (= [1 1 1 0] (tst f2)))
+    (is (= [2 2 2 1] (tst f3)))
+    (is (= 0 @n4))
+    (is (= [nil 2 2 2] (tst f4)))
+    (is (= 1 @n4))
+    (is (= [[3 3 nil] 3 3 3] (tst f5)))))
+
+(deftest with-let-args
+  (let [runs (running)
+        active (atom 0)
+        n1 (atom 0)
+        f1 (fn [x y]
+             (with-let [_ (swap! active inc)
+                        v (r/atom @x)]
+               (swap! n1 inc)
+               (+ y @v)
+               (finally
+                 (reset! v nil)
+                 (swap! active dec))))
+        f2 (fn [x y]
+             (with-let [t1 (track f1 x y)
+                        t2 (track f1 x y)]
+               (let [v @(track f1 x y)]
+                 (is (= v @t1 @t2))
+                 v)))
+        f2t (partial track f2)
+        res (atom nil)
+        val (r/atom 1)
+        valtrack (track deref val)
+        t (track! #(reset! res (let [v valtrack]
+                                 (if (> @v 2)
+                                   [@(f2t v 10)]
+                                   [@(f2t val 0)
+                                    @(f2t val 0)
+                                    @(f2t v 10)
+                                    (f1 v 10)]))))]
+    (is (= [1 1 11 11] @res))
+    (is (= [3 3] [@n1 @active]))
+    (reset! val 1)
+    (flush)
+    (is (= [1 1 11 11] @res))
+    (is (= [3 3] [@n1 @active]))
+
+    (swap! val inc)
+    (is (= [3 3] [@n1 @active]))
+    (flush)
+    (is (= [6 3] [@n1 @active]))
+    (is (= [1 1 11 11] @res))
+
+    (swap! val inc)
+    (flush)
+    (is (= [6 1] [@n1 @active]))
+    (is (= [11] @res))
+
+    (dispose! t)
+    (is (= [6 0] [@n1 @active]))
+    (is (= runs (running)))))


remove bar title now that hovercards exist

--- src-cljs/frontend/components/insights.cljs
+++ src-cljs/frontend/components/insights.cljs
@@ -213,11 +213,7 @@
     ;; top bars enter and update
     (-> bars-join
         (.select ".top")
-        (.attr #js {"xlink:href" build-timing-url
-                    "xlink:title" #(let [duration-str (datetime/as-duration (unexterned-prop % "build_time_millis"))]
-                                     (gstring/format "%s in %s"
-                                                     (gstring/toTitleCase (unexterned-prop % "outcome"))
-                                                     duration-str))})
+        (.attr #js {"xlink:href" build-timing-url})
         (.on #js {"click" #(analytics/track-insights-bar-click {:current-url js/window.location.href
                                                                        :build-url (unexterned-prop % "build_url")})})
         (.select "rect.bar")
@@ -230,9 +226,7 @@
     ;; bottom bar enter and update
     (-> bars-join
         (.select ".bottom")
-        (.attr #js {"xlink:href" build-timing-url
-                    "xlink:title" #(let [duration-str (datetime/as-duration (unexterned-prop % "queued_time_millis"))]
-                                     (gstring/format "Queue time %s" duration-str))})
+        (.attr #js {"xlink:href" build-timing-url})
         (.select "rect.bar")
         (.attr #js {"y" y-zero
                     "x" #(x-scale (unexterned-prop % "build_num"))


remove leftover prn

remove leftover prn

fixes #676

--- src/main/shadow/cljs/repl.clj
+++ src/main/shadow/cljs/repl.clj
@@ -255,7 +255,6 @@
                  (filter #(.isDirectory %))
                  (map #(.toPath %))
                  (filter (fn [^Path path]
-                           (prn [:match abs-path path (.startsWith abs-path path)])
                            (.startsWith abs-path path))))]

         (when (seq matched-paths)


pulled out higher order pop-if fn to use in pop-docstring and pop-opts-map

--- src/midje/util/form_utils.clj
+++ src/midje/util/form_utils.clj
@@ -203,16 +203,17 @@
   (into [] (for [x exprs]
              `(fn [] ~x))))

-(defn pop-docstring
-  "Used to extract optional map from head of args"
-  [args]
-  (if (string? (first args))
+(defn pop-if
+  "Extracts optional arg (that we assume is present if the pred is true) from head of args"
+  [pred args]
+  (if (pred (first args))
     [(first args) (rest args)]
     [nil args]))

-(defn pop-opts-map
-  "Used to extract optional docstring from head of args"
-  [args]
-  (if (map? (first args))
-    [(first args) (rest args)]
-    [{}           args]))+(def pop-docstring
+  ;; "Extracts optional map from head of args"
+  (partial pop-if string?))
+
+(def pop-opts-map
+  ;; "Extracts optional docstring from head of args"
+  (partial pop-if map?))


Only start top level bookie server if server? is set

--- src/onyx/state/bookkeeper.clj
+++ src/onyx/state/bookkeeper.clj
@@ -20,38 +20,36 @@
 (defrecord Bookie [env-config port log]
   component/Lifecycle
   (component/start [component]
-    (if (arg-or-default :onyx.bookkeeper/server? env-config)
-      (let [onyx-id (:onyx/id env-config)
-            ledgers-root-path (ozk/ledgers-path onyx-id)
-            ledgers-available-path (ozk/ledgers-available-path onyx-id)
-            _ (zk/create (:conn log) ledgers-root-path :persistent? true)
-            _ (zk/create (:conn log) ledgers-available-path :persistent? true)
-            base-journal-dir (arg-or-default :onyx.bookkeeper/base-journal-dir env-config)
-            base-ledger-dir (arg-or-default :onyx.bookkeeper/base-ledger-dir env-config)
-            server-id (str onyx-id "_" port)
-            journal-dir (str base-journal-dir "/" server-id)
-            ledger-dir (str base-ledger-dir "/" server-id)
-            server-conf (doto (ServerConfiguration.)
-                          (.setZkServers (:zookeeper/address env-config))
-                          (.setZkLedgersRootPath ledgers-root-path)
-                          (.setBookiePort port)
-                          (.setJournalDirName journal-dir)
-                          (.setLedgerDirNames (into-array String [ledger-dir]))
-                          (.setAllowLoopback true))
-            server (BookieServer. server-conf)
-            _ (info "Starting BookKeeper server on port" port)
-            _ (.start server)]
-        (when (:onyx.bookkeeper/delete-server-data? env-config)
-          (.addShutdownHook (Runtime/getRuntime)
-                            (Thread. (fn []
-                                       (cleanup-dir base-ledger-dir)
-                                       (cleanup-dir base-journal-dir)))))
-        (assoc component
-               :server server
-               :port port
-               :journal-dir journal-dir
-               :ledger-dir ledger-dir))
-      component))
+    (let [onyx-id (:onyx/id env-config)
+          ledgers-root-path (ozk/ledgers-path onyx-id)
+          ledgers-available-path (ozk/ledgers-available-path onyx-id)
+          _ (zk/create (:conn log) ledgers-root-path :persistent? true)
+          _ (zk/create (:conn log) ledgers-available-path :persistent? true)
+          base-journal-dir (arg-or-default :onyx.bookkeeper/base-journal-dir env-config)
+          base-ledger-dir (arg-or-default :onyx.bookkeeper/base-ledger-dir env-config)
+          server-id (str onyx-id "_" port)
+          journal-dir (str base-journal-dir "/" server-id)
+          ledger-dir (str base-ledger-dir "/" server-id)
+          server-conf (doto (ServerConfiguration.)
+                        (.setZkServers (:zookeeper/address env-config))
+                        (.setZkLedgersRootPath ledgers-root-path)
+                        (.setBookiePort port)
+                        (.setJournalDirName journal-dir)
+                        (.setLedgerDirNames (into-array String [ledger-dir]))
+                        (.setAllowLoopback true))
+          server (BookieServer. server-conf)
+          _ (info "Starting BookKeeper server on port" port)
+          _ (.start server)]
+      (when (:onyx.bookkeeper/delete-server-data? env-config)
+        (.addShutdownHook (Runtime/getRuntime)
+                          (Thread. (fn []
+                                     (cleanup-dir base-ledger-dir)
+                                     (cleanup-dir base-journal-dir)))))
+      (assoc component
+             :server server
+             :port port
+             :journal-dir journal-dir
+             :ledger-dir ledger-dir)))
   (component/stop [{:keys [server] :as component}]
     (info "Stopping BookKeeper server")
     (.shutdown ^BookieServer server)
@@ -96,16 +94,19 @@
 (defrecord BookieServers [env-config log]
   component/Lifecycle
   (component/start [component]
-    (let [local-quorum? (arg-or-default :onyx.bookkeeper/local-quorum? env-config)
+    (if (arg-or-default :onyx.bookkeeper/server? env-config)
+      (let [local-quorum? (arg-or-default :onyx.bookkeeper/local-quorum? env-config)
           ports (if local-quorum?
                   (arg-or-default :onyx.bookkeeper/local-quorum-ports env-config)
                   (vector (arg-or-default :onyx.bookkeeper/port env-config)))]
       (assoc component :servers (mapv (fn [port]
                                         (component/start (->BookieMonitor env-config log port)))
-                                      ports))))
+                                      ports))
+      component)))
   (component/stop [component]
-    (doseq [server (:servers component)]
-      (component/stop server))))
+    (if (arg-or-default :onyx.bookkeeper/server? env-config)
+      (doseq [server (:servers component)]
+        (component/stop server)))))

 (defn multi-bookie-server [env-config]
   (map->BookieServers {:env-config env-config}))


use generate-all rather than generate

use generate-all rather than generate

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -1,10 +1,9 @@
 (ns babel.test.it
   (:refer-clojure :exclude [get-in])
-  (:require [babel.engine :refer [generate generate-all]]
-            [babel.italiano.grammar :refer [small medium np-grammar]]
+  (:require [babel.italiano.grammar :refer [small medium np-grammar]]
             [babel.italiano.lexicon :refer [lexicon]]
             [babel.italiano.morphology :refer [fo new-style replace-patterns]]
-            [babel.italiano.workbook :refer [analyze parse]]
+            [babel.italiano.workbook :refer [analyze generate generate-all parse]]
             #?(:clj [clojure.test :refer [deftest is]])
             #?(:cljs [cljs.test :refer-macros [deftest is]])
             #?(:clj [clojure.tools.logging :as log])
@@ -24,32 +23,32 @@
     (is (not (nil? plural)))))

 (deftest present-irregular
-  (let [result (generate {:synsem {:subcat '()
-                                   :sem {:pred :be
-                                         :subj {:pred :I}
-                                         :tense :present}}}
-                         small)]
+  (let [result (first (take 1 (generate {:synsem {:subcat '()
+                                                  :sem {:pred :be
+                                                        :subj {:pred :I}
+                                                        :tense :present}}}
+                                        small)))]
     (is (= "io sono" (fo result)))))

 (deftest passato-prossimo
-  (let [result (generate {:root {:italiano {:italiano "bere"}}
-                          :synsem {:subcat ()
-                                   :sem {:subj {:pred :I}
-                                         :tense :past
-                                         :aspect :perfect}}}
-                         small)]
+  (let [result (first (take 1 (generate {:root {:italiano {:italiano "bere"}}
+                                         :synsem {:subcat ()
+                                                  :sem {:subj {:pred :I}
+                                                        :tense :past
+                                                        :aspect :perfect}}}
+                                        small)))]
     (is (not (nil? result)))
     (is (= "io ho bevuto" (fo result)))))

 (deftest passato-prossimo-reflexive
-  (let [result (generate {:head {:synsem {:agr {:gender :fem}}}
-                          :synsem {:subcat '()
-                                   :infl :present
-                                   :sem {:pred :get-up
-                                         :subj {:pred :I}
-                                         :tense :past
-                                         :aspect :perfect}}}
-                         small)]
+  (let [result (first (take 1 (generate {:head {:synsem {:agr {:gender :fem}}}
+                                         :synsem {:subcat '()
+                                                  :infl :present
+                                                  :sem {:pred :get-up
+                                                        :subj {:pred :I}
+                                                        :tense :past
+                                                        :aspect :perfect}}}
+                                        small)))]
     (is (not (nil? result)))
     (is (= "io mi sono alzata" (fo result)))))

@@ -60,13 +59,12 @@

 (deftest round-trip-1
-  (let [expr (generate {:synsem {:subcat '()
-                                 :sem {:spec {:def :def}
-                                       :mod {:pred :difficile}
-                                       :number :sing
-                                     :pred :donna}}}
-                       np-grammar
-                       {:allow-meta-lexemes false})]
+  (let [expr (first (take 1 (generate {:synsem {:subcat '()
+                                                :sem {:spec {:def :def}
+                                                      :mod {:pred :difficile}
+                                                      :number :sing
+                                                      :pred :donna}}}
+                                      np-grammar)))]
     (is (= (fo expr) "la donna difficile"))
     (is (not (empty? (parse (fo expr) np-grammar))))))

@@ -111,7 +109,7 @@
                            (take do-this-many expressions)))))))))

 (deftest roundtrip-small-grammar
-  (let [do-this-many 1000]
+  (let [do-this-many 100]
     (is (empty?
          (filter #(not (nil? %))
                  (let [expressions
@@ -131,5 +129,3 @@
                          (if (= do-this-many :all)
                            expressions
                            (take do-this-many expressions)))))))))
-
-


fix to judge identity

fix to judge identity

--- test/cljam/t_sorter.clj
+++ test/cljam/t_sorter.clj
@@ -77,12 +77,8 @@
         (with-reader sorter/sort-order tmp-queryname-sorted-sam-file-2) =future=> sorter/order-queryname
         (with-reader sorter/sort-order tmp-queryname-sorted-bam-file-2) =future=> sorter/order-queryname
         ;; compare generated files
-        (= (slurp-sam-for-test tmp-coordinate-sorted-sam-file)
-           (slurp-sam-for-test tmp-coordinate-sorted-sam-file-2)) => truthy
-        (= (slurp-bam-for-test tmp-coordinate-sorted-bam-file)
-           (slurp-bam-for-test tmp-coordinate-sorted-bam-file-2)) => truthy
-        (= (slurp-sam-for-test tmp-queryname-sorted-sam-file)
-           (slurp-sam-for-test tmp-queryname-sorted-sam-file-2)) =future=> truthy
-        (= (slurp-bam-for-test tmp-queryname-sorted-bam-file)
-           (slurp-bam-for-test tmp-queryname-sorted-bam-file-2)) =future=> truthy
+        (slurp-sam-for-test tmp-coordinate-sorted-sam-file-2) => (slurp-sam-for-test tmp-coordinate-sorted-sam-file)
+        (slurp-bam-for-test tmp-coordinate-sorted-bam-file-2) => (slurp-bam-for-test tmp-coordinate-sorted-bam-file)
+        (slurp-sam-for-test tmp-queryname-sorted-sam-file-2) =future=> (slurp-sam-for-test tmp-queryname-sorted-sam-file)
+        (slurp-bam-for-test tmp-queryname-sorted-bam-file-2) =future=> (slurp-bam-for-test tmp-queryname-sorted-bam-file)
         ))


Fix subscriber.

Fix subscriber.

--- test/onyx/log/log_test.clj
+++ test/onyx/log/log_test.clj
@@ -3,11 +3,14 @@
             [com.stuartsierra.component :as component]
             [onyx.system :as system]
             [onyx.extensions :as extensions]
-            [midje.sweet :refer :all]))
+            [midje.sweet :refer :all]
+            [onyx.api]))

 (def onyx-id (java.util.UUID/randomUUID))

 (def config (read-string (slurp (clojure.java.io/resource "test-config.edn"))))
+
+(def scheduler :onyx.job-scheduler/greedy)

 (def env-config
   {:hornetq/mode :udp
@@ -22,6 +25,7 @@
    :zookeeper/address (:address (:zookeeper config))
    :zookeeper/server? true
    :zookeeper.server/port (:spawn-port (:zookeeper config))
+   :onyx.peer/job-scheduler scheduler
    :onyx/id onyx-id})

 (def env (onyx.api/start-env env-config))
@@ -41,7 +45,7 @@

 (def ch (chan entries))

-(extensions/subscribe-to-log (:log env) 0 ch)
+(extensions/subscribe-to-log (:log env) ch)

 (future
   (try


Edited thread-last to conform to new rules.

It passes all the tests, so it must be good, right?

Right?

--- formatter/src/formatter/extensions/thread_last.clj
+++ formatter/src/formatter/extensions/thread_last.clj
@@ -3,22 +3,35 @@
             [formatter.parser :as par]))

 (def ^:dynamic *min-depth* 3)
+(def ^:dynamic *max-nonlast-depth* 2)
 (def ^:dynamic *do-not-nest*
   #{"defn" "loop" "let" "if" "and" "or" "fn" "deftest" "is" "testing"})

-(defn count-nesting
+; Kind of ugly with that double-if, but hey.
+(defn count-nonlast-nesting
+  "Counts the nesting level of the function node"
+  [tree]
+  (let [tree-vecs (filter #(and (vector? %) (= (first %) :Eval)) tree)]
+    (if (> (count tree-vecs) 0)
+        (inc (apply max (map count-nonlast-nesting tree-vecs)))
+        1)))
+
+(defn count-last-nesting
   "Counts the nesting levels of the tree, excluding functions listed in the
   *do-not-nest* var."
   [node]
-  (loop [node node n 0]
-    (let [node-vecs (filter #(or (vector? %) (= :Eval %)) node)]
+  (loop [node node n 0 nonlast-n 0]
+    (let [node-vecs (filter vector? node)]
       (cond
-        (contains? *do-not-nest* (second (second node-vecs)))
-          n
-        (and (= :Eval (first node-vecs)) (vector? (last node-vecs)))
-          (recur (last node-vecs) (inc n))
+        (contains? *do-not-nest* (second (first node-vecs)))
+          [n nonlast-n]
+        (and (= :Eval (first node)) (vector? (last node-vecs)))
+          (recur (last node-vecs)
+                 (inc n)
+                 (max nonlast-n
+                      (count-nonlast-nesting (butlast (rest node-vecs)))))
         :else
-          n))))
+          [n nonlast-n]))))

 (defn find-nested-nodes
   "Finds nodes with a thread-last nesting level greater than or equal to n.
@@ -27,9 +40,13 @@
   (* 9 2)."
   [tree]
   (if (sequential? tree)
-      (if (>= (count-nesting tree) *min-depth*)
-          (cons tree (mapcat #(find-nested-nodes %) (next tree)))
-          (mapcat #(find-nested-nodes %) (next tree)))
+      (let [[nesting nonlast-nesting] (count-last-nesting tree)]
+        (if (and (<= nonlast-nesting *max-nonlast-depth*)
+                 (>= nesting *min-depth*))
+            (let [last-of-tree (last (filter vector? tree))
+                  result (mapcat find-nested-nodes (next tree))]
+              (cons tree (remove #(= last-of-tree %) result)))
+            (mapcat #(find-nested-nodes %) (next tree))))
       nil))

 (defn nodes-to-strings


support Clojure semantics in `cljs.core/vec`, adopt arrays


wayward comma

wayward comma


artifact=true => machine = false

artifact=true => machine = false

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -37,6 +37,8 @@
                       :activity false
                       :living false
                       :physical-object true}
+
+   {:artifact false}  {:machine false}

    {:buyable true}   {:human false
                       :part-of-human-body false}


~(def present-perfect-grammar): add more rules

--- src/babel/italiano/lab.cljc
+++ src/babel/italiano/lab.cljc
@@ -315,8 +315,11 @@

 (def present-perfect-grammar
   #{"s-aux"
+    "vp-aux-22-nonphrasal-comp"
+    "vp-aux-22-phrasal-comp"
     "vp-aux-nonphrasal-complement"
     "vp-aux-phrasal-complement"
+    "vp-pronoun-phrasal"
     "vp-pronoun-nonphrasal"})

 (defn create-index-fn [verb-set grammar]
@@ -359,6 +362,20 @@
         indices (create-indices lexicon verbcoach-index-paths)]
     (fn [spec]
       (lookup-spec spec indices verbcoach-index-paths))))
+
+;; grow at:[s-aux C:_ H:[vp-pronoun-phrasal C:_ H:[vp-aux-22-nonphrasal-comp H:essere C:arrabbiarsi]]];
+;; frontier: (:head :comp); looking for spec:
+(def looking-for-spec
+  {:synsem {:pronoun true,
+            :subcat '(),
+            :cat :noun,
+            :agr :top,
+            :top :top,
+            :sem {:prop {:animate true}},
+            :reflexive true,
+            :case :acc},
+   :italiano {:initial true,
+              :cat :noun}})

 (defn arrabbiarsi
   "generate arrabiarsi sentences with a grammar subset."
@@ -379,6 +396,8 @@
     (binding [babel.generate/println? true
               babel.generate/truncate? false
               babel.generate/grammar grammar
+              ;; TODO: if this works, use this exception-filtering everywhere we generate Italiano.
+              babel.generate/lexical-filter (fn [lexeme] (= false (u/get-in lexeme [:italiano :exception] false)))
               babel.generate/index-fn index-fn]
       (time (generate spec model)))))


on-change clear selected item

on-change clear selected item

--- src/re_complete/handlers.cljs
+++ src/re_complete/handlers.cljs
@@ -58,7 +58,8 @@
          (assoc-in [:re-complete :linked-components linked-component-keyword :text] input)
          (assoc-in [:re-complete :linked-components linked-component-keyword :change-index] index)
          (assoc-in [:re-complete :linked-components linked-component-keyword :current-word] current-word)
-         (assoc-in [:re-complete :linked-components linked-component-keyword :completions] (app/completions current-word dictionary options))))))
+         (assoc-in [:re-complete :linked-components linked-component-keyword :completions] (app/completions current-word dictionary options))
+         (assoc-in [:re-complete :linked-components linked-component-keyword :selected-item] nil)))))

 (register-handler
  :add-completed-word


Add post-processing

Add post-processing

--- src/cfpb/qu/query/mongo.clj
+++ src/cfpb/qu/query/mongo.clj
@@ -20,10 +20,7 @@
             [cfpb.qu.query.select :as select]
             [cfpb.qu.query.parser :as parser]))

-(declare match project group sort validate)
-
-(defn- valid? [query]
-  (= 0 (reduce + (map count (:errors query)))))
+(declare valid? match project group sort validate post-process-validate)

 (defn process
   "Process the original query through the various filters used to
@@ -33,16 +30,36 @@
   (let [query (validate query)]
     (if (valid? query)
       (-> query
-          match
           project
           group
-          sort)
-      query)))
-
-(defn- add-error
-  [query field message]
-  (update-in query [:errors field]
-             (fnil #(conj % message) (vector))))
+          match
+          sort
+          post-process-validate)
+      query)))
+
+(defn- valid? [query]
+  (= 0 (reduce + (map count (:errors query)))))
+
+(declare validate-select validate-group validate-where
+         validate-order-by validate-limit validate-offset)
+
+(defn validate
+  "Check the query for any errors."
+  [query]
+  (if (not (:slicedef query))
+    query
+    (let [slicedef (:slicedef query)
+          dimensions (:dimensions slicedef)
+          metrics (:metrics slicedef)
+          column-set (set (concat dimensions metrics))]
+      (-> query
+          (assoc :errors {})
+          (validate-select column-set)
+          (validate-group column-set dimensions)
+          validate-where
+          validate-order-by
+          validate-limit
+          validate-offset))))

 (defn match
   "Add the :match provision of the Mongo query. Assemble the match
@@ -122,6 +139,11 @@
        flatten
        (filter keyword?)))

+(defn- add-error
+  [query field message]
+  (update-in query [:errors field]
+             (fnil #(conj % message) (vector))))
+
 (defn- validate-field
   [query clause column-set field]
   (let [field (name field)]
@@ -236,21 +258,6 @@
   [query]
   (validate-integer query :offset))

-(defn validate
-  "Check the query for any errors."
-  [query]
-  (if (or (:errors query)
-          (not (:slicedef query)))
-    query
-    (let [slicedef (:slicedef query)
-          dimensions (:dimensions slicedef)
-          metrics (:metrics slicedef)
-          column-set (set (concat dimensions metrics))]
-      (-> query
-          (assoc :errors {})
-          (validate-select column-set)
-          (validate-group column-set dimensions)
-          validate-where
-          validate-order-by
-          validate-limit
-          validate-offset))))
+(defn- post-process-validate
+  [query]
+  query)


fix case-lambda parsing and self-recur across arities

--- src/clj/wombat/compiler.clj
+++ src/clj/wombat/compiler.clj
@@ -191,7 +191,7 @@
     (cons 'lambda (sanitize-method env params body))))

 (defn sanitize-case-lambda
-  [env [_ methods :as form]]
+  [env [_ & methods :as form]]
   (cons 'case-lambda
         (for [[params & body] (validate-arities methods)]
           (sanitize-method env params body))))
@@ -421,10 +421,13 @@
         top-label (. gen newLabel)
         env (assoc env :top-label top-label)]
     (. gen visitCode)
-    (. gen mark top-label)
     (when rest-id
       (emit-list-from-array gen #(. gen loadArg (count params)))
-      (. gen storeLocal rest-id))
+      (. gen storeLocal rest-id)
+      (. gen visitInsn Opcodes/ACONST_NULL)
+      (. gen storeArg (count params)))
+
+    (. gen mark top-label)
     (emit-body env :context/return gen body)
     (. gen returnValue)
     (. gen endMethod)))
@@ -479,11 +482,13 @@
     (dec (count varg))))

 (defn min-variadic-arity
-  [fixed variadic]
-  (when variadic
-    (if (= (last fixed) (dec variadic))
-      variadic
-      (dec variadic))))
+  ([arglists] (min-variadic-arity (fixed-arities arglists)
+                                  (variadic-arity arglists)))
+  ([fixed variadic]
+     (when variadic
+       (if (= (last fixed) (dec variadic))
+         variadic
+         (dec variadic)))))

 (defn gen-applier
   [^ClassWriter cw ^Type thistype arglists]
@@ -684,7 +689,8 @@
     (doseq [[params & body] methods]
       (let [env (assoc env
                   :params (take-while before-rest params)
-                  :restarg (second (drop-while before-rest params)))]
+                  :restarg (second (drop-while before-rest params))
+                  :arglists arglists)]
         (gen-body cw env body)))
     (gen-applier cw thistype arglists)
     (gen-handle cw thistype arglists)))
@@ -1007,14 +1013,16 @@
   [env context ^GeneratorAdapter gen [_ name val :as form]]
   (when (> (count form) 3)
     (throw (IllegalArgumentException. "define only takes one value")))
-  (set-global! name (eval* val))
+  (binding [*lambda-name* name]
+    (set-global! name (eval* val)))
   (emit env context gen name))

 (defmethod emit-seq 'define-macro
   [env context ^GeneratorAdapter gen [_ name val :as form]]
   (when (> (count form) 3)
     (throw (IllegalArgumentException. "define-macro only takes one value")))
-  (set-macro! name (eval* val))
+  (binding [*lambda-name* name]
+    (set-macro! name (eval* val)))
   (emit env context gen name))

 (defmethod emit-seq 'if
@@ -1174,31 +1182,36 @@
           (list 'let (list (list res (explode-invocation call)))
                 res))))

+(defn arity-match?
+  [{:keys [restarg params arglists] :as env} args]
+  (if restarg
+    (>= (count args) (min-variadic-arity arglists))
+    (= (count args) (count params))))
+
 (defn emit-tail-call
-  [{:keys [recur-sym restarg top-label params] :as env} ^GeneratorAdapter gen [fun & args :as call]]
-  (if (= fun recur-sym)
+  [{:keys [recur-sym restarg top-label params locals] :as env} ^GeneratorAdapter gen [fun & args :as call]]
+  (if (and (= fun recur-sym)
+           (arity-match? env args))
                                         ; Self call, becomes loop
     (do
       (debug "emitting self tail-call: " call)
-      (when (or (and restarg (< (count args) (count params)))
-                (not= (count args) (count params)))
-        (throw (IllegalArgumentException.
-                (str "Wrong number of args (" (count args) " for " (count params) (when restarg "+") ")"))))
                                         ; emit all new values
       (dotimes [n (count params)]
         (emit env :context/expression gen (nth args n)))
       (when restarg
-        (let [extra (seq (drop (count params) args))]
-          (AsmUtil/pushInt gen (count extra))
-          (. gen newArray object-type)
-          (dotimes [n (count extra)]
-            (. gen dup)
-            (AsmUtil/pushInt gen n)
-            (emit env :context/expression gen (nth extra n))
-            (. gen arrayStore object-type))))
+        (emit-list-from-array gen
+                              #(let [extra (drop (count params) args)]
+                                 (AsmUtil/pushInt gen (count extra))
+                                 (. gen newArray object-type)
+                                 (dotimes [n (count extra)]
+                                   (. gen dup)
+                                   (AsmUtil/pushInt gen n)
+                                   (emit env :context/expression gen (nth extra n))
+                                   (. gen arrayStore object-type))))
+        (. gen storeLocal (get locals restarg)))
                                         ; store them in reverse order from stack
       (dotimes [n (count params)]
-        (. gen storeArg (- (count params) n (if restarg 0 1))))
+        (. gen storeArg (- (count params) n 1)))
       (. gen goTo top-label))
                                         ; Calls another fn, return continuation thunk
     (do


Solve bug in the AI + extract the eval heuristic

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -173,23 +173,23 @@
 ;; ARTIFICIAL INTELLIGENCE
 ;; -----------------------------------------

+(defn move-strength ;; TODO - Count taken is bad: select a better evaluation
+  "Compute the strength value of a move"
+  [move]
+  (count (:taken move)))
+
 (defn- best-immediate-move-with
   "Return the move with the highest immediate score increase:
    * For the provided player
    * And with move scope limitation"
-  [game player move-filter]
+  [moves move-filter]
   (apply max-key ;; TODO - max key is slow: it will recompute the same stuff over and over
     #(transduce
        (comp
          (filter move-filter)
-         (map (comp count :taken))) ;; TODO - Count taken is bad: select a better evaluation
+         (map move-strength))
        + (second %))
-    (get-in game [:moves player])))
-
-#_(defn best-immediate-move
-   "Return the move with the highest immediate score increase for the provided player"
-   [game player]
-   (best-immediate-move-with game player identity))
+    moves))

 (defn worst-immediate-loss
   "Return the next game move:
@@ -197,7 +197,8 @@
    * That would reduce the score for 'looser'"
   [game player looser]
   (let [move-filter #(= looser (:looser %))
-        move (best-immediate-move-with game (:player game) move-filter)]
+        all-moves (get-in game [:moves player])
+        move (best-immediate-move-with all-moves move-filter)]
     (transduce (map (comp count :taken)) + (second move))
     ))


Small cleaning

Small cleaning

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -17,8 +17,6 @@
 ;; -----------------------------------------
 ;; INIT THE BOARD
 ;; -----------------------------------------
-
-;; (defrecord Point [x y])

 (def empty-board
   (let [column (vec (repeat board-height :empty))]
@@ -68,7 +66,7 @@
    :winner :blue,
    :looser :red,
    :taken [[8 5] [9 5]]}"
-  [board [xi yi] [dx dy]]
+  [board [xi yi :as move] [dx dy]]
   (loop [x (+ xi dx)
          y (+ yi dy)
          looser nil
@@ -78,12 +76,11 @@
         (is-cell-empty? cell) nil ;; No move: reached end and only 1 type of cell
         (and looser (not= looser cell)) {:winner cell   ;; Who wins the cells
                                          :looser looser ;; Who looses the cells
-                                         :move [xi yi]  ;; The move performed
+                                         :move move     ;; The move performed
                                          :taken taken}  ;; The cells taken
         :else (recur
                 (+ x dx) (+ y dy)
-                (or looser cell)
-                (conj taken [x y])))
+                cell (conj taken [x y])))
       )))

 (defn available-moves-at
@@ -126,12 +123,6 @@
         all-positions)) ;; TODO - To optimize, just consider the move of the current player?
     ))

-(defn bench-test
-  [app-state]
-  (dotimes [n 10]
-    (do (with-available-moves app-state) nil)
-    ))
-

 ;; -----------------------------------------
 ;; ON PLAYER MOVE


Fetch psql events in pages

Fetch psql events in pages

--- src/rill/event_store/psql.clj
+++ src/rill/event_store/psql.clj
@@ -6,24 +6,44 @@
             [taoensso.nippy :as nippy]
             [clojure.tools.logging :as log]))

-(defrecord PsqlEventStore [spec]
+(defn record->message
+  [r]
+  (with-meta (assoc (nippy/thaw (:payload r))
+               ::message/number (:stream_order r))
+    {:cursor (or (:insert_order r)
+                 (:stream_order r))}))
+
+(defn select-stream-fn
+  [spec stream-id]
+  (fn [cursor page-size]
+    (sql/query spec ["SELECT payload, stream_order FROM rill_events WHERE stream_id = ? AND stream_order > ? ORDER BY insert_order ASC LIMIT ?"
+                     (str stream-id)
+                     cursor page-size])))
+
+(defn select-all-fn
+  [spec]
+  (fn [cursor page-size]
+    (sql/query spec ["SELECT payload, stream_order, insert_order FROM rill_events WHERE insert_order > ? ORDER BY insert_order ASC LIMIT ?"
+                     cursor page-size])))
+
+(defn messages
+  [cursor page-size selector]
+  (let [p (map record->message (selector cursor page-size))]
+    (if (< (count p) page-size)
+      (seq p) ;; make sure we return nil when no messages are found
+      (concat p (lazy-seq (messages (:cursor (meta (last p))) page-size selector))))))
+
+(defrecord PsqlEventStore [spec page-size]
   EventStore
   (retrieve-events-since [this stream-id cursor wait-for-seconds]
     (let [cursor (if (number? cursor)
                    cursor
                    (or (message/number cursor)
                        (throw (ex-info (str "Not a valid cursor: " cursor) {:cursor cursor}))))]
-      (or (seq (map (fn [r]
-                      (with-meta (assoc (nippy/thaw (:payload r))
-                                   ::message/number (:stream_order r))
-                        {:cursor (or (:insert_order r)
-                                     (:stream_order r))}))
+      (or (messages cursor page-size
                     (if (= stream-id all-events-stream-id)
-                      (sql/query spec ["SELECT payload, stream_order, insert_order FROM rill_events WHERE insert_order > ? ORDER BY insert_order ASC"
-                                       cursor])
-                      (sql/query spec ["SELECT payload, stream_order FROM rill_events WHERE stream_id = ? AND stream_order > ? ORDER BY insert_order ASC"
-                                       (str stream-id)
-                                       cursor]))))
+                      (select-all-fn spec)
+                      (select-stream-fn spec stream-id)))
           (do (when (< 0 wait-for-seconds)
                 (Thread/sleep 200))
               []))))
@@ -50,6 +70,7 @@
            (catch java.sql.BatchUpdateException e
              nil)))))

-(defn psql-event-store [spec]
-  (let [es (->PsqlEventStore spec)]
+(defn psql-event-store [spec & [{:keys [page-size] :or {page-size 20}}]]
+  {:pre [(integer? page-size)]}
+  (let [es (->PsqlEventStore spec page-size)]
     (assoc es :store es)))


Stop requiring Push connection to compile.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -5,7 +5,13 @@
             [com.evocomputing.colors :as colors]
             [overtone.midi :as midi]))

-(defonce user-port-out (midi/midi-out "Ableton Push User Port"))
+(defonce user-port-out (atom nil))
+
+(defn connect-to-push
+  "Try to establish the connection to the Ableton Push, if that has
+  not already been made."
+  []
+  (swap! user-port-out #(or % (midi/midi-out "Ableton Push User Port"))))

 (defn velocity-for-color
   "Given a target color, calculate the MIDI note velocity which will
@@ -42,5 +48,5 @@
   [x y color]
   {:pre [(<= 0 x 7) (<= 0 y 7)]}
   (let [note (+ 36 x (* y 8))]  ;; Calculate note from grid coordinates
-    (midi/midi-note-on user-port-out note (velocity-for-color color))))
+    (midi/midi-note-on @user-port-out note (velocity-for-color color))))


Don't display changelog in menu

Don't display changelog in menu

Takes a long time to load & we haven't really been updating
CHANGELOG.md anyway...

--- src/braid/core/client/ui/views/header.cljs
+++ src/braid/core/client/ui/views/header.cljs
@@ -112,7 +112,7 @@
     :route-fn routes/page-path
     :route-args {:page-id "me"}
     :body "Edit Your Profile"}
-   {:class "changelog"
+   #_{:class "changelog"
     :route-fn routes/page-path
     :route-args {:page-id "changelog"}
     :body "See Changelog"}])


Add more metrics to understand matcher performance

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -393,10 +393,13 @@
        (sort-by (fn [{{:keys [mem cpus]} :resources}] [mem cpus]))
        reverse))

-(timers/deftimer  [cook-mesos scheduler handle-resource-offer!-duration])
-(meters/defmeter  [cook-mesos scheduler pending-job-atom-contended])
+(timers/deftimer [cook-mesos scheduler handle-resource-offer!-duration])
+(timers/deftimer [cook-mesos scheduler handler-resource-offer!-transact-task-duration])
+(timers/deftimer [cook-mesos scheduler handler-resource-offer!-match-duration])
+(meters/defmeter [cook-mesos scheduler pending-job-atom-contended])
 (histograms/defhistogram [cook-mesos scheduler offer-size-mem])
 (histograms/defhistogram [cook-mesos scheduler offer-size-cpus])
+(histograms/defhistogram [cook-mesos scheduler number-tasks-matched])
 (meters/defmeter [cook-mesos scheduler scheduler-offer-matched])
 (meters/defmeter [cook-mesos scheduler handle-resource-offer!-errors])
 (meters/defmeter [cook-mesos scheduler matched-tasks])
@@ -439,7 +442,9 @@
                                                          (filter #(false? (:instance/preempted? %)))
                                                          (map :instance/hostname)))))
                                    scheduler-contents)
-              matches (match-offer-to-schedule considerable offer)
+              matches (timers/time!
+                        handler-resource-offer!-match-duration
+                        (match-offer-to-schedule considerable offer))
               ;; We know that matches always form a prefix of the scheduler's contents
               new-scheduler-contents (remove (set matches) scheduler-contents)
               first-considerable-resources (-> considerable first util/job-ent->resources)
@@ -472,32 +477,35 @@
               ;; during a race. If that happens, then other jobs that should
               ;; be scheduled will not be eligible for rescheduling until
               ;; the pending-jobs atom is repopulated
-              @(d/transact
-                 conn
-                 (mapcat (fn [task-info]
-                           [[:job/allowed-to-start? (:job-id task-info)]
-                            {:db/id (d/tempid :db.part/user)
-                             :job/_instance (:job-id task-info)
-                             :instance/task-id (:task-id task-info)
-                             :instance/hostname (:hostname offer)
-                             :instance/start-time (now)
-                             ;; NB command executor uses the task-id
-                             ;; as the executor-id
-                             :instance/executor-id (get-in
-                                                     task-info
-                                                     [:executor :executor-id]
-                                                     (:task-id task-info))
-                             :instance/slave-id (:slave-id offer)
-                             :instance/progress 0
-                             :instance/status :instance.status/unknown
-                             :instance/preempted? false}])
-                         task-infos))
+              (timers/time!
+                handler-resource-offer!-transact-task-duration
+                @(d/transact
+                   conn
+                   (mapcat (fn [task-info]
+                             [[:job/allowed-to-start? (:job-id task-info)]
+                              {:db/id (d/tempid :db.part/user)
+                               :job/_instance (:job-id task-info)
+                               :instance/task-id (:task-id task-info)
+                               :instance/hostname (:hostname offer)
+                               :instance/start-time (now)
+                               ;; NB command executor uses the task-id
+                               ;; as the executor-id
+                               :instance/executor-id (get-in
+                                                       task-info
+                                                       [:executor :executor-id]
+                                                       (:task-id task-info))
+                               :instance/slave-id (:slave-id offer)
+                               :instance/progress 0
+                               :instance/status :instance.status/unknown
+                               :instance/preempted? false}])
+                           task-infos)))
               (log/info "Matched offer" offer "to tasks" task-infos)
               ;; This launch-tasks MUST happen after the above transaction in
               ;; order to allow a transaction failure (due to failed preconditions)
               ;; to block the launch
               (meters/mark! scheduler-offer-matched (count (:ids offer)))
               (meters/mark! matched-tasks (count task-infos))
+              (histograms/update! number-tasks-matched (count task-infos))
               (meters/mark! matched-tasks-cpus (:cpus match-resource-requirements))
               (meters/mark! matched-tasks-mem (:mem match-resource-requirements))
               (mesos/launch-tasks


Add locking around fenzo

Add locking around fenzo

Signed-off-by: Wil <41c73e1c187a64e501bf473cfef5419e8eb5a640@twosigma.com>

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -410,14 +410,20 @@
   [^TaskScheduler fenzo considerable offers db fid]
   (log/debug "Matching" (count offers) "offers to" (count considerable) "jobs with fenzo")
   (let [t (System/currentTimeMillis)
+        _ (log/debug "offer to scheduleOnce" offers)
+        _ (log/debug "tasks to scheduleOnce" considerable)
         leases (mapv #(->VirtualMachineLeaseAdapter % t) offers)
         requests (mapv (fn [job]
                          (->TaskRequestAdapter job (job->task-info db fid (:db/id job))))
                        considerable)
-        result (.scheduleOnce fenzo requests leases)
+        ;; Need to lock on fenzo when accessing scheduleOnce because scheduleOnce and
+        ;; task assigner can not be called at the same time.
+        ;; task assigner may be called when reconciling
+        result (locking fenzo
+                 (.scheduleOnce fenzo requests leases))
         failure-results (.. result getFailures values)
         assignments (.. result getResultMap values)]
-    (log/info "Found this assigment:" result)
+    (log/debug "Found this assigment:" result)
     (when (and (seq failure-results) (log/enabled? :debug))
       (log/debug "Task placement failure information follows:")
       (doseq [failure-result failure-results
@@ -783,9 +789,12 @@
               :let [task-ent (d/entity db [:instance/task-id task-id])
                     hostname (:instance/hostname task-ent)
                     job (:job/_instance task-ent)]]
-        (.. fenzo
-            (getTaskAssigner)
-            (call (->TaskRequestAdapter job (job->task-info db fid (:db/id job))) hostname)))
+        ;; Need to lock on fenzo when accessing taskAssigner because taskAssigner and
+        ;; scheduleOnce can not be called at the same time.
+        (locking fenzo
+          (.. fenzo
+              (getTaskAssigner)
+              (call (->TaskRequestAdapter job (job->task-info db fid (:db/id job))) hostname))))
       (doseq [ts (partition-all 50 running-tasks)]
         (log/info "Reconciling" (count ts) "tasks, including task" (first ts))
         (mesos/reconcile-tasks driver (mapv (fn [[task-id status slave-id]]


added compiler optimizations for store and load, store_loc and loc

--- src/selectscript/compiler.clj
+++ src/selectscript/compiler.clj
@@ -99,8 +99,23 @@
                       (conc asm_ [(count ids_)] ids_)))
                #{:LOAD}
                (let [[data_ i] (cmp:data data (second code))]
-                 (cmp:base (conj (nthrest code 2) i) data_ asm_ list))
-               #{:CST_STR :LOC :LOCX :STORE :STORE_LOC}
+                 (if (= [(+ 128 (:STORE OP)) i]
+                        (take-last 2 asm))
+                   (cmp (nthrest code 2)
+                        data
+                        (conc (drop-last 2 asm)
+                              [(:STORE OP) i]))
+                   (cmp:base (conj (nthrest code 2) i) data_ asm_ list)))
+               #{:LOC}
+               (let [[data_ i] (cmp:data data (second code))]
+                 (if (= [(+ 128 (:STORE_LOC OP)) i]
+                        (take-last 2 asm))
+                   (cmp (nthrest code 2)
+                        data
+                        (conc (drop-last 2 asm)
+                              [(:STORE_LOC OP) i]))
+                   (cmp:base (conj (nthrest code 2) i) data_ asm_ list)))
+               #{:CST_STR :LOCX :STORE :STORE_LOC}
                (let [[data_ i] (cmp:data data (second code))]
                  (cmp:base (conj (nthrest code 2) i) data_ asm_ list))
                #{:CALL_FCTX


More optimizations for Uwes Algorithm

More optimizations for Uwes Algorithm

this time more substantial.

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/experimental/ryssel_algorithm.clj
+++ src/conexp/contrib/experimental/ryssel_algorithm.clj
@@ -34,8 +34,7 @@
           (<= 2 (get count x))))))

 (defn- minimum-covers [base-set sets]
-  (let [sets    (sort #(>= (count %1) (count %2)) sets),
-        result  (atom []),
+  (let [result  (atom []),
         search  (fn search [rest-base-set current-cover cover-count sets]
                   (cond
                    (redundant? base-set current-cover cover-count)
@@ -49,19 +48,23 @@

                    :else
                    (when (covers? sets rest-base-set)
-                     (search (difference rest-base-set (first sets))
-                             (conj current-cover (first sets))
-                             (reduce! (fn [map x]
-                                        (if (contains? base-set x)
-                                          (assoc! map x (inc (get map x)))
-                                          map))
-                                      cover-count
-                                      (first sets))
-                             (rest sets))
-                     (search rest-base-set
-                             current-cover
-                             cover-count
-                             (rest sets)))))]
+                     (let [counts (map-by-fn #(count (intersection rest-base-set %))
+                                             sets),
+                           sets   (sort #(>= (counts %1) (counts %2))
+                                        sets)],
+                       (search (difference rest-base-set (first sets))
+                               (conj current-cover (first sets))
+                               (reduce! (fn [map x]
+                                          (if (contains? base-set x)
+                                            (assoc! map x (inc (get map x)))
+                                            map))
+                                        cover-count
+                                        (first sets))
+                               (rest sets))
+                       (search rest-base-set
+                               current-cover
+                               cover-count
+                               (rest sets))))))]
     (search base-set
             #{}
             (map-by-fn (constantly 0) base-set)
@@ -110,13 +113,13 @@
                                  (for [N M
                                        :when (subset? A N),
                                        m (gens A),
-                                       n (gens N),
-                                       :when (not= m n)]
-                                   (make-implication #{m} #{n}))),
-              M-down-A     (set-of V | V M :when (proper-subset? V A)),
+                                       :when (not= (gens N) #{m})]
+                                   (make-implication #{m} (gens N)))),
               candidates   (set-of U | U (disj M A),
-                                       :when (not (exists [V M-down-A]
-                                                    (subset? (intersection U A) V)))),
+                                       :let [UcapA (intersection U A)]
+                                       :when (not (exists [V M]
+                                                    (and (proper-subset? V A)
+                                                         (subset? UcapA V))))),
               candidates   (difference candidates
                                        (set-of (intersection X Y) | X candidates, Y candidates
                                                                     :when (and (not (subset? X Y))


Comment out spec-validation

Comment out spec-validation

--- examples/http-swagger/src/example/server.clj
+++ examples/http-swagger/src/example/server.clj
@@ -113,8 +113,8 @@
                              :body {:total (- x y)}})}}]]]

       {;:reitit.interceptor/transform dev/print-context-diffs ;; pretty context diffs
-       :validate spec/validate ;; enable spec validation for route data
-       :reitit.spec/wrap spell/closed ;; strict top-level validation (alpha)
+       ;;:validate spec/validate ;; enable spec validation for route data
+       ;;:reitit.spec/wrap spell/closed ;; strict top-level validation (alpha)
        :exception pretty/exception
        :data {:coercion spec-coercion/coercion
               :muuntaja m/instance


Moved common util method from indexer-app to common-lib.

--- src/cmr/common/concepts.clj
+++ src/cmr/common/concepts.clj
@@ -59,3 +59,8 @@
   [{:keys [concept-type sequence-number provider-id]}]
   (let [prefix (concept-type->concept-prefix concept-type)]
     (format "%s%d-%s" prefix sequence-number provider-id)))
+
+(defn concept-id->type
+  "Returns concept type for the given concept-id"
+  [concept-id]
+  (concept-prefix->concept-type (subs concept-id 0 1)))


Some lines of code are refactored.

Some lines of code are refactored.

--- src/sweet_crossplane/core.clj
+++ src/sweet_crossplane/core.clj
@@ -699,8 +699,7 @@
              [:div.col-md-3 (search-condition-panel entity-class-key {:target-element-id (get-in *request* [:params :target-element-id])})]
              [:div.col-md-9 (list-entities-panel    entity-class-key entities page-count page
                                                     (fn [entity]
-                                                      (link-to-javascript
-                                                       {:class "btn btn-primary btn-xs"} (<< "$.crossplane.setOpenerSelectProperty('~{target-element-id}', '~(:key entity)', '~(format-property-param entity-class-key representative-property-key (get entity representative-property-key))'); window.close()")
+                                                      (link-to-javascript {:class "btn btn-primary btn-xs"} (<< "$.crossplane.setOpenerSelectProperty('~{target-element-id}', '~(:key entity)', '~(format-property-param entity-class-key representative-property-key (get entity representative-property-key))'); window.close()")
                                                        [:span.glyphicon.glyphicon-link]))
                                                     (fn []
                                                       (let [target-element-id (get-in *request* [:params :target-element-id])]


Added system trace lib as dependency.

Added system trace lib as dependency.

--- project.clj
+++ project.clj
@@ -9,7 +9,8 @@
                  [nasa-cmr/cmr-indexer-app "0.1.0-SNAPSHOT"]
                  [nasa-cmr/cmr-metadata-db-app "0.1.0-SNAPSHOT"]
                  [nasa-cmr/cmr-common-lib "0.1.1-SNAPSHOT"]
-                 [nasa-cmr/cmr-umm-lib "0.1.0-SNAPSHOT"]]
+                 [nasa-cmr/cmr-umm-lib "0.1.0-SNAPSHOT"]
+                 [nasa-cmr/cmr-system-trace-lib "0.1.0-SNAPSHOT"]]
   :plugins []
   :repl-options {:init-ns user}
   :profiles


Update CIDER nrepl plugin version

Update CIDER nrepl plugin version

--- project.clj
+++ project.clj
@@ -56,7 +56,7 @@
                                   [pjstadig/humane-test-output "0.6.0"]]

                    :plugins [[lein-figwheel "0.1.4-SNAPSHOT"]
-                             [cider/cider-nrepl "0.8.2-SNAPSHOT"]]
+                             [cider/cider-nrepl "0.9.0-SNAPSHOT"]]

                    :injections [(require 'pjstadig.humane-test-output)
                                 (pjstadig.humane-test-output/activate!)]


Updated dependencies to Clojure 1.2.0

Updated dependencies to Clojure 1.2.0

--- project.clj
+++ project.clj
@@ -1,10 +1,10 @@
-(defproject compojure "0.4.1"
+(defproject compojure "0.5.0-beta1"
   :description "A concise web framework for Clojure"
   :url "http://github/weavejester/compojure"
-  :dependencies [[org.clojure/clojure "1.1.0"]
-                 [org.clojure/clojure-contrib "1.1.0"]
-                 [clout "0.2.0"]
-                 [ring/ring-core "0.2.5"]]
-  :dev-dependencies [[lein-clojars "0.5.0"]
+  :dependencies [[org.clojure/clojure "1.2.0"]
+                 [org.clojure/clojure-contrib "1.2.0"]
+                 [clout "0.3.0"]
+                 [ring/ring-core "0.3.0-RC1"]]
+  :dev-dependencies [[lein-clojars "0.6.0"]
                      [swank-clojure "1.2.1"]
-                     [ring/ring-jetty-adapter "0.2.5"]])
+                     [ring/ring-jetty-adapter "0.3.0-RC1"]])


Bump version number for 0.4.0 release

Bump version number for 0.4.0 release

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject puppetlabs/kitchensink "0.3.1-SNAPSHOT"
+(defproject puppetlabs/kitchensink "0.4.0"
   :description "Clojure utility functions"
   :license {:name "Apache License, Version 2.0"
             :url "http://www.apache.org/licenses/LICENSE-2.0.html"}


Prepare for next development iteration (0.6.1-SNAPSHOT)

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject cljam "0.6.0"
+(defproject cljam "0.6.1-SNAPSHOT"
   :description "A DNA Sequence Alignment/Map (SAM) library for Clojure"
   :url "https://github.com/chrovis/cljam"
   :license {:name "Apache License, Version 2.0"


project.clj: Add org.clojure/data.json dependency.

--- project.clj
+++ project.clj
@@ -7,6 +7,7 @@
   [[org.clojure/clojure "1.5.1"]
    [lib-noir "0.6.6"]
    [compojure "1.1.5"]
+   [org.clojure/data.json "0.2.2"]
    [ring-server "0.2.8"]]
   :ring
   {:handler wlmmap.handler/war-handler,


removed redundant dependency

removed redundant dependency

--- project.clj
+++ project.clj
@@ -7,7 +7,6 @@
                  [com.codahale.metrics/metrics-core "3.0.2"]
                  [com.codahale.metrics/metrics-json "3.0.2"]
                  [com.codahale.metrics/metrics-healthchecks "3.0.2"]
-                 [com.fasterxml.jackson.core/jackson-databind "2.2.2"]
                  [cheshire "5.3.1" :scope "test"]])


Upgrade Clojure (1.9.0) / ClojureScript (1.9.946)

--- project.clj
+++ project.clj
@@ -1,10 +1,9 @@
 (defproject test-utils-cljs "0.1.0-SNAPSHOT"
   :description "FIXME: write this!"
   :url "http://example.com/FIXME"
-  :dependencies [[org.clojure/clojure "1.8.0"]
-                 [org.clojure/clojurescript "1.8.51" :classifier "aot"
-                  :exclusion [org.clojure/data.json]]
-                 [org.clojure/data.json "0.2.6" :classifier "aot"]]
+  :dependencies [[org.clojure/clojure "1.9.0"]
+                 [org.clojure/clojurescript "1.9.946" :classifier "aot"]
+                 [kixi/stats "0.4.0"]]
   :jvm-opts ^:replace ["-Xmx1g" "-server"]
   :plugins [[lein-npm "0.6.1"]]
   :npm {:dependencies [[source-map-support "0.3.2"]]}