allow nil values in type-hinted params

allow nil values in type-hinted params

--- src/asphalt/internal/param.clj
+++ src/asphalt/internal/param.clj
@@ -73,50 +73,38 @@

 (defn set-param-value
   [^PreparedStatement prepared-statement param-type ^long param-index param-value]
-  (case (get t/single-typemap param-type)
-    :nil        (if (instance? clojure.lang.BigInt param-value)
-                  (.setLong   prepared-statement param-index ^long (long param-value))
-                  (.setObject prepared-statement param-index ^Object param-value))
-    :boolean    (.setBoolean   prepared-statement param-index (boolean    param-value))
-    :byte       (.setByte      prepared-statement param-index (byte       param-value))
-    :byte-array (.setBytes     prepared-statement param-index (cond
-                                                                (= (type param-value) ba-type) param-value
-                                                                (nil? param-value) nil
-                                                                :else (byte-array param-value)))
-    :date       (if (instance? Calendar param-value)
-                  (.setDate    prepared-statement param-index (Date. (.getTimeInMillis ^Calendar param-value))
-                    ^Calendar param-value)
-                  (.setDate    prepared-statement param-index ^java.sql.Date param-value))
-    :double     (.setDouble    prepared-statement param-index (double     param-value))
-    :float      (.setFloat     prepared-statement param-index (float      param-value))
-    :int        (.setInt       prepared-statement param-index (int        param-value))
-    :long       (.setLong      prepared-statement param-index (long       param-value))
-    :nstring    (.setNString   prepared-statement param-index ^String param-value)
-    :object     (.setObject    prepared-statement param-index ^Object param-value)
-    :string     (.setString    prepared-statement param-index ^String param-value)
-    :time       (if (instance? Calendar param-value)
-                  (.setTime      prepared-statement param-index (Time. (.getTimeInMillis ^Calendar param-value))
-                    ^Calendar param-value)
-                  (.setTime      prepared-statement param-index ^java.sql.Time param-value))
-    :timestamp  (if (instance? Calendar param-value)
-                  (.setTimestamp prepared-statement param-index (Timestamp. (.getTimeInMillis ^Calendar param-value))
-                    ^Calendar param-value)
-                  (.setTimestamp prepared-statement param-index ^java.sql.Timestamp param-value))
-    (i/expected-single-param-type param-type)))
+  (if (nil? param-value)
+    (.setObject prepared-statement param-index nil)  ; param type doesn't matter for nil values
+    (case (get t/single-typemap param-type)
+      :nil        (if (instance? clojure.lang.BigInt param-value)
+                    (.setLong   prepared-statement param-index ^long (long param-value))
+                    (.setObject prepared-statement param-index ^Object param-value))
+      :boolean    (.setBoolean   prepared-statement param-index (boolean    param-value))
+      :byte       (.setByte      prepared-statement param-index (byte       param-value))
+      :byte-array (.setBytes     prepared-statement param-index ^bytes param-value)
+      :date       (if (instance? Calendar param-value)
+                    (.setDate    prepared-statement param-index (Date. (.getTimeInMillis ^Calendar param-value))
+                      ^Calendar param-value)
+                    (.setDate    prepared-statement param-index ^java.sql.Date param-value))
+      :double     (.setDouble    prepared-statement param-index (double     param-value))
+      :float      (.setFloat     prepared-statement param-index (float      param-value))
+      :int        (.setInt       prepared-statement param-index (int        param-value))
+      :long       (.setLong      prepared-statement param-index (long       param-value))
+      :nstring    (.setNString   prepared-statement param-index ^String param-value)
+      :object     (.setObject    prepared-statement param-index ^Object param-value)
+      :string     (.setString    prepared-statement param-index ^String param-value)
+      :time       (if (instance? Calendar param-value)
+                    (.setTime      prepared-statement param-index (Time. (.getTimeInMillis ^Calendar param-value))
+                      ^Calendar param-value)
+                    (.setTime      prepared-statement param-index ^java.sql.Time param-value))
+      :timestamp  (if (instance? Calendar param-value)
+                    (.setTimestamp prepared-statement param-index (Timestamp. (.getTimeInMillis ^Calendar param-value))
+                      ^Calendar param-value)
+                    (.setTimestamp prepared-statement param-index ^java.sql.Timestamp param-value))
+      (i/expected-single-param-type param-type))))

 ;; ----- param laying helpers -----
