Revert "Fix undo issue"

Revert "Fix undo issue"

This reverts commit 1f410d94c4f7ea2d315b4d40237bde28bbee0c6c.

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -396,13 +396,11 @@
                          (.getKeyCode e))
               (mwm/update-cursor-position! edit-history (get-cursor-position text-area))

-              (and (or (.isControlDown e) (.isMetaDown e))
-                (= (.getKeyCode e) KeyEvent/VK_V))
-              (->> (get-parinfer-state text-area true)
-                   (refresh-content! text-area)
-                   (mwm/update-edit-history! edit-history))
-
-              :else
+              (not (or (contains? #{KeyEvent/VK_SHIFT KeyEvent/VK_CONTROL
+                                    KeyEvent/VK_ALT KeyEvent/VK_META}
+                                  (.getKeyCode e))
+                       (.isControlDown e)
+                       (.isMetaDown e)))
               (->> (cond
                      (= (.getKeyCode e) KeyEvent/VK_ENTER)
                      (get-normal-state text-area)
@@ -410,6 +408,12 @@
                      (get-indent-state text-area (.isShiftDown e))
                      :else
                      (get-parinfer-state text-area false))
+                   (refresh-content! text-area)
+                   (mwm/update-edit-history! edit-history))
+
+              (and (or (.isControlDown e) (.isMetaDown e))
+                (= (.getKeyCode e) KeyEvent/VK_V))
+              (->> (get-parinfer-state text-area true)
                    (refresh-content! text-area)
                    (mwm/update-edit-history! edit-history))))
           (keyTyped [this e] nil)


Show line after 80 characters and make tab 2 spaces in clojure files

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -144,7 +144,7 @@
                      "json" SyntaxConstants/SYNTAX_STYLE_NONE
                      "md" SyntaxConstants/SYNTAX_STYLE_NONE
                      "txt" SyntaxConstants/SYNTAX_STYLE_NONE})
