Factor out add-dispatch-entries and applicable-middleware

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -383,13 +383,37 @@
               (maybe-resolver-by-tag arg)))
       arglist)))

+(defn add-dispatch-entries [dispatch-map method pathvec handler]
+  (let [pathvec'      (mapv #(if (variable? %) ::param-next %) pathvec)
+        dispatch-path (conj pathvec' method)
+        binding-names (filter variable? pathvec)
+        binding-paths (keep-indexed
+                        (fn [i seg]
+                          (if (variable? seg)
+                            (-> (subvec pathvec' 0 i)
+                              (into [])
+                              (conj ::param-name))))
+                        pathvec)]
+    (reduce (fn [dispatch-map [name path]]
+              (assoc-in dispatch-map path (keyword name)))
+      (assoc-in dispatch-map dispatch-path handler)
+      (map vector binding-names binding-paths))))
+
+(defn applicable-middleware [specified-middleware arg-resolvers]
+  (let [mw (eval specified-middleware)]
+    (if (seq arg-resolvers)
+      (let [resolvers (mapv eval arg-resolvers)]
+        (fn [handler]
+          (apply rook/wrap-with-arg-resolvers
+            (mw handler) resolvers)))
+      mw)))
+
 (defn build-dispatch-map
   "Returns a dispatch-map for use with map-traversal-dispatcher."
   [{:keys [routes handlers middleware]}
    {:keys [async?]}]
   (reduce (fn [dispatch-map [[method pathvec] handler-sym]]
-            (let [ensure-fn #(if (fn? %) % (eval %))
-                  apply-middleware (if async?
+            (let [apply-middleware (if async?
                                      apply-middleware-async
                                      apply-middleware-sync)

@@ -403,20 +427,14 @@
                                  (resolvers-for arglist (:resolvers metadata))
                                  route-params)

-                  mw (get middleware middleware-sym)
-                  mw (ensure-fn mw)
-                  mw (if (or #_route-param-resolver (seq arg-resolvers))
-                       (let [resolvers
-                             (mapv ensure-fn
-                               (concat #_route-param-resolver arg-resolvers))]
-                         (fn [handler]
-                           (apply rook/wrap-with-arg-resolvers
-                             (mw handler) resolvers)))
-                       mw)
-
-                  ef (ensure-fn verb-fn-sym)
-                  f  (fn wrapped-handler [request]
-                       (apply ef (resolve-args request)))
+                  mw (applicable-middleware
+                       (get middleware middleware-sym)
+                       arg-resolvers)
+
+                  f  (let [ef (eval verb-fn-sym)]
+                       (fn wrapped-handler [request]
+                         (apply ef (resolve-args request))))
+
                   h  (apply-middleware mw sync? f)
                   h  (fn wrapped-with-rook-metadata [request]
                        (h (-> request
@@ -424,23 +442,8 @@
                               merge (dissoc metadata :arg-resolvers))
                             ;; FIXME
                             (cond-> context
-                              (update-in [:context] str context)))))
-
-                  pathvec' (mapv #(if (variable? %) ::param-next %) pathvec)
-
-                  dispatch-path (conj pathvec' method)
-                  binding-names (filter variable? pathvec)
-                  binding-paths (keep-indexed
-                                  (fn [i seg]
-                                    (if (variable? seg)
-                                      (-> (subvec pathvec' 0 i)
-                                        (into [])
-                                        (conj ::param-name))))
-                                  pathvec)]
-              (reduce (fn [dispatch-map [name path]]
-                        (assoc-in dispatch-map path (keyword name)))
-                (assoc-in dispatch-map dispatch-path h)
-                (map vector binding-names binding-paths))))
+                              (update-in [:context] str context)))))]
+              (add-dispatch-entries dispatch-map method pathvec h)))
     {}
     routes))


Remove mention of build-pattern-matching-handler from dispatcher's ns docstring

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -22,12 +22,7 @@
      compile-dispatch-table.

   compile-dispatch-table takes several options; these are all
-  described in its docstring.
-
-  Also of note are the two built-in compilation strategies for use
-  with compile-dispatch-table's :build-handler-fn option:
-  build-pattern-matching-handler and build-map-traversal-handler. See
-  their own docstrings for details."
+  described in its docstring."
   (:require [clojure.core.async :as async]
             [clojure.string :as string]
             [clojure.pprint :as pp]


check that :subtype key exists

check that :subtype key exists

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1506,8 +1506,9 @@
                                             (when no-cost " at no cost")))))
                  ;Apply added-virus-counter flag for this turn if the card enters play with a counter
                  (if (and
+                       (contains? installed-card :counter)
+                       (contains? installed-card :subtype)
                        (re-find #"Virus" (:subtype card))
-                       (contains? installed-card :counter)
                        (> (:counter installed-card) 0))
                    (update! state side (assoc installed-card :added-virus-counter true))
                    )


Use the correct year specifier to SimpleDateFormat.

\Y gives you "week year" in java 7+, and causes SDF to throw on java
1.6 (which we're using in prod).

--- src/clojars/admin.clj
+++ src/clojars/admin.clj
@@ -8,7 +8,7 @@
            java.text.SimpleDateFormat))

 (defn current-date-str []
-  (.format (SimpleDateFormat. "YYYYMMdd") (db/get-time)))
+  (.format (SimpleDateFormat. "yyyyMMdd") (db/get-time)))

 (defn repo->backup [parts]
   (let [backup (doto (io/file (:deletion-backup-dir config))


remove dead code

remove dead code

--- src/fat_jar/core.clj
+++ src/fat_jar/core.clj
@@ -40,7 +40,6 @@
          errors? #(not (empty? (:errors %)))
          help? #(:help %)
          print-help #(do (println "usage:") (println (:summary %)))]
-         ; (println options)
     (cond
       (errors? options) (do (print-help options) (println (:errors options)))
       (help? options) (print-help options)


just cleaning up

just cleaning up

--- src/grid/render.cljs
+++ src/grid/render.cljs
@@ -15,14 +15,12 @@

 (q/defcomponent Grid
   [meta data]
-  (let [header (:header meta)]
     (d/div {:className "panel panel-default"}
            (d/div {:className "panel-heading"} (str "SuperAmazing ClojureScript w/React grid"))
            (d/table {:className "table"}
                     (render-header (:header meta))
                     (apply d/tbody {}
-                           (map (partial User (:header meta)) (:data data)))))))
-
+                           (map (partial User (:header meta)) (:data data))))))

 (def my-data {:data [{:name "John Doe"
                           :email "user@email.com"
@@ -31,7 +29,9 @@
                           :email "frank.bolviken@gmail.com"
                           :country "Norway"}]})

-(def my-meta {:header [{:key :email :title "Email" :className "email"}
+(def my-meta {:header [{:key :email :title "Email"
+                        :className "email"
+                        :onClick (fn [] (...))}
                        {:key :name :title "Name"}
                        {:key :country :title "Country"}]})


Fix the base case of a raw Group

Fix the base case of a raw Group

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -27,18 +27,19 @@
   :examples -> dir"

   [{store :datastore} which thing]
-  (let [d (get store which (:docs store))
-        p (io/file (str d "/" (thing->path (:parent thing))))
-        e (case which
-            (:meta)     ".edn"
-            (:related)  ".txt"
-            (:examples) nil
-            (:notes)    ".md"
-            nil)
-        n (if (= :def (:type thing))
-            (util/munge (:name thing))
-            (:name thing))
-        h (io/file p (str n e))]
+  (let [d      (get store which (:docs store))
+        parent (:parent thing)
+        p      (io/file (str d "/" (when parent (thing->path parent))))
+        e      (case which
+                 (:meta)     ".edn"
+                 (:related)  ".txt"
+                 (:examples) nil
+                 (:notes)    ".md"
+                 nil)
+        n      (if (= :def (:type thing))
+                 (util/munge (:name thing))
+                 (:name thing))
+        h      (io/file p (str n e))]
     (.mkdirs p)
     (when (= :examples which)
       (when-not (.isDirectory h)


Clean up -main some

Clean up -main some

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -175,35 +175,42 @@
   [p-groupid p-artifactid p-version p-source-paths ;; provided by lein
    mode-selector & args ;; user provided
    ]
-  (let [config  {:groupid    p-groupid
-                 :artifactid p-artifactid
-                 :version    p-version
-                 :datastore  {:docs (last args)}}]
-    (case mode-selector
-      ("artifact" :artifact)
-      ,,(let [[groupid artifactid version _dst] args
-              _ (assert groupid)
-              _ (assert artifactid)
-              _ (assert version)
-              _ (assert _dst)
-              pattern (format ".*?/%s/%s/%s.*"
-                              (string/replace groupid "." "/")
-                              artifactid
-                              version)
-              pattern (re-pattern pattern)]
-          (doseq [e (cp/classpath)]
-            (when (re-matches pattern (str e))
-              (doseq [ns (tns.f/find-namespaces [e])]
-                (when-not (= ns 'clojure.parallel) ;; FIXME: get out nobody likes you
-                  (require ns)
-                  (write-docs-for-ns config ns))))))
-
-      ("src" :src "source" :source)
-      ,,(doseq [ns (->> p-source-paths
+  (case mode-selector
+    ("artifact" :artifact)
+    ,,(let [[groupid artifactid version dst] args
+            _ (assert groupid "Groupid missing!")
+            _ (assert artifactid "Artifactid missing!")
+            _ (assert version "Version missing!")
+            _ (assert dst "Doc target dir missing!")
+            config {:groupid    groupid
+                    :artifactid artifactid
+                    :version    version
+                    :datastore  {:docs dst}}
+            pattern (format ".*?/%s/%s/%s.*"
+                            (string/replace groupid "." "/")
+                            artifactid
+                            version)
+            pattern (re-pattern pattern)]
+        (doseq [e (cp/classpath)]
+          (when (re-matches pattern (str e))
+            (doseq [ns (tns.f/find-namespaces [e])]
+              (when-not (= ns 'clojure.parallel) ;; FIXME: get out nobody likes you
+                (require ns)
+                (write-docs-for-ns config ns))))))
+
+    ("src" :src "source" :source)
+    ,,(let [[doc] args
+            _ (assert doc "Doc target dir missing!")
+
+            config  {:groupid    p-groupid
+                               :artifactid p-artifactid
+                               :version    p-version
+                               :datastore  {:docs (last args)}}]
+        (doseq [ns (->> p-source-paths
                         (string/split #" ")
                         (map io/file)
                         (tns.f/find-namespaces))]
           (require ns)
           (write-docs-for-ns config ns))

-      (:doc (meta #'-main)))))
+        (:doc (meta #'-main)))))


cleaner docstring for keypin.store namespace

--- src/keypin/store.clj
+++ src/keypin/store.clj
@@ -25,8 +25,15 @@

 (defn fetch-every?
-  "Given duration in milliseconds, return a fetch decider (fn fetch? [last-fetch-time-millis]) that returns `true` if
-  it is time to fetch data, `false` otherwise."
+  "Given duration in milliseconds, return a fetch decider (predicate) function
+
+  ```
+  (fn [^keypin.type.record.StoreState store-state]) -> boolean
+  ```
+
+  that returns `true` if the duration has elapsed, `false` otherwise.
+
+  See: [[make-dynamic-store]]"
   [^long duration-millis]
   (fn [^StoreState store-state]
     (>= (i/now-millis (.-updated-at store-state))
@@ -34,6 +41,22 @@

 (defn fetch-if-error?
+  "Given error-timestamp key and duration since error, return a fetch decider (predicate) function
+
+  ```
+  (fn [^keypin.type.record.StoreState store-state]) -> boolean
+  ```
+
+  that returns `true` if error happened + duration elapsed,
+  `false` if error happened + duration NOT elapsed, `true` otherwise.
+
+  |Error occured?|Duration elapsed?|Return|
+  |--------------|-----------------|------|
+  |      Yes     |       Yes       | True |
+  |              |        No       | False|
+  |       No     |                 | True |
+
+  See: [[make-dynamic-store]]"
   [err-ts-key ^long millis-since-error]
   (fn [^StoreState store-state]
     (if-let [err-ts (get store-state err-ts-key)]
@@ -43,6 +66,10 @@

 (defn wait-if-stale
+  "Given staleness duration and refresh-wait timeout in milliseconds, return a function `(fn [state-agent])` that
+  detects stale store and waits until timeout for a refresh.
+
+  See: [[make-dynamic-store]]"
   [^long stale-millis ^long timeout-millis]
   (fn [state-agent]
     (let [^StoreState store-state @state-agent
@@ -64,10 +91,10 @@

 (defn make-dynamic-store
-  "Given a fetch function (fn [old-data])->new-data that fetches a map instance, and initial data (`nil`: initialized
-  asynchronously in another thread), create a dynamic store that refreshes itself.
+  "Given a fetch function `(fn [old-data]) -> new-data` that fetches a map instance, and initial data
+  (`nil`: initialized asynchronously in another thread), create a dynamic store that refreshes itself.

-  ## Options
+  ### Options

   | Kwarg          | Type/format                 | Description                 | Default |
   |----------------|-----------------------------|-----------------------------|---------|
@@ -78,7 +105,7 @@

   You may deref StoreState-holder to access its contents.

-  ## Examples
+  ### Examples

   ```
   (make-dynamic-store f nil)  ; async initialization, refresh interval 1 second


Fix a problem with multi-cd archiving

Fix a problem with multi-cd archiving

--- src/mdr2/archive.clj
+++ src/mdr2/archive.clj
@@ -108,7 +108,8 @@
                                         (str  "_" volume))
                                       ".iso")
                 iso-archive-path (.getPath (file archive-path iso-archive-name))]
-            (fs/copy+ (path/iso-name production (when (prod/multi-volume?) volume))
+            (fs/copy+ (path/iso-name production
+                                     (when (prod/multi-volume? production) volume))
                       iso-archive-path))))
       (log/error "Archive path %s already exists" archive-path))))


WIP on paredit-forward-slurp-sexp

WIP on paredit-forward-slurp-sexp

--- src/paredit/core.clj
+++ src/paredit/core.clj
@@ -718,13 +718,25 @@
 ;;; get new string from parent (re-indenting according to lisp rules)
 ;;;

-(defn- rightmost-non-punct
-  [loc]
-  )
+(defn- take-to-non-punct
+  ([dir-fn loc]
+     (take-to-non-punct dir-fn loc '()))
+  ([dir-fn loc ret]
+     (if (or (punct-loc? loc) (gspaces (loc-tag loc)))
+       (do (prn (loc-text loc))
+           (recur dir-fn (dir-fn loc) (cons loc ret)))
+       (cons loc ret))))
+
+(def non-puncts-to-left
+  (partial take-to-non-punct z/left))
+
+(def non-puncts-to-right
+  (partial take-to-non-punct z/right))
+

 (defn- up-to-right-sibling
   [loc]
-  (if (= loc (-> loc z/rightmost z/left))
+  (if (= loc (-> loc z/rightmost non-puncts-to-left first))
     (when-let [u (z/up loc)]
       (recur u))
     loc))
@@ -740,16 +752,7 @@
                          (if-let [nl (z/up (parse-node l))]
                            nl l))]
       (if-let [first-not-rightmost (up-to-right-sibling starting-loc)]
-        (let [
-              ;; rmost (z/rightmost starting-loc) ;; will rightmost always be punct?
-              ;; rightmost (if (punct-loc? rmost)
-              ;;             (z/left rmost)
-              ;;             rmost)
-              ;; rightmost? (= rightmost starting-loc)
-
-              slurpee (z/right first-not-rightmost) ;; we don't just need the one guy to right
-                                                    ;; we need all elements until non-punct
-
+        (let [slurpees (reverse (non-puncts-to-right (z/right first-not-rightmost)))
               parent (parse-node starting-loc)
               parent-so (start-offset parent)
               parent-eo (end-offset parent)
@@ -776,14 +779,14 @@
           (printf "text-to-replace: '%s'
 grandparent-text: '%s'
 removed: '%s'
-rightmost-text: '%s'
-slurpee (%s): '%s'"
+first-not-rightmost: '%s'
+slurpees (%s): '%s'"
                       text-to-replace
                       grandparent-text
                       text-sans-removed
                       (loc-text first-not-rightmost)
-                      (loc-tag slurpee)
-                      (loc-text slurpee))
+                      (apply str (map loc-tag slurpees))
+                      (apply str (map loc-text slurpees)))
               ret)
         t))
     t))


refactor

refactor

--- src/replify/core.clj
+++ src/replify/core.clj
@@ -1,61 +1,63 @@
 (ns replify.core
-  (:require [clojure.main :as main]
-            [clojure.tools.cli :refer [parse-opts]]
-            [cljs.build.api :as b]
-            [cljs.repl :as repl]
-            [cljs.repl.node :as node]
-            [cljs.repl.browser :as browser]
-            [cljs.repl.rhino :as rhino]
-            [alembic.still :as still]
-            [dynapath.util :as dp]
-            [replify.deps :refer [load-cljsjs-deps]])
-  (:import clojure.lang.DynamicClassLoader
-           (java.net URL URLClassLoader)))
+  (:require
+   [clojure.main :as main]
+   [clojure.java.io :as io]
+   [clojure.tools.cli :refer [parse-opts]]
+   [cljs.compiler :as compiler]
+   [cljs.closure :as closure]
+   [cljs.build.api :as api]
+   [cljs.repl :as repl]
+   [cljs.repl.node :as node]
+   [cljs.repl.browser :as browser]
+   [cljs.repl.rhino :as rhino]
+   [alembic.still :as still]
+   [dynapath.util :as dp]
+   [replify.deps :refer [load-cljsjs-deps]])
+  (:import
+   clojure.lang.DynamicClassLoader
+   (java.net URL URLClassLoader)))

 (defn compile-cljs-src
-  "Compile Cljs compiler for faster src compilations"
+  "Compile Cljs compiler for faster source compilations"
   []
-  (do
-    (compile 'cljs.core)
-    (compile 'cljs.repl.node)
-    (compile 'cljs.repl.browser)))
+  (compile 'cljs.core)
+  (compile 'cljs.repl.node)
+  (compile 'cljs.repl.browser))
+
+(defn build
+  ([main & options]
+   "Build Cljs src with options"
+   (println "Building Cljs")
+   (let [start (System/nanoTime)]
+     (println "setting main as: " main)
+     (api/build "src"
+              {:main main
+               :output-to "out/app.js"
+               :output-dir "out"
+               :optimizations :none
+               :source-map true
+               :verbose true})
+     (println "... done. Elapsed" (/ (- (System/nanoTime) start) 1e9) "seconds"))))

 (defn watch
   "Watch for Cljs src changes"
   [main & options]
   (println "Watching for changes ...")
-  (b/watch "src"
-           {:main main
+  (api/watch "src"
+             {:main main
             :output-to "out/app.js"
             :output-dir "out"
             :optimizations :none
             :cache-analysis true
             :source-map true}))

-(defn build
-  ([main & options]
-   "Build Cljs src with options"
-   (println "Building Cljs and watching for changes ...")
-   (let [start (System/nanoTime)]
-     (println "setting main as: " main)
-     (b/build "src"
-              {:main main
-               :output-to "out/app.js"
-               :output-dir "out"
-               :optimizations :none
-               :source-map true
-               :verbose true})
-     (println "... done. Elapsed" (/ (- (System/nanoTime) start) 1e9) "seconds")
-     (future
-       (watch main)))))
-
-(defn build-for-node
+(defn build-on-node
   ([main & options]
    "Build Cljs src for Nodejs with options"
    (println "Building Cljs for Node and watching for changes ...")
    (let [start (System/nanoTime)]
      (println "setting main as: " main)
-     (b/build "src"
+     (api/build "src"
               {:main main
                :output-to "main.js"
                :target :nodejs})
@@ -66,7 +68,7 @@
   [& options]
   (println "Building 'Release' ...")
   (let [start (System/nanoTime)]
-    (b/build "src"
+    (api/build "src"
              {:output-to "dist/app.min.js"
               :output-dir "out"
               :optimizations :advanced
@@ -74,7 +76,6 @@
     (println "... done. Elapsed" (/ (- (System/nanoTime) start) 1e9) "seconds")))

 (defn start-node-repl
-  "Start a Node Repl"
   [& options]
   (println "Starting Node REPL ...")
   (repl/repl* (node/repl-env)
@@ -100,6 +101,12 @@
                :cache-analysis true
                :source-map true}))

+(defn- run [task]
+  (still/lein run -m task))
+
+(defn node-repl [main]
+  (run (replify.core/start-node-repl main)))
+
 (defn add-deps [deps]
   (alembic.still/distill deps))

@@ -110,6 +117,3 @@

 (defn show-classpath []
   (dp/classpath-urls (clojure.lang.DynamicClassLoader.)))
-
-(defn deps-tree []
-  (still/lein deps :tree))


unlz77 refacto

unlz77 refacto

--- src/sandbox/lz77.clj
+++ src/sandbox/lz77.clj
@@ -2,22 +2,13 @@
   (:require [clojure.set :as cset]))

-(defn expand
-  [the-vector
-   distance
-   length]
+(defn expand [the-vector [distance length]]
   (->> (take-last distance the-vector)
        (cycle)
        (take length)))

-(defn un-LZ77
-  [bytes]
-  (loop [result []
-         remaining bytes]
-    (if (seq remaining)
-      (let [current (first remaining)
-            the-rest (rest remaining)]
-        (if-not (vector? current)
-          (recur (conj result current) the-rest)
-          (recur (into result (expand result (current 0) (current 1))) the-rest)))
-      result)))
+(defn un-LZ77 [bites]
+  (reduce #(if-not (vector? %2)
+             (conj %1 %2)
+             (into %1 (expand %1 %2)))
+          [] bites))


Fix bugs in handling of infinite sets.

Fix bugs in handling of infinite sets.

--- src/setbang/core.clj
+++ src/setbang/core.clj
@@ -69,7 +69,7 @@
    :else (if (empty? x)
            [0 0]
            (let [elt (first x)]
-             [(rest x) elt]))))
+             [(remove #(equality-check % elt) (rest x)) elt]))))

 (defn is-empty-set [x]
   (cond
@@ -129,10 +129,11 @@
   (if (empty? xs) ()
       (let [n (or n 1)
             choices (map choice (take n xs))]
-        (concat (map second choices)
-                (stagger (concat (remove is-empty-set (map first choices))
-                                 (drop n xs))
-                         (inc n))))))
+        (lazy-seq
+         (concat (map second choices)
+                 (stagger (concat (remove is-empty-set (map first choices))
+                                  (drop n xs))
+                          (inc n)))))))

 (defn staggered-union [xs]
   (lazy-seq
@@ -186,9 +187,10 @@
         coll' (take limit coll)]
     (map #(normalize (select-by-bits % coll')) (range 0 (bit-shift-left 1 (count coll'))))))

-(def large-set-cutoff 100000)
+(def large-set-cutoff 40)

 (defn shrink-if-possible [x]
+  (println "entering shrink-if-possible")
   (cond (number? x) x
         (set?    x) x
         :else (let [z (take (inc large-set-cutoff) x)]
@@ -361,7 +363,8 @@
       x
       (if (has-definite-size? x)
         (format "{%s}" (clj-string/join ", " (map #(set-to-string % true) x)))
-        (format "{%s, ...}" (clj-string/join "," (map #(set-to-string % true) (take 16 x))))))
+        (format "{%s, ...}" (clj-string/join "," (map #(set-to-string % true)
+                                                      (take 16 (distinct x)))))))
     (let [s (if (number? x) (into #{} (range x)) x)]
       (apply str (concat '("{") (map #(set-to-string % false) s) '("}"))))))


send a bad start

send a bad start

--- src/spawner/core.clj
+++ src/spawner/core.clj
@@ -72,6 +72,7 @@
      (>! command-chan [:start :doit2])
      (>! command-chan [:noop])
      (>! command-chan [:start :doit])
+     (>! command-chan [:start :nothere])
      (>! command-chan [:status])
      (>! command-chan [:exit]))
     (with-redefs


fix typo

fix typo

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -63,7 +63,7 @@
     (generate spec source-language target-language)))

 (defn id2expression [id]
-  (let [results (db/exec-raw [(str "SELECT struture
+  (let [results (db/exec-raw [(str "SELECT structure
                                       FROM expression
                                      WHERE id=?")
                               [id]]


make retrogradeorbit move up and down

make retrogradeorbit move up and down

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -98,6 +98,17 @@

     (<! render!)

+    (sprite/set-alpha! test-text 0.0)
+    (sprite/set-scale! test-text 6)
+    (.addChild (-> canvas :layer :ui) test-text)
+    (resources/fadein test-text :duration 5)
+    (go (loop [n 0]
+          (let [h (.-innerHeight js/window)
+                hh (/ h 2)
+                qh (/ h 4)]
+            (sprite/set-pos! test-text 0 (+ 200 (- (* 0.6 qh (Math/sin (* 0.04 n))) qh))))
+          (<! (events/next-frame))
+          (recur (inc n))))
     (let [scale [4 4]
           text (resources/get-texture :stars :nearest)
           stars (for [[x y] [[16 8] [8 8] [16 0] [8 0] [0 0] ;[24 0]


update-index now updates an index's settings/mappings in place, while clone-index takes over old behaviour of update-index.

--- joplin.elasticsearch/src/joplin/elasticsearch/database.clj
+++ joplin.elasticsearch/src/joplin/elasticsearch/database.clj
@@ -122,31 +122,60 @@
       :settings))

 (defn update-index
-  "Create an index based on a previous index, with updates applied."
+  "Update the mappings and settings of an existing index in place.
+
+   You can change settings in a fairly straightforward manner.
+
+   Mappings can also be changed, e.g. to add mappings for new fields.
+   Care must be taken when updating mappings of existing fields - see the ES documentation - but you
+   may well get unexpected behaviour. You can set :ignore-conflicts? to true if you know it is
+   safe to do so.
+
+   If you are making non-compatible changes to settings or mappings you should not use this function -
+   you will need to use clone-index with your mapping updates
+   and then migrate-data to copy the data into it."
   [es-client alias-name & updates]
   (let [current-index (first (find-index-names es-client alias-name))
         mappings (:mappings (get (esi/get-mapping es-client current-index) (keyword current-index)))
         settings (-> (get-index-settings es-client current-index)
                      (update-in [:index] dissoc :uuid :version))
         update-map (apply hash-map updates)
-        mappings-u (or (:mappings update-map) {})
-        settings-u (or (:settings update-map) {})]
-    (create-index es-client
-                  alias-name
-                  :mappings (deep-merge mappings mappings-u)
-                  :settings (deep-merge settings settings-u))))
+        mappings-updates (or (:mappings update-map) {})
+        settings-updates (or (:settings update-map) {})
+        ignore-conflicts? (or (:ignore-conflicts? update-map) false)]
+
+    (doseq [[type _] mappings-updates]
+      (let [new-mappings (select-keys (deep-merge mappings mappings-updates) [type])
+            result (esi/update-mapping es-client alias-name (name type) {:mapping new-mappings
+                                                                         :ignore_conflicts ignore-conflicts?})]
+        (when (:error result)
+          (println result))))
+
+    (when (not-empty settings-updates)
+      (let [result (esi/update-settings es-client alias-name settings-updates)]
+        (when (:error result)
+          (println result))))))

 (defn clone-index
-  "Create an index with the same settings and mappings as another index"
-  [es-client source-index-alias target-index-alias]
+  "Create a new index with settings and mappings copied from source index,
+   with optional updates to mappings or settings.
+
+   Use when you need to change a setting that affects the way existing data has been indexed.
+
+   To move the data as well, use migrate-data."
+  [es-client source-index-alias target-index-alias & updates]
   (let [source-index (first (find-index-names es-client source-index-alias))
         mappings (:mappings (get (esi/get-mapping es-client source-index) (keyword source-index)))
         settings (-> (get-index-settings es-client source-index)
-                     (update-in [:index] dissoc :uuid :version))]
+                     (update-in [:index] dissoc :uuid :version))
+        update-map (apply hash-map updates)
+        mappings-updates (or (:mappings update-map) {})
+        settings-updates (or (:settings update-map) {})]
+
     (create-index es-client
                   target-index-alias
-                  :mappings mappings
-                  :settings settings)))
+                  :mappings (deep-merge mappings mappings-updates)
+                  :settings (deep-merge settings settings-updates))))

 (defn- rollback-index-to [es-client alias-name current previous]
   (assign-alias es-client alias-name previous current)


Cosmetic fixes on ns form on beicon.core ns.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -3,11 +3,7 @@
             [cats.protocols :as p]
             [cats.context :as ctx])
   (:refer-clojure :exclude [true? map filter reduce merge repeat repeatedly zip
-                            dedupe drop take take-while not and
-                            or
-                            next
-                            concat
-                            partition]))
+                            dedupe drop take take-while concat partition]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Observables Constructors


fix `whitespace?`, throw ex-info with info regarding line and column numbers

--- src/blind/reader.clj
+++ src/blind/reader.clj
@@ -98,7 +98,8 @@
 (defn- whitespace?
   "Checks whether a given character is whitespace"
   [^Character ch]
-  (or (Character/isWhitespace ch) (= \, ch)))
+  (if ch
+    (or (Character/isWhitespace ch) (= \, ch))))

 (defn- numeric?
   "Checks whether a given character is numeric"
@@ -126,8 +127,11 @@

 (defn reader-error
   [rdr & msg]
-  (throw (RuntimeException. ^String (apply str msg)))
-  #_ (throw (ReaderException. (get-line-number rdr) (get-column-number rdr) (apply str msg))))
+  (throw (ex-info (apply str msg)
+                  (merge {:type :reader-exception}
+                         (if (satisfies? IndexingReader rdr)
+                           {:line (get-line-number rdr)
+                            :column (get-column-number rdr)})))))

 (defn macro-terminating? [ch]
   (and (not= \# ch)
@@ -473,7 +477,7 @@
                         [(get-line-number rdr) (dec (get-column-number rdr))])
         m (desugar-meta (read rdr true nil true))]
     (when-not (map? m)
-      (reader-error rdr "Metadata must be Symbol,Keyword,String or Map"))
+      (reader-error rdr "Metadata must be Symbol, Keyword, String or Map"))
     (let [o (read rdr true nil true)]
       (if (instance? IMeta o)
         (let [m (if (and (not (nil? line))
@@ -770,20 +774,30 @@
   "Reads the first object from a PushbackReader. Returns the object read.
    If EOF, throws if eof-is-error is true. Otherwise returns sentinel."
   [reader eof-is-error sentinel is-recursive]
-  (let [ch (read-char reader)]
-    (cond
-     (nil? ch) (if eof-is-error (reader-error reader "EOF") sentinel)
-     (whitespace? ch) (recur reader eof-is-error sentinel is-recursive)
-     (comment-prefix? ch) (recur (read-comment reader ch) eof-is-error sentinel is-recursive)
-     :else (let [f (macros ch)
-                 res
-                 (cond
-                  f (f reader ch)
-                  (number-literal? reader ch) (read-number reader ch)
-                  :else (read-symbol reader ch))]
-     (if (= res reader)
-       (recur reader eof-is-error sentinel is-recursive)
-       res)))))
+  (try
+    (let [ch (read-char reader)]
+      (cond
+        (nil? ch) (if eof-is-error (reader-error reader "EOF") sentinel)
+        (whitespace? ch) (read reader eof-is-error sentinel is-recursive)
+        (comment-prefix? ch) (read (read-comment reader ch) eof-is-error sentinel is-recursive)
+        :else (let [f (macros ch)
+                    res
+                    (cond
+                      f (f reader ch)
+                      (number-literal? reader ch) (read-number reader ch)
+                      :else (read-symbol reader ch))]
+                (if (= res reader)
+                  (read reader eof-is-error sentinel is-recursive)
+                  res))))
+    (catch Exception e
+      (if (instance? clojure.lang.ExceptionInfo e)
+        (throw e)
+        (throw (ex-info (.getCause e)
+                        (merge {:type :reader-exception}
+                               (if (satisfies? IndexingReader rdr)
+                                 {:line (get-line-number rdr)
+                                  :column (get-column-number rdr)}))
+                        e))))))

 (defn read-tagged* [rdr tag]
   (let [o (read rdr true nil true)]


minor

minor

--- src/client/game.cljs
+++ src/client/game.cljs
@@ -223,11 +223,7 @@
   (.focus (dom/by-id "gameScreenChatInput")))

 (defn- blur-chat-input []
-  (reset! client.game.core/chat-input-has-focus? false)
-
-  ;; TODO: this is not working...
-  ;;(.focus (aget js/document "body"))
-  )
+  (reset! client.game.core/chat-input-has-focus? false))

 (defn- focus-chat-input []
   (reset! client.game.core/chat-input-has-focus? true))
@@ -236,6 +232,7 @@
 ;;   for the game when we tab out of this input element
 ;;   currently not working
 (defn- keydown-chat-input [js-evt]
+  (.stopPropagation js-evt)
   (if (= 13 (aget js-evt "keyCode"))
     (let [input-el (dom/by-id "gameScreenChatInput")
           msg (aget input-el "value")]


Added (file-inode). Stored new blob using clj-git!!!!

--- src/clj_git/core.clj
+++ src/clj_git/core.clj
@@ -199,6 +199,15 @@
   [filepath]
   (java.util.Date. (.lastModified (java.io.File. filepath))))

+(defn file-inode
+  [filepath]
+  (let [res (clojure.java.shell/sh "ls" "-i" filepath)
+        [out] (clojure.string/split (:out res) #" ")]
+    (assert (= 0 (:exit res)))
+    (assert (= "" (:err res)))
+    (read-string out)))
+
+
 ; TODO: If times differ, compute hash to check for differences
 ;   if not really different, update modified times back to index..?!


tweak QP so that we execute MBQL queries by first calling `mbql->native` then wrapping that in a native query structure that gets passed to `process-native`.  we are also calling `annotate/annotate` on all results now.

--- src/metabase/query_processor.clj
+++ src/metabase/query_processor.clj
@@ -375,18 +375,6 @@
                                               absolute-max-results))))))

-(defn post-annotate
-  "QP middleware that runs directly after the the query is run and adds metadata as appropriate."
-  [qp]
-  (fn [query]
-    (let [results (qp query)]
-      (if-not (mbql-query? query)
-        ;; non-MBQL queries are not affected
-        results
-        ;; for MBQL queries capture the results and annotate
-        (annotate/annotate query results)))))
-
-
 (defn- pre-log-query [qp]
   (fn [query]
     (when (and (mbql-query? query)
@@ -439,6 +427,23 @@
           (assert (every? map? (:cols <>)))
           (assert (sequential? (:columns <>)))
           (assert (every? u/string-or-keyword? (:columns <>))))))))
+
+
+(defn- run-query
+  "The end of the QP middleware processing which actually executes the query on the driver."
+  [query]
+  (let [driver       (:driver query)
+        native-form  (if-not (mbql-query? query)
+                       (get-in query [:native :query])
+                       (driver/mbql->native driver query))
+        native-query (if-not (mbql-query? query)
+                       query
+                       {:database (get-in query [:database :id])
+                        :type     :native
+                        :native   {:query native-form}})
+        raw-result   (driver/process-native driver native-query)
+        query-result (annotate/annotate query raw-result)]
+    (assoc query-result :native_form native-form)))

 ;;; +-------------------------------------------------------------------------------------------------------+
@@ -480,10 +485,7 @@
   ;; TODO: it probably makes sense to throw an error or return a failure response here if we can't get a driver
   (let [driver (driver/database-id->driver (:database query))]
     (binding [*driver* driver]
-      (let [driver-process-in-context (partial driver/process-query-in-context driver)
-            driver-process-query      (partial (if (mbql-query? query)
-                                                 driver/process-mbql
-                                                 driver/process-native) driver)]
+      (let [driver-process-in-context (partial driver/process-query-in-context driver)]
         ((<<- wrap-catch-exceptions
               pre-add-settings
               pre-expand-macros
@@ -497,10 +499,9 @@
               cumulative-count
               limit
               post-check-results-format
-              post-annotate
               pre-log-query
               guard-multiple-calls
-              driver-process-query) (assoc query :driver driver))))))
+              run-query) (assoc query :driver driver))))))

 ;;; +----------------------------------------------------------------------------------------------------+


Removed Kavist

Removed Kavist

--- src/priceous/provider/kavist.clj
+++ src/priceous/provider/kavist.clj
@@ -1,128 +0,0 @@
-(ns priceous.provider.kavist
-  (:require [clojure.string :as str]
-            [net.cgrand.enlive-html :as html]
-            [priceous.provider :as p]
-            [priceous.selector-utils :as su]
-            [priceous.utils :as u]
-            [clj-http.client :as http]
-            [taoensso.timbre :as log]
-            [cheshire.core :as json]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- get-categories [provider]
-  (->>
-   [["Все напитки" "http://kavist.com.ua/55-vse-napitki#/page-%s/"]]
-   (mapv (fn [[name url]] {:name name :template url}))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- node->document
-  [provider {page :page node :node link :link :as nodemap}]
-  (su/with-selectors provider nodemap
-    (when page
-      (let [spec (->> (concat (q*? [:#idTab2 :li])
-                              (q*? [:#idTab1 :li]))
-                      (map html/text)
-                      (map (fn [s]
-                             (some->> (.split s ":" 2)
-                                      (seq)
-                                      (map u/cleanup)
-                                      (into []))))
-                      (filter (fn [v] (= (count v) 2)))
-                      (into {}))]
-        (-> {}
-            (assoc :provider (p/pname provider))
-            (assoc :name (text+ [:h1 [:span (html/attr= :itemprop "name")]]))
-
-            (assoc :price (some-> (text+ [:#our_price_display])
-                                  (u/smart-parse-double)))
-            (assoc :link link)
-            (assoc :image (-> (q+ [:#image-block :img])
-                              (get-in [:attrs :src])))
-            (assoc :country (str (spec "Страна") " " (spec "Регион")))
-            (assoc :available true)
-            (assoc :volume (-> (spec "Обьем") (u/smart-parse-double)))
-            (assoc :alcohol (-> (spec "Крепость") (u/smart-parse-double)))
-            (assoc :timestamp (u/now))
-            (assoc :description (some->> (list (spec "Аромат") (spec "Вкус") (spec "Послевкусие"))
-                                         (remove empty?)
-                                         (str/join ";")))
-            (assoc :type (some->> (list (spec "Тип напитка")
-                                        (spec "Тип виски")
-                                        (spec "Цвет шампанского")
-                                        (spec "Сахар"))
-                                  (remove empty?)
-                                  (str/join " ")
-                                  (u/cleanup)))
-            (assoc :producer (some-> (su/select*? node provider [:.manufacturer_pr])
-                                     (html/text)
-                                     (u/cleanup)))
-            ;; TODO new, sale, sale-description
-
-
-            ;; post-filter
-            ((fn [doc] (if (= "Товар отсутствует" (:name doc)) {} doc)))
-            )))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-                   ;; :link-selector      [:.product_img_link :img]
-                   ;; :link-selector-type :full-href
-                   ;; :last-page-selector [:.pagination :li]
-
-
-(defn fetch-page-fn [provider]
-  (let [api-url (format (get-in provider [:custom :api-template])
-                        (get-in provider [:state :current-val]))
-        result (http/get api-url)]
-    (if (not= 200 (:status result))
-      (do (log/error (format "Problem sending request, status %s" (:status result)))
-          "")
-      (-> (json/parse-string (:body result) true)
-          ((fn [raw]
-             (concat (html/html-snippet (:productList raw))
-                     (html/html-snippet (:pagination raw)))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def provider
-  {
-   :info {
-          :name          "Kavist"
-          :base-url      "http://kavist.com.ua/"
-          :icon          "http://kavist.com.ua/img/logo.jpg"
-          :icon-width    "156"
-          :icon-height   "72"
-          }
-
-   ;; provider state, will be changed by flow processor
-   :state {
-           :page-current   1
-           :page-processed 0
-           :page-template  "http://kavist.com.ua/55-vse-napitki#/page-%s/"
-           :category       :no-category
-           :page-limit     Integer/MAX_VALUE
-           :done           false
-
-           :current-val    1
-           :init-val       1
-           :advance-fn     inc
-
-           }
-
-   :configuration {
-                   :categories-fn      get-categories
-                   :threads            8
-                   :strategy           :heavy
-                   :fetch-page-fn      fetch-page-fn
-                   :node->document     node->document
-                   :node-selector      [:.ajax_block_product]
-                   :link-selector      [:.product_img_link]
-                   :link-selector-type :full-href
-                   :last-page-selector [:.pagination :li]
-                   }
-   :custom {
-            :api-template "http://kavist.com.ua/modules/blocklayered/blocklayered-ajax.php?id_category_layered=55&orderby=popularity&orderway=asc&n=12&p=%s"
-            }
-   })


Copy the appengine-api-labs* jar from the App Engine SDK into the deployment WEB-INF/lib directory. It contains the underlying implementation of Task Queues.

--- src/leiningen/appengine_prepare.clj
+++ src/leiningen/appengine_prepare.clj
@@ -31,4 +31,4 @@
     (lancet/copy {:todir (.getPath target-lib-dir)}
                  (lancet/fileset
                   {:dir lib-dev-dir
-                   :includes "appengine-magic*,ring-core*,appengine-api-1.0-sdk*"}))))
+                   :includes "appengine-magic*,ring-core*,appengine-api-1.0-sdk*,appengine-api-labs*"}))))


Add logic to blacklist tables with certain names :page_facing_up:

--- src/metabase/sync_database/sync.clj
+++ src/metabase/sync_database/sync.clj
@@ -143,6 +143,51 @@
       (catch Throwable t
         (log/error (u/format-color 'red "Unexpected error syncing table") t)))))

+(def ^:private ^:const blacklisted-table-names
+  "Names of Tables to skip syncing. These should be lowercased, as we'll compare them with lowercased names of `raw-tables` below."
+  #{"_metabase_metadata"})
+
+(defn- non-blacklisted-tables
+  "Filter out Tables that we don't want to sync.
+   This includes the `_metabase_metadata` Table, if present, as well as Tables for frameworks like Rails or Django."
+  [raw-tables]
+  (for [table raw-tables
+        :when (not (contains? blacklisted-table-names (s/lower-case (:name table))))]
+    table))
+
+(defn- create-and-update-tables!
+  "Create/update tables (and their fields)."
+  [database existing-tables raw-tables]
+  (doseq [{raw-table-id :id, :as raw-tbl} (non-blacklisted-tables raw-tables)]
+    (try
+      (if-let [existing-table (get existing-tables raw-table-id)]
+        ;; table already exists, update it
+        (save-table-fields! (table/update-table existing-table raw-tbl))
+        ;; must be a new table, insert it
+        (save-table-fields! (table/create-table (:id database) (assoc raw-tbl :raw-table-id raw-table-id))))
+      (catch Throwable e
+        (log/error (u/format-color 'red "Unexpected error syncing table") e)))))
+
+(defn- set-fk-relationships!
+  "Handle setting any FK relationships. This must be done after fully syncing the tables/fields because we need all tables/fields in place."
+  [database]
+  (when-let [db-fks (k/select RawColumn
+                      (k/fields [:id :source-column]
+                                [:fk_target_column_id :target-column])
+                      ;; NOTE: something really wrong happening with SQLKorma here which requires us
+                      ;;       to be explicit about :metabase_table.raw_table_id in the join condition
+                      ;;       without this it seems to want to join against metabase_field !?
+                      (k/join RawTable (= :raw_table.id :raw_column.raw_table_id))
+                      (k/where {:raw_table.database_id (:id database)})
+                      (k/where (not= :raw_column.fk_target_column_id nil)))]
+    (save-fks! db-fks)))
+
+(defn- maybe-sync-metabase-metadata-table!
+  "Sync the `_metabase_metadata` table, a special table with Metabase metadata, if present.
+   If per chance there were multiple `_metabase_metadata` tables in different schemas, just sync the first one we find."
+  [database raw-tables]
+  (when-let [metadata-table (first (filter #(= (s/lower-case (:name %)) "_metabase_metadata") raw-tables))]
+    (sync-metabase-metadata-table! (driver/engine->driver (:engine database)) database metadata-table)))

 (defn update-data-models-from-raw-tables!
   "Update the working `Table` and `Field` metadata for *all* tables in a `Database` based on the latest raw schema information.
@@ -160,33 +205,7 @@
   (let [raw-tables      (raw-table/active-tables database-id)
         existing-tables (into {} (for [{raw-table-id :raw_table_id, :as table} (db/sel :many Table, :db_id database-id, :active true)]
                                    {raw-table-id table}))]
-    ;; create/update tables (and their fields)
-    ;; NOTE: we make sure to skip the _metabase_metadata table here.  it's not a normal table.
-    (doseq [{raw-table-id :id, :as raw-tbl} (filter #(not= "_metabase_metadata" (s/lower-case (:name %))) raw-tables)]
-      (try
-        (if-let [existing-table (get existing-tables raw-table-id)]
-          ;; table already exists, update it
-          (-> (table/update-table existing-table raw-tbl)
-              save-table-fields!)
-          ;; must be a new table, insert it
-          (-> (table/create-table database-id (assoc raw-tbl :raw-table-id raw-table-id))
-              save-table-fields!))
-        (catch Throwable t
-          (log/error (u/format-color 'red "Unexpected error syncing table") t))))
-
-    ;; handle setting any fk relationships
-    ;; NOTE: this must be done after fully syncing the tables/fields because we need all tables/fields in place
-    (when-let [db-fks (k/select RawColumn
-                        (k/fields [:id :source-column]
-                                  [:fk_target_column_id :target-column])
-                        ;; NOTE: something really wrong happening with SQLKorma here which requires us
-                        ;;       to be explicit about :metabase_table.raw_table_id in the join condition
-                        ;;       without this it seems to want to join against metabase_field !?
-                        (k/join RawTable (= :raw_table.id :raw_column.raw_table_id))
-                        (k/where {:raw_table.database_id database-id})
-                        (k/where (not= :raw_column.fk_target_column_id nil)))]
-      (save-fks! db-fks))
-
-    ;; NOTE: if per chance there were multiple _metabase_metadata tables in different schemas, we just take the first
-    (when-let [_metabase_metadata (first (filter #(= (s/lower-case (:name %)) "_metabase_metadata") raw-tables))]
-      (sync-metabase-metadata-table! (driver/engine->driver (:engine database)) database _metabase_metadata))))
+
+    (create-and-update-tables! database existing-tables raw-tables)
+    (set-fk-relationships! database)
+    (maybe-sync-metabase-metadata-table! database raw-tables)))


exhausted-outputs -> sealed-outputs in invariant check

--- src/onyx/log/replica_invariants.clj
+++ src/onyx/log/replica_invariants.clj
@@ -40,5 +40,5 @@
     :as replica}]
   (let [replica-job-ids (mapcat (fn [k]
                                   (keys (replica k)))
-                                [:allocations :task-metadata :exhausted-inputs :exhausted-outputs])]
+                                [:allocations :task-metadata :exhausted-inputs :sealed-outputs])]
     (empty? (remove (set jobs) replica-job-ids))))


fix error in big pca computation with proj and extremity computation not being merged in

--- src/polismath/math/conversation.clj
+++ src/polismath/math/conversation.clj
@@ -332,6 +332,18 @@
   (priority-metric false 18 3 20 1)
   :end-comment)

+(defn with-proj-and-extremtiy
+  "Compute projection and extremity and merge in to pca results"
+  [pca]
+  (let [cmnt-proj (pca/pca-project-cmnts pca)
+        cmnt-extremity
+        (mapv
+          (fn [row]
+            (matrix/length row))
+          (matrix/rows cmnt-proj))]
+    (assoc pca
+           :comment-projection (matrix/transpose cmnt-proj)
+           :comment-extremity cmnt-extremity)))

 (def small-conv-update-graph
   "For computing small conversation updates (those without need for base clustering)"
@@ -365,16 +377,8 @@
                    (pca/wrapped-pca mat
                                     (:n-comps opts')
                                     :start-vectors (get-in conv [:pca :comps])
-                                    :iters (:pca-iters opts'))
-                   cmnt-proj (pca/pca-project-cmnts pca)
-                   cmnt-extremity
-                   (mapv
-                     (fn [row]
-                       (matrix/length row))
-                     (matrix/rows cmnt-proj))]
-               (assoc pca
-                      :comment-projection (matrix/transpose cmnt-proj)
-                      :comment-extremity cmnt-extremity)))
+                                    :iters (:pca-iters opts'))]
+               (with-proj-and-extremtiy pca)))

       :proj
@@ -739,8 +743,10 @@
                 (let [rand-indices (take sample-size (sampling/sample (range n-ptpts) :generator :twister))
                       pca          ((partial-pca mat pca rand-indices) pca)]
                   (if (= iter 0)
-                    (recur pca (dec iter))
-                    pca)))))}))
+                    ;; Then done, but don't forget to merge in the comment extremtiy, etc
+                    (with-proj-and-extremtiy pca)
+                    ;; Recur
+                    (recur pca (dec iter)))))))}))

 (def eager-profiled-compiler


(PDB-1951) Give dispatcher its own AMQP connection

Have the PuppetDBCommandDispatcher manage its own AMQP connection,
instead of relying on an indirectly managed connection from
PuppetDBServer.  That'll still leave us with just two long-term
connection stacks -- here, and in the listener.

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -369,20 +369,28 @@

   (start [this context]
     (let [{:keys [scf-write-db catalog-hash-debug-dir]} (shared-globals)
-          config {:db scf-write-db
+          db-cfg {:db scf-write-db
                   :catalog-hash-debug-dir catalog-hash-debug-dir}
-          {:keys [response-chan response-pub]} context]
+          {:keys [response-chan response-pub]} context
+          factory (-> (conf/mq-broker-url (get-config))
+                      (mq/activemq-connection-factory))
+          connection (.createConnection factory)]
       (register-listener
        supported-command?
-       #(process-command-and-respond! % config response-chan (:stats context)))
-      context))
+       #(process-command-and-respond! % db-cfg response-chan (:stats context)))
+      (assoc context
+             :factory factory
+             :connection connection)))

   (stop [this context]
     (async/unsub-all (:response-pub context))
     (async/untap-all (:response-mult context))
     (async/close! (:response-chan-for-pub context))
     (async/close! (:response-chan context))
-    (dissoc context :response-pub :response-chan :response-chan-for-pub :response-mult))
+    (dissoc context :response-pub :response-chan :response-chan-for-pub :response-mult)
+    (.close (:connection context))
+    (.close (:factory context))
+    context)

   (stats [this]
     @(:stats (service-context this)))
@@ -416,7 +424,7 @@

   (submit-command [this command version payload uuid]
     (enqueue-command this
-                     (get-in (shared-globals) [:command-mq :connection])
+                     (:connection (service-context this))
                      (conf/mq-endpoint (get-config))
                      (command-names command) version payload uuid))


Select standard keys while logging requests

--- src/time_tracker/web/middleware.clj
+++ src/time_tracker/web/middleware.clj
@@ -38,29 +38,31 @@
 (defn wrap-error-logging
   [handler]
   (fn [request]
-    (try
-      (if-let [response (handler request)]
-        response
-        (do
-          (log/error {:event   ::nil-response
-                      :request request})
-          web-util/error-internal-server-error))
-      (catch Exception ex
-        (log/error ex {:event   ::unhandled-exception
-                       :request request})
-        web-util/error-internal-server-error))))
+    (let [loggable-request (select-keys request standard-ring-request-keys)]
+      (try
+        (if-let [response (handler request)]
+          response
+          (do
+            (log/error {:event   ::nil-response
+                        :request loggable-request})
+            web-util/error-internal-server-error))
+        (catch Exception ex
+          (log/error ex {:event   ::unhandled-exception
+                         :request loggable-request})
+          web-util/error-internal-server-error)))))

 (defn wrap-validate
   [handler]
   (fn [request]
-    (try
-      (handler request)
-      (catch Exception ex
-        (if (= :validation-failed
-               (:event (ex-data ex)))
-          (do (log/info (merge (ex-data ex)
-                               {:event   ::validation-failed
-                                :request request}))
-              web-util/error-bad-request)
-          (throw ex))))))
+    (let [loggable-request (select-keys request standard-ring-request-keys)]
+      (try
+        (handler request)
+        (catch Exception ex
+          (if (= :validation-failed
+                 (:event (ex-data ex)))
+            (do (log/info (merge (ex-data ex)
+                                 {:event   ::validation-failed
+                                  :request loggable-request}))
+                web-util/error-bad-request)
+            (throw ex)))))))


Unbreak cljs tests.

Unbreak cljs tests.

--- test/active/clojure/monad_test.cljc
+++ test/active/clojure/monad_test.cljc
@@ -5,6 +5,7 @@
             #?(:cljs [active.clojure.monad :refer (return
                                                    free-return free-return?
                                                    free-bind free-bind?
+                                                   call-cc call-cc?
                                                    with-handler free-throw
                                                    get-state put-state!
                                                    get-env get-env-component with-env-component with-env


fix tests for cljs

fix tests for cljs

--- test/com/rpl/specter/core_test.cljc
+++ test/com/rpl/specter/core_test.cljc
@@ -1515,10 +1515,11 @@
     ))

 #?(:clj
-  (defprotocolpath FooPP)
-  (extend-protocolpath FooPP String s/STAY)
-
-  (deftest satisfies-protpath-test
-    (is (satisfies-protpath? FooPP "a"))
-    (is (not (satisfies-protpath? FooPP 1)))
-    ))
+  (do
+    (defprotocolpath FooPP)
+    (extend-protocolpath FooPP String s/STAY)
+
+    (deftest satisfies-protpath-test
+      (is (satisfies-protpath? FooPP "a"))
+      (is (not (satisfies-protpath? FooPP 1)))
+      )))


More on atoms.

More on atoms.

--- test/com/nomistech/clojure_the_language/intro_to_state.clj
+++ test/com/nomistech/clojure_the_language/intro_to_state.clj
@@ -84,14 +84,17 @@
 ;;;; Illustration of multiple threads competing to update an atom.
 ;;;;
 ;;;; - Each thread uses `swap!` with a function that runs for a long time.
-;;;;   (I'm calling the function a "swap function".)
 ;;;;
-;;;; - Clojure allows each thread to be optimistic.
-;;;;   - So multiple swap functions run concurrently.
+;;;; - Terminology: I'm calling the function passed to `swap!` a "swap function".
+;;;;
+;;;; - Clojure allows each thread that calls `swap!` to be optimistic.
+;;;;   - So multiple swap functions run concurrently (for the same atom).
 ;;;;
 ;;;; - When a swap function finishes:
 ;;;;   - If the current value of the atom is the same as the value when the
 ;;;;     function started
+;;;;     (this means that this swap function did its work based on the
+;;;;     current value)
 ;;;;     then
 ;;;;         the new value is swapped in
 ;;;;     else
@@ -131,7 +134,18 @@
 ;;;; ___________________________________________________________________________

 ;;;; TODO:
+
+;;;; You are using atoms, futures and agents above. Shit.
+
 ;;;; - Look at your notes
 ;;;; - More on atoms?
+;;;;   - When to use atoms
+;;;;   - When not to use atoms -- not when you can use functional stuff!
+;;;;     - give an example of a bad use
+;;;;
+;;;; - How long will it take to go through what you have so far?
+;;;;
 ;;;; - Refs
+;;;;   - and STM
+;;;;
 ;;;; - Single big atoms vs multiple small refs


Implement normalise-class test

Implement normalise-class test

--- test/irresponsible/unscrew_test.clj
+++ test/irresponsible/unscrew_test.clj
@@ -34,5 +34,6 @@
 (deftest slurp-jar-matching
   (let [mymap (u/slurp-jar-matching "test/project.jar" #(re-find #".clj$" %) false)]
     (is (= "irresponsible/unscrew.clj" (first (keys mymap))))))
-(deftest normalise-class)
+(deftest normalise-class
+  (is (= "path.to.foo" (u/normalise-class "path/to/foo.class"))))
 (deftest normalise-namespace)


Add docstring for let-later

Add docstring for let-later

--- src/useful/utils.clj
+++ src/useful/utils.clj
@@ -181,7 +181,16 @@
      (when-not (= ::EOF form)
        (cons form (read-seq))))))

-(defmacro let-later [bindings & body]
+(defmacro let-later
+  "Behaves like let, but symbols which have :delay metadata on them are
+   evaluated lazily, by placing their values in a delay and forcing the
+   delay whenever the body of the let-later needs the value. For example,
+
+   (let-later [^:delay a (do-stuff)]
+     (when (whatever) a))
+
+   will only evaluate (do-stuff) if (whatever) is true."
+  [bindings & body]
   (reduce (fn [body [name val]]
             (if (and (symbol? name) (:delay (meta name)))
               (let [delay-sym (gensym (str "delay-" name))]


Minor fix on email ns.

Minor fix on email ns.

--- src/uxbox/emails.clj
+++ src/uxbox/emails.clj
@@ -17,7 +17,7 @@
   #(emails/render "register" % {:reply-to "no-reply@uxbox.io"}))

 (defn send!
-  ([email] (send! sender email 5))
+  ([email] (send! email 5))
   ([email priority]
    (let [defaults (:email cfg/config)
          email (merge defaults email)


Fix annoying manifold stack traces

Fix annoying manifold stack traces

This was my fault, using 'constantly' instead of using a fn

--- src/yada/methods.clj
+++ src/yada/methods.clj
@@ -175,9 +175,9 @@
   (idempotent? [_] true)
   (request [_ ctx]
     (let [f (get-in ctx [:resource :methods (:method ctx) :response]
-                    (constantly (d/error-deferred
-                                 (ex-info (format "Resource %s does not provide a handler for :put" (type (:resource ctx)))
-                                          {:status 500}))))]
+                    (fn [_] (d/error-deferred
+                             (ex-info (format "Resource %s does not provide a handler for :put" (type (:resource ctx)))
+                                     {:status 500}))))]
       (d/chain
        (f ctx)
        (fn [res]


Fix copy-and-paste error in docs

Fix copy-and-paste error in docs

--- src/yada/methods.clj
+++ src/yada/methods.clj
@@ -35,7 +35,7 @@
 (defprotocol Method
   (keyword-binding [_] "Return the keyword this method is for")
   (safe? [_] "Is the method considered safe? Return a boolean")
-  (idempotent? [_] "Is the method considered safe? Return a boolean")
+  (idempotent? [_] "Is the method considered idempotent? Return a boolean")
   (request [_ ctx] "Apply the method to the resource"))

 (defn methods


Cosmetic changes.

Cosmetic changes.

--- clojure/src/advent2017/day10.clj
+++ clojure/src/advent2017/day10.clj
@@ -21,12 +21,12 @@
     (if (<= length 1)
       ring
       (loop [res      ring
-             n        0
+             pos      start
              [x & xs] (reverse (subring ring start length))]
         (if-not x
           res
-          (recur (assoc res (mod (+ start n) size) x)
-                 (inc n)
+          (recur (assoc res pos x)
+                 (mod (inc pos) size)
                  xs))))))

 (defn rounds


Allow false; fail if too many components in vector given.

--- src/datomish/db.cljc
+++ src/datomish/db.cljc
@@ -504,7 +504,7 @@
   (let [[op e a v tx] entity]
     [op e a v (or tx current-tx)]))

-(defn ensure-entity-form [[op e a v tx :as entity]]
+(defn ensure-entity-form [[op e a v tx & rest :as entity]]
   (cond
     (not (sequential? entity))
     (raise "Bad entity " entity ", should be sequential at this point"
@@ -514,16 +514,20 @@
     (raise "Unrecognized operation " op " expected one of :db/add :db/retract at this point"
            {:error :transact/bad-operation :entity entity })

-    (not e)
+    (nil? e)
     (raise "Bad entity: nil e in " entity
            {:error :transact/bad-entity :entity entity })

-    (not a)
+    (nil? a)
     (raise "Bad entity: nil a in " entity
            {:error :transact/bad-entity :entity entity })

-    (not v)
+    (nil? v)
     (raise "Bad entity: nil v in " entity
+           {:error :transact/bad-entity :entity entity })
+
+    (some? rest)
+    (raise "Bad entity: too long " entity
            {:error :transact/bad-entity :entity entity })

     true


handle corner case of zero

handle corner case of zero

--- src/euler/helper.clj
+++ src/euler/helper.clj
@@ -206,11 +206,12 @@
 (defn count-divisors
   "**count-divisors :: Int -> Int**
   Calculates the number of divisors of n (including 1 and n itself)."
-  [n] (->> (prime-factors n)
+  [n] (if (zero? n) 0
+        (->> (prime-factors n)
            (partition-by identity)
            (map count)
            (map inc)
-           (reduce *)))
+           (reduce *))))

 (defn palindrome?
   "**palindrome? :: Int -> Bool**


[#2227] Fix akvo.lumen.auth/api-authz? logic condition

--- backend/src/akvo/lumen/auth.clj
+++ backend/src/akvo/lumen/auth.clj
@@ -56,7 +56,7 @@
   "Feature flag predicate function. Add trailing $auth to given_name to enable
   API authz"
   [{:strs [family_name] :as jwt-claims}]
-  (and (nil? family_name) (string/ends-with? family_name "$auth")))
+  (and (some? family_name) (string/ends-with? family_name "$auth")))

 (defn wrap-auth
   "Wrap authentication for API. Allow GET to root / and share urls at /s/<id>.


Correct order of fileset operations, so that metadata actually gets set

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -455,8 +455,8 @@
                              (render-paths-fn options)
                              (render-to-paths (:renderer options) tmp tracer))]
         (-> fileset
-            (perun/merge-meta new-metadata)
-            (commit tmp))))))
+            (commit tmp)
+            (perun/merge-meta new-metadata))))))

 (deftask render
   "Render individual pages for entries in perun data.


whitespace

whitespace

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1320,7 +1320,6 @@
                                   :present {:3sing "takes advantage of"}}
                         :synsem {:cat :verb
                                  :sem {:pred :take-advantage-of}}}
-
    "talk"
    {:synsem {:cat :verb
              :sem {:pred :talk


if no [:synsem :sem :obj], then [:synsem :sem :obj] = :unspec

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -708,6 +708,13 @@
               (if-then {:synsem {:cat :verb
                                  :subcat {:3 '()}}}
                        {:synsem {:subcat {:3 '()}}})
+
+              ;; if object is not specified, then set to :unspec.
+              ;; this prevents translations that may have actual objects - e.g. would allow translations like:
+              ;; "Je mange" => "I eat the bread" whereas a better translation is "I eat".
+              (if-then {:synsem {:cat :verb
+                                 :sem {:obj :unspec}}}
+                       {:synsem {:sem {:obj :unspec}}})

               ;; TODO: use lexiconfn/if-then here, like espanol/lexicon does.
               ;; default: essere=false


fix typo: should be :I, not :io

fix typo: should be :I, not :io

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -1374,7 +1374,7 @@
                      :person :1st
                      :number :sing}
                :sem {:human true
-                     :pred :io}
+                     :pred :I}
                :subcat '()}}]

     "migliorare" {:synsem {:cat :verb


added ere-i present

added ere-i present

--- src/babel/latin/morphology.clj
+++ src/babel/latin/morphology.clj
@@ -74,6 +74,36 @@
      ["unt"
       {:synsem {:sem {:subj {:pred :loro}}}}]]}))

+
+
+(def ere-present-indicative
+  (conjugation
+   {:infinitive "ere-i"
+    :common {:synsem {:infl :present
+                      :sem {:tense :present}}}
+    :forms
+    [["io"
+      {:synsem {:sem {:subj {:pred :I}}}}]
+
+     ["is"
+      {:synsem {:sem {:subj {:pred :tu}}}}]
+
+     ["it"
+      {:synsem {:sem {:subj {:pred :lui}}}}]
+
+     ["imus"
+      {:synsem {:sem {:subj {:pred :noi}}}}]
+
+     ["itis"
+      {:synsem {:sem {:subj {:pred :voi}}}}]
+
+     ["iunt"
+      {:synsem {:sem {:subj {:pred :loro}}}}]]}))
+
+
+
+
+
 (def ire-present-indicative
   (conjugation
    {:infinitive "īre"
@@ -103,6 +133,14 @@
                               ere-present-indicative
                               ire-present-indicative))

+
+
+
+
+
+
+
+
 (defn analyze [surface-form lexicon]
   (morph/analyze surface-form lexicon replace-patterns))


Regression fix

Regression fix

--- src/clj/salava/badge/parse.clj
+++ src/clj/salava/badge/parse.clj
@@ -566,7 +566,7 @@
         header     (-> raw-header u/url-base64->str (json/read-str :key-fn keyword))
         payload    (-> raw-payload u/url-base64->str (json/read-str :key-fn keyword))
         public-key (-> (get-in payload [:verify :url]) http/http-get keys/str->public-key)
-        body       (-> input (jws/unsign public-key {:alg (keyword (:alg header))}) (String. "UTF-8"))]
+        body       (-> input (jws/unsign public-key {:alg (-> header :alg string/lower-case keyword)}) (String. "UTF-8"))]
     (assertion->badge user (json/read-str body :key-fn keyword) {:assertion_url nil :assertion_jws input :assertion_json body})))

 (defmethod str->badge :blank [_ _]


hide commodity accounts on index page

hide commodity accounts on index page

--- src/clj_money/web/accounts.clj
+++ src/clj_money/web/accounts.clj
@@ -69,17 +69,18 @@
                     :data-confirm "Are you sure you want to delete this account?"
                     :title "Click here to remove this account"})]]])

-; TODO Adjust this so that commodity accounts are omitted
 (defn- account-and-children-rows
   "Renders an individual account row and any child rows"
   ([account] (account-and-children-rows account 0))
   ([account depth]
-   (html
-     (concat
-       [(account-row account depth)]
-       (->> (:children account)
-            (map #(account-and-children-rows % (+ depth 1)))
-            (into []))))))
+   (let [account-row (account-row account depth)]
+     (if (= :currency (:content-type account))
+       (concat
+         [account-row]
+         (->> (:children account)
+              (map #(account-and-children-rows % (+ depth 1)))
+              (into [])))
+       account-row))))

 (defn- account-rows
   "Renders rows for all accounts and type headers"


Make tests only run once when figwheel reloads

--- env/dev/devsetup.cljs
+++ env/dev/devsetup.cljs
@@ -1,8 +1,12 @@
-(ns devsetup
-  (:require [demo :as site]
-            [runtests]
-            [reagent.core :as r]
-            [figwheel.client :as fw]))
+(ns ^:figwheel-always devsetup
+    (:require [demo :as site]
+              [runtests]
+              [reagent.core :as r]
+              [figwheel.client :as fw]))
+
+(when r/is-client
+  (fw/start
+   {:websocket-url "ws://localhost:3449/figwheel-ws"}))

 (defn test-results []
   [runtests/test-output-mini])
@@ -11,11 +15,4 @@
   (demo/start! {:test-results test-results})
   (runtests/run-tests))

-(when r/is-client
-  (fw/start
-   {:websocket-url "ws://localhost:3449/figwheel-ws"
-    :jsload-callback #(start!)
-    :heads-up-display true
-    :load-warninged-code false}))
-
 (start!)


Doesn't print SS missions for GM any more, waste of space. Prints cbay instead.

--- src/hphelper/scengen/print.clj
+++ src/hphelper/scengen/print.clj
@@ -180,9 +180,10 @@
          (html-print-header scenRec)
          (html-print-indicies scenRec)
          (html-print-crisises scenRec)
+         (html-print-cbay scenRec)
          (html-print-directive-summary scenRec)
          (html-print-news-summary scenRec)
-         (html-print-ssm-summary scenRec)
+         ;(html-print-ssm-summary scenRec)
          (html-print-player-sheets scenRec)
          (html-print-minions scenRec)
          (html-print-directive-table scenRec)


Corrected grammar on the main page

Corrected grammar on the main page

--- src/jarkeeper/views/common.clj
+++ src/jarkeeper/views/common.clj
@@ -20,7 +20,7 @@
       [:a {:href "http://hashobject.com/"} "Hashobject team"] "."]
     [:p
      [:a {:href "http://github.com/hashobject/jarkeeper.com"} "Jarkeeper"]
-     " is open source project hosted on GitHub."]]])
+     " is an open source project hosted on GitHub."]]])

 (defn ga []
   [:script "


Updated requires.

Updated requires.

--- dev-resources/src/dragon/dev.clj
+++ dev-resources/src/dragon/dev.clj
@@ -11,9 +11,9 @@
             [clojure.tools.namespace.repl :as repl]
             [clojure.walk :refer [macroexpand-all]]
             [clojusc.twig :as logger]
+            [dragon.blog.content.rfc5322 :as rfc5322]
+            [dragon.blog.generator :as generator]
             [dragon.cli.core :as cli]
-            [dragon.content.rfc5322 :as rfc5322]
-            [dragon.generator :as generator]
             [dragon.main :as main]
             [dragon.util :as util]
             [dragon.web.core :as web]


improve logging

improve logging

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -106,9 +106,9 @@
                                                             right-strings)
                                       left-signs (lazy-cat left-lexemes (filter map? left))
                                       right-signs (lazy-cat right-lexemes (filter map? right))
-                                      debug (log/debug (str "# lexemes found for left:" (string/join "," left-strings) ":"
+                                      debug (log/debug (str "#lexemes found for left:'" (string/join "','" left-strings) "':"
                                                             (count left-lexemes)))
-                                      debug (log/debug (str "# lexemes found for right:" (string/join "," right-strings) ":"
+                                      debug (log/debug (str "#lexemes found for right:'" (string/join "','" right-strings) "':"
                                                             (count right-lexemes)))

                                       ]


lein-release plugin: preparing 0.4.10 release

--- re_view/project.clj
+++ re_view/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view "0.4.10-SNAPSHOT"
+(defproject re-view "0.4.10"
   :description "ClojureScript React Library"
   :url "https://www.github.com/braintripping/re-view/tree/master/re_view"
   :license {:name "Eclipse Public License"


Mark arity 2 of publish as deprecated.

Mark arity 2 of publish as deprecated.

--- src/beicon/core.cljc
+++ src/beicon/core.cljc
@@ -214,9 +214,12 @@

 (defn publish
   "Create a connectable (hot) observable
-  from other observable."
-  ([ob]
-   (publish ob true))
+  from other observable.
+
+  WARNING: the arity 2 is deprecated, if you
+  want to connect, just use `connect!` function."
+  ([^Observable ob]
+   (.publish ob))
   ([^Observable ob connect?]
    {:pre [(observable? ob)]}
    (let [ob' (.publish ob)]


Update org.clojure/clojure to 1.10.1-RC (#2176)

* Update org.clojure/clojure to 1.10.0

* Update org.clojure/clojure to 1.10.1-RC1

--- backend/project.clj
+++ backend/project.clj
@@ -33,7 +33,7 @@
                  [org.apache.httpcomponents/httpcore "4.4.11"]
                  [org.apache.httpcomponents/httpclient "4.5.8"]
                  [org.apache.httpcomponents/httpmime "4.5.8"]
-                 [org.clojure/clojure "1.10.0-RC1"]
+                 [org.clojure/clojure "1.10.1-RC1"]
                  [org.clojure/data.csv "0.1.4"]
                  [org.clojure/core.match "0.3.0"]
                  [org.clojure/java.jdbc "0.7.9"]


correct format-number bug misspelling

correct format-number bug misspelling

--- src/client/game.cljs
+++ src/client/game.cljs
@@ -63,7 +63,7 @@
         [:tr.tr-cf247
          [:td (str (+ i 1) ".")]
          [:td {:class (str "color-" (mod i 7))} (:user player)]
-         [:td (util/number-format (:score player))]
+         [:td (util/format-number (:score player))]
          [:td (:total-lines player)]])]]]
    [:button#game-over-btn.red-btn-2c9ab "LOBBY"]])


cell schema read walk

cell schema read walk

--- src/clj/neb/cell.clj
+++ src/clj/neb/cell.clj
@@ -1,6 +1,6 @@
 (ns neb.cell
   (:require [neb.types :refer [data-types]]
-            [neb.schema :refer [schema-store schema-by-id]]
+            [neb.schema :refer [schema-store schema-by-id schema-id-by-sname]]
             [cluster-connector.utils.for-debug :refer [spy $]])
   (:import (org.shisoft.neb trunk schemaStore)
            (org.shisoft.neb.io cellReader cellWriter reader type_lengths cellMeta)))
@@ -87,20 +87,70 @@
 (defn mark-cell-deleted [trunk cell-loc data-length]
   (add-frag trunk cell-loc (dec (+ cell-loc cell-head-len data-length))))

-(defn calc-dynamic-field-length [trunk unit-length field-loc]
+(defn calc-dynamic-type-length [trunk unit-length field-loc]
   (+ (* (reader/readInt trunk field-loc)
         unit-length)
      type_lengths/intLen))
+
+;[[:id             :int]
+; [:name           :text]
+; [:map            [[:field1 :int] [:field2 :int]]]
+; [:int-array     [:ARRRAY :int]]
+; [:map-array      [:ARRAY [[:map-field :text]]]
+; [:nested-array   [:ARRAY [:ARRAY :int]]]]
+
+(defn walk-schema-for-read* [schema-fields ^cellReader cell-reader field-func map-func array-func]
+  (apply
+    map-func
+    (doall
+      (map
+        (fn [[field-name field-format]]
+          [field-name
+           (let [recur-nested (fn [nested-schema & _] (walk-schema-for-read* nested-schema cell-reader field-func map-func array-func))
+                 is-type? keyword?
+                 is-nested? vector?]
+             (cond
+               (is-nested? field-format)
+               (if (= :ARRAY (first field-format))
+                 (let [array-format (second field-format)
+                       array-len (reader/readInt trunk (.getCurrLoc cell-reader))]
+                   (.advancePointer cell-reader type_lengths/intLen)
+                   (apply
+                     array-func
+                     (doall
+                       (repeatedly
+                         array-len
+                         (fn []
+                           (cond
+                             (is-nested? array-format)
+                             (recur-nested field-format)
+                             (is-type? array-format)
+                             (if (get @data-types array-format)
+                               (:d (recur-nested [[:d field-format]]))
+                               (recur-nested (schema-id-by-sname array-format)))))))))
+                 (recur-nested field-format))
+               (is-type? field-format)
+               (let [{:keys [unit-length length] :as type-props} (get @data-types field-format)
+                     field-length (or length (calc-dynamic-type-length trunk unit-length (.getCurrLoc cell-reader)))
+                     field-result (field-func field-name (.getCurrLoc cell-reader) type-props field-length)]
+                 (.advancePointer cell-reader field-length)
+                 field-result)))])
+        schema-fields))))
+
+(defn walk-schema-for-read [schema-fields ^Long cell-loc field-func map-func array-func]
+  (walk-schema-for-read* schema-fields (cellReader. trunk cell-loc) field-func map-func array-func))

 (defn calc-trunk-cell-length [^trunk trunk ^Long cell-loc schema]
   (let [cell-data-loc (+ cell-loc cell-head-len)
         cell-reader (cellReader. trunk cell-data-loc)]
     (reduce + (map
                 (fn [[_ data-type]]
-                  (let [{:keys [unit-length length]} (get @data-types data-type)
-                        field-length (or length (calc-dynamic-field-length trunk unit-length (.getCurrLoc cell-reader)))]
-                    (.advancePointer cell-reader field-length)
-                    field-length))
+                  (if (vector? data-type)
+                    (calc-trunk-cell-length trunk (.getCurrLoc cell-reader) data-type)
+                    (let [{:keys [unit-length length]} (get @data-types data-type)
+                          field-length (or length (calc-dynamic-type-length trunk unit-length (.getCurrLoc cell-reader)))]
+                      (.advancePointer cell-reader field-length)
+                      field-length)))
                 (:f schema)))))

 (defn delete-cell [^trunk trunk ^Long hash]
@@ -129,7 +179,7 @@
                               dep (when dep (get @data-types dep))
                               reader (or reader (get dep :reader))
                               reader (if decoder (comp decoder reader) reader)
-                              length (or length (calc-dynamic-field-length trunk unit-length (.getCurrLoc cell-reader)))]
+                              length (or length (calc-dynamic-type-length trunk unit-length (.getCurrLoc cell-reader)))]
                           (.streamRead cell-reader reader length))])
                      (:f schema)))
                  {:*schema* schema-id


upsert support

upsert support

--- src/clj_pg/honey.clj
+++ src/clj_pg/honey.clj
@@ -16,7 +16,7 @@
   (str "RETURNING "
        (when (:modifiers sql-map)
          (str (sqlf/space-join (map (comp clojure.string/upper-case name)
-                               (:modifiers sql-map)))
+                                    (:modifiers sql-map)))
               " "))
        (sqlf/comma-join (map sqlf/to-sql fields))))

@@ -31,7 +31,7 @@
 (defmethod sqlf/format-clause :columns [[_ cols] sql-map]
   (str "("
        (str/join ", " (map #(str/join " " (map name %)) cols))
-   ")"))
+       ")"))

 (sqlf/register-clause! :inherits 3)

@@ -43,6 +43,51 @@
   (str "DROP TABLE " (when (:if-exists sql-map) " IF EXISTS ") (sqlf/to-sql tbl-name)))

 (sqlf/register-clause! :drop-table 1)
+
+;; UPSERT (from https://github.com/nilenso/honeysql-postgres/)
+
+(sqlf/register-clause! :do-update-set 235)
+(sqlf/register-clause! :do-update-set! 235)
+(sqlf/register-clause! :do-nothing 235)
+(sqlf/register-clause! :upsert 225)
+
+(defmethod sqlf/format-clause :on-conflict-constraint [[_ k] _]
+  (let [get-first #(if (sequential? %)
+                     (first %)
+                     %)]
+    (str "ON CONFLICT ON CONSTRAINT " (-> k
+                                          get-first
+                                          sqlf/to-sql))))
+
+(defmethod sqlf/format-clause :on-conflict [[_ ids] _]
+  (let [comma-join-args #(if (nil? %)
+                           ""
+                           (->> %
+                                (map sqlf/to-sql)
+                                sqlf/comma-join
+                                sqlf/paren-wrap))]
+    (str "ON CONFLICT " (comma-join-args ids))))
+
+(defmethod sqlf/format-clause :do-nothing [_ _]
+  "DO NOTHING")
+
+(defmethod sqlf/format-clause :do-update-set! [[_ values] _]
+  (str "DO UPDATE SET " (sqlf/comma-join (for [[k v] values]
+                                           (str (sqlf/to-sql k) " = " (sqlf/to-sql v))))))
+
+(defmethod sqlf/format-clause :do-update-set [[_ values] _]
+  (str "DO UPDATE SET "
+       (sqlf/comma-join (map #(str (sqlf/to-sql %) " = EXCLUDED." (sqlf/to-sql %))
+                             values))))
+
+(defn- format-upsert-clause [upsert]
+  (let [ks (keys upsert)]
+    (map #(sqlf/format-clause % (find upsert %)) upsert)))
+
+(defmethod sqlf/format-clause :upsert [[_ upsert] _]
+  (sqlf/space-join (format-upsert-clause upsert)))
+
+;; END UPSERT

 (defmethod sqlf/fn-handler "ilike" [_ col qstr]
   (str (sqlf/to-sql col) " ilike " (sqlf/to-sql qstr)))


cleaning up a bit

cleaning up a bit

--- example/src/example/client.cljs
+++ example/src/example/client.cljs
@@ -210,9 +210,6 @@
                      :paddingLeft "0px"
                      :paddingRight "0px"
                      :borderRadius "35px" } ""))
-
-(ensure-container "figwheel-heads-up-container")
-#_(warning-circle "This is an error yeppers")

 ;; super tricky hack to get goog to load newly required files

@@ -422,6 +419,7 @@
                   (warning-state? msg-names)
                   (<! (display-warning (:message msg))))
                  (recur))))
+    (ensure-container "figwheel-heads-up-container")
     (fn [msg-hist] (put! ch msg-hist) msg-hist)))

 (defn watch-and-reload-with-opts [opts]
@@ -454,4 +452,3 @@
 (defn watch-and-reload
   [& {:keys [] :as opts}]
   (watch-and-reload-with-opts opts))
-


Fixed the doc on the play function.

Fixed the doc on the play function.

--- src/overtunes/songs/before.clj
+++ src/overtunes/songs/before.clj
@@ -102,8 +102,9 @@
   [n s]
   (take (* (count s) n) (cycle s)))

-(defn play [chords metro]
+(defn play
   "Play the melody over the chords to metro's time."
+  [chords metro]
   (let
   [ repetitions-per-chord (/ (count melody) 2)
     melody-line (cycle-n (/ (count chords) repetitions-per-chord) melody)]


fixing hooking

fixing hooking

--- src/dwc_rest/api.clj
+++ src/dwc_rest/api.clj
@@ -22,7 +22,8 @@
         (if-let [to (:to params)]
           (if-let [hook (:hook params)]
             (do
-              (future (http/post {:body (convert (:from from :to to :source url))
+              (future
+                (http/post hook {:body (convert {:from from :to to :source url})
                                   :headers {"Content-Type" (get ctypes to)}}))
               {:status 200 :body "ok"})
             {:status 200
@@ -33,7 +34,8 @@
         {:status 400 :body "Must provide 'from' parameter of the input format."})
      {:status 400 :body "Must provide 'url' parameter of data source."})
     (catch Exception e
-      {:status 500 :body (str "Server error: " (.getMessage e)) })
+      (do (.printStackTrace e)
+        {:status 500 :body (str "Server error: " (.getMessage e))}))
     )
   )


1.3-ifying examples.odd

1.3-ifying examples.odd

--- src/examples/odd.clj
+++ src/examples/odd.clj
@@ -3,8 +3,8 @@
 ;; Lee Spector, lspector@hampshire.edu, 2010

 (ns examples.odd
-  (:require [clojush] [clojure.contrib.math])
-  (:use [clojush] [clojure.contrib.math]))
+  (:use [clojush]
+	[clojure.math.numeric-tower]))

 ;;;;;;;;;;;;
 ;; The "odd" problem: take a positive integer input and push a Boolean indicating


Properly catch exceptions on image fetching.

--- frontend/src/uxbox/main/data/images.cljs
+++ frontend/src/uxbox/main/data/images.cljs
@@ -343,6 +343,7 @@
       (if existing
         (rx/empty)
         (->> (rp/req :fetch/image {:id id})
+             (rx/catch rp/client-error? #(rx/empty))
              (rx/map :payload)
              (rx/map image-fetched))))))


adding click-fn to utils

adding click-fn to utils

--- src/hatti/utils.cljs
+++ src/hatti/utils.cljs
@@ -32,3 +32,7 @@
 (defn indexed [coll]
   "Given a seq, produces a two-el seq. [a b c] => [[0 a] [1 b] [2 c]]."
   (map-indexed vector coll))
+
+(defn click-fn [f]
+  "Helper function to create a click function that prevents default"
+  (fn [event] (.preventDefault event) (f)))