Working inter-op with Wit.ai's mic

Working inter-op with Wit.ai's mic

--- src/cljs/shop/core.cljs
+++ src/cljs/shop/core.cljs
@@ -35,18 +35,15 @@
     (str k "=" v "\n")))

 (defn new-mic []
-  (let [m (.Microphone (new js/Wit)
-            (.getElementById js/document "microphone"))])
-  (set! m.onready (fn [] (info "Microphone is ready to record")))
-  (set! m.onaudiostart (fn [] (info "Recording started")))
-  (set! m.onaudioend (fn [] (info "Recording stopped, processing started")))
-  (set! m.onerror (fn [err] (error err)))
-  (set! m.onconnecting (fn [] (info "Microphone is connecting")))
-  (set! m.ondisconnected (fn [] (info "Microphone is not connected")))
-  (set! m.onresult (fn [intent, entities] (info intent) (info entities)))
-  m)
-
-(def mic (new-mic))
+  (let [m (new js/Wit.Microphone (.getElementById js/document "microphone"))]
+    (set! (.-onready m) (fn [] (info "Microphone is ready to record")))
+    (set! (.-onaudiostart m) (fn [] (info "Recording started")))
+    (set! (.-onaudioend m) (fn [] (info "Recording stopped, processing started")))
+    (set! (.-onerror m) (fn [err] (error err)))
+    (set! (.-onconnecting m) (fn [] (info "Microphone is connecting")))
+    (set! (.-ondisconnected m) (fn [] (info "Microphone is not connected")))
+    (set! (.-onresult m) (fn [intent, entities] (info intent) (info entities)))
+    m))

 ;; ──────────────────────────────────────────────────────────────────────
 ;; state


Use inline vector in m-lift macro

Use inline vector in m-lift macro

--- src/cljx/cats/core.cljx
+++ src/cljx/cats/core.cljx
@@ -225,9 +225,9 @@
   [n f]
   (let [val-syms (repeatedly n gensym)
         mval-syms (repeatedly n gensym)
-        mlet-bindings (vec (interleave val-syms mval-syms))]
+        mlet-bindings (interleave val-syms mval-syms)]
     `(fn [~@mval-syms]
-       (mlet ~mlet-bindings
+       (mlet [~@mlet-bindings]
          (return (~f ~@val-syms))))))

 (defn m-filter


Added DOM label

Added DOM label

So we can use it as an element

--- src/webapp/framework/client/coreclient.clj
+++ src/webapp/framework/client/coreclient.clj
@@ -249,6 +249,8 @@
   `(om.dom/circle  (webapp.framework.client.coreclient/attrs ~attributes) ~@more))
 (defmacro button [attributes & more]
   `(om.dom/button  (webapp.framework.client.coreclient/attrs ~attributes) ~@more))
+(defmacro label [attributes & more]
+  `(om.dom/label  (webapp.framework.client.coreclient/attrs ~attributes) ~@more))
 (defmacro input [attributes & more]
   `(om.dom/input  (webapp.framework.client.coreclient/attrs ~attributes) ~@more))
 (defmacro table [attributes & more]


Debug mode for direct SQL works now

Debug mode for direct SQL works now

So doing select-debug as direct SQL now shows you the debug parameters
for the SQL

--- src/webapp/framework/client/coreclient.clj
+++ src/webapp/framework/client/coreclient.clj
@@ -702,7 +702,7 @@

      FIELDS             = (FIELD)+

-     <FIELD>            = #'[a-z_]+'  <#' '+>
+     <FIELD>            = #'[a-z_|(|)]+'  <#' '+>

      FROM               = 'from '
@@ -796,13 +796,25 @@
                                       }))
         typeof2     (str (type []))
         ]
+    (if
+
+
+    (get main-params :debug)
+      `{"SQL STRING: "                  ~sql-as-a-string
+        "Main Instaparse Query: "       ~parsed-sql
+        "Main Transformed query: "      ~transformed-sql
+        "Main Dataview map: "           ~dataview-map
+        "Main Params: "                 ~main-params
+        "Type: "                        ~typeof2
+           }
+
     `(~'data-view-result-set
        ~dataview-map

        {:start 1
         :end   20
         }
-       )
+       ))
 ))

@@ -874,18 +886,41 @@

 (defmacro select-debug [& select-args]
-        (let [
-              main-sql          (butlast (butlast   select-args))
-              main-params       (last (butlast   select-args))
-              dataview-map      (merge main-params {:debug true})
-              code              (last  select-args)
-          ]
-           `(sql-parser
-                "select"
-                ~@main-sql
-                ~dataview-map
-                ~code))
-  )
+  (let [
+        type-of-last-arg     (last  select-args)
+        ]
+
+    (cond
+     (= (type type-of-last-arg)  (type {}))
+     (let [
+           main-sql          (butlast   select-args)
+           main-params       (last select-args)
+           dataview-map      (merge main-params {:debug true})
+           ]
+       `(remote-sql-parser
+         "select"
+         ~@main-sql
+         ~dataview-map))
+
+
+
+     :else
+     (let [
+           main-sql          (butlast (butlast   select-args))
+           main-params       (last (butlast   select-args))
+           dataview-map      (merge main-params {:debug true})
+           code              (last  select-args)
+           ]
+       `(sql-parser
+         "select"
+         ~@main-sql
+         ~dataview-map
+         ~code))
+     )))
+
+
+
+

 (defmacro select [& select-args]


Add handler for channel item editing

Add handler for channel item editing

--- src/app/handlers.cljs
+++ src/app/handlers.cljs
@@ -94,6 +94,12 @@
 (defn delete [vect item]
   (vec (remove (fn [word] (= word item)) vect)))

+(defn update-item [vect item text]
+  (let [i (.indexOf (to-array vect) item)]
+    (if (>= i 0)
+      (assoc vect i text)
+      vect)))
+
 (register-handler
  :delete
  channel-mw
@@ -104,6 +110,14 @@
               (assoc % :items (delete (:items %) item))
               %) channels))))

+(register-handler
+ :channel-update-item
+ channel-mw
+ (fn [channels [channel item text]]
+   (mapv #(if (= % channel)
+            (assoc % :items (update-item (:items %) item text))
+            %) channels)))
+

 (register-handler
  :channel-set-mix
@@ -122,6 +136,7 @@
    (vec (map #(if (= % (channels channel-i))
                 (assoc % :title value)
                 %) channels))))
+

 ;; todo decouple this
@@ -178,3 +193,18 @@
  (fn [channels [words channel]]
    (add-words channels words channel)))

