Cleanup recv loop

Cleanup recv loop

--- src/cljs/om_sente/core.cljs
+++ src/cljs/om_sente/core.cljs
@@ -26,7 +26,7 @@
       {:text ""})
     om/IRenderState
     (render-state [this {:keys [text]}]
-      (dom/input #js {:ref "data" :type "text" :value (om/value text)
+      (dom/input #js {:ref "data" :type "text" :value text
                       :onChange #(om/set-state! owner :text
                                                 (.. % -target -value))
                       :onKeyPress #(send-field % text)}))))
@@ -39,12 +39,12 @@
     om/IWillMount
     (will-mount [this]
       (go (loop []
-            (let [[op & args :as event] (<! ch-chsk)]
+            (let [[op arg] (<! ch-chsk)]
               (case op
                 :chsk/recv
-                (let [[ev-id & payload] (first args)]
+                (let [[ev-id payload] arg]
                   (case ev-id
-                    :test/reply (om/set-state! owner :text (first payload))
+                    :test/reply (om/set-state! owner :text payload)
                     nil))
                 nil))
             (recur))))


display number of lembrandos

display number of lembrandos

--- src/cljs/relembra/core.cljs
+++ src/cljs/relembra/core.cljs
@@ -184,7 +184,7 @@
   (let [lembrandos (d/q '[:find [?l ...] :where [?l :lembrando/question]] @conn)]
     [screen "Bem vindo!"
      (if (> (count lembrandos) 0)
-       [:div "Tes lembrandos!"]
+       [:div (str "Tes " (count lembrandos)" lembrandos!")]
        [:div "Nom tes!"])]))

 (def screens {:loading loading


Function creates a map of all path : its filenames pairs

Also found from SO a way to do list comparison
more closely to how JS and Python does it:
lexicographically, not lengthwise

--- src/cljs/repodoc/utils.cljs
+++ src/cljs/repodoc/utils.cljs
@@ -12,3 +12,28 @@
            (map (fn [x]
                   [(decorator x) x])
                 sortable))))
+
+(defn sapling
+  "Function that reduces into acc
+  a map of given items' basenames
+  using directory paths as keys"
+  [acc item]
+  (let [path (get item "path")
+        parts (clojure.string/split path #"/")
+        dirs (clojure.string/join "/" (butlast parts))
+        dir (if (empty? dirs) "/" dirs)
+        leaf (get acc dir)]
+    (if leaf
+      (assoc acc dir (conj leaf item))
+      (assoc acc dir [item]))))
+
+(defn path-reduce [paths]
+  (reduce sapling  {} paths))
+
+(defn vector-compare [[value1 & rest1] [value2 & rest2]]
+  "From http://stackoverflow.com/questions/15716894/"
+  (let [result (compare value1 value2)]
+    (cond
+      (not (= result 0)) result
+      (nil? value1) 0 ; value2 will be nil as well
+      :else (recur rest1 rest2))))


small changes

small changes

--- src/cljx/mazegen/rules.cljx
+++ src/cljx/mazegen/rules.cljx
@@ -12,10 +12,9 @@
        (filter #(get-in maze %))))

 (defn categorized-neighbors [start maze]
-  (->> start (neighbors maze)
-       (group-by #(empty? (get-in maze %)))))
+  (->> start (neighbors maze) (group-by #(empty? (get-in maze %)))))

-(defn init [rows cols]
+(defn create-empty [rows cols]
   (vec (take rows (repeat (vec (take cols (repeat #{})))))))

 (defn open-wall [src dst maze]
@@ -23,8 +22,8 @@
       (update-in src conj (map - dst src))
       (update-in dst conj (map - src dst))))

-(defn prim-gen [start rows cols]
-  (loop [maze (update-in (init rows cols) start conj :start)
+(defn prim-gen [maze start]
+  (loop [maze (update-in maze start conj :start)
          frontier (into #{} (neighbors maze start))]
     (if (empty? frontier)
       maze
@@ -33,16 +32,21 @@
         (recur (open-wall (rand-nth s) dst maze)
                (into (disj frontier dst) f))))))

-(defn dfs [start rows cols]
-  (loop [maze (update-in (init rows cols) start conj :start) visited [start]]
+(defn dfs [maze start]
+  (loop [maze (update-in maze start conj :start)
+         visited [start]]
     (if (empty? visited)
       maze
-      (let [f (filter #(empty? (get-in maze %)) (neighbors maze (first visited)))]
+      (let [n (neighbors maze (first visited))
+            f (filter #(empty? (get-in maze %)) n)]
         (if (empty? f)
           (recur maze (rest visited))
           (let [dst (rand-nth (vec f))]
             (recur (open-wall (first visited) dst maze) (conj visited dst))))))))

+(def m (prim-gen (create-empty 4 4) [0 0]))
+(def n (dfs (create-empty 4 4) [0 0]))
+
 ;(prn (prim-gen [0 0] 4 4))

 ;(prn (dfs [0 0] 4 4))


Try to fix message processing on destroy

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -42,6 +42,20 @@
        (when @lockee#
          (Display/makeCurrent)
          ~@body)
+       (finally
+         (when @lockee#
+           (Display/releaseContext))
+         (monitor-exit lockee#)))))
+
+(defmacro with-gl-lock
+  "Executes exprs in an implicit do, while holding the monitor of x and aquiring/releasing the OpenGL context.
+  Will release the monitor of x in all circumstances."
+  [x & body]
+  `(let [lockee# ~x]
+     (try
+       (monitor-enter lockee#)
+       (Display/makeCurrent)
+       ~@body
        (finally
          (when @lockee#
            (Display/releaseContext))
@@ -355,13 +369,14 @@
        ;; Signal to parent that display has been created
        (.countDown latch)
        (loop []
-         (if (with-gl-context gl-lock
-               ; Process messages in the main thread rather than the input go-loop due to Windows only allowing
-               ; input on the thread that created the window
-               (Display/processMessages)
-               ;; Close the display if the close window button has been clicked
-               ;; or the gl-lock has been released programmatically (e.g. by destroy!)
-               (or (Display/isCloseRequested) (not @gl-lock)))
+         (if (or (with-gl-context gl-lock
+                   ; Process messages in the main thread rather than the input go-loop due to Windows only allowing
+                   ; input on the thread that created the window
+                   (Display/processMessages)
+                   ;; Close the display if the close window button has been clicked
+                   ;; or the gl-lock has been released programmatically (e.g. by destroy!)
+                   (Display/isCloseRequested))
+                 (not @gl-lock))
            (do
              (log/info "Destroying display")
              (with-gl-context gl-lock


fix error on running 'lein test-refresh': "Error refreshing environment: java.lang.ClassNotFoundException: clojure.pprint, compiling:(clj_fakes/macro.clj:22:5)"

--- src/clj_fakes/macro.clj
+++ src/clj_fakes/macro.clj
@@ -1,4 +1,5 @@
-(ns clj-fakes.macro)
+(ns clj-fakes.macro
+  (:require [clojure.pprint]))

 (defn -cljs-env?
   "Take the &env from a macro, and tell whether we are expanding into cljs.


Improve documentation in `quil.util`.

Improve documentation in `quil.util`.

--- src/cljc/quil/util.cljc
+++ src/cljc/quil/util.cljc
@@ -30,8 +30,8 @@
            (= java.lang.Integer t)))))

 (defn resolve-constant-key
-  "Returns the val associated with key in mappings or key directly if it
-  is one of the vals in mappings. Otherwise throws an exception."
+  "Returns the val associated with `key` in `mappings` or `key` directly if it
+  is one of the vals in `mappings`. Otherwise throws an exception."
   [key mappings]
   (cond
     (get mappings key)            (get mappings key)
@@ -42,19 +42,31 @@
                                           (str "Expecting a keyword, got: " key ". Expected one of: " (vec (sort (keys mappings))))))))

 (defn- length-of-longest-key
-  "Returns the length of the longest key of map m. Assumes m's keys are strings
+  "Returns the length of the longest key of map `m`. Assumes `m`'s keys are strings
    and returns 0 if map is empty:
+
+   Examples:
+   ```
    (length-of-longest-key {\"foo\" 1 \"barr\" 2 \"bazzz\" 3}) ;=> 5
-   (length-of-longest-key {}) ;=> 0"
+   (length-of-longest-key {}) ;=> 0
+   ```"
   [m]
   (or (last (sort (map #(.length %) (keys m))))
       0))

 (defn- gen-padding
-  "Generates a padding string starting concatting s with len times pad:
-   (gen-padding \"\" 5 \"b\") ;=> \"bbbbb\"
-   May be called without starting string s in which case it defaults to the
-   empty string and also without pad in which case it defaults to a single space"
+  "Generates a padding string with `s` concatenated with `len` times `pad`.
+   May be called without starting string `s` in which case it defaults to the
+   empty string and also without `pad` in which case it defaults to a single
+   space.
+
+   Examples:
+   ```
+   (gen-padding \"asdf\" 5 \"b\") ;=> \"asdfbbbbb\"
+   (gen-padding 3 \"b\")          ;=> \"bbb\"
+   (gen-padding 3)                ;=> \"   \"
+   ```
+   "
   ([len] (gen-padding "" len " "))
   ([len pad] (gen-padding "" len pad))
   ([s len pad]
@@ -113,7 +125,7 @@
         (partition 2 opts))))

 (defn clj-unchecked-int
-  "In clojure it does unchecked-int and does nothing in cljs.
+  "In clojure it does `unchecked-int` and does nothing in cljs.
   Needed to handle colors in hex form in clojure."
   [v]
   #?(:clj (unchecked-int v) :cljs v))


need to load cljs.pprint analysis cache

need to load cljs.pprint analysis cache

--- src/cljs/lumo/repl.cljs
+++ src/cljs/lumo/repl.cljs
@@ -131,31 +131,32 @@
    we might need to load the corresponding analysis cache."
   [name macros]
   (and (not macros)
-    (#{'cljs.analyzer
-       'cljs.analyzer.api
-       'cljs.compiler
-       'cljs.env
-       'cljs.js
-       'cljs.nodejs
-       'cljs.reader
-       'cljs.source-map
-       'cljs.source-map.base64
-       'cljs.source-map.base64-vlq
-       'cljs.spec
-       'cljs.spec.impl.gen
-       'cljs.tagged-literals
-       'cljs.test
-       'cljs.tools.reader
-       'cljs.tools.reader.reader-types
-       'cljs.tools.reader.impl.commons
-       'cljs.tools.reader.impl.utils
-       'clojure.core.reducers
-       'clojure.data
-       'clojure.string
-       'clojure.set
-       'clojure.zip
-       'clojure.walk
-       'cognitect.transit} name)))
+    ('#{cljs.analyzer
+        cljs.analyzer.api
+        cljs.compiler
+        cljs.env
+        cljs.js
+        cljs.nodejs
+        cljs.pprint
+        cljs.reader
+        cljs.source-map
+        cljs.source-map.base64
+        cljs.source-map.base64-vlq
+        cljs.spec
+        cljs.spec.impl.gen
+        cljs.tagged-literals
+        cljs.test
+        cljs.tools.reader
+        cljs.tools.reader.reader-types
+        cljs.tools.reader.impl.commons
+        cljs.tools.reader.impl.utils
+        clojure.core.reducers
+        clojure.data
+        clojure.string
+        clojure.set
+        clojure.zip
+        clojure.walk
+        cognitect.transit} name)))

 (defn- skip-load?
   [name macros?]
@@ -168,7 +169,6 @@
         cljs.compiler.macros
         cljs.tools.reader.reader-types}
      '#{cljs.core
-        cljs.pprint
         com.cognitect.transit
         com.cognitect.transit.delimiters
         com.cognitect.transit.handlers


Toggle sub-expressions within arranged expressions

--- src/cljs_formatter.cljs
+++ src/cljs_formatter.cljs
@@ -96,6 +96,7 @@
 (def next-state rest)

 (defn arrange-keyval! [state elem container]
+  (d/add-class! elem "arranged")
   (let [[key separator val] (d/children elem)]
     (arrange-element! state key container)
     (arrange-element! state val container)
@@ -106,7 +107,8 @@
                           :margin-left "1em"}))))

 (def collection-styles
-  {:display "inline-block"
+  {:color "black"
+   :display "inline-block"
    :padding-top "1px"
    :padding-right "2px"
    :padding-bottom "2px"
@@ -118,6 +120,7 @@
    :border-bottom-left-radius "10px"})

 (defn arrange-collection! [state elem container]
+  (d/add-class! elem "arranged")
   (d/set-styles! elem (merge collection-styles
                              {:background-color (color state)}))
   (let [[opener contents closer] (d/children elem)]
@@ -141,6 +144,8 @@
 (defn remove-all-styles! [elem]
   ;; remove-attr! doesn't always work
   (d/set-attr! elem :style "")
+  (d/remove-class! elem "condensed")
+  (d/remove-class! elem "arranged")
   (doseq [child (d/children elem)]
     (remove-all-styles! child)))

@@ -148,7 +153,6 @@
   (remove-all-styles! elem)
   (d/set-styles! elem {:white-space "pre"})
   (d/remove-class! elem "condensed")
-  (d/add-class! elem "arranged")
   (when (overflow? elem container)
     (cond
      (d/has-class? elem "collection")
@@ -160,6 +164,7 @@
   (arrange-element! initial-arrange-state elem container))

 (defn condense-collection! [elem container]
+  (d/add-class! elem "condensed")
   (let [[opener contents closer] (d/children elem)
         w (- (max-inline-width elem container)
              (* 2 (+ (width opener) (width closer))))]
@@ -175,22 +180,38 @@
   (remove-all-styles! elem)
   (d/set-styles! elem {:white-space "pre"})
   (d/remove-class! elem "arranged")
-  (d/add-class! elem "condensed")
   (when (overflow? elem container)
     (when (d/has-class? elem "collection")
       (condense-collection! elem container))))
+
+(defn find-arranged-parent [elem container]
+  (cond (= container elem)
+          elem
+        (and (gdom/isElement elem)
+             (d/has-class? elem "collection")
+             (d/has-class? elem "arranged"))
+          elem
+        :else
+          (recur (.-parentNode elem) container)))

 (defn toggle! [elem container]
   (cond (d/has-class? elem "condensed")
         (arrange! elem container)
         (d/has-class? elem "arranged")
-        (condense! elem container)
-        :else
-        (condense! elem container)))
+        (do (condense! elem (find-arranged-parent (.-parentNode elem)
+                                                  container))
+            (d/set-styles! elem {:display "block"}))))

 (defn set-toggle-on-click! [elem container]
   (events/listen (d/single-node elem) "click"
-                 (fn [e]
-                   (.stopPropagation e)
-                   (.preventDefault e)
-                   (toggle! elem container))))
+                 (fn [event]
+                   (loop [elem (.-target event)]
+                     (when elem
+                       (if (and (gdom/isElement elem)
+                                (d/has-class? elem "collection")
+                                (or (d/has-class? elem "condensed")
+                                    (d/has-class? elem "arranged")))
+                         (do (.stopPropagation event)
+                             (.preventDefault event)
+                             (toggle! elem container))
+                         (recur (.-parentNode elem))))))))


Add load-pixels support.

Add load-pixels support.

--- src/cljx/quil/core.cljx
+++ src/cljx/quil/core.cljx
@@ -150,6 +150,24 @@
 #+cljs
 (defn
   ^{:require-bindings true
+    :category "Image"
+    :subcategory "Pixels"
+    :added "1.0"}
+  load-pixels
+  "Loads the pixel data for the display window (or an image) into the pixels[] array.
+  This function must always be called before reading from or writing to pixels[].
+
+  Certain renderers may or may not seem to require loadPixels() or updatePixels().
+  However, the rule is that any time you want to manipulate the pixels[] array,
+  you must first call loadPixels(), and after changes have been made, call updatePixels().
+  Even if the renderer may not seem to use this function in the current Processing release,
+  this will always be subject to change."
+  []
+  (.loadPixels (current-graphics)))
+
+#+cljs
+(defn
+  ^{:require-bindings true
     :category "Output"
     :subcategory "Text area"
     :added "1.0"}


Fixed issue #21: Packages on the "All CCS descriptions" should be sorted.

--- src/clouseau/server.clj
+++ src/clouseau/server.clj
@@ -62,8 +62,11 @@
             desc))) ; (.replaceAll desc "\n" "<br />"))))

 (defn read-all-descriptions
+    "Read all descriptions from a table 'ccs-db' stored in a file 'ccs_descriptions.db'."
     []
-    (jdbc/query ccs-db (str "select name, description from packages order by name;")))
+    ; we need to use trim() here because some package names starts with one space or even with more spaces
+    ; due to errors in the original database
+    (jdbc/query ccs-db (str "select trim(name) as name, description from packages order by trim(name);")))

 (defn store-ccs-description
     [package description]


add new rules to cover 'day after tomorrow' without the article in EN

--- resources/duckling/rules/en.cycles.clj
+++ resources/duckling/rules/en.cycles.clj
@@ -65,11 +65,19 @@
   "the <cycle> after <time>"
   [#"(?i)the" (dim :cycle) #"(?i)after" (dim :time)]
   (cycle-nth-after (:grain %2) 1 %4)
+
+  "<cycle> after <time>"
+  [(dim :cycle) #"(?i)after" (dim :time)]
+  (cycle-nth-after (:grain %1) 1 %3)

   "the <cycle> before <time>"
   [#"(?i)the" (dim :cycle) #"(?i)before" (dim :time)]
   (cycle-nth-after (:grain %2) -1 %4)

+  "<cycle> before <time>"
+  [(dim :cycle) #"(?i)before" (dim :time)]
+  (cycle-nth-after (:grain %1) -1 %3)
+
   "last n <cycle>"
   [#"(?i)last|past" (integer 1 9999) (dim :cycle)]
   (cycle-n-not-immediate (:grain %3) (- (:value %2)))


Validate arguments as directories

Validate arguments as directories


Add missing fn

Add missing fn

--- src/detritus/update.clj
+++ src/detritus/update.clj
@@ -16,6 +16,8 @@
        [k (apply f v args)])
      (into {})))

+(defn map-entry [x y]
+  [x y])

 (defn map-keys
   "Create a new map from m by calling function f on each key to get a
@@ -26,7 +28,6 @@
           (for [[k v] m]
             (map-entry (apply f k args) v)))))

-
 (defn map-vals-with-keys
   "Create a new map from m by calling function f, with two
   arguments (the key and value) to get a new value."
@@ -36,7 +37,6 @@
           (for [[k v] m]
             (map-entry k (apply f k v args))))))

-
 (defn map-keys-and-vals
   "Create a new map from m by calling function f on each key & each
   value to get a new key & value"
@@ -45,7 +45,6 @@
     (into {}
           (for [[k v] m]
             (map-entry (apply f k args) (apply f v args))))))
-

 (defn fix
   "λ (fn T → T) → T → T
@@ -59,7 +58,6 @@
       dat
       (recur f dat'))))

-
 (defn update
   "λ {A → B} → A → (λ B → args* → C) → args* → {A → C}

@@ -68,7 +66,6 @@
   [map key f & args]
   (assoc map key
          (apply f (get map key) args)))
-

 ;; Conditional update operations
 ;;--------------------------------------------------------------------
@@ -85,7 +82,6 @@
     (apply f x args)
     x))

-
 (defn ->>when-update
   "Function of a predicate, an updater, optional varargs and a
   value. If the predicate is true of the value, returns (apply f x


update action upon successful move, limit action count to two

--- src/dodgeball/core.cljs
+++ src/dodgeball/core.cljs
@@ -95,6 +95,13 @@
     (render [_]
       (dom/h2 nil (str "Actions: " data)))))

+(defn flip-team [app]
+  (om/update! app :actions 0)
+  (if (= (:turn @app) :red-team)
+    (om/update! app :turn :blue-team)
+    (om/update! app :turn :red-team)))
+
+
 (defn board-view [app owner]
   (reify
     om/IInitState
@@ -107,29 +114,33 @@
      (let [move (om/get-state owner :move)]
        (go (loop []
           (let [selected (:coords (<! move))]
-            (om/set-state! owner :selected-unit (first (filter #(= selected (:coords %)) ((:turn app) (:cells @app-state)))))
+            (om/set-state! owner :selected-unit (first (filter #(= selected (:coords %)) ((:turn @app) (:cells @app)))))
             (let [target (:coords (<! move))]
             (if (or
-                 (unit? (:turn app) target)
+                 (unit? (:turn @app) target)
                  (not (in-range? target selected)))
               (om/set-state! owner :selected-unit nil)
                (om/transact!
                app
-               [:cells (:turn app)]
+               [:cells (:turn @app)]
                (fn [units]
                   (map
                    #(if (= (om/get-state owner :selected-unit) %)
-                      {:coords target}
+                      ((fn []
+                        (om/transact! app :actions inc)
+                         (cond (= (:actions @app) 2)
+                           (flip-team app))
+                         {:coords target}))
                       %)
                    units))))
-              (om/transact! app :actions (fn [a] (inc a)))))
+              ))
           (recur)))))

     om/IRenderState
     (render-state [this {:keys [move]}]
       (dom/div #js {:className "container"}
-        (om/build turn-view (:turn app))
-        (om/build action-view (:actions app))
+        (om/build turn-view (:turn @app))
+        (om/build action-view (:actions @app))
         (bench)
         (apply dom/table nil
           (vec (for [y board-length]


Fixing tests

Fixing tests

to-graph function is renamed according to Clojure style guide.
See https://github.com/bbatsov/clojure-style-guide#naming

--- test/larva/graph_test.clj
+++ test/larva/graph_test.clj
@@ -7,50 +7,50 @@

 (deftest root-successors-test
   (testing "Number of root node successors."
-    (is (= 2 (-> (lg/to-graph standard-program-1)
+    (is (= 2 (-> (lg/->graph standard-program-1)
                  (g/successors lg/root-node)
                  count)))
-    (is (= 1 (-> (lg/to-graph standard-program-2)
+    (is (= 1 (-> (lg/->graph standard-program-2)
                  (g/successors lg/root-node)
                  count)))
-    (is (= 3 (-> (lg/to-graph standard-program-with-meta)
+    (is (= 3 (-> (lg/->graph standard-program-with-meta)
                  (g/successors lg/root-node)
                  count)))))

 (deftest root-successors-names-test
   (testing "Root node successors names."
-    (is (= #{"about" "meta" :entities} (-> (lg/to-graph standard-program-with-meta)
+    (is (= #{"about" "meta" :entities} (-> (lg/->graph standard-program-with-meta)
                                            (g/successors lg/root-node)
                                            set)))))

 (deftest entities-successors-test
   (testing "Number of entities-dispatch-node successors."
-    (is (= 3 (-> (lg/to-graph standard-program-1)
+    (is (= 3 (-> (lg/->graph standard-program-1)
                  (g/successors lg/entities-node)
                  count)))
-    (is (= 4 (-> (lg/to-graph standard-program-11)
+    (is (= 4 (-> (lg/->graph standard-program-11)
                  (g/successors lg/entities-node)
                  count)))
-    (is (= 3 (-> (lg/to-graph standard-program-2)
+    (is (= 3 (-> (lg/->graph standard-program-2)
                  (g/successors lg/entities-node)
                  count)))
-    (is (= 0 (-> (lg/to-graph no-entities-edge-case)
+    (is (= 0 (-> (lg/->graph no-entities-edge-case)
                  (g/successors lg/entities-node)
                  count)))
-    (is (= 0 (-> (lg/to-graph no-entities-no-about-edge-case)
+    (is (= 0 (-> (lg/->graph no-entities-no-about-edge-case)
                  (g/successors lg/entities-node)
                  count)))))

 (deftest entity-property-test
   (testing "Name of properties of a specific entity."
     (is (= #{"name" "surname" "nickname" "honors"}
-           (let [g (lg/to-graph standard-program-1)
+           (let [g (lg/->graph standard-program-1)
                  n "Musician"]
              (->> (g/successors g n)
                   (mapv #(:name (g/attrs g %)))
                   set))))
     (is (= #{"name" "location"}
-           (let [g (lg/to-graph standard-program-1)
+           (let [g (lg/->graph standard-program-1)
                  n "Festival"]
              (->> (g/successors g n)
                   (mapv #(:name (g/attrs g %)))
@@ -68,30 +68,30 @@
           p3 {:name "bands" :type {:coll :ref-to :signature "Band"}
               :gui-label "participant bands"}]
       (is (= 0
-             (-> (lg/to-graph standard-program-no-refs)
+             (-> (lg/->graph standard-program-no-refs)
                  (g/out-edges (lg/build-property-label p0 "Musician"))
                  count)))
       (is (= 0
-             (-> (lg/to-graph standard-program-no-refs)
+             (-> (lg/->graph standard-program-no-refs)
                  (g/out-edges (lg/build-property-label p01 "Musician"))
                  count)))
       ;; whole-part relationship
       (is (= "Category"
-             (-> (lg/to-graph standard-program-cardinality-1)
+             (-> (lg/->graph standard-program-cardinality-1)
                  (g/out-edges (lg/build-property-label p1 "Category"))
                  first :dest)))
       (is (= "Band"
-             (-> (lg/to-graph references-1)
+             (-> (lg/->graph references-1)
                  (g/out-edges (lg/build-property-label p2 "Musician"))
                  first :dest)))
       (is (= "Band"
-             (-> (lg/to-graph references-1)
+             (-> (lg/->graph references-1)
                  (g/out-edges (lg/build-property-label p3 "Festival"))
                  first :dest))))))

 (deftest property-reference-cardinality-test
   (testing "Cardinality of the property-entity relationships."
-    (let [g (lg/to-graph references-1)
+    (let [g (lg/->graph references-1)
           p1 {:name "band" :type {:one :ref-to :signature "Band"}
               :gui-label "Of band"}
           p2 {:name "bands" :type {:coll :ref-to :signature "Band"}
@@ -120,7 +120,7 @@
 (deftest cardinality-graph-presentation-test
   (testing "If cardinality expressed through uni-model is established in graph
  representation of the program."
-    (let [g (lg/to-graph references-1)
+    (let [g (lg/->graph references-1)
           band-particip {:name "participated" :type {:coll :ref-to :signature
                                                      "Festival"}
                          :gui-label "Participated in"}


First draft of composable contexts

First draft of composable contexts

--- lazytest.clj
+++ lazytest.clj
@@ -1,166 +1,39 @@
-(deftype Context [before after])
+(deftype Context [parents before after])

-(deftype Assertion [locals form])
+(defn open-context
+  "Opens context c, and all its parents, unless it is already active."
+  [active c]
+  (let [active (reduce open-context active (:parents c))
+        states (map active (:parents c))]
+    (if-let [f (:before c)]
+      (assoc active c (or (active c) (apply f states)))
+      active)))
+
+(defn close-context
+  "Closes context c and removes it from active."
+  [active c]
+  (let [states (map active (:parents c))]
+    (when-let [f (:after c)]
+      (apply f (active c) states))
+    (let [active (reduce close-context active (:parents c))]
+      (dissoc active c))))
+
+(def c1 (Context nil nil nil))
+
+(assert (= {} (open-context {} c1)))
+(assert (= {} (close-context {} c1)))
+
+(def c2 (Context nil (fn [] 2) (fn [x] (assert (= x 2)))))
+
+(assert (= {c2 2} (open-context {} c2)))
+(assert (= {} (close-context {c2 2} c2)))
+(assert (= {c2 0} (open-context {c2 0} c2)))
+
+(def c3 (Context [c2] (fn [s2] (assert (= s2 2)) 3)
+                 (fn [x s2] (assert (= x 3)) (assert (= s2 2)))))
+
+(assert (= {c2 2, c3 3} (open-context {} c3)))
+(assert (= {} (close-context {c2 2, c3 3} c3)))

 (deftype TestCase [contexts children])

-(defprotocol TestSuccess
-  (success? [r] "Returns true if r is a 100% successful result."))
-
-(deftype TestResult [source children]
-  TestSuccess (success? [] (every? success? children)))
-
-(deftype TestThrown [source error]
-  TestSuccess (success? [] false))
-
-(deftype AssertionPassed [source]
-  TestSuccess (success? [] true))
-
-(deftype AssertionFailed [source]
-  TestSuccess (success? [] false))
-
-(deftype AssertionThrown [source error]
-  TestSuccess (success? [] false))
-
-(defn- format-assertion [a]
-  {:pre [(= ::Assertion (type a))
-         (vector? (:locals a))]}
-  (let [form (:form a)]
-    `(fn ~(:locals a)
-       (try (if ~form
-              (AssertionPassed '~form)
-              (AssertionFailed '~form))
-            (catch Throwable t#
-              (AssertionThrown '~form t#))))))
-
-(defn compile-assertion [a]
-  (eval (format-assertion a)))
-
-(defmacro assertion [locals form]
-  (format-assertion (Assertion locals form)))
-
-(defn- unchunked-map
-  "Like map but does not chunk results; slower but lazier than map."
-  [f coll]
-  (lazy-seq
-   (when (seq coll)
-     (cons (f (first coll))
-           (unchunked-map f (next coll))))))
-
-(defn run-test-case
-  ([t] (run-test-case t {}))
-  ([t active]
-     {:pre [(= ::TestCase (type t))
-            (every? #(= ::Context (type %)) (:contexts t))]}
-     (try
-      (let [contexts (:contexts t)
-            states (map (fn [c] (when-let [b (:before c)]
-                                  (or (active c) (b)))) contexts)
-            merged (merge active (zipmap contexts states))
-            ;; Prevent chunking for truly lazy execution:
-            results (unchunked-map (fn [c] (if (fn? c)
-                                             (apply c states)
-                                             (run-test-case c merged)))
-                                   (:children t))]
-        ;; Force non-lazy execution to handle shutdown properly:
-        (when (some :after contexts)
-          (dorun results)
-          (dorun (map (fn [c state] (when-not (active c) ((:after c) state)))
-                      (reverse contexts) (reverse states))))
-        (TestResult t results))
-      (catch Throwable e (TestThrown t e)))))
-
-(defn result-seq [r]
-  (tree-seq :children :children r))
-
-(defprotocol Testable
-  (run-tests [x]))
-
-(defn var-test-case [v]
-   #^{:name (:name (meta v))}
-   (TestCase [] [(assertion [] (clojure.core/test v))]))
-
-(defn test-var [v]
-  (run-test-case (var-test-case v)))
-
-(defn ns-test-case [n]
-  #^{:name (ns-name n)}
-  (TestCase [] (map var-test-case (ns-interns n))))
-
-(defn test-ns [n]
-  (run-test-case (ns-test-case n)))
-
-(extend ::TestCase Testable {:run-tests run-test-case})
-(extend clojure.lang.Var Testable {:run-tests test-var})
-(extend clojure.lang.Namespace Testable {:run-tests test-ns})
-
-(defmacro defcontext
-  "decl => docstring? before-forms* :after [arg] after-forms*"
-  [name & decl]
-  (let [docstring (if (string? (first decl)) (first decl) nil)
-        decl      (if (string? (first decl)) (next decl) decl)
-        before    (take-while #(not= :after %) decl)
-        decl      (next (drop-while #(not= :after %) decl))
-        argv      (first decl)
-        after     (next decl)]
-    `(def ~name
-          (with-meta (Context ~(when (seq before) `(fn [] ~@before))
-                              ~(when (seq after) `(fn ~argv ~@after)))
-            {:name '~name, :doc ~docstring}))))
-
-;;; USAGE
-
-(def c1 (Context (fn [] (println "Opening lazy context c1.") 1) nil))
-
-(def c2 (Context (fn [] (println "Opening lazy context c2.") 2) nil))
-
-(def c3 (Context (fn [] (println "Opening strict context c3.") 3)
-                 (fn [x] (println "Closing strict context c3." x))))
-
-(def c4 (Context (fn [] (println "Opening strict context c4.") 4)
-                 (fn [x] (println "Closing strict context c4." x))))
-
-(def c5 (Context nil nil))
-
-(def c6 (Context (fn [] (throw (ArithmeticException.))) nil))
-
-(def c7 (Context nil (fn [x] (throw (ArithmeticException.)))))
-
-(def a1 (assertion [a] (do (println "Executing assertion a1.")
-                           (pos? a))))
-
-(def a2 (assertion [a] (do (println "Executing assertion a2.")
-                           (pos? a))))
-
-(def a3 (assertion [a] (do (println "Executing assertion a3.")
-                           (pos? a))))
-
-(def a4 (assertion [a b] (do (println "Executing assertion a4.")
-                             (< a b))))
-
-(def a5 (assertion [a b] (do (println "Executing assertion a5.")
-                             (= a b))))
-
-(def t1 (TestCase [c1] [a1]))
-
-(def t2 (TestCase [c1] [a1 a2 a3]))
-
-(def t3 (TestCase [] [t1 t2]))
-
-(def t4 (TestCase [c1] [t1 t2]))
-
-(def t5 (TestCase [c1 c2] [a4 a5]))
-
-(def t6 (TestCase [] [t5 t4]))
-
-(def t7 (TestCase [c3] [a1 a2 a3]))
-
-(def t8 (TestCase [c3 c4] [a4 a5]))
-
-(def t9 (TestCase [] [t8 t8]))
-
-(def t10 (TestCase [c5] [a1 a2]))
-
-(def t11 (TestCase [c6] [a1 a2]))
-
-(def t12 (TestCase [c7] [a1 a2]))


added comment for swap-docspec-in!

added comment for swap-docspec-in!

--- src/karras/document.clj
+++ src/karras/document.clj
@@ -165,7 +165,9 @@
   [type & kvs]
   (swap! docspecs assoc type (apply assoc (docspec type) kvs)))

-(defn swap-docspec-in! [type attribute-path f & args]
+(defn swap-docspec-in!
+  "Combines swap! and assoc-in to modify the attribute of a docspec."
+  [type attribute-path f & args]
   (swap! docspecs
          (fn [specs]
            (let [path (cons type attribute-path)


Change track name search to be more logical

Search whole name instead of splitting it into
tokens.

--- src/ktra_indexer/db.clj
+++ src/ktra_indexer/db.clj
@@ -7,7 +7,6 @@
             [java-time :as t]
             [ktra-indexer.config :as cfg])
   (:import org.apache.commons.text.similarity.LevenshteinDistance
-           org.apache.commons.text.StrTokenizer
            org.postgresql.util.PSQLException))

 (let [db-host (get (System/getenv)
@@ -369,14 +368,18 @@
 (defn get-episodes-with-track
   "Returns track name, artist, episode name and number of the provided track."
   [db-con track-name]
-  (let [tokenizer (new StrTokenizer (s/replace track-name #"[()&;\-{2}\']" ""))
-        tokens (.getTokenArray tokenizer)]
-    (j/query db-con
-             [(str "SELECT t.name AS track, a.name AS artist, e.number, "
-                   "e.name AS ep_name FROM tracks t "
-                   "INNER JOIN artists a USING (artist_id) "
-                   "INNER JOIN episode_tracks et USING (track_id) "
-                   "INNER JOIN episodes e ON e.ep_id = et.ep_id "
-                   "WHERE to_tsvector(t.name) @@ to_tsquery(?)"
-                   "ORDER BY ep_name ASC")
-              (s/join " & " tokens)])))
+  (j/query db-con
+           (sql/format (sql/build :select [[:t.name :track]
+                                           [:a.name :artist]
+                                           :e.number
+                                           [:e.name :ep_name]]
+                                  :from [[:tracks :t]]
+                                  :join [[:artists :a]
+                                         [:= :a.artist_id :t.artist_id]
+                                         [:episode_tracks :et]
+                                         [:= :t.track_id :et.track_id]
+                                         [:episodes :e]
+                                         [:= :e.ep_id :et.ep_id]]
+                                  :where (sql/raw
+                                          ["t.name LIKE '%" track-name "%'"])
+                                  :order-by [[:ep_name :asc]]))))


Move dirty? into table protocol.

Move dirty? into table protocol.

--- src/merkle_db/table.clj
+++ src/merkle_db/table.clj
@@ -156,6 +156,10 @@
     "Remove some records from the table, identified by a collection of id keys.
     Returns an updated table.")

+  (dirty?
+    [table]
+    "Return true if the table has local non-persisted modifications.")
+
   (flush!
     [table]
     [table opts]
@@ -417,13 +421,6 @@
         patch'
         true
         (._meta table)))))
-
-
-; TODO: put this in protocol?
-(defn dirty?
-  "Return true if the table has local non-persisted modifications."
-  [^Table table]
-  (.dirty table))

@@ -636,6 +633,12 @@
     table))

+(defn -dirty?
+  "Internal `dirty?` implementation."
+  [^Table table]
+  (.dirty table))
+
+
 (defn- flush-changes
   "Returns a vector containing a link to a patch tablet and an index tree."
   [^Table table full?]
@@ -665,7 +668,7 @@
   ([table]
    (-flush! table nil))
   ([^Table table opts]
-   (if (dirty? table)
+   (if (.dirty table)
      (let [[patch-link data-link] (flush-changes table (:apply-patch? opts))
            root-data (-> (.root-data table)
                          (assoc :data/type :merkle-db/table)
@@ -699,8 +702,12 @@
    :read -read
    :insert -insert
    :delete -delete
+   :dirty? -dirty?
    :flush! -flush!})

+
+
+;; ## Utility Functions

 (defn table-stats
   "Calculate statistics about the structure of the given table."


fix output of '(with authentication)' string.

--- src/ancient_clj/io.clj
+++ src/ancient_clj/io.clj
@@ -10,8 +10,8 @@
   (let [msg (format "  Trying to retrieve '%s' ..." url)
         username (when (seq username) username)]
     (if username
-      (verbose msg)
-      (verbose msg "(with authentication)"))
+      (verbose msg "(with authentication)")
+      (verbose msg))
     (if-not username
       (slurp url)
       (try


trash Asset/Agenda in filled servers on install

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -249,15 +249,21 @@
               "R&D" [:servers :rd]
               "Archives" [:servers :archive]
               "New remote" [:servers :remote (count (get-in @state [:corp :servers :remote]))]
-              [:servers :remote (-> (split server " ") last js/parseInt)])
-        card-type (:type card)
-        slot (case card-type
-               "ICE" (conj dest :ices)
-               ("Agenda" "Asset" "Upgrade") (conj dest :content))
-        cost (if (= card-type "ICE") [:credit (count (get-in @state (cons :corp slot)))])]
-    (when (apply pay (concat [state side :click 1] cost))
-      (system-msg state side (str "installs a" (if (= card-type "ICE") "n ICE" " card") " in " server))
-      (move state side card slot))))
+              [:servers :remote (-> (split server " ") last js/parseInt)])]
+    (if (= (:type card) "ICE")
+      (let [slot (conj dest :ices)]
+        (when (pay state side :click 1 :credit (count (get-in @state (cons :corp slot))))
+          (move state side card slot)
+          (system-msg state side (str "install an ICE on " server))))
+      (when (pay state side :click 1)
+        (let [slot (conj dest :content)]
+          (when (#{"Asset" "Agenda"} (:type card))
+            (doseq [c (get-in @state (cons :corp slot))]
+              (when (#{"Asset" "Agenda"} (:type c))
+                (trash state side c)
+                (system-msg state side (str "trash a card in " server)))))
+          (move state side card slot))
+        (system-msg state side (str "installs a card in " server))))))

 (defn play [state side {:keys [card server]}]
   (case (:type card)


minor regexp improvement

minor regexp improvement

--- src/notehub/storage.clj
+++ src/notehub/storage.clj
@@ -9,7 +9,7 @@
   (defn sign
     "Returns the MD5 hash for the concatenation of all passed parameters"
     [& args]
-    (let [input (sreplace (apply str args) #"\r*" "")]
+    (let [input (sreplace (apply str args) #"\r+" "")]
       (do (.reset md5Instance)
           (.update md5Instance (.getBytes input))
           (apply str


(Should actually commit the files)

(Should actually commit the files)

--- src/parmenides/core.clj
+++ src/parmenides/core.clj
@@ -6,26 +6,24 @@
             [aleph.http :as http]
             [schema.core :as s]
             [parmenides.ocd :refer [OCD]]
-            [clojure.data.json :refer [read-str]
-                                        ;[clojure.java.shell :refer [sh]]
-             ]))
-
+            [clojure.data.json :refer [read-str]]
+            [taoensso.timbre :as timbre]))
+(timbre/refer-timbre)

 (def last-requests (atom []))
-
 (defn ingest [{body :body params :params}]
-  ;;(println (str params) (quot (System/currentTimeMillis) 1000))
-  (when-not (:save params)
-    (let [filename (str "example-data/"(str (d/squuid)))]
-      (spit filename (slurp body))
-      (println filename)))
-  (let [{data "data" apikey "apikey"} (read-str (slurp body))]
-    (println apikey)
-    (swap! last-requests concat data)))
+  (info "recieved file")
+  (let [body (slurp body)]
+    (when-not (:save params)
+      (let [filename (str "example-data/"(str (d/squuid)))]
+        (spit filename body)
+        (info filename)))
+    (let [{data "data" apikey "api-key"} (read-str body)]
+      (swap! last-requests concat data))))

 (defroutes app
   (GET "/index.html" [] "test")
-  (POST "/ingest" request (ingest request) "HELLO PAULTAG SHALL WE PLAY A GAME?\n")
+  (POST "/ingest" request (ingest request) "*burp*\n")
   (route/not-found "OH SNAP SON"))

 (declare server)
@@ -33,5 +31,9 @@

 (def server (http/start-server (wrap-defaults app api-defaults) {:port 80}))

-(count (clojure.java.shell/sh "./test.sh"))
+#_(count (clojure.java.shell/sh "./smalltest.sh"))
+#_(count (clojure.java.shell/sh "./fulltest.sh"))
+
+
 (count (map (partial s/validate OCD) @last-requests))
+1


Little clsts trace helper function

Little clsts trace helper function

--- src/polismath/utils.clj
+++ src/polismath/utils.clj
@@ -94,6 +94,15 @@
   (require '[clojure.tools.trace :as tr]))

+(defn clst-trace
+  ([clsts] (clst-trace "" clsts))
+  ([k clsts]
+   (println "TRACE" k ":")
+   (doseq [c clsts]
+     (println "   " c))
+   clsts))
+
+
 (defn prep-for-uploading-bidToPid-mapping [results]
   {"bidToPid" (:bid-to-pid results)})


Cleanup based on recommendations by ninjudd.

--- src/cake/tasks/new.clj
+++ src/cake/tasks/new.clj
@@ -11,6 +11,16 @@
   :dependencies [[clojure \"1.2.0\"]])
 ")

+(def template-dir (file "~" ".cake" "template"))
+
+(defn rename-dirs [root project]
+  (log "Renaming directories with +project+ in their name")
+  (doseq [old-file (reverse (sort-by (comp count str) (file-seq root)))
+          :let [name (.getName old-file)
+                replaced (.replace name "+project+" project)]
+          :when (not= name replaced)]
+    (.renameTo old-file (file (.getParent old-file) replaced))))
+
 (defn template-new [project]
   (let [root (file *pwd* project)]
     (if (.exists root)
@@ -18,40 +28,32 @@
       (do
         (log "Creating a new project based on ~/.cake/template")
         (ant Copy {:todir root} (add-fileset {:dir (str (file "~" ".cake" "template"))}))
-        (let [files (file-seq root)
-              rep (filter identity
-                          (map #(let [name (.getName %)
-                                      replaced (.replace name "+project+" project)]
-                                  (when (not= replaced name) [% (file (.getParent %) replaced)]))
-                               files))]
-          (log "Renaming directories with +project+ in their name")
-          (doseq [[from to] (sort-by (comp count str second) #(or (and (= % %2) 0) 1) rep)]
-            (.renameTo from to))
-          (let [files (file-seq root)]
-            (log (str "Replacing +project+ with '" project "' in all files."))
-            (doseq [f (filter #(.isFile %) files)]
-              (spit f (.replace (slurp f) "+project+" project)))))))))
+        (rename-dirs root project)
+        (let [files (file-seq root)]
+          (log (str "Replacing +project+ with '" project "' in all files."))
+          (doseq [f (filter #(.isFile %) files)]
+            (spit f (.replace (slurp f) "+project+" project))))))))
+
+(defn create-default-template [project]
+  (do
+    (log "Creating template directory: ~/.cake/template")
+    (ant Mkdir {:dir template-dir})
+    (ant Mkdir {:dir (file template-dir "src" "+project+")})
+    (spit (file template-dir "src" "+project+" "core.clj") "(ns +project+.core)")
+    (log "Created template file: src/+project+/core.clj")
+    (ant Mkdir {:dir (file template-dir "test")})
+    (spit (file template-dir "project.clj") (format default-template project))
+    (log "Created template file: project.clj")
+    (spit (file template-dir ".gitignore")
+          (apply str (interleave [".cake" "pom.xml" "*.jar" "*.war" "lib" "classes" "build" project] (repeat "\n"))))
+    (log "Created template file: .gitignore")
+    (extract-resource "LICENSE" template-dir)
+    (log "Created template LICENSE file (Eclipse Public License)")
+    (template-new project)))

 (deftask new
   "Create scaffolding for a new project."
   "You can put a default project template in ~/.cake/template. Substitute +project+ anywhere
    that you want your project name to be."
   [{[project] :new}]
-  (let [template-dir (file "~" ".cake" "template")]
-    (if (.exists template-dir)
-      (template-new project)
-      (do
-        (log "Creating template directory: ~/.cake/template")
-        (ant Mkdir {:dir template-dir})
-        (ant Mkdir {:dir (file template-dir "src" "+project+")})
-        (spit (file template-dir "src" "+project+" "core.clj") "(ns +project+.core)")
-        (log "Created template file: src/+project+/core.clj")
-        (ant Mkdir {:dir (file template-dir "test")})
-        (spit (file template-dir "project.clj") (format default-template project))
-        (log "Created template file: project.clj")
-        (spit (file template-dir ".gitignore")
-              (apply str (interleave [".cake" "pom.xml" "*.jar" "*.war" "lib" "classes" "build" project] (repeat "\n"))))
-        (log "Created template file: .gitignore")
-        (extract-resource "LICENSE" template-dir)
-        (log "Created template LICENSE file (Eclipse Public License)")
-        (template-new project)))))
+  (if (.exists template-dir) (template-new project) (create-default-template project)))


Renamed lane credentials to more generic lane state.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -27,29 +27,32 @@
         lane-buf-size 20
         make-lane (fn [actx lane-name lane-out-ch]
                     (let [lane-in-ch (achan-buf actx lane-buf-size)
-                          cred-ch (achan actx)
-                          cred-cb (fn [is-req msg lane-state]
-                                    (if is-req
-                                      (if msg
-                                        [(assoc msg :cred-ch cred-ch) lane-state]
-                                        (do (act close-cred actx
-                                                 (aclose close-cred cred-ch))
-                                            [msg lane-state]))
-                                      [msg lane-state]))]
+                          lane-state-ch (achan actx)
+                          lane-state-cb (fn [is-req m lane-ext-state]
+                                          (if is-req
+                                            (if m
+                                              [(assoc m :lane-state-ch lane-state-ch)
+                                               lane-ext-state]
+                                              (do (act closer actx
+                                                       (aclose closer lane-state-ch))
+                                                  [m lane-ext-state]))
+                                            [m lane-ext-state]))]
+                      (act-loop lane-state-loop actx [lane-state nil]
+                                (let [m (atake lane-state-loop lane-state-ch)]
+                                  (case (:op m)
+                                    :get-lane-state
+                                    (do (aput lane-state-loop (:res-ch m)
+                                              (assoc m :status :ok :value lane-state))
+                                        (recur lane-state))
+                                    :update-lane-state
+                                    (do (aput lane-state-loop (:res-ch m)
+                                              (assoc m :status :ok))
+                                        (recur ((:update-fn m) lane-state)))
+                                    :unknown-op)))
                       (cbfg.fence/make-fenced-pump actx lane-name
                                                    lane-in-ch lane-out-ch
                                                    lane-max-inflight false
-                                                   :ext-cb cred-cb)
-                      (act-loop lane-cred actx [cred nil]
-                                (let [m (atake lane-cred cred-ch)]
-                                  (case (:op m)
-                                    :get-cred (do (aput lane-cred (:res-ch m)
-                                                        (assoc m :status :ok :result cred))
-                                                  (recur cred))
-                                    :set-cred (do (aput lane-cred (:res-ch m)
-                                                        (assoc m :status :ok))
-                                                  (recur (:cred m)))
-                                    :mismatch)))
+                                                   :ext-cb lane-state-cb)
                       lane-in-ch))
         conn-loop (fn [actx server-send-ch server-recv-ch close-server-recv-ch]
                     (cbfg.world.net/server-conn-loop actx server-send-ch server-recv-ch


make invitation format consistent

make invitation format consistent

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -197,9 +197,9 @@

 (defn- db->invitation [e]
   {:id (:invite/id e)
-   :from (:user/id (:invite/from e))
-   :to (:invite/to e)
-   :group (:group/id (:invite/group e)) })
+   :inviter-id (:user/id (:invite/from e))
+   :invitee-email (:invite/to e)
+   :group-id (:group/id (:invite/group e)) })

 (defmacro with-conn
   "Execute the body with *conn* dynamically bound to a new connection."


Allow configurable chunk size in lazy seqs

We ran into a case where a single item from the seq could fit into
memory, but 32 could not. This just makes `32` a dynamic var instead of
hardcoding it, so if desired the user can do something like

```
(binding [cheshire.parse/*chunk-size* 2]
 (cheshire/parse-stream my-giant-json))
```

Co-authored-by: @cayennes <7fa451de48113f3dee560c091394cab060e46b64@users.noreply.github.com>

--- src/cheshire/parse.clj
+++ src/cheshire/parse.clj
@@ -2,6 +2,8 @@
   (:import (com.fasterxml.jackson.core JsonParser JsonToken)))

 (declare parse*)
+
+(def ^:dynamic *chunk-size* 32)

 (def ^{:doc "Flag to determine whether float values should be returned as
              BigDecimals to retain precision. Defaults to false."
@@ -45,14 +47,14 @@

 (defn lazily-parse-array [^JsonParser jp key-fn bd? array-coerce-fn]
   (lazy-seq
-   (loop [chunk-idx 0, buf (chunk-buffer 32)]
+   (loop [chunk-idx 0, buf (chunk-buffer *chunk-size*)]
      (if (identical? (.getCurrentToken jp) JsonToken/END_ARRAY)
        (chunk-cons (chunk buf) nil)
        (do
          (chunk-append buf (parse* jp key-fn bd? array-coerce-fn))
          (.nextToken jp)
          (let [chunk-idx* (unchecked-inc chunk-idx)]
-           (if (< chunk-idx* 32)
+           (if (< chunk-idx* *chunk-size*)
              (recur chunk-idx* buf)
              (chunk-cons
               (chunk buf)


never restart test pod

never restart test pod

--- src/ci3/controller.clj
+++ src/ci3/controller.clj
@@ -17,7 +17,8 @@
                      :pods {:apiVersion "v1"
                             :kind "Pod"
                             :metadata {:name id :lables {:system "ci3"}}
-                            :spec {:volumes
+                            :spec {:restartPolicy "Never"
+                                   :volumes
                                    [{:name "docker-sock"
                                      :hostPath {:path "/var/run/docker.sock"}}]
                                    :containers


Third draft of sinusoidal conversion function.

--- src/clj/forma/sinu.clj
+++ src/clj/forma/sinu.clj
@@ -7,11 +7,13 @@
 ;; 38,800 chunks for the 1km data means that to do a straight lookup for everything on the rain table is going to take,
 ;; roughly, 90 minutes (distributed across machines). Gotta be a faster way to do this!

+(ns forma.sinu
+  (:use [clojure.contrib.generic.math-functions :only (cos)]))

-(ns forma.sinu)
+
+;; ## Constants

 (def *rho* 6371007.181)
-(def *pi* (Math/PI))
 (def *x-tiles* 36)
 (def *y-tiles* 18)

@@ -20,36 +22,55 @@
    :500 2400
    :1000 1200})

-(defn cos
-  "Takes the cosine of the supplied angle. Angle must be in degrees."
-  [angle]
-  (Math/cos (Math/toRadians angle)))
+;; ## Helper Functions

-(defn degs-by-rho
-  "Multiplies the argument by rho and converts the answer to radians."
-  [arg]
-  (* arg *rho* (/ *pi* 180)))
+(defn to-rad [angle] (Math/toRadians angle))
+(defn to-deg [angle] (Math/toDegrees angle))

-(defn sinusoidal-x
-  "Returns the sinusoidal projection's x coordinate in meters for a given lat and long (in degrees)."
+(defn distance
+  "Calculates distance of magnitude from the starting point in a given direction."
+  [dir start magnitude]
+  (dir start magnitude))
+
+(defn scale
+  "Scales each element in a collection of numbers by the supplied factor."
+  [fact sequence]
+  (for [x sequence] (* x fact)))
+
+(defn x-coord
+  "Returns the x coordinate for a given (lat, long) point."
+  [point]
+  (first point))
+
+(defn y-coord
+  "Returns the y coordinate for a given (lat, long) point."
+  [point]
+  (second point))
+
+(defn sinu-xy
+  "Computes the sinusoidal x and y coordinates for the supplied latitude and longitude (in radians)."
+    [lat lon]
+  (scale *rho* [(* (cos lat) lon) lat]))
+
+(defn sinu-deg-xy
+  "Computes the sinusoidal x and y coordinates for the supplied latitude and longitude (in degrees)."
   [lat lon]
-  (degs-by-rho (* (cos lat) lon)))
-
-(defn sinusoidal-y
-  "Returns the sinusoidal projection's y coordinate in meters for a given lat and long (in degrees)."
-  [lat lon]
-  (degs-by-rho lat))
+  (apply sinu-xy (map to-rad [lat lon])))

 (defn lat-long
   "Computes the latitude and longitude for a given set of sinusoidal map coordinates (in meters)."
   [x y]
   (let [lat (/ y *rho*)
-        lon (/ x (* *rho* (Math/cos lat)))]
-    (map #(Math/toDegrees %) [lat lon])))
+        lon (/ x (* *rho* (cos lat)))]
+    (map to-deg [lat lon])))

-(def min-x (sinusoidal-x 0 -180))
-(def min-y (sinusoidal-y -90 0))
-(def max-y (sinusoidal-y 90 0))
+
+;; These are the meter values of the minimum possible x and y values on a sinusoidal projection. Things get weird at the corners,
+;; so I compute the minimum x and y values separately, along the projection's axes.
+
+(def min-x (x-coord (sinu-deg-xy 0 -180)))
+(def min-y (y-coord (sinu-deg-xy -90 0)))
+(def max-y (y-coord (sinu-deg-xy 90 0)))

 (defn pixel-length
   "The length, in meters, of the edge of a pixel at a given resolution."
@@ -58,15 +79,7 @@
         total-pixels (pixels-at-res res)]
     (/ pixel-span total-pixels)))

-(defn distance
-  "Calculates distance of magnitude from the starting point in a given direction."
-  [dir start magnitude]
-  (dir start magnitude))
-
-(defn scale
-  "Scales each element in a collection of numbers by the supplied factor."
-  [fact seq]
-  (for [x seq] (* x fact)))
+;; ## Main Conversion Functions

 (defn pixel-coords
   "returns the row and dimension of the pixel on the global MODIS grid."


fix Frame Job

fix Frame Job

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -967,7 +967,11 @@
             :msg (msg "trash " (:title target)) :effect (effect (trash target))}}

    "Frame Job"
-   {:additional-cost [:forfeit] :effect (effect (gain :corp :bad-publicity 1))}
+   {:prompt "Choose an agenda to forfeit"
+    :choices (req (get-in runner [:scored]))
+    :effect (effect (forfeit target)
+                    (system-msg (str " forfeits " (:title target) " to give the Corp 1 bad publicity"))
+                    (gain :corp :bad-publicity 1))}

    "Freelance Coding Contract"
    {:choices {:max 5 :req #(and (has? % :type "Program") (= (:zone %) [:hand]))}


atomize by-fn and by extension by

atomize by-fn and by extension by

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -1296,13 +1296,12 @@
             (first fields)
             ; Return a vec of *each* function given, applied to the event
             (apply juxt fields))
-        table (ref {})]
+        table (atom {})]
      (fn stream [event]
        (let [fork-name (f event)
-             fork (dosync
-                    (or ((deref table) fork-name)
-                        ((alter table assoc fork-name (new-fork))
-                           fork-name)))]
+             fork (if-let [fork (@table fork-name)]
+                    fork
+                    ((swap! table assoc fork-name (new-fork)) fork-name))]
          (call-rescue event fork)))))

 (defn changed


Minor tweaks.

Minor tweaks.

--- src/simulacrum/ipip.clj
+++ src/simulacrum/ipip.clj
@@ -1,5 +1,5 @@
 (ns simulacrum.ipip
-  (:require [simulacrum.bigfive :refer [attributes questions-base]]))
+  (:require [simulacrum.bigfive :refer [domains questions-base]]))

 (def facets
@@ -39,5 +39,6 @@
     questions-base
     {:title "IPIP NEO-PI-R Facet Scales Short Inventory"
      :questions
+      [

-    }))
+       ]}))


top level is always a map

top level is always a map

--- src/syncserver/core.clj
+++ src/syncserver/core.clj
@@ -43,8 +43,8 @@
   (if old-state
     (let [os (.getIfPresent cache! old-state)]
       (when os (debug "Cache hit:" os))
-      (object-array [(:current cs) (ddiff [] os (:state cs) #{})]))
-    (object-array [(:current cs) (ddiff [] nil (:state cs) #{})]))))
+      (object-array [(:current cs) (map-diff [] os (:state cs) #{})]))
+    (object-array [(:current cs) (map-diff [] nil (:state cs) #{})]))))

 (defn groovy [s x cls]
   (case (.getMaximumNumberOfParameters cls)
@@ -107,7 +107,7 @@
    (= a b) diffs
    (every? vector? [a b]) (vector-diff path a b diffs)
    (every? map? [a b]) (map-diff path a b diffs)
-   :otherwise (if (= a b) diffs (conj diffs [:set path b]))))
+   :otherwise (conj diffs [:set path b])))

 (comment
   (defn -main [& args]


correct estimation now done

correct estimation now done

--- src/crawler/corpus.clj
+++ src/crawler/corpus.clj
@@ -292,7 +292,9 @@
   [a-model pagination corpus]
   ;(println :corpus-size (count corpus))
   (let [path-seqs (model-steps
-                   (:actions a-model))]
+                   (:actions a-model))
+
+        refinements (:refined a-model)]
     (reduce
      (fn [acc step]
        ;(println :acc acc)
@@ -339,10 +341,15 @@
                                    (map
                                     (fn [[u x]]
                                       (let [state-action  (:xpath-nav-info
-                                                           (extractor/state-action (:body x)
-                                                                                {:url u}
-                                                                                {}
-                                                                                []))
+                                                           (extractor/state-action-xpath
+                                                            action-to-take
+                                                            (or (try (refinements [step action-to-take])
+                                                                     (catch Exception e nil))
+                                                                {})
+                                                            (:body x)
+                                                            {:url u}
+                                                            {}
+                                                            []))

                                             yield-record  (count
                                                            (:hrefs-and-texts


delaney2d.clj: some improvements to (curvature)

--- clojure/org/gavrog/clojure/delaney2d.clj
+++ clojure/org/gavrog/clojure/delaney2d.clj
@@ -3,13 +3,17 @@

 (defn curvature
   ([ds default-v]
-    (reduce +
-            (- (size ds))
-            (for [[i j] [[0 1] [0 2] [1 2]]
-                  :let [s #(if (orbit-loopless? ds [i j] %) 2 1)
-                        v #(or (v ds i j %) default-v)]
-                  D (orbit-reps ds [i j])]
-              (/ (s D) (v D)))))
+    (do
+      (assert (= 2 (dim ds)) (str "Expected 2d symbol, got " (dim ds) "d"))
+      (assert (connected? ds) "Symbol must be connected")
+      (let [[i j k] (indices ds)]
+        (reduce +
+                (- (size ds))
+                (for [[i j] [[i j] [i k] [j k]]
+                      :let [s #(if (orbit-loopless? ds [i j] %) 2 1)
+                            v #(or (v ds i j %) default-v)]
+                      D (orbit-reps ds [i j])]
+                  (/ (s D) (v D)))))))
   ([ds]
     (curvature ds 0)))


dsets_new.clj: first (buggy) version of dsets2d

--- clojure/org/gavrog/clojure/dsets_new.clj
+++ clojure/org/gavrog/clojure/dsets_new.clj
@@ -2,7 +2,8 @@
   (:use (org.gavrog.clojure
           [generators :only [make-backtracker results]]
           [simple-generators :only [integer-partitions]]
-          [delaney])))
+          [delaney]
+          [combineTiles])))

 (defn- circuit [n]
   (assert (even? n))
@@ -30,3 +31,30 @@
         [op-0 op-1] (if (zero? i) [op-a op-b] [op-b op-a])]
     (make-dsymbol 1 n {0 (into {} (for [i elms] [i (op-0 i)]))
                        1 (into {} (for [i elms] [i (op-1 i)]))} {})))
+
+(defn- orbit-lists [sizes]
+  (let [sizes (vec sizes)
+        n (count sizes)
+        make-orbit (fn [n i] (if (= i 2) (circuit n) (chain n i)))]
+    (make-backtracker
+      {:root []
+       :extract (fn [xs]
+                  (when (= n (count xs))
+                    (reduce append (dsymbol "0 1") (map make-orbit sizes xs))))
+       :children (fn [xs]
+                   (let [m (count xs)]
+                     (when (< m n)
+                       (if (odd? (nth sizes m))
+                         [(conj xs 0)]
+                         (let [k (if (and (> m 0)
+                                          (= (nth sizes m) (nth sizes (dec m))))
+                                   (nth xs (dec m))
+                                   0)]
+                           (for [i (range k 3)] (conj xs i)))))))})))
+
+(defn dsets2d [max-size]
+  (for [s (range 1 (inc max-size))
+        sizes (results (integer-partitions s))
+        olist (results (orbit-lists sizes))
+        ds (results (combine-tiles olist))]
+    ds))


remove vestigeal code from tests

remove vestigeal code from tests

--- src/test/clojure/clojure/data/xml/test_emit.clj
+++ src/test/clojure/clojure/data/xml/test_emit.clj
@@ -55,9 +55,6 @@
           (emit-str (element :mixed
                              {:single "'single'quotes'here"
                               :double "\"double\"quotes\"here\""}))))))
-
-;; TODO add an indentation test once we figure out how to indent portably across JREs
-

 (defn emit-char-seq [xml-tree encoding]
   (with-open [bos (java.io.ByteArrayOutputStream.)
@@ -134,11 +131,6 @@
                                 (xml-comment " goes here ")
                                 " not here")))))

-(def xml-decl-newline?
-  (-> (System/getProperty "java.version")
-      (.startsWith "1.8")
-      not))
-
 (deftest test-indent
   (let [nested-xml (lazy-parse* (str "<c><d>foo</d></c>"))
         expect (str "\n  \n    <c>\n      <d>foo</d>\n    </c>\n  \n\n")


refactor doit, add some reusable functions

--- src/fscrawler_tika_convert/core.clj
+++ src/fscrawler_tika_convert/core.clj
@@ -151,6 +151,16 @@
   (lb/ack ch delivery-tag))

+(defn handle-msg-listdir
+  [fs ch {:keys [content-type delivery-tag type] :as meta} ^bytes payload]
+  (println (format "[consumer] Received a message: %s, delivery tag: %d, content type: %s, type: %s"
+                   (String. payload "UTF-8")
+                   delivery-tag
+                   content-type
+                   type))
+  (lb/ack ch delivery-tag))
+
+
 (defn connect-loop
   "connect to rabbitmq with settings rmq-settings and call
   handle-connection with the connection object. if the connection
@@ -179,7 +189,7 @@
   [conn]
   (let [ch (lch/open conn)
         queue-name (initialize-rabbitmq-structures ch "extract_content" "nextbot" "fscrawler:test")]
-    (doseq [i (range 100)]
+    (doseq [i (range 15)]
       (println "[main] Publishing...")
       (lb/publish ch "nextbot" queue-name "Hello!" :content-type "text/plain" :type "greetings.hi"))
     (lch/close ch)
@@ -217,23 +227,46 @@
     (lq/bind ch "no-such-queu-453456546345", "amq.fanout")))

+(defn connect-loop-with-thread-pool
+  [rmq-settings handle-connection]
+  (let [thread-pool (Executors/newFixedThreadPool 500)
+        connect (partial connect-with-thread-pool rmq-settings thread-pool)]
+    (connect-loop
+     connect
+     handle-connection)))
+
+
+(defn build-handle-connection-from-config
+  [iniconfig section]
+  (fn [conn]
+    (let [queue-name (publish-some-message conn)]
+      (doseq [i (range 20)]
+        (println "starting channel" i)
+        (channel-loop conn
+                      (fn [ch]
+                        (if (zero? (mod i 4))
+                          (break-channel ch (+ 2000 (* i 500))))
+                        (lb/qos ch 1)
+                        (lcons/subscribe ch queue-name new-handle-msg)))))
+    (println "fn-done")))
+
+(def default-section-name "fscrawler")
+
+(defn rmq-settings-from-config
+  [iniconfig]
+  (rmq/settings-from (get-in iniconfig [default-section-name "amqp_url"])))
+
+
 (defn doit
   []
-  (let [thread-pool (Executors/newFixedThreadPool 500)
-        connect (partial connect-with-thread-pool {} thread-pool)]
-    (connect-loop
-     connect
-     (fn [conn]
-       (let [queue-name (publish-some-message conn)]
-         (doseq [i (range 20)]
-           (println "starting channel" i)
-           (channel-loop conn
-                         (fn [ch]
-                           (if (zero? (mod i 4))
-                             (break-channel ch (+ 2000 (* i 500))))
-                           (lb/qos ch 1)
-                           (lcons/subscribe ch queue-name new-handle-msg)))))
-       (println "fn-done")))))
+  (let [iniconfig (ini/read-ini "config.ini")
+        section "fscrawler"
+        rmq-settings (rmq-settings-from-config iniconfig)]
+    (println "config" iniconfig)
+    (println "rmq-settings" rmq-settings)
+    (connect-loop-with-thread-pool
+     rmq-settings
+     (build-handle-connection-from-config iniconfig section))))

 (defn -main [& args]


destroy old sounds

destroy old sounds

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -13,7 +13,9 @@
                           :message-received false
                           :file-downloading? false
                           :num-of-queued-requests 0
-                          :current-track 0}))
+                          :current-track 0
+                          :current-sound nil
+                          :current-sound-id "current-song"}))

 (enable-console-print!)

@@ -84,15 +86,20 @@
           (println (str "Number of music files downloaded "
                         (count (:music-files @app-state))))
           (if-not (is-music-playing?)
-          (set! (.-onloadend reader)
-            (fn []
-                (.play (.createSound js/soundManager #js {:type "audio/mpeg"
-                                                          :url  (.-result reader)}))
-                ;(.attr (js/$ "#current-track") "src" (.-result reader))
-                ;(.load (.getElementById js/document "audio-tag"))
-                ;(.play (.getElementById js/document "audio-tag"))
-                (swap! app-state assoc :current-track (+ 1 (:current-track @app-state)))
-               ))))))))
+            (set! (.-onloadend reader)
+              (fn []
+                (if-not (nil? (:current-sound @app-state))
+                  (.destroySound js/soundManager (:current-sound-id @app-state)))
+                (swap! app-state assoc :current-sound
+                  (.createSound js/soundManager #js {:id   (:current-sound-id @app-state)
+                                                     :type "audio/mpeg"
+                                                     :url  (.-result reader)}))
+                  (.play (:current-sound @app-state))
+                  ;(.attr (js/$ "#current-track") "src" (.-result reader))
+                  ;(.load (.getElementById js/document "audio-tag"))
+                  ;(.play (.getElementById js/document "audio-tag"))
+                  (swap! app-state assoc :current-track (+ 1 (:current-track @app-state)))
+                 ))))))))

 (.change (js/$ "#file_upload_input")
   (fn [e]
@@ -127,7 +134,12 @@
       (.readAsDataURL reader blob)
       (set! (.-onloadend reader)
         (fn []
-          (.play (.createSound js/soundManager #js {:type "audio/mpeg"
+          (if-not (nil? (:current-sound @app-state))
+            (.destroySound js/soundManager (:current-sound-id @app-state)))
+          (swap! app-state assoc :current-sound
+                 (.createSound js/soundManager #js {:id   (:current-sound-id @app-state)
+                                                    :type "audio/mpeg"
                                                     :url  (.-result reader)}))
+          (.play (:current-sound @app-state))
           (swap! app-state assoc :current-track (+ 1 (:current-track @app-state))))))))


Add notice if no mail files are found

Add notice if no mail files are found

--- src/less4clj/api.clj
+++ src/less4clj/api.clj
@@ -57,16 +57,20 @@
                          :opt-un [::auto ::help ::compression ::source-map
                                   ::inline-javascript ::verbosity]))

+(defn- find-files-and-compile [source-paths options]
+  (let [main-files (find-main-files source-paths)]
+    (when-not (seq main-files)
+      (println "No files with a \".main.less\" suffix found."))
+    (compile-less main-files options)))
+
 (defn build [{:keys [source-paths auto] :as options}]
   (when-not (s/valid? ::options options)
     (s/explain-out (s/explain-data ::options options)))
   (let [options (dissoc options :source-paths)]
     (if auto
       (watcher/start source-paths (fn [& _]
-                                    (let [main-files (find-main-files source-paths)]
-                                      (compile-less main-files options))))
-      (let [main-files (find-main-files source-paths)]
-        (compile-less main-files options)))))
+                                    (find-files-and-compile source-paths options)))
+      (find-files-and-compile source-paths options))))

 (defn start [options]
   (build (assoc options :auto true)))


fixed trf to honor locale

fixed trf to honor locale

--- src/untangled/i18n.cljc
+++ src/untangled/i18n.cljc
@@ -21,15 +21,15 @@
 #?(:cljs
    (set! js/trf
          (fn [fmt & {:keys [] :as argmap}]
-           (let [formatter (js/IntlMessageFormat. fmt "en-US")]
+           (let [formatter (js/IntlMessageFormat. fmt (current-locale))]
              (.format formatter (clj->js argmap))
              ))))

 #?(:cljs (defn format-date
            "Format a date with an optional style. The default style is :short.
-
+
            Style can be one of:
-
+
            - :short E.g. 3/4/2015
            - :medium E.g. Mar 4, 2015
            - :long E.g. March 4, 2015
@@ -85,17 +85,17 @@
 #?(:clj (defmacro trc
           "Same as tr, but include a context message to the translator. This is recommended when asking for a
           translation to something vague.
-
+
           For example:
-
+
                  (tr \"M\")
-
+
           is the same as asking a translator to translate the letter 'M'.
-
+
           Using:
-
+
                  (trc \"abbreviation for male gender\" \"M\")
-
+
           lets the translator know what you want. Of course, the msg key is the default language value (US English)
           "
           [context msg]
@@ -106,9 +106,9 @@
           "Translate a format string, then use it to format a message with the given arguments. The format MUST be a literal
           string for extraction by gettext. The arguments should be keyword/value pairs that will match the embedded
           items to format.
-
+
           (trf \"{name} owes {amount, currency)\" :name who :amount amt)
-
+
           The format string is an ICU message format. See FormatJS for details.
           "
           [format & args]


Add logout interaction to the user menu on header.

--- src/uxbox/ui/users.cljs
+++ src/uxbox/ui/users.cljs
@@ -3,8 +3,10 @@
             [cats.labs.lens :as l]
             [rum.core :as rum]
             [uxbox.router :as r]
+            [uxbox.rstore :as rs]
             [uxbox.state :as s]
-            [uxbox.ui.icons :as icons]
+            [uxbox.data.auth :as da]
+            [uxbox.ui.icons :as i]
             [uxbox.ui.navigation :as nav]
             [uxbox.ui.mixins :as mx]))

@@ -18,20 +20,20 @@
    [:ul.dropdown {:class (when-not open?
                            "hide")}
     [:li
-     icons/page
+     i/page
      [:span "Page settings"]]
     [:li
-     icons/grid
+     i/grid
      [:span "Grid settings"]]
     [:li
-     icons/eye
+     i/eye
      [:span "Preview"]]
     [:li
-     icons/user
+     i/user
      [:span "Your account"]]
-    [:li
-     icons/exit
-     [:span "Save & Exit"]]]))
+    [:li {:on-click #(rs/emit! (da/logout))}
+     i/exit
+     [:span "Exit"]]]))

 (def user-menu
   (mx/component


Do not set flags when archiving

Do not set flags when archiving

--- src/mdr2/archive.clj
+++ src/mdr2/archive.clj
@@ -59,7 +59,6 @@
    :archivar "NN"
    :abholer "NN"
    :aktion "save"
-   :flags "x"
    :transaktions_status "pending"})

 (defn- container-id


Removed unused module

Removed unused module

--- src/hurvinek/utils.clj
+++ src/hurvinek/utils.clj
@@ -1,57 +0,0 @@
-;
-;  (C) Copyright 2016  Pavel Tisnovsky
-;
-;  All rights reserved. This program and the accompanying materials
-;  are made available under the terms of the Eclipse Public License v1.0
-;  which accompanies this distribution, and is available at
-;  http://www.eclipse.org/legal/epl-v10.html
-;
-;  Contributors:
-;      Pavel Tisnovsky
-;
-
-(ns hurvinek.utils
-    "Various utility function used by other modules.")
-
-(defn third
-    "Simple utility function - returns third item from a given sequence."
-    [coll]
-    (nth coll 2 nil))
-
-(defn fourth
-    "Simple utility function - returns fourth item from a given sequence."
-    [coll]
-    (nth coll 3 nil))
-
-(defn substring
-    "Call method String.substring()."
-    ([^String s from to]
-     (.substring s from to))
-    ([^String s from]
-     (.substring s from)))
-
-(defn startsWith
-    "Call method String.startsWith()."
-    [^String s pattern]
-    (.startsWith s pattern))
-
-(defn endsWith
-    "Call method String.endsWith()."
-    [^String s pattern]
-    (.endsWith s pattern))
-
-(defn contains
-    "Call method String.contains()."
-    [^String s pattern]
-    (.contains s pattern))
-
-(defn replaceAll
-    "Call method String.replaceAll()."
-    [^String s pattern replacement]
-    (.replaceAll s pattern replacement))
-
-(defn get-exception-message
-    "Retrieve a message from given exception."
-    [^java.lang.Exception exception]
-    (.getMessage exception))
-


Fix: token-watch integration test for filtering stream (#1566)

* add debugging logs

* fix bad integration test, watches map of tokens may not be up to date

* sort fields

* sort import

--- waiter/integration/waiter/token_watch_integration_test.clj
+++ waiter/integration/waiter/token_watch_integration_test.clj
@@ -1,5 +1,6 @@
 (ns waiter.token-watch-integration-test
   (:require [clojure.core.async :as async]
+            [clojure.data :as data]
             [clojure.set :as set]
             [clojure.test :refer :all]
             [clojure.tools.logging :as log]
@@ -115,6 +116,7 @@
   (let [{:keys [body error headers] :as response}
         (make-request router-url "/tokens" :async? true :cookies cookies :query-params query-params)
         _ (assert-response-status response 200)
+        {:strs [x-cid]} headers
         json-objects (utils/chan-to-json-seq!! body)
         token->index-atom (atom {})
         initial-event-time-epoch-ms-atom (atom nil)
@@ -128,32 +130,39 @@
           (try
             (doseq [msg json-objects
                     :when (some? msg)]
+              (log/info "received msg from token watch" {:current-token->index @token->index-atom
+                                                         :msg msg
+                                                         :watch-cid x-cid})
               (reset!
                 token->index-atom
                 (let [{:strs [object type]} msg
-                      token->index @token->index-atom]
-                  (case type
-                    "INITIAL"
-                    (do
-                      (reset! initial-event-time-epoch-ms-atom (System/currentTimeMillis))
-                      (reduce
-                        (fn [token->index index]
-                          (assoc token->index (get index "token") index))
-                        {}
-                        object))
-
-                    "EVENTS"
-                    (reduce
-                      (fn [token->index {:strs [object type]}]
-                        (case type
-                          "UPDATE"
-                          (assoc token->index (get object "token") object)
-                          "DELETE"
-                          (dissoc token->index (get object "token") object)
-                          (throw (ex-info "Unknown event type received in EVENTS object" {:event object}))))
-                      token->index
-                      object)
-                    (throw (ex-info "Unknown event type received from watch" {:event msg}))))))
+                      token->index @token->index-atom
+                      new-token->index
+                      (case type
+                        "INITIAL"
+                        (do
+                          (reset! initial-event-time-epoch-ms-atom (System/currentTimeMillis))
+                          (reduce
+                            (fn [token->index index]
+                              (assoc token->index (get index "token") index))
+                            {}
+                            object))
+
+                        "EVENTS"
+                        (reduce
+                          (fn [token->index {:strs [object type]}]
+                            (case type
+                              "UPDATE"
+                              (assoc token->index (get object "token") object)
+                              "DELETE"
+                              (dissoc token->index (get object "token") object)
+                              (throw (ex-info "Unknown event type received in EVENTS object" {:event object}))))
+                          token->index
+                          object)
+                        (throw (ex-info "Unknown event type received from watch" {:event msg})))]
+                  (log/info "diff token->index" {:diff-token->index (data/diff token->index new-token->index)
+                                                 :watch-cid x-cid})
+                  new-token->index)))
             (catch Exception e
               (exit-fn)
               (log/error e "Error in test watch-chan" {:router-url router-url}))))]
@@ -371,9 +380,9 @@
                                                              "maintenance" true})
               (post-token waiter-url (assoc (kitchen-params) :token token-1 :maintenance {:message "maintenance message"}))
               (post-token waiter-url (assoc (kitchen-params) :token token-2))
-              (assert-watch-token-index-entry-does-not-change watch token-1 {"token" token-1
-                                                                             "owner" (retrieve-username)
-                                                                             "maintenance" true})
+              (assert-watch-token-index-entry watch token-1 {"token" token-1
+                                                             "owner" (retrieve-username)
+                                                             "maintenance" true})
               (assert-watch-token-index-entry-does-not-change watch token-2 {"token" token-2
                                                                              "owner" (retrieve-username)
                                                                              "maintenance" true})


Let's call it a kat

Let's call it a kat

--- test/caesium/crypto/generichash_test.clj
+++ test/caesium/crypto/generichash_test.clj
@@ -3,7 +3,7 @@
             [caesium.crypto]
             [clojure.test :refer :all]))

-(deftest blake2b-test-vectors-test
+(deftest blake2b-kat-test
   (testing "blake2b works directly"
     (are [args expected] (array-eq (apply blake2b args)
                                    expected)