Simplify iterators and reduce number of method calls

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -152,7 +152,7 @@
 (deftype Tree [max-keys key-len ^:mutable root]
   Object
   (toString [this]
-            (pr-str (into {} (map vec (iterator->elems (iterator this))))))
+            (pr-str (into {} (map vec this))))
   (assoc! [this key val]
           (.assoc! root key val max-keys))
   (dissoc! [this key]
@@ -176,9 +176,13 @@
                   (when (seq nodes)
                     (apply println (map #(.pretty-print %) nodes))
                     (recur (mapcat #(.-children %) nodes)))))
+  (foreach [this f]
+           (.foreach root f))
   ISeqable
   (-seq [this]
-        (seq (iterator->elems (iterator this)))))
+        (let [results #js []]
+          (.foreach this #(apush results #js [%1 %2]))
+          (seq results))))

 (deftype Node [parent parent-ix keys vals children ^:mutable lower ^:mutable upper]
   Object
@@ -354,7 +358,14 @@
                 (assert (every? #(key-lt (aget keys %) (.-lower (aget children (inc %)))) (range (count keys))))
                 (dotimes [i (count children)] (.valid! (aget children i) max-keys))))))
   (pretty-print [this]
-                (str "(" parent-ix ")" "|" (pr-str lower) " " (pr-str (vec keys)) " " (pr-str upper) "|")))
+                (str "(" parent-ix ")" "|" (pr-str lower) " " (pr-str (vec keys)) " " (pr-str upper) "|"))
+  (foreach [this f]
+           (dotimes [i (alength keys)]
+             (when (not (nil? children))
+               (.foreach (aget children i) f))
+             (f (aget keys i) (aget vals i)))
+           (when (not (nil? children))
+             (.foreach (aget children (alength keys)) f))))

 (defn tree [min-keys key-len]
   (let [node (Node. nil nil #js [] #js [] nil nil nil)
@@ -370,45 +381,14 @@
 ;; On seek, point to first key greater than or equal to seek-key, or otherwise the last key
 ;; NOTE iterators are not write-safe unless reset after writing

-(deftype Iterator [tree ^:mutable node ^:mutable ix ^:mutable end? key-len]
+(deftype Iterator [tree ^:mutable node ^:mutable ix]
   Object
   (reset [this]
          (set! node (.-root tree))
-         (set! ix 0)
          (while (not (nil? (.-children node)))
            (set! node (aget (.-children node) 0)))
+         (set! ix 0)
          (set! end? (<= (alength (.-keys node)) 0)))
-  (key [this]
-       (aget (.-keys node) ix))
-  (val [this]
-       (aget (.-vals node) ix))
-  (next [this]
-        (when (false? end?)
-          (if (nil? (.-children node))
-            (let [old-node node
-                  old-ix ix]
-              (set! ix (+ ix 1))
-              (loop []
-                (if (>= ix (alength (.-keys node)))
-                  (if (instance? Node (.-parent node))
-                    (do
-                      (set! ix (.-parent-ix node))
-                      (set! node (.-parent node))
-                      (recur))
-                    (do
-                      (set! node old-node)
-                      (set! ix old-ix)
-                      (set! end? true)))
-                  nil)))
-            (do
-              (set! node (aget (.-children node) (+ ix 1)))
-              (set! ix 0)
-              (loop []
-                (if (nil? (.-children node))
-                  nil
-                  (do
-                    (set! node (aget (.-children node) 0))
-                    (recur))))))))
   (seek [this key]
         (let [start-node node
               start-ix ix]
@@ -421,214 +401,59 @@
                 (set! node (.-parent node))
                 (recur))
               (loop []
-                (.-keys node)
-                key
                 (set! ix (key-find (.-keys node) key))
-                (if (>= ix (alength (.-keys node)))
-                  (if (nil? (.-children node))
-                    (do
-                      (set! ix (- ix 1)) ;; point to last key
-                      (set! end? true))
-                    (do
-                      (set! node (aget (.-children node) ix))
-                      (set! ix 0)
-                      (recur)))
-                  (if (or (nil? (.-children node))
-                          (key= key (aget (.-keys node) ix))
-                          (key-lt (.-upper (aget (.-children node) ix)) key))
-                    (set! end? false)
+                (if (nil? (.-children node))
+                  (if (< ix (alength (.-keys node)))
+                    (aget (.-keys node) ix)
+                    nil)
+                  (if (key-lt (.-upper (aget (.-children node) ix)) key)
+                    (aget (.-keys node) ix)
                     (do
                       (set! node (aget (.-children node) ix))
                       (set! ix 0)
                       (recur))))))))))

 (defn iterator [tree]
-  (let [iterator (Iterator. tree (.-root tree) 0 false (.-key-len tree))]
+  (let [iterator (Iterator. tree (.-root tree) 0)]
     (.reset iterator)
     iterator))

-;; used only inside Join
-(deftype JoinIterator [iterator inner->outer inner-key outer-key key-len ^:mutable blocked?]
+;; CONSTRAINTS
+
+;; los and his are inclusive
+;; propagate may assume that los and his are within its current bounds
+
+(def unchanged 0)
+(def changed 1)
+(def failed 2)
+
+(deftype Contains [iterator seek-key ^:mutable lower upper ixes pushed|split pushed-nodes pushed-ixes split-keys]
   Object
-  (maintain [this]
-            (if (.-end? iterator)
-              (set! blocked? true)
-              (let [new-key (.key iterator)]
-                (set! blocked? false)
-                (dotimes [inner-ix (alength inner->outer)]
-                  (aset outer-key (aget inner->outer inner-ix) (aget new-key inner-ix))))))
-  (reset [this]
-         (.reset iterator)
-         (dotimes [i (alength outer-key)]
-           (aset outer-key i least))
-         (.maintain this))
-  (key [this]
-       outer-key)
-  (next [this]
-        (.next iterator)
-        (.maintain this))
-  (seek [this key]
-        (dotimes [inner-ix (alength inner-key)]
-          (aset inner-key inner-ix (aget key (aget inner->outer inner-ix))))
-        (.seek iterator inner-key)
-        (dotimes [outer-ix (alength outer-key)]
-          (aset outer-key outer-ix (aget key outer-ix)))
-        (.maintain this)))
-
-(defn join-iterator [iterator var->present?]
-  (let [inner->outer (make-array (.-key-len iterator))
-        inner-var 0]
-    (dotimes [outer-var (alength var->present?)]
-      (when (true? (aget var->present? outer-var))
-        (aset inner->outer inner-var outer-var)
-        (set!! inner-var (+ inner-var 1))))
-    (let [itr (JoinIterator. iterator inner->outer (make-array (.-key-len iterator)) (make-array (alength var->present?)) num-vars false)]
-      (.maintain itr)
-      itr)))
-
-(deftype Join [iterators keys ^:mutable end?]
-  Object
-  (maintain [this]
-            (loop [i -1]
-              (cond
-
-               ;; see if we need to do anything
-               (== i -1)
-               (let [min-key (.key (aget iterators 0))
-                     max-key (.key (aget iterators (- (alength iterators) 1)))]
-                 (if (key= min-key max-key)
-                   (if (true? (.-blocked? (aget iterators (- (alength iterators) 1))))
-                     (do
-                       (set! end? true)
-                       (debug :end/found))
-                     (debug :found min-key))
-                   (recur 0)))
-
-               ;; find the minimum non-blocked iter and seek it
-               (< i (- (alength iterators) 1))
-               (let [iterator (aget iterators i)]
-                 (if (false? (.-blocked? iterator))
-                   (do
-                     (debug :seeking i (map #(.key %) iterators) (map #(.key (.-iterator %)) iterators))
-                     (.splice iterators i 1)
-                     (.seek iterator (.key (aget iterators (- (alength iterators) 1))))
-                     (dotimes [i (alength iterators)]
-                       (aset keys i (.key (aget iterators i))))
-                     (.splice iterators (key-find keys (.key iterator)) 0 iterator)
-                     (recur -1))
-                   (recur (+ i 1))))
-
-               ;; otherwise see if we can bump the max iterator along
-               (== i (- (alength iterators) 1))
-               (let [max-iterator (aget iterators (- (alength iterators) 1))]
-                 (if (false? (.-blocked? max))
-                   (do
-                     (.next max-iterator)
-                     (debug :bump-max max-key)
-                     (recur 0))
-                   (do
-                     (set! end? true)
-                     (debug :end))))
-
-               )))
-  (reset [this]
-         (debug)
-         (debug :reset)
-         (dotimes [i (alength iterators)]
-           (.reset (aget iterators i)))
-         (js/goog.array.sort iterators (fn [i0 i1] (key-compare (.key i0) (.key i1))))
-         (set! end? false)
-         (.maintain this))
-  (key [this]
-       (.key (aget iterators 0)))
-  (next [this]
-        (debug :next)
-        (when (false? end?)
-          (let [max-iterator (aget iterators (- (alength iterators) 1))]
-            (assert (false? (.-blocked? max-iterator)))
-            (.next max-iterator)
-            (.maintain this))))
-  (seek [this key]
-        (debug :seek)
-        (when (false? end?)
-          (let [max-iterator (aget iterators (- (alength iterators) 1))]
-            (assert (false? (.-blocked? max-iterator)))
-            (.seek max-iterator key)
-            (.maintain this)))))
-
-(defn join [iterators num-vars iterator->var->present?]
-  (let [join-iterators (amake [i (alength iterators)]
-                              (join-iterator (aget iterators i) (aget iterator->var->present? i)))
-        keys (make-array (- (alength iterators) 1))
-        join (Join. join-iterators keys false)]
-    (.reset join)
-    join))
-
-(deftype FunctionIterator [f num-args ^:mutable saved-key ^:mutable end? ^:mutable old-saved-key ^:mutable old-end? pushed-saved-keys pushed-end?s]
-  Object
-  (reset [this]
-         (set! saved-key (least-key (+ num-args 1)))
-         (set! end? true)
-         (set! old-saved-key saved-key)
-         (set! old-end? end?)
-         (aclear pushed-saved-keys)
-         (aclear pushed-end?s))
-  (key [this]
-       (when (false? end?)
-         saved-key))
-  (next [this]
-        (assert false ".next on FunctionIterator"))
-  (seek [this key]
-        (if (not (== least (aget key (- num-args 1)))) ;; ie all input vars are defined
-          (let [old-result (aget key num-args)
-                new-result (.apply f nil key)]
-            (assert (val? new-result) (pr-str new-result))
-            (if (val-lte old-result new-result)
-              (do
-                (set! old-saved-key saved-key)
-                (set! old-end? end?)
-                (set! saved-key (aclone key))
-                (aset saved-key num-args new-result)
-                (set! end? false)
-                (== old-result new-result))
-              (do
-                (set! end? true)
-                false)))
-          (do
-            (set! end? true)
-            false)))
-  (undo [this]
-        (set! saved-key old-saved-key)
-        (set! end? old-end?))
+  (propagate [this los his]
+             (dotimes [i (alength ixes)]
+               (aset seek-key i (aget los (aget ixes i)))
+               (aset upper i (aget his (aget ixes i))))
+             (when (key-lt lower seek-key)
+               (.seek iterator seek-key)
+               (if (true? (.-end? iterator))
+                 failed
+                 (let [key (.key iterator)]
+                   (if (key-lt upper lower)
+                     failed
+                     (let [changed? false]
+                       (set! lower (.key iterator))
+                       (dotimes [i (alength ixes)]
+                         (let [ix (aget ixes i)
+                               new-lo (aget lower i)]
+                           (when (val-lt (aget los ix) new-lo)
+                             (aset los ix new-lo)
+                             (set!! changed? true))))
+                       (if (true? changed?)
+                         changed
+                         unchanged)))))))
   (push [this]
-        (apush pushed-saved-keys saved-key)
-        (apush pushed-end?s end?))
-  (pop [this]
-       (set! saved-key (.pop pushed-saved-keys))
-       (set! end? (.pop pushed-end?s))))
-
-(defn function-iterator [f num-args]
-  (FunctionIterator. f num-args (least-key (+ num-args 1)) true (least-key (+ num-args 1)) true #js [] #js []))
-
-(defn iterator->keys
-  ([iterator]
-   (iterator->keys js/Infinity iterator))
-  ([n iterator]
-   (let [results #js []]
-     (while (and (false? (.-end? iterator)) (< (alength results) n))
-       (.push results (aclone (.key iterator)))
-       (.next iterator))
-     results)))
-
-(defn iterator->elems
-  ([iterator]
-   (iterator->elems js/Infinity iterator))
-  ([n iterator]
-   (let [results #js []]
-     (while (and (false? (.-end? iterator)) (< (alength results) n))
-       (.push results #js [(.key iterator) (.val iterator)])
-       (.next iterator))
-     results)))
+        (apush pushed-nodes (.-node iterator))
+        (apush pushed-ixes (.-ix iterator))))

 ;; TESTS

@@ -763,34 +588,17 @@
                  action (gen key-len)]
                 (run-lookup-prop min-keys key-len actions action)))

-(defn gen-next [key-len]
-  (gen/make-gen
-   (fn [rnd size]
-     [[:next] nil])))
-
 (defn gen-seek [key-len]
   (gen/make-gen
    (fn [rnd size]
      (let [key (make-simple-key rnd size key-len)]
        [[:seek key] nil]))))

-(defn gen-movement [key-len]
-  (gen/make-gen
-   (fn [rnd size]
-     (let [key (make-simple-key rnd size key-len)]
-       (if (pprng/boolean rnd)
-         [[:next] nil]
-         [[:seek key] nil])))))
-
 (defn apply-to-iterator [iterator movements]
   (for [movement movements]
     (case (nth movement 0)
-      :next (do
-              (.next iterator)
-              (.key iterator))
-      :seek (do
-              (.seek iterator (nth movement 1))
-              (.key iterator)))))
+      :next (.next iterator)
+      :seek (.seek iterator (nth movement 1)))))

 (defn apply-to-elems [elems movements]
   (let [cur-elems (atom elems)]
@@ -798,10 +606,10 @@
       (case (nth movement 0)
         :next (do
                 (swap! cur-elems rest)
-                (or (first (first @cur-elems)) (first (last elems))))
+                (first (first @cur-elems)))
         :seek (do
                 (reset! cur-elems (drop-while #(key-lt (nth % 0) (nth movement 1)) elems))
-                (or (first (first @cur-elems)) (first (last elems))))))))
+                (first (first @cur-elems)))))))

 (defn run-iterator-prop [min-keys key-len actions movements]
   (let [tree (apply-to-tree (tree min-keys key-len) actions)
@@ -814,7 +622,7 @@
 (defn iterator-prop [key-len]
   (prop/for-all [min-keys gen/s-pos-int
                  actions (gen/vector (gen-action key-len))
-                 movements (gen/vector (gen-movement key-len))]
+                 movements (gen/vector (gen-seek key-len))]
                 (run-iterator-prop min-keys key-len actions movements)))

 (defn run-self-join-prop [min-keys key-len actions movements]
@@ -832,7 +640,7 @@
 (defn self-join-prop [key-len]
   (prop/for-all [min-keys gen/s-pos-int
                  actions (gen/vector (gen-action key-len))
-                 movements (gen/vector (gen-movement key-len))]
+                 movements (gen/vector (gen-seek key-len))]
                 (run-self-join-prop min-keys key-len actions movements)))

 (defn run-product-join-prop [min-keys key-len actions movements]
@@ -857,7 +665,7 @@
 (defn product-join-prop [key-len]
   (prop/for-all [min-keys gen/s-pos-int
                  actions (gen/vector (gen-action key-len))
-                 movements (gen/vector (gen-movement key-len))]
+                 movements (gen/vector (gen-seek key-len))]
                 (run-product-join-prop min-keys key-len actions movements)))

 (comment
@@ -911,7 +719,7 @@
   (time (dotimes [_ 10] (h)))

   (do
-    (def samples (gen/sample (gen/tuple gen/s-pos-int (gen/vector gen-action) (gen/vector gen-movement)) 100))
+    (def samples (gen/sample (gen/tuple gen/s-pos-int (gen/vector gen-action) (gen/vector gen-seek)) 100))
     (def trees (for [[min-keys actions _] samples]
                  (apply-to-tree (tree min-keys) actions)))
     (def benches (mapv vector trees (map #(nth % 2) samples)))


add karma-slimer to doo tests

add karma-slimer to doo tests

--- library/test/clj/test/doo/core.clj
+++ library/test/clj/test/doo/core.clj
@@ -47,7 +47,8 @@
          :spidermonkey :browser :browsers :v8 :d8 :something-else)
     (are [js-env] (doo/valid-js-env? js-env)
       :rhino :nashorn :slimer :phantom :node
-      :chrome :safari :firefox :opera :ie :karma-phantom))
+      :chrome :safari :firefox :opera :ie
+      :karma-phantom :karma-slimer))
   (testing "We can resolve aliases"
     (are [alias js-envs] (= (doo/resolve-alias alias {}) js-envs)
          :phantom [:phantom]
@@ -108,14 +109,17 @@
                          :main 'example.runner
                          :optimizations :none}
           srcs (cljs/inputs "../example/src" "../example/test")]
-      (doseq [[opts envs] [[{} [:phantom :chrome :firefox :karma-phantom]]
+      (doseq [[opts envs] [[{} [:phantom :slimer :chrome :firefox
+                                :karma-phantom :karma-slimer]]
                            [{:target :nodejs} [:node]]
-                           [{:optimizations :whitespace} [:rhino :nashorn :phantom
-                                                          :chrome :firefox :karma-phantom]]
+                           [{:optimizations :whitespace} [:rhino :nashorn :phantom :slimer
+                                                          :chrome :firefox
+                                                          :karma-phantom :karma-slimer]]
                            [{:optimizations :simple :target :nodejs} [:node]]
                            [{:optimizations :advanced :target :nodejs} [:node]]
-                           [{:optimizations :advanced} [:phantom :rhino :nashorn
-                                                        :chrome :firefox :karma-phantom]]]]
+                           [{:optimizations :advanced} [:phantom :slimer :rhino :nashorn
+                                                        :chrome :firefox
+                                                        :karma-phantom :karma-slimer]]]]
         (let [compiler-opts' (merge compiler-opts opts)]
           (cljs/build srcs compiler-opts')
           (doseq [env envs]


Don't append data/ to user provided path

--- src/buildviz/main.clj
+++ src/buildviz/main.clj
@@ -6,12 +6,9 @@
             [clojure.java.io :as io]
             [clojure.string :as str]))

-(defn- path-for [file-name]
-  (if-let [data-dir (System/getenv "BUILDVIZ_DATA_DIR")]
-    (.getPath (io/file data-dir file-name))
-    file-name))
-
-(def data-dir (path-for "data"))
+(def data-dir (if-let [data-dir (System/getenv "BUILDVIZ_DATA_DIR")]
+                data-dir
+                "data"))

 (defn- persist-build! [build-results job-name build-id]


Simplify the escaping

Simplify the escaping

--- src/catalog/latex.clj
+++ src/catalog/latex.clj
@@ -58,29 +58,20 @@
   List](http://www.ctan.org/tex-archive/info/symbols/comprehensive/symbols-a4.pdf))"
   [text]
   (if (nil? text) ""
-      (->
+      (reduce
+       (fn [txt [regexp replacement]]
+         (string/replace txt regexp replacement))
        text
-       ;; backslash
-       (string/replace #"\\" "\\\\textbackslash ")
-       ;; drop excessive white space
-       (string/replace #"\s+" " ")
-       ;; quote special chars
-       (string/replace #"(\$|&|%|#|_|\{|\})" "\\\\$1")
-       ;; append a '{}' to special chars so they are not missinterpreted
-       (string/replace #"(~|\^)" "$1{}")
-       ;; add non-breaking space in front of emdash or endash followed by
-       ;; punctuation
-       (string/replace #" ([–—]\p{P})" " $1")
-       ;; add non-breaking space in front ellipsis followed by punctuation
-       (string/replace #" ((\.{3}|…)\p{P})" " $1")
-       ;; [ and ] can sometimes be interpreted as the start or the end of
-       ;; an optional argument
-       (string/replace #"\[" "\\\\lbrack{}")
-       (string/replace #"\]" "\\\\rbrack{}")
-       ;; << and >> is apparently treated as a shorthand and is not
-       ;; handled by our shorthand disabling code
-       (string/replace #"<<" "{<}<")
-       (string/replace #">>" "{>}>"))))
+       [[#"\\" "\\\\textbackslash "] ; backslash
+        [#"\s+" " "] ; drop excessive white space
+        [#"(\$|&|%|#|_|\{|\})" "\\\\$1"] ; quote special chars
+        [#"(~|\^)" "$1{}"] ; append a '{}' to special chars so they are not missinterpreted
+        [#" ([–—]\p{P})" " $1"] ; add non-breaking space in front of emdash or endash followed by punctuation
+        [#" ((\.{3}|…)\p{P})" " $1"] ; add non-breaking space in front ellipsis followed by punctuation
+        [#"\[" "\\\\lbrack{}"] ; [ and ] can sometimes be interpreted as the start or the end of an optional argument
+        [#"\]" "\\\\rbrack{}"]
+        [#"<<" "{<}<"] ; << and >> is apparently treated as a shorthand and is not handled by our shorthand disabling code
+        [#">>" "{>}>"]])))

 (defn preamble [{:keys [title font creator] :or {font "Verdana"}}]
   (let [[title creator] (map escape [title creator])]


Don't need cvt-top-level-forms.

Don't need cvt-top-level-forms.

--- src/cbfg/zgo/core.clj
+++ src/cbfg/zgo/core.clj
@@ -11,7 +11,7 @@
   (re-seq (re-pattern (str ".{0," width "}\\s")) (str s " ")))

 (defn ljust [width s] ; Left justify a string.
-  (format (str "%-" width "s:") s))
+  (format (str "%-" width "s") s))

 (defn read-model-file [fname]
     {:fname fname
@@ -151,17 +151,13 @@
 (defn cvt-defn [name params body]
   ["func" (cvt-sym name) (rest (cvt-fn params body))])

-(defn cvt-top-level-form [smodel form]
+(defn cvt-top-level-form [form]
   (let [[op name & more] form]
     [(case (str op)
       "ns" (j ["package" (cvt-sym name)])
       "defn" (j (cvt-defn name (first more) (rest more)))
       "UNKNOWN-TOP-LEVEL-FORM")
      (line-range form)]))
-
-(defn cvt-top-level-forms [smodel]
-  (map #(cvt-top-level-form smodel %)
-       (:forms smodel)))

 (defn numbered-lines [lines beg end] ; beg and end are 1-based.
   (map vector
@@ -175,7 +171,7 @@
           [i sline] (first slines)]
       (when (or oline sline)
         (do (println (ljust OUT-WIDTH (string/replace (or oline "") "\n" ""))
-                     (when sline (str "// " i " " sline)))
+                     (if sline (str "// " i " " sline) ""))
             (recur (rest olines) (rest slines)))))))

 (defn emit [slines pmodel-in]
@@ -196,6 +192,6 @@

 (defn -main []
   (let [smodel (read-model-file "src/cbfg/fence.cljs")
-        pmodel (cvt-top-level-forms smodel)]
+        pmodel (map cvt-top-level-form (:forms smodel))]
     (emit (:lines smodel) pmodel)))


fix bad cljs.analyzer/analyze calls in cljs.repl

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -386,7 +386,7 @@
     (evaluate-form repl-env env filename form wrap *repl-opts*))
   ([repl-env env filename form wrap opts]
    (binding [ana/*cljs-file* filename]
-     (let [ast (ana/analyze env form opts)
+     (let [ast (ana/analyze env form nil opts)
            js (comp/emit-str ast)
            wrap-js
            ;; TODO: check opts as well - David
@@ -398,7 +398,7 @@
                (let [js (comp/emit-str
                           (ana/no-warn
                             (ana/analyze (assoc env :repl-env repl-env)
-                              (wrap form) opts)))
+                              (wrap form) nil opts)))
                      t (System/currentTimeMillis)]
                  (str js
                    "\n//# sourceURL=repl-" t ".js"
@@ -418,7 +418,7 @@
              (comp/emit-str
                (ana/no-warn
                  (ana/analyze (assoc env :repl-env repl-env)
-                   (wrap form) opts))))]
+                   (wrap form) nil opts))))]
        (when (= (:op ast) :ns)
          (load-dependencies repl-env
            (into (vals (:requires ast))


Reaching out 1.1K subscribers, ego boost

--- src/clj/hsm/views.clj
+++ src/clj/hsm/views.clj
@@ -49,7 +49,7 @@
   [:div.bs-callout.bs-callout-success ;{:style "background-color:#f7f7f7;" }

     [:a.btn.btn-success {:href "#mc_embed_signup" :data-toggle :modal} "Subscribe Free"]
-    [:p {:style "margin-top:10px"} "Join " [:b 1028] " others. No spamming." [:br][:b "I promise!"]]
+    [:p {:style "margin-top:10px"} "Join " [:b 1100] " others. No spamming." [:br][:b "I promise!"]]
     [:p "We are currently under high development. "[:a {:href "https://github.com/bcambel/hackersome?utm_source=left_menu_link"} "Follow us at github."]]
     [:hr]
     [:p "Looking for " [:b[:span.red "Python Tutorials? "]] [:br] [:a {:href "/tutorial/?utm_source=left_menu_link"}  "Check these awesome tutorials"]]


Add seed function for transitioning from SQLite DB to event logs.

--- src/clojars/event.clj
+++ src/clojars/event.clj
@@ -1,6 +1,8 @@
 (ns clojars.event
   (:refer-clojure :exclude [load])
   (:require [clojure.java.io :as io]
+            [clojure.java.jdbc :as sql]
+            [clojure.set :as set]
             [clojars.config :refer [config]]
             [clojars.search :as search]
             [clucy.core :as clucy])
@@ -51,6 +53,21 @@
     (swap! users #(reduce add-user-membership %
                           (map read-string (line-seq r))))))

-(defn load []
+(defn load
+  "Load users and memberships from event logs."
+  []
   (load-users (event-log-file :user))
-  (load-memberships (event-log-file :membership)))+  (load-memberships (event-log-file :membership)))
+
+(defn seed
+  "Seed event log with initial values from SQLite DB"
+  []
+  (sql/with-connection (config :db)
+    (sql/with-query-results groups ["SELECT * FROM groups"]
+      (doseq [{:keys [name user]} groups]
+        (record :membership {:group name :username user :added-by nil})))
+    (sql/with-query-results users ["SELECT * FROM users"]
+      (doseq [{:keys [user password email created ssh_key pgp_key]} users]
+        (record :user {:username user :email email :password password
+                       :ssh-key ssh_key :pgp-key pgp_key
+                       :at created :from "sqlite"})))))


added model pruning info

added model pruning info

--- src/crawler/model.clj
+++ src/crawler/model.clj
@@ -4,6 +4,7 @@
   (:require [clojure.java.io :as io]
             [crawler.dom :as dom]
             [structural-similarity.xpath-text :as similarity])
+  (:use [clojure.pprint :only [pprint]])
   (:import [java.io PushbackReader]))

 (defn read-model
@@ -215,3 +216,14 @@

     {:action-seq (into {} pruned)
      :pagination (into {} paging)}))
+
+(defn plan-dump-model
+  [a-model-file a-corpus-file]
+  (let [fixed-model (planned-model a-model-file
+                                   a-corpus-file)
+
+        filename    (first
+                     (clojure.string/split a-model-file #"\."))
+
+        wrtr (io/writer (str filename ".pruned-model"))]
+    (pprint fixed-model wrtr)))


Remove hardcoded http protocol in url construction

--- src/docker/client.clj
+++ src/docker/client.clj
@@ -81,7 +81,6 @@
   (to-url [this path]
     (-> host
         (url version path)
-        (assoc :protocol "http")
         str))
   (to-ws-url [this path]
     (to-ws-url this path {}))


Comment.

Comment.

--- src/clojush/problems/software/repeating_decimals.clj
+++ src/clojush/problems/software/repeating_decimals.clj
@@ -74,6 +74,18 @@
                    (conj decimals (int (/ curr-numerator n)))
                    (conj seen-numerators curr-numerator)
                    (conj corresponding-decimals decimals)))))
+
+
+(comment
+
+  (str 1 2 [1 2])
+
+  (+ 2 (* 3 2))
+
+  (sort [1 9 3 2 0 92])
+
+
+  )

 (find-repeating-decimal 773)


remove info.cukes/cucumber-core dep.; fix #946

--- examples/clojure_cukes/project.clj
+++ examples/clojure_cukes/project.clj
@@ -5,6 +5,5 @@
   :cucumber-feature-paths ["test/features/"]
   :profiles
   {:dev
-   {:dependencies [[lein-cucumber "1.0.2"]
-                   [info.cukes/cucumber-core "1.2.4"]]}}
+   {:dependencies [[lein-cucumber "1.0.2"]]}}
 )


Make client timeout configurable

Make client timeout configurable

--- src/etaoin/client.clj
+++ src/etaoin/client.clj
@@ -9,12 +9,19 @@
 ;; defaults
 ;;

-(def timeout
+(def default-timeout
   "HTTP timeout in seconds. The current value may seems to high,
   but according to my experience with SPA application full of React
   modules even 20 seconds could not be enough for a driver to process
   your request."
   60)
+
+(defn read-timeout []
+  (if-let [t (System/getenv "ETAOIN_TIMEOUT")]
+    (Integer/parseInt t)
+    default-timeout))
+
+(def timeout (read-timeout))

 (def default-api-params
   {:as :json


refine entity api

refine entity api

--- src/clj/clj_money/api/entities.clj
+++ src/clj/clj_money/api/entities.clj
@@ -15,12 +15,16 @@

 (defn update
   [{{id :id} :params}]
-  (let [entity (authorize :update (entities/find-by-id (env :db) id))]
+  (let [entity (authorize (entities/find-by-id (env :db) id) :update)]
     (try
-      (entities/update (env :db) entity)
-      (-> []
-          response
-          (status 204))
+      (let [result (entities/update (env :db) entity)]
+        (if (validation/has-error? result)
+          (-> (validation/error-messages result)
+              response
+              ))
+        (-> []
+            response
+            (status 204)))
       (catch Exception e
         (->  (if (env :show-error-messages?)
                (.getMessage e)
@@ -31,7 +35,7 @@

 (defn delete
   [{{id :id} :params}]
-  (let [entity (authorize :delete (entities/find-by-id (env :db) id))]
+  (let [entity (authorize (entities/find-by-id (env :db) id) :delete)]
     (try
     (entities/delete (env :db) (:id entity))
     (catch Exception e


possible lazy seq

possible lazy seq

--- src/clj/morpheus/traversal/bfs.clj
+++ src/clj/morpheus/traversal/bfs.clj
@@ -43,10 +43,10 @@
                 (when vertex-vailed
                   (let [neighbours (apply edges/neighbours-edges vertex (if filters (mapcat identity filters) []))
                         vertex-res (if with-vertices? vertex (select-keys vertex [:*id*]))
-                        edges-res (map (fn [edge]
-                                         (assoc (if with-edges? edge {})
-                                           :*opp* (eb/get-oppisite edge vertex-id)))
-                                       neighbours)]
+                        edges-res (doall (map (fn [edge]
+                                                (assoc (if with-edges? edge {})
+                                                  :*opp* (eb/get-oppisite edge vertex-id)))
+                                              neighbours))]
                     [vertex-res edges-res]))))
             (filter identity)
             (doall))]


Parse extra plugin translations

Parse extra plugin translations

--- src/clj/salava/core/translator.clj
+++ src/clj/salava/core/translator.clj
@@ -21,6 +21,9 @@

 ;;;
+
+(defn dict-kw [plugin]
+ (keyword (clojure.string/replace (plugin-str plugin) #"/" "-")))

 (defn prop-read [filename]
@@ -74,14 +77,14 @@
 (defn props-to-dict []
   (log/info "reading .properties files")
   (reduce (fn [coll [lang plugin]]
-            (assoc-in coll [lang plugin] (load-prop-file lang plugin))) {} lang-pairs))
+            (assoc-in coll [lang (dict-kw plugin)] (load-prop-file lang plugin))) {} lang-pairs))

 (defn dict-to-props [dict]
   (log/info "writing .properties files")
   (doseq [[lang plugin] lang-pairs]
-    (when (keys (get-in dict [lang plugin]))
-      (save-prop-file lang plugin (get-in dict [lang plugin])))))
+    (when (keys (get-in dict [lang (dict-kw plugin)]))
+      (save-prop-file lang plugin (get-in dict [lang (dict-kw plugin)])))))

 (defn combine-dicts [source target]
@@ -93,8 +96,8 @@
 (defn add-default-vals [dict]
   (log/info "merging new keys from default language")
   (reduce (fn [coll [lang plugin]]
-            (assoc-in coll [lang plugin]
-                      (combine-dicts (get-in coll [default-lang plugin]) (get-in coll [lang plugin]))))
+            (let [p (dict-kw plugin)]
+              (assoc-in coll [lang p] (combine-dicts (get-in coll [default-lang p]) (get-in coll [lang p])))))
           dict lang-pairs))

 (defn touch-i18n [_]


dataview no error

dataview no error

--- src/cljs/hatti/views/dataview.cljs
+++ src/cljs/hatti/views/dataview.cljs
@@ -93,7 +93,8 @@
       (let [active-view (-> app-state :views :selected)
             view->display #(if (= active-view %) "block" "none")
             view->cls #(when (= active-view %) "clicked")
-            dataviews (map dataview-map (-> app-state :views :all))
+            dataviews (->> (-> app-state :views :all)
+                           (map dataview-map) (remove nil?))
             dv->link (fn [{:keys [view label]}]
                        (if (and (= view :map) no-geodata?)
                          [:a {:class "inactive" :title "No geodata"}


Move to a much more robust way of specifying what area of the complex plane is being rendered in the state. This also means that you are guaranteed to see the bit you zoomed in on, even if you resize the window

--- src/cljs/mandelbrot_cljs/core.cljs
+++ src/cljs/mandelbrot_cljs/core.cljs
@@ -4,9 +4,13 @@
 (enable-console-print!)

 (def initial-rendering-data
-  {:scale          (/ (.-innerWidth js/window) 4) ; How many pixels a distance of 1 in the complex plane takes up
-   :x0             -3 ; the x co-ordinate of the top-left pixel in the canvase
-   :y0             1.2 ; the y co-ordinate of the top-left pixel in the canvase
+  "Defines a rectangle (not necessarily of the same aspect ratio as the screen)
+  in the complex plane to be displayed. This will then be centred on the screen
+  using advanced maths."
+  {:x0             -3
+   :y0             1
+   :width          4
+   :height         2
    })

 (defonce app-state (atom {:canvas         (.getElementById js/document "canvas")
@@ -53,39 +57,78 @@
       :fill (do (aset context "fillStyle" color)
                 (.fillRect context x0 y0 (- x1 x0) (- y1 y0))))))

+(defn enclosing-rectangle
+  "Calculates an enclosing rectangle which contains the given
+  one centered on the screen (would you believe that working
+  this out was the hardest thing in this project?)"
+  [x0 y0 width height screen-width screen-height]
+  (let [portrait?    (>= height width)
+
+        aspect-ratio (/ width height)
+
+        padding      (if portrait?
+                       (- screen-width (* screen-height aspect-ratio))
+                       (- screen-height (/ screen-width aspect-ratio)))
+
+        scale        (if portrait?
+                       (/ screen-height height)
+                       (/ screen-width width))]
+
+    (if portrait?
+      {:x0     (- x0 (* 0.5 (/ padding scale)))
+       :y0     y0
+       :width  (+ width (/ padding scale))
+       :height height
+       :scale  scale}
+
+      {:x0     x0
+       :y0     (+ y0 (* 0.5 (/ padding scale)))
+       :width  width
+       :height (+ height (/ padding scale))
+       :scale  scale})))
+
 (defn render-mandelbrot!
   "Iterate over every pixel in the canvas, rendering the mandelbrot
   set at the specified scale. Uses a javascript function (in resources/public/js/fractal-maths.js)
   for the hard maths, because clojurescript just wasn't cutting it speed wise (you really want local
   variables for this kind of thing - I got it to be only ~10 times slower using the >> and << macros)"
   [{:keys [canvas overlay-canvas escape-radius]
-    {:keys [scale x0 y0] :as render-state} :rendering-data}]
+    {:keys [width height x0 y0] :as render-state} :rendering-data}]
+
+  (println render-state)

   (set-canvas-dimensions! canvas)
   (set-canvas-dimensions! overlay-canvas)
   (clear-canvas! overlay-canvas)

-  (let [context               (.getContext canvas "2d")
-        max-iterations        (int (* 10 (Math/log scale))) ; Sensible?
-        start                 (.getTime (js/Date.))
-
-        width                 (.-width canvas)
-        height                (.-height canvas)
-        idata                 (.createImageData context width height)
-        data                  (.-data idata)
-
-        escape-radius-squared (* escape-radius escape-radius)]
+  (let [screen-width             (.-width canvas)
+        screen-height            (.-height canvas)
+        {:keys [x0 y0 scale]
+         :as rendered-rectangle} (enclosing-rectangle x0 y0 width height screen-width screen-height)
+
+        context                  (.getContext canvas "2d")
+        max-iterations           (int (* 10 (Math/log scale))) ; Sensible?
+        start                    (.getTime (js/Date.))
+
+
+        idata                    (.createImageData context screen-width screen-height)
+        data                     (.-data idata)
+
+        escape-radius-squared    (* escape-radius escape-radius)]
+
+    (println rendered-rectangle)
+    (swap! app-state assoc :rendered-rectangle rendered-rectangle)

     (forloop
-     [(x 0) (< x width)  (inc x)]
+     [(x 0) (< x screen-width)  (inc x)]
      (forloop
-      [(y 0) (< y height) (inc y)]
+      [(y 0) (< y screen-height) (inc y)]

       (let [real       (+ (/ x scale) x0)
             imaginary  (- (/ y scale) y0)
             iterations (js/mandelbrot_smoothed_iteration_count escape-radius-squared max-iterations real imaginary)
             intensity  (* 255 (/ iterations max-iterations))
-            data-index (* 4 (+ x (* y width)))]
+            data-index (* 4 (+ x (* y screen-width)))]

         (aset data data-index intensity)
         (aset data (+ data-index 1) intensity)
@@ -94,7 +137,8 @@

     (.putImageData context idata 0 0)

-    (.log js/console "Done in: " (int (* 1000 (/ (* height width)  (- (.getTime (js/Date.)) start)))) "px/s")))
+    (.log js/console "Done in: " (int (* 1000 (/ (* screen-height screen-width)
+                                                 (- (.getTime (js/Date.)) start)))) "px/s")))

 (defn re-render!
   "Adds a green semi-transparent overlay to the screen, then
@@ -110,60 +154,28 @@
   (.setTimeout js/window #(render-mandelbrot! new-state) 50))

-(defn zoom-to-enclose-rectangle!
-  "Returns a new rendering-data map to zoom the view of the mandelbrot to enclose a given
-  rectangle in the current screen. If the aspect ratio of the given rectangle
-  is not the same as that of the screen, it centers the given rectangle in the
-  screen (hard to explain.. imagine I've drawn a really nice picture of this here)"
-  [{:keys [scale] old-x0 :x0 old-y0 :y0} canvas rect-x0 rect-y0 rect-x1 rect-y1]
-  (let [width            (aget canvas "width")
-        height           (aget canvas "height")
-
-        portrait?        (< (- rect-x1 rect-x0) (- rect-y1 rect-y0))
-
-        new-scale        (if portrait?
-                           (/ height (/ (- rect-y1 rect-y0) scale))
-                           (/ width (/ (- rect-x1 rect-x0) scale)))
-
-        new-aspect-ratio (/ (- rect-x1 rect-x0) (- rect-y1 rect-y0))
-
-        padding          (* 0.5
-                            (if portrait?
-                              (- width (* height new-aspect-ratio))
-                              (- height (/ width new-aspect-ratio))))
-
-        new-x0           (if portrait?
-                           (- (+ old-x0 (/ rect-x0 scale))
-                              (/ padding new-scale))
-
-                           (+ old-x0 (/ rect-x0 scale)))
-
-        new-y0           (if portrait?
-                           (- old-y0 (/ rect-y0 scale))
-
-                           (+ (- old-y0 (/ rect-y0 scale))
-                              (/ padding new-scale)))]
-
-    {:x0 new-x0
-     :y0 new-y0
-     :scale new-scale}))
-
-
 (defn handle-mouseup
   "On mouseup, we zoom the mandelbrot to the specified box and remove the
    :mousedown-event key from the app-state"
   [e]
-  (swap! app-state
-         (fn [{:as old-state :keys [mousedown-event canvas]}]
-
-           (let [x1 (aget e "pageX")
-                 y1 (aget e "pageY")
-                 x0 (aget mousedown-event "pageX")
-                 y0 (aget mousedown-event "pageY")]
-
-             (-> old-state
-                 (dissoc :mousedown-event)
-                 (update-in [:rendering-data] zoom-to-enclose-rectangle! canvas x0 y0 x1 y1))))))
+  (swap!
+   app-state
+   (fn [{:as old-state :keys [mousedown-event canvas rendered-rectangle]}]
+
+     (let [{:keys [x0 y0 scale]}        rendered-rectangle
+
+           x*1                           (+ x0 (/ (aget e "pageX") scale))
+           y*1                           (- y0 (/ (aget e "pageY") scale))
+
+           x*0                           (+ x0 (/ (aget mousedown-event "pageX") scale))
+           y*0                           (- y0 (/ (aget mousedown-event "pageY") scale))]
+
+       (-> old-state
+           (dissoc :mousedown-event)
+           (assoc :rendering-data {:x0     x*0
+                                   :y0     y*0
+                                   :width  (- x*1 x*0)
+                                   :height (- y*0 y*1)}))))))

 (defn handle-state-change!
   [_ _ old-state new-state]


Fixed resource type for generated ECHO10 OnlineResources.

--- src/cmr/umm/echo10/related_url.clj
+++ src/cmr/umm/echo10/related_url.clj
@@ -50,6 +50,12 @@
    "OPENDAP" ["GET DATA" "OPENDAP DATA (DODS)"]
    "DATA ACCESS" ["GET DATA"]
    "ALGORITHM INFO" ["VIEW RELATED INFORMATION"]})
+
+(def related-url-types->resource-types
+  "A mapping of UMM RelatedURL's type to ECHO10 OnlineResource's type.
+  This list is used for generating ECHO10 OnlineResources from UMM RelatedURLs."
+  {"GET DATA" "STATIC URL"
+   "GET RELATED VISUALIZATION" "BROWSE"})

 (def DOCUMENTATION_MIME_TYPES
   ["Text/rtf" "Text/richtext" "Text/plain" "Text/html" "Text/example" "Text/enriched"
@@ -172,6 +178,6 @@
           (let [{:keys [url description type mime-type]} related-url]
             (x/element :OnlineResource {}
                        (x/element :URL {} url)
-                       (x/element :Type {} type)
+                       (x/element :Type {} (related-url-types->resource-types type))
                        (when description (x/element :URLDescription {} description))
                        (when mime-type (x/element :MimeType {} mime-type)))))))))


sketched better macro syntax in design spike

--- design_spikes/instruction_spike.clj
+++ design_spikes/instruction_spike.clj
@@ -28,5 +28,41 @@
 :float_yankdup [
   #(consume-as % int1 :integer)
   #(record-nth-as % float1 :float (mod int1 (count-of :float)))
-  #(send-to % :float record-nth-as)]
-}+  #(send-to % :float float1)]
+}
+
+
+;; the more complete instruction creator would be something like
+
+(def-pushinstruction
+  integer-add
+  :doc "adds two :integers"
+  :needs {:integer 2}
+  :makes {:integer 1}
+  :tags [:arithmetic :core]
+    (consume-as int1 :integer)
+    (consume-as int2 :integer)
+    (send-to :integer (+ int1 int2))
+    )
+
+
+(def-pushinstruction
+  boolean-flush
+  :doc "empties the :boolean stack"
+  :needs {:boolean 0}
+  :tags [:combinator :core]
+  :transaction
+    (discard-stack :boolean)
+    )
+
+
+(def-pushinstruction
+  float-yankdup
+  :doc "Takes an :integer, and copies the indicated nth item (modulo the :float stack size) on the :float stack to the top; so if the :integer is 12 and the :float stack has 5 items, the (mod 12 5) item is copied to the top as a new 6th item."
+  :needs {:integer 1 :float 1}
+  :tags [:core :combinator]
+  :transaction
+    (consume-as int1 :integer)
+    (record-nth-as float1 :float (mod int1 (count-of :float)))
+    (send-to :float float1)]
+    )


Remove the schema.clj file.

Remove the schema.clj file.

--- src/continuo/postgresql/schema.clj
+++ src/continuo/postgresql/schema.clj
@@ -1,124 +0,0 @@
-;; Copyright 2015 Andrey Antukh <niwi@niwi.nz>
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License")
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;;     http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-
-(ns continuo.postgresql.schema
-  (:require [suricatta.core :as sc]
-            [taoensso.nippy :as nippy]
-            [continuo.util.template :as tmpl]
-            [continuo.executor :as exec]))
-
-;; TODO: add props validation
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Attribute SQL Generator
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmulti generate-create-sql
-  "Generate a valid DDL operation for create the attribute
-  table depending on the attribute type."
-  :type)
-
-(defmethod generate-create-sql :continuo/string
-  [{:keys [attr] :as opts}]
-  (let [sql (str "CREATE TABLE {{ attr }} ("
-                 "  eid uuid PRIMARY KEY,"
-                 "  txid bigint,"
-                 "  created_at timestamptz default now(),"
-                 "  modified_at timestamptz,"
-                 "  content text"
-                 ") WITH (OIDS=FALSE);")]
-    (tmpl/render-string sql {:attr attr})))
-
-(defmethod generate-create-sql :default
-  [{:keys [attr] :as opts}]
-  (throw (ex-info "The type is not implemented or not specified." {})))
-
-(defn- generate-drop-sql
-  "Generate a valid DDL operation for create the attribute
-  table depending on the attribute type."
-  [attr]
-  (let [sql (str "DROP TABLE {{ attr }};")]
-    (tmpl/render-string sql {:attr attr})))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Schema Compiler
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare normalize-attrname)
-
-(defmulti compile-op
-  "Compile a chema operation into a ready
-  to execute operation."
-  (fn [fact] (first fact)))
-
-(defmethod compile-op :db/add
-  [[_ attrname props]]
-  (let [attr (normalize-attrname attrname)]
-    (generate-create-sql (assoc props :attr attr))))
-
-(defmethod compile-op :db/drop
-  [[_ attrname]]
-  (let [attr (normalize-attrname attrname)]
-    (generate-drop-sql attr)))
-
-(defmethod compile-op :default
-  [[op]]
-  (throw (ex-info (format "The schema operation %s is not supported." op) {})))
-
-(defn- compile-schema
-  "Compile a schema entries."
-  [schema]
-  (reduce #(conj %1 [(compile-op %2)]) [] schema))
-
-(defn- schema->facts
-  "Normalize the schema values into facts like data."
-  [schema]
-  (letfn [(reducer [acc v]
-            (conj acc (case (count v)
-                        3 v
-                        2 (conj v nil))))]
-    (reduce func [] schema))
-
-;; (defn get-transact-sql
-;;   [schema]
-;;   (let [data (nippy/freeze schemas)]
-;;     [["INSERT INTO txlog VALUES (?,?,?,?,?);"]]))
-
-;; (defn execute-schema
-;;   [schema ]
-;;   (csch (fn [sql]
-;;             (println "EXECUTING:" sql)))))
-
-(defn run-schema
-  [conn schema]
-  {:pre [(seq schema)]}
-  (let [ctx (:context conn)]
-        locksql (get-lock-sql)
-        txsql (get-transact-sql schema)
-        opsql (compile-schema schema)]
-    ))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Utils
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- normalize-attrname
-  [attrname]
-  {:pre [(keyword? attrname)]}
-  (let [nspart (namespace attrname)
-        nmpart (name attrname)]
-    (str nspart "_" nmpart)))
-
-
-


Fix: OpenJDK does not have a native JPEG encoder

--- test/io/perun_test.clj
+++ test/io/perun_test.clj
@@ -73,7 +73,7 @@
    g height HEIGHT int "height of the image"]
   (boot/with-pre-wrap fileset
     (let [tmp (boot/tmp-dir!)
-          buffered-image (BufferedImage. width height BufferedImage/TYPE_INT_ARGB)
+          buffered-image (BufferedImage. width height BufferedImage/TYPE_INT_RGB)
           file (io/file tmp path)]
       (io/make-parents file)
       (ImageIO/write buffered-image type file)


tests to enforce that =throws=> used outside of provided fails

--- test/midje/t_sweet.clj
+++ test/midje/t_sweet.clj
@@ -30,11 +30,28 @@

 (silent-fact
- (two-numbers) => nil
- (provided
-   (number) =throws=> [1]))
-(note-that fact-fails, (fact-captured-throwable-with-message #"Right side of =throws=> should extend Throwable"))
-
+  (two-numbers) => nil
+  (provided
+    (number) =throws=> [1]))
+(note-that fact-fails (fact-captured-throwable-with-message
+                        #"Right side of =throws=> should extend Throwable"))
+
+(silent-fact "`=throws=>` provided arrows should fail when used outside of `provided` body"
+  (inc 1) =throws=> 2)
+(note-that fact-fails (fact-failed-with-note
+                        #"The prerequisite arrow appears outside the body of a `provided`:\(inc 1\) =throws=> 2"))
+
+(silent-fact "nested `=throws=>` provided arrows should fail when used outside of `provided` body"
+  (let [x 1]
+    (inc x) =throws=> 2))
+(note-that fact-fails (fact-failed-with-note
+                        #"The prerequisite arrow appears outside the body of a `provided`:\(inc x\) =throws=> 2"))
+
+(silent-fact "`=streams=>` provided arrows should fail when used outside of `provided` body"
+  (inc 1) =streams=> 2)
+(note-that fact-fails (fact-failed-with-note
+                        #"The prerequisite arrow appears outside the body of a `provided`:\(inc 1\) =streams=> 2"))
+
 (facts "this is a doc string"
   (+ 10 10) => 20
   "this is another one"


Use ligher theme from Kibana for docs.

Use ligher theme from Kibana for docs.

--- src/kiries/layout.clj
+++ src/kiries/layout.clj
@@ -5,7 +5,7 @@
 (defn full-layout [title & content]
   (html5
    [:head
-    (include-css "/kibana/common/css/bootstrap.dark.min.css")
+    (include-css "/kibana/common/css/bootstrap.light.min.css")
     (include-css "/kibana/common/css/bootstrap-responsive.min.css")
     (include-css "/kibana/common/css/font-awesome.min.css")
     [:title title]]


Tidy up

Tidy up

--- test/yada/api_test.clj
+++ test/yada/api_test.clj
@@ -2,20 +2,20 @@

 (ns yada.api-test
   (:require
-   [byte-streams :as bs]
-   [clojure.edn :as edn]
-   [com.stuartsierra.component :refer (system-using system-map)]
    [bidi.bidi :refer (match-route routes)]
    [bidi.ring :refer (make-handler)]
+   [byte-streams :as bs]
+   [cheshire.core :as json]
+   [clojure.edn :as edn]
    [clojure.test :refer :all]
-   [yada.yada :as yada]
+   [com.stuartsierra.component :refer (system-using system-map)]
    [juxt.iota :refer (given)]
    [manifold.deferred :as d]
    [modular.test :refer (with-system-fixture *system*)]
-   [cheshire.core :as json]
    [ring.mock.request :as mock]
    [yada.dev.user-api :refer (new-verbose-user-api)]
-   [yada.dev.database :refer (new-database)]))
+   [yada.dev.database :refer (new-database)]
+   [yada.yada :as yada]))

 (defn new-system
   "Define a minimal system which is just enough for the tests in this


temporarily disabling s3 storage

temporarily disabling s3 storage

--- src/blackbox/src/leela/blackbox/blackbox.clj
+++ src/blackbox/src/leela/blackbox/blackbox.clj
@@ -76,4 +76,4 @@
          (storage/with-connection [graph-cluster (:cassandra options) cassandra-args]
            (storage/use-attr-schema attr-cluster (:attr-keyspace options))
            (storage/use-graph-schema graph-cluster (:graph-keyspace options))
-           (zserver/server-start (ZMQ/context 1) attr-cluster graph-cluster s3cred (assoc options :endpoint endpoint)))))))))
+           (zserver/server-start (ZMQ/context 1) attr-cluster graph-cluster (assoc options :endpoint endpoint)))))))))


order accounts by name by default

order accounts by name by default

--- src/clj_money/models/storage/sql_storage.clj
+++ src/clj_money/models/storage/sql_storage.clj
@@ -246,7 +246,8 @@
     [_ entity-id]
     (query db-spec (-> (h/select :*)
                        (h/from :accounts)
-                       (h/where [:= :entity_id entity-id]))))
+                       (h/where [:= :entity_id entity-id])
+                       (h/order-by :name))))

   (update-account
     [_ account]


add test oauth endpoint for dev purposes

--- src/braid/server/routes/client.clj
+++ src/braid/server/routes/client.clj
@@ -55,6 +55,11 @@
        :headers {"Content-Type" "text/plain"}
        :body "Bad user or token"}))

+  ; OAuth redirect
+  (GET "/oauth/github" [code state :as req]
+    (println "GITHUB OAUTH" (pr-str code) (pr-str state))
+    )
+
   ; everything else
   (GET "/*" []
     (get-html "desktop")))


explain package intent

explain package intent

--- src/er_cassandra/record_either.clj
+++ src/er_cassandra/record_either.clj
@@ -6,6 +6,10 @@
    [cats.monad.either :as either]
    [cats.monad.deferred :as dm]
    [er-cassandra.record :as r]))
+
+;; low-level record-based cassandra interface which
+;; puts responses into an Either monad Right value,
+;; and transforms Exceptions into Left values

 (defn alia-error-transformer
   "transforms an alia exception into an error map... doesn't


fixed some formatting

fixed some formatting

--- src/frontend/server-interface.cljs
+++ src/frontend/server-interface.cljs
@@ -27,11 +27,15 @@
 (.on app-state/socket "file-upload-info"
   (fn [file-upload-info]
     (if (= (.-totalsize file-upload-info) (.-bytesreceived file-upload-info))
-      (swap! app-state/app-state assoc :current-uploads-info
-        (dissoc (:current-uploads-info @app-state/app-state) (.-id file-upload-info)))
-      (swap! app-state/app-state assoc :current-uploads-info
-        (merge (:current-uploads-info @app-state/app-state)
-          {(.-id file-upload-info) file-upload-info})))))
+      (swap! app-state/app-state
+             assoc
+             :current-uploads-info
+             (dissoc (:current-uploads-info @app-state/app-state) (.-id file-upload-info)))
+      (swap! app-state/app-state
+             assoc
+             :current-uploads-info
+             (merge (:current-uploads-info @app-state/app-state)
+                    {(.-id file-upload-info) file-upload-info})))))

 (.on app-state/socket "resume" player/resume!)


Fix message text input position

Fix message text input position

Former-commit-id: b28076f5b875f5440913c942847811995751e4e7

--- src/syng_im/components/chat/plain_message_input.cljs
+++ src/syng_im/components/chat/plain_message_input.cljs
@@ -50,11 +50,12 @@
           [text-input {:underlineColorAndroid "transparent"
                        :style                 {:flex       1
                                                :marginLeft 16
-                                               :marginTop  7
+                                               :marginTop  -2
+                                               :padding    0
                                                :fontSize   14
                                                :fontFamily font
                                                :color      text2-color}
-                       :autoFocus             false
+                       :autoFocus             (< 0 (count @staged-commands-atom))
                        :placeholder           "Type"
                        :placeholderTextColor  text2-color
                        :onChangeText          (fn [new-text]


Do not show run in own window button

Do not show run in own window button

This feature is temporarily removed for class in cljs

--- src/webapp/framework/client/webhosting/hostmain.cljs
+++ src/webapp/framework/client/webhosting/hostmain.cljs
@@ -163,7 +163,7 @@
             (cond
              (= (read-ui app [:mode]) "edit")
              (div {:style       {:display "inline-block"}}
-               (a {:className    "btn btn-default"
+               (comment a {:className    "btn btn-default"
                    :target       "new"
                    :style       {:display "inline-block" :marginLeft "30px" :fontFamily "Ubuntu" :fontSize "1em"  :marginTop "-0.3em" }
                    :href         (str "http://" @appshare-dev-server ":3450")}


Formatting

Formatting

--- test/clojure/clojurewerkz/cassaforte/schema_test.clj
+++ test/clojure/clojurewerkz/cassaforte/schema_test.clj
@@ -1,10 +1,9 @@
 (ns clojurewerkz.cassaforte.schema-test
   (:refer-clojure :exclude [update])
-  (:require [clojurewerkz.cassaforte.client :as client]
-            [clojurewerkz.cassaforte.test-helper :as th]
-            [clojurewerkz.cassaforte.cql :refer :all]
-            [clojure.test :refer :all]
-            [clojurewerkz.cassaforte.query :refer :all]))
+  (:require [clojurewerkz.cassaforte.test-helper :as th]
+            [clojurewerkz.cassaforte.cql         :refer :all]
+            [clojure.test                        :refer :all]
+            [clojurewerkz.cassaforte.query       :refer :all]))

 (defn changes-by
   [f f2 n]


Refactor async pipeline transducer.

Refactor async pipeline transducer.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -256,12 +256,12 @@
                            (async/pipeline
                              pipeline-length
                              out-chan
-                             (fn [rf]
-                               (fn ([] (rf))
-                               ([result] (rf result))
-                               ([result data]
-                                 (let [ret (direct-proc-fn data)]
-                                   (rf result (if (nil? ret) 1 ret))))))
+                             (map
+                               (fn [in-data]
+                                 (let [out-data (direct-proc-fn in-data)]
+                                   (if (nil? out-data)
+                                     1
+                                     out-data))))
                              in-chan))
           self-adaptivity-cfg (options :self-adaptivity-cfg)
           self-adaptivity-controller (if (not (nil? self-adaptivity-cfg))


Primitive asplan works (well)

Primitive asplan works (well)

--- src/exp/asplan.clj
+++ src/exp/asplan.clj
@@ -64,7 +64,10 @@
        [[(action-var sas/goal-var-name) goal-action]
         [(free-var sas/goal-var-name) false]]))))

+(def *add-count* (util/sref 0))
+
 (defn make-add-action-action [{:keys [name precond-map effect-map reward] :as factored-primitive}]
+  (util/sref-set! *add-count* (inc (util/sref-get *add-count*)))
   (let [[evar eval] (util/safe-singleton (seq effect-map))]
     (env/FactoredPrimitive
      [::AddAction name]
@@ -152,8 +155,8 @@

 (defn current-child [s child-var-map p-var]
   (when-not (env/get-var s (free-var p-var))
-    (some #(env/get-var s (parent-var p-var %))
-          (child-var-map p-var))))
+    (util/find-first #(env/get-var s (parent-var p-var %))
+      (child-var-map p-var))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions fn, actual env ;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -189,7 +192,7 @@
     (ASPlanEnv
      (expand-initial-state (env/initial-state sas-problem) child-var-map (goal-action dtgs))
      (fn asplan-actions [s]
-       (let [[aa-vars na-vars] (split-with #(env/get-var s (action-var %)) vars)
+       (let [[aa-vars na-vars] (util/separate #(env/get-var s (action-var %)) vars)
              aa-parent-edges   (for [av aa-vars
                                       :let [pm (:precond-map (env/get-var s (action-var av)))]
                                       pv    (remove #{av} (keys pm))
@@ -200,6 +203,8 @@
                                      :let  [child (current-child s child-var-map nav)]
                                      :when (and child (not (env/get-var s (action-var child))))]
                                  [nav child])]
+         (println "\n" s "\n" (first (:act-seq (meta s))))
+;         (println "\n\n\n" s "\n"  aa-vars "\n"  aa-parent-edges "\n" na-tuples )
         (util/cond-let [x]
           ;; Greedy action -- all preconditions satisfied and not assigned elsewhere
           (some #(make-greedy-fire-action s %) aa-vars)
@@ -209,8 +214,10 @@
           (util/find-first (fn [[pv cv]] (env/get-var s (parent-var pv cv))) aa-parent-edges)
             (let [[pv cv] x,
                   p-val (env/get-var s pv)
-                  d-val (util/safe-get-in (env/get-var s (action-var cv)) [:precond-map pv])]
-              (apply concat (map (get-in dtgs [pv p-val]) (acyclic-succ-fn pv p-val d-val))))
+                  d-val ((:precond-map (env/get-var s (action-var cv))) pv)
+                  dtg   (get-in dtgs [pv p-val])]
+              (for [n-val (acyclic-succ-fn pv p-val d-val), a (dtg n-val)]
+                (make-add-action-action a)))

           ;; Inactive bottom-up var -- needs to be assigned.
           (first aa-parent-edges)
@@ -218,7 +225,8 @@

           ;; Active top-down var -- add actions
           (util/find-first #(not (env/get-var s (free-var %))) (map second na-tuples))
-            (apply concat (vals (util/safe-get-in dtgs [x (env/get-var s x)])))
+            (for [as (vals (util/safe-get-in dtgs [x (env/get-var s x)])), a as]
+              (make-add-action-action a))

           ;; Inactive top-down var -- activate it
           (first (map second na-tuples))
@@ -226,7 +234,7 @@
      (env/goal-map sas-problem))))

 (defn asplan-solution-name [sol]
-  (map second (filter #(= (first %) ::GreedyFire) (map env/action-name sol))))
+  (map second (filter #(= (first %) ::GreedyFire) sol)))

 (defn asplan-solution-pair-name [[sol rew]]
   [(asplan-solution-name sol) rew])


Add microdata attributes

Add microdata attributes

--- src/kioo/util.cljx
+++ src/kioo/util.cljx
@@ -95,11 +95,11 @@
               [:accessKey :allowFullScreen :allowTransparency :autoComplete
                :autoFocus :autoPlay :cellPadding :cellSpacing :charSet
                :colSpan :contentEditable :contextMenu :dateTime :encType
-               :formNoValidate :frameBorder :htmlFor :httpEquiv :maxLength
-               :noValidate :radioGroup :readOnly :rowSpan :scrollLeft :scrollTop
-               :spellCheck :srcDoc :tabIndex :gradientTransform :gradientUnits
-               :spreadMethod :stopColor :stopOpacity :strokeLinecap :strokeWidth
-               :textAnchor :viewBox])
+               :formNoValidate :frameBorder :htmlFor :httpEquiv :itemProp
+               :itemScope :itemType :maxLength :noValidate :radioGroup :readOnly
+               :rowSpan :scrollLeft :scrollTop :spellCheck :srcDoc :tabIndex
+               :gradientTransform :gradientUnits :spreadMethod :stopColor
+               :stopOpacity :strokeLinecap :strokeWidth :textAnchor :viewBox])
     :class
     :className))


removed numbered parameters (wrong idea)

--- src/latte/core.clj
+++ src/latte/core.clj
@@ -71,31 +71,18 @@
                 (reduced [:ko ty])
                 [:ok (conj params [x ty])]))) [:ok []] params))

-(defn mk-params-renaming
-  ([params] (mk-params-renaming params 1))
-  ([params level]
-   (loop [params params, level level, nparams [], ren {}]
-     (if (seq params)
-       (let [[x ty] (first params)
-             x' (symbol (str "%" level))]
-         (recur (rest params) (inc level) (conj nparams [x' (syntax/renaming ty ren)]) (assoc ren x x')))
-       [nparams ren]))))
-
-
 (defn handle-term-definition [def-name params body]
   ;; parse parameters
   (let [[status params] (parse-parameters defenv/empty-env params)]
     (if (= status :ko)
       [:ko params]
-      (let [[params' ren] (mk-params-renaming params)
-            [status body-term] (stx/parse-term defenv/empty-env body)]
+      (let [[status body-term] (stx/parse-term defenv/empty-env body)]
         (if (= status :ko)
           [:ko body-term]
-          (let [body-term' (syntax/renaming body-term ren)
-                [status ty _] (ty/type-of-term defenv/empty-env params' body-term')]
+          (let [[status ty _] (ty/type-of-term defenv/empty-env params body-term)]
             (if (= status :ko)
               [:ko ty]
-              [:ok (defenv/->Definition def-name params' (count params') body-term' ty {})])))))))
+              [:ok (defenv/->Definition def-name params (count params) body-term ty {})])))))))

 (defn mk-def-doc [kind content explanation]
   (str "\n```\n"
@@ -180,14 +167,12 @@
   (let [[status params] (parse-parameters defenv/empty-env params)]
     (if (= status :ko)
       [:ko params]
-      (let [[params' ren] (mk-params-renaming params)
-            [status ty'] (stx/parse-term defenv/empty-env ty)]
+      (let [[status ty'] (stx/parse-term defenv/empty-env ty)]
         (if (= status :ko)
           [:ko ty']
-          (let [ty'' (syntax/renaming ty' ren)]
-            (if (not (ty/proper-type? defenv/empty-env params' ty''))
-              [:ko {:msg "Theorem body is not a proper type" :theorem thm-name :type ty''}]
-              [:ok (defenv/->Theorem thm-name params (count params) ty'' false)])))))))
+          (if (not (ty/proper-type? defenv/empty-env params ty'))
+            [:ko {:msg "Theorem body is not a proper type" :theorem thm-name :type (unparser/unparse ty')}]
+            [:ok (defenv/->Theorem thm-name params (count params) ty' false)]))))))

 ;;{
 ;; ## Axioms
@@ -246,14 +231,12 @@
   (let [[status params] (parse-parameters defenv/empty-env params)]
     (if (= status :ko)
       [:ko params]
-      (let [[params' ren] (mk-params-renaming params)
-            [status ty'] (stx/parse-term defenv/empty-env ty)]
+      (let [[status ty'] (stx/parse-term defenv/empty-env ty)]
         (if (= status :ko)
           [:ko ty']
-          (let [ty''(syntax/renaming ty' ren)]
-            (if (not (ty/proper-type? defenv/empty-env params' ty''))
-              [:ko {:msg "Axiom body is not a proper type" :axiom ax-name :type (unparser/unparse ty'')}]
-              [:ok (defs/mkaxiom ax-name params' ty'')])))))))
+          (if (not (ty/proper-type? defenv/empty-env params ty'))
+            [:ko {:msg "Axiom body is not a proper type" :axiom ax-name :type (unparser/unparse ty')}]
+            [:ok (defenv/->Axiom ax-name params (count params) ty')]))))))

 ;;{
 ;; ## Proofs
@@ -416,7 +399,7 @@
           [:ko ty']
           (if (not (ty/proper-type? defenv/empty-env params ty'))
             [:ko {:msg "Example body is not a proper type" :type ty'}]
-            [:ok (defs/mkthm (gensym "example") params ty')]))))))
+            [:ok (defenv/->Theorem (gensym "example") params (count params) ty' false)]))))))

 ;;{
 ;; ## Implicits


Allow jar to proceed even if compile returns nil.

--- src/leiningen/jar.clj
+++ src/leiningen/jar.clj
@@ -155,10 +155,10 @@
 be used as the main-class for an executable jar."
   ([project jar-name]
      (binding [compile/*silently* true]
-       (when (compile/compile project)
-         (let [jar-path (get-jar-filename project jar-name)
-               deps-fileset (deps project :skip-dev)]
-           (write-jar project jar-path (filespecs project deps-fileset))
-           (println "Created" jar-path)
-           jar-path))))
+       (compile/compile project)
+       (let [jar-path (get-jar-filename project jar-name)
+             deps-fileset (deps project :skip-dev)]
+         (write-jar project jar-path (filespecs project deps-fileset))
+         (println "Created" jar-path)
+         jar-path)))
   ([project] (jar project (get-default-jar-name project))))


Clarify unclear docstring for run task.

Clarify unclear docstring for run task.

--- src/leiningen/run.clj
+++ src/leiningen/run.clj
@@ -11,13 +11,13 @@

 ;; TODO: use subtask help?
 (defn run
-  "Call a function in a new process or run a .clj file.
+  "Call a -main function with optional command-line arguments.

 USAGE: lein run [ARGS...]
 Calls the -main function in the namespace specified as :main in project.clj.

 USAGE: lein run -m NAMESPACE [ARGS...]
-Calls the namespace/function in a new process; function defaults to -main.
+Calls the -main function in the specified namespace.

 USAGE: lein run :alias [ARGS...]
 Aliases can be defined in project.clj as
@@ -28,6 +28,5 @@
         alias (and (keyword? flag) (flag (:run-aliases project)))]
     (cond alias           (apply run project "-m" (cons alias args))
           (= flag '-m)    (apply run-main project args)
-          (:main project) (apply run-main project (:main project)
-                                 flag args)
+          (:main project) (apply run-main project (:main project) flag args)
           :else (abort "No :main namespace specified in project.clj."))))


Return project from xjc-task.

Return project from xjc-task.

--- src/leiningen/xjc.clj
+++ src/leiningen/xjc.clj
@@ -3,4 +3,5 @@

 (defn xjc
   [project & args]
-  (plugin/xjc-task project))
+  (plugin/xjc-task project)
+  project)


Don't show see-alsos with missing target var. Fixes #158

--- src/clj/clojuredocs/pages/vars.clj
+++ src/clj/clojuredocs/pages/vars.clj
@@ -36,7 +36,11 @@
                  :from-var.name name
                  :from-var.library-url library-url})
        (map (fn [{:keys [to-var] :as sa}]
-              (assoc sa :doc (-> (str (:ns to-var) "/" (:name to-var)) search/lookup :doc))))))
+         (let [ns-name (str (:ns to-var) "/" (:name to-var))
+               looked-up-var (search/lookup ns-name)]
+           (if (nil? looked-up-var) nil
+               (assoc sa :doc (:doc looked-up-var))))))
+       (remove nil?)))

 (defn source-url [{:keys [file line ns]}]
   (when (= "clojure.core" ns)


added service-task based on filter

added service-task based on filter

#72

--- src/clj/swarmpit/docker/client.clj
+++ src/clj/swarmpit/docker/client.clj
@@ -118,6 +118,10 @@
   (-> (str "/services/" id)
       (get)))

+(defn service-tasks
+  [id]
+  (get "/tasks" {:filters (generate-string {:service [id]})}))
+
 (defn delete-service
   [id]
   (-> (str "/services/" id)


Tweaking build formatting (last time)

Tweaking build formatting (last time)

--- src/cljc/zetawar/views/common.cljc
+++ src/cljc/zetawar/views/common.cljc
@@ -111,7 +111,7 @@
        [:a {:href (str "/builds/" site/build)} site/build]
        "DEV")
      (when (not-empty site/build-timestamp)
-       (str " - " site/build-timestamp))]
+       (str " • " site/build-timestamp))]
     [:p
      "Follow "
      [:a {:href "https://twitter.com/ZetawarGame"} "@ZetawarGame"]


Naive HTTP URL enrichment

Naive HTTP URL enrichment


call modal with options

call modal with options

--- src/cljs/salava/core/ui/modal.cljs
+++ src/cljs/salava/core/ui/modal.cljs
@@ -47,7 +47,13 @@
                                                     #_(if (and init-data state)
                                                         (init-data state))))}))

-(defn open-modal [route params]
-  (if (empty? @views)
-    (m/modal! [modal-init [((get-in (modal-navi) route) params)]] {:size :lg})
-    (set-new-view route params)))
+(defn open-modal
+  ([route params]
+   (if (empty? @views)
+     (m/modal! [modal-init [((get-in (modal-navi) route) params)]] {:size :lg})
+     (set-new-view route params)))
+  ([route params opts]
+   (if (empty? @views)
+     (m/modal! [modal-init [((get-in (modal-navi) route) params)]] (merge opts {:size :lg}))
+     (set-new-view route params))
+   ))


simplify frame

simplify frame

--- src/cljs/tictactoe/view/frame.cljs
+++ src/cljs/tictactoe/view/frame.cljs
@@ -7,10 +7,7 @@
 (defn render
   "Rendering the main frame of the game,
    takes as input the callbacks to trigger events"
-  [board {:keys [on-restart-event on-undo-event on-move-event]}]
+  [board callbacks]
   [:div
-   (panel/render-top-panel
-     {:on-restart-event on-restart-event
-      :on-undo-event on-undo-event})
-   (board/render-board board
-     {:on-move-event on-move-event})])
+   (panel/render-top-panel callbacks)
+   (board/render-board board callbacks)])


fixed onSuccess signature error

fixed onSuccess signature error

--- src/link/socketio.clj
+++ src/link/socketio.clj
@@ -20,7 +20,7 @@
   (send* [this msg cb]
     (.sendMessage this msg
                   (proxy [VoidAckCallback] []
-                    (onSuccess []
+                    (onSuccess [r]
                       (cb)))))
   (send [this msg]
     (send* this msg (fn [])))


show outer pricing cost as free to start

--- frontend/components/pricing-b.cljs
+++ frontend/components/pricing-b.cljs
@@ -47,7 +47,8 @@
     (render-state [_ {:keys [drag-percent dragging?]}]
       (let [pricing-parallelism (get-in app state/pricing-parallelism-path 1)
             normalized-drag-percent (* increment (js/Math.ceil (/ drag-percent increment)))
-            container-count (max pricing-parallelism (/ normalized-drag-percent increment))]
+            container-count (max pricing-parallelism (/ normalized-drag-percent increment))
+            total-cost (max (* (dec container-count) 50) 0)]
         (html
           [:div.pricing.page {:on-mouse-up #(om/set-state! owner :dragging? false)
                               :on-mouse-down #(when dragging?
@@ -110,7 +111,9 @@
                 [:div.value (str (int (/ container-count pricing-parallelism)))]]
                [:div.calculator-preview-item
                 [:div.item "Cost"]
-                [:div.value (str "$" (max (* (dec container-count) 50) 0))]]
+                [:div.value (if (> total-cost 0)
+                              (str "$" total-cost)
+                              "Free")]]
                [:a.pricing-action {:role "button"} "Sign Up Free"]]]
              [:article.pricing-features
               [:div.pricing-feature


Remove unused code from workspace data ns.

--- frontend/uxbox/data/workspace.cljs
+++ frontend/uxbox/data/workspace.cljs
@@ -123,21 +123,8 @@
     (-apply-update [_ state]
       ;; (println "apply-delta" shapeid delta)
       (let [pageid (get-in state [:workspace :page])
-            _ (assert pageid)
             shape (get-in state [:pages-by-id pageid :shapes-by-id shapeid])]
         (update-in state [:pages-by-id pageid :shapes-by-id shapeid] merge
                    {:x (+ (:x shape) dx)
                     :y (+ (:y shape) dy)})))))

-
-;; (defn apply-delta'
-;;   "Mark a shape selected for drawing in the canvas."
-;;   [shapeid [dx dy :as delta]]
-;;   (reify
-;;     rs/UpdateEvent
-;;     (-apply-update [_ state]
-;;       ;; (println "apply-delta'" shapeid delta)
-;;       (let [pageid (get-in state [:workspace :page])
-;;             shape (get-in state [:pages-by-id pageid :shapes-by-id shapeid])]
-;;         (update-in state [:pages-by-id pageid :shapes-by-id shapeid] merge
-;;                    {:x dx :y dy})))))


removed use of variable? in htn.clj

removed use of variable? in htn.clj

Signed-off-by: Tom Marble <b248307e886b80bf9cb4014595572a835b049bf4@info9.net>
Signed-off-by: Tom Marble <b248307e886b80bf9cb4014595572a835b049bf4@info9.net>

--- src/pamela/htn.clj
+++ src/pamela/htn.clj
@@ -580,8 +580,8 @@
             )
           (let [{:keys [nonprimitive-task]} method
                 compatible? (fn [[task-arg method-arg]]
-                              (or (variable? task-arg)
-                                  (variable? method-arg)
+                              (or (symbol? task-arg)
+                                  (symbol? method-arg)
                                   (= task-arg method-arg)))
                 match? (and (= name (:name nonprimitive-task))
                             (= (count arguments) (count (:arguments nonprimitive-task)))


help updated

help updated

--- src/rssfs/core.clj
+++ src/rssfs/core.clj
@@ -17,8 +17,8 @@
     (< size 2048)          (str size)
     (< size 1024000)       (format "%.0fk" (Math/floor (/ size 1024)))
     (< size 1024000000)    (format "%.0fM" (Math/floor (/ size 1024000)))
-    (< size 1024000000000) (format "%.0fG" (Math/floor (/ size 1024000000)))
-    :else                  (format "%.0fT" (Math/floor (/ size 1024000000000)))))
+    (< size 1024000000000) (format "%.1fG" (Math/floor (/ size 1024000000)))
+    :else                  (format "%.1fT" (Math/floor (/ size 1024000000000)))))

 (defn scandir
@@ -71,9 +71,11 @@

 (defn help
   [options-summary]
-  (->> ["fill up projects querying their sources to the warmup\n"
+  (->> [(str "RSS-FS v" VERSION)
+        "generate a rss with the most recents files in the given path[s]\n"
         "syntax:"
         "rssls [path] [options]\n"
+        "by defaut current path is used\n"
         "options:"
         options-summary]
        (str/join \newline)))


Use accompanying-material in braille as is

Before we were not trusting it and setting our own string under some
very specific conditions. As it happens this drops some legitimate other
use cases. So use the string as is. If there are problems solve them at
the source, i.e. fix the data in the library system.

Fixes #4

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -296,15 +296,7 @@
                      double-spaced? (boolean
                                       (and double-spaced?
                                            (re-find #"^Weitzeilig" double-spaced?)))
-                     braille-grade (braille-grade-raw-to-braille-grade braille-grade)
-                     ;; apparently the data in the library re accompanying-material for
-                     ;; braille books is not to be trusted, hence we figure out if there
-                     ;; is some accompanying material based on an elaborate set of
-                     ;; preconditions
-                     accompanying-material (when (and
-                                                  rucksackbuch-number
-                                                  (= (:sub-genre item) :kinderbücher-ab-6))
-                                             "inkl. Schwarzschriftbeilage")]
+                     braille-grade (braille-grade-raw-to-braille-grade braille-grade)]
                  (-> item
                      (assoc-some
                       :rucksackbuch-number rucksackbuch-number


Update copyright notice on builtin ns.

Update copyright notice on builtin ns.

--- src/cats/builtin.cljc
+++ src/cats/builtin.cljc
@@ -1,5 +1,5 @@
-;; Copyright (c) 2014, Andrey Antukh
-;; Copyright (c) 2014, Alejandro Gómez
+;; Copyright (c) 2014-2015 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2014-2015 Alejandro Gómez <alejandro@dialelo.com>
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without


using host and not h

using host and not h

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -24,10 +24,10 @@
    :body (pr-str data)})

 (defroutes provision-routes
-  (POST "/:h" [h]
-        (let [machine (p/host h) type (p/type (:type machine))]
+  (POST "/:host" [host]
+        (let [machine (p/host host) type (p/type (:type machine))]
           (jobs/enqueue "provision" (merge machine type))
-          (generate-response {:status "submitted pupptization" :host h :machine machine :type type}))))
+          (generate-response {:status "submitted pupptization" :host host :machine machine :type type}))))

 (defroutes stage-routes
   (POST "/:host" [host]


adding templates to published api

adding templates to published api

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -27,7 +27,7 @@
       [actions :refer (actions actions-ro)]
       [types :refer (types types-ro)]
       [audits :refer (audits-ro audits)]
-      [systems :refer (systems environments systems-admin)]
+      [systems :refer (systems environments systems-admin templates)]
       [stacks :refer (stacks stacks-ro)]
       [users :refer (users quotas users-ro users-current)]
       [ui :refer (public sessions)]]
@@ -44,7 +44,8 @@
 (import-logging)

 (defroutes app-routes
-  systems types-ro audits-ro actions-ro stacks-ro
+  templates systems types-ro
+  audits-ro actions-ro stacks-ro
   environments jobs sessions users-current
   (friend/wrap-authorize metrics su)
   (friend/wrap-authorize users-ro su)


adding login routes

adding login routes

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -12,20 +12,23 @@
 (ns celestial.api
   (:refer-clojure :exclude [hash type])
   (:use
-        [celestial.hosts-api :only (system type environments)]
-        [celestial.users-api :only (users quotas)]
-        [gelfino.timbre :only (get-tid)]
-        [compojure.core :only (defroutes routes)]
-        [metrics.ring.expose :only  (expose-metrics-as-json)]
-        [celestial.roles :only (roles roles-m admin)]
-        [clojure.core.strint :only (<<)]
-        [slingshot.slingshot :only  [throw+ try+]]
-        [ring.middleware.format :only [wrap-restful-format]]
-        [ring.middleware.params :only (wrap-params)]
-        [metrics.ring.instrument :only  (instrument)]
-        [swag.model :only (defmodel wrap-swag defv defc)]
-        [celestial.common :only (import-logging get! resp bad-req conflict success version wrap-errors)])
+    [celestial.hosts-api :only (system type environments)]
+    [celestial.users-api :only (users quotas)]
+    [gelfino.timbre :only (get-tid)]
+    [compojure.core :only (defroutes routes)]
+    [metrics.ring.expose :only  (expose-metrics-as-json)]
+    [celestial.roles :only (roles roles-m admin)]
+    [clojure.core.strint :only (<<)]
+    [slingshot.slingshot :only  [throw+ try+]]
+    [ring.middleware.format :only [wrap-restful-format]]
+    [ring.middleware.params :only (wrap-params)]
+    [metrics.ring.instrument :only  (instrument)]
+    [swag.model :only (defmodel wrap-swag defv defc)]
+    [celestial.common :only (import-logging get! resp bad-req conflict success version wrap-errors)])
   (:require
+    [ring.middleware.session.cookie :refer (cookie-store)]
+    [ring.middleware.session :refer (wrap-session)]
+    [compojure.core :refer (GET ANY)]
     [me.raynes.fs :as fs]
     [swag.core :refer (swagger-routes GET- POST- PUT- DELETE- defroutes- errors )]
     [ring.middleware [multipart-params :as mp] ]
@@ -143,10 +146,14 @@
     (if (fs/exists? build ) build bin)))

 (defroutes static-routes
+  (GET "/login" [] (ring.util.response/file-response "assets/login.html" {:root (static-path)}))
   (route/files "/" {:root (static-path)}))

+(defroutes sessions
+  (friend/logout (ANY "/logout" request  (ring.util.response/redirect "/"))))
+
 (defroutes app-routes
-  static-routes system type environments actions jobs (friend/wrap-authorize users admin)
+  system type environments actions jobs sessions (friend/wrap-authorize users admin)
   (friend/wrap-authorize quotas admin) (route/not-found "Not Found"))

 (defn error-wrap
@@ -166,7 +173,7 @@
 (defn compose-routes
   "Composes celetial apps"
   [secured?]
-  (let [rs (routes (swagger-routes version) (if secured? (sec/secured-app app-routes) app-routes) )]
+  (let [rs (routes static-routes (swagger-routes version) (if secured? (sec/secured-app app-routes) app-routes) )]
     (if secured?
       (force-https rs) rs)))

@@ -174,6 +181,7 @@
   "The api routes, secured? will enabled authentication"
   (-> (compose-routes secured?)
       (wrap-swag)
+      (wrap-session {:cookie-name "celestial" :store (cookie-store)})
       (handler/api)
       (wrap-restful-format :formats [:json-kw :edn :yaml-kw :yaml-in-html])
       (mp/wrap-multipart-params)


* src/clj/cljs/core.clj: optimize satisfies?, gap between calling through fn to protocol fn, vs calling protocol fn directly now much smaller across the board.

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -586,11 +586,11 @@
   [psym x]
   (let [p (:name (cljs.compiler/resolve-var (dissoc &env :locals) psym))
         prefix (protocol-prefix p)
-        xsym (gensym)
+        xsym (bool-expr (gensym))
         [part bit] (fast-path-protocols p)
         msym (symbol (core/str "-cljs$lang$protocol_mask$partition" part "$"))]
     `(let [~xsym ~x]
-       (if (coercive-not= ~xsym nil)
+       (if ~xsym
          (if (or ~(if bit `(unsafe-bit-and (. ~xsym ~msym) ~bit))
                  ~(bool-expr `(. ~xsym ~(symbol (core/str "-" prefix)))))
            true


load-file should attempt to load a file before falling back on io/resource

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -474,7 +474,10 @@
   ([repl-env f] (load-file repl-env f nil))
   ([repl-env f opts]
     (if (:output-dir opts)
-      (let [src (if (util/url? f) f (io/resource f))
+      (let [src (cond
+                  (util/url? f) f
+                  (.exists (io/file f)) (io/file f)
+                  :else (io/resource f))
             compiled (cljsc/compile src
                        (assoc opts
                          :output-file


Add "priority" prompts. Add get-virus-counters.

Support for Hivemind.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -151,11 +151,15 @@

 (declare resolve-ability)

-(defn show-prompt [state side card msg choices f]
-  (let [prompt (if (string? msg) msg (msg state side card nil))]
+(defn show-prompt
+  ([state side card msg choices f] (show-prompt state side card msg choices f nil))
+  ([state side card msg choices f priority]
+    (let [prompt (if (string? msg) msg (msg state side card nil))]
     (when (or (#{:credit :counter} choices) (> (count choices) 0))
       (swap! state update-in [side :prompt]
-             #(conj (vec %) {:msg prompt :choices choices :effect f :card card})))))
+             (if priority
+               #(cons {:msg prompt :choices choices :effect f :card card} (vec %))
+               #(conj (vec %) {:msg prompt :choices choices :effect f :card card})))))))

 (defn resolve-psi [state side card psi bet]
   (swap! state assoc-in [:psi side] bet)
@@ -176,8 +180,10 @@
                  (map #(str % " [Credits]") (range (min 3 (inc (get-in @state [s :credit])))))
                  #(resolve-psi state s card psi (Integer/parseInt (first (split % #" ")))))))

-(defn prompt! [state side card msg choices ability]
-  (show-prompt state side card msg choices #(resolve-ability state side ability card [%])))
+(defn prompt!
+  ([state side card msg choices ability] (prompt! state side card msg choices ability nil))
+  ([state side card msg choices ability priority]
+    (show-prompt state side card msg choices #(resolve-ability state side ability card [%]) priority)))

 (defn optional-ability [state side card msg ability targets]
   (show-prompt state side card msg ["Yes" "No"] #(if (= % "Yes")
@@ -215,19 +221,21 @@
   (swap! state assoc-in [side :selected] nil)
   (swap! state update-in [side :prompt] rest))

-(defn show-select [state side card ability]
-  (swap! state assoc-in [side :selected]
-         {:ability (dissoc ability :choices) :req (get-in ability [:choices :req])
-          :max (get-in ability [:choices :max])})
-  (show-prompt state side card
-               (if-let [m (get-in ability [:choices :max])]
-                 (str "Select up to " m " targets for " (:title card))
-                 (str "Select a target for " (:title card)))
-               ["Done"] (fn [choice] (resolve-select state side))))
+(defn show-select
+  ([state side card ability] (show-select state side card ability nil))
+  ([state side card ability priority]
+    (swap! state assoc-in [side :selected]
+           {:ability (dissoc ability :choices) :req (get-in ability [:choices :req])
+            :max (get-in ability [:choices :max])})
+    (show-prompt state side card
+                 (if-let [m (get-in ability [:choices :max])]
+                         (str "Select up to " m " targets for " (:title card))
+                         (str "Select a target for " (:title card)))
+                 ["Done"] (fn [choice] (resolve-select state side)) priority)))

 (defn resolve-ability [state side {:keys [counter-cost advance-counter-cost cost effect msg req once
                                           once-key optional prompt choices end-turn player psi trace
-                                          not-distinct] :as ability}
+                                          not-distinct priority] :as ability}
                        {:keys [title cid counter advance-counter] :as card} targets]
   (when ability
     (when (and optional
@@ -243,13 +251,13 @@
                (or (not req) (req state side card targets)))
       (if choices
         (if (map? choices)
-          (show-select state (or player side) card ability)
+          (show-select state (or player side) card ability priority)
           (let [cs (if-not (fn? choices)
                      choices
                      (let [cards (choices state side card targets)]
                              (if not-distinct
                                cards (distinct-by :title cards))))]
-            (prompt! state (or player side) card prompt cs (dissoc ability :choices))))
+            (prompt! state (or player side) card prompt cs (dissoc ability :choices) priority)))
         (when (and (or (not counter-cost) (<= counter-cost counter))
                    (or (not advance-counter-cost) (<= advance-counter-cost advance-counter))
                    (apply pay (concat [state side card] cost)))
@@ -628,7 +636,9 @@
                p (assoc p :current-strength nil))))
     (system-msg state side "continues the run")))

+
 (defn play-ability [state side {:keys [card ability targets] :as args}]
+      (system-msg state side (str "play ability"))
   (let [cdef (card-def card)
         abilities (:abilities cdef)
         ab (if (= ability (count abilities))
@@ -664,6 +674,10 @@
     (when (or (has? card :subtype "Virus") (= (:counter-type card) "Virus"))
       (set-prop state :runner card :counter 0)))
   (trigger-event state side :purge))
+
+(defn get-virus-counters [state side card]
+   (let [hiveminds (filter #(= (:title %) "Hivemind") (get-in @state [:runner :rig :program]))]
+        (reduce + (map :counter (cons card hiveminds)))))

 (defn play-instant
   ([state side card] (play-instant state side card nil))


Remove vestigial function.

Remove vestigial function.

--- clojure/src/advent2018/day5.clj
+++ clojure/src/advent2018/day5.clj
@@ -4,11 +4,6 @@
             [advent2018.core :refer [read-puzzle]]))

 (def puzzle (read-puzzle "day5" str/trim))
-
-(defn reacting-pair [^Character c]
-  (let [pair (str (Character/toLowerCase c)
-                  (Character/toUpperCase c))]
-    (format "%s|%s" pair (clojure.string/join (reverse pair)))))

 (def letters "abcdefghijklmnopqrstuvwxyz")


Use //# for inline source maps

Use //# for inline source maps

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -89,8 +89,8 @@
                  (let [js (comp/emit-str (ana/no-warn (ana/analyze env (wrap form))))
                        t (System/currentTimeMillis)]
                    (str js
-                        "\n//@ sourceURL=repl-" t ".js"
-                        "\n//@ sourceMappingURL=data:application/json;base64,"
+                        "\n//# sourceURL=repl-" t ".js"
+                        "\n//# sourceMappingURL=data:application/json;base64,"
                         (DatatypeConverter/printBase64Binary
                          (.getBytes
                           (sm/encode


Remove redundant io/file definition

Remove redundant io/file definition

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/cljparse/core.clj
+++ src/cljparse/core.clj
@@ -31,7 +31,7 @@
             (exit -1 (str "Configuration not found at " (:path options))))

       (println "Starting cljparse with path:" (:path options) "and errors:" errors)
-      (config/parser (io/file (:path options) configname)))))
+      (config/parser file))))


fix bad variable name

fix bad variable name

--- src/crucible/core.clj
+++ src/crucible/core.clj
@@ -18,9 +18,9 @@

 (defn join
   ([vals]
-   [:fn [:join {:delimiter "" :values v}]])
+   [:fn [:join {:delimiter "" :values vals}]])
   ([delimiter vals]
-   [:fn [:join {:delimiter delimiter :values v}]]))
+   [:fn [:join {:delimiter delimiter :values vals}]]))

 (defn select
   [i vals]


Update service-equiv tests for indices

Update service-equiv tests for indices

wrapped/unwrapped index are not equivalent.

--- test/riemann/index_test.clj
+++ test/riemann/index_test.clj
@@ -132,19 +132,17 @@
       (is (= nil (query-for-host-and-service ast))))))

 (deftest service-interface
-  (testing "service equivelance of indexes"
+  (testing "service equivalance of indexes"
     (let [one-index (index)
           two-index (index)]
       (is (service/equiv? one-index two-index))))

-  (testing "service equivelance of wrapped indexes"
+  (testing "service equivalance of wrapped indexes"
     (let [one-index (wrap-index (index))
           two-index (wrap-index (index))]
       (is (service/equiv? one-index two-index))))

-  (testing "service equivelance of wrapped to unwrapped index"
+  (testing "service equivalance of wrapped to unwrapped index"
     (let [one-index (wrap-index (index))
           two-index (index)]
-      (is (service/equiv? one-index two-index))))
-
-  )
+      (is (not (service/equiv? one-index two-index))))))


Always specify a cache for the benchmarks.

--- test/soy_clj/bench_test.clj
+++ test/soy_clj/bench_test.clj
@@ -11,24 +11,27 @@

 (deftest ^:bench parse-cached-bench
   (println "\n\n=== Parsing (cached)")
-  (soy/set-cache (cache/lru-cache-factory {}))
+  (soy/set-cache (cache/lu-cache-factory {}))
   (soy/parse "example.soy")
   (c/bench (soy/parse "example.soy")))

 (deftest ^:bench render-big-bench
   (println "\n\n=== Rendering (big list)")
+  (soy/set-cache (cache/lu-cache-factory {}))
   (let [templates (soy/parse "example.soy")
         data {:items (vec (map str (range 1 1000)))}]
     (c/bench (soy/render templates "examples.simple.list" data))))

 (deftest ^:bench render-small-bench
   (println "\n\n=== Rendering (small list)")
+  (soy/set-cache (cache/lu-cache-factory {}))
   (let [templates (soy/parse "example.soy")
         data {:items (vec (map str (range 1 50)))}]
     (c/bench (soy/render templates "examples.simple.list" data))))

 (deftest ^:bench render-simple-bench
   (println "\n\n=== Rendering (simple)")
+  (soy/set-cache (cache/lu-cache-factory {}))
   (let [templates (soy/parse "example.soy")
         data {:bar "bar"}]
     (c/bench (soy/render templates "examples.simple.basic" data))))


update

update

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -879,7 +879,7 @@
   (end [_] "Return the end of a span of time"))

 (extend-protocol ITimeSpan
-  clojure.lang.APersistentMap
+  #?(:clj clojure.lang.APersistentMap :cljs PersistentHashMap)
   (beginning [m] (:tick/beginning m))
   (end [m] (:tick/end m)))


Rename test

Rename test

--- src/test/cljc/mikron/runtime/core_test2.cljc
+++ src/test/cljc/mikron/runtime/core_test2.cljc
@@ -12,7 +12,7 @@
 (macrowbar/emit :debug-self-hosted
   (def buffer (mikron/allocate-buffer 100000))

-  (tc.test/defspec core-test 100
+  (tc.test/defspec core-test-property-based 100
     (tc.prop/for-all
       [[schema value]
        (tc.gen/bind


Whitespace

Whitespace

--- src/fink_nottle/sqs/channeled.cljc
+++ src/fink_nottle/sqs/channeled.cljc
@@ -43,7 +43,7 @@
         (when-let [exs (some->> failed vals (map failure->throwable) not-empty)]
           (<? (a/onto-chan error-chan exs false))))
       (catch #? (:clj Exception :cljs js/Error) e
-             (>! error-chan e)))))
+        (>! error-chan e)))))

 (defn- batch-cleanup! [issue-fn batch error-chan close?]
   (go-catching


Reserve `follow-ups` as a board slug name.

--- src/oc/storage/resources/board.clj
+++ src/oc/storage/resources/board.clj
@@ -68,7 +68,7 @@

 ;; ----- Board Slug -----

-(def reserved-slugs #{"create-board" "settings" "boards" "all-posts" "drafts" "must-see"})
+(def reserved-slugs #{"create-board" "settings" "boards" "all-posts" "drafts" "must-see" "follow-ups"})

 (declare list-boards-by-org)
 (defn taken-slugs