-
-
-(defmacro verify
-  [klass instance]
-  (i/expected symbol? "a class symbol" klass)
-  (let [sym (with-meta (gensym) {:tag (str klass)})]
-    `(let [~sym ~instance]
-       (cond
-         (instance? ~klass ~sym) ~sym
-         (nil? ~sym)             nil
-         :else (i/expected ~(str "nil or instance of class " klass) ~sym)))))

 (defmacro try-param
@@ -129,61 +117,73 @@
                 e#)))))

+(defmacro try-set
+  [prepared-stmt pindex-sym type-label pvalue-expr pvalue-sym & body]
+  `(let [~pvalue-sym (try-param ~pindex-sym ~type-label ~pvalue-expr)]
+     (if (nil? ~pvalue-sym)
+       (.setObject ~prepared-stmt ~pindex-sym nil)
+       (try
+         ~@body
+         (catch ClassCastException e#
+           (throw (IllegalArgumentException.
+                    (str "Error setting SQL param " ~pindex-sym ~(apply str " as " type-label ": " body))
+                    e#)))
+         (catch Exception e#
+           (throw (IllegalStateException.
+                    (str "Error setting SQL param " ~pindex-sym ~(apply str " as " type-label ": " body))
+                    e#)))))))
+
+
 (defn lay-param-expr
   "Given prepared statement symbol, parm type, param index expression/symbol and param value expression/symbol, return
   an expression to set JDBC prepared statement param."
-  [pstmt-sym param-type pindex-sym pvalue-sym]
+  [pstmt-sym param-type pidx-sym pval-sym]
   (when-not (contains? t/all-typemap param-type) (i/expected-param-type param-type))
   (if (contains? t/multi-typemap param-type)  ; multi-bit?
     (let [i-sym (gensym "i-")
           v-sym (gensym "v-")]
-      `(i/loop-indexed [~i-sym ~pindex-sym
-                        ~v-sym ~pvalue-sym]
+      `(i/loop-indexed [~i-sym ~pidx-sym
+                        ~v-sym ~pval-sym]
          ~(lay-param-expr pstmt-sym (get t/multi-typemap param-type) i-sym v-sym)))
     (case (get t/single-typemap param-type)
-      :nil        `(set-param-value ~pstmt-sym :nil ~pindex-sym ~pvalue-sym)
-      :boolean    `(.setBoolean ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "boolean"    (boolean ~pvalue-sym)))
-      :byte       `(.setByte    ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "byte"       (byte    ~pvalue-sym)))
-      :byte-array `(.setBytes   ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "byte-array" (let [v# ~pvalue-sym]
-                                                                                (cond
-                                                                                (= (type v#) ba-type) v#
-                                                                                (nil? v#)             nil
-                                                                                :else (byte-array v#)))))
-      :date       `(let [p# (try-param ~pindex-sym "date" ~pvalue-sym)]
+      :nil        `(set-param-value ~pstmt-sym :nil ~pidx-sym ~pval-sym)
+      :boolean    `(try-set ~pstmt-sym ~pidx-sym "boolean"    ~pval-sym v# (.setBoolean ~pstmt-sym ~pidx-sym (boolean
+                                                                                v#)))
+      :byte       `(try-set ~pstmt-sym ~pidx-sym "byte"       ~pval-sym v# (.setByte    ~pstmt-sym ~pidx-sym (byte v#)))
+      :byte-array `(try-set ~pstmt-sym ~pidx-sym "byte-array" ~pval-sym v# (.setBytes   ~pstmt-sym ~pidx-sym v#))
+      :date       `(let [p# (try-param ~pidx-sym "date" ~pval-sym)]
                      (cond
-                       (instance? Date p#) (.setDate ~pstmt-sym ~pindex-sym ^java.sql.Date p#)
+                       (instance? Date p#) (.setDate ~pstmt-sym ~pidx-sym ^java.sql.Date p#)
                        ;; calendar
-                       (instance? Calendar p#) (.setDate ~pstmt-sym ~pindex-sym
+                       (instance? Calendar p#) (.setDate ~pstmt-sym ~pidx-sym
                                                  (Date. (.getTimeInMillis ^java.util.Calendar p#))
                                                  ^java.util.Calendar p#)
-                       (nil? p#)    (.setDate ~pstmt-sym ~pindex-sym nil)
+                       (nil? p#)    (.setDate ~pstmt-sym ~pidx-sym nil)
                        :otherwise   (i/expected "java.sql.Date or java.util.Calendar instance" p#)))
-      :double     `(.setDouble    ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "double"   (double     ~pvalue-sym)))
-      :float      `(.setFloat     ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "float"    (float      ~pvalue-sym)))
-      :int        `(.setInt       ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "int"      (int        ~pvalue-sym)))
-      :long       `(.setLong      ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "long"     (long       ~pvalue-sym)))
-      :nstring    `(.setNString   ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "string"   (verify java.lang.String
-                                                                                ~pvalue-sym)))
-      :object     `(.setObject    ~pstmt-sym ~pindex-sym ~pvalue-sym)
-      :string     `(.setString    ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "string"   (verify java.lang.String
-                                                                                ~pvalue-sym)))
-      :time       `(let [p# (try-param ~pindex-sym "time" ~pvalue-sym)]
+      :double     `(try-set ~pstmt-sym ~pidx-sym "double"  ~pval-sym v# (.setDouble  ~pstmt-sym ~pidx-sym (double v#)))
+      :float      `(try-set ~pstmt-sym ~pidx-sym "float"   ~pval-sym v# (.setFloat   ~pstmt-sym ~pidx-sym (float v#)))
+      :int        `(try-set ~pstmt-sym ~pidx-sym "int"     ~pval-sym v# (.setInt     ~pstmt-sym ~pidx-sym (int v#)))
+      :long       `(try-set ~pstmt-sym ~pidx-sym "long"    ~pval-sym v# (.setLong    ~pstmt-sym ~pidx-sym (long v#)))
+      :nstring    `(try-set ~pstmt-sym ~pidx-sym "nstring" ~pval-sym v# (.setNString ~pstmt-sym ~pidx-sym v#))
+      :object     `(.setObject    ~pstmt-sym ~pidx-sym ~pval-sym)
+      :string     `(try-set ~pstmt-sym ~pidx-sym "string"  ~pval-sym v# (.setString  ~pstmt-sym ~pidx-sym v#))
+      :time       `(let [p# (try-param ~pidx-sym "time" ~pval-sym)]
                      (cond
-                       (instance? Date p#) (.setTime ~pstmt-sym ~pindex-sym ^java.sql.Time p#)
+                       (instance? Date p#) (.setTime ~pstmt-sym ~pidx-sym ^java.sql.Time p#)
                        ;; calendar
-                       (instance? Calendar p#) (.setTime ~pstmt-sym ~pindex-sym
+                       (instance? Calendar p#) (.setTime ~pstmt-sym ~pidx-sym
                                                  (Time. (.getTimeInMillis ^java.util.Calendar p#))
                                                  ^java.util.Calendar p#)
-                       (nil? p#)    (.setTime ~pstmt-sym ~pindex-sym nil)
+                       (nil? p#)    (.setTime ~pstmt-sym ~pidx-sym nil)
                        :otherwise   (i/expected "java.sql.Time or java.util.Calendar instance" p#)))
-      :timestamp  `(let [p# (try-param ~pindex-sym "timestamp" ~pvalue-sym)]
+      :timestamp  `(let [p# (try-param ~pidx-sym "timestamp" ~pval-sym)]
                      (cond
-                       (instance? Timestamp p#) (.setTimestamp ~pstmt-sym ~pindex-sym ^java.sql.Timestamp p#)
+                       (instance? Timestamp p#) (.setTimestamp ~pstmt-sym ~pidx-sym ^java.sql.Timestamp p#)
                        ;; calendar
-                       (instance? Calendar p#) (.setTimestamp ~pstmt-sym ~pindex-sym
+                       (instance? Calendar p#) (.setTimestamp ~pstmt-sym ~pidx-sym
                                                  (Timestamp. (.getTimeInMillis ^java.util.Calendar p#))
                                                  ^java.util.Calendar p#)
-                       (nil? p#)    (.setTimestamp ~pstmt-sym ~pindex-sym nil)
+                       (nil? p#)    (.setTimestamp ~pstmt-sym ~pidx-sym nil)
                        :otherwise   (i/expected "java.sql.Timestamp or java.util.Calendar instance" p#)))
       (i/expected-single-param-type param-type))))


remove use of "intransitivize" rule: now relies on (default)s

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -8,7 +8,6 @@
                             verb-pred-defaults]]
    [babel.english.morphology :as morph]
    [babel.english.pos :refer [adjective
-                              intransitivize
                               subject-verb-agreement
                               transitivize]]
    [dag_unify.core :refer [dissoc-paths fail? get-in strip-refs unifyc]]))
@@ -2320,11 +2319,9 @@
                                   :shared-with-obj false
                                   :obj :unspec}}})

-                 ;; make an intransitive version of every verb which has an
-                 ;; [:sem :obj] path.
-                 intransitivize
-
-                 ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
+                 ;; If verb does specify a [:sem :obj], then fill
+                 ;; it in with subcat info.
+                 ;; TODO: remove use of this opaque function: 'transitivize'
                  transitivize

                  (verb-pred-defaults encyc/verb-pred-defaults)


whitespace

whitespace

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1560,7 +1560,7 @@
                     :gender :masc
                     :number :plur}
               :sem {:gender :masc
-                   :human false
+                    :human false
                     :pred :loro}
               :subcat '()}}]
    "they (♀)"


+yellow

+yellow

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2284,6 +2284,14 @@
                     :sem {:pred :yell}
                     :subcat {:2 {:cat :prep
                                  :sem {:pred :at}}}}}
+   "yellow"
+   (unify adjective
+          {:synsem {:cat :adjective
+                    :sem {:mod {:pred :yellow}
+                          :comparative false
+                          :physical-object true
+                          :human false}}})
+
    "you"
    [{:english {:note "♂"}
      :target :it ;; Italian makes gender distinction for agreement with verbs and adjectives..


attempts to prevent phrasal verbs from intransitivizing

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -282,3 +282,4 @@
    ;; </prep default rules>

    ))
+


cantare: human must be true

cantare: human must be true

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -434,7 +434,8 @@
                           :sem {:pred :erase}}}

    "cantare" {:synsem {:cat :verb
-                       :sem {:pred :sing}}}
+                       :sem {:pred :sing
+                             :subj {:human true}}}}

    "caricare" {:italiano {:future-stem "carich"}
                :synsem {:cat :verb


Fix cljs test #274 #356

Fix cljs test #274 #356

--- src/datascript/db.cljc
+++ src/datascript/db.cljc
@@ -327,23 +327,26 @@
    (defmacro case-tree [qs vs]
      (-case-tree qs vs)))

-(defn cmp [o1 o2]
-  (if (nil? o1) 0
-    (if (nil? o2) 0
-      (compare o1 o2))))
-
-(defn value-compare [o1 o2]
+(defn cmp [x y]
+  (if (nil? x) 0
+    (if (nil? y) 0
+      (compare x y))))
+
+(defn value-compare [x y]
   (cond
-    (= o1 o2) 0
-    #?@(:clj  [(instance? Comparable o1)   (compare o1 o2)]
-        :cljs [(satisfies? IComparable o1) (-compare o1 o2)])
-    :else     (- (hash o1) (hash o2))))
-
-(defn value-cmp [o1 o2]
+    (= x y) 0
+    #?@(:clj  [(instance? Number x)       (clojure.lang.Numbers/compare x y)])
+    #?@(:clj  [(instance? Comparable x)   (.compareTo x y)]
+        :cljs [(satisfies? IComparable x) (-compare x y)])
+    #?@(:cljs [(and (or (string? x) (array? x) (true? x) (false? x))
+                 (identical? (type x) (type y))) (garray/defaultCompare x y)])
+    :else (- (hash x) (hash y))))
+
+(defn value-cmp [x y]
   (cond
-    (nil? o1) 0
-    (nil? o2) 0
-    :else     (value-compare o1 o2)))
+    (nil? x) 0
+    (nil? y) 0
+    :else     (value-compare x y)))

 ;; Slower cmp-* fns allows for datom fields to be nil.
 ;; Such datoms come from slice method where they are used as boundary markers.


Use callout and panel wrapper

Use callout and panel wrapper

--- src/discuss/views.cljs
+++ src/discuss/views.cljs
@@ -215,8 +215,7 @@
                       (get-in data [:layout :intro])
                       (dom/br nil)
                       (dom/strong nil (get-in data [:issues :info]))))
-           (vlib/panel-wrapper
-             (view-dispatcher data))
+           (bs/panel-wrapper (view-dispatcher data))
            (when (get-in data [:layout :add?])
              (om/build add-element {}))
            (clipboard/view)))


Set fn when-v-node, when-v-kv, when-v-attrs as private in wpml

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -148,20 +148,20 @@
          (node :w:semiHidden)
          (node :w:unhideWhenUsed))])

-(defn when-v-node
+(defn- when-v-node
   "Returns an XML tag node when the value exists."
   [v tag]
   (cond (nil? v) nil
         (= "" v) (node tag)
         true (node tag {} (str v))))

-(defn when-v-kv
+(defn- when-v-kv
   "Returns a vector of [k v] when the value exists."
   [v k]
   (if (nil? v) nil
     [k v]))

-(defn when-v-attrs
+(defn- when-v-attrs
   "Returns an XML tag attributes without nil values."
   [& kvs]
   (into {}


Relativize script paths before writing the shim

--- src/adzerk/boot_cljs.clj
+++ src/adzerk/boot_cljs.clj
@@ -68,7 +68,12 @@
 (defn- write-shim!
   [f shim-path incs cljs output-path output-dir]
   (let [output-dir (replace-path shim-path output-dir)
-        scripts  (concat incs [(.getPath (io/file output-dir "goog" "base.js")) output-path])]
+        shim-dir (.getParentFile (io/file shim-path))
+        scripts  (-> incs
+                     (->> (mapv io/file))
+                     (conj (io/file output-dir "goog" "base.js"))
+                     (conj output-path)
+                     (->> (mapv (partial relative-to shim-dir))))]
     (spit f (format shim-js
                     (.getName f)
                     (apply str (map write-src scripts))


With Hanasu, no longer need msgpacket stuff

--- src/aerobio/pgmgraph.clj
+++ src/aerobio/pgmgraph.clj
@@ -45,7 +45,6 @@
    ;; For pgm graph data shape validation
    [schema.core :as sch]

-   [aerial.msgpacket.binaryjs :as bjs]
    [aerial.utils.coll :as coll :refer [in takev-until dropv-until ensure-vec]]
    [aerial.fs :as fs]

@@ -611,9 +610,8 @@
         proxclient (urlmap :bsc)
         qid (urlmap :qid)
         ;;out (io/output-stream (fs/join (fs/pwd) "cache" "backstream.bam"))
-        stream (bjs/new-stream
-                (:clients msgpacket) (proxclient :id) nil
-                {:event "backstream", :params {:id qid}})
+        stream  {:clients-db-from-somewhere (proxclient :id)
+                 :event "backstream", :params {:id qid}}
         on (stream :on)]
     (infof "!!! Start getting backstream data...")
     (on :onData


more/need and processing there of broken

--- src/aerobio/pgmgraph.clj
+++ src/aerobio/pgmgraph.clj
@@ -522,12 +522,15 @@
   (func-node :n->1))

 (defn one2n? [func-node]
-  (func-node :n->1))
-
-(defn nxt []
+  (func-node :1->n))
+
+(defn need
+  "Inside function nodes, call this to indicate more values are needed
+  to generate next output."
+  []
   ::nextinput)

-(defn nxt? [res]
+(defn need? [res]
   (= res ::nextinput))

@@ -536,7 +539,7 @@

 (defn more
   "Inside 'generator/repeat' function nodes, call this to indicate
-  there are move values to return."
+  there are more values to return."
   [] ::more)

 (defn more?
@@ -723,20 +726,20 @@
                         repeat?
                         (loop [res (apply func (concat args [data]))]
                           (cond
-                            (done? res) :nop
-                            (more? res) (recur (apply func args))
+                            (done? res) :nop ; repeat same as non
+                            (need? res) :nop ; next data comes from channels
+                            (more? res) :requires-mult-sigs-how-does-this-work?
                             :else
-                            (do (doseq [ch outputs] (>! ch res))
-                                (recur (apply func args)))))
+                            (when res
+                              (doseq [ch outputs] (>! ch res)))))
                         :else
                         (let [res (apply func (concat args [data]))]
                           (cond
-                            (more? res) :nop
+                            (need? res) :nop ; outer loop gets next data set
                             (done? res) (vswap! short-circuit? truefn)
                             :else
                             (when res
-                              (doseq [ch outputs]
-                                (>! ch res))))))
+                              (doseq [ch outputs] (>! ch res))))))
                       (catch Exception e
                         (warnf "%s, Exception %s\n %s\n %s"
                                (funcm :id) e args data))))


Added cmd line arg

Added cmd line arg

--- src/crawler/main.clj
+++ src/crawler/main.clj
@@ -1,6 +1,7 @@
 (ns crawler.main
   "Run from here"
   (:require [clojure.tools.cli :as cli]
+            [crawler.corpus :as corpus]
             [crawler.crawl :as crawl]
             [clojure.java.io :as io]
             [crawler.model :as crawler-model]
@@ -21,7 +22,8 @@
     :default 500
     :parse-fn #(Integer/parseInt %)]
    [nil "--refine" "Refine a model file"]
-   [nil "--corpus CORPUS" "Specify a corpus"]])
+   [nil "--corpus CORPUS" "Specify a corpus"]
+   [nil "--corpus-to-json CORPUS" "Convert corpus file to json file"]])

 (defn dump-state-model-corpus
   "Creates a dated file _prefix_-yr-month-day-hr-min.corpus/state/model"
@@ -117,6 +119,9 @@
           (let [model-file (:model options)
                 corpus     (:corpus options)]
             (crawler-model/plan-dump-model model-file corpus))
+
+          (:corpus-to-json options)
+          (corpus/corpus->json (:corpus-to-json options))

           :else
           (println "Pick one bruh"))))


Break apart regex failure types

Break apart regex failure types

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -196,8 +196,11 @@
           :spec/contains-key-pred
           (nth pred 2)))))

-(defn regex-failure? [_problem problem]
-  (contains? #{"Insufficient input" "Extra input"} (:reason problem)))
+(defn insufficient-input? [_problem problem]
+  (contains? #{"Insufficient input"} (:reason problem)))
+
+(defn extra-input? [_problem problem]
+  (contains? #{"Extra input"} (:reason problem)))

 (defn multi-spec [pred spec]
   (->> (s/form spec)
@@ -290,7 +293,7 @@
    (header-label "Missing spec")
    (expected-str _type spec-name val path problems opts)))

-(defmethod problem-group-str :problem/regex-failure [_type spec-name val path problems opts]
+(defmethod problem-group-str :problem/insufficient-input [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -298,9 +301,18 @@

 %s"
      (header-label "Syntax error")
-     (case (:reason problem)
-       "Insufficient input" (insufficient-input spec-name val path problem)
-       "Extra input" (extra-input spec-name val path)))))
+     (insufficient-input spec-name val path problem))))
+
+(defmethod problem-group-str :problem/extra-input [_type spec-name val path problems opts]
+  (s/assert ::singleton problems)
+  (let [problem (first problems)]
+    (printer/format
+     "%s
+
+%s"
+     (header-label "Syntax error")
+     (extra-input spec-name val path))))
+

 (defmethod problem-group-str :problem/fspec-exception-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
@@ -393,8 +405,12 @@
     (missing-spec? failure problem)
     :problem/missing-spec

-    (regex-failure? failure problem)
-    :problem/regex-failure
+    ;; TODO - move to top of list
+    (insufficient-input? failure problem)
+    :problem/insufficient-input
+
+    (extra-input? failure problem)
+    :problem/extra-input

     (fspec-exception-failure? failure problem)
     :problem/fspec-exception-failure


fix Director Haas' Pet Project

fix Director Haas' Pet Project

--- src/clj/game/cards-agendas.clj
+++ src/clj/game/cards-agendas.clj
@@ -94,7 +94,7 @@
                                                    (or (= (:zone %) [:hand])
                                                        (= (:zone %) [:discard])))}
                               :effect (req (corp-install state side target
-                                            (str "Server " (dec (count (get-in @state [:corp :servers :remote])))) {:no-install-cost true})
+                                            (last (get-remote-names @state)) {:no-install-cost true})
                                            (when (< n 2)
                                              (resolve-ability state side (dpp (inc n)) card nil)))})]
      {:optional {:prompt "Create a new remote server?"


Add helper fn for recursively touching an entity

--- src/clj/gtfve/data/queries.clj
+++ src/clj/gtfve/data/queries.clj
@@ -1,6 +1,18 @@
 (ns gtfve.data.queries
   (:require [datomic.api :as d]
             [gtfve.data.connection :refer [conn uri feed]]))
+
+(defn touch-all
+  "Touches entity e and all other reachable Entities of e"
+  [e]
+  (cond
+    (instance? datomic.query.EntityMap e)
+    (reduce (fn [m [k v]]
+              (assoc m k (touch-all v)))
+            {}
+            (d/touch e))
+    (set? e) (into #{} (map touch-all e))
+    :else e))

 (defn trips []
   (let [db (d/db conn)]
@@ -22,7 +34,7 @@
           first
           :e
           (d/entity db)
-          d/touch))))
+          touch-all))))

 (defn haversine
   [{lon1 :longitude lat1 :latitude} {lon2 :longitude lat2 :latitude}]


Randomize initial user locations

Randomize initial user locations

--- src/clj/salava/location/db.clj
+++ src/clj/salava/location/db.clj
@@ -19,6 +19,7 @@
   ([seed v multip]
    (let [op (if (even? seed) - +)]
      (op v (* (fake-rand seed) 0.0019 multip)))))
+

 (defn set-location-reset [ctx user-id]
   (jdbc/with-db-transaction  [tx (:connection (u/get-db ctx))]
@@ -51,10 +52,22 @@
     (or (select-user-location-public {:user user-id} (u/get-db-1 ctx)) {:lat nil :lng nil})))

+(defn- country-latlng
+  "Get default location from user's country.
+  Add small amount of random noise so that multiple users have different coordinates."
+  [country]
+  (let [ll (get c/lat-lng (keyword country))
+        move (fn [v] (if (> (rand) 0.5)
+                       (+ v (rand 0.75))
+                       (- v (rand 0.75))))]
+    (if ll
+      {:lat (move (:lat ll)) :lng (move (:lng ll))}
+      {:lat nil :lng nil})))
+
 (defn user-location [ctx user-id]
   (if-let [user (select-user {:user user-id} (u/get-db-1 ctx))]
     {:enabled (select-user-location {:user user-id} (u/get-db-1 ctx))
-     :country (get c/lat-lng (keyword (:country user)) {:lat nil :lng nil})
+     :country (country-latlng (:country user))
      :public (pos? (:location_public user))}
     {:enabled nil
      :country {:lat nil :lng nil}


replace score test boilerplate with score-agenda

--- src/clj/test/cards-agendas.clj
+++ src/clj/test/cards-agendas.clj
@@ -6,13 +6,7 @@
     (new-game (default-corp [(qty "Ancestral Imager" 3)]) (default-runner))
     (play-from-hand state :corp "Ancestral Imager" "New remote")
     (let [ai (get-in @state [:corp :servers :remote1 :content 0])]
-      (core/advance state :corp {:card (refresh ai)})
-      (core/advance state :corp {:card (refresh ai)})
-      (take-credits state :corp)
-      (take-credits state :runner)
-      (core/advance state :corp {:card (refresh ai)})
-      (is (= 3 (get-in (refresh ai) [:advance-counter])))
-      (core/score state :corp {:card (refresh ai)})
+      (score-agenda state :corp ai)
       (take-credits state :corp)
       (is (= 3 (count(get-in @state [:runner :hand]))))
       (core/click-run state :runner {:server :hq})


Update comment / testing map

Update comment / testing map

--- src/clj/traveler/api/users.clj
+++ src/clj/traveler/api/users.clj
@@ -16,7 +16,7 @@
 ;;
 ;; Optional Fields (default to false)
 ;;  istest
-;;  can_masquerade
+;;  can-masquerade
 (defn validate-add-user
   "Validate user map"
   [user]
@@ -34,15 +34,16 @@

 ;;testing

-;(def user {:id-sk "00392"
-;           :username "mgeorge"
-;           :password "kaj309jdfna0sd9flk4nas2"
-;           :privilege "ADMIN"
-;           :lastname "George"
-;           :firstname "Michael"
-;           :email "mgeorge@vlacs.org"
-;           :policies-assent-date "2001-03-02"
-;           })
+#_
+(def user {:id-sk "00392"
+           :username "mgeorge"
+           :password "kaj309jdfna0sd9flk4nas2"
+           :privilege "ADMIN"
+           :lastname "George"
+           :firstname "Michael"
+           :email "mgeorge@vlacs.org"
+           :policies-assent-date "2001-03-02"
+           })

 ;;end testing


better resources management

better resources management

--- src/clj/work_sessions/core.clj
+++ src/clj/work_sessions/core.clj
@@ -4,6 +4,7 @@
             [compojure.route :refer [resources]]
             [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
             [ring.middleware.multipart-params :refer [wrap-multipart-params]]
+            [ring.middleware.resource :refer [wrap-resource]]
             [ring.middleware.gzip :refer [wrap-gzip]]
             [ring.util.request :refer [body-string]]
             ;; [ring.middleware.logger :refer [wrap-with-logger]]
@@ -118,15 +119,22 @@
   ;;      (what-is-my-ip request))

   (GET "/js/*" _
-    {:status 404})
-  (GET "/*" _
+       {:status 404})
+
+  (resources "/css/*")
+
+
+  #_(GET "/*" _
     {:status 200
      :headers {"Content-Type" "text/html; charset=utf-8"}
-     :body (io/input-stream (io/resource "public/index.html"))}))
+     :body (io/input-stream (io/resource "public/index.html"))})
+  )

 (def http-handler
   (-> routes
       (wrap-defaults (assoc-in site-defaults [:security :anti-forgery] false))
+      (wrap-resource "public/css")
+      (ring.middleware.content-type/wrap-content-type)
       logger.onelog/wrap-with-logger
       wrap-gzip))


stroke for weird browsers

stroke for weird browsers

--- src/cljs/devplatform/core.cljs
+++ src/cljs/devplatform/core.cljs
@@ -38,7 +38,8 @@
         (.append "rect")
         (.attr #js {:width WIDTH :height 1 :class "block"})
         (.style "fill" #(shift-color (aget % "name")))
-        (.style "stroke" 1))
+        (.style "stroke-width" 1)
+        (.style "stroke" "black"))
     (-> enterGroup
         (.append "text")
         (.style "fill" "white")


Fix present-packages functionality

Fix present-packages functionality

--- src/degasolv/cli.clj
+++ src/degasolv/cli.clj
@@ -150,24 +150,26 @@
                    (string-to-requirement vetted-str-req)))
                requirements))
        present-packages
-       (map
-         (fn [str-pkg]
-           (let [vetted-str-pkg
-                 (s/conform ::r/frozen-package-string str-pkg)]
-             (when (= vetted-str-pkg ::s/invalid)
-               (binding [*out* *err*]
-                 (println
-                   (str
-                     "Present package string `"
-                     str-pkg
-                     "` invalid:"
-                     (s/explain ::r/frozen-package-string str-pkg)))))
-             (let [[id version] (string/split str-pkg #"==")]
-               (->PackageInfo
-                 id
-                 version
-                 "Already present"
-                 nil))))
+       (into {}
+             (map
+               (fn [str-pkg]
+                 (let [vetted-str-pkg
+                       (s/conform ::r/frozen-package-string str-pkg)]
+                   (when (= vetted-str-pkg ::s/invalid)
+                     (binding [*out* *err*]
+                       (println
+                         (str
+                           "Present package string `"
+                           str-pkg
+                           "` invalid:"
+                           (s/explain ::r/frozen-package-string str-pkg)))))
+                   (let [[id version] (string/split str-pkg #"==")]
+                     [id
+                      (->PackageInfo
+                        id
+                        version
+                        "Already present"
+                        nil)]))))
          (:present-packages options))
        aggregate-repo
        (aggregate-repositories


with-testing-data now prints binding on failure

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

--- src/conexp/util.clj
+++ src/conexp/util.clj
@@ -48,11 +48,16 @@
 				    namespaces))))))

 (defmacro with-testing-data
-  "Expects for all bindings the body to be evaluated to true. bindings
-  must be suitable for forall."
-  [bindings & body]
-  `(forall ~bindings
-     ~@(map (fn [expr] `(is ~expr))
+  "Expects for all bindings of var to elements of coll the body to be
+  evaluated to true."
+  [[var coll] & body]
+  `(forall [~var ~coll]
+     ~@(map (fn [expr]
+              `(let [result# (do ~expr)]
+                 (if-not result#
+                   (do (println "Test failed for" '~var "being" ~var)
+                       (is false))
+                   (is true))))
             body)))

 ;;; Types


populate uploads on slots increase

populate uploads on slots increase

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -420,7 +420,13 @@

 (.on socket "upload-slots-change"
   (fn [new-upload-slots]
-    (swap! app-state assoc :upload-slots new-upload-slots)))
+    (let [old-upload-slots (:upload-slots @app-state)]
+      (swap! app-state assoc :upload-slots new-upload-slots)
+      (if (> new-upload-slots old-upload-slots)
+        (let [next-file (last (:upload-queue @app-state))]
+          (swap! app-state assoc :upload-queue (pop (:upload-queue @app-state)))
+          (upload-file next-file)
+        )))))

 (.onready js/soundManager
   (fn []


fixed adding music after hotjoin

fixed adding music after hotjoin

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -136,6 +136,7 @@
   (fn [music-info]
     (swap! app-state assoc :music-info
       (merge (:music-info @app-state) music-info))
+    (println (:music-info @app-state))
     (if (:play-next-upload? @app-state)
       (do
         (.emit socket "file-download-request" (.-id music-info))
@@ -200,8 +201,9 @@

 (.on socket "hotjoin-music-info"
   (fn [room-music-info current-track-id]
-    (swap! app-state assoc :music-info (.sort room-music-info
-                                              #(- (.-tracknum %1)
-                                                  (.-tracknum %2))))
+    (let [sorted-music-info (.sort room-music-info #(- (.-tracknum %1)
+                                                       (.-tracknum %2)))]
+      (swap! app-state assoc :music-info (map #(clj->js %1) (js->clj sorted-music-info)))
+      (println (:music-info @app-state)))
     (swap! app-state assoc :current-track-id current-track-id)
     (.emit socket "file-download-request" current-track-id)))


fixed multiple file uploads

fixed multiple file uploads

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -10,7 +10,7 @@
                           :upload-progress nil
                           :data-uploaded 0
                           :current-file-download nil
-                          :current-download-stream-id nil}))
+                          :current-download-stream-id (new js/Blob)}))

 (enable-console-print!)

@@ -87,31 +87,31 @@

 (.on (new js/ss socket) "file-to-client"
   (fn [stream]
-    (if (nil? (:current-download-stream-id @app-state)) (fn []
-      (swap! app-state assoc :current-download-stream-id (.-id stream))
-      (swap! app-state assoc :current-file-download (new js/Blob))))
+    (if (= 0 (:current-file-download @app-state))
+      (swap! app-state assoc :current-download-stream-id (.-id stream)))
     (.on stream "data"
       (fn [blob-chunk]
         (if (= (.-id stream) (:current-download-stream-id @app-state))
-          (println "H")
+          (println (.-id stream))
           (swap! app-state assoc :current-file-download
             (new js/Blob #js [(:current-file-download @app-state) blob-chunk])))))
     (.on stream "end"
       (fn []
         (if (= (.-id stream) (:current-download-stream-id @app-state))
-        (println (.-size (:current-file-download @app-state)))
-        (let [reader (new js/FileReader)
-              blob   (:current-file-download @app-state)]
-          (.readAsDataURL reader blob)
-          (set! (.-onloadend reader)
-            (fn []
-              (println (.-result reader))
-              (println (.attr (js/$ "#current-track") "src"))
-              (.attr (js/$ "#current-track") "src" (.-result reader))
-              (println (.attr (js/$ "#current-track") "src"))
-              (.load (.getElementById js/document "audio-tag"))
-              (.play (.getElementById js/document "audio-tag"))
-              (swap! app-state assoc :current-download-stream-id nil)))))))))
+          (println (.-size (:current-file-download @app-state)))
+          (let [reader (new js/FileReader)
+                blob   (:current-file-download @app-state)]
+            (.readAsDataURL reader blob)
+            (set! (.-onloadend reader)
+              (fn []
+                (println (.-result reader))
+                (println (.attr (js/$ "#current-track") "src"))
+                (.attr (js/$ "#current-track") "src" (.-result reader))
+                (println (.attr (js/$ "#current-track") "src"))
+                (.load (.getElementById js/document "audio-tag"))
+                (.play (.getElementById js/document "audio-tag"))
+                (swap! app-state assoc :current-download-stream-id nil)
+                (swap! app-state assoc :current-file-download (new js/Blob))))))))))

 (.change (js/$ "#file_upload_input")
   (fn [e]


Add test data, generate layout

Add test data, generate layout

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -4,9 +4,21 @@
 ;; (defonce conn
 ;;   (repl/connect "http://localhost:9000/repl"))

+;; Debug
+
 (enable-console-print!)

+(defn p [message f & args]
+  (let [ret (apply f args)]
+    (println message (apply f args))
+    ret))
+
 (def d3 js/d3)
+
+;; Constants
+
+(def world-width 1280)
+(def world-height 800)

 ;; SVG setup

@@ -43,17 +55,70 @@
         (.attr "class" "node")
         (.attr "cx" #(:x %))
         (.attr "cy" #(:y %))
-        (.attr "r" 32))))
+        (.attr "r" 10))))

 ;; State management

-(defn initial-state [svg width height]
+(defn initial-state [svg width height nodes]
   {:svg svg
    :view-width width
    :view-height height
    :camera-x 0
    :camera-y 0
-   :nodes [{:x 40 :y 40}]})
+   :nodes nodes})
+
+;; Layout
+
+(defn get-force-layout []
+  (-> d3 .-layout .force
+      (.charge -240)
+      (.linkDistance 100)
+      (.size (array world-width world-height))))
+
+(defn do-layout! [data]
+  (let [n (-> data .-nodes .-length)
+        force-layout (get-force-layout)]
+    ; Initialize the positions deterministically, for better results
+    (-> data .-nodes
+        (.forEach (fn [d i]
+                    (let [val (* i (/ world-width n))]
+                      (aset d "x" val)
+                      (aset d "y" val)))))
+    (-> force-layout
+        (.nodes (.-nodes data))
+        (.links (.-links data))
+        .start)
+    (dotimes [_ n]
+      (.tick force-layout))
+    (.stop force-layout)
+    ; Center the nodes in the middle
+    (let [sum-x (->> data .-nodes js->clj (map #(% "x")) (apply +))
+          sum-y (->> data .-nodes js->clj (map #(% "y")) (apply +))
+          avg-x (/ sum-x n)
+          avg-y (/ sum-y n)]
+      (-> data .-nodes
+          (.forEach (fn [d]
+                      (aset d "x" (- (.-x d) avg-x))
+                      (aset d "y" (- (.-y d) avg-y))))))
+    data))
+
+;; JSON loading and parsing
+
+(defn node [title x y]
+  {:title title
+   :x x
+   :y y})
+
+(defn load-nodes [json-file callback]
+  (.json d3 json-file
+         (fn [data]
+           (do-layout! data)
+           (let [raw-nodes (p "raw-nodes:" js->clj (.-nodes data) :keywordize-keys true)
+                 nodes (p "nodes:" map (fn [raw-node]
+                              (node (:name raw-node)
+                                    (:x raw-node)
+                                    (:y raw-node))) raw-nodes)]
+             (callback nodes)))))

 ;; Exported function to do magic

@@ -61,6 +126,8 @@
   (let [element (-> d3 (.select selector) .node)
         width (.-clientWidth element)
         height (.-clientHeight element)
-        svg (setup-svg! selector width height)
-        state (initial-state svg width height)]
-    (setup-graph! state)))
+        svg (setup-svg! selector width height)]
+    (load-nodes "miserables.json"
+                (fn [nodes]
+                  (let [state (initial-state svg width height nodes)]
+                    (setup-graph! state))))))


a bit more on x+6 demo

a bit more on x+6 demo

--- src/demo/examples/x_plus_6.clj
+++ src/demo/examples/x_plus_6.clj
@@ -1,6 +1,8 @@
 (ns demo.examples.x-plus-6
   (:use midje.sweet)
   (:require [push.interpreter.templates.one-with-everything :as owe])
+  (:require [push.interpreter.core :as core])
+  (:require [push.util.stack-manipulation :as u])
   )

@@ -33,6 +35,7 @@
 ;;
 ;; Here I'll stick with "top `:float` at 3000 steps, if any", and immediately discard any program that gives no answer.
 ;;
+;;
 ;; ## Guessing
 ;;
 ;; Finally, there's the question we should ask next: What's a "guess"?
@@ -42,7 +45,7 @@
 ;; We'll want an input value, call it `:x`, but otherwise it's as simple as this:

-(def my-interpreter (owe/make-everything-interpreter :inputs {:x 12.3}))
+(def my-interpreter (owe/make-everything-interpreter :inputs {:x nil}))

 (fact "my-interpreter knows some things"
@@ -55,3 +58,116 @@

   (keys (:inputs my-interpreter)) => '(:x))

+
+;; That seems like it should more than suffice.
+;;
+;; A Push program is a vector of items: instruction keys, input keys, literal values and lists of those things. For example, both `[1 (false [4 3 1] :code-flush)]` and `[:x 6 "blueberry" :integer-add :integer->float]` are valid Push programs this interpreter would recognize and run. Any vector of these sorts of valid item, of any length, would be a valid "guess" for our algorithm to match the data. The first trick is arguably being able to pick random _valid_ programs that this interpreter will recognize and run.
+;;
+;; As the preceding tests imply, a new Push `Interpreter` instance already knows and can communicate a lot about the things it will do and recognize. Looking at those `midje` results, we know it already can deal with literal values of these types:
+;;
+;; - `:boolean`
+;; - `:booleans`
+;; - `:char`
+;; - `:chars`
+;; - `:integer`
+;; - `:integers`
+;; - `:float`
+;; - `:floats`
+;; - `:set`
+;; - `:string`
+;; - `:strings`
+;; - `:vector`
+;;
+;; We know it can also recognize a bunch of instructions:
+
+
+(fact "the number of instructions known ain't small"
+  (count (:instructions my-interpreter)) => 587) ;; as of this writing
+
+
+;; ... and what those are:
+
+
+(fact "my-interpreter can tell us the instructions it knows"
+  (sort (keys (:instructions my-interpreter))) =>
+    '(:boolean->code :boolean->float :boolean->integer :boolean->signedfloat :boolean->signedint :boolean->string :boolean-and :boolean-cutflip :boolean-cutstack :boolean-dup :boolean-empty? :boolean-equal? :boolean-flipstack :boolean-flush :boolean-not :boolean-notequal? :boolean-or :boolean-pop :boolean-print :boolean-return :boolean-return-pop :boolean-rotate :boolean-shove :boolean-stackdepth :boolean-swap :boolean-xor :boolean-yank :boolean-yankdup :booleans->code :booleans-butlast :booleans-concat :booleans-conj :booleans-contains? :booleans-cutflip :booleans-cutstack :booleans-do*each :booleans-dup :booleans-empty? :booleans-emptyitem? :booleans-equal? :booleans-first :booleans-flipstack :booleans-flush :booleans-fromexample :booleans-generalize :booleans-generalizeall :booleans-indexof :booleans-last :booleans-length :booleans-new :booleans-notequal? :booleans-nth :booleans-occurrencesof :booleans-pop :booleans-portion :booleans-print :booleans-remove :booleans-replace :booleans-replacefirst :booleans-rest :booleans-return :booleans-return-pop :booleans-reverse :booleans-rotate :booleans-set :booleans-shatter :booleans-shove :booleans-stackdepth :booleans-swap :booleans-take :booleans-yank :booleans-yankdup :char->code :char->float :char->integer :char->string :char-cutflip :char-cutstack :char-digit? :char-dup :char-empty? :char-equal? :char-flipstack :char-flush :char-letter? :char-lowercase? :char-max :char-min :char-notequal? :char-pop :char-print :char-return :char-return-pop :char-rotate :char-shove :char-stackdepth :char-swap :char-uppercase? :char-whitespace? :char-yank :char-yankdup :char<? :char>? :chars->code :chars-butlast :chars-concat :chars-conj :chars-contains? :chars-cutflip :chars-cutstack :chars-do*each :chars-dup :chars-empty? :chars-emptyitem? :chars-equal? :chars-first :chars-flipstack :chars-flush :chars-fromexample :chars-generalize :chars-generalizeall :chars-indexof :chars-last :chars-length :chars-new :chars-notequal? :chars-nth :chars-occurrencesof :chars-pop :chars-portion :chars-print :chars-remove :chars-replace :chars-replacefirst :chars-rest :chars-return :chars-return-pop :chars-reverse :chars-rotate :chars-set :chars-shatter :chars-shove :chars-stackdepth :chars-swap :chars-take :chars-yank :chars-yankdup :char≤? :char≥? :code->set :code->string :code-append :code-atom? :code-cons :code-container :code-contains? :code-cutflip :code-cutstack :code-do :code-do* :code-do*count :code-do*range :code-do*times :code-drop :code-dup :code-empty? :code-equal? :code-extract :code-first :code-flipstack :code-flush :code-if :code-insert :code-length :code-list :code-map :code-member? :code-noop :code-notequal? :code-nth :code-null? :code-points :code-pop :code-position :code-print :code-quote :code-reduce :code-rest :code-return :code-return-pop :code-rotate :code-shove :code-size :code-stackdepth :code-subst :code-swap :code-wrap :code-yank :code-yankdup :environment-begin :environment-empty? :environment-end :environment-new :environment-stackdepth :error-empty? :error-stackdepth :exec->string :exec-cutflip :exec-cutstack :exec-do*count :exec-do*range :exec-do*times :exec-do*while :exec-dup :exec-empty? :exec-equal? :exec-flipstack :exec-flush :exec-if :exec-k :exec-noop :exec-notequal? :exec-pop :exec-print :exec-return :exec-return-pop :exec-rotate :exec-s :exec-shove :exec-stackdepth :exec-string-iterate :exec-swap :exec-when :exec-while :exec-y :exec-yank :exec-yankdup :float->asciichar :float->boolean :float->char :float->code :float->integer :float->string :float-add :float-cosine :float-cutflip :float-cutstack :float-dec :float-divide :float-dup :float-empty? :float-equal? :float-flipstack :float-flush :float-inc :float-max :float-min :float-mod :float-multiply :float-notequal? :float-pop :float-print :float-return :float-return-pop :float-rotate :float-shove :float-sign :float-sine :float-stackdepth :float-subtract :float-swap :float-tangent :float-yank :float-yankdup :float<? :float>? :floats->code :floats-butlast :floats-concat :floats-conj :floats-contains? :floats-cutflip :floats-cutstack :floats-do*each :floats-dup :floats-empty? :floats-emptyitem? :floats-equal? :floats-first :floats-flipstack :floats-flush :floats-fromexample :floats-generalize :floats-generalizeall :floats-indexof :floats-last :floats-length :floats-new :floats-notequal? :floats-nth :floats-occurrencesof :floats-pop :floats-portion :floats-print :floats-remove :floats-replace :floats-replacefirst :floats-rest :floats-return :floats-return-pop :floats-reverse :floats-rotate :floats-set :floats-shatter :floats-shove :floats-stackdepth :floats-swap :floats-take :floats-yank :floats-yankdup :floatsign->boolean :float≤? :float≥? :integer->asciichar :integer->boolean :integer->char :integer->code :integer->float :integer->string :integer-add :integer-cutflip :integer-cutstack :integer-dec :integer-divide :integer-dup :integer-empty? :integer-equal? :integer-few :integer-flipstack :integer-flush :integer-inc :integer-lots :integer-many :integer-max :integer-min :integer-mod :integer-multiply :integer-notequal? :integer-pop :integer-print :integer-return :integer-return-pop :integer-rotate :integer-shove :integer-sign :integer-some :integer-stackdepth :integer-subtract :integer-swap :integer-yank :integer-yankdup :integer<? :integer>? :integers->code :integers-butlast :integers-concat :integers-conj :integers-contains? :integers-cutflip :integers-cutstack :integers-do*each :integers-dup :integers-empty? :integers-emptyitem? :integers-equal? :integers-first :integers-flipstack :integers-flush :integers-fromexample :integers-generalize :integers-generalizeall :integers-indexof :integers-last :integers-length :integers-new :integers-notequal? :integers-nth :integers-occurrencesof :integers-pop :integers-portion :integers-print :integers-remove :integers-replace :integers-replacefirst :integers-rest :integers-return :integers-return-pop :integers-reverse :integers-rotate :integers-set :integers-shatter :integers-shove :integers-stackdepth :integers-swap :integers-take :integers-yank :integers-yankdup :integer≤? :integer≥? :intsign->boolean :log-empty? :log-stackdepth :print-empty? :print-newline :print-space :print-stackdepth :push-counter :push-inputs :push-inputset :push-instructionset :set->code :set-cutflip :set-cutstack :set-difference :set-dup :set-empty? :set-equal? :set-flipstack :set-flush :set-intersection :set-notequal? :set-pop :set-print :set-return :set-return-pop :set-rotate :set-shove :set-stackdepth :set-subset? :set-superset? :set-swap :set-union :set-yank :set-yankdup :string->chars :string->code :string->float :string->integer :string-butlast :string-concat :string-conjchar :string-contains? :string-containschar? :string-cutflip :string-cutstack :string-dup :string-empty? :string-emptystring? :string-equal? :string-first :string-flipstack :string-flush :string-indexofchar :string-last :string-length :string-max :string-min :string-notequal? :string-nth :string-occurrencesofchar :string-pop :string-print :string-removechar :string-replace :string-replacechar :string-replacefirst :string-replacefirstchar :string-rest :string-return :string-return-pop :string-reverse :string-rotate :string-setchar :string-shatter :string-shove :string-solid? :string-spacey? :string-splitonspaces :string-stackdepth :string-substring :string-swap :string-take :string-yank :string-yankdup :string<? :string>? :strings->code :strings-butlast :strings-concat :strings-conj :strings-contains? :strings-cutflip :strings-cutstack :strings-do*each :strings-dup :strings-empty? :strings-emptyitem? :strings-equal? :strings-first :strings-flipstack :strings-flush :strings-fromexample :strings-generalize :strings-generalizeall :strings-indexof :strings-last :strings-length :strings-new :strings-notequal? :strings-nth :strings-occurrencesof :strings-pop :strings-portion :strings-print :strings-remove :strings-replace :strings-replacefirst :strings-rest :strings-return :strings-return-pop :strings-reverse :strings-rotate :strings-set :strings-shatter :strings-shove :strings-stackdepth :strings-swap :strings-take :strings-yank :strings-yankdup :string≤? :string≥? :vector->code :vector->set :vector-butlast :vector-concat :vector-conj :vector-contains? :vector-cutflip :vector-cutstack :vector-do*each :vector-dup :vector-empty? :vector-emptyitem? :vector-equal? :vector-first :vector-flipstack :vector-flush :vector-fromexample :vector-indexof :vector-last :vector-length :vector-new :vector-notequal? :vector-nth :vector-occurrencesof :vector-pop :vector-portion :vector-print :vector-refilter :vector-refilterall :vector-remove :vector-replace :vector-replacefirst :vector-rest :vector-return :vector-return-pop :vector-reverse :vector-rotate :vector-set :vector-shatter :vector-shove :vector-stackdepth :vector-swap :vector-take :vector-yank :vector-yankdup)
+    )
+
+(defn random-instruction
+  [interpreter]
+  (rand-nth (keys (:instructions interpreter))))
+
+
+(defn random-float
+  [scale]
+  (* scale (/ (rand-int scale) 32.0)))
+
+
+(defn random-integer
+  [scale]
+  (rand-int scale))
+
+
+(defn random-input
+  [interpreter]
+  (rand-nth (keys (:inputs interpreter))))
+
+
+(defn random-boolean
+  []
+  (< 0.5 (rand)))
+
+
+(declare random-push-item)
+
+(defn random-code
+  [interpreter length]
+  (into '() (repeatedly length #(random-push-item interpreter))))
+
+
+(defn random-push-item
+  [interpreter]
+  (let [diceroll (rand-int 20)]
+    (condp #(<= %1 %2) diceroll
+      15 (random-float 100)
+      13 (random-integer 100)
+      11 (random-boolean)
+      9 (random-input my-interpreter)
+      6 (random-code my-interpreter 5)
+      (random-instruction interpreter)
+      )))
+
+
+
+(defn random-push-program
+  [length]
+  (into [] (repeatedly length #(random-push-item my-interpreter))))
+
+
+(def sample-program (random-push-program 7))
+
+
+(fact
+  (let [dude (core/recycle-interpreter
+              my-interpreter (random-push-program 1000)
+              :inputs {:x 17})]
+    ; (println (:program dude))
+    (println
+      (sort
+        (reduce-kv
+          #(assoc %1 %2 (count %3))
+          {}
+          (:stacks (core/run dude 5000)))))
+    (println
+      (u/get-stack (core/run dude 5000) :return))
+    ))
+
+
+
+
+
+
+
+
+
+


api: debug logging

api: debug logging

--- src/io/cyanite/api.clj
+++ src/io/cyanite/api.clj
@@ -87,7 +87,8 @@

 (defmethod dispatch :paths
   [{{:keys [query]} :params index :index}]
-  (index/matches index (if (blank? query) "*" query) false))
+  (debug "path fetch request for:" (pr-str path))
+  (index/prefixes index (if (blank? query) "*" query)))

 (defmethod dispatch :query
   [{{:keys [from to query]} :params :keys [index store engine]}]
@@ -99,6 +100,7 @@

 (defmethod dispatch :metrics
   [{{:keys [from to path agg]} :params :keys [index store engine]}]
+  (debug "metric fetch request for:" (pr-str path))
   (let [from  (or (parse-time from)
                   (throw (ex-info "missing from parameter"
                                   {:suppress? true :status 400})))


nat wait

nat wait

--- src/kvm/networking.clj
+++ src/kvm/networking.clj
@@ -11,6 +11,7 @@

 (ns kvm.networking
   (:require
+    [celestial.provider :refer (wait-for)]
     [slingshot.slingshot :refer [throw+]]
     [taoensso.timbre :as timbre]
     [clojure.core.strint :refer (<<)]
@@ -33,10 +34,15 @@
    [c id node]
    (let [[nic mac] (first (macs c id)) uuid (gen-uuid)]
      (execute (<< "arp -i ~{nic}") node :out-fn (collect-log uuid))
-     (if-let [line (first (filter #(.contains % mac) (get-log uuid)))]
+     (when-let [line (first (filter #(.contains % mac) (get-log uuid)))]
        (first (.split line "\\s" ))
-       (throw+ {:type ::kvm:networking} "Failed to grab domain Nat IP")
        )))
+
+(defn wait-for-nat [c id node timeout]
+  "Waiting for nat cache to update"
+  (wait-for {:timeout timeout} #(not (nil? (nat-ip c id node)))
+    {:type ::kvm:networking :timeout timeout}
+      "Timed out on waiting for arp cache to update"))

 (def ignore-authenticity "-o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no")

@@ -46,6 +52,7 @@

 (defn public-ip
   [c user node id & {:keys [public-nic] :or {public-nic "eth1"}}]
+   (wait-for-nat c id node [5 :minute])
    (let [uuid (gen-uuid) nat (nat-ip c id node)
          cmd (<< "ssh ~{ignore-authenticity} ~{user}@~{nat} -C 'ifconfig ~{public-nic}'")]
      (execute cmd node :out-fn (collect-log uuid))


Add initial freshen command

Add initial freshen command

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -13,6 +13,16 @@

 (set! *warn-on-reflection* true)

+(defn git
+  [^File d & subcmd]
+  ;; We won't handle bare repos or displaced worktrees
+  (let [gitdir (.getPath d)
+        worktree (.getParent d)
+        rtn (apply sh "git" (str "--git-dir=" gitdir) (str "--work-tree=" worktree) subcmd)]
+    (when-not (zero? (:exit rtn))
+      (throw (ex-info "git error" rtn)))
+    rtn))
+
 ;; === git sha-based versions ===

 (def timestamp-fmt "yyyyMMdd_hhmmss")
@@ -24,10 +34,18 @@
            t))

 (defn get-voom-version
-  [path & [long-sha]]
-  (let [shafmt (if long-sha "%H" "%h")
+  [path & [long-sha?]]
+  (let [shafmt (if long-sha? "%H" "%h")
         fmt (str "--pretty=" shafmt ",%cd")
         {:keys [out exit err]} (sh "git" "log" "-1" fmt path)
+        ;; Throw exception if error?
+        [sha, datestr] (-> out s/trim (s/split #"," 2))
+        ctime (Date. ^String datestr)]
+    {:ctime ctime :sha sha}))
+
+(defn get-dir-voom-version
+  [dir path]
+  (let [{:keys [out exit err]} (git dir "log" "-1"  "--pretty=%h,%cd" "--" path)
         ;; Throw exception if error?
         [sha, datestr] (-> out s/trim (s/split #"," 2))
         ctime (Date. ^String datestr)]
@@ -73,13 +91,6 @@
     (dorun (map #(.setLevel ^Handler %1 %2) handlers old-levels))
     result))

-(defn git
-  [^File d & subcmd]
-  ;; We won't handle bare repos or displaced worktrees
-  (let [gitdir (.getPath d)
-        worktree (.getParent d)]
-    (apply sh "git" (str "--git-dir=" gitdir) (str "--work-tree=" worktree) subcmd)))
-
 (defn find-project-files
   [^File d]
   (let [{:keys [out err exit]} (git d "ls-files" "project.clj" "**/project.clj")
@@ -99,6 +110,9 @@
   (seq (for [d dirs
              :when (contains-sha? d sha)]
          d)))
+
+(defn all-repos-dirs []
+  (glob (str (s/replace repos-home #"/$" "") "/*/.git")))

 (defn fetch-all
   [dirs]
@@ -120,9 +134,7 @@
   [repos-dir pspec]
   (prn "find-matching-projects" repos-dir pspec)
   (let [{:keys [sha artifactId groupId]} pspec
-        dirglob (str (s/replace repos-dir #"/$" "") "/*/.git")
-        dirs (glob dirglob)
-        _ (prn "dirs" dirglob dirs)
+        dirs (all-repos-dirs)
         sha-candidates (locate-sha dirs sha)
         sha-candidates (or sha-candidates
                            (do (fetch-all dirs)
@@ -206,6 +218,84 @@
       (pprint {:exception-data (ex-data e)}))))

+;; === freshen ===
+
+(defn fetch-checkout-all
+  "This is slower than necessary for most real use cases."
+  [dirs]
+  (doseq [^File d dirs]
+    (println "Checking out latest:" (.getPath d))
+    (git d "fetch")
+    (git d "checkout" "origin/HEAD")))
+
+;; Add metadata pinning (how big to bump? all? minor? sha?) -- warn about not updating
+;; Opt-in autobump  -- default to no major auto
+(defn get-fresh-versions []
+  (let [dirs (all-repos-dirs)
+        _ (fetch-checkout-all dirs)]
+    (into {}
+          (for [dir dirs
+                prj-file (find-project-files dir)]
+            (let [{:keys [group name version] :as prj} (project/read prj-file)
+                  gver (get-dir-voom-version dir (:root prj))
+                  qual (format-voom-ver gver timestamp-fmt)
+                  new-ver (str (s/replace version #"-SNAPSHOT" "") qual)]
+              [(symbol group name) new-ver])))))
+
+(defn fresh-version [fresh-versions-map [prj ver :as dep]]
+  (if-let [new-ver (get fresh-versions-map prj)]
+    (assoc dep 1 new-ver)
+    (do
+      (when (ver-parse ver)
+        (println "Warning: didn't find or freshen voom-version dep" dep))
+      dep)))
+
+(defn rewrite-project-file [input-str replacement-map]
+  (reduce (fn [^String text [[prj old-ver :as old-dep] [_ new-ver]]]
+            (let [short-prj (if (= (name prj) (namespace prj))
+                              (name prj)
+                              (str prj))
+                  pattern (re-pattern (str "\\Q" short-prj "" "\\E(\\s+)\\Q\"" old-ver "\"\\E"))
+                  matches (re-seq pattern input-str)]
+              (when (empty? matches)
+                (throw (ex-info (str "No match found for " [prj old-ver])
+                                {:pattern pattern :dep old-dep})))
+              (when (second matches)
+                (throw (ex-info (str "More than one match found for " [prj old-ver])
+                                {:pattern pattern :dep old-dep})))
+              (s/replace text pattern (str short-prj "$1" \" new-ver \"))))
+          input-str
+          replacement-map))
+
+(defn freshen [project & args]
+  (let [prj-file-name (str (:root project) "/project.clj")
+        old-deps (:dependencies project)
+        fresh-versions-map (get-fresh-versions)
+        desired-new-deps (map #(fresh-version fresh-versions-map %) old-deps)]
+    (doseq [[[prj old-ver] [_ new-ver]] (map list old-deps desired-new-deps)]
+      (println (format "%-40s" prj)
+               (str old-ver
+                    (when (not= old-ver new-ver)
+                      (str " -> " new-ver)))))
+    (if (= old-deps desired-new-deps)
+      (println "All deps already up-to-date.")
+      (let [replacement-map (into {} (map #(when (not= %1 %2) [%1 %2])
+                                          old-deps desired-new-deps))
+            tmp-file (File/createTempFile
+                      ".project-" ".clj" (File. ^String (:root project)))]
+
+        (spit tmp-file
+              (rewrite-project-file (slurp prj-file-name) replacement-map))
+
+        (if (= desired-new-deps (:dependencies (project/read (str tmp-file))))
+          (.renameTo tmp-file (File. prj-file-name))
+          (throw (ex-info (str "Freshen mis-fire. See "
+                               tmp-file " for attempted change.")
+                          {:old-deps old-deps
+                           :replacement-map replacement-map
+                           :desired-new-deps desired-new-deps
+                           :tmp-file-name (str tmp-file)})))))))
+
 ;; === lein entrypoint ===

 (defn nope [& args]
@@ -215,7 +305,7 @@
 ;; lein commands?  Separate lein plugins?
 (def sub-commands
   {"build-deps" build-deps
-   "freshen" nope
+   "freshen" freshen
    "task-add" nope
    "new-task" nope})


Add *pwd* check and type hinting to 'find-box.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -624,12 +624,12 @@
       ^String (str "/" path)
       (File.))))

-(defn find-box
+(defn ^File find-box
   "Locates voom-box root starting from current working directory."
-  [& args]
-  (loop [path (File. (System/getProperty "user.dir"))]
-    (let [ppath (.getCanonicalPath path)
-          pfile (File. (str ppath "/.voom-box"))]
+  []
+  (loop [^File path (or *pwd* (-> "user.dir" System/getProperty File.))]
+    (let [^File ppath (.getCanonicalPath path)
+          ^File pfile (File. (str ppath "/.voom-box"))]
       (when-not (= "/" ppath)
         (if (.exists pfile)
           path


Global connection is now opened only if needed

--- src/lobos/config.clj
+++ src/lobos/config.clj
@@ -1,9 +1,26 @@
 (ns lobos.config
   (:use lobos.connectivity))
+
+
+;; http://pupeno.com/2011/08/20/how-to-use-lobos-with-heroku/
+(defn open-global-when-necessary
+  "Open a global connection only when necessary, that is, when no previous
+  connection exist or when db-spec is different to the current global
+  connection."
+  [db-spec]
+  ;; If the connection credentials has changed, close the connection.
+  (when (and (@lobos.connectivity/global-connections :default-connection)
+             (not= (:db-spec (@lobos.connectivity/global-connections :default-connection)) db-spec))
+    (lobos.connectivity/close-global))
+  ;; Open a new connection or return the existing one.
+  (if (nil? (@lobos.connectivity/global-connections :default-connection))
+    ((lobos.connectivity/open-global db-spec) :default-connection)
+    (@lobos.connectivity/global-connections :default-connection)))
+

 (def h2
   {:classname   "org.h2.Driver"
    :subprotocol "h2"
    :subname     "./resources/database"})

-(open-global h2)+(open-global-when-necessary h2)


:row-count -> :row_count and small fn simplification

--- src/metabase/pulse.clj
+++ src/metabase/pulse.clj
@@ -66,13 +66,14 @@
 (defn is-card-empty?
   "Check if the card is empty"
   [card]
-  (or (zero? (-> card :result :row-count))
-      (= [[nil]]
-         (-> card :result :data :rows))
-      (and (= [["count"]]
-              (-> card :card :dataset_query :query :aggregation))
-           (= [[0]]
-              (-> card :result :data :rows)))))
+  (let [result (:result card)]
+    (or (zero? (-> result :row_count))
+        (= [[nil]]
+           (-> result :data :rows))
+        (and (= [["count"]]
+                (-> card :card :dataset_query :query :aggregation))
+             (= [[0]]
+                (-> result :data :rows))))))

 (defn are-all-cards-empty?
   "Do none of the cards have any results?"


Fix the path to the language information in a DTBook XML

--- src/mdr2/dtbook/validation.clj
+++ src/mdr2/dtbook/validation.clj
@@ -28,8 +28,8 @@
    :identifier [(get-metadata-path "dc:Identifier")
                 (get-metadata-path "dtb:uid")]
    :source [(get-metadata-path "dc:Source")]
-   :language [[:dtbook :head :meta (attr= :name "dc:Language") (attr :content)]
-              [:dtbook (attr= :name "xml:lang")]]
+   :language [[:head :meta (attr= :name "dc:Language") (attr :content)]
+              [(attr :xml:lang)]]
    :rights [(get-metadata-path "dc:Rights")]
    :source_date [(get-metadata-path "dtb:sourceDate")]
    :source_edition [(get-metadata-path "dtb:sourceEdition")]


passing search into vertex query handler

--- src/ophion/aleph.clj
+++ src/ophion/aleph.clj
@@ -88,9 +88,9 @@
     (#'find-vertex-handler graph request)))

 (defn vertex-query
-  [graph]
+  [graph search]
   (fn [request]
-    (#'vertex-query-handler graph request)))
+    (#'vertex-query-handler graph search request)))

 (defn find-edge
   [graph]


use a set instead of a vector.

use a set instead of a vector.

--- src/metabase/db/migrations.clj
+++ src/metabase/db/migrations.clj
@@ -214,7 +214,7 @@
                 ;; this check gaurds against any table that appears in the schema multiple times
                 (if (contains? @processed-tables {:schema table-schema, :name table-name})
                   ;; this is a dupe of this table, retire it and it's fields
-                  (table/retire-tables [table-id])
+                  (table/retire-tables #{table-id})
                   ;; this is the first time we are encountering this table, so migrate it
                   (do
                     ;; add this table to the set of tables we've processed


marked some unused params with underscores

--- src/midje/ideas/background.clj
+++ src/midje/ideas/background.clj
@@ -41,7 +41,7 @@
     "Code to run before a given wrapping target (:facts, :contents, :checks).
   Can take an optional keyword argument :after, for any code to run afterward.
   Used with background and against-background"
-    [wrapping-target before-form & {:keys [after]}]
+    [_wrapping-target_ before-form & {:keys [after]}]
     (ensure-correct-form-variable `(try
                                      ~before-form
                                      ?form
@@ -50,7 +50,7 @@
   (defmacro after
     "Code to run after a given wrapping target (:facts, :contents, :checks).
   Used with background and against-background"
-    [wrapping-target after-form]
+    [_wrapping-target_ after-form]
     (ensure-correct-form-variable `(try ?form (finally ~after-form))))

   (defmacro around
@@ -63,7 +63,7 @@
                       (print a)))

   Used with background and against-background"
-    [wrapping-target around-form]
+    [_wrapping-target_ around-form]
     (ensure-correct-form-variable around-form)))

 (defn seq-headed-by-setup-teardown-form? [forms]
@@ -92,7 +92,7 @@
       (recur (conj expanded (first in-progress))
              (rest in-progress)))))

-(defn- ^{:testable true } state-wrapper [[_before-after-or-around_ wrapping-target & _  :as state-description]]
+(defn- ^{:testable true } state-wrapper [[_before-after-or-around_ wrapping-target & _ :as state-description]]
   (with-wrapping-target
     (macroexpand-1 (map-first #(symbol "midje.ideas.background" (name %)) state-description))
     wrapping-target))


minor

minor

--- src/prais2/data.cljs
+++ src/prais2/data.cljs
@@ -68,17 +68,6 @@
   [slider value]
   (* value (bar-scale slider))
   )
-
-(r/defc bar < r/static [slider value fill]
-  [:div {:style {:padding 0
-                 :margin 0
-                 :vertical-align "middle"
-                 :display "inline-table"
-                 :background-color fill
-                 :height "22px"
-                 :width (str (bar-width slider value) "%")}
-         }])
-

 (def colour-map-options
@@ -117,6 +106,16 @@

 (def colour-map (:brewer-YlGnBu colour-map-options))

+
+(r/defc bar < r/static [slider value fill]
+  [:div {:style {:vertical-align "middle"
+                 :display "inline-table"
+                 :background-color fill
+                 :margin-top "5px"
+                 :height "25px"
+                 :width (str (bar-width slider value) "%")}
+         }])
+
 (r/defc bar-chart < r/static [row]
   (let [slider 0.9]
     [:div
@@ -168,6 +167,9 @@
           {:key :axis
            :style {:padding 0
                    :margin 0
+                   :width "100%"
+                   :height "100%"
+                   :border "none"
                    :white-space "nowrap"
                    :display "inline-block"
                    :vertical-align "top"
@@ -178,7 +180,7 @@
                 }
         (for [row rows]
           [:tr {:key (:h-code row)
-                :style {:width "600px"}}
+                }
            (for [column-key column-keys :when (-> headers column-key :shown)]
              [:td {:key [column-key "r"]}
               (column-key row)])
@@ -188,10 +190,14 @@
                      :padding 0
                      :margin 0
                      :width "100%"
-                     :position "static"
+                     :height "100%"
+                     :border-left "none"
+                     :border-right "none"
+                     :border-bottom "none"
+                     :border-top "1px solid #dddddd"
+                     :position "relative"
                      :white-space "nowrap"
                      :display "inline-block"
-                     :vertical-align "middle"
-                     :background-color "white"}}
+                     :background-color "#EDF8B1"}}
             (bar-chart row)]])]]]])
   )


Add shutdown recur back in.

Add shutdown recur back in.

--- src/onyx/peer/virtual_peer.clj
+++ src/onyx/peer/virtual_peer.clj
@@ -16,6 +16,7 @@

         (cond (nil? v) (extensions/delete sync (:node pulse))
               (= ch complete-ch) (recur nil)
+              (= ch shutdown-ch) (recur nil)
               (= ch payload-ch)
               (let [payload-node (:path v)
                     payload (extensions/read-node sync payload-node)


Improve title component

Improve title component

--- src/re_com/core.cljs
+++ src/re_com/core.cljs
@@ -348,17 +348,20 @@

 (def title-args
   #{:label        ;; Text of the title
+    :style
+    :h           ;;  something like :h3 or :h4
     :underline?   ;; Boolean determines whether an underline is placed under the title
     })

-
 (defn title
-  "An underlined, left justified, H3 Title"
-  [& {:keys [label underline?]
-      :or   {underline? true}
+  "An underlined, left justified, Title. By default :h3"
+  [& {:keys [label h underline? style]
+      :or   {underline? true h :h3}
       :as   args}]
   {:pre [(superset? title-args (keys args))]}

   [v-box
-   :children [[:h3 label]
+   :children [[h {:style (merge  {:display "flex" :flex "none"}
+                           style)}
+               label]
               (when underline? [line :size "1px"])]])


Fix a bug when screen goes black on game over.

--- src/tetris/core.cljs
+++ src/tetris/core.cljs
@@ -365,7 +365,7 @@
   [{t :tetrimino
     rows :rows}]
   (draw-background screen-ctx "#2a2f34")
-  (draw-blocks screen-ctx rendering-offset (tetrimino->blocks t))
+  (when t (draw-blocks screen-ctx rendering-offset (tetrimino->blocks t)))
   (draw-blocks screen-ctx rendering-offset (rows->blocks rows)))

 (defn render-bar?


Minor fixes and new usefull functions for schema impl.

--- src/uxbox/schema.clj
+++ src/uxbox/schema.clj
@@ -2,8 +2,7 @@
   (:refer-clojure :exclude [keyword uuid vector boolean])
   (:require [bouncer.core :as b]
             [bouncer.validators :as v]
-            [cuerdas.core :as str]
-            [uxbox.shapes :refer (shape?)]))
+            [cuerdas.core :as str]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Validators
@@ -14,7 +13,7 @@
   For use with validation functions such as `validate` or `valid?`"
   {:default-message-format "%s must be a keyword"}
   [v]
-  (cljs.core/keyword? v))
+  (keyword? v))

 (v/defvalidator uuid
   "Validates maybe-an-int is a valid integer.
@@ -39,6 +38,7 @@
 (def number v/number)
 (def integer v/integer)
 (def boolean v/boolean)
+(def string v/string)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Public Api
@@ -65,3 +65,13 @@
             message (str/format message data)]
         (throw (ex-info message {}))))))

+(defn extract
+  [schema data]
+  (let [keycoll (keys schema)]
+    (select-keys data keycoll)))
+
+(defn extract!
+  "Extract and validate."
+  [schema data]
+  (validate! schema data)
+  (extract schema data))


Add test that facts can't be queried after removal

--- test/com/puppetlabs/cmdb/test/query/facts.clj
+++ test/com/puppetlabs/cmdb/test/query/facts.clj
@@ -19,4 +19,7 @@
     (testing "with facts present for a node"
        (is (= (facts/facts-for-node certname) facts)))
     (testing "without facts present for a node"
-       (is (= (facts/facts-for-node "imaginary_node") {})))))
+       (is (= (facts/facts-for-node "imaginary_node") {})))
+    (testing "after deleting facts for a node"
+      (scf-store/delete-facts! certname)
+      (is (= (facts/facts-for-node certname) {})))))


move mouse-y rate to the correct place :-)

--- src/overtone/sc/ugen/input.clj
+++ src/overtone/sc/ugen/input.clj
@@ -20,10 +20,9 @@
               {:name "warp",
                :default :linear
                :map {:linear 0 :exponential 1 :lin 0 :exp 1}
-               :rates #{:kr}
                :doc "mapping curve - either :linear or :exponential (:lin and :exp abbreviations are allowed)"}
               {:name "lag", :default 0.2 :doc "lag factor to smooth out cursor movement."}]
-
+       :rates #{:kr}
        :doc "maps the current mouse Y coordinate to a value between min and max"}

       {:name "MouseButton",


Use @samaaron's cycle-n.

Use @samaaron's cycle-n.

--- src/overtunes/songs/before.clj
+++ src/overtunes/songs/before.clj
@@ -70,10 +70,14 @@
       (at (metro start) (play-note (first melody) organ-cornet duration))
       (play-melody (rest melody) metro (+ start beats-per-note)))))

-(defn n-times [n items] (flatten (repeat n items)))
+(defn cycle-n
+  "Returns a new seq which is cycled n times
+  (cycle-n 2 [1 2 3]) ;=> [1 2 3 1 2 3]"
+  [n s]
+  (take (* (count s) n) (cycle s)))

 (defn play [chords metro]
-  (let [ melody-line (n-times (/ (count chords) 2.5) melody)]
+  (let [ melody-line (cycle-n (/ (count chords) 2.5) melody)]
   (do
     (play-melody melody-line metro (metro))
     (play-progression (concat chords finish) metro (metro)))))


Gracefully ignore unavailable MIDI devices.

--- src/afterglow/midi.clj
+++ src/afterglow/midi.clj
@@ -9,7 +9,7 @@
   (:import [java.io InputStream]
            [java.util.concurrent LinkedBlockingDeque]
            [java.util.regex Pattern]
-           [javax.sound.midi MidiDevice MidiDevice$Info]))
+           [javax.sound.midi MidiDevice MidiDevice$Info MidiUnavailableException]))

 (def ^:private max-clock-intervals
   "How many MIDI clock pulses and interval averages should be kept
@@ -49,11 +49,11 @@
   midi-outputs (atom {}))

 (defonce ^{:private true
-          :doc "Functions to be called when a new device appears in
-          the MIDI environment. They will be passed a single argument,
-          the `:midi-device` map from `overtone.midi` representing the
-          new device."}
-  new-device-handlers (atom #{}))
+           :doc "Functions to be called when a new device appears in
+  the MIDI environment. They will be passed a single argument, the
+  `:midi-device` map from `overtone.midi` representing the new
+  device."} new-device-handlers
+  (atom #{}))

 ;; Originally I was using the `:device`, which worked fine with CoreMIDI4J, but turned out
 ;; to be a different object every time the standard MIDI SPI was asked to enumerate devices.
@@ -90,7 +90,7 @@
   (swap! new-device-handlers disj f))

 (defonce ^{:private true
-          :doc "Functions to be called when a device disappears from
+           :doc "Functions to be called when a device disappears from
   the MIDI environment. Keys are the `javax.sound.midi.MidiDevice`
   whose departure is of interest, and values are a set of functions to
   be called if and when that device ceases to exist. They will be
@@ -309,23 +309,23 @@
   * Otherwise, the filter accepts all ports."
   (delay
    (cond
-    (and (mac?) (cm4j-installed?))
-    cm4j-device?  ;; Only use devices provided by CoreMIDI4J if it is installed.
-
-    (and (mac?) (mmj-installed?))
-    (fn [device]
-      (let [mmj-descriptions (set (map :description (filter mmj-device? (overtone.midi/midi-sources))))]
-        (or (mmj-device? device)
-            ;; MMJ returns devices whose descriptions match the names of the
-            ;; broken devices returned by the broken Java MIDI implementation.
-            ;; But it does not wrap all devices, e.g. the Traktor Virtual Output,
-            ;; so we need to only screen out devices which are supported.
-            ;; MMJ support is only left in place to support Java 6 environments,
-            ;; in particular Max/MSP, where CoreMIDI4J is not available.
-            (not (mmj-descriptions (:name device))))))
-
-    :else
-    identity)))
+     (and (mac?) (cm4j-installed?))
+     cm4j-device?  ;; Only use devices provided by CoreMIDI4J if it is installed.
+
+     (and (mac?) (mmj-installed?))
+     (fn [device]
+       (let [mmj-descriptions (set (map :description (filter mmj-device? (overtone.midi/midi-sources))))]
+         (or (mmj-device? device)
+             ;; MMJ returns devices whose descriptions match the names of the
+             ;; broken devices returned by the broken Java MIDI implementation.
+             ;; But it does not wrap all devices, e.g. the Traktor Virtual Output,
+             ;; so we need to only screen out devices which are supported.
+             ;; MMJ support is only left in place to support Java 6 environments,
+             ;; in particular Max/MSP, where CoreMIDI4J is not available.
+             (not (mmj-descriptions (:name device))))))
+
+     :else
+     identity)))

 (defn- incoming-message-handler
   "Attached to all midi input devices we manage. Puts the message on a
@@ -383,6 +383,7 @@
           (let [connected (connect-midi-in input)]
             (doseq [handler @new-device-handlers]
               (handler connected)))
+          (catch MidiUnavailableException e)  ; If we can't have it, give up gracefully
           (catch Throwable t
             (timbre/error t "Unable to connect MIDI input" input))))))
   (vals @midi-inputs))
@@ -402,6 +403,7 @@
           (let [connected (connect-midi-out output)]
                (doseq [handler @new-device-handlers]
                  (handler connected)))
+          (catch MidiUnavailableException e)  ; If we can't have it, give up gracefully
           (catch Throwable t
             (timbre/error t "Unable to connect MIDI output" output))))))
   (vals @midi-outputs))


Add stub for test for next-gen nesting implementation.

--- test/dsbdp/test/data_processing_dsl_tests.clj
+++ test/dsbdp/test/data_processing_dsl_tests.clj
@@ -445,3 +445,41 @@
     (is (map? result))
     (is (= expected result))))

+(deftest nested-udp-and-tcp-byte-array-packet-test-1
+  (let [expected-udp {"len" 58,
+                      "data" {"dst" "FF:FE:FD:F2:F1:F0",
+                              "data" {"proto-id" 17
+                                      "src" "1.2.3.4",
+                                      "data" {"src" 2048
+                                              "dst" 4096}}}}
+        expected-tcp {"len" 58,
+                      "data" {"dst" "FF:FE:FD:F2:F1:F0",
+                              "data" {"proto-id" 6
+                                      "src" "127.0.0.1",
+                                      "data" {"src" 55522
+                                              "dst" 61481
+                                              "flags" 0x18
+                                              "seq-no" 4109031044
+                                              "ack-no" 3662655102}}}}
+        dsl-expression {:output-type :clj-map
+                        :rules [['len '(int32be 8)]
+                                ['data [['dst '(eth-mac-addr-str 16)]
+                                        ['data [['proto-id '(int8 39)]
+                                                ['src '(ipv4-addr-str 42)]
+                                                ['data '(nested
+                                                          '(= 17 __2_proto-id) [['src '(int16 50)]
+                                                                                ['dst '(int16 52)]]
+                                                          '(= 6 __2_proto-id) [['src '(int16 50)]
+                                                                               ['dst '(int16 52)]
+                                                                               ['flags '(int8 63)]
+                                                                               ['seq-no '(int32 54)]
+                                                                               ['ack-no '(int32 58)]]
+                                                          :default (str "Unsupported protocol: " __2_proto-id))]]]]]]}
+        data-processing-fn (create-proc-fn dsl-expression)
+        result-udp (data-processing-fn pcap-byte-array-test-data)
+        result-tcp (data-processing-fn pcap-tcp-byte-array-test-data)]
+    (is (map? result-udp))
+    (is (= expected-udp result-udp))
+    (is (map? result-tcp))
+    (is (= expected-tcp result-tcp))))
+


Functions to return common JS and CSS files to the client

--- src/arachnida/server.clj
+++ src/arachnida/server.clj
@@ -323,17 +323,51 @@
         (-> (html-renderer/render-product-page product-name repositories)
             continue-processing)))

+(defn update-file-name
+    [file-name]
+    (if (.startsWith file-name "/")
+        (subs file-name 1)
+        file-name))
+
+(defn return-file
+    [file-name content-type]
+    (let [file (new java.io.File "www" (update-file-name file-name))]
+        (println "Returning file " (.getAbsolutePath file))
+        (if (.exists file)
+            (-> (http-response/response file)
+                (http-response/content-type content-type))
+            (println "return-file(): can not access file: " (.getName file)))))
+
+(defn return-icon
+    [uri]
+    (return-file uri "image/x-icon"))
+
+(defn return-css
+    [uri]
+    (return-file uri "text/css"))
+
+(defn return-javascript
+    [uri]
+    (return-file uri "application/javascript"))
+
 (defn handler
     "Handler that is called by Ring for all requests received from user(s)."
     [request]
     (println "request URI: " (request :uri))
     (let [uri (request :uri)]
         (condp = uri
-            "/"            (perform-index-page request)
-            "/author"      (perform-author-page request)
-            "/product"     (perform-product-page request)
-            "/favicon.ico" nil
-        )))
+            "/"                                 (perform-index-page request)
+            "/author"                           (perform-author-page request)
+            "/product"                          (perform-product-page request)
+            "/favicon.ico"                      (return-icon uri)
+            "/bootstrap.min.css"                (return-css uri)
+            "/arachnida.css"                    (return-css uri)
+            "/bootstrap.min.js"                 (return-javascript uri)
+            "/flotr/lib/prototype-1.6.0.2.js"   (return-javascript uri)
+            "/flotr/lib/canvas2image.js"        (return-javascript uri)
+            "/flotr/lib/canvastext.js"          (return-javascript uri)
+            "/flotr/flotr-0.2.0-alpha.js"       (return-javascript uri)
+            "/flotr/flotr.debug-0.2.0-alpha.js" (return-javascript uri))))

 (def app
     (-> handler


new variable name convention

new variable name convention

--- src/engine/core.clj
+++ src/engine/core.clj
@@ -5,26 +5,27 @@
         [ring.middleware.session :only (wrap-session)]
         [net.cgrand.moustache :only (app)]
         [compojure.core :only (routes)]
-        [compojure.route :as route]
-        [compojure.handler :as handler]
         [hiccup.page-helpers :only (html5)]
-        [cssgen :only (css rule)]
-        [engine.middleware.log-request :as log-request]
-        [engine.server.socket-io :as socket-io])
-  (:require [engine server]))
+        [cssgen :only (css rule)])
+  (:require [engine server]
+            [engine.data.buffer :as buffer]
+            [compojure.route :as route]
+            [compojure.handler :as handler]
+            [engine.middleware.log-request :as log-request]
+            [engine.server.socket-io :as socket-io]))

-(defonce *dispatch-table*
+(defonce dispatch-table
   (agent {} :validator #(and (map? %1)
                              (and (every? string? (keys %1))
                                   (every? fn? (vals %1))))
          :error-mode :continue))

 (defn server-dispatch [request]
-  (when-let [handler (@*dispatch-table* (:uri request))]
+  (when-let [handler (@dispatch-table (:uri request))]
     (handler request)))

 (defn defdispatcher [uri handler]
-  (send *dispatch-table* #(assoc %1 uri handler)))
+  (send dispatch-table #(assoc %1 uri handler)))

 (defn index [request]
   {:status 200
@@ -38,20 +39,25 @@
                  [:style {:type "text/css" :media "screen"}
                   (css (rule "body" :overflow "none")
                        (rule "#editor" :margin 0 :position "absolute" :top 0 :bottom 0 :left 0 :right 0))]
-                 [:script {:data-main "client/main" :src "client/require.js"}]]
+                 #_[:script {:src "/client/goog/base.js"}]
+                 [:script {:data-main "client/main" :src "client/require.js"}]
+                 #_[:script {:data-main "client/client" :src "client/require.js"}]
+                 #_[:script {:src "client/client.js"}]]
                 [:body [:pre {:id "editor"}]])
    :session (:session request)})

 (def dispatcher
   (app
-;   (log-request/log)
+   (log-request/log)
    (wrap-stacktrace)
    (wrap-session {:cookie-name "engine"})
    (socket-io/socket.io-handler engine.server/server)
-   ["client" "ace" &] (handler/site (route/resources "/" {:root "support/ace/build/src"}))
-   ["client" "pilot" &] (handler/site (route/resources "/" {:root "support/ace/lib/pilot"}))
-   ["client" "socket.io" &] (handler/site (route/resources "/" {:root "support/socket.io-client/dist"}))
-   ["client" &] (handler/site (route/resources "/" {:root "client"}))
+   ["client" "ace" &] (app
+                       ["theme" &] (route/resources "/" {:root "support/ace/build/src"})
+                       [&] (route/resources "/" {:root "support/ace/lib/ace"}))
+   ["client" "pilot" &] (route/resources "/" {:root "support/ace/lib/pilot"})
+   ["client" "socket.io" &] (route/resources "/" {:root "support/socket.io-client/dist"})
+   ["client" &] (route/resources "/" {:root "client"})
    [""] index
    [&] (routes server-dispatch (route/not-found "Not found"))))


Fix fleet state page so it shows total

Fix fleet state page so it shows total

--- src-cljs/frontend/components/admin.cljs
+++ src-cljs/frontend/components/admin.cljs
@@ -112,7 +112,8 @@
                                    :cell-fn (comp datetime/long-datetime :boot_time)}

                                   {:header "Busy Containers"
-                                   :cell-fn :busy}
+                                   :cell-fn (fn [m]
+                                              (str (:busy m) " / " (:total m)))}

                                   {:header "State"
                                    :cell-fn :state}]})))]))))


improve copy on trial and features pages

--- src-cljs/frontend/components/outer.cljs
+++ src-cljs/frontend/components/outer.cljs
@@ -73,7 +73,7 @@
           [:div.content
            [:div.outer-form-info
             [:h1.outer-form-heading
-             "What is the name of your team? "
+             "What should we call your team? "
              "Grab your domain to get started. "]
             (if (utils/logged-in? owner)
               [:p.outer-form-copy
@@ -299,7 +299,7 @@
           [:div.team-features
             [:div.features-head.content
              [:h1.content-heading
-              "Team domains make real-time collaboration even simpler. "]
+              "Team domains make real-time collaboration more productive. "]
              [:p.content-copy
               "Precursor prototyping is free. "
               "But we're a "


Fix headers parsing.

Fix headers parsing.

--- src/postal/parser.cljc
+++ src/postal/parser.cljc
@@ -118,7 +118,6 @@
                    (assoc frame :headers (assoc (:headers frame)
                                                 (keyword (str/lower (read-header-key reader)))
                                                 (read-header-value reader))))))
-
       (= parsing :body)
       (do
         (reader/read-char reader)
@@ -128,8 +127,8 @@

       (= parsing :complete)
       (frames/frame (:command frame)
-                    (:headers frame)
-                    (:body frame))
+                    (:headers frame {})
+                    (:body frame ""))

       (= chr-in ::continue)
       (recur (reader/read-char reader)


fixed a channel error caused by bad session-id declaration (it was not atomic)

--- src/prais2/logger.cljs
+++ src/prais2/logger.cljs
@@ -11,7 +11,7 @@
 ;;;
 ;; The session id is ideally unique for this user
 ;;;
-(defonce session-id nil)
+(defonce session-id (atom nil))

 ;;;
 ;; We need to serialise/deserialise the log and also convert it to CSV
@@ -130,12 +130,14 @@
    (let [log-entry [new-session-id (js/Date.) event-key event-data @core/app]]
      (prn log-entry)
      (write-sheet-log log-entry)
+     (reset! session-id new-session-id)
      (swap! log-state #(conj % log-entry))
      (swap! log-state-index #(if (nil? %) 0 (inc %)))
      ))

-  ([[event-key event-data]]
-   (write-log [event-key event-data] @session-id)))
+  ([event-key-data]
+   (prn "one parameter log " event-key-data)
+   (write-log event-key-data @session-id)))

 (def log-sheet-url "https://docs.google.com/spreadsheets/d/1bLxk8unegtsoBr9TysVDVA0jECmr5D4a3WQvyT69iuE")


Fixed little bug in handle-next-sibling.

--- evermind.web/src/evermind/web/core.cljs
+++ evermind.web/src/evermind/web/core.cljs
@@ -148,7 +148,7 @@
                      (select-node m m)
                      (if (not (nil? next-sibling))
                        (select-node m next-sibling)
-                       (m)))))))
+                       m))))))

 (defn previous-sibling
   [parent of]


REPL input history (up/down keys in REPL)

--- src/brevis/ui/core.clj
+++ src/brevis/ui/core.clj
@@ -98,13 +98,15 @@
 (defn a-paste [e] (.paste (get-editor)))

 (def repl-output (atom []))
+(def repl-input (atom []))
+(def repl-input-index (atom 0));; 0 is most recent, then go backwards, this is used with (- (count @repl-input) index)

 (defn update-repl-output
   "Update the REPL output window."
   []
-  (println "count repl-output" (count @repl-output))
-  (doseq [line @repl-output]
-    (println line))
+  #_(println "count repl-output" (count @repl-output))
+  #_(doseq [line @repl-output]
+     (println line))
   (text! (:text-area @repl-output-window)
          (with-out-str
            (doseq [line @repl-output]
@@ -113,7 +115,7 @@
 (defn write-stdout-repl
   "Write a stdout message for to the REPL output."
   [s]
-  (swap! repl-output conj s)
+  (swap! repl-output conj s);; probably should limit history
   (update-repl-output))

 (def write-value-repl write-stdout-repl)
@@ -123,6 +125,7 @@
   "Evaluate something, print all outputs, and print the final returned value."
   [thing echo?]
   (when echo?
+    (swap! repl-input conj thing);; probably should limit history
     (write-form-repl (str "> " thing)))
   (let [response-vals (nrepl/message (:client @repl) {:op "eval" :code thing})]
     (doseq [resp response-vals]
@@ -262,6 +265,24 @@
       (.addKeyListener textArea
         (proxy [java.awt.event.KeyAdapter] []
           (keyPressed [#^java.awt.event.KeyEvent e]
+            (when (= (.getKeyCode e) java.awt.event.KeyEvent/VK_UP)
+              (try
+                (let [startPosition 0]
+                  (.remove (.getDocument textArea) startPosition (- (.getLength (.getDocument textArea)) startPosition 1))
+                  (.setText textArea (nth @repl-input (- (dec (count @repl-input)) @repl-input-index)))
+                  (reset! repl-input-index (min (inc @repl-input-index) (dec (count @repl-input))))
+                  #_(.setText textArea (last @repl-input)))
+                (catch Exception e (println (.getMessage e))))
+              (.consume e))
+            (when (= (.getKeyCode e) java.awt.event.KeyEvent/VK_DOWN)
+              (try
+                (let [startPosition 0]
+                  (.remove (.getDocument textArea) startPosition (- (.getLength (.getDocument textArea)) startPosition 1))
+                  (.setText textArea (nth @repl-input (- (dec (count @repl-input)) @repl-input-index)))
+                  (reset! repl-input-index (max (dec @repl-input-index) 0))
+                  #_(.setText textArea (last @repl-input)))
+                (catch Exception e (println (.getMessage e))))
+              (.consume e))
             (when (= (.getKeyCode e) java.awt.event.KeyEvent/VK_ENTER)
               (.append textArea "\n")
               ;; This shouldn't be here:
@@ -271,6 +292,7 @@
                       line (.getText textArea startPosition (- (.getLength (.getDocument textArea)) startPosition 1))
                       ;response-vals (nrepl/message (:client @repl) {:op "eval" :code line})
                       #_session-sender #_(nrepl/client-session @reply.eval-modes.nrepl/current-connection :session @reply.eval-modes.nrepl/current-session)]
+                  (reset! repl-input-index 0)
                   (.setText textArea "")
                   (eval-and-print line true)
                   ;; Add to a console history


Minor refactoring.

Minor refactoring.

--- umm-spec-lib/src/cmr/umm_spec/json_schema.clj
+++ umm-spec-lib/src/cmr/umm_spec/json_schema.clj
@@ -198,15 +198,15 @@
                    "date-time" (when x (dtp/parse-datetime x))
                    (str x))

-       "number"  (if (number? x)
-                   x
-                   (when (and (string? x) (seq x))
-                     (Double. x)))
-
-       "integer" (if (integer? x)
-                   x
-                   (when (and (string? x) (seq x))
-                     (Long. x)))
+       "number"  (cond (number? x) x
+                       (string? x) (when-not (str/blank? x)
+                                     (Double. x))
+                       :else (throw (Exception. (str "Unexpected type for number: " (pr-str x)))))
+
+       "integer" (cond (integer? x) x
+                       (string? x) (when-not (str/blank? x)
+                                     (Long. x))
+                       :else (throw (Exception. (str "Unexpected type for integer: " (pr-str x)))))

        "boolean" (= "true" x)


update ring-async to 0.2.3

update ring-async to 0.2.3

--- example/server/project.clj
+++ example/server/project.clj
@@ -2,7 +2,7 @@
   :description "Example Server-Sent Events server using eventual."
   :dependencies [[org.clojure/clojure "1.5.1"]
                  [com.ninjudd/ring "1.2.2"]
-                 [com.ninjudd/ring-async "0.2.3-SNAPSHOT"]
+                 [com.ninjudd/ring-async "0.2.3"]
                  [com.ninjudd/eventual "0.1.1-SNAPSHOT"]
                  [org.clojure/core.async "0.1.267.0-0d7780-alpha"]
                  [compojure "1.1.5"]


When target is :nodejs, default :optimizations to :simple

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -627,7 +627,10 @@
 (defn build
   "Given a source which can be compiled, produce runnable JavaScript."
   [source opts]
-  (let [compiled (-compile source opts)
+  (let [opts (if (= :nodejs (:target opts))
+               (merge {:optimizations :simple} opts)
+               opts)
+        compiled (-compile source opts)
         js-sources (if (coll? compiled)
                      (apply add-dependencies opts compiled)
                      (add-dependencies opts compiled))