-(def ^:const paredit-exts #{"clj" "cljs"})
+(def ^:const clojure-exts #{"clj" "cljs"})

 (defn get-extension
   [path]
@@ -158,14 +158,22 @@
   (or (get styles (get-extension path))
       SyntaxConstants/SYNTAX_STYLE_NONE))

+(defn get-text-area
+  []
+  (proxy [TextEditorPane] []
+    (setMarginLineEnabled [is-enabled?]
+      (proxy-super setMarginLineEnabled is-enabled?))
+    (setMarginLinePosition [size]
+      (proxy-super setMarginLinePosition size))))
+
 (defn create-editor
   [path]
   (when (and (.isFile (java.io/file path))
              (contains? styles (get-extension path)))
-    (let [text-area (if (contains? paredit-exts (get-extension path))
-                      (paredit/paredit-widget (TextEditorPane.))
-                      (TextEditorPane.))
-          text-area-scroll (RTextScrollPane. text-area)
+    (let [is-clojure? (contains? clojure-exts (get-extension path))
+          text-area (if is-clojure?
+                      (paredit/paredit-widget (get-text-area))
+                      (get-text-area))
           btn-group (utils/wrap-panel
                       :items [(s/button :id :save-button
                                         :text (utils/get-string :save)
@@ -192,25 +200,29 @@
                                       :listen [:key-released search])])
           text-group (s/border-panel
                        :north btn-group
-                       :center text-area-scroll)]
-      (shortcuts/create-mappings text-group
-                                 {:save-button save-file
-                                  :undo-button undo-file
-                                  :redo-button redo-file
-                                  :find-field focus-on-find
-                                  :font-enc-button increase-font-size
-                                  :font-dec-button decrease-font-size})
-      (shortcuts/create-hints text-group)
-      (update-buttons text-group text-area)
+                       :center (RTextScrollPane. text-area))]
+      (doto text-group
+        (shortcuts/create-mappings {:save-button save-file
+                                    :undo-button undo-file
+                                    :redo-button redo-file
+                                    :find-field focus-on-find
+                                    :font-enc-button increase-font-size
+                                    :font-dec-button decrease-font-size})
+        shortcuts/create-hints
+        (update-buttons text-area))
       (doto (TextPrompt. (utils/get-string :find)
                          (s/select text-group [:#find-field]))
         (.changeAlpha 0.5))
-      (.load text-area (FileLocation/create path) nil)
-      (.discardAllEdits text-area)
-      (.setAntiAliasingEnabled text-area true)
-      (s/listen text-area
-                :key-released
-                (fn [e] (update-buttons text-group text-area)))
+      (doto text-area
+        (.load (FileLocation/create path) nil)
+        .discardAllEdits
+        (.setAntiAliasingEnabled true)
+        (s/listen :key-released
+                  (fn [e] (update-buttons text-group text-area)))
+        (.setSyntaxEditingStyle (get-syntax-style path))
+        (.setMarginLineEnabled true)
+        (.setMarginLinePosition 80))
+      (when is-clojure? (.setTabSize text-area 2))
       (.addDocumentListener (.getDocument text-area)
                             (reify DocumentListener
                               (changedUpdate [this e]
@@ -219,7 +231,6 @@
                                 (update-buttons text-group text-area))
                               (removeUpdate [this e]
                                 (update-buttons text-group text-area))))
-      (.setSyntaxEditingStyle text-area (get-syntax-style path))
       (-> (java.io/resource "dark.xml")
           java.io/input-stream
           Theme/load


expose side-effect func (fetch-url) outside let

--- clojure/src/usedbooks_search/core.clj
+++ clojure/src/usedbooks_search/core.clj
@@ -70,10 +70,8 @@
 (defn select-total-nbooks [html]
   (html-select html [:span.ss_f_g_l]))

-(defn find-total-nbooks [q shop]
-  (let [url    (usedstore-url shop (encode-aladin-query q))
-        html   (fetch-url url)
-        result (first (:content (first (select-total-nbooks html))))]
+(defn parse-total-nbooks [html]
+  (let [result (first (:content (first (select-total-nbooks html))))]
     (if (nil? result)
       0
       result)))
@@ -82,9 +80,10 @@
   (println (str shop ": " (if (= result 0) "no books" result))))

 (defn search-total-nbooks [q shop after-search]
-  (after-search
-    (find-total-nbooks q shop)
-    shop))
+  (let [url (usedstore-url shop (encode-aladin-query q))]
+    (after-search
+      (parse-total-nbooks (fetch-url url))
+      shop)))

 (defn -main [& args]
   (if (= (count args) 0)


Added condition to return error when no content type.

--- src/cmr/opendap/http/response.clj
+++ src/cmr/opendap/http/response.clj
@@ -39,11 +39,15 @@
   [status headers body]
   (let [default-msg (format errors/msg-status-code status)
         ct (:content-type headers)]
-    (log/error default-msg)
     (log/trace "Headers:" headers)
     (log/trace "Content-Type:" ct)
     (log/trace "Body:" body)
-    (cond (string/starts-with? ct "application/xml")
+    (cond (nil? ct)
+          (do
+            (log/error body)
+            {:errors [body]})
+
+          (string/starts-with? ct "application/xml")
           (let [errs (xml-errors body)]
             (log/error errs)
             {:errors errs})


Limit debug hover info to 50 chars

Limit debug hover info to 50 chars

To avoid creating odd rendering bugs with horizontal scrollbars

--- src/day8/re_frame_10x/view/event.cljs
+++ src/day8/re_frame_10x/view/event.cljs
@@ -187,7 +187,7 @@
       [rc/v-box
        :size "1 1 auto"
        :class "code-panel"
-       :children [(when debug? [:pre "Hover " (pr-str @highlighted-form) "\n"])
+       :children [(when debug? [:pre "Hover " (subs (pr-str @highlighted-form) 0 50) "\n"])
                   [event-expression]
                   [rc/gap-f :size common/gs-19s]
                   [event-fragments (->> (:code code-execution)


allow exception messages to wrap in heads up display (#630)

--- support/src/figwheel/client/heads_up.cljs
+++ support/src/figwheel/client/heads_up.cljs
@@ -209,7 +209,7 @@
                                 ": ") "")
                         "" (escape message) "")
                    (when display-ex-data
-                     (str "
" (utils/pprint-to-string display-ex-data) "
"))
+                     (str "
" (utils/pprint-to-string display-ex-data) "
"))
                    (when (pos? (count error-inline))
                      (format-inline-error error-inline))]
                   (map #(str (escape (:class %))


remove hardcoded ip

remove hardcoded ip

--- src/devops_101_pipeline/steps.clj
+++ src/devops_101_pipeline/steps.clj
@@ -28,4 +28,4 @@

 (defn smoke-test [args ctx]
   (shell/bash ctx "/"
-              "while [ `curl --write-out %{http_code} --silent --output /dev/null http://192.34.62.217:8080/` != 200 ]; do echo waiting; sleep 1; done"))+              "while [ `curl --write-out %{http_code} --silent --output /dev/null http://app-server:8080/` != 200 ]; do echo waiting; sleep 1; done"))


Only warn when cli argspec is invalid (compatibility)

--- boot/core/src/boot/cli.clj
+++ boot/core/src/boot/cli.clj
@@ -172,7 +172,7 @@

 (defmacro ^:private assert
   [test fmt & args]
-  `(when-not ~test (throw (Exception. (apply format ~fmt (map pr-str [~@args]))))))
+  `(when-not ~test (util/warn (apply format ~fmt (map pr-str [~@args])))))

 (defn- assert-argspecs [argspecs]
   (let [split (->> argspecs (partition-by string?))
@@ -183,20 +183,20 @@
                    (reduce-kv #(if (< (count %3) 2) %1 (conj %1 %2)) []))]
     (doseq [[[short long optarg type & extra] [desc]] specs]
       (assert (and (not= 'h short) (not= 'help long))
-              "cli: the -h/--help option is reserved")
+              "cli: the -h/--help option is reserved\n")
       (assert ((some-fn nil? (every-pred symbol? #(= 1 (count (name %))))) short)
-              "cli: expected short option, got %s" short)
+              "cli: expected short option, got %s\n" short)
       (assert (symbol? long)
-              "cli: expected long option, got %s" long)
+              "cli: expected long option, got %s\n" long)
       (assert (nil? (seq extra))
-              "cli: option %s: expected description, got %s" long (first extra))
+              "cli: option %s: expected description, got %s\n" long (first extra))
       (assert (or (and type (symbol? optarg))
                   (#{'int 'bool} optarg))
-              "cli: option %s: expected optarg, got %s" long (or optarg desc))
+              "cli: option %s: expected optarg, got %s\n" long (or optarg desc))
       (assert (or (not type) (not= 'bool type))
-              "cli: option %s: flags should not have optargs, got %s" long optarg))
+              "cli: option %s: flags should not have optargs, got %s\n" long optarg))
     (assert (not (seq dupes))
-            (format "cli: options must be unique: %s" (string/join ", " dupes)))))
+            (format "cli: options must be unique: %s\n" (string/join ", " dupes)))))

 (defmacro clifn [& forms]
   (let [[doc argspecs & body]


qb:DimensionProperty and qb:AttributeProperty

--- src/grafter/rdf/ontologies/qb.clj
+++ src/grafter/rdf/ontologies/qb.clj
@@ -14,8 +14,10 @@
 (def qb:structure (qb "structure"))

 (def qb:dimension (qb "dimension"))
+(def qb:DimensionProperty (qb "DimensionProperty"))

 (def qb:attribute (qb "attribute"))
+(def qb:AttributeProperty (qb "AttributeProperty"))

 (def qb:measure (qb "measure"))
 (def qb:measureType (qb "measureType"))


Sketch treeterator and add key-len everywhere

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -303,7 +303,7 @@

 ;; NOTE iterators are not write-safe

-(deftype Iterator [max-keys ^:mutable node ^:mutable ix marked-nodes marked-ixes ^:mutable end?]
+(deftype Iterator [max-keys ^:mutable node ^:mutable ix marked-nodes marked-ixes ^:mutable end? key-len]
   Object
   (key [this]
        (when (false? end?)
@@ -376,11 +376,12 @@
   (loop [node (.-root tree)]
     (if (nil? (.-children node))
       (if (> (alength (.-keys node)) 0)
-        (Iterator. (.-max-keys tree) node 0 #js [] #js [] false)
-        (Iterator. (.-max-keys tree) node 0 #js [] #js [] true))
+        (Iterator. (.-max-keys tree) node 0 #js [] #js [] false (.-key-len tree))
+        (Iterator. (.-max-keys tree) node 0 #js [] #js [] true (.-key-len tree)))
       (recur (aget (.-children node) 0)))))

-(deftype Trieterator [iterator seek-key ^:mutable pinned-key ^:mutable pinned-key-ix ^:mutable moving-key-ix ^:mutable end?]
+;; trie view of a tree
+(deftype Trieterator [iterator seek-key ^:mutable pinned-key ^:mutable pinned-key-ix ^:mutable moving-key-ix ^:mutable end? key-len]
   Object
   (key [this]
        (aget (.key iterator) moving-key-ix))
@@ -420,11 +421,11 @@
   (reset [this]
          (.reset iterator)))

-(defn trieterator [tree]
-  (let [it (iterator tree)]
-    (Trieterator. it (least-key (.-key-len tree)) nil -1 0 (.-end? it))))
-
-(deftype Intersection [iterators ^:mutable end?]
+(defn trieterator [iterator]
+  (Trieterator. iterator (least-key (.-key-len iterator)) nil -1 0 (.-end? it) (.-key-len iterator)))
+
+;; works on trees
+(deftype Intersection [iterators ^:mutable end? key-len]
   Object
   (key [this]
        (when (false? end?)
@@ -452,29 +453,26 @@
             (set! end? true)
             (.search this 1)))))

-;; TODO treeterator (key-ix->needed? , key-ix->produced?)
-
 (defn intersection [iterators]
+  (assert (> (alength iterators) 0))
+  (assert (every? #(= (.-key-len (aget iterators 0)) (.-key-len %)) iterators))
   (if (> (alength iterators) 1)
     (if (some #(.-end? %) iterators)
       (Intersection. iterators true)
-      (let [intersection (Intersection. (into-array (sort-by #(.key %) key-compare iterators)) false)]
+      (let [intersection (Intersection. (into-array (sort-by #(.key %) key-compare iterators)) false (.-key-len (aget iterators 0)))]
         (.search intersection 0)
         intersection))
     (aget iterators 0)))

-(defn iter-seq [iterator]
-  (let [results #js []]
-    (while (false? (.-end? iterator))
-      (.push results (.key iterator))
-      (.next iterator))
-    results))
-
-(deftype Join [^:mutable key-ix iterators key-ix->intersection key-ix->iterator->present? ^:mutable end?]
+;; works on tries
+(deftype Join [^:mutable key-ix iterators key-ix->intersection key-ix->iterator->present? ^:mutable end? key-len]
   Object
   (key [this]
        (when (false? end?)
          (.key (aget key-ix->intersection key-ix))))
+  (val [this]
+       (when (false? end?)
+         (.val (aget key-ix->intersection key-ix))))
   (maintain [this]
             (set! end? (.-end? (aget key-ix->intersection key-ix))))
   (next [this]
@@ -505,34 +503,83 @@
             (.reset (aget iterators i))))
         (.maintain this))))

-(defn join [trees num-vars tree->vars]
+(defn join [iterators num-vars iterator->vars]
   (assert (> num-vars 0))
-  (dotimes [i (alength trees)]
-    (let [tree-vars (aget tree->vars i)]
-      (assert (== (alength tree-vars) (.key-len (aget trees i))))
-      (dotimes [j (alength tree-vars)]
-        (assert (< (aget tree-vars j) num-vars)))))
-  (let [iterators (amap trees i _ (iterator (aget trees i)))
-        var->trees #js []
-        var->tree->present? #js []
+  (dotimes [i (alength iterators)]
+    (let [iterator-vars (aget iterator->vars i)]
+      (assert (== (alength iterator-vars) (.key-len (aget iterators i))))
+      (dotimes [j (alength iterator-vars)]
+        (assert (< (aget iterator-vars j) num-vars)))))
+  (let [var->iterators #js []
+        var->iterator->present? #js []
         var->intersection #js []]
     (dotimes [i num-vars]
-      (.push var->trees #js [])
-      (let [tree->present? #js []]
-        (.push var->tree->present? tree->present?)
-        (dotimes [j (alength trees)]
-          (.push tree->present? false))))
-    (dotimes [tree (alength trees)]
-      (let [tree-vars (aget trees tree)]
-        (dotimes [j (alength tree-vars)]
-          (let [var (aget tree-vars j)]
-            (.push (aget var->trees var) tree)
-            (aset var->tree->present? var tree true)))))
+      (.push var->iterators #js [])
+      (let [iterator->present? #js []]
+        (.push var->iterator->present? iterator->present?)
+        (dotimes [j (alength iterators)]
+          (.push iterator->present? false))))
+    (dotimes [iterator (alength iterators)]
+      (let [iterator-vars (aget iterators iterator)]
+        (dotimes [j (alength iterator-vars)]
+          (let [var (aget iterator-vars j)]
+            (.push (aget var->iterators var) iterator)
+            (aset var->iterator->present? var iterator true)))))
     (dotimes [i num-vars]
-      (.push var->intersection i (intersection (aget var->trees i))))
-    (let [join (Join. 0 iterators var->intersection var->tree->present? false)]
+      (assert (> (alength (aget var->iterators i)) 0))
+      (.push var->intersection i (intersection (aget var->iterators i))))
+    (let [join (Join. 0 iterators var->intersection var->iterator->present? false num-vars)]
       (.maintain join)
       join)))
+
+;; tree view of a trie
+(deftype Treeterator [iterator key ^:mutable key-ix ^:mutable end? key-len]
+  Object
+  (key [this]
+       (when (false? end?)
+         (aclone key)))
+  (val [this]
+       (when (false? end?)
+         (.val iterator)))
+  (walk-up [this]
+           (loop []
+             (when (false? end?)
+               (if (.-end? iterator)
+                 (if (<= key-ix 0)
+                   (set! end? true)
+                   (do
+                     (set! key-ix (- key-ix 1))
+                     (.up iterator)
+                     (recur)))))))
+  (walk-down [this]
+             (loop []
+               (when (and (false? end?) (< key-ix (- (alength key) 1)))
+                 (do
+                   (set! key-ix (+ key-ix 1))
+                   (.down iterator)
+                   (aset key key-ix (.key iterator))))))
+  (next [this]
+        (.walk-up this)
+        (when (false? end?)
+          (.next iterator)
+          (if (false? (.-end? iterator))
+            (aset key key-ix (.key iterator))
+            (set! end? true)))
+        (.walk-down this))
+  (seek [this key]
+        (assert false "TODO")))
+
+(defn treeterator [iterator]
+  (let [treeterator (Treeterator. iterator (least-key (.-key-len iterator)) 0 (.-key-len iterator))]
+    (.walk-down treeterator)
+    treeterator))
+
+(defn iter-seq [iterator]
+  (let [results #js []]
+    (while (false? (.-end? iterator))
+      (.push results (.key iterator))
+      (.next iterator))
+    results))

 ;; TESTS


fix filter

fix filter

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -175,7 +175,7 @@
         from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
         bolt-spec (get-in bolt path :no-path)
         spec (unifyc spec bolt-spec)]
-    (log/trace (str "add-complement to bolt with bolt:["
+    (log/debug (str "add-complement at path: " path " to bolt with bolt:["
                     (if (map? bolt) (get-in bolt [:rule]))
                     " '" (morph bolt) "'"
                     "]"))
@@ -204,17 +204,16 @@
           (log/error (str "complement-candidate-lexemes is unexpectedly a map with keys:"
                           ( keys complement-candidate-lexemes))))
         (let [shuffled-candidate-lexical-complements complement-candidate-lexemes
-              complement-pre-check (fn [child parent]
-                                     (or true
+              complement-pre-check (fn [child parent path-to-child]
                                      (and (not (fail?
                                                 (unifyc (get-in child [:synsem :cat] :top)
-                                                        (get-in parent [:comp :synsem :cat] :top))))
+                                                        (get-in path-to-child [:synsem :cat] :top))))
                                           (not (fail?
                                                 (unifyc (get-in child [:synsem :subcat :1 :cat] :top)
-                                                        (get-in parent [:comp :synsem :subcat :1 :cat] :top)))))))
+                                                            (get-in path-to-child [:synsem :subcat :1 :cat] :top))))))
               filtered-lexical-complements
               (filter (fn [lexeme]
-                        (complement-pre-check lexeme bolt))
+                        (complement-pre-check lexeme bolt path))
                       shuffled-candidate-lexical-complements)
               debug (log/trace (str "shuffled size: " (count shuffled-candidate-lexical-complements)))
               debug (log/trace (str "filtered size: " (count filtered-lexical-complements)))


big optimization for LAST for small vectors (e.g. those used for mapentries)

--- src/clj/com/rpl/specter/impl.cljx
+++ src/clj/com/rpl/specter/impl.cljx
@@ -447,11 +447,22 @@
   (get-first [s])
   (get-last [s]))

+(defprotocol FastEmpty
+  (fast-empty? [s]))
+
 (defn- update-first-list [l afn]
   (cons (afn (first l)) (rest l)))

 (defn- update-last-list [l afn]
   (append (butlast l) (afn (last l))))
+
+#+clj
+(defn vec-count [^clojure.lang.PersistentVector v]
+  (.count v))
+
+#+cljs
+(defn vec-count [v]
+  (count v))

 (extend-protocol UpdateExtremes
   #+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector
@@ -460,8 +471,12 @@
       (assoc v 0 (afn val))
       ))
   (update-last [v afn]
-    (conj (pop v) (afn (peek v)))
-    )
+    (let [c (vec-count v)]
+      (case c
+        1 (let [[e] v] [(afn e)])
+        2 (let [[e1 e2] v] [e1 (afn e2)])
+        (conj (pop v) (afn (peek v)))
+      )))
   #+clj Object #+cljs default
   (update-first [l val]
     (update-first-list l val))
@@ -482,6 +497,16 @@
     (last s)
     ))

+
+(extend-protocol FastEmpty
+  #+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector
+  (fast-empty? [v]
+    (= 0 (vec-count v)))
+  #+clj Object #+cljs default
+  (fast-empty? [s]
+    (empty? s))
+  )
+
 (defn walk-until [pred on-match-fn structure]
   (if (pred structure)
     (on-match-fn structure)
@@ -617,10 +642,10 @@
 (extend-protocol p/Navigator
   PosNavigator
   (select* [this structure next-fn]
-    (if-not (empty? structure)
+    (if-not (fast-empty? structure)
       (next-fn ((.-getter this) structure))))
   (transform* [this structure next-fn]
-    (if (empty? structure)
+    (if (fast-empty? structure)
       structure
       ((.-updater this) structure next-fn))))


Added back lat and lon fields

Added back lat and lon fields

--- src/clj/forma/hadoop/jobs/cdm.clj
+++ src/clj/forma/hadoop/jobs/cdm.clj
@@ -84,7 +84,7 @@
   [src gadm-src nodata zoom tres tres-out start thresh]
   (let [epoch (date/datetime->period tres-out "2000-01-01")
         start-period (date/datetime->period tres start)]
-    (<- [?x ?y ?z ?p ?iso]
+    (<- [?x ?y ?z ?p ?iso ?lat ?lon]
         (src ?sres ?modh ?modv ?s ?l ?prob-series)
         (gadm-src ?sres ?modh ?modv ?s ?l _ ?gadm _ _ _)
         (gadm->iso ?gadm :> ?iso)


Fix Haarpsichord interaction with Domestic Sleepers.

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -62,7 +62,7 @@
    {:effect (effect (gain :credit 5 :bad-publicity 1))}

    "Haarpsichord Studios"
-   {:events {:pre-steal-cost {:req (req (pos? (or (:stole-agenda runner-reg) 0)))
+   {:events {:pre-steal-cost {:req (req (:stole-agenda runner-reg))
                               :effect (effect (prevent-steal))}}}

    "Haas-Bioroid: Engineering the Future"


get the actual file list

get the actual file list

a bit more useful than #object[[Ljava.lang.String; 0x652855c4 [Ljava.lang.String;@652855c4]

--- src/clj/runbld/vcs/middleware.clj
+++ src/clj/runbld/vcs/middleware.clj
@@ -35,7 +35,7 @@
         (debug/log msg
                    "CWD exists?" exists?
                    "Listing:" (if exists?
-                                (.list f)
+                                (vec (.list f))
                                 "N/A")
                    "Process opts:" (:process opts))
         (throw+


dont ask for compute scope at login (#1275)

--- src/cljs/main/broadfcui/auth.cljs
+++ src/cljs/main/broadfcui/auth.cljs
@@ -25,8 +25,7 @@
            scopes (string/join
                    " "
                    ["email" "profile"
-                    "https://www.googleapis.com/auth/devstorage.full_control"
-                    "https://www.googleapis.com/auth/compute"])
+                    "https://www.googleapis.com/auth/devstorage.full_control"])
            init-options (clj->js {:client_id (config/google-client-id) :scope scopes})
            auth2 (js/gapi.auth2.init init-options)]
        (gapi.signin2.render "sign-in-button" #js{:width 180 :height 40 :longtitle true :theme "dark"})


Fixed footer (in a very dumb way)

Fixed footer (in a very dumb way)

--- src/cljs/nonojure/puzzleview.cljs
+++ src/cljs/nonojure/puzzleview.cljs
@@ -78,11 +78,23 @@
                   (pad (dec offset) (dec offset) [:td.hide]))))))))

 (defn create-bottom [nums offset]
-  (let [data (map #(add-class-templ % " footer")
-                  (create-header nums offset))]
-    data
-    )
-  )
+  "Takes a vector of column numbers and offset. Returns template for table bottom."
+  (let [col-num (count nums)
+        longest (apply max (map count nums))
+        padded  (map #(pad % 0 (- longest (count %)) nil) nums)]
+    (into []
+      (for [row (range longest)]
+        (let [nums-col (map #(nth % row) padded)
+              tds  (map #(if % [:td {:class "num num-not-clicked"} %]
+                           [:td {:class "nothing"}])
+                     nums-col)]
+          (into [:tr {:class (cond (zero? row) "first footer"
+                               (= row (dec longest)) "last footer"
+                               :default "footer")}]
+            (-> (concat [[:td.hide.has-right]]
+                  (add-thick-class tds)
+                  [[:td.hide.has-left]])
+              (pad (dec offset) (dec offset) [:td.hide]))))))))

 (defn create-template [data]
   "Create a template for puzzle based on description"


Bottom and right numbers are not reversed

--- src/cljs/nonojure/puzzleview.cljs
+++ src/cljs/nonojure/puzzleview.cljs
@@ -20,47 +20,54 @@
 ;(def data {:left [[3 1] [3] [2] [1 1] [1 1]]
 ;           :top [[1 1] [1 3] [2] [1 2] [2]]})

-(defn pad-nils
+(defn pad-with
   "Given a sequence of numbers adds desired number of nils in the beginning, and to the end"
-  ([nums nil-num]
-    (let [ nils (take nil-num (cycle [nil]))]
-        (into (vec nils) nums)))
-  ([nums nil-beg nil-end]
-    (let [ nils-beg (take nil-beg (cycle [nil]))
-           nils-end (take nil-end (cycle [nil]))]
-        (-> (vec nils-beg)
+  ([el nums el-num]
+    (let [ els (take el-num (cycle [el]))]
+        (into (vec els) nums)))
+  ([el nums el-beg el-end]
+    (let [ els-beg (take el-beg (cycle [el]))
+           els-end (take el-end (cycle [el]))]
+        (-> (vec els-beg)
           (into nums)
-          (into nils-end)))))
+          (into els-end)))))

 (defn create-row [nums offset row-num row-length]
   "Takes a vector of row numbers, offset (assumed to be longer then row numbers vector),
   row number and row length. Returns template for nodes construction"
-  (let [ all-nums (pad-nils nums (- offset (count nums)))
-         num-tds (map #(if % [:td.num.num-not-clicked %] [:td.nothing]) all-nums)
+  (let [ num-tds (map (fn [n] [:td.num.num-not-clicked n]) nums)
+         pad-length (- offset (count nums))
+         num-tds-left (pad-with [:td.nothing] num-tds pad-length)
+         num-tds-right (pad-with [:td.nothing] num-tds 0 pad-length)
          cells (for [c (range row-length)] [(keyword (str "td#.cell.c" c ".r" row-num ".cell-not-clicked"))])]
     (-> [:tr]
-      (into num-tds)
+      (into num-tds-left)
       (into cells)
-      (into (reverse num-tds)))))
+      (into num-tds-right))))

 (defn create-header [nums offset]
   "Takes a vector of column numbers and offset. Returns template for table header."
   (let [col-num (count nums)
         longest (apply max (map count nums))
-        padded  (map #(pad-nils % (- longest (count %))) nums)]
+        padded  (map #(pad-with nil % (- longest (count %))) nums)]
     (into []
       (for [row (range longest)]
         (let [nums-col (map #(nth % row) padded)
-              padded (pad-nils nums-col offset offset)
+              padded (pad-with nil nums-col offset offset)
               tds (map #(if % [:td.num.num-not-clicked %] [:td.nothing]) padded)]
         (into [:tr] tds))))))

 (defn create-bottom [nums offset]
-  (let [data (create-header nums offset)]
-    (reverse data)
-    )
-  )
-
+  "Takes a vector of column numbers and offset. Returns template for table bottom."
+  (let [col-num (count nums)
+        longest (apply max (map count nums))
+        padded  (map #(pad-with nil % 0 (- longest (count %))) nums)]
+    (into []
+      (for [row (range longest)]
+        (let [nums-col (map #(nth % row) padded)
+              padded (pad-with nil nums-col offset offset)
+              tds (map #(if % [:td.num.num-not-clicked %] [:td.nothing]) padded)]
+          (into [:tr] tds))))))

 (defn create-template [data]
   "Create a template for puzzle based on description"
@@ -123,9 +130,7 @@
         (set! (.-oncontextmenu cell) (fn [evt] false)))
       (doseq [num nums]
         (set! (.-onmousedown num) #(num-click % num))
-        (set! (.-oncontextmenu num) (fn [evt] false)))
-
-    ))
+        (set! (.-oncontextmenu num) (fn [evt] false)))))

 (defn show [nono]
   (do


cleanup controller

cleanup controller

--- src/cljs/swarmpit/controller.cljs
+++ src/cljs/swarmpit/controller.cljs
@@ -64,9 +64,15 @@
 (defmethod dispatch :service-info
   [{:keys [route-params handler]}]
   (get (routes/path-for-backend :service route-params)
-       (fn [response]
-         (state/set-value {:handler handler
-                           :data    response} cursor))))
+       (fn [service]
+         (get (routes/path-for-backend :service-tasks route-params)
+              (fn [tasks]
+                (get (routes/path-for-backend :service-networks route-params)
+                     (fn [networks]
+                       (state/set-value {:handler handler
+                                         :data    {:service  service
+                                                   :tasks    tasks
+                                                   :networks networks}} cursor))))))))

 (defmethod dispatch :service-create-image
   [{:keys [handler]}]
@@ -81,36 +87,18 @@
 (defmethod dispatch :service-create-config
   [{:keys [handler]}]
   (let [params (keywordize-keys (query->map (query-string)))]
-    (get (routes/path-for-backend :networks)
-         (fn [networks]
-           (get (routes/path-for-backend :volumes)
-                (fn [volumes]
-                  (get (routes/path-for-backend :secrets)
-                       (fn [secrets]
-                         (get (routes/path-for-backend :placement)
-                              (fn [placement]
-                                (state/set-value {:handler handler
-                                                  :data    (assoc params
-                                                             :networks networks
-                                                             :volumes volumes
-                                                             :secrets secrets
-                                                             :placement placement)} cursor)))))))))))
+    (state/set-value {:handler handler
+                      :data    params} cursor)))

 (defmethod dispatch :service-edit
   [{:keys [route-params handler]}]
   (get (routes/path-for-backend :service route-params)
        (fn [service]
-         (get (routes/path-for-backend :volumes)
-              (fn [volumes]
-                (get (routes/path-for-backend :secrets)
-                     (fn [secrets]
-                       (get (routes/path-for-backend :placement)
-                            (fn [placement]
-                              (state/set-value {:handler handler
-                                                :data    {:service   service
-                                                          :volumes   volumes
-                                                          :secrets   secrets
-                                                          :placement placement}} cursor))))))))))
+         (get (routes/path-for-backend :service-networks route-params)
+              (fn [networks]
+                (state/set-value {:handler handler
+                                  :data    {:service  service
+                                            :networks networks}} cursor))))))

 ;;; Network controller


Better handling of upsert condition.

Better handling of upsert condition.

--- src/clojure/staircase/handler.clj
+++ src/clojure/staircase/handler.clj
@@ -231,8 +231,11 @@
   (let [ensure-token (fn [service] (if (:token service)
                                      service
                                      (let [token (register-for service)
-                                           id (create services {:root (:root service) :token token})]
-                                       (merge service (get-one services id)))))
+                                           current (first (get-where services [:= :root (:root service)]))
+                                           canon (if current
+                                                  (update services (:id current) {:token token})
+                                                  (get-one services (create services {:root (:root service) :token token})))]
+                                       (merge service canon))))
         real-id #(if (= "default" %) (:default-service config) %)]
     (routes ;; Routes for getting service information.
             (GET "/" []


Add slot-window example

Add slot-window example

--- rules/mysql/query.clj
+++ rules/mysql/query.clj
@@ -16,7 +16,16 @@
          :user "user_for_monitor"
          :password "Secret!IMeanIt!"
          :database "awesome_app"
-         :sql "SELECT count(*) FROM user WHERE bad = 1"}))
+         :sql "SELECT count(*) FROM user WHERE bad = 1"})
+
+      (plugin-metric "mysql.query" 60
+        {:name "total-user-count"
+         :host "localhost"
+         :port 3306
+         :user "user_for_monitor"
+         :password "Secret!IMeanIt!"
+         :database "awesome_app"
+         :sql "SELECT count(*) FROM user"})))

     (where (service "mysql.query.bad-user-count")
       (set-state (> 50)
@@ -24,4 +33,18 @@
           (should-alarm-every 300
             (! {:note "坏用户太多了！"
                 :level 3
-                :groups [:operation]})))))))
+                :groups [:operation]}))))
+
+    (where (service #"^mysql\.query\..*-user-count$")
+      (slot-window :service {:total "mysql.query.total-user-count",
+                             :bad   "mysql.query.bad-user-count"}
+        (slot-coalesce :total {:service "app.sms.bad-user-percent",
+                               :metric (if (> bad 5) (/ bad total) -1)
+                               :bad-users bad
+                               :total-users total}
+          (set-state (> 0.5)
+            (runs 2 :state
+              (should-alarm-every 300
+                (! {:note "坏用户占比过高！"
+                    :level 3
+                    :groups [:operation]})))))))))


event entry loose spec

event entry loose spec

--- src/com/wsscode/pathom/trace.cljc
+++ src/com/wsscode/pathom/trace.cljc
@@ -14,7 +14,7 @@
 (>def ::relative-timestamp nat-int?)
 (>def ::duration nat-int?)
 (>def ::style "Map with CSS styles to apply in the trace bar." map?)
-(>def ::event-entry (s/keys :req [::event] :opt [::label ::style]))
+(>def ::event-entry (s/keys :opt [::event ::label ::style]))
 (>def ::details (s/coll-of ::event-entry :kind vector?))
 (>def ::trace* "Atom with ::details." any?)


Switch from clojars.mobile... to clojars.brislabs.com

--- src/leiningen/new/cljskel/project.clj
+++ src/leiningen/new/cljskel/project.clj
@@ -56,7 +56,7 @@
                    :integration :integration}

   :lein-release {:release-tasks [:clean :uberjar :pom :rpm]
-                 :clojars-url "clojars@clojars.mobile.lnx.nokia.com:"}
+                 :clojars-url "clojars@clojars.brislabs.com:"}

   :ring {:handler {{name}}.web/app
          :main {{name}}.web
@@ -64,7 +64,7 @@
          :init {{name}}.setup/setup}

   :repositories {"internal-clojars"
-                 "http://clojars.mobile.lnx.nokia.com/repo"
+                 "http://clojars.brislabs.com/repo"
                  "rm.brislabs.com"
                  "http://rm.brislabs.com/nexus/content/groups/all-releases"}


Change default phrase to a shorter one.

Change default phrase to a shorter one.

--- src/cadence/model.clj
+++ src/cadence/model.clj
@@ -31,4 +31,4 @@
 (def identity #(get friend/*identity* :current))

 (defn get-phrase []
-  "passwords are so completely last decade")
+  "completing this phrase is fun")


fixing tests

fixing tests

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -67,21 +67,24 @@
          (generate-response {:msg "submitted staging" :host host}))

   (POST- "/job/create/:host" [^:string host] {:nickname "createMachine" :summary "Machine creation job"}
-         (let [[id t] (jobs/enqueue "machine" {:identity host :args [(p/host host)]})]
-           (generate-response {:msg "submited system creation" :host host :id id :total t})))
+         (generate-response
+           {:msg "submited system creation" :host host
+            :job (jobs/enqueue "machine" {:identity host :args [(p/host host)]})}))

   (POST- "/job/provision/:host" [^:string host] {:nickname "provisionHost" :summary "provisioning job"}
-         (let [machine (p/host host) type (p/type-of (:type machine))
-               [id t] (jobs/enqueue "provision" {:identity host :args [type machine]})]
+         (let [machine (p/host host) type (p/type-of (:type machine)) ]
            (generate-response
-             {:msg "submitted provisioning" :host host :machine machine :type type :id id :total t})))
+             {:msg "submitted provisioning" :host host :machine machine :type type
+              :job (jobs/enqueue "provision" {:identity host :args [type machine]})})))

   (GET- "/job/:queue/:uuid/status" [^:string queue ^:string uuid]
         {:nickname "jobStatus" :summary "job status tracking"
          :notes "job status can be pending, processing, done or nil"}
-        (generate-response {:job-status  (jobs/status queue uuid)}))
+        (generate-response {:job-status (jobs/status queue uuid)}))

   )
+
+(jobs/status "machine" "2a340dcb-17af-41e0-afbd-561c2a81ec25" )

 (defroutes- hosts {:path "/host" :description "Operations on hosts"}
   (GET- "/host/machine/:host" [^:string host] {:nickname "getHostMachine" :summary "Get Host machine"}


Updating version to 1.63.4-SNAPSHOT

Updating version to 1.63.4-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.63.4"
+(defproject cook "1.63.5-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.10.3"]


Have extend-type emit fn (and not fn*) forms for protocol fns, refs #141

This makes it possible to use destructuring in protocol function
parameter lists.

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -224,7 +224,7 @@
                                  pfn-prefix (subs (str psym) 0 (clojure.core/inc (.lastIndexOf (str psym) ".")))]
                              (cons `(aset ~psym ~t true)
                                    (map (fn [[f & meths]]
-                                          `(aset ~(symbol (str pfn-prefix f)) ~t (fn* ~@meths)))
+                                          `(aset ~(symbol (str pfn-prefix f)) ~t (fn ~@meths)))
                                         sigs))))]
         `(do ~@(mapcat assign-impls impl-map)))
       (let [t (resolve tsym)
@@ -238,7 +238,7 @@
                                                       (list (with-meta (vec args) (meta sig))
                                                             (list* 'this-as tname body))))]
                                  (map (fn [[f & meths]]
-                                        `(set! ~(symbol (str prototype-prefix f)) (fn* ~@(map adapt-params meths))))
+                                        `(set! ~(symbol (str prototype-prefix f)) (fn ~@(map adapt-params meths))))
                                       sigs))
                                (cons `(set! ~(symbol (str prototype-prefix pprefix)) true)
                                      (map (fn [[f & meths]]
@@ -253,7 +253,7 @@
                                                   meths (if ifn?
                                                           (map adapt-params meths)
                                                           meths)]
-                                              `(set! ~(symbol pf) (fn* ~@meths))))
+                                              `(set! ~(symbol pf) (fn ~@meths))))
                                           sigs)))))]
         `(do ~@(mapcat assign-impls impl-map))))))


CLJS-914: thrown-with-msg? is unable to get message of exception

--- src/clj/cljs/test.clj
+++ src/clj/cljs/test.clj
@@ -121,7 +121,7 @@
        ~@body
        (cljs.test/do-report {:type :fail, :message ~msg, :expected '~form, :actual nil})
        (catch ~klass e#
-         (let [m# (.getMessage e#)]
+         (let [m# (.-message e#)]
            (if (re-find ~re m#)
              (cljs.test/do-report
                {:type :pass, :message ~msg,


add enforce-msg for display of card enforcement notifications

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -14,12 +14,21 @@
   (when-let [title (:title card)]
     (cards (.replace title "'" ""))))

+;Detect special card conditions from the card definition
+;These definitions are intended to remain immutable, and should be used
+;for things like Architect being untrashable while installed (i.e. conditions inherent to the card).
+;TODO: add a register for mutable state card flags, separate from this
+(defn flag? [card flag value]
+  (let [cdef (card-def card)]
+    (= value (get-in cdef [:flags flag]))
+    ))
+
 (declare parse-command)

 (defn say [state side {:keys [user text]}]
   (let [author (or user (get-in @state [side :user]))]
     (if-let [command (parse-command text)]
-      (when (not= side :spectator)
+      (when (and (not= side nil) (not= side :spectator))
         (do (command state side)
             (swap! state update-in [:log] #(conj % {:user nil :text (str "[!]" (:username author) " uses a command: " text)}))))
       (swap! state update-in [:log] #(conj % {:user author :text text})))))
@@ -29,6 +38,10 @@
   ([state side text {:keys [hr]}]
    (let [username (get-in @state [side :user :username])]
     (say state side {:user "__system__" :text (str username " " text "." (when hr "[hr]"))}))))
+
+(defn enforce-msg [state card text]
+  (say state nil {:user (get-in card [:title]) :text (str (:title card) " " text ".")})
+  )

 (declare prompt! forfeit trigger-event handle-end-run trash update-advancement-cost update-all-advancement-costs
          update! get-card update-all-ice update-ice-strength update-breaker-strength all-installed resolve-steal-events)


Fix trashing abilities :yes-ability map

Fix trashing abilities :yes-ability map

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -869,10 +869,10 @@
               (if-let [trash-cost (trash-cost state side c)]
                 (let [card (assoc c :seen true)]
                   (optional-ability state :runner card (str "Pay " trash-cost "[Credits] to trash " name "?")
-                                    {:cost [:credit trash-cost]
-                                     :effect (effect (trash card)
-                                                     (system-msg (str "pays " trash-cost " [Credits] to trash "
-                                                                      (:title card))))} nil))
+                                    {:yes-ability {:cost [:credit trash-cost]
+                                                   :effect (effect (trash card)
+                                                                   (system-msg (str "pays " trash-cost " [Credits] to trash "
+                                                                                (:title card))))}} nil))
                 (prompt! state :runner c (str "You accessed " (:title c)) ["OK"] {})))))))))

 (defn max-access [state side n]


Refactor io/rmdir-r function.

Refactor io/rmdir-r function.

--- src/clj/runbld/io.clj
+++ src/clj/runbld/io.clj
@@ -47,27 +47,12 @@
     res))

 (defn rmdir-r [dir]
-  (let [f (fn [[x & xs]]
-            (when x
-              (cond
-                ;; Leaf (file or empty directory)
-                (or (.isFile x)
-                    (and (.isDirectory x)
-                         (zero? (count (.listFiles x)))))
-                (do
-                  (when (windows?)
-                    (System/gc)
-                    (.setWritable x true))
-                  (again/with-retries [100 500 500]
-                    (jio/delete-file x))
-                  (recur xs))
-
-                ;; Node (non-empty directory)
-                (and (.isDirectory x)
-                     (pos? (count (.listFiles x))))
-                (recur
-                 (concat (.listFiles x) [x] xs)))))]
-    (f [(jio/file dir)])))
+  (let [listing (->> dir
+                     jio/file
+                     file-seq
+                     reverse)]
+    (doseq [f listing]
+      (jio/delete-file f))))

 (defn mkdir-p [dir]
   (.mkdirs (jio/file dir)))


Add admin group verification tool

Add admin group verification tool

--- src/clojars/admin.clj
+++ src/clojars/admin.clj
@@ -1,14 +1,17 @@
 (ns clojars.admin
-  (:require [clojars
-             [config :refer [config]]
-             [db :as db]
-             [file-utils :as fu]
-             [search :as search]
-             [storage :as storage]]
-            [clojure.java.io :as io]
-            [clojure.string :as str]
-            [clojure.tools.nrepl.server :as nrepl])
-  (:import java.text.SimpleDateFormat))
+  (:require
+   [clojars.config :refer [config]]
+   [clojars.db :as db]
+   [clojars.file-utils :as fu]
+   [clojars.search :as search]
+   [clojars.storage :as storage]
+   [clojure.java.io :as io]
+   [clojure.java.shell :as shell]
+   [clojure.pprint :refer [pprint]]
+   [clojure.string :as str]
+   [clojure.tools.nrepl.server :as nrepl])
+  (:import
+   java.text.SimpleDateFormat))

 (defn current-date-str []
   (.format (SimpleDateFormat. "yyyyMMdd") (db/get-time)))
@@ -19,22 +22,22 @@

 (defn backup-dir [base-dir path]
   (io/file base-dir
-    (str/join "-" (conj (vec (str/split path #"/"))
-                    (current-date-str)))))
+           (str/join "-" (conj (vec (str/split path #"/"))
+                               (current-date-str)))))

 (defn path->backup [path storage base-backup-dir]
   (let [ts-dir (backup-dir base-backup-dir path)]
     (run!
-      (fn [p]
-        (try
-          (let [url (storage/artifact-url storage p)
-                dest (io/file ts-dir p)]
-            (.mkdirs (.getParentFile dest))
-            (with-open [in (.openStream url)]
-              (io/copy in dest)))
-          (catch Exception e
-            (printf "WARNING: failed to backup %s: %s\n" p (.getMessage e)))))
-      (storage/path-seq storage path))))
+     (fn [p]
+       (try
+         (let [url (storage/artifact-url storage p)
+               dest (io/file ts-dir p)]
+           (.mkdirs (.getParentFile dest))
+           (with-open [in (.openStream url)]
+             (io/copy in dest)))
+         (catch Exception e
+           (printf "WARNING: failed to backup %s: %s\n" p (.getMessage e)))))
+     (storage/path-seq storage path))))

 (defn segments->path [segments]
   (let [[group & rest] (remove nil? segments)]
@@ -42,13 +45,13 @@

 (defn help []
   (println
-    (str/join "\n"
-      ["Admin functions - each function below returns a fn that does the actual work,"
-       "and makes a backup copy of the dir before removal:"
-       ""
-       "* (delete-group [group-id]) - deletes a group and all of the jars in it"
-       "* (delete-jars [group-id jar-id & [version]]) - deletes a jar, all versions"
-       "     if no version is provided"])))
+   (str/join "\n"
+             ["Admin functions - each function below returns a fn that does the actual work,"
+              "and makes a backup copy of the dir before removal:"
+              ""
+              "* (delete-group [group-id]) - deletes a group and all of the jars in it"
+              "* (delete-jars [group-id jar-id & [version]]) - deletes a jar, all versions"
+              "     if no version is provided"])))

 (defn delete-group [group-id]
   (if (seq (db/group-activenames *db* group-id))
@@ -72,7 +75,7 @@
       (do
         (println "Giving you a fn to delete jars that match" pretty-coords)
         (when-not
-            (and description (re-find #"(?i)delete me" description))
+         (and description (re-find #"(?i)delete me" description))
           (println "WARNING: jar description not set to 'delete me':" description))
         (fn []
           (println "Deleting" pretty-coords)
@@ -109,6 +112,62 @@
         (db/verify-group! *db* username group-name)
         (db/find-group-verification *db* group-name)))))

+(defn- get-txt-records
+  [domain]
+  (-> (shell/sh "dig" "txt" "+short" domain)
+      :out
+      (str/replace "\"" "")
+      (str/split #"\n")))
+
+(defn- confirm-and-verify-group
+  [username group]
+  (printf "Do you want to verify %s for %s? [y/N] " group username)
+  (let [res (read-line)]
+    (if (= res "y")
+      (do
+        (verify-group! username group)
+        (printf "\nGroup verified: https://clojars.org/groups/%s\n" group))
+      (println "\nGroup not verified."))))
+
+(defn check-and-verify-group!
+  [group domain]
+  (let [txt (get-txt-records domain)]
+    (printf "TXT records for %s:\n" domain)
+    (pprint txt)
+    (if-some [[_ username] (some #(re-find #"^clojars (.+)$" %) txt)]
+      (let [group-active-members (seq (db/group-activenames *db* group))
+            group-verification (db/find-group-verification *db* group)
+            user-record (db/find-user *db* username)]
+        (printf "Found username %s\n" username)
+        (cond
+          (nil? user-record)
+          (printf "User %s does not exist.\n" username)
+
+          group-verification
+          (do
+            (println "Group is already verified:")
+            (pprint group-verification))
+
+          (nil? group-active-members)
+          (do
+            (println "Group does not exist.")
+            (confirm-and-verify-group username group))
+
+          (contains? (set group-active-members) username)
+          (do
+            (println "Group exists. Active members:")
+            (pprint group-active-members)
+            (println "User is an active member of the group.")
+            (confirm-and-verify-group username group))
+
+          :else
+          (do
+            (println "Group exists. Active members:")
+            (pprint group-active-members)
+            (println "User is an active member of the group.")
+            (println "User is *not* an active member of the group."))))
+      (println "Clojars TXT record not found."))))
+
 (defn handler [mapping]
   (nrepl/default-handler
     (with-meta


Getting rid of jcollider dependency.

Getting rid of jcollider dependency.

--- test/synthdef_test.clj
+++ test/synthdef_test.clj
@@ -30,22 +30,6 @@
                 :special (short 0), :n-outputs (short 0), :n-inputs (short 2), :rate (byte 2), :name "Out"}]
    :n-variants (short 0)
    :variants []})
-
-(defn jc-load-file [path]
-  (de.sciss.jcollider.SynthDef/readDefFile (java.net.URL. (str "file:" path))))
-
-(defn dia-file [path]
-  (de.sciss.jcollider.gui.SynthDefDiagram.
-    (first (jc-load-file path))))
-
-(defn jc-load [sdef]
- (de.sciss.jcollider.SynthDef/readDefFile
-             (-> (synthdef-bytes sdef) (ByteArrayInputStream.)
-               (BufferedInputStream.) (DataInputStream.))))
-
-(defn dia [sdef]
-  (de.sciss.jcollider.gui.SynthDefDiagram.
-    (first (jc-load sdef))))

 (deftest self-consistent-syndef
   (let [a (sawzall-raw)


Add support for two players.

Add support for two players.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -59,11 +59,12 @@

-(defn prepare-edge [locations world-state [start end color :as edge]]
+(defn prepare-edge [locations world-state [start end color player :as edge]]
   [(locations start)
    (locations end)
    color
-   (ok-to-flip? world-state edge)])
+   (ok-to-flip? world-state edge)
+   player])

@@ -114,9 +115,9 @@
                                          (:selected world-state))])))

-(defn flip-edge [world-state [from to color :as edge]]
+(defn flip-edge [world-state [from to color player :as edge]]
   (if (ok-to-flip? world-state edge)
-    [to from color]
+    [to from color player]
     edge))

 (defn toggle-editing [world-state]


slightly safer externs inference for js/... for CLJS namespaces

--- src/main/shadow/build/cljs_hacks.cljc
+++ src/main/shadow/build/cljs_hacks.cljc
@@ -156,16 +156,25 @@
                  (let [[global & props]
                        (str/split (name sym) #"\.")]

-                   ;; do not record access to
+                   ;; do not record access to known namespace roots
                    ;; js/goog.string.format
                    ;; js/cljs.core.assoc
                    ;; just in case someone does that, we won't need externs for those
-                   (when-not (contains? known-safe-js-globals global)
-                     (shadow-js-access-global current-ns global)
-                     (when (seq props)
-                       (doseq [prop props]
-                         (shadow-js-access-property current-ns prop))))))
-
+                   (let [ns-roots (:shadow/ns-roots @env/*compiler*)]
+                     (when-not (or (contains? ns-roots global)
+                                   ;; just in case ns-roots wasn't set properly
+                                   (contains? known-safe-js-globals global))
+                       (shadow-js-access-global current-ns global)
+                       (when (seq props)
+                         (doseq [prop props]
+                           (shadow-js-access-property current-ns prop)))))))
+
+               ;; FIXME: exists? ends up here since it will check all segments
+               ;; (defonce PROTOCOL-SENTINEL ...)
+               ;; js/cljs
+               ;; js/cljs.core
+               ;; js/cljs.core.PROTOCOL-SENTINEL
+               ;; they don't leak into the code but should technically not return :js-var for those?
                {:op :js-var
                 :name sym
                 :ns 'js
@@ -306,11 +315,13 @@

 (defn shadow-resolve-var-checked
   ([env sym]
-   {:post [(contains? % :op)]}
-   (shadow-resolve-var env sym nil))
+   (shadow-resolve-var-checked env sym nil))
   ([env sym confirm]
-   {:post [(contains? % :op)]}
-   (shadow-resolve-var env sym confirm)))
+   (let [info (shadow-resolve-var env sym confirm)]
+     (when-not (:op info)
+       (throw (ex-info "missing op" {:sym sym})))
+     info
+     )))

 (defn infer-externs-dot
   [{:keys [form form-meta method field target-tag env prop tag] :as ast}


Three tests for the function string/contains

--- test/zg/utils_test.clj
+++ test/zg/utils_test.clj
@@ -221,3 +221,28 @@
         (is (thrown? NullPointerException (contains "" nil)))
         (is (thrown? NullPointerException (contains nil nil)))))

+(deftest test-starts-with-1
+    "Check the function zg.utils/starts-with."
+    (testing "the function zg.utils/starts-with."
+        (are [x y] (= x y)
+            false (startsWith "Hello world!" "hello")
+            true  (startsWith "Hello world!" "Hello")
+            true  (startsWith "Hello world!" "H")
+            true  (startsWith "Hello world!" ""))))
+
+(deftest test-starts-with-2
+    "Check the function zg.utils/starts-with."
+    (testing "the function zg.utils/starts-with."
+        (are [x y] (= x y)
+            false (startsWith "" "hello")
+            false (startsWith "" "Hello")
+            false (startsWith "" "H")
+            true  (startsWith "" ""))))
+
+(deftest test-starts-with-NPE
+    "Check the function zg.utils/starts-with."
+    (testing "the function zg.utils/starts-with."
+        (is (thrown? NullPointerException (startsWith nil nil)))
+        (is (thrown? NullPointerException (startsWith "text" nil)))
+        (is (thrown? NullPointerException (startsWith nil "text")))))
+


fixed null exception

fixed null exception

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -305,16 +305,17 @@

   ([queue visited to-eliminate leaf-paths]
      (if (seq queue)
-      (do
+       (do
         (Thread/sleep 2000)
         (println :url (-> queue first :url))
-        (println :src-ulr (-> queue first :src-url))
+        (println :src-url (-> queue first :src-url))
         (println :src-xpath (-> queue first :src-xpath))
         (println :score-seq (-> queue first :src-nav-num))
         (let [url     (-> queue first :url)
               src-xp  (-> queue first :src-xpath)
               src-nav-num (-> queue first :src-nav-num)
-              body    (download-with-cookie url)
+              body    (utils/download-with-cookie url)
+

               ;; ask the rich extractor to sample and extract on this page.
               content    (try (rich-char-extractor/state-action
@@ -323,8 +324,9 @@
                                                       (set [url])
                                                       (set (map :url queue))))
                               (catch Exception e nil))
-
-              score   (cur-nav-fraction body content)
+
+              score   (try (cur-nav-fraction body content)
+                           (catch Exception e nil))

               leaf?      (or (not body)
                              (rich-char-extractor/leaf?
@@ -341,25 +343,30 @@
               mined      (when-not leaf?
                            (rich-char-extractor/filter-content
                             content))
-              mined-links (reverse
-                           (filter
-                            #(and (-> % :url)
-                                  (not (some #{(-> % :url)} (clojure.set/union
-                                                             (set visited)
-                                                             (set [url])
-                                                             (set (map (fn [x] (:url x)) queue))))))
-                            (reduce
-                             concat
-                             (map
-                              (fn [{xpath :xpath score :score hrefs :hrefs text :texts}]
-                                (map
-                                 (fn [h]
-                                   {:url h
-                                    :src-xpath (cons xpath src-xp)
-                                    :src-url url
-                                    :src-nav-num (cons (if body score 0) src-nav-num)})
-                                 hrefs))
-                              mined))))]
+              mined-links (try
+                           (reverse
+                            (filter
+                             #(and (-> % :url)
+                                   (not (some #{(-> % :url)} (clojure.set/union
+                                                              (set visited)
+                                                              (set [url])
+                                                              (set (map (fn [x] (:url x)) queue))))))
+                             (reduce
+                              concat
+                              (map
+                               (fn [{xpath :xpath score :score hrefs :hrefs text :texts}]
+                                 ;; take only a 25 % sample from here.
+                                 (take
+                                  (Math/ceil (/ (count hrefs) 4))
+                                  (map
+                                   (fn [h]
+                                     {:url h
+                                      :src-xpath (cons xpath src-xp)
+                                      :src-url url
+                                      :src-nav-num (cons (if body score 0) src-nav-num)})
+                                   hrefs)))
+                               mined))))
+                           (catch Exception e []))]
           (if (and (not leaf?) (seq mined-links))
             (recur (concat (rest queue)
                            mined-links)
@@ -372,8 +379,7 @@
              (clojure.set/union visited (set [url]))
              to-eliminate
              (cons
-              (cons {:content nil}
-                    src-xp)
+              nil
               leaf-paths)))))
       (frequencies leaf-paths))))


project file reading debugged

project file reading debugged


select -> update

select -> update

scharfschalten von update


Added default file event subscribers.

Added default file event subscribers.

--- src/dragon/event/subscription.clj
+++ src/dragon/event/subscription.clj
@@ -39,6 +39,10 @@
    tag/write-output-post [:default]
    tag/generate-routes-pre [:default]
    tag/generate-routes-post [:default]
+   tag/file-change [:default]
+   tag/file-create [:default]
+   tag/file-modify [:default]
+   tag/file-delete [:default]
    tag/shutdown-cli [shutdown-subscriber]})

 (defn subscribe-all-event
@@ -55,7 +59,6 @@
 (defn subscribe-all
   ""
   [system-or-component]
-  (log/debug "Adding subscribers ...")
   (let [system (util/component->system system-or-component)]
     (doseq [[event-type subscriber-funcs] subscribers]
       (subscribe-all-event system


Small refactoring.

Small refactoring.

--- src/decl_ui/core.cljs
+++ src/decl_ui/core.cljs
@@ -14,8 +14,8 @@
   []
   @ui-root)

-(defn load-ui [cell-def ui-def helpers callbacks]
-  (reset! ui-root (compile-ui {:title (atom "This is title") :results (atom ["result1" "result2"])}
+(defn load-ui [globals cell-def ui-def helpers callbacks]
+  (reset! ui-root (compile-ui globals
                               cell-def
                               ui-def
                               helpers
@@ -28,11 +28,10 @@

   (compile/instantiate-cells {:title (atom "This is title")}
                              "{:text \"Click me\" :pressed 0 :x #bind :title}")
-
-  (load-ui "{:text \"Click me\"
+  (load-ui {:title (atom "This is title") :results (atom ["result1" "result2"])} "{:text \"Click me\"
            :pressed 0
            :x #bind :title}"
-           "[:div [:button {:on-click ui/handle-click} #bind :text]
+           "[:div [:button#click {:on-click ui/handle-click} #bind :text]
               [:div \"Change text\"]
               [:ui/input #= :text]
               [:ui/special-div]


Fix CLI issue.

Fix CLI issue.

--- src/open_company/util/sample_data.clj
+++ src/open_company/util/sample_data.clj
@@ -8,6 +8,10 @@
             [open-company.resources.company :as company]
             [open-company.resources.section :as section])
   (:gen-class))
+
+(defn exit [status msg]
+  (println msg)
+  (System/exit status))

 ;; ----- Sections import -----

@@ -77,10 +81,6 @@
   (str "The following errors occurred while parsing your command:\n\n"
        (s/join \newline errors)))

-(defn exit [status msg]
-  (println msg)
-  (System/exit status))
-
 (defn -main [& args]
   (pool/start)
   (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]


Made the schedule classes required on-demand

--- src/eddy/schedule.clj
+++ src/eddy/schedule.clj
@@ -1,8 +1,7 @@
 (ns eddy.schedule
   (:require [clojurewerkz.quartzite.scheduler :as quartzite]
             [clojurewerkz.quartzite.jobs :as jobs]
-            [clojurewerkz.quartzite.triggers :as triggers]
-            [clojurewerkz.quartzite.schedule.calendar-interval]))
+            [clojurewerkz.quartzite.triggers :as triggers]))

 (defmacro job [job-type key]
   `(jobs/build
@@ -10,11 +9,13 @@
     (jobs/with-identity (jobs/key ~key))))

 (defn interval-class [interval-key]
-  (str
-   "clojurewerkz.quartzite.schedule."
-   (case interval-key
-     :every "calendar-interval"
-     (throw (IllegalArgumentException. "Interval syntax invalid")))))
+  (let [namespace (str
+                   "clojurewerkz.quartzite.schedule."
+                   (case interval-key
+                     :every "calendar-interval"
+                     (throw (IllegalArgumentException. "Interval syntax invalid"))))]
+    (require (symbol namespace))
+    namespace))

 (defn calendar-interval-function [unit]
   (case (str unit)


Some styling

Some styling

--- src/hundred_pushups/ios/core.cljs
+++ src/hundred_pushups/ios/core.cljs
@@ -179,9 +179,9 @@
      [invalid-stage])])

 (defn dev-menu []
-  [view {:style {:flex 1}}
+  [view {:style {:flex 1 :padding-bottom 20}}
    [text {:style (-> styles :section)} "DB"]
-   [scroll-view {:style {:padding-top 20}}
+   [scroll-view {:style {}}
     [text {:style {:font-family "Menlo"
                    :background-color "lightgrey"}}
      (pp/write @(subscribe [:db]) :stream nil)]]


adding block device support

adding block device support

--- src/aws/provider.clj
+++ src/aws/provider.clj
@@ -50,7 +50,7 @@
 (defn creation-keys [aws]
   (clojure.set/subset? (into #{} (keys aws))
     #{:volumes :min-count :max-count :instance-type :ebs-optimized
-      :key-name :placement :security-groups}))
+      :key-name :placement :security-groups :block-device-mappings}))

 (defn create-instance
    "creates instance from aws"
@@ -127,7 +127,10 @@
   [{:keys [aws machine] :as spec}]
   (cond-> (merge-with merge (dissoc-in* spec [:aws :endpoint]) defaults)
     :availability-zone
-      (map-key [:aws :availability-zone] [:aws :placement :availability-zone])))
+      (map-key [:aws :availability-zone] [:aws :placement :availability-zone])
+     :block-devices
+      (map-key [:aws :block-devices] [:aws :block-device-mappings])
+    ))

 (defmethod translate :aws [{:keys [aws machine] :as spec}]
   [(aws :endpoint) (aws-spec spec) (or (machine :user) "root")])


improve logging

improve logging

--- src/babel/engine.clj
+++ src/babel/engine.clj
@@ -33,16 +33,19 @@
                          @language-model
                          language-model)

-        debug (log/debug (str "pre-enriched spec: " spec))
+        debug (log/debug (str "pre-enrich spec: " spec))

         spec (if (and do-enrich (:enrich language-model))
                ((:enrich language-model)
                 spec
                 (:lexicon language-model))
-               spec)]
-    (log/debug (str "calling forest/generate with spec: " (if (seq? spec)
-                                                            (string/join "," spec)
-                                                            spec)))
+               spec)
+        debug (if (seq? spec)
+                (.size
+                 (map #(log/debug (str "post-enrich spec: " %))
+                      spec))
+                (log/debug (str "post-enrich spec: " spec)))
+        ]
     (forest/generate spec
                      (:grammar language-model)
                      (:lexicon language-model)


move shuffle to (defn lookup-spec)

move shuffle to (defn lookup-spec)

--- src/babel/index.cljc
+++ src/babel/index.cljc
@@ -142,7 +142,7 @@
                      (map (fn [entry]
                             (get-in entry path :top))
                           (flatten (vals lexicon))))))
-   (shuffle (flatten (vals lexicon)))
+   (flatten (vals lexicon))
    path))

 (defn create-indices [lexicon index-lexicon-on-paths]
@@ -187,5 +187,6 @@
     (log/debug (str "indexed size returned: " (count result) " for spec: " (strip-refs spec)))
     (if (and false (empty? result))
       (throw (Exception. (str "lookup-spec failed: " (strip-refs spec)))))
-    result))
+    (shuffle result)))

+


read JSON correctly

read JSON correctly

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -322,12 +322,14 @@
                                        WHERE language=?
                                          AND active=true
                                          AND structure @> "
+                                     ;; TODO: use '?' here, not string concatenation
                                      "'" json-spec "' LIMIT 1")
                                 [language]]
                                :results)]
+      (log/debug (str (string/join "," results)))
       (first (map (fn [result]
                     {:surface (:surface result)
-                     :structure (read-str (:structure result))})
+                     :structure (json-read-str (.getValue (:structure result)))})
                   results)))))

 (defn contains [spec]
@@ -336,6 +338,7 @@
                  {}
                  spec)
           json-spec (json/write-str (strip-refs spec))
+          ;; TODO: use '?' below, not string concatenation
           results (db/exec-raw [(str "SELECT DISTINCT *
                                         FROM (SELECT english.surface   AS en,
                                                       italiano.surface AS it,


element location tests added

element location tests added


Update server.cljs

Update server.cljs

--- src/meta/server.cljs
+++ src/meta/server.cljs
@@ -34,7 +34,7 @@

 (defn with-authentication [app]
   (debug "Loading server Authentication api")
-  (auth/configure app))
+  (auth/authentication app))

 (defn with-channels [app]
   (debug "Loading server Channels api")


Don't need to also add security-token to headers

This function is used to sign a GET request, so the token is already
in the query string

--- src/braid/lib/s3.clj
+++ src/braid/lib/s3.clj
@@ -59,7 +59,7 @@

 (defn- get-signature
   [{:aws/keys [credentials-provider] region :aws-region bucket :aws-bucket :as config} utc-now path query-str]
-  (let [[_ api-secret ?security-token] (credentials-provider)]
+  (let [[_ api-secret] (credentials-provider)]
     (->> ["AWS4-HMAC-SHA256"
           (.format utc-now aws/basic-date-time-format)
           (string/join "/" [(.format utc-now aws/basic-date-format) region "s3"
@@ -68,9 +68,7 @@
            {:method "GET"
             :path (str "/" path)
             :query-string query-str
-            :headers (cond-> {"host" (str bucket ".s3." region ".amazonaws.com")}
-                       ?security-token
-                       (assoc "x-amz-security-token" ?security-token))
+            :headers {"host" (str bucket ".s3." region ".amazonaws.com")}
             :body nil})]
          (string/join "\n")
          aws/str->bytes


Show world desc in copyable format

Show world desc in copyable format

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -12,7 +12,8 @@
     [player.seen-viz :as seen-viz]
     [player.key-handler :as keys]
     [devtools.core :as devtools]
-    [clojure.set :as sets])
+    [clojure.set :as sets]
+    [cljs.pprint :as pp])
   (:require-macros
     [devcards.core :refer [defcard deftest]]
     [player.macros :refer [soft-assert]]))
@@ -726,5 +727,10 @@
       (js/React.render (sab/html [:div {}
                                   (world-widget #js {"args" {:world  world
                                                              :editor ed-atom}})
-                                  (edit-controls world ed-atom)]) target)))
+                                  (edit-controls world ed-atom)
+                                  [:p
+                                   {:style {:width 640
+                                            :fontFamily "monospace"
+                                            :overflow "auto"}}
+                                   (str (:desc w))]]) target)))
   (.requestAnimationFrame js/window #(rererender target)))


fix build-sql-source impl

fix build-sql-source impl

--- src/asphalt/core.clj
+++ src/asphalt/core.clj
@@ -376,7 +376,8 @@
   [sql-template result-types
    {:keys [make-param-setter
            make-row-maker
-           make-column-reader]
+           make-column-reader
+           sql-name]
     :or {make-param-setter  (fn [param-keys param-types]
                               (eval `(fn [^PreparedStatement prepared-stmt# params#]
                                        (p/lay-params prepared-stmt# ~param-keys ~param-types params#))))
@@ -385,7 +386,7 @@
                                 (do
                                   (i/expected vector? "vector of result types" result-types)
                                   (doseq [t result-types]
-                                    (i/expected-result-type t))
+                                    (when-not (contains? t/single-typemap t) (i/expected-result-type t)))
                                   (let [rsyms (-> (count result-types)
                                                 (repeatedly gensym)
                                                 vec)
@@ -404,7 +405,8 @@
                                 (fn [^ResultSet result-set ^long col-index]
                                   (when-not (<= 1 col-index n)
                                     (i/expected s col-index))
-                                  (iresult/read-column-value result-set col-index))))}
+                                  (iresult/read-column-value result-set col-index))))
+         sql-name           (gensym "sql-name-")}
     :as options}]
   (i/expected vector? "vector of SQL template tokens" sql-template)
   (i/expected vector? "vector of result column types" result-types)
@@ -414,7 +416,8 @@
                                (keyword? token) [token :nil]
                                (vector? token)  (let [[param-key param-type] token]
                                                   (i/expected keyword? "param key (keyword)" param-key)
-                                                  (i/expected-param-type param-type)
+                                                  (when-not (contains? t/all-typemap param-type)
+                                                    (i/expected-param-type param-type))
                                                   token)
                                :otherwise       (i/expected "string, param key or key/type vector" token)))
                        sql-template)]
@@ -423,11 +426,13 @@
            (map second)
            (every? (partial contains? t/single-typemap)))
        (isql/->StaticSqlTemplate
+         sql-name
          (isql/make-sql sanitized-st (vec (repeat (count kt-pairs) nil)))
          (make-param-setter (mapv first kt-pairs) (mapv second kt-pairs))
          (make-row-maker result-types)
          (make-column-reader result-types))
        (isql/->DynamicSqlTemplate
+         sql-name
          (reduce (fn [st token] (cond
                                   (and (string? token) (string? (last st))) (conj (pop st) (str (last st) token))
                                   (and (vector? token) (string? (last st))


Filter out resources to be only cpus and mem in mesos/monitor.clj

--- scheduler/src/cook/mesos/monitor.clj
+++ scheduler/src/cook/mesos/monitor.clj
@@ -48,7 +48,10 @@
          ;; Produce a list of maps from user's name to his stats.
          (mapv (fn [job-ent]
                  (let [user (:job/user job-ent)
-                       stats (assoc (util/job-ent->resources job-ent) :count 1)]
+                       stats (-> job-ent
+                                 util/job-ent->resources
+                                 (select-keys [:cpus :mem])
+                                 (assoc :count 1))]
                    {user stats})))
          (reduce (partial merge-with (partial merge-with +)) {}))))

@@ -148,4 +151,4 @@
                     (log/debug (format "Sending %s monitor events ..." (count events)))
                     (riemann/send-events riemann-client events)))
                 {:error-handler (fn [ex]
-                                  (log/error "Sending riemann events failed!" ex))}))))
+                                  (log/error ex "Sending riemann events failed!"))}))))


Make generate function only available on jvm.

--- src/beicon/core.cljc
+++ src/beicon/core.cljc
@@ -248,25 +248,30 @@
                 (.onError emitter e)))))))))

-(defn generate
-  "Returns a cold, synchronous, stateful and backpressure-aware
-  generator of values."
-  ([init next] (generate init next nil))
-  ([init next dispose]
-   (let [init (if (fn? init) init (constantly init))
-         next (as-bifunction (fn sink [state ^Emitter emitter]
-                               (let [sink (fn sink [v]
-                                            (cond
-                                              (identical? end v) (.onComplete emitter)
-                                              (-next? v) (.onNext emitter v)
-                                              (-error? v) (.onError emitter v)
-                                              (-end? v) (.onComplete emitter)
-                                              (reduced? v) (do
-                                                             (sink @v)
-                                                             (.onComplete emitter))))]
-                                 (next state sink))))
-         dispose (if (fn? dispose) (as-consumer dispose) noop-consumer)]
-     (Flowable/generate ^Callable init next ^Consumer dispose))))
+#?(:clj
+   (defn generate
+     "Returns a cold, synchronous, stateful and backpressure-aware
+     generator of values."
+     ([next] (generate next nil nil))
+     ([next setup dispose]
+      (let [setup (if (fn? setup) setup (constantly setup))
+            dispose (if (fn? dispose) (as-consumer dispose) noop-consumer)
+            next (as-bifunction
+                  (fn [state ^Emitter emitter]
+                    (let [sink (fn sink [v]
+                                 (cond
+                                   (identical? end v) (.onComplete emitter)
+                                   (-next? v) (.onNext emitter v)
+                                   (-error? v) (.onError emitter v)
+                                   (-end? v) (.onComplete emitter)
+                                   (reduced? v) (do
+                                                  (sink @v)
+                                                  (.onComplete emitter)))
+                                 v)]
+                      (next state sink))))]
+        (Flowable/generate ^Callable setup
+                           ^BiFunction next
+                           ^Consumer dispose)))))

 ;; --- Observable Subscription


Adds difference

Adds difference

--- src/the_little_clojurian/chapter7.clj
+++ src/the_little_clojurian/chapter7.clj
@@ -103,3 +103,18 @@
   (is (= (union '(1) '(1 2)) '(1 2)))
   (is (= (union '(1 2 3) '(4 5 6)) '(1 2 3 4 5 6)))
   (is (= (union '(stewed tomatoes and macaroni casserole) '(macaroni and cheese)) '(stewed tomatoes casserole macaroni and cheese))))
+
+(with-test
+  (def difference
+    (fn [set1 set2]
+      (cond (null? set1) '()
+            (member? (car set1) set2) (difference (cdr set1) set2)
+            :else (cons (car set1) (difference (cdr set1) set2)))))
+
+  (is (= (difference '() '()) '()))
+  (is (= (difference '(:foo) '()) '(:foo)))
+  (is (= (difference '(:bar) '()) '(:bar)))
+  (is (= (difference '(:foo :bar) '(:foo)) '(:bar)))
+  (is (= (difference '(:foo) '(:bar)) '(:foo)))
+  (is (= (difference '(1 2 3) '(1 2 3)) '()))
+  (is (= (difference '(:a :b :c) '(:d :e :f)) '(:a :b :c))))


add built-in worker_threads node module

add built-in worker_threads node module

--- src/main/shadow/build/resolve.clj
+++ src/main/shadow/build/resolve.clj
@@ -88,7 +88,7 @@
     "constants" "crypto" "_debugger" "dgram" "dns" "domain" "events" "freelist"
     "fs" "http" "http2" "https" "_linklist" "module" "net" "os" "path" "punycode"
     "querystring" "readline" "repl" "stream" "string_decoder" "sys" "timers"
-    "tls" "tty" "url" "util" "vm" "zlib" "_http_server" "process" "v8"})
+    "tls" "tty" "url" "util" "vm" "zlib" "_http_server" "process" "v8" "worker_threads"})

 (defn find-npm-resource
   [npm ^File require-from ^String require]


+u/pprint

+u/pprint

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -12,7 +12,7 @@
    [clojure.java.io :as io]
    [clojure.tools.logging :as log]
    [compojure.core :as compojure :refer [GET PUT POST DELETE ANY]]
-   [dag_unify.core :as u :refer [dissoc-paths get-in ref? strip-refs unify]]
+   [dag_unify.core :as u :refer [dissoc-paths get-in ref? pprint strip-refs unify]]
    [korma.core :as db]
    [ring.util.response :as resp]])


Add missing docstring to from-callback function.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -115,6 +115,8 @@
     (js/Rx.Observable.fromArray array)))

 (defn from-callback
+  "Creates an observable sequence of one unique value
+  executing a callback."
   [f & args]
   {:pre [(fn? f)]}
   (create (fn [sink]


faaaaahck

faaaaahck

--- src/benjals/core.clj
+++ src/benjals/core.clj
@@ -18,6 +18,6 @@
   (println (System/getenv "DATABASE_URL"))
   (migrate (System/getenv "DATABASE_URL"))
   (let
-    [port-env System/getenv "PORT"
-     port (if-not (nil? port-env) port-env "8080")]
+    [port-env (System/getenv "PORT")
+     port (if-not (nil? port-env) (Integer/valueOf port-env) 8080)]
     (run-jetty (var app) {:port port :join? false})))


[Add] fun print-exp-data

[Add] fun print-exp-data

--- src/clj_elm/core.clj
+++ src/clj_elm/core.clj
@@ -156,6 +156,17 @@
          (#(pmap (fn [feature] (predict % feature)) (:features test)))
          (#(evaluation (:classes test) % exp-data))))))

+(defn print-exp-data [expdata]
+  (print "L: " (:L expdata) "\n"
+         "length(train_cover): " (:length-train-cover expdata) "\n"
+         "length(test_cover): " (:length-test-cover expdata) "\n"
+         "length(train_stego): " (:length-train-stego expdata) "\n"
+         "length(test_stego): " (:length-train-cover expdata) "\n"
+         "TP: " (:TP expdata) ", FP: " (:FP expdata) ", TN: " (:TN expdata) ", FN: " (:FN expdata) "\n"
+         "Accracy: " (:Accuracy expdata "\n")
+         "Recall: " (:Recall expdata "\n")
+         "Precision: " (:Precision expdata) "\n\n"))
+
 (defn cross-validate
   ([dataset L k]
    {:pre [(instance? DataSet dataset) (integer? k) (integer? L)]}
@@ -164,7 +175,7 @@
          groupn (quot numd k)]                ; number of one group's element
      (->> (take k (iterate #(+ % groupn) 0))
           (pmap #(let [eva (_cross-validate norm-dataset % (+ % (dec groupn)) L)]
-                   (dorun (println eva))
+                   (dorun (print-exp-data eva))
                    (:Accuracy eva)))
           (reduce +)
           (* (/ 1 k))))))


Renaming marker fn

Renaming marker fn

--- src/cljs/go/core.clj
+++ src/cljs/go/core.clj
@@ -794,7 +794,7 @@
   (warn-and-update-protocol p type env)
   (let [psym      (resolve p)]
     (cons
-     `(do (~'js* "func (_ *~{})~{}Marker() {}" ~type-sym ~psym))
+     `(do (~'js* "func (_ *~{})~{}__() {}" ~type-sym ~(symbol (cljs.compiler/go-type-fqn psym))))
      (if (= p 'Object)
        (add-obj-methods type type-sym sigs)
        (concat
@@ -1018,7 +1018,7 @@
                        (apply core/str)))]
     `(do
        (def ~psym) ;; Empty init gets dropped by the compiler, but registered by the analyzer.
-       (~'js* ~(core/str "type ~{} interface{\n" (core/str psym "Marker()\n")
+       (~'js* ~(core/str "type ~{} interface{\n" (core/str go-psym "__()\n")
                          (apply core/str (map method-decl methods)) "}\n")
               ~go-psym)
        (~'js* "func init() {\n\tRegisterProtocol_(~{}, (*~{})(nil))\n}"


Update util.clj

Update util.clj

--- src/clojush/util.clj
+++ src/clojush/util.clj
@@ -437,3 +437,32 @@
             bottom-val (nth sorted bottom)
             top-val (nth sorted halfway)]
            (mean [bottom-val top-val])))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Function to produce proportional input and constant instructions
+
+(defn concatenate-until-threshold
+  "Utility function for make-proportional-atom-generators.
+   This repeatedly concatenates coll with itself until
+   it has at least threshold elements in it."
+  [coll threshold]
+  (loop [things coll]
+    (if (>= (count things) threshold)
+      things
+      (recur (concat things coll)))))
+
+(defn make-proportional-atom-generators
+  "Takes lists of one-each-instructions, inputs, and constants,
+   and the proportions of inputs and constants in the final set
+   as a map, and produces the final list of atom generators."
+  [one-each-instructions inputs constants
+   {:keys [proportion-inputs proportion-constants]}]
+  (let [original-instruction-count (count one-each-instructions)
+        proportional-increase (+ proportion-inputs proportion-constants)
+        final-instruction-count (/ original-instruction-count
+                                   (- 1.0 proportional-increase))
+        number-inputs (int (* proportion-inputs final-instruction-count))
+        number-constants (int (* proportion-constants final-instruction-count))
+        inputs-final (concatenate-until-threshold inputs number-inputs)
+        constants-final (concatenate-until-threshold constants number-constants)]
+    (concat one-each-instructions inputs-final constants-final)))


Fix indent.

Fix indent.

--- src/blocks/meter.clj
+++ src/blocks/meter.clj
@@ -157,15 +157,15 @@
   "Helper function for the `measure-method` macro."
   [store method-kw args body-fn]
   (let [elapsed (stopwatch)]
-     (try
-       (body-fn)
-       (finally
-         (when (::recorder store)
-           (log/tracef "Method %s of %s block store on %s took %.1f ms"
-                       (name method-kw)
-                       (meter-label store)
-                       args
-                       @elapsed)
-           (record! store ::method-time @elapsed
-                    :method method-kw
-                    :args args))))))
+    (try
+      (body-fn)
+      (finally
+        (when (::recorder store)
+          (log/tracef "Method %s of %s block store on %s took %.1f ms"
+                      (name method-kw)
+                      (meter-label store)
+                      args
+                      @elapsed)
+          (record! store ::method-time @elapsed
+                   :method method-kw
+                   :args args))))))


serve css

serve css

--- src/bløggr/core.clj
+++ src/bløggr/core.clj
@@ -9,9 +9,6 @@

 (def cegdown-ext [:fenced-code-blocks :autolinks])

-(defn get-posts []
-  (stasis/slurp-directory "posts/" #"test.*\.(md|markdown)$"))
-
 (defn parse-datestring [date-str]
   (tf/parse (tf/formatter "yyyy-MM-dd HH:mm:ssZ") date-str))

@@ -20,8 +17,8 @@
   [post]
   (let [x (str/split post #"\n------\n")]
        {:body (second x)
-       :header (let [header (read-string (first x))]
-                    (assoc header :date (parse-datestring (header :date))))}))
+        :header (let [header (read-string (first x))]
+                     (assoc header :date (parse-datestring (header :date))))}))

 (defn filename [title date]
   (str (tf/unparse (tf/formatter "/yyyy/MM/dd/") date)
@@ -49,21 +46,22 @@
 (defn render [post]
   (assoc post :body (apply str (html/emit* (post :body)))))

-(def ring (stasis/serve-pages {"/index.html" (->> (get-posts)
-                                                  (vals)
-                                                  (map parse-post)
-                                                  (map markdown)
-                                                  (map enliveify)
-                                                  (map highlight)
-                                                  (map render)
-                                                  (first)
-                                                  (:body))}))
+(defn get-posts []
+  (->> (stasis/slurp-directory "posts/" #"test.*\.(md|markdown)$")
+       (vals)
+       (map parse-post)
+       (map markdown)
+       (map enliveify)
+       (map highlight)
+       (map render)
+       (map filename-body-map)
+       (reduce merge)))

+(defn get-css []
+  (stasis/slurp-directory "resources/css/" #".*\.css"))

-;(def ring (->> (get-posts)
-;               (vals)
-;               (map parse-post)
-;               (map markdown)
-;               (reduce merge)
-;               (stasis/serve-pages)))
+(def ring (-> {:posts (get-posts)
+               :css (get-css)}
+              (stasis/merge-page-sources)
+              (stasis/serve-pages)))


adds game over whe no mor pieces fit

adds game over whe no mor pieces fit

--- src/client/core.cljs
+++ src/client/core.cljs
@@ -54,11 +54,22 @@
 ;; Game-driven STATE CHANGES
 ;;------------------------------------------------------------

+(defn game-over
+  "You lost, get to the chopper"
+  []
+  (js/console.log "game over"))
+
 (defn spawn-piece!
   "Spawns a random piece at the starting position."
   []
-  (swap! state assoc :piece (get-rand-piece)
-                     :position start-position))
+  (let [piece (get-rand-piece)
+        [x y] start-position
+        board (:board @state)]
+    (if (piece-fits? piece x y board)
+      (swap! state assoc :piece (get-rand-piece)
+                     :position start-position)
+      (game-over))
+  ))

 (defn collapse-rows!
   "Collapse all filled rows."


write leaves as well - might nuke this sucker later

--- src/crawler/main.clj
+++ src/crawler/main.clj
@@ -51,6 +51,31 @@
                (pprint model model-wrtr)
                (pprint corpus corpus-wrtr)))))))

+(defn dump-state-model-corpus-leaves
+  "Creates a dated file _prefix_-yr-month-day-hr-min.corpus/state/model"
+  ([state model corpus leaves]
+     (dump-state-model-corpus state model corpus leaves "nameless-model"))
+
+  ([state model corpus leaves prefix]
+     (let [date-file-prefix (utils/dated-filename "" "")
+
+           create #(str prefix "/" date-file-prefix %)
+
+           state-file  (create ".state")
+           model-file  (create ".model")
+           corpus-file (create ".corpus")
+           leaves-file (create ".leaves")]
+       (do
+         (utils/safe-mkdir prefix)
+         (with-open [state-wrtr  (io/writer state-file)
+                     model-wrtr  (io/writer model-file)
+                     corpus-wrtr (io/writer corpus-file)
+                     leaves-wrtr (io/writer leaves-file)]
+           (do (pprint state state-wrtr)
+               (pprint model model-wrtr)
+               (pprint corpus corpus-wrtr)
+               (pprint leaves leaves-wrtr)))))))
+
 (defn dump-corpus
   ([corpus]
      (dump-corpus corpus "crawler"))
@@ -131,15 +156,17 @@
         {state :state
          model :model
          corpus :corpus
-         prefix :prefix}
+         prefix :prefix
+         leaf-clusters :leaf-clusters}
         (crawl/crawl-with-estimation-example start-url
                                              discussion-forum-leaf?
                                              discussion/extractor
                                              discussion-forum-stop?)]
-    (dump-state-model-corpus state
-                             model
-                             corpus
-                             (str "example-scheduler-estimate-stopper-" prefix))))
+    (dump-state-model-corpus-leaves state
+                                    model
+                                    corpus
+                                    leaf-clusters
+                                    (str "example-scheduler-estimate-stopper-" prefix))))

 (defn execute-model-crawler
   [start-url model num-leaves]


Fix some more requires

Fix some more requires

--- src/icecap/crypto.clj
+++ src/icecap/crypto.clj
@@ -12,7 +12,8 @@
   This namespace defines those components."
   (:require [caesium.crypto.generichash :refer [blake2b]]
             [caesium.crypto.secretbox :as secretbox]
-            [caesium.randombytes :refer [randombytes]])
+            [caesium.randombytes :refer [randombytes]]
+            [taoensso.timbre :refer [info spy]])
   (:import (java.util Arrays))
   (:refer-clojure :exclude [derive]))


RDC - Main file will parse the last arg as JSON.

--- src/icfp2015/core.clj
+++ src/icfp2015/core.clj
@@ -10,4 +10,4 @@
 (defn -main
   "I don't do a whole lot ... yet."
   [& args]
-  (println "Hello, World!"))
+  (load-json (last args)))


Use v8 instead of rhino. It's faster.

Use v8 instead of rhino. It's faster.

--- src/incise/server.clj
+++ src/incise/server.clj
@@ -43,7 +43,7 @@
              (wrap-stacktrace)
              (wrap-log-exceptions)
              (asset-pipeline {:cache-mode :development
-                              :engine :rhino
+                              :engine :v8
                               :compress false})))

 (defn getenv


add last-git-commit-date fnc

add last-git-commit-date fnc

--- src/leiningen/git.clj
+++ src/leiningen/git.clj
@@ -13,6 +13,9 @@

 (defn status-failed []
   (str "==> " :failed))
+
+(defn commit-date [path]
+  (u/output-of (sh/sh "git" "log" "-1" "--format=%cr" path) ""))

 (defn get-changed-files []
   (u/output-of (sh/sh "git" "diff" "--name-only") " "))


use create-all when creating the node

use create-all when creating the node

--- src/clj_kafka/zk.clj
+++ src/clj_kafka/zk.clj
@@ -82,4 +82,4 @@
         (zk/delete z path)
         (if-let [{:keys [version] :as m} (zk/exists z path)]
           (zk/set-data z path (.getBytes (str offset)) version)
-          (zk/create z path :persistent? true :data (.getBytes (str offset))))))))
+          (zk/create-all z path :persistent? true :data (.getBytes (str offset))))))))


DOM Attr and Style should use `->dom`.

DOM Attr and Style should use `->dom`.

--- src/cljs/c2/dom.cljs
+++ src/cljs/c2/dom.cljs
@@ -104,19 +104,22 @@

    `(style el :keyword val)`   sets single style, returns element"
   ([el] (throw (js/Error. "TODO: return map of element styles")))
-  ([el x] (match [x]
-                 [(k :when keyword?)] (gstyle/getComputedStyle el (name k))
-                 [(m :when map?)]
-                 (do
-                   (doseq [[k v] m] (style el k v))
-                   el)))
-  ([el k v] (gstyle/setStyle el (name k)
-                             (match [v]
-                                    [s :when string?] s
-                                    [n :when number?]
-                                    (if (#{:height :width :top :left :bottom :right} (keyword k))
-                                      (str n "px")
-                                      n)))
+  ([el x]
+     (let [el (->dom el)]
+       (match [x]
+              [(k :when keyword?)] (gstyle/getComputedStyle el (name k))
+              [(m :when map?)]
+              (do
+                (doseq [[k v] m] (style el k v))
+                el))))
+  ([el k v]
+     (gstyle/setStyle (->dom el) (name k)
+                      (match [v]
+                             [s :when string?] s
+                             [n :when number?]
+                             (if (#{:height :width :top :left :bottom :right} (keyword k))
+                               (str n "px")
+                               n)))
      el))

 (defn attr
@@ -129,28 +132,30 @@
    `(attr el {:keyword val})` sets element attributes according to map, returns element

    `(attr el :keyword val)`   sets single attr, returns element"
-  ([el] (let [attrs (.-attributes el)]
+  ([el] (let [attrs (.-attributes (->dom el))]
           (into {} (for [i (range (.-length attrs))]
                      [(keyword  (.-name (aget attrs i)))
                       (.-value (aget attrs i))]))))
-  ([el x] (match [x]
-                 [(k :when keyword?)] (.getAttribute el (name k))
-                 [(m :when map?)]
-                 (do (doseq [[k v] m] (attr el k v))
-                     el)))
+  ([el x]
+     (let [el (->dom el)]
+       (match [x]
+              [(k :when keyword?)] (.getAttribute el (name k))
+              [(m :when map?)]
+              (do (doseq [[k v] m] (attr el k v))
+                  el))))
   ([el k v]
-     (if (nil? v)
-       (.removeAttribute el (name k))
-       (if (= :style k)
-         (style el v)
-         (.setAttribute el (name k) v)))
-     el))
+     (let [el (->dom el)]
+       (if (nil? v)
+         (.removeAttribute el (name k))
+         (if (= :style k)
+           (style el v)
+           (.setAttribute el (name k) v)))
+       el)))

 (defn text
   "Get or set element text, returning element"
   ([el]
-     (let [el (->dom el)]
-       (gdom/getTextContent el)))
+     (gdom/getTextContent (->dom el)))
   ([el v]
      (let [el (->dom el)]
        (gdom/setTextContent el v)
@@ -159,8 +164,7 @@
 (defn val
   "Get or set element value."
   ([el]
-     (let [el (->dom el)]
-       (gforms/getValue el)))
+     (gforms/getValue (->dom el)))
   ([el v]
      (let [el (->dom el)]
        (gforms/setValue el v)