+
+(defn tree->words [tree]
+  (let [flattened (tree-seq map? #(:children %) tree)]
+    (reduce #(conj %1 %2) [] flattened)))
+
+
+;; TODO get the tree as clojure map from somewhere
+(register-handler
+ :tree-add
+ channel-mw
+ (fn [channels [tree channel]]
+   (let [words (tree->words tree)]
+     (add-words channels (tree->words tree) channel))))
+
+


GG & RS | 172 | using th/store-user! for test data setup

--- test/stonecutter/test/controller/admin.clj
+++ test/stonecutter/test/controller/admin.clj
@@ -48,7 +48,7 @@
        (fact "trusting user sends user-trusted flash message"
              (let [user-store (m/create-memory-store)
                    user-email "user3#email.com"
-                   _user3 (user/store-user! user-store user-email "password3")
+                   _user3 (th/store-user! user-store user-email "password3")
                    request (th/create-request :post (routes/path :set-user-trustworthiness) {:login user-email :trust-toggle "on"})
                    response (admin/set-user-trustworthiness user-store request)]

@@ -58,7 +58,7 @@
        (fact "untrusting user sends user-untrusted flash message"
              (let [user-store (m/create-memory-store)
                    user-email "user3#email.com"
-                   _user (user/store-user! user-store user-email "password")
+                   _user (th/store-user! user-store user-email "password")
                    request (th/create-request :post (routes/path :set-user-trustworthiness) {:login user-email})
                    response (admin/set-user-trustworthiness user-store request)]


Extract order from order-and-group

Extract order from order-and-group

so that it can be invoked independently

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -546,6 +546,14 @@
         name-of-part]
        (map chunkify)))

+(defn order
+  "Order the catalog `items`. Items representing the same book, e.g.
+  different Braille versions of the same book are collated."
+  [items]
+  (->> items
+   collate-all-duplicate-items
+   (sort-by sort-key locale-comparator)))
+
 (defn order-and-group
   "Order and group the catalog `items`. Given a sequence of `items`
   returns a tree where all items are grouped by format, genre and
@@ -554,10 +562,8 @@
   ([items]
    (order-and-group items get-update-keys))
   ([items get-update-keys-fn]
-   (->>
-    items
-    collate-all-duplicate-items
-    (sort-by sort-key locale-comparator)
+   (->> items
+    order
     (reduce
      (fn [m item]
        (let [update-keys (get-update-keys-fn item)]


Implement context-from-clop with maximal counterexamples

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

--- src/conexp/fca/more.clj
+++ src/conexp/fca/more.clj
@@ -161,19 +161,45 @@

 ;;;

+(defn- first-extender
+  "Finds the first element n in elts such that the set C extended by n
+  and closed under c does not contain m."
+  [c C m elts]
+  (loop [elements (seq elts)]
+    (when-let [n (first elements)]
+      (let [D (c (conj C n))]
+        (if-not (contains? D m)
+          [n D]
+          (recur (next elements)))))))
+
+(defn- maximal-counterexample
+  "For a given closure operator c on a set base-set, maximizes the set
+  C (i.e. returns a superset of C) that is not a superset of
+  B (i.e. there exists an element m in B without C that is also not in
+  the result."
+  [c base-set B C]
+  (let [m (first (difference B C))]
+    (loop [C C,
+           elts (difference (disj base-set m)
+                            C)]
+      (if-let [[next-m, D] (first-extender c C m elts)]
+        (recur D (disj elts next-m))
+        C))))
+
 (defn context-from-clop
   "Returns a context whose intents are exactly the closed sets of the
   given closure operator on the given base-set."
   [base-set clop]
-  (-> (explore-attributes (make-context #{} base-set #{})
-                          :handler (fn [_ _ impl]
-                                     (let [A (premise impl),
-                                           B (conclusion impl),
-                                           C (clop A)]
-                                       (when-not (subset? B C)
-                                         [[(gensym) C]]))))
-      :context
-      reduce-context))
+  (let [base-set (set base-set)]
+    (-> (explore-attributes (make-context #{} base-set #{})
+                            :handler (fn [_ _ impl]
+                                       (let [A (premise impl),
+                                             B (conclusion impl),
+                                             C (clop A)]
+                                         (when-not (subset? B C)
+                                           [[(gensym) (maximal-counterexample clop base-set B C)]]))))
+        :context
+        reduce-context-objects)))       ;is this still necessary?

 ;;;


style

style

--- src/main/clojure/clojure/tools/reader.clj
+++ src/main/clojure/clojure/tools/reader.clj
@@ -974,10 +974,8 @@
   ([reader eof-error? sentinel]
    (let [ret (read* reader eof-error? sentinel nil {} (LinkedList.))]
      (when (source-logging-reader? reader)
-       (let [^StringBuilder buf (:buffer @(.source-log-frames ^SourceLoggingPushbackReader reader))
-             len (.length buf)]
-         (when (pos? len)
-           (.delete buf 0 len))))
+       (let [^StringBuilder buf (:buffer @(.source-log-frames ^SourceLoggingPushbackReader reader))]
+         (.setLength buf 0)))
      ret)))

 (defn read-string


fix some AOT oddities in the const enhancement

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -1434,6 +1434,11 @@
               cljs.analyzer/*cljs-file*)))))
     (assoc m test expr)))

+(defn- const? [env x]
+  (core/let [m (core/and (core/list? x)
+                         (ana/resolve-var env (last x)))]
+    (core/when m (core/get m :const))))
+
 (defmacro case
   "Takes an expression, and a set of clauses.

@@ -1481,10 +1486,9 @@
                            (assoc-test m test expr env)))
                      {} (partition 2 clauses))
              esym    (gensym)
-             const? #(:const (and (list? %) (ana/resolve-var env (last %))))
              tests   (keys pairs)]
     (cond
-      (every? (some-fn core/number? core/string? core/char? const?) tests)
+      (every? (some-fn core/number? core/string? core/char? #(const? env %)) tests)
       (core/let [no-default (if (odd? (count clauses)) (butlast clauses) clauses)
                  tests      (mapv #(if (seq? %) (vec %) [%]) (take-nth 2 no-default))
                  thens      (vec (take-nth 2 (drop 1 no-default)))]


break out base-assign-impls from extend-type

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -591,21 +591,24 @@
         (drop-while seq? (next s)))
       ret)))

+(defn base-assign-impls [env resolve tsym type [p sigs]]
+  (warn-and-update-protocol p tsym env)
+  (let [psym       (resolve p)
+        pfn-prefix (subs (core/str psym) 0
+                     (clojure.core/inc (.indexOf (core/str psym) "/")))]
+    (cons `(aset ~psym ~type true)
+      (map (fn [[f & meths :as form]]
+             `(aset ~(symbol (core/str pfn-prefix f))
+                ~type ~(with-meta `(fn ~@meths) (meta form))))
+        sigs))))
+
 (defmacro extend-type [tsym & impls]
-  (let [resolve   (partial resolve-var &env)
+  (let [env       &env
+        resolve   (partial resolve-var env)
         impl-map  (->impl-map impls)
         skip-flag (set (-> tsym meta :skip-protocol-flag))]
-    (if (base-type tsym)
-      (let [t (base-type tsym)
-            assign-impls (fn [[p sigs]]
-                           (warn-and-update-protocol p tsym &env)
-                           (let [psym (resolve p)
-                                 pfn-prefix (subs (core/str psym) 0 (clojure.core/inc (.indexOf (core/str psym) "/")))]
-                             (cons `(aset ~psym ~t true)
-                                   (map (fn [[f & meths :as form]]
-                                          `(aset ~(symbol (core/str pfn-prefix f)) ~t ~(with-meta `(fn ~@meths) (meta form))))
-                                        sigs))))]
-        `(do ~@(mapcat assign-impls impl-map)))
+    (if-let [type (base-type tsym)]
+      `(do ~@(mapcat #(base-assign-impls env resolve tsym type %) impl-map))
       (let [t (resolve tsym)
             prototype-prefix (fn [sym]
                                `(.. ~tsym -prototype ~(to-property sym)))


:sparkles: Review fixes

:sparkles: Review fixes

--- frontend/src/uxbox/main/refs.cljs
+++ frontend/src/uxbox/main/refs.cljs
@@ -62,7 +62,7 @@
   (letfn [(selector [state]
             (let [page-id (get-in state [:workspace-page :id])
                   objects (get-in state [:workspace-data page-id :objects])]
-              (->> (get objects id))))]
+              (get objects id)))]
     (l/derived selector st/state =)))

 (defn objects-by-id


Small refactor to note the softmax loss

Small refactor to note the softmax loss

--- src/cortex/network.cljc
+++ src/cortex/network.cljc
@@ -50,18 +50,27 @@
                   [nil nil]
                   (range (count coll)))))

+
 (defn softmax-results-to-unit-vectors
   [results]
   (let [zeros (apply vector (repeat (first (m/shape (first results))) 0))]
-    (mapv #(m/array (assoc zeros (max-index (into [] (seq  %))) 1.0))
-                      results)))
+    (mapv #(assoc zeros (max-index (into [] (seq  %))) 1.0)
+          results)))
+
+
+(defn softmax-results
+  ^double [results labels]
+  (let [correct (count (filter #(m/equals (first %) (second %))
+                               (map vector
+                                    (softmax-results-to-unit-vectors results)
+                                    labels)))]
+    (double (/ correct (count labels)))))
+

 (defn evaluate-softmax
   "evaluate the network assuming single classification and last layer is softmax"
-  [network test-data test-labels]
-  (let [results (softmax-results-to-unit-vectors (run network test-data))
-        correct (count (filter #(m/equals (first %) (second %)) (map vector results test-labels)))]
-    (double (/ correct (count test-labels)))))
+  ^double [network test-data test-labels]
+  (softmax-results (run network test-data) test-labels))

 (defn train-step


allow single and average linkage for clustering

--- src/crawler/cluster.clj
+++ src/crawler/cluster.clj
@@ -1,7 +1,8 @@
 (ns crawler.cluster
   "Clustering utilities for explorations by the crawler")

-(defn assign-where?
+(defn assign-where-single-linkage?
+  "At least 1 cluster member satisfies the membership test"
   [clusters x membership-test]
   (.indexOf
    (map
@@ -10,11 +11,15 @@
     clusters)
    true))

-(defn assign
+(defn assign-single-linkage
   "Returns a new set of clusters
-after adding object x to them"
+   after adding object x to them"
   [clusters x membership-test]
-  (let [position (assign-where? clusters x membership-test)]
+  (let [position (assign-where-single-linkage? clusters x membership-test)]
     (if (<= 0 position)
       (assoc clusters position (cons x (nth clusters position)))
       (cons [x] clusters))))
+
+(defn assign-average-linkage [] '*)
+
+(defn assign-maximum-linkage [] '*)


Update input keys in handler code.

Update input keys in handler code.

--- src/org/playasophy/wonderdome/handler.clj
+++ src/org/playasophy/wonderdome/handler.clj
@@ -36,7 +36,7 @@
                      [false 0]))]
     (fn [state event]
       ; Update button state.
-      (case [(:type event) (:button event)]
+      (case [(:type event) (:input event)]
         [:time/tick nil]
         (swap! button-state inc-held (:elapsed event 0))

@@ -61,7 +61,7 @@
   [handler]
   (fn [state event]
     (if (and (= (:type event) :button/press)
-             (= (:button event) :select))
+             (= (:input event) :select))
       (state/next-mode state)
       (handler state event))))

@@ -119,7 +119,7 @@
    (fn [state event]
      (handler
        (if (= (:type event) :button/press)
-         (update-in state [:button-history] rolling-append size (:button event))
+         (update-in state [:button-history] rolling-append size (:input event))
          state)
        event))))


changing header, name to be more explicit, see https://github.com/Wikia/wikia-vcl/pull/347 /cc @drsnyder

--- src/vignette/util/external_hotlinking.clj
+++ src/vignette/util/external_hotlinking.clj
@@ -1,7 +1,7 @@
 (ns vignette.util.external-hotlinking)

-(def force-header-name "x-vary-string")
-(def force-header-val "forced-vignette-thumb")
+(def force-header-name "x-vignette-force-thumb")
+(def force-header-val "1")
 (def force-thumb-params {:request-type :thumbnail
                          :thumbnail-mode "scale-to-width"
                          :width "200"


[WR] refactor xml loading process

[WR] refactor xml loading process

--- src/vip/data_processor/validation/zip.clj
+++ src/vip/data_processor/validation/zip.clj
@@ -22,17 +22,16 @@

 (defn assoc-file [ctx]
   (let [path (:input ctx)]
-    (if (zip-file? path)
-      (assoc ctx :input (unzip-file path))
-      (if (xml-file? path)
-        (assoc ctx :input path)
-        (assoc ctx :stop (str path " is not a zip file!"))))))
+    (cond
+      (zip-file? path) (assoc ctx :input (unzip-file path))
+      (xml-file? path) (assoc ctx :input path)
+      :else (assoc ctx :stop (str path " is not a zip or xml file!")))))

 (defn extracted-contents [ctx]
   (let [path (:input ctx)]
     (if (xml-file? path)
       (assoc ctx :input
-             (seq [(.toFile path)]))
+             [(.toFile path)])
       (assoc ctx :input
              (-> path
                  (.resolve "data")


Removed server debug code

Removed server debug code

To make way for new server debug code related to build database tables
from blockly

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -1499,11 +1499,11 @@

 (defn get-fields-for-table   [db-table]
-    (println (pr-str "get-fields-for-table: " db-table))
+    ;(println (pr-str "get-fields-for-table: " db-table))
   (let [fields-atom          (get @server-datasource-fields  db-table)
         fields-entry         (if fields-atom (into [] @fields-atom))   ]

-    (println (pr-str "Read fields: " fields-entry))
+    ;(println (pr-str "Read fields: " fields-entry))

     (if fields-entry
       fields-entry
@@ -1527,7 +1527,7 @@
 ; ----------------------------------------------------------------
 (defn update-record-in-cache [db-table  id]
   (do
-    (println "Update record")
+    ;(println "Update record")
     (let [
           cached-record    (get-record-from-server-cache-for-id  db-table   id)
           fields           (get-fields-for-table   db-table)
@@ -1555,12 +1555,12 @@

 (defn inform-clients-about-record  [schema  db-table   id]
-  (println (str "inform-clients-about-record: " schema " . " db-table))
+  ;(println (str "inform-clients-about-record: " schema " . " db-table))
   (let [full-table-name    (str schema "." db-table)
          the-record        (get-record-from-server-cache-for-id  full-table-name  id )
         clients-atom      (:clients the-record)
         ]
-    (println (str "    the-record: " the-record))
+    ;(println (str "    the-record: " the-record))
     ;(println (str "    Record Clients: " @clients-atom))
     (if clients-atom

@@ -1633,7 +1633,7 @@
         (swap! the-query assoc  :count         record-count)
         (swap! the-query assoc  :timestamp     query-time)

-        (println (str "    clients: " @clients-atom))
+        ;(println (str "    clients: " @clients-atom))
         (doall (for [client @clients-atom]
                  (do
                    ;(println (str "    Client: " client))
@@ -1642,7 +1642,7 @@
                          ]
                      (if (not response-atom) (swap! the-query assoc  :update-request (atom {})))
                      (let [client-query    (assoc query :db-table (get-table-name  (:db-table query)))]
-                       (println (str "    query: " client-query))
+                       ;(println (str "    query: " client-query))
                        (swap! (:update-request @the-client) assoc-in [:queries client-query] {:timestamp query-time})
                        ;(println (str "    responses: " (if response-atom @response-atom)))
                        )
@@ -2304,7 +2304,7 @@

 (defn !savecode [{:keys [id   code  code-index   app-session-id] }]
   (do
-    (println (str "***********id: " id))
+    ;(println (str "***********id: " id))
     (if (= 1 code-index)
       (sql "update  appshare_applications  set  code_format='text', application_code = '',
            blockly_xml = NULL where  id = ?" [id]))
@@ -2324,7 +2324,7 @@

 (defn !saveblockly [{:keys [id   code   code-index  app-session-id] }]
   (do
-    (println (str "***********id: " id))
+    ;(println (str "***********id: " id))
     (cond
       (= 1 code-index)
       (sql "update  appshare_applications  set  code_format='blockly',


Avoid closing over the initial dataset, we want updates too

--- src/datafrisk/core.cljs
+++ src/datafrisk/core.cljs
@@ -136,7 +136,7 @@
 (defn DataFriskShell [& data]
   (let [expand-by-default (reduce #(assoc-in %1 [:data-frisk %2 :expanded-paths] #{[]}) {} (range (count data)))
         state-atom (r/atom expand-by-default)]
-    (fn []
+    (fn [& data]
       (let [data-frisk (:data-frisk @state-atom)
             visible? (:visible? data-frisk)]
         [:div {:style (merge {:position "fixed"


working with-timestamp

working with-timestamp

--- src/datasplash/core.clj
+++ src/datasplash/core.clj
@@ -6,7 +6,8 @@
             [clojure.math.combinatorics :as combo]
             [clojure.tools.logging :as log]
             [superstring.core :as str]
-            [taoensso.nippy :as nippy])
+            [taoensso.nippy :as nippy]
+            [clj-time.coerce :as timc])
   (:import [clojure.lang MapEntry ExceptionInfo]
            [com.google.cloud.dataflow.sdk Pipeline]
            [com.google.cloud.dataflow.sdk.coders StringUtf8Coder CustomCoder Coder$Context KvCoder IterableCoder]
@@ -238,18 +239,58 @@
   [& kvs]
   (MultiResult. (partition 2 kvs)))

+(defrecord TimeStamped [timestamp result])
+
+(defn with-timestamp
+  [timestamp result]
+  (->TimeStamped (timc/to-long timestamp) result))
+
+(defn output-value!
+  [^DoFn$ProcessContext context {:keys [entity bindings]}]
+  (let [{:keys [tag timestamp]} bindings]
+    (cond
+      (and tag timestamp) (if (= (name tag) (name *main-output*))
+                            (.outputWithTimestamp context entity timestamp)
+                            (.sideOutputWithTimestamp context (TupleTag. (name tag)) entity timestamp))
+      tag (if (= (name tag) (name *main-output*))
+            (.output context entity)
+            (.sideOutput context (TupleTag. (name tag)) entity))
+      timestamp (.outputWithTimestamp context entity timestamp)
+      :else (.output context entity))))
+
 (defn output-to-context
-  ([tx ^DoFn$ProcessContext context result]
-   (if (instance? MultiResult result)
-     (let [main-name (name *main-output*)]
-       (doseq [[tag res] (:kvs result)
-               :let [tag-name (name tag)]]
-         (if (= tag-name main-name)
-           (.output context (tx res))
-           (.sideOutput context (TupleTag. tag-name) (tx res)))))
-     (.output context (tx result))))
+  ([tx context result]
+   (loop [todo [{:entity result :bindings {}}]]
+     (when-let [{:keys [entity bindings]} (first todo)]
+       (cond
+         (instance? MultiResult entity) (recur
+                                         (concat (rest todo)
+                                                 (map (fn [[tag sub-entity]]
+                                                        {:entity sub-entity
+                                                         :bindings (assoc bindings :tag tag)})
+                                                      (:kvs entity))))
+         (instance? TimeStamped entity) (recur
+                                         (conj (rest todo)
+                                               {:entity (:result entity)
+                                                :bindings (assoc bindings :timestamp (:timestamp entity))}))
+         :else (do
+                 (output-value! context {:entity (tx entity) :bindings bindings})
+                 (recur (rest todo)))))))
   ([context result]
    (output-to-context identity context result)))
+
+;; (defn output-to-context
+;;   ([tx ^DoFn$ProcessContext context result]
+;;    (if (instance? MultiResult result)
+;;      (let [main-name (name *main-output*)]
+;;        (doseq [[tag res] (:kvs result)
+;;                :let [tag-name (name tag)]]
+;;          (if (= tag-name main-name)
+;;            (.output context (tx res))
+;;            (.sideOutput context (TupleTag. tag-name) (tx res)))))
+;;      (.output context (tx result))))
+;;   ([context result]
+;;    (output-to-context identity context result)))

 (defn clj->kv
   "Coerce from Clojure data to KV objects"


correct the fns which deail with system values

--- src/deferst/system.cljc
+++ src/deferst/system.cljc
@@ -248,21 +248,23 @@
             dks)))

 (defn stop-system!
-  "given a Deferred<[_, system]> stop the system, running
+  "given a Deferred<[_, system]> (i.e. the result of one of the
+   config-ctx value fns) stop the system, running
    destructor functions in reverse order to object construction"
   [dsys]
-  (with-context dm/deferred-context
-    (bind dsys
-          (fn [[_ system]]
-            (let [sd (system-destructor system)]
-              (run-state sd system))))))
+  (d/chain
+   dsys
+   (fn [[_ system]]
+     (let [sd (system-destructor system)]
+       (run-state sd system)))))

 (defn start-system!
   "given a system-builder, start a system with the seed config
    returns a Deferred<[system-map, system]>. if an Exception
    is thrown somewhere, unwind the system construction and
    call destructor functions for the objects which have so
-   far been constructed"
+   far been constructed.
+   returns a Deferred<[_, system]>"
   [system-builder seed]
   (-> (run-state system-builder seed)
       (d/catch
@@ -287,13 +289,14 @@
                             :error e})))))))))

 (defn system-map
-  "given a Deferred<[system-map, system]> extract the system-map
-  to a Deferred<system-map>"
-  [sys]
-  (with-context dm/deferred-context
-    (bind sys
-          (fn [[sm _]]
-            (return sm)))))
+  "given the result of a config-ctx value fn,
+   a Deferred<[system-map, system]>, extract the system-map
+   returning a Deferred<system-map>"
+  [dsys]
+  (d/chain
+   dsys
+   (fn [[_ system]]
+     (filter-system-map system))))

 (comment
   (require '[deferst.system :as dfs])


Remove dummy data

Remove dummy data

--- src/discuss/parser.cljs
+++ src/discuss/parser.cljs
@@ -19,7 +19,7 @@
                 :user/token "razupaltuff"
                 :user/logged-in? false
                 :user/avatar "img/profile.jpg"
-                :selection/current "This is a selected text passage"
+                :selection/current ""
                 :discussion/add-step :add/position
                 :discussion/items [{:htmls ["the city should reduce the number of street festivals"],
                                     :texts ["the city should reduce the number of street festivals"],
@@ -42,8 +42,7 @@
                                       :html "What is your most important reason why we should shut down University Park holds?
Because..."
                                       :text "What is your most important reason why we should shut down University Park holds? Because..."
                                       :url nil}]
-                :clipboard/items [{:title "This is an item from the clipboard"}
-                                  {:title "And yet another item"}]})
+                :clipboard/items []})

 ;; -----------------------------------------------------------------------------
 ;; Parsing


Use str instead of .toString

Use str instead of .toString

--- src/graphql_clj/box.clj
+++ src/graphql_clj/box.clj
@@ -14,7 +14,7 @@
   (equiv [a b] (.equals a b))

   Named
-  (getName [this] (if (instance? Box value) (.getName value) (.toString this)))
+  (getName [_] (if (instance? Box value) (.getName value) (str value)))

   Object
   (equals [_ b] (if (instance? Box b) (= value @b) (= value b)))


image upload from clojure done need to reimplement image to array of 0-1

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -5,6 +5,12 @@
             [figwheel.client :as fw]))

 (enable-console-print!)
+
+(defn to-clj-array [js-col]
+  (-> (clj->js [])
+      (.-slice)
+      (.call js-col)
+      (js->clj)))

 ;; define your app data so that it doesn't get over-written on reload

@@ -86,45 +92,44 @@
 (defn black-and-white [context canvas]
   [])

-;(defn onimageload [image canvas context]
-;  (set! (.-width canvas (.-width image)))
-;  (set! (.-height canvas (.-height image)))
-;  (.drawImage canvas image 0 0)
-;  (let [pixels (black-and-white context canvas)]
-;    (.log js/console pixels)))
+(defn on-image-load [event]
+  (let [image (.-target event)
+        canvas (dom/getElement "viewport")
+        context (.getContext canvas "2d")]
+    (set! (.-width canvas) (.-width image))
+    (set! (.-height canvas) (.-height image))
+    (.drawImage context image 0 0)
+    (let [pixels (black-and-white context canvas)]
+      (print pixels))
+    )
+  )

-;(defn onreaderload [reader]
-;  (let [pixels-div dom/getElement "pixels"
-;        image (js/Image.)]
-;    (set! (.-src image (:result reader)))
-;    ;(set! (.-onload image onimageload))
-;    ;(set! (.-innerHTML pixels-div ""))
-;    )
-;  (.log js/console "onreaderload")
-;  )
+(defn on-reader-load [event]
+  (let [pixels-div (dom/getElement "pixels")
+        image (js/Image.)
+        src (.-result (.-target event))]
+    (events/listen image (.-LOAD events/EventType) on-image-load)
+    (set! (.-src image) src)
+    (set! (.-innerHTML pixels-div) "")
+    )
+  (print "onreaderload")
+  )

 (defn handle-files [event]
-  {:pre [(not (empty? (.-files (.-target event))))]}
-  (let [canvas (dom/getElement "viewport")
-        a (.log js/console canvas)
-        context (.getContext canvas "2d")
-        b (.log js/console context)
-        f (nth (.-files (.-target event)) 0)
-        c (.log js/console f)
+  {:pre [(not (nil? (.-files (.-target event))))]}
+  (let [f (nth (to-clj-array (.-files (.-target event))) 0)
         reader (js/FileReader.)]
-    (set! (.-onloadend reader) #())
+    (set! (.-onloadend reader) on-reader-load)
     (.readAsDataURL reader f))
-  (.log js/console "handle files")
   )

+(defn on-dom-loaded []
+  (let [file-upload (dom/getElement "fileInput")]
+    (when file-upload
+      (print file-upload)
+      (events/listen file-upload "change" handle-files)))
+  (print "domready"))
+
 (def w (dom/getWindow))
-(events/listen w
-               (.-DOMCONTENTLOADED events/EventType)
-               (fn [] (
-                        (let [file-upload (dom/getElement "fileInput")]
-                          (when file-upload
-                            (print file-upload)
-                            (events/listen file-upload "change" handle-files)))
-                        (print "domready")
-                        )))
+(events/listen w (.-DOMCONTENTLOADED events/EventType) on-dom-loaded)


add sha-1

add sha-1

--- src/hasch/platform.cljs
+++ src/hasch/platform.cljs
@@ -1,44 +1,23 @@
-(ns hasch.platform)
-
-(defprotocol IHashCoercion
-  (-coerce [this hash-fn]))
-
-;; changes break hashes!
-(def magics {:string -99
-             :symbol -100
-             :keyword -101
-             :number -102
-             :vector -103
-             :seq -104
-             :map -105
-             :set -106
-             :nil -107
-             :boolean -108
-             :character -109
-             :uuid -110
-             :inst -111})
+(ns hasch.platform
+  (:require [goog.crypt.Sha1]
+            [hasch.benc :refer [IHashCoercion -coerce magics]]))

-(defn sha-1 [])
-
-(defn benc
-  "Dumb binary encoding which ensures basic types (incl. collections)
-cannot collide with different content. MAY NOT CHANGE OR BREAKS HASHES."
-  [x]
-  (let [b (byte x)]
-    (if (< b -98)
-      (list -98 (+ b 98))
-      (list b))))
+(defn sha-1 [bytes]
+  (let [md (goog.crypt.Sha1.)
+        sarr (apply js/Array bytes)]
+    (.update md sarr)
+    (.digest md)))

-(defn to-byte [n]
+(defn benc [n]
   (if (< n -98)
     (list -98 (+ n 98))
     (list n)))

-(defn get-js-string [input]
-  (mapcat to-byte
+(defn encode [input]
+  (mapcat benc
     (map
       #(bit-and (.charCodeAt input %) 0xFF)
       (range (.-length input)))))
@@ -49,19 +28,10 @@
   (-coerce [this hash-fn] (list (:boolean magics) (if this 1 0)))

   js/String
-  (-coerce [this hash-fn] (conj (get-js-string this) (:string magics)))
+  (-coerce [this hash-fn] (conj (encode this) (:string magics)))

   js/Number
-  (-coerce [this hash-fn] (conj (get-js-string (str this)) (:number magics)))
+  (-coerce [this hash-fn] (conj (encode (str this)) (:number magics)))

   js/Date
-  (-coerce [this hash-fn] (conj (get-js-string (str this)) (:inst magics))))
-
-
-;; --- some testing, open console in /resources/public/index.html for output ---
-
-(.log js/console (str (-coerce true sha-1)))
-(.log js/console (str (-coerce "abc" sha-1)))
-(.log js/console (str (-coerce 123 sha-1)))
-(.log js/console (str (-coerce 1.23 sha-1)))
-(.log js/console (str (-coerce (js/Date.) sha-1)))
+  (-coerce [this hash-fn] (conj (encode (str this)) (:inst magics))))


http: less verbose logging

http: less verbose logging

--- src/io/cyanite/http.clj
+++ src/io/cyanite/http.clj
@@ -1,7 +1,7 @@
 (ns io.cyanite.http
   "Small wrapper around netty for HTTP servers"
   (:require [com.stuartsierra.component :as component]
-            [clojure.tools.logging      :refer [error info]])
+            [clojure.tools.logging      :refer [error]])
   (:import io.netty.channel.ChannelHandlerContext
            io.netty.channel.ChannelHandlerAdapter
            io.netty.channel.ChannelInboundHandlerAdapter
@@ -125,7 +125,7 @@
                          (.channel (if (epoll?)
                                      EpollServerSocketChannel
                                      NioServerSocketChannel))
-                         (.handler (LoggingHandler. LogLevel/INFO))
+                         (.handler (LoggingHandler. LogLevel/WARN))
                          (.childHandler (initializer (:ring-handler options))))
              channel   (-> bootstrap
                            (.bind ^String (or (:host options) "127.0.0.1")


One more TODO

One more TODO

--- src/loudmoauth/core.clj
+++ src/loudmoauth/core.clj
@@ -19,6 +19,7 @@

 (def query-params [:client-id :response-type :redirect-uri :scope :state])

+;TODO - Should omit bringing in the vals here?
 (defn change-keys
   "Change hyphen to underscore in param map keys."
   [params]


Remove editor/compound

Remove editor/compound

editor/compound wraps CodeMirror's compoundChange method, which does
not exist in versions above 3.0.

--- src/lt/objs/editor.cljs
+++ src/lt/objs/editor.cljs
@@ -270,10 +270,6 @@

 (defn operation [e func]
   (.operation (->cm-ed e) func)
-  e)
-
-(defn compound [e fun]
-  (.compoundChange (->cm-ed e) fun)
   e)

 (defn on-click [e func]


Removes comments used for determining diff-paths functionality

--- src/lt/plugins/css.cljs
+++ src/lt/plugins/css.cljs
@@ -7,18 +7,6 @@
             [lt.objs.clients :as clients]
             [lt.util.dom :refer [$ append]])
   (:require-macros [lt.macros :refer [behavior defui]]))
-
-; file    /home/josh/repos/
-; client: /home/josh/
-; delta:  repos/
-
-; file    /home/josh/
-; client: /home/josh/repos/
-; delta:  ../
-
-; file:   /home/josh/project/
-; client: /home/josh/LT/
-; delta:  ../project/

 (defn get-prefix
   "Get the longest shared prefix of s1 and s2 and return it."


Initial table protocol implementation.

Initial table protocol implementation.

--- src/merkle_db/table.clj
+++ src/merkle_db/table.clj
@@ -359,6 +359,62 @@

 ;; ## Protocol Implementation

+; TODO: put this somewhere else
+(def tombstone ::tombstone)
+
+
+; TODO: put this somewhere else
+(defn- tombstone?
+  "Returns true if the value x is a tombstone."
+  [x]
+  (identical? ::tombstone x))
+
+
+(defn- remove-tombstones
+  "Returns a lazy sequence with tombstoned records removed."
+  [rs]
+  (remove (comp tombstone? second) rs))
+
+
+(defn- prepare-patch
+  "Takes a full set of patch data and returns a cleaned sequence based on the
+  given options."
+  [patch opts]
+  (when (seq patch)
+    (cond->> patch
+      (:start-key opts)
+        (drop-while #(neg? (key/compare (first %) (:start-key opts))))
+      (:end-key opts)
+        (take-while #(not (neg? (key/compare (:end-key opts) (first %)))))
+      (:fields opts)
+        (map (fn [[k r]]
+               [k (if (map? r) (select-keys r (:fields opts)) r)])))))
+
+
+(defn- patch-seq
+  "Combines an ordered sequence of patch data with a lazy sequence of record
+  keys and data. Any records present in the patch will appear in the output
+  sequence, replacing any equivalent keys from the sequence."
+  [patch records]
+  (lazy-seq
+    (cond
+      ; No more patch data, return records directly.
+      (empty? patch)
+        records
+      ; No more records, return patch with tombstones removed.
+      (empty? records)
+        (remove (comp tombstone? second) patch)
+      ; Next key is in both patch and records.
+      (= (ffirst patch) (ffirst records))
+        (cons (first patch) (patch-seq (next patch) (next records)))
+      ; Next key is in patch, not in records.
+      (key/before? (ffirst patch) (ffirst records))
+        (cons (first patch) (patch-seq (next patch) records))
+      ; Next key is in records, not in patch.
+      :else
+        (cons (first records) (patch-seq patch (next records))))))
+
+
 (extend-type Table

   ITable
@@ -367,31 +423,98 @@

   (scan
     [this opts]
-    (throw (UnsupportedOperationException. "NYI")))
+    ; TODO: apply lexicoder
+    (->>
+      (patch-seq
+        ; Merged patch data to apply to the records.
+        (prepare-patch (.patch-data this) opts) ; TODO: merge ::patch
+        ; Lazy sequence of matching records from the index tree.
+        (when-let [data-node (mdag/get-data
+                               (.store this)
+                               (::data (.node-data this)))]
+          (if (or (:start-key opts) (:end-key opts))
+            (index/read-range
+              (.store this)
+              data-node
+              (:fields opts)
+              (:start-key opts)
+              (:end-key opts))
+            (index/read-all
+              (.store this)
+              data-node
+              (:fields opts)))))
+      (remove-tombstones)))

   (get-records
-    [this primary-keys opts]
-    (throw (UnsupportedOperationException. "NYI")))
-
-
-  (write
-    [this records]
-    (throw (UnsupportedOperationException. "NYI")))
+    [this id-keys opts]
+    ; TODO: apply lexicoder
+    (let [id-keys (set id-keys)
+          patch-map (.patch-data this) ; TODO: merge ::patch
+          patch-entries (select-keys patch-map id-keys)
+          extra-keys (apply disj id-keys (keys patch-entries))
+          patch-entries (cond->> (remove-tombstones patch-entries)
+                          (seq (:fields opts))
+                            (map (fn [[k r]] [k (select-keys r (:fields opts))])))
+          data-entries (when-let [data-node (and (seq extra-keys)
+                                                 (mdag/get-data
+                                                   (.store this)
+                                                   (::data (.node-data this))))]
+                         (index/read-batch
+                           (.store this)
+                           data-node
+                           (:fields opts)
+                           extra-keys))]
+      (concat patch-entries data-entries)))
+
+
+  (insert
+    [this records opts]
+    ; TODO: apply lexicoder
+    (let [{:keys [merge-record merge-field]} opts
+          update-record (cond
+                          merge-record merge-record
+                          merge-field
+                          (fn merge-fields
+                            [_ old-data new-data]
+                            (reduce
+                              (fn [data field-key]
+                                (let [])
+                                (assoc data
+                                       field-key
+                                       (merge-field field-key
+                                                    (get old-data field-key)
+                                                    (get new-data field-key))))
+                              {} (distinct (concat (keys old-data) (keys new-data)))))
+                          :else
+                          (fn merge-simple
+                            [_ old-data new-data]
+                            (into {}
+                                  (filter (comp some? val))
+                                  (merge old-data new-data))))
+          extant (into {} (get-records this (map first records) nil))
+          new-records (map
+                        (fn [[k data]]
+                          [k (update-record k (get extant k) data)])
+                        records)]
+      ; Add new data maps to patch-data.
+      (->Table
+        (.store this)
+        (dissoc (.table-info this) ::node/id)
+        (.root-data this)
+        (into (.patch-data this) new-records)
+        true
+        (._meta this))))

   (delete
-    [this primary-keys]
-    (throw (UnsupportedOperationException. "NYI")))
-
-
-  ;; Partitions
-
-  (list-partitions
-    [this]
-    (throw (UnsupportedOperationException. "NYI")))
-
-
-  (read-partition
-    [this partition-id opts]
-    (throw (UnsupportedOperationException. "NYI"))))
+    [this id-keys]
+    ; TODO: apply lexicoder
+    ; Add tombstones to patch-data.
+    (->Table
+      (.store this)
+      (dissoc (.table-info this) ::node/id)
+      (.root-data this)
+      (into (.patch-data this) (map vector id-keys (repeat tombstone)))
+      true
+      (._meta this))))


use routes/not-found

use routes/not-found

--- src/metabase/routes.clj
+++ src/metabase/routes.clj
@@ -17,7 +17,7 @@
     (context "/api" [] api/routes)                    ; ^/api/        -> API routes
     (context "/app" []
       (route/files "/" {:root "frontend_client/app"}) ; ^/app/        -> static files under frontend_client/app
-      (GET "/*" [] {:status 404                       ;                  return 404 for anything else starting with ^/app/ that doesn't exist
-                    :body "Not found."}))
+      (route/not-found {:status 404                   ;                  return 404 for anything else starting with ^/app/ that doesn't exist
+                        :body "Not found."}))
     (GET "/:org-slug/admin/*" [] admin)               ; ^/org/admin/* -> admin_index.html
     (GET "*" [] index)))                              ; Anything else (e.g. /user/edit_current) should serve up index.html; Angular app will handle the rest


improved end of run handling

improved end of run handling

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -186,13 +186,30 @@
                    #(conj % {:ability end-turn :card card :targets targets}))))
         (when once (swap! state assoc-in [once (or once-key cid)] true))))))

+(defn handle-end-run [state side]
+  (if-not (and (empty? (get-in @state [:runner :prompt])) (empty? (get-in @state [:corp :prompt])))
+    (swap! state assoc-in [:run :ended] true)
+    (do (let [server (get-in @state [:run :server])]
+          (trigger-event state side :run-ends (first server))
+          (if (get-in @state [:run :successful])
+            (trigger-event state side :successful-run-ends (first server))
+            (trigger-event state side :unsuccessful-run-ends (first server)))
+          (swap! state assoc-in [:runner :rig :program]
+                 (for [p (get-in @state [:runner :rig :program])]
+                   (assoc p :current-strength nil)))
+          ;; (prn (get-in @state [:run :run-effect :end-run]))
+          (when-let [end-run-effect (get-in @state [:run :run-effect :end-run])]
+            (resolve-ability state side end-run-effect nil [(first server)])))
+        (swap! state assoc :run nil))))

 (defn resolve-prompt [state side {:keys [choice card] :as args}]
   (let [effect (:effect (first (get-in @state [side :prompt])))]
     (swap! state update-in [side :prompt] rest)
     (effect (or choice card))
-    (when (empty? (:prompt @state))
-      (swap! state assoc :access true))))
+    (when-let [run (:run @state)]
+      (when (and (:ended run)
+                 (empty? (get-in @state [:runner :prompt])) (empty? (get-in @state [:corp :prompt])))
+        (handle-end-run state :runner)))))

 (defn register-events [state side events card]
   (doseq [e events]
@@ -384,7 +401,6 @@
          (swap! state update-in [:runner :register :made-run] #(conj % (first s)))))))

 (defn handle-access [state side cards]
-  (swap! state assoc :access true)
   (doseq [c cards]
     (let [cdef (card-def c)]
       (when-let [name (:title c)]
@@ -431,16 +447,6 @@

 (defn access-bonus [state side n]
   (swap! state update-in [:run :access-bonus] #(+ % n)))
-
-(defn handle-end-run [state side]
-  (let [server (get-in @state [:run :server])]
-    (trigger-event state side :run-ends (first server))
-    (swap! state assoc-in [:runner :rig :program]
-           (for [p (get-in @state [:runner :rig :program])]
-             (assoc p :current-strength nil)))
-    (when-let [end-run-effect (get-in @state [:run :run-effect :end-run])]
-      (resolve-ability state side end-run-effect nil [(first server)])))
-  (swap! state assoc :run nil))

 (defn do-access [state side server]
   (let [cards (access state side server)]


Document an inelegant failure to be fixed

--- test/midje/t_sweet.clj
+++ test/midje/t_sweet.clj
@@ -383,3 +383,8 @@
    (#'midje.internal-ideas.t-fakes/var-inc
     (#'midje.internal-ideas.t-fakes/var-inc 2)) => 201))

+(after-silently
+ (future-fact "exceptions do not blow up"
+   "foo" => odd?)
+ (future-fact @reported => (just bad-result)))
+


LMDB flags.

LMDB flags.

--- src/onyx/state/lmdb.clj
+++ src/onyx/state/lmdb.clj
@@ -6,7 +6,7 @@
             [onyx.state.serializers.windowing-key-decoder :as dec]
             [onyx.state.serializers.checkpoint :as cp]
             [onyx.compression.nippy :refer [statedb-compress statedb-decompress]])
-  (:import [org.fusesource.lmdbjni Database Env Transaction Entry]
+  (:import [org.fusesource.lmdbjni Database Env Transaction Entry Constants]
            [org.agrona MutableDirectBuffer]
            [org.agrona.concurrent UnsafeBuffer]))

@@ -170,6 +170,7 @@
   ;; Not implemented yet.
   nil)

+
 (defmethod db/create-db
   :lmdb
   [peer-config
@@ -182,6 +183,7 @@
         path (str (System/getProperty "java.io.tmpdir") "/onyx/" (java.util.UUID/randomUUID) "/")
         _ (.mkdirs (java.io.File. path))
         env (doto (Env. path)
+              ;(.addFlags (reduce bit-or [#_Constants/NOSYNC Constants/MAPASYNC]))
               (.setMapSize max-size))
         db (.openDatabase env db-name)]
     (->StateBackend db name env


Documentation sanity checks by comparing with schemas

--- test/onyx/doc_test.clj
+++ test/onyx/doc_test.clj
@@ -2,8 +2,53 @@
   (:require [taoensso.timbre :refer [info] :as timbre]
             [clojure.test :refer [deftest is testing]]
             [onyx.static.default-vals :refer [defaults]]
+            [onyx.schema :as schema]
+            [schema.core :as s]
             [onyx.information-model :refer [model]]))

 (deftest missing-documentation-test
   (is (empty? (remove (apply merge (map :model (vals model)))
-                      (keys defaults)))))
+                      (keys defaults)))))
+
+(defn schema-keys [sc]
+  (mapv (fn [k]
+          (if (= (type k) schema.core.OptionalKey)
+            (:k k)
+            k))
+        (remove #{s/Keyword s/Any}
+                (keys sc))))
+
+(deftest catalog-test
+  (is (= (set (keys (:model (:catalog-entry model))))
+         (set (concat (schema-keys schema/base-task-map)
+                      (schema-keys schema/partial-grouping-task)
+                      (schema-keys schema/partial-input-output-task)
+                      (schema-keys schema/partial-fn-task))))))
+
+(deftest peer-config-test
+  (is (= (set (keys (:model (:peer-config model))))
+         (set (schema-keys schema/PeerConfig)))))
+
+(deftest lifecycle-call-test
+  (is (= (set (keys (:model (:lifecycle-calls model))))
+         (set (schema-keys schema/LifecycleCall)))))
+
+(deftest flow-conditions-test
+  (is (= (set (keys (:model (:flow-conditions-entry model))))
+         (set (schema-keys schema/FlowCondition)))))
+
+(deftest window-test
+  (is (= (set (keys (:model (:window-entry model))))
+         (set (schema-keys schema/Window)))))
+
+(deftest trigger-test
+  (is (= (set (keys (:model (:trigger-entry model))))
+         (set (schema-keys schema/Trigger)))))
+
+(deftest env-test
+  (is (= (set (keys (:model (:env-config model))))
+         (set (schema-keys schema/EnvConfig)))))
+
+(deftest state-aggregation-test
+  (is (= (set (keys (:model (:state-aggregation model))))
+         (set (schema-keys schema/StateAggregationCall)))))


fixed float li

fixed float li

--- src/portfolio/core.cljs
+++ src/portfolio/core.cljs
@@ -17,7 +17,7 @@
   [:div.container-fluid.darkbg
    [:div
    [:ul
-    [:mainnav
+    [:div.mainnav
      [:li "Hello"]]]]])


Make npcs collide with player

Make npcs collide with player

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -1612,12 +1612,14 @@
                                (fn [npc]
                                  ;(trace "updating npc" (select-keys npc [:race :place :pos :speed :energy]))
                                  (update-in
-                                   ;; no npc at the destination cell?
-                                   (if (not-any? (fn [npc] (and (= (get npc :pos)
-                                                                   new-pos)
-                                                                (= (get npc :place)
-                                                                   (get new-npc :place))))
-                                                 (get-in state [:world :npcs]))
+                                   ;; no npc or player at the destination cell?
+                                   (if (and
+                                         (not-any? (fn [npc] (and (= (get npc :pos)
+                                                                      new-pos)
+                                                                   (= (get npc :place)
+                                                                      (get new-npc :place))))
+                                                    (get-in state [:world :npcs]))
+                                         (not= new-pos (player-pos state)))
                                      ;; use the new npc value
                                      new-npc
                                      ;; otherwise there is an npc at the destination, use the old npc


[FIX #2780] hide re-frame warning when reloading

--- src/status_im/core.cljs
+++ src/status_im/core.cljs
@@ -5,7 +5,11 @@
             [reagent.core :as reagent]
             [status-im.native-module.core :as status]
             [taoensso.timbre :as log]
-            [status-im.utils.config :as config]))
+            [status-im.utils.config :as config]
+            [goog.object :as object]))
+
+(when js/goog.DEBUG
+  (object/set js/console "ignoredYellowBox" #js ["re-frame: overwriting"]))

 (defn init [app-root]
   (log/set-level! config/log-level)


[#3031] Remove ssl settings

[#3031] Remove ssl settings

--- backend/src/akvo/lumen/admin/util.clj
+++ backend/src/akvo/lumen/admin/util.clj
@@ -22,12 +22,11 @@
           database (env :pg-database)
           user (env :pg-user)
           password (env :pg-password)}}]
-   (hikaricp/ssl-url
-    (format "jdbc:postgresql://%s/%s?ssl=true&user=%s%s"
-            host database user
-            (if-not password #_(or (= host "localhost") (= host "postgres"))
-              ""
-              (format "&password=%s" password))))))
+   (format "jdbc:postgresql://%s/%s?user=%s%s"
+           host database user
+           (if-not password #_(or (= host "localhost") (= host "postgres"))
+                   ""
+                   (format "&password=%s" password)))))

 (defn role-name [label & [admin?]]
   (let [s (if admin? "akvo:lumen:%s:admin" "akvo:lumen:%s")]


[#672] Using psql types instead of client types in

--- backend/src/akvo/lumen/import/csv.clj
+++ backend/src/akvo/lumen/import/csv.clj
@@ -9,11 +9,11 @@

 (defn transform-value
   "Transforms the given value according to its associated type label.
-  Numeric strings are cast to numbers, only if the type label is 'number'"
+  Numeric strings are cast to numbers, only if the type label matches."
   [[value type-label]]
   (cond
     (string/blank? value) nil
-    (and (string/numeric? value) (= "number" type-label)) (Double/parseDouble value)
+    (and (string/numeric? value) (= "double precision" type-label)) (Double/parseDouble value)
     :else value))

 (defn transform-rows
@@ -96,7 +96,7 @@
             column-types (get-column-types rows)
             client-types (map :client column-types)
             psql-types (map :psql column-types)
-            transformed-rows (transform-rows rows client-types)]
+            transformed-rows (transform-rows rows psql-types)]
         (jdbc/db-do-commands tenant-conn
           (jdbc/create-table-ddl table-name
                                  (apply vector [:rnum :serial :primary :key]


Fix a busted test

Fix a busted test

I added a lein plugin that spotted the single argument call to `=`

--- test/runbld/process_test.clj
+++ test/runbld/process_test.clj
@@ -113,7 +113,7 @@
             env (proc/update-path {path-key path
                                    :JAVA_HOME "javahome"})
             expected (if (io/windows?) :Path :PATH)]
-        (is (= (get env path-key) )))))
+        (is (= (get env path-key) (str "javahome/bin:" path))))))
   (testing "Updating the path works when there is no path in the env"
     (let [env (proc/update-path {:JAVA_HOME "javahome"})]
       (is (re-find #"^javahome/bin:" (:PATH env))


Cosmetrics

Cosmetrics

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -621,9 +621,7 @@
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (SchemaBuilder/alterTable (name table-name)))
-         (maybe-stringify)))
-
-  )
+         (maybe-stringify))))

 (let [order
       {:if-exists 1}


remove obsolete comment

remove obsolete comment

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@10864 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/control.clj
+++ acqEngine/src/org/micromanager/control.clj
@@ -35,7 +35,7 @@
    {\"Camera\" {:exposure 10}}."
   [camera-settings]
   (doseq-parallel [[camera {:keys [exposure]}] camera-settings]
-    (mm/core setExposure camera exposure))) ;; TODO: update MMCore to implement this function
+    (mm/core setExposure camera exposure)))

 (defn set-hardware-state!
   "Sets the state of the hardware. Example state:


Changed constructor name.

Changed constructor name.

--- src/cmr/dev/env/manager/components/common/process.clj
+++ src/cmr/dev/env/manager/components/common/process.clj
@@ -88,7 +88,7 @@
                       process-key)
           component)))))

-(defn create-process-runner-component
+(defn create-runner-component
   ""
   [config-builder-fn process-keyword]
   (map->ProcessRunner


added a wee message

added a wee message

--- src/crumb/handler.clj
+++ src/crumb/handler.clj
@@ -12,7 +12,7 @@
 (defn attempt-create-user-account
   [username]
   (let [usr-exists (db/user-exists? username)
-        result {:user-created false :messages []}]
+        result {:user-created false :messages ["User created!"]}]
     (if usr-exists
       (assoc result :messages ["This username is already taken."])
       (do


Clean up processing of a byte.

Clean up processing of a byte.

--- proxy-protocol/src/main/clojure/com/mattunderscore/proxy/protocol/v1/Plaintextipv4deserialiser.clj
+++ proxy-protocol/src/main/clojure/com/mattunderscore/proxy/protocol/v1/Plaintextipv4deserialiser.clj
@@ -36,28 +36,34 @@
     (update-in [:groups] conj (:pending context))
     (assoc :pending [])))

+(declare process-next-byte)
+
+(defn- process-byte [context byte remaining]
+  (if (is-valid-byte byte)
+    (if (is-grouping-invalid byte context)
+      ; Group separator without pending group or too many groups
+      (NotDeserialisableResult/create (+ (:processed context) 1))
+      ; Accumulate the byte
+      (if (is-group-separator byte)
+        ; Pack new group and continue
+        (process-next-byte remaining (-> context
+                                       (update-in [:processed] + 1)
+                                       (append-pending-to-groups)))
+        ; Add to pending group and continue
+        (process-next-byte remaining (-> context
+                                       (update-in [:processed] + 1)
+                                       (update-in [:pending] conj byte)))))
+
+    ; Has reached a byte that is not a part of the address
+    (if (has-potential-address context)
+      ; Create the address
+      (create-address-result-from-context (append-pending-to-groups context) remaining)
+      ; Cannot be an address
+      (NotDeserialisableResult/create (+ (:processed context) 1)))))
+
 (defn- process-next-byte [seq context]
   (if-let [byte (first seq)]
-    (if (is-valid-byte byte)
-      (if (is-grouping-invalid byte context)
-        ; Group separator without pending group or too many groups
-        (NotDeserialisableResult/create (+ (:processed context) 1))
-        ; Accumulate the byte
-        (if (is-group-separator byte)
-          ; Pack new group
-          (process-next-byte (rest seq) (-> context
-                                          (update-in [:processed] + 1)
-                                          (append-pending-to-groups)))
-          ; Add to pending group
-          (process-next-byte (rest seq) (-> context
-                                            (update-in [:processed] + 1)
-                                            (update-in [:pending] conj byte)))))
-
-      (if (has-potential-address context)
-        ; Create the address
-        (create-address-result-from-context (append-pending-to-groups context) (rest seq))
-        ; Ended early
-        (NotDeserialisableResult/create (+ (:processed context) 1))))
+    (process-byte context byte (rest seq))
     ; No more data
     (if (has-potential-address context)
       ; Create the address


Revision to root_concept_identifier_gen rule

Added filters to exclude concepts that are used only in ICE world. It
is likely that these filters will never be exercised, but better to be
safe here.

--- resources/rules/pre_identifier_merge/step_a_ontology_to_ice/step_a/root_concept_identifier_gen.clj
+++ resources/rules/pre_identifier_merge/step_a_ontology_to_ice/step_a/root_concept_identifier_gen.clj
@@ -18,5 +18,9 @@
   filter (!contains(str(?root), '/bnode/'))
   # exclude the oboInOwl:ObsoleteClass class
   filter (?root != oboInOwl:ObsoleteClass)
+  # exclude ICE world concepts (IAO, CCP extension ontology, OA ontology)
+  filter (!contains (str(?root), 'ext/IAO_'))
+  filter (!contains (str(?root), 'obo/IAO_'))
+  filter (!contains (str(?root), 'http://www.w3.org/ns/oa#'))
   }"
 }


Add move-card test

Add move-card test

--- test/cljs/love_letter_cljs/game_test.cljs
+++ test/cljs/love_letter_cljs/game_test.cljs
@@ -130,3 +130,10 @@
              (->> first
                   :visible)))))

+(deftest move-card-test
+  (is (= {:face :guard,:value 1 :visible []}
+         (-> test-game-a
+             (sut/move-card [:deck] [:discard-pile])
+             (get-in [:discard-pile])
+             first))))
+


Remove autologin

Remove autologin

--- src/discuss/core.cljs
+++ src/discuss/core.cljs
@@ -1,6 +1,5 @@
 (ns ^:figwheel-always discuss.core
   (:require [om.core :as om :include-macros true]
-            [discuss.auth :as auth]
             [discuss.communication :as com]
             [discuss.debug :as debug]
             [discuss.utils.extensions]
@@ -14,7 +13,9 @@
 (defn main []
   (com/init!)
   (com/request-references)
-  (auth/one-click-login))
+  #_(auth/one-click-login))
+
+(main)

 ;; Register
 (om/root views/main-view lib/app-state


forgot this little guy

forgot this little guy


Prod does not produce source maps anymore.

--- build.boot
+++ build.boot
@@ -112,8 +112,7 @@
    :props {"CLJS_LOG_LEVEL" "WARN"}
    :env {:source-paths #{"src/clj" "src/cljs" "env/prod/cljs"}
          :resource-paths #{"resources/public/"}}
-   :cljs {:source-map true
-          :optimizations :simple
+   :cljs {:optimizations :simple
           :compiler-options prod-compiler-options}
    :test-cljs {:optimizations :simple
                :cljs-opts prod-compiler-options


Speed up test a bit

Speed up test a bit

--- integration-tests/apps/tx/src/tx/listen.clj
+++ integration-tests/apps/tx/src/tx/listen.clj
@@ -29,5 +29,5 @@
 (deftest transactional-writes-in-listener-should-fail-on-rollback
   (trigger-listener true)
   (is (nil? (imsg/receive "/queue/test" :timeout 2000)))
-  (is (nil? (imsg/receive "/queue/remote-test")))
+  (is (nil? (imsg/receive "/queue/remote-test" :timeout 2000)))
   (is (nil? (:a core/cache))))


Do not refresh page if buttons clicked in demo

The demo is smoother now

--- src/webapp/framework/client/components/main_view.cljs
+++ src/webapp/framework/client/components/main_view.cljs
@@ -78,7 +78,8 @@
                                                    (fn [e]
                                                      (go
                                                        (sql "delete from  coils_todo_items  where id = ?"
-                                                            [(<-- :id)]  )))})
+                                                            [(<-- :id)]  ))
+                                                     false)})
                                           ))))

@@ -104,21 +105,21 @@
                                   }  (str (count active-items) " items left"))

                             (button {:style {:width "9%" :border (str (if (nil? (read-ui app [:show])) "1px solid"))}
-                                     :onClick #(write-ui app [:show] nil)
+                                     :onClick #(do (write-ui app [:show] nil) false)
                                     } "ALL")

                             (button {:style {:width "13%" :border (str (if (= "ACTIVE" (read-ui app [:show])) "1px solid"))}
-                                     :onClick #(write-ui app [:show] "ACTIVE")
+                                     :onClick #(do (write-ui app [:show] "ACTIVE") false)
                                     } "Active")

                             (button {:style {:width "17%" :border (str (if (= "COMPLETED" (read-ui app [:show])) "1px solid"))}
-                                     :onClick #(write-ui app [:show] "COMPLETED")
+                                     :onClick #(do (write-ui app [:show] "COMPLETED") false)
                                     } "Completed")

                             (if (pos? (count completed-items))
                               (button {:style {  :width "34%" :textAlign "right"}
-                                       :onClick #(go
-                                                   (sql "delete from  coils_todo_items  where item_status = 'COMPLETED'" []  ))
+                                       :onClick #(do (go
+                                                   (sql "delete from  coils_todo_items  where item_status = 'COMPLETED'" []  )) false)
                                                    } "Clear completed"))

                             ))))))))


Import some changes I added to zhelpers

Import some changes I added to zhelpers

--- src/zguide/zhelpers.clj
+++ src/zguide/zhelpers.clj
@@ -3,7 +3,7 @@
 ;;
 (ns zguide.zhelpers
   (:refer-clojure :exclude [send])
-  (:import [org.zeromq ZMQ ZMQ$Context ZMQ$Socket ZMQQueue])
+  (:import [org.zeromq ZMQ ZMQ$Context ZMQ$Socket ZMQ$Poller ZMQQueue])
   (:import (java.util Random)
            (java.nio ByteBuffer)))

@@ -16,19 +16,43 @@
      (try ~@body
           (finally (.term ~id)))))

+;; Non-blocking send/recv
+(def no-block ZMQ/NOBLOCK)
+(def dont-wait ZMQ/DONTWAIT)
+;; More message parts are coming
 (def sndmore ZMQ/SNDMORE)
+(def send-more ZMQ/SNDMORE)

-(def router ZMQ/XREP)
-(def dealer ZMQ/XREQ)
+;;; Socket types
+;; Request/Reply
 (def req ZMQ/REQ)
 (def rep ZMQ/REP)
+;; Publish/Subscribe
+(def pub ZMQ/PUB)
+(def sub ZMQ/SUB)
+;; Extended Publish/Subscribe
+(def x-pub ZMQ/XPUB)
+(def x-sub ZMQ/XSUB)
+;; Push/Pull
+(def push ZMQ/PUSH)
+(def pull ZMQ/PULL)
+;; Internal 1:1
+(def pair ZMQ/PAIR)
+
+;; Router/Dealer
+
+;; Creates/consumes request-reply routing envelopes.
+;; Lets you route messages to specific connections if you
+;; know their identities.
+(def router ZMQ/ROUTER)
+;; Combined ventilator/sink.
+;; Does load balancing on output and fair-queuing on input.
+;; Can shuffle messages out to N nodes then shuffle the replies back.
+;; Raw bidirectional async pattern.
+(def dealer ZMQ/DEALER)
+;; Obsolete names for Router/Dealer
 (def xreq ZMQ/XREQ)
 (def xrep ZMQ/XREP)
-(def pub ZMQ/PUB)
-(def sub ZMQ/SUB)
-(def pair ZMQ/PAIR)
-(def push ZMQ/PUSH)
-(def pull ZMQ/PULL)

 (defn socket
   [#^ZMQ$Context context type]
@@ -97,8 +121,37 @@
         (recur (conj acc msg))
         (conj acc msg)))))

-(defn recv-str [#^ZMQ$Socket socket]
-  (-> socket recv String. .trim))
+(defn recv-str
+  ([#^ZMQ$Socket socket]
+      (-> socket recv String. .trim))
+  ([#^ZMQ$Socket socket flags]
+     ;; This approach risks NPE:
+     ;;(-> socket (recv flags) String. .trim)
+     (when-let [s (recv socket flags)]
+       (-> s String. .trim))))
+
+(defn poller
+  "Return a new Poller instance.
+Realistically, this shouldn't be public...it opens the door
+for some pretty low-level stuff."
+  [socket-count]
+  (ZMQ$Poller. socket-count))
+
+(def poll-in ZMQ$Poller/POLLIN)
+(def poll-out ZMQ$Poller/POLLOUT)
+
+(defn register-in
+  "Register a listening socket to poll on."
+  [#^ZMQ$Socket socket #^ZMQ$Poller poller]
+  (.register poller socket poll-in))
+
+(defn socket-poller-in
+  "Get a poller attached to a seq of sockets"
+  [sockets]
+  (let [checker (poller (count sockets))]
+    (doseq [s sockets]
+      (register-in s checker))
+    checker))

 (defn dump
   [#^ZMQ$Socket socket]


Make output conform to lein repl format for things like cider

- These things actually parse the banner to get the port and stuff...

--- boot/core/src/boot/repl_server.clj
+++ boot/core/src/boot/repl_server.clj
@@ -76,4 +76,4 @@
         {:keys [port]} (apply server/start-server (mapcat identity opts))
         bind           (or (:bind opts) "0.0.0.0")]
     (doto (io/file ".nrepl-port") .deleteOnExit (spit port))
-    (printf "nREPL server listening: %s:%s\n" bind port)))
+    (printf "nREPL server started on port %d on host %s - nrepl://%s:%d\n" port bind bind port)))


adjust logging level

adjust logging level

--- src/spq/lib.clj
+++ src/spq/lib.clj
@@ -54,7 +54,7 @@
 (defn shutdown
   []
   (when *kill*
-    (timbre/fatal "shutdown. if jvm doesnt exit right after this, it should have")
+    (timbre/warn "shutdown. if jvm doesnt exit right after this, it should have")
     (Thread/sleep 1000)
     (shutdown-agents)
     (System/exit 0) ;; soft kill


Reset Gitique state between PRs

Reset Gitique state between PRs

Fixes #2.

--- src/gitique/core.cljs
+++ src/gitique/core.cljs
@@ -25,6 +25,7 @@
                                 (when (and new-pr
                                            (or (not= (:current-pr old) new-pr)
                                                (and (pos? new-count) (not= (:commit-count old) new-count))))
+                                  (util/remove-class pjax-wrapper "gitique-enabled")
                                   (add-icons!)
                                   (maybe-show-new (:repo new-pr) (:pr new-pr))))))

@@ -121,14 +122,14 @@
     (set-text! ".toc-diff-stats strong:first-of-type" (str added " additions"))
     (set-text! ".toc-diff-stats strong:last-of-type" (str deleted " deletions"))))

-(defn- set-state! [state event]
+(defn- set-gitique-state! [state event]
   (let [enabled? (= state "new")
         other-state (if enabled? "all" "new")
         to-enable (util/qs (str "#gitique-show-" state))
         to-disable (util/qs (str "#gitique-show-" other-state))]
     (util/add-class to-enable "selected")
     (util/remove-class to-disable "selected")
-    ((if (= state "new") util/add-class util/remove-class) pjax-wrapper "gitique-enabled")
+    ((if enabled? util/add-class util/remove-class) pjax-wrapper "gitique-enabled")
     (update-overall!)))

 (defn- add-button! []
@@ -143,8 +144,8 @@
                            "Selected commits")
         group (dom/createDom "div" #js["btn-group" "right" "gitique-header-wrapper"] all new)]
     (util/add-class (if enabled? new all) "selected")
-    (.addEventListener all "click" (partial set-state! "all") true)
-    (.addEventListener new "click" (partial set-state! "new") true)
+    (.addEventListener all "click" (partial set-gitique-state! "all") true)
+    (.addEventListener new "click" (partial set-gitique-state! "new") true)
     (.insertBefore parent group sibling)))

 (defn- reset-classes! []


Add an 'upadate' function to the DAO.

Add an 'upadate' function to the DAO.

--- src/hateoasql/dao.clj
+++ src/hateoasql/dao.clj
@@ -135,3 +135,8 @@
   [resource id subresource]
   (let [query (get (get by-fk-queries subresource) resource)]
     (jdbc/query db [query id])))
+
+(defn update
+  "Overwrite a resource with a new version."
+  [resource instance]
+  (jdbc/update! db resource instance [(str (get primary-keys resource)" = ?") (get-pk-value resource instance)]))


Just print serving at localhost.

Just print serving at localhost.

--- src/incise/server.clj
+++ src/incise/server.clj
@@ -43,9 +43,7 @@
   "Start a development server."
   []
   (let [port (conf/get :port)]
-    (info "Serving at"
-          (str "http://" (.getCanonicalHostName
-                           (java.net.InetAddress/getLocalHost)) \: port \/))
+    (info "Serving at" (str "http://localhost:" port \/))
     (run-server (create-app) {:port port
                               :thread (conf/get :thread-count)})))


minor cleanup

minor cleanup

--- src/lambdacd/core.clj
+++ src/lambdacd/core.clj
@@ -4,14 +4,12 @@
             [lambdacd.execution :as execution]
             [lambdacd.pipeline-state :as pipeline-state]))

-(defn initial-context []
-  {:_pipeline-state (atom pipeline-state/initial-pipeline-state)})

 (defn- start-pipeline-thread [pipeline-def context]
   (async/thread (while true (execution/run pipeline-def context))))

 (defn mk-pipeline [pipeline-def]
-  (let [context (initial-context)
-        state (:_pipeline-state context)]
+  (let [state (atom pipeline-state/initial-pipeline-state)
+        context {:_pipeline-state state}]
     {:ring-handler (server/ui-for pipeline-def state)
      :init (partial start-pipeline-thread pipeline-def context)}))


Recognize a :classifier keyword for dependencies as the Maven classifier

Fixes #58

--- src/leiningen/pom.clj
+++ src/leiningen/pom.clj
@@ -75,9 +75,17 @@
     (.setGroupId (or (namespace excl) (name excl)))
     (.setArtifactId (name excl))))

-(defn make-dependency [[dep version & exclusions]]
-  (let [es (map make-exclusion (when (= (first exclusions) :exclusions)
-                                 (second exclusions)))]
+(defn make-dependency
+  "Makes a dependency from a seq. The seq (usually a vector) should contain a symbol to define the
+group and artifact id, then a version string. The remaining arguments are combined into a map. The  value
+for the :classifier key (if present) is the classifier on the dependency (as a string). The value for
+the :exclusions key, if present, is a seq of symbols, identifying group ids and artifact ids to exclude
+from transitive dependencies."
+  [[dep version & extras]]
+  (let [extras-map (apply hash-map extras)
+        exclusions (:exclusions extras-map)
+        classifier (:classifier extras-map)
+        es (map make-exclusion exclusions)]
     (doto (Dependency.)
       ;; Allow org.clojure group to be omitted from clojure/contrib deps.
       (.setGroupId (if (and (nil? (namespace dep))
@@ -86,6 +94,7 @@
                      (or (namespace dep) (name dep))))
       (.setArtifactId (name dep))
       (.setVersion version)
+      (.setClassifier classifier)
       (.setExclusions es))))

 (defn make-repository [[id url]]


Refactored tag rendering so it can hopefully be pre-compiled easily

--- src/hiccup.clj
+++ src/hiccup.clj
@@ -9,9 +9,11 @@
 (ns hiccup
   "Efficiently generate HTML from a Clojure data structure."
   (:use clojure.contrib.def)
-  (:use clojure.contrib.java-utils)
-  (:import clojure.lang.IPersistentVector)
-  (:import clojure.lang.IPersistentList))
+  (:use clojure.contrib.java-utils))
+
+(derive clojure.lang.IPersistentVector ::vector)
+(derive clojure.lang.IPersistentList ::list)
+(derive clojure.lang.ISeq ::seq)

 (defn escape-html
   "Change special characters into HTML character entities."
@@ -22,25 +24,17 @@
     (replace ">"  ">")
     (replace "\"" """)))

+(defn quoted?
+  "True if the form is a quoted value."
+  [x]
+  (and (list? x)
+       (= 'quote (first x))))
+
 (defn literal?
-  "True if the value is a literal string, keyword, number, map, vector, nil
-  or a quoted value."
+  "True if the value is a not a list or a quoted value."
   [x]
-  (or (string? x)
-      (number? x)
-      (keyword? x)
-      (vector? x)
-      (map? x)
-      (nil? x)
-      (and (list? x)
-           (= (first x) 'quote))))
-
-(defn- pre-compile
-  "Pre-compile a form if its arguments are all literals."
-  [form]
-  (if (every? literal? (rest form))
-    (eval form)
-    (list form)))
+  (or (not (list? x))
+      (quoted? x)))

 (defn- format-attr
   "Turn a key-value pair into a pair of attribute-value strings."
@@ -53,7 +47,7 @@
 (defn- make-attrs
   "Turn a map into a string of HTML attributes, sorted by attribute name."
   [attrs]
-  (apply str
+  (remove nil?
     (for [[attr value] (sort (map format-attr attrs))]
       (if attr
         (str " " attr "=\"" value "\"")))))
@@ -62,52 +56,56 @@
   #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?"
   "Regular expression that parses a CSS-style id and class from a tag name.")

-(defn make-start-tag
-  "Create the start of a tag, given a tag name with optional CSS-style syntax
-  to denote the id and classes."
+(defn parse-tag-name
+  "Parse the id and classes from a tag name."
   [tag]
-  (let [[_ tag id classes] (re-matches re-tag (as-str tag))]
-    (list "<" tag (make-attrs {:id id, :class classes}))))
+  (rest (re-matches re-tag (as-str tag))))

-(defn make-tag-attrs
-  "Create the attributes for a tag, if the second element of the vector is a
-  map."
-  [attrs]
-  (if (map? attrs)
-    (list (make-attrs attrs))))
+(defmulti render-html
+  "Render a Clojure data structure to a seq of HTML at runtime."
+  type)

-(defn make-end-tag
-  "Create an ending tag."
-  [tag]
-  (list "</" (as-str tag) ">"))
+(defn render-tag
+  "Render a HTML tag."
+  [tag-name content]
+  (let [[tag id class] (parse-tag-name tag-name)
+        attributes     (make-attrs {:id id, :class class})]
+    (concat
+      (list* "<" tag attributes)
+      content
+      (list "</" tag ">"))))

-(defn remove-attrs
-  "Remove optional attribute map from content."
-  [content]
-  (if (map? (first content))
-    (rest content)
+(defn render-attrs
+  "Render an attribute map."
+  [attrs content]
+  (concat
+    (if (map? attrs)
+      (make-attrs attrs))
     content))

-(defmulti compile-html
-  "Compile a Clojure data structure value to a seq of strings and forms."
-  (fn [x] (type x)))
+(defn render-content
+  "Render the contents of a tag."
+  [content]
+  (list*
+    ">"
+    (render-html
+      (if (map? (first content))
+        (rest content)
+        content))))

-(defmethod compile-html IPersistentVector
+(defmethod render-html ::vector
   [[tag & content]]
-  (concat
-    (pre-compile `(make-start-tag ~tag))
-    (pre-compile `(make-tag-attrs ~(first content)))
-    (list ">")
-    (mapcat compile-html (remove-attrs content))
-    (pre-compile `(make-end-tag ~tag))))
+  (render-tag tag
+    (render-attrs (first content)
+      (render-content content))))

-(defmethod compile-html IPersistentList
-  [form]
-  form)
+(defmethod render-html ::seq
+  [coll]
+  (mapcat render-html coll))

-(defmethod compile-html :default
+(defmethod render-html :default
   [x]
-  (list (pre-compile `(str ~x))))
+  (list (as-str x)))

 (defn collapse-strs
   "Concatenate adjacent strings in a sequence."
@@ -120,17 +118,7 @@
     '()
     (reverse coll)))

-(defn build-str-concat
-  "Build code to string concatenate a sequence of forms."
-  [coll]
-  (let [buffer (gensym "buffer")]
-   `(let [~buffer (StringBuffer.)]
-     ~@(for [x (collapse-strs coll)]
-        `(.append ~buffer ~x))
-       (.toString ~buffer))))
-
-(defmacro html
-  "Efficiently compile a Clojure data structure to HTML"
-  [& content]
-  (build-str-concat
-    (mapcat compile-html content)))
+;(defmacro html
+;  "Efficiently compile a Clojure data structure into a list of HTML."
+;  [& content]
+;  `(list ~@(mapcat compile-html content)))


removed left over prn

removed left over prn

--- src/karras.clj
+++ src/karras.clj
@@ -51,7 +51,6 @@

 (declare to-clj)
 (defn to-clj-value [v]
-  (prn v)
   (cond
    (isa? (class v) java.util.Map) (to-clj v)
    (isa? (class v) java.util.List) (map to-clj-value v)


solved sort-row cursor separation

solved sort-row cursor separation

--- src/om_grid/core.cljs
+++ src/om_grid/core.cljs
@@ -1,9 +1,9 @@
 (ns om-grid.core
   (:require [om.core :as om :include-macros true]
-            [om.dom :as dom :include-macros true]))
+            [om.dom :as dom :include-macros true]
+            [om-grid.utils :refer [olog]]))

 (defn grid-row-header [cursor owner]
-  ;; (olog cursor)
   (om/component
     (dom/th nil
       (dom/div #js {:className "grid-column-header-label"} (:label cursor))
@@ -15,11 +15,8 @@
   (om/component (dom/td nil r)))

 (defn grid-rows [row owner]
-  ;; sorting row here...
-  ;; (let [sorted-row (map #(get row %) (:column-order @my-testdev-grid))]
-  (let [sorted-row row]
-    (om/component
-      (apply dom/tr nil (om/build-all grid-col sorted-row)))))
+  (om/component
+    (apply dom/tr nil (om/build-all grid-col row))))

 (defn om-grid [app owner]
   (reify
@@ -32,4 +29,5 @@
                             (apply dom/tr #js {:className "om-grid-thead-tr"}
                                    (om/build-all grid-row-header (vec (sort-by #(:order %) (:columns app))))))
                  (apply dom/tbody #js {:className "om-grid-table-body"}
-                        (om/build-all grid-rows (:data app))))))))
+                        (om/build-all grid-rows (:data app)
+                                      {:fn (fn [r] (map #(get r %) (:column-order app)))})))))))


comments/renames highlighting what is for dev

--- src/om_pear/core.cljs
+++ src/om_pear/core.cljs
@@ -4,31 +4,36 @@
     [om.dom :as dom :include-macros true]
     [pear]))

-(def mygrid (atom {:columns
-                   (clj->js [(js/pear.data.Column. "Name" "name" "name" 100 js/pear.data.Column.DataType.TEXT js/pear.data.Column.Align.CENTER)
-                        (js/pear.data.Column. "Address" "address" "address" 300 js/pear.data.Column.DataType.TEXT js/pear.data.Column.Align.CENTER)])
-                   :data
-                   (clj->js [{:name "Bob Fleming" :address "230 Oak St., NJ USA"}
-                          {:name "Rick Rearden" :address "91 Windings Way, Clement OK 28174"}])
-                   :config (clj->js {:AllowColumnResize true :ShowCellBorder true :AllowAlternateRowHighlight true})
-                   :width 500 :height 150 :title "My Test Grid"
-                   }))
+(def my-testdev-grid (atom
+                       ; this should be defined where used.. this is for dev/testing really. remove when rdy
+                       ; could include this in docs
+                       {:columns
+                        (clj->js [(js/pear.data.Column. "Name" "name" "name" 100 js/pear.data.Column.DataType.TEXT js/pear.data.Column.Align.CENTER)
+                                  (js/pear.data.Column. "Address" "address" "address" 300 js/pear.data.Column.DataType.TEXT js/pear.data.Column.Align.CENTER)])
+                        :data
+                        (clj->js [{:name "Bob Fleming" :address "230 Oak St., NJ USA"}
+                                  {:name "Rick Rearden" :address "91 Windings Way, Clement OK 28174"}])
+                        :config (clj->js {:AllowColumnResize true :ShowCellBorder true :AllowAlternateRowHighlight true})
+                        :width 500 :height 150 :title "My Test Grid"
+                        }))

 (defn ^:export om-pear [app-state owner]
   (om/component (let [g (js/pear.ui.Grid.)
-                      dom-ele (dom/div #js {:id "grid2"})]
-                  (.setColumns g (:columns @mygrid))
-                  (.setDataRows g (:data @mygrid))
-                  (.setConfiguration g (:config @mygrid) )
-                  (.setWidth g (:width @mygrid))
-                  (.setHeight g (:height @mygrid))
-                  (.setTitle g (:title @mygrid))
-                  (.render g (. js/document (getElementById "grid2")))
+                      dom-ele (dom/div #js {:id "omdom-grid"})]
+                  (.setColumns g (:columns app-state))
+                  (.setDataRows g (:data app-state))
+                  (.setConfiguration g (:config app-state) )
+                  (.setWidth g (:width app-state))
+                  (.setHeight g (:height app-state))
+                  (.setTitle g (:title app-state))
+                  (.render g (. js/document (getElementById "omdom-grid")))
                   ;; (js/console.log g)
+                  (js/console.log dom-ele)
                   dom-ele)))

-(om/root
-  om-pear
-  mygrid
-  {:target (. js/document (getElementById "here"))})
+(om/root ; again for testing/dev.. remove when rdy
+         ; could include this in docs
+         om-pear
+         my-testdev-grid
+         {:target (. js/document (getElementById "here"))})


Major rework to eval

Major rework to eval

 - Remove def tracking
 - Rework configuration values accordingly
 - Pull related FIXMEs

After this change I'll do def detection in a separate analysis pass over
the eval'd forms. Figuring out how to deal with code in analyzed form is
probably gonna be most of today but it can't be helped.

--- src/oxcart.clj
+++ src/oxcart.clj
@@ -63,15 +63,12 @@
            (or *load-configuration*
                {:debug? false})))

-  ([form {:keys [debug? exec? ast env classloader]
-          :or   {exec? true
-                 debug? false}
-          :as options}]
-     (let [defs-ast  (:defs ast)
-           forms-ast (:forms ast)
-           mform     (binding [macroexpand-1 ana.jvm/macroexpand-1]
-                       (macroexpand form (or env
-                                             (ana.jvm/empty-env))))]
+  ([form {:keys [debug? exec? forms env classloader]
+          :or   {debug? false}
+          :as   options}]
+     (let [mform (binding [macroexpand-1 ana.jvm/macroexpand-1]
+                   (macroexpand form
+                                (or env (ana.jvm/empty-env))))]

        (if (and (seq? mform)
                 (= 'do (first mform)))
@@ -98,50 +95,38 @@
          ;;   answer is no, but it'd be nice.

          ;; FIXME: Closed over defs
-         ;;  This is gonna be invalid for a whole lot of code. Lambda
-         ;;  lifting is gonna come into play here methinks. I have to
-         ;;  get this working so that closed over defs are supported,
-         ;;  eg:
+         ;;   This is gonna be invalid for a whole lot of code. Lambda
+         ;;   lifting is gonna come into play here methinks. I have to
+         ;;   get this working so that closed over defs are supported,
+         ;;   eg:
          ;;
-         ;;  (let [x 3]
-         ;;    (def foo [y]
-         ;;         (+ x y)))
+         ;;   (let [x 3]
+         ;;     (def foo [y]
+         ;;          (+ x y)))
          ;;
          ;; This issue also impacts multimethods which are implemented
          ;; with closed over defs.

-         (let [ast   (binding [ana/macroexpand-1 ana.jvm/macroexpand-1
-                               ana/create-var    ana.jvm/create-var
-                               ana/parse         ana.jvm/parse
-                               ana/var?          var?]
-                       (ana.jvm/analyze mform
-                                        (or env (ana.jvm/empty-env))))]
-
-           ;; the accumulator for the whole read program
-           (when (and forms-ast
-                      (atom? forms-ast))
-             (swap! forms-ast conj ast))
-
-           ;; the accumulator for defs to structure
-           (when (and defs-ast
-                      (atom? defs-ast)
-                      (patern/def? ast))
-             (swap! defs-ast assoc
-                    (patern/def->symbol ast)
-                    ast))
-
-           ;; FIXME: Eval for side effects
-           ;;  Running code for side-effects may be something that I
-           ;;  need to conditionalize, see "Closed over defs"
-
-           ;; and run the code for side-effects.
-           (let [r     (-> `(^:once fn* [] ~mform)
-                           (ana.jvm/analyze (or env (ana.jvm/empty-env)))
-                           (e/emit {:debug?       debug?
-                                    :class-loader (or classloader
-                                                      (clojure.lang.RT/makeClassLoader))}))
-                 class (-> r meta :class)]
-             (.invoke ^IFn (.newInstance ^Class class))))))))
+         (do (let [ast (binding [ana/macroexpand-1 ana.jvm/macroexpand-1
+                                 ana/create-var    ana.jvm/create-var
+                                 ana/parse         ana.jvm/parse
+                                 ana/var?          var?]
+                         (ana.jvm/analyze mform
+                                          (or env (ana.jvm/empty-env))))]
+
+               ;; the accumulator for the whole read program
+               (when (and forms
+                          (atom? forms))
+                 (swap! forms conj ast)))
+
+             ;; and run the code for side-effects.
+             (let [r     (-> `(^:once fn* [] ~mform)
+                             (ana.jvm/analyze (or env (ana.jvm/empty-env)))
+                             (e/emit {:debug?       debug?
+                                      :class-loader (or classloader
+                                                        (clojure.lang.RT/makeClassLoader))}))
+                   class (-> r meta :class)]
+               (.invoke ^IFn (.newInstance ^Class class))))))))

 (defn load
@@ -159,18 +144,13 @@
     If config contains a :debug? key, then printing of the generated
     class bytecode and other development information is enabled.

-    If config contains an atom at [:ast :defs] the ASTs of all def
-    symbols will be assoc'd into that atom keyed on the symbol they
-    define. Multiple definitions will overwrite each other.
-
-    If config contains an atom at [:ast :forms] the ASTs of all read
-    forms will be conj'd to it in reading & evaluation order."
+    If config contains an atom at :forms the ASTs of all read forms
+    will be conj'd to it in reading & evaluation order."

   ([res]
      (load res
            (or *load-configuration*
-               {:debug? false
-                :exec?  true})))
+               {:debug? false})))

   ([res {:keys [debug?] :as options}]
      (let [p      (str (apply str (replace {\. \/ \- \_} res)) ".clj")
@@ -204,7 +184,7 @@
   config-map:
    `:passes` is a sequence of functions constituting an optimization
     configuration. These functions must be
-    (λ form-seq → def-map → settings → form-seq)
+    (λ form-seq → settings → form-seq)
     and pure. It is expected but not enforced that passes may not
     emit nodes which an emitter does not support. If passes is empty
     no program transformations will be done and the emitter will be
@@ -231,8 +211,7 @@
            defs  (atom {})
            config {:debug? false
                    :exec?  true
-                   :ast {:forms forms
-                         :defs defs}}]
+                   :forms forms}]
        ;; Loads and macroexpands all the code using the built config
        ;; to generate the forms and defs structures.
        (load res config)
@@ -247,11 +226,10 @@
        ;;   the mailing list.
        (let [settings (:passes settings)]
          (doseq [pass passes]
-           (swap! forms pass @defs settings)
+           (swap! forms pass settings)

            (let [eval-forms @forms]
              (reset! forms [])
-             (reset! defs  {})

              (doseq [form eval-forms]
                (eval (:form form)


Wrong namespace in sample.

Wrong namespace in sample.

--- sample.clj
+++ sample.clj
@@ -1,5 +1,5 @@
 (ns sample
-  (:require [async.http.client :as c]))
+  (:require [http.async.client :as c]))

 (let [r (c/GET "http://example.com/")]
   (println "done?" (c/done? r))


Cleared TODO and removed transient notes.

--- src/pamela/parser.clj
+++ src/pamela/parser.clj
@@ -1285,14 +1285,9 @@
       ;; (println "Magic" magic "MIR" mir)  ;; DEBUG
       (log/debug "MAGIC input\n" (with-out-str (pprint mir))))
     (reset! pamela-lvars mir)
-    ; TODO
-    ; Iterate over all input files
-    ;   For each file, create IR and merge with final-IR
-    ;   collecting errors in a vector
-    ; when no errors, validate before returning final-IR
-    ; otherwise return {:error []} only
     (let [transformed (transform-pamela-files input parser)
           fnil-conj (fnil conj [])
+          ;; Collect errors if any.
           ir (reduce (fn [ir [_ tir]]
                        (if (contains? tir :error)
                          (update ir :error fnil-conj (:error tir))


be selective about what subscriber info we send to the frontend

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -280,6 +280,22 @@
                                                                              team))
                            :entity-type :access-request}]))))

+(defn subscriber-read-api [subscriber]
+  (-> subscriber
+    (select-keys [:client-id
+                  :cust/uuid
+                  :cust/name
+                  :cust/color-name
+                  :frontend-id-seed
+                  :hide-in-list?
+                  :tool
+                  :layers
+                  :relation
+                  :recording?
+                  :show-mouse?])
+    (merge (when (:mouse-position subscriber)
+             (select-keys subscriber [:mouse-position])))))
+
 ;; TODO: subscribe should be the only function you need when you get to a doc, then it should send
 ;;       all of the data asynchronously
 (defmethod ws-handler :frontend/subscribe [{:keys [client-id ?data ?reply-fn] :as req}]
@@ -303,8 +319,8 @@
                                              :max-document-scope (auth/max-document-scope (:db req) doc (get-in req [:ring-req :auth]))}])

     (doseq [[uid _] (get @document-subs document-id)]
-      (send-fn uid [:frontend/subscriber-joined (merge {:client-id client-id}
-                                                       (get-in subs [document-id client-id]))]))
+      (send-fn uid [:frontend/subscriber-joined (subscriber-read-api (merge {:client-id client-id}
+                                                                            (get-in subs [document-id client-id])))]))

     ;; TODO: we'll need a read-api or something here at some point
     (log/infof "sending document for %s to %s" document-id client-id)
@@ -338,7 +354,9 @@
     (log/infof "sending subscribers for %s to %s" document-id client-id)
     (send-fn client-id [:frontend/subscribers
                         {:document/id document-id
-                         :subscribers (get subs document-id)}])
+                         :subscribers (reduce (fn [acc [client-id subscriber]]
+                                                (assoc acc client-id (subscriber-read-api subscriber)))
+                                              {} (get subs document-id))}])

     ;; These are interesting b/c they're read-only. And by "interesting", I mean "bad"
     ;; We should find a way to let the frontend edit things
@@ -449,15 +467,18 @@
         mouse-position (-> ?data :mouse-position)
         tool (-> ?data :tool)
         layers (-> ?data :layers)
-        relation (-> ?data :relation)]
+        relation (-> ?data :relation)
+        recording? (-> ?data :recording?)]
+    (swap! document-subs utils/update-when-in [document-id client-id] merge {:mouse-position mouse-position
+                                                                             :tool tool
+                                                                             :recording? recording?})
     (doseq [[uid _] (dissoc (get @document-subs document-id) client-id)]
-      ((:send-fn @sente-state) uid [:frontend/mouse-move (merge
-                                                          {:client-id client-id
-                                                           :tool tool
-                                                           :layers layers
-                                                           :relation relation}
-                                                          (when mouse-position
-                                                            {:mouse-position mouse-position}))]))))
+      ((:send-fn @sente-state) uid [:frontend/mouse-move (subscriber-read-api {:client-id client-id
+                                                                               :tool tool
+                                                                               :layers layers
+                                                                               :relation relation
+                                                                               :recording? recording?
+                                                                               :mouse-position mouse-position})]))))

 (defmethod ws-handler :frontend/update-self [{:keys [client-id ?data] :as req}]
   ;; TODO: update subscribers in a different way