Use key-lt

Use key-lt

--- src/aurora/join.cljs
+++ src/aurora/join.cljs
@@ -226,7 +226,7 @@
         (set! end? false)
         (ainto cur-key key)
         (func cur-key key)
-        (when (key-gt key cur-key)
+        (when (key-lt cur-key key)
           (max-func cur-key))
         ))


layout

layout

--- src/aws/provider.clj
+++ src/aws/provider.clj
@@ -86,8 +86,7 @@
         (debug (<<  "Associating existing ip ~{ip} to ~{instance-id}"))
         (assoc-pub-ip endpoint instance-id ip))
       (update-ip spec endpoint instance-id)
-      (wait-for-ssh (pub-dns endpoint instance-id) user [5 :minute])
-      ))
+      (wait-for-ssh (pub-dns endpoint instance-id) user [5 :minute])))

   (delete [this]
     (with-instance-id


s/map/mapcat/ so that default-fn can return multiple values

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -44,7 +44,7 @@
     (cond (nil? default-fn)
           pre-default
           true
-          (map default-fn pre-default))))
+          (mapcat default-fn pre-default))))

 ;; TODO: use dag_unify/assoc-in rather than over/over, so that we can remove babel.over.
 (defn over [grammar left right morph default-fn]
@@ -52,7 +52,7 @@
   (if default-fn
     (->>
      (over/over grammar left right)
-     (map default-fn))
+     (mapcat default-fn))
     (over/over grammar left right)))

 (defn square-cross-product [x]


comments, whitespace, formatting

comments, whitespace, formatting

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -224,10 +224,14 @@

 (defn parse
   "return a list of all possible parse trees for a string or a sequence of tokens.
-   If the input is a string, then use a language-independent tokenizer to turn the string into a sequence of tokens.
-   In the latter case, the tokens are assumed to be produced by splitting a string in
-   some language-dependent way."
-  ([input model & [parse-with-truncate original-input]]
+   If the input is a string, then use a language-independent tokenizer
+  to turn the string into a sequence of tokens.  In the latter case,
+  the tokens are assumed to be produced by splitting a string in some
+  language-dependent way. If parse-with-truncate is false, then at
+  each step of parsing the input, the entire tree will be preserved
+  rather than just the immediate parents of the root node. Preserving
+  the entire tree costs about 20% time than truncating it."
+  ([input model & {:keys [parse-with-truncate original-input]}]
    (let [parse-with-truncate
          (cond (= parse-with-truncate false)
                false
@@ -241,7 +245,9 @@
              (log/debug (str "parsing input: '" input "'"))
              ;; tokenize input (more than one tokenization is possible), and parse each tokenization.
              (let [tokenizations (filter #(not (empty? %)) (string/split input tokenizer))
-                   result (parse tokenizations model parse-with-truncate original-input)]
+                   result (parse tokenizations model
+                                 :parse-with-truncate parse-with-truncate
+                                 :original-input original-input)]
                (if (empty? result)
                  (log/warn (str "could not parse: \"" input "\". Tokenizations attempted: "
                                 (string/join ";" tokenizations)))
@@ -296,7 +302,6 @@
   "return a human-readable string of a phrase structure tree. leaves of the tree are printed
    by calling the supplied _fo_ function"
   (let [head-first? (get-in tree [:first] :none)
-        pred (get-in tree [:synsem :sem :pred])
         cat (str (get-in tree [:synsem :cat]) "")]
     (if (= true (get-in tree [:phrasal]))
       (do (log/debug (str "fo-ps: rule at top of tree: " (get-in tree [:rule])))
@@ -306,13 +311,11 @@
       (and (= :none (get-in tree [:head] :none))
            (= :none (get-in tree [:comp] :none))
            (not (= :none (get-in tree [:rule] :none))))
-      (str "[" (get-in tree [:rule]) "/" cat
-           pred
+      (str "[" (get-in tree [:rule])
            " '" (fo tree) "']")

       (= head-first? :none)
-      (str " '" (fo tree) "'/" cat
-           pred)
+      (str " '" (fo tree) "'")

       (= head-first? :comp)
       (str "[" (get-in tree [:rule]) " "


unify target-spec with basic-spec

unify target-spec with basic-spec

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -77,6 +77,8 @@
                              :sem {:subj {:city false}}
                              :cat :verb}
                     :modified false}
+        target-spec (unify target-spec basic-spec)
+        target-language-str target-language
         source-language (keyword source-language)
         target-language (keyword target-language)
         target-model @((get models target-language))


cleanup

cleanup

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -1,6 +1,5 @@
 (ns babel.writer
   (:refer-clojure :exclude [get-in merge])
-;  (:import [org.postgresql JDBCException])
   (:require
     [babel.lexiconfn :refer [sem-impl]]
     [babel.engine :as engine]


Game start screen, game abort and pause.

--- src/canvas/main.cljs
+++ src/canvas/main.cljs
@@ -17,15 +17,17 @@
 (def PLAYER_2_COLOR "peru")

 (def SCORE_FONT "60px Helvetica")
-(def SCORE_COLOR "#555")
+(def SCORE_COLOR "slategray")

 (def BALL_COLOR "lime")

 (def KEYBOARD
-  {40 :down
+  {27 :abort
+   32 :space
+   37 :paddle-1
    38 :up
-   37 :paddle-1
-   39 :paddle-2})
+   39 :paddle-2
+   40 :down})

 ;;-----------------------------------------------------------------------------

@@ -60,10 +62,13 @@
 ;;-----------------------------------------------------------------------------

 (defrecord Rect [x y width height color])
+(defrecord Line [x1 y1 x2 y2 color])
 (defrecord Frame [x y width height color frame-width])
+
+(defrecord GameStartScreen [])
 (defrecord Paddle [x y width height vy color])
 (defrecord Ball [x y radius vx vy fill-color oob?])
-(defrecord Score [score x y font color])
+(defrecord Score [score x y font color align])

 ;;-----------------------------------------------------------------------------
 ;; Drawable Objects
@@ -72,52 +77,94 @@
 (defprotocol IDrawable
   (draw! [_ ctx]))

+(extend-type GameStartScreen
+  IDrawable
+  (draw! [_ ctx]
+    (.save ctx)
+    (aset ctx "textAlign" "center")
+    ;;
+    (aset ctx "font" "60px Helvetica")
+    (aset ctx "fillStyle" "peru")
+    (.fillText ctx "Welcome to Pong!" (/ SCALE-W 2) 100)
+    ;;
+    (aset ctx "font" "italic 14px Helvetica")
+    (aset ctx "fillStyle" "slategray")
+    (.fillText ctx "single player" (/ SCALE-W 2) 150)
+    ;;
+    (aset ctx "font" "20px Helvetica")
+    (aset ctx "fillStyle" "dodgerblue")
+    (.fillText ctx "Press the spacebar to start." (/ SCALE-W 2) 300)
+    ;;
+    (aset ctx "font" "italic 12px Helvetica")
+    (aset ctx "fillStyle" "slategray")
+    (.fillText ctx "[ Right ] and [ Left ] arrows to switch paddles." (/ SCALE-W 2) 370)
+    (.fillText ctx "[ Up ] and [ Down ] arrows to move paddles." (/ SCALE-W 2) 390)
+    (.fillText ctx "[ Spacebar ] to pause ." (/ SCALE-W 2) 410)
+    (.fillText ctx "[ Escape ] to quit." (/ SCALE-W 2) 430)
+    (.restore ctx)))
+
+(extend-type Line
+  IDrawable
+  (draw! [{:keys [x1 y1 x2 y2 color] :as line} ctx]
+    (.save ctx)
+    (aset ctx "lineWidth" "1")
+    (aset ctx "strokeStyle" color)
+    (.setLineDash ctx (array 1 2))
+    (.beginPath ctx)
+    (.moveTo ctx x1 y1)
+    (.lineTo ctx x2 y2)
+    (.stroke ctx)
+    (.closePath ctx)
+    (.restore ctx)))
+
 (extend-type Score
   IDrawable
-  (draw! [{:keys [score x y font color] :as Score} ctx]
+  (draw! [{:keys [score x y font color align]} ctx]
+    (.save ctx)
     (aset ctx "font" font)
     (aset ctx "fillStyle" color)
-    (aset ctx "textAlign" "center")
+    (aset ctx "textAlign" align)
     (.fillText ctx (str score) x y)
-    ctx))
+    (.restore ctx)))

 (extend-type Paddle
   IDrawable
-  (draw! [paddle ctx]
-    (let [{:keys [color x y width height]} paddle]
-      (aset ctx "fillStyle" color)
-      (.fillRect ctx x y width height))
-    ctx))
+  (draw! [{:keys [color x y width height]} ctx]
+    (.save ctx)
+    (aset ctx "fillStyle" color)
+    (.fillRect ctx x y width height)
+    (.restore ctx)))

 (extend-type Ball
   IDrawable
   (draw! [{:keys [x y radius fill-color] :as ball} ctx]
+    (.save ctx)
     (aset ctx "fillStyle" fill-color)
     (.beginPath ctx)
     (.arc ctx x y radius 0 (* 2 js/Math.PI) false)
     (.fill ctx)
     (.closePath ctx)
-    ctx))
+    (.restore ctx)))

 (extend-type Rect
   IDrawable
-  (draw! [rect ctx]
-    (let [{:keys [color x y width height]} rect]
-      (aset ctx "lineWidth" "0.5")
-      (aset ctx "fillStyle" color)
-      (aset ctx "strokeStyle" "black")
-      (.fillRect ctx x y width height)
-      (.strokeRect ctx x y width height))
-    ctx))
+  (draw! [{:keys [color x y width height]} ctx]
+    (.save ctx)
+    (aset ctx "lineWidth" "0.5")
+    (aset ctx "fillStyle" color)
+    (aset ctx "strokeStyle" "black")
+    (.fillRect ctx x y width height)
+    (.strokeRect ctx x y width height)
+    (.restore ctx)))

 (extend-type Frame
   IDrawable
-  (draw! [frame ctx]
-    (let [{:keys [color x y width height frame-width]} frame]
-      (aset ctx "lineWidth" (str frame-width))
-      (aset ctx "strokeStyle" color)
-      (.strokeRect ctx x y width height))
-    ctx))
+  (draw! [{:keys [color x y width height frame-width]} ctx]
+    (.save ctx)
+    (aset ctx "lineWidth" (str frame-width))
+    (aset ctx "strokeStyle" color)
+    (.strokeRect ctx x y width height)
+    (.restore ctx)))

 ;;-----------------------------------------------------------------------------
 ;; Moveable Objects
@@ -165,22 +212,22 @@
 ;; Game State
 ;;-----------------------------------------------------------------------------

-(def state
-  ;; Order matters
-  (atom {:current-paddle :paddle-1
-         ;; use div behind canvas
-         :background (Rect. 0 0 SCALE-W SCALE-H "black")
-         ;; use div behind canvas
-
-         :border     (Frame. 0 0 SCALE-W SCALE-H "#333" 2)
-
-         :score-1    (Score. 0 200 60 SCORE_FONT SCORE_COLOR)
-         :score-2    (Score. 0 (- SCALE-W 200) 60 SCORE_FONT SCORE_COLOR)
-
-         :paddle-1   (Paddle. 20 (- SCALE-H 120) 20 100 10 PLAYER_1_COLOR)
-         :paddle-2   (Paddle. (- SCALE-W 40) 20 20 100 10 PLAYER_2_COLOR)
-
-         :ball       (Ball. 400 225 13 3 2 BALL_COLOR false)}))
+(def resets
+  {:background (Rect. 0 0 SCALE-W SCALE-H "black")
+   :border     (Frame. 0 0 SCALE-W SCALE-H "#333" 2)
+   :net        (Line. (/ SCALE-W 2) 0 (/ SCALE-W 2) SCALE-H SCORE_COLOR)
+   :game-start (GameStartScreen.)
+   :score-1    (Score. 0 (- (/ SCALE-W 2) 75) 60 SCORE_FONT SCORE_COLOR "right")
+   :score-2    (Score. 0 (+ (/ SCALE-W 2) 75) 60 SCORE_FONT SCORE_COLOR "left")
+   :paddle-1   (Paddle. 20 (- SCALE-H 120) 20 100 10 PLAYER_1_COLOR)
+   :paddle-2   (Paddle. (- SCALE-W 40) 20 20 100 10 PLAYER_2_COLOR)
+   :ball       (Ball. 400 225 13 3 2 BALL_COLOR false)})
+
+(defonce state
+  (atom (merge resets
+               {:mode :game-start ;; game-start game-over playing
+                :pause? false
+                :current-paddle :paddle-1})))

 ;;-----------------------------------------------------------------------------
 ;; Animation
@@ -188,10 +235,26 @@

 (defn draw-phase!
   [state ctx]
+  ;;
+  ;; Always
   (.clearRect ctx 0 0 SCALE-W SCALE-H)
-  (doseq [object (vals @state)]
-    (when (satisfies? IDrawable object)
-      (draw! object ctx))))
+  (draw! (:background @state) ctx)
+  (draw! (:border @state) ctx)
+  ;;
+  ;; While playing and game-over
+  (when (contains? #{:playing :gameover} (:mode @state))
+    (draw! (:score-2 @state) ctx)
+    (draw! (:score-1 @state) ctx))
+  ;;
+  (when (contains? #{:game-start} (:mode @state))
+    (draw! (:game-start @state) ctx))
+  ;;
+  ;; While playing.
+  (when (contains? #{:playing} (:mode @state))
+    (draw! (:net @state) ctx)
+    (draw! (:paddle-1 @state) ctx)
+    (draw! (:paddle-2 @state) ctx)
+    (draw! (:ball @state) ctx)))

 (defn move-phase!
   [{:keys [ball] :as state}]
@@ -212,7 +275,7 @@
                               (>= radius (dist x y1 x y)))))))

 (defn collision-phase!
-  [{:keys [ball paddle-1 paddle-2] :as state}]
+  [{:keys [ball paddle-1 paddle-2 mode] :as state}]
   (if (or (hit? ball paddle-1)
           (hit? ball paddle-2))
     (assoc state :ball (assoc ball :vx (* -1 (:vx ball))))
@@ -237,13 +300,10 @@

 (defn animate-loop!
   [state ctx]
-  ;; if start-mode:
-  ;; ...
-  ;; if play-mode:
-  (swap! state #(-> % move-phase! collision-phase! score-phase!))
-  ;; if win-mode:
-  ;; ...
-  (draw-phase! state ctx)
+  (when-not (:pause? @state)
+    (when (= (:mode @state) :playing)
+      (swap! state #(-> % move-phase! collision-phase! score-phase!)))
+    (draw-phase! state ctx))
   (.requestAnimationFrame js/window (partial animate-loop! state ctx)))

 ;;-----------------------------------------------------------------------------
@@ -266,11 +326,23 @@
     (when-let [event (<! ch)]
       (cond
         (contains? #{:up :down} event)
-        (swap! state (fn [{id :current-paddle :as state}]
-                       (assoc state id (control! (id state) event))))
+        (when-not (:pause? @state)
+          (swap! state (fn [{id :current-paddle :as state}]
+                         (assoc state id (control! (id state) event)))))

         (contains? #{:paddle-1 :paddle-2} event)
-        (swap! state assoc :current-paddle event)
+        (when-not (:pause? @state)
+          (swap! state assoc :current-paddle event))
+
+        (= :abort event)
+        (swap! state #(if (:pause? %)
+                        (assoc % :pause? false)
+                        (assoc % :mode :game-start)))
+
+        (= :space event)
+        (swap! state #(if (= (:mode %) :game-start)
+                        (merge % resets {:mode :playing})
+                        (assoc % :pause? (not (:pause? %)))))

         :else
         (println "Unhandled event:" event))


added default to read

added default to read

--- src/copper/core.cljs
+++ src/copper/core.cljs
@@ -27,6 +27,14 @@
 (defn store [obj]
   (-store obj))

+
+(defprotocol IPath
+  (-path [this]))
+
+(defn path [obj]
+  (-path obj))
+
+
 (defprotocol INotify
   (-notify [this path]))

@@ -51,10 +59,13 @@
 (defprotocol IReadable
   (-read [this path]))

-(defn read [store path]
-  (when *component*
-    (register-path *component* store path))
-  (-read store path))
+(defn read
+  ([store path] (read store path nil))
+  ([store path default]
+     (when *component*
+       (register-path *component* store path))
+     (let [res (-read store path)]
+       (if res res default))))

 (defprotocol ITransact
@@ -121,6 +132,41 @@
     (notify-update path dep-graph)))

+
+
+;; ---------------------------------------------------------------------
+;; Helper Functions
+
+
+(defn add-to [type container value]
+  (if (empty? container)
+    (conj type value)
+    (conj container value)))
+
+
+(defn register-path [component store path]
+  (aset component "_paths"
+        (add-to #{} (aget component "_paths") [store path])))
+
+
+(defn build-path
+  ([path-parts] (build-path [] path-parts))
+  ([seed [part & rparts]]
+     (cond
+      (nil? part)
+      seed
+
+      (satisfies? IPath part)
+      (concat seed (path part))
+
+      :else
+      (conj seed path))))
+
+
+(defn cleanup [component]
+  (let [paths (aget  component "_paths")]
+    (doseq [[db path] paths]
+      (remove-dep! db component path))))

 ;; ---------------------------------------------------------------------
 ;; Simple Store Cursor
@@ -175,9 +221,13 @@
 (defn sub-cursor
   "takes a path and existing cursor and returns a cursor
    scoped to that path"
-  [cursor path]
-  (let [db cursor]
+  [cursor & path-parts]
+  (let [db cursor
+        path (build-path path-parts)]
     (reify
+      IPath
+      (-path [this] path)
+
       IReadable
       (-read [_  sub-path]
         (read cursor (concat path sub-path)))
@@ -185,27 +235,6 @@
       ITransact
       (-transact! [_ sub-path value]
         (transact! cursor (concat path sub-path) value)))))
-
-
-;; ---------------------------------------------------------------------
-;; Helper Functions
-
-
-(defn add-to [type container value]
-  (if (empty? container)
-    (conj type value)
-    (conj container value)))
-
-
-(defn register-path [component store path]
-  (aset component "_paths"
-        (add-to #{} (aget component "_paths") [store path])))
-
-
-(defn cleanup [component]
-  (let [paths (aget  component "_paths")]
-    (doseq [[db path] paths]
-      (remove-dep! db component path))))


Pass multiple arguments to function

Pass multiple arguments to function

--- src/cljam/io/bigwig.clj
+++ src/cljam/io/bigwig.clj
@@ -79,7 +79,7 @@
 (defn- check-version
   "Ranged from [1,4]. Throws IOException if the version is out of range."
   [ushort]
-  (when-not (and (<= 1 ushort) (<= ushort 4))
+  (when-not (<= 1 ushort 4)
     (throw (IOException. "Invalid bigWig version"))))

 (defn- check-field-count


Add DISABLE_ASYNC_SAVEFRAME hint option

Add DISABLE_ASYNC_SAVEFRAME hint option

The latest documentation includes this hint option, though those docs
haven't been published online yet.

See https://github.com/processing/processing-docs/commit/69fcbc307a8dff592d176ec8c2f99873d1622874

--- src/cljc/quil/core.cljc
+++ src/cljc/quil/core.cljc
@@ -51,7 +51,8 @@
  color-modes (:rgb :hsb)
  image-formats (:rgb :argb :alpha)
  ellipse-modes (:center :radius :corner :corners)
- hint-options (:enable-depth-test :disable-depth-test
+ hint-options (:enable-async-saveframe :disable-async-saveframe
+               :enable-depth-test :disable-depth-test
                                   :enable-depth-sort :disable-depth-sort
                                   :enable-depth-mask :disable-depth-mask
                                   :enable-opengl-errors :disable-opengl-errors


Initial, Naive implementation of PersisentQueue

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1269,6 +1269,53 @@

   ISeqable
   (-seq [coll] (seq (lazy-seq-value coll))))
+
+;;; PersistentQueue ;;;
+
+(deftype PersistentQueue [meta count front rear]
+  IWithMeta
+  (-with-meta [coll meta] (PersistentQueue. meta count front rear))
+
+  IMeta
+  (-meta [coll] meta)
+
+  ISeq
+  (-first [coll] (first front))
+  (-rest [coll] (rest (seq coll)))
+
+  IStack
+  (-peek [coll] (-first front))
+  (-pop [coll]
+    (if front
+      (if-let [f1 (next front)]
+        (PersistentQueue. meta (dec count) f1 rear)
+        (PersistentQueue. meta (dec count) (seq rear) nil))
+      coll))
+
+  ICollection
+  (-conj [coll o]
+    (if front
+      (PersistentQueue. meta (inc count) front (conj (or rear []) o))
+      (PersistentQueue. meta (inc count) (conj front o) nil)))
+
+  IEmptyableCollection
+  (-empty [coll] cljs.core.PersistentQueue/EMPTY)
+
+  ISequential
+  IEquiv
+  (-equiv [coll other] (equiv-sequential coll other))
+
+  IHash
+  (-hash [coll] (hash-coll coll))
+
+  ISeqable
+  ; This is wrong, but quick
+  (-seq [coll] (concat front rear))
+
+  ICounted
+  (-count [coll] count))
+
+(set! cljs.core.PersistentQueue/EMPTY (PersistentQueue. nil 0 nil nil))

 ;;;;;;;;;;;;;;;;


ci-reduce/array-reduce call count once

ci-reduce/array-reduce call count once

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -403,59 +403,65 @@
   "Accepts any collection which satisfies the ICount and IIndexed protocols and
 reduces them without incurring seq initialization"
   ([cicoll f]
-     (if (zero? (-count cicoll))
-       (f)
-       (loop [val (-nth cicoll 0), n 1]
-         (if (< n (-count cicoll))
+     (let [cnt (-count cicoll)]
+       (if (zero? cnt)
+         (f)
+         (loop [val (-nth cicoll 0), n 1]
+           (if (< n cnt)
+             (let [nval (f val (-nth cicoll n))]
+               (if (reduced? nval)
+                 @nval
+                 (recur nval (inc n))))
+             val)))))
+  ([cicoll f val]
+     (let [cnt (-count cicoll)]
+       (loop [val val, n 0]
+         (if (< n cnt)
            (let [nval (f val (-nth cicoll n))]
              (if (reduced? nval)
                @nval
                (recur nval (inc n))))
            val))))
-  ([cicoll f val]
-     (loop [val val, n 0]
-         (if (< n (-count cicoll))
+  ([cicoll f val idx]
+     (let [cnt (-count cicoll)]
+       (loop [val val, n idx]
+         (if (< n cnt)
            (let [nval (f val (-nth cicoll n))]
              (if (reduced? nval)
                @nval
                (recur nval (inc n))))
-           val)))
-  ([cicoll f val idx]
-     (loop [val val, n idx]
-         (if (< n (-count cicoll))
-           (let [nval (f val (-nth cicoll n))]
-             (if (reduced? nval)
-               @nval
-               (recur nval (inc n))))
-           val))))
+           val)))))

 (defn- array-reduce
   ([arr f]
-     (if (zero? (alength arr))
-       (f)
-       (loop [val (aget arr 0), n 1]
-         (if (< n (alength arr))
+     (let [cnt (alength arr)]
+       (if (zero? (alength arr))
+         (f)
+         (loop [val (aget arr 0), n 1]
+           (if (< n cnt)
+             (let [nval (f val (aget arr n))]
+               (if (reduced? nval)
+                 @nval
+                 (recur nval (inc n))))
+             val)))))
+  ([arr f val]
+     (let [cnt (alength arr)]
+       (loop [val val, n 0]
+         (if (< n cnt)
            (let [nval (f val (aget arr n))]
              (if (reduced? nval)
                @nval
                (recur nval (inc n))))
            val))))
-  ([arr f val]
-     (loop [val val, n 0]
-         (if (< n (alength arr))
+  ([arr f val idx]
+     (let [cnt (alength arr)]
+       (loop [val val, n idx]
+         (if (< n cnt)
            (let [nval (f val (aget arr n))]
              (if (reduced? nval)
                @nval
                (recur nval (inc n))))
-           val)))
-  ([arr f val idx]
-     (loop [val val, n idx]
-         (if (< n (alength arr))
-           (let [nval (f val (aget arr n))]
-             (if (reduced? nval)
-               @nval
-               (recur nval (inc n))))
-           val))))
+           val)))))

 (declare hash-coll cons pr-str counted? RSeq)


* src/cljs/cljs/core.cljs: CLJS-62: IndexedSeq now implements IIndexed

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -290,8 +290,20 @@
   (-rest [_] (if (< (inc i) (.length a))
                (IndexedSeq. a (inc i))
                (list)))
+
   ICounted
-  (-count [_] (.length a))
+  (-count [_] (- (.length a) i))
+
+  IIndexed
+  (-nth [coll n]
+    (let [i (+ n i)]
+      (when (< i (.length a))
+        (aget a i))))
+  (-nth [coll n not-found]
+    (let [i (+ n i)]
+      (if (< i (.length a))
+        (aget a i)
+        not-found)))

   ISequential
   IEquiv


[neko.ui] Add :custom-constructor attribute

--- src/clojure/neko/ui.clj
+++ src/clojure/neko/ui.clj
@@ -44,16 +44,15 @@
   current element will receive the initial options map, and
   modifications will only appear visible to the subsequent elements."
   [widget-kw widget attributes options]
-  (let [all-attributes (merge (kw/default-attributes widget-kw) attributes)]
-    (loop [[trait & rest] (kw/all-traits widget-kw),
-           attrs all-attributes, new-opts options]
-      (if trait
-        (let [[attributes-fn options-fn]
-              (apply-trait trait widget attrs options)]
-          (recur rest (attributes-fn attrs) (options-fn new-opts)))
-        (do
-          (apply-default-setters-from-attributes widget-kw widget attrs)
-          new-opts)))))
+  (loop [[trait & rest] (kw/all-traits widget-kw),
+         attrs attributes, new-opts options]
+    (if trait
+      (let [[attributes-fn options-fn]
+            (apply-trait trait widget attrs options)]
+        (recur rest (attributes-fn attrs) (options-fn new-opts)))
+      (do
+        (apply-default-setters-from-attributes widget-kw widget attrs)
+        new-opts))))

 ;; ## Widget creation

@@ -75,11 +74,18 @@
   (if (sequential? tree)
     (let [[widget-kw attributes & inside-elements] tree
           _ (assert (and (keyword? widget-kw) (map? attributes)))
-          ;; Remove :constructor-args from attribues since it is used
-          ;; by constructor and is not a real attribute.
-          wdg (construct-element widget-kw context
-                                 (:constructor-args attributes))
-          new-opts (apply-attributes widget-kw wdg attributes options)]
+          attributes (merge (kw/default-attributes widget-kw) attributes)
+          wdg (if-let [constr (:custom-constructor attributes)]
+                (apply constr context (:constructor-args attributes))
+                (construct-element widget-kw context
+                                   (:constructor-args attributes)))
+          new-opts (apply-attributes
+                    widget-kw wdg
+                    ;; Remove :custom-constructor and
+                    ;; :constructor-args since they are not real
+                    ;; attributes.
+                    (dissoc attributes :constructor-args :custom-constructor)
+                    options)]
       (doseq [element inside-elements :when element]
         (.addView ^android.view.ViewGroup wdg
                   (make-ui-element context element new-opts)))


Add Content-Type for new task POST

Add Content-Type for new task POST

--- server/src/clinicico/server/handler.clj
+++ server/src/clinicico/server/handler.clj
@@ -43,7 +43,8 @@
         url (http/url-from (:request ctx) (:id task))
         resource (represent-task task url)]
     {:status 202
-     :headers {"Location" url}
+     :headers {"Location" url
+               "Content-Type" "application/json"}
      :body (hal/resource->representation resource :json)}))

 (def listeners (atom {}))


cleanup namespace usage

cleanup namespace usage

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -3,6 +3,7 @@
   (:require
    [babel.english.lexicon :refer [deliver-lexicon]]
    [babel.english.morphology :refer (analyze fo)]
+   [babel.generate :as generate]
    [babel.index :refer [create-indices lookup-spec]]
    [babel.parse :as parse]
    [babel.ug :as ug
@@ -537,4 +538,4 @@
     (assoc model
           :generate-fn
           (fn [spec]
-            (babel.generate/generate spec model)))))
+            (generate/generate spec model)))))


add [:subcat :2] = '() for a few intransitive verbs

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1582,10 +1582,12 @@
                          :present {:3sing "sits down"}}
                :synsem {:cat :verb
                         :sem {:pred :sit-down
-                              :reflexive true}}}
+                              :reflexive true}
+                        :subcat {:2 '()}}}

    "sleep" {:synsem {:cat :verb
-                     :sem {:pred :sleep}}
+                     :sem {:pred :sleep}
+                     :subcat {:2 '()}}
             :english {:past "slept"}}
    "small"
    (unify adjective
@@ -1870,7 +1872,8 @@
    "wake up"
    (let [subject-semantics (atom :top)]
      {:synsem {:cat :verb
-               :sem {:pred :wake-up}}
+               :sem {:pred :wake-up}
+               :subcat {:2 '()}}
       :english {:participle "waking up"
                 :present {:3sing "wakes up"}
                 :past "woke up"}})
@@ -2173,6 +2176,3 @@
                           (let [subject-agr (atom :top)]
                             {:synsem {:subcat {:1 {:agr subject-agr}
                                                :2 {:agr subject-agr}}}}))))
-
-
-


add info print

add info print

--- src/thread_exec/core.clj
+++ src/thread_exec/core.clj
@@ -9,6 +9,7 @@
   (let [queue (ArrayBlockingQueue. (int 100))
 			  exec  (doto (ThreadPoolExecutor. 0 threads 60 TimeUnit/SECONDS queue)
 					     (.setRejectedExecutionHandler  (ThreadPoolExecutor$CallerRunsPolicy.)))]
+    (info "Creating thread pool max threads " threads)
     exec))


Updated link and script selectors to be more specific.

--- src/timber/selectors.clj
+++ src/timber/selectors.clj
@@ -9,15 +9,14 @@

 (def brand-title [:a#brand])

-(def link-asset [[:link (html/attr? :asset)]])
-(def js-asset [[:script (html/attr? :asset)]])
+(def link-asset [:head :link (html/attr? :asset)])
+(def link-template [:head :link (html/attr? :template)])
+(def js-asset [:head :script (html/attr? :asset)])
+(def script-template [:script (html/attr? :template)])

 (def main-menu [:ul#main-menu-list])
 (def user-menu [:ul#user-account-menu])
 (def user-name [:a#user-menu-toggle])
-
-(def link-template [[:link (html/attr? :template)]])
-(def script-template [[:script (html/attr? :template)]])

 (def content [:div#content])


REPLs also need to get upstream deps

REPLs also need to get upstream deps

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -353,9 +353,12 @@
   [repl-env opts]
   (print "To quit, type: ")
   (prn :cljs/quit)
-  (let [{:keys [analyze-path repl-verbose warn-on-undeclared special-fns static-fns] :as opts
+  (let [ups-deps (cljsc/get-upstream-deps)
+        {:keys [analyze-path repl-verbose warn-on-undeclared special-fns static-fns] :as opts
          :or   {warn-on-undeclared true}}
-        (merge (-repl-options repl-env) opts)]
+        (assoc (merge (-repl-options repl-env) opts)
+          :ups-libs (:libs ups-deps)
+          :ups-foreign-libs (:foreign-libs ups-deps))]
     (env/with-compiler-env
      (or (::env/compiler repl-env) (env/default-compiler-env opts))
      (binding [ana/*cljs-ns* 'cljs.user


need to pass along opts

need to pass along opts

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -316,13 +316,17 @@
                              (set! *1 ret#)
                              ret#))))))

-(defn- eval-and-print [repl-env env form]
-  (println
-    (evaluate-form repl-env
-      (assoc env :ns (ana/get-namespace ana/*cljs-ns*))
-      "<cljs repl>"
-      form
-      (wrap-fn form))))
+(defn- eval-and-print
+  ([repl-env env form]
+    (eval-and-print repl-env env form nil))
+  ([repl-env env form opts]
+    (println
+      (evaluate-form repl-env
+        (assoc env :ns (ana/get-namespace ana/*cljs-ns*))
+        "<cljs repl>"
+        form
+        (wrap-fn form)
+        opts))))

 ;; Special REPL fns, these provide compatiblity with Clojure functions
 ;; that are not possible to reproduce given ClojureScript's compilation model
@@ -486,7 +490,7 @@
                  (recur))

                :else
-               (do (eval-and-print repl-env env form)
+               (do (eval-and-print repl-env env form opts)
                    (recur)))))
          (-tear-down repl-env))))))


Fix select with less than max cards selected

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -296,7 +296,7 @@
                     (if-let [m (get-in ability [:choices :max])]
                       (str "Select up to " m " targets for " (:title card))
                       (str "Select a target for " (:title card))))
-                  ["Done"] (req (resolve-select state side))
+                  ["Done"] (fn [choice] (resolve-select state side))
                   (assoc args :prompt-type :select)))))

 (defn resolve-ability [state side {:keys [counter-cost advance-counter-cost cost effect msg req once
@@ -387,8 +387,8 @@
       (pay state side card :credit choice))
     (when (= (:choices prompt) :counter)
       (add-prop state side (:card prompt) :counter (- choice)))
+    ((:effect prompt) (or choice card))
     (swap! state update-in [side :prompt] (fn [pr] (filter #(not= % prompt) pr)))
-    ((:effect prompt) (or choice card))
     (when (empty? (get-in @state [:runner :prompt]))
       (when-let [run (:run @state)]
         (when (:ended run)


Fixed issue #32: Application can't fail when port is not specified on the command line, use default port instead.

--- src/clouseau/core.clj
+++ src/clouseau/core.clj
@@ -52,12 +52,21 @@
   [["-p" "--port   PORT"    "port number"   :id :port]])

 (def app
-    (-> server/handler cookies/wrap-cookies http-params/wrap-params))
+    "Ring application."
+    (-> server/handler
+        cookies/wrap-cookies
+        http-params/wrap-params))

 (defn start-server
+    "Start server on specified port."
     [port]
     (println "Starting the server at the port: " port)
     (jetty/run-jetty app {:port (read-string port)}))
+
+(defn get-port
+    "Returns specified port or default port if none is specified on the command line."
+    [specified-port]
+    (or specified-port "3000"))

 (defn -main
     "Entry point to the Clouseau server."
@@ -65,5 +74,5 @@
     (let [all-options      (cli/parse-opts args cli-options)
           options          (all-options :options)
           port             (options :port)]
-          (start-server port)))
+          (start-server (get-port port))))


Doc listbox basically works, without flexible ordering.  Poor layout.

You can select an arbitrary set of things to enable showing, rather
than only one!

--- src/clj_ns_browser/browser.clj
+++ src/clj_ns_browser/browser.clj
@@ -601,27 +601,7 @@
     (config! (id :ns-lb) :selection-mode :multi-interval) ;; experimental...
     (config! (id :vars-lb) :model [])
     (config! (id :ns-entries-lbl) :text "0")
-    (config! (id :doc-lb)
-             :model doc-lb-value-list
-             :drag-enabled? true
-             :drop-mode :insert
-             :transfer-handler
-             (seesaw.dnd/default-transfer-handler
-               :import [seesaw.dnd/string-flavor
-                        (fn [{:keys [target data drop? drop-location] :as m}]
-                          ;; Ignore anything dropped onto the list that is
-                          ;; not in the original set of list elements.
-                          (if (and drop?
-                                   (:insert? drop-location)
-                                   (:index drop-location)
-                                   (doc-lb-value-set data))
-                            (let [new-order (list-with-elem-at-index
-                                              @doc-lb-cur-order data
-                                              (:index drop-location))]
-                              (reset! doc-lb-cur-order new-order)
-                              (config! target :model new-order))))]
-               :export {:actions (constantly :copy)
-                        :start   (fn [c] [seesaw.dnd/string-flavor (selection c)])}))
+    (config! (id :doc-lb) :model doc-lb-value-list)
     (config! (id :edit-btn) :enabled? false)
     (config! (id :browse-btn) :enabled? false)
     (config! (id :clojuredocs-online-rb) :selected? true)


Don't wait for stdin

Don't wait for stdin

--- src/clojure/nightcode/lein.clj
+++ src/clojure/nightcode/lein.clj
@@ -55,7 +55,6 @@
           pump-in (doto (ClosingPipe. *in* in) .start)]
       (.join pump-out)
       (.join pump-err)
-      (.join pump-in)
       (.waitFor @process))))

 (defn start-process-command
@@ -81,7 +80,7 @@
 (defn run-project-fast
   [path]
   ;We could do this:
-  ;(start-thread in out (start-process-command "run" path))
+  ;(start-process-command "run" path)
   ;But instead we are calling the Leiningen code directly for speed:
   (let [project-map (read-project-clj path)
         _ (leiningen.core.eval/prep project-map)


http-kit/clojure: Minify: Move func args to a line above.

--- src/clojure/src/dnsresolvd.clj
+++ src/clojure/src/dnsresolvd.clj
@@ -15,8 +15,7 @@
 (ns dnsresolvd)

 (defn startup
-    "Starts up the daemon."
-    [args]
+    "Starts up the daemon." [args]

     (let [port-number (first             args  )]
     (let [daemon-name (first       (rest args ))]


shopping cart: fixed bug: on checkout products query was performed twice

--- examples/shopping-cart/project.clj
+++ examples/shopping-cart/project.clj
@@ -3,8 +3,8 @@
   :dependencies [[org.clojure/clojure "1.8.0"]
                  [org.clojure/clojurescript "1.7.228"]

-                 [reagent "0.5.1" :exclusions [cljsjs/react]]
-                 [cljsjs/react-with-addons "0.13.3-0"]
+                 [reagent "0.6.0-alpha" :exclusions [cljsjs/react]]
+                 [cljsjs/react-with-addons "0.14.3-0"]

                  [org.clojure/core.match "0.3.0-alpha4"]


Reset Hystrix after tests have run.

Reset Hystrix after tests have run.

Without the resets, running the tests more than once will fail due to
collapser instance caching behind the scenes.

--- hystrix-contrib/hystrix-clj/src/test/clojure/com/netflix/hystrix/core_test.clj
+++ hystrix-contrib/hystrix-clj/src/test/clojure/com/netflix/hystrix/core_test.clj
@@ -1,8 +1,18 @@
 (ns com.netflix.hystrix.core-test
   (:use com.netflix.hystrix.core)
   (:require [clojure.test :refer [deftest testing is are use-fixtures]])
-  (:import [com.netflix.hystrix HystrixExecutable]
+  (:import [com.netflix.hystrix Hystrix HystrixExecutable]
            [com.netflix.hystrix.strategy.concurrency HystrixRequestContext]))
+
+; reset hystrix after each execution, for consistency and sanity
+(defn reset-fixture
+  [f]
+  (try
+    (f)
+    (finally
+      (Hystrix/reset))))
+
+(use-fixtures :once reset-fixture)

 ; wrap each test in hystrix context
 (defn request-context-fixture


added corpus as well

added corpus as well

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -419,7 +419,7 @@
    The clustering is done using single
    linkage and XPath-text structural
    similarity"
-  [xpaths-and-urls src-path url]
+  [xpaths-and-urls src-path url leaf?]
   (reduce
    (fn [acc {xpath :xpath hrefs-and-texts :hrefs-and-texts}]
      (let [stuff  (utils/distinct-by-key
@@ -441,22 +441,36 @@
                                             4)))
                             stuff)

+           sampled-corpus  (doall
+                            (map
+                             (fn [x]
+                               (do
+                                 (Thread/sleep 2000)
+                                 (utils/sayln :downloading (:url x))
+                                 (merge x {:body (-> x :url utils/download-cache-with-cookie)})))
+                             links-and-texts))
+
            clusters        (doall
                             (cluster/cluster
-                             (doall
-                              (map
-                               (fn [x]
-                                 (do
-                                   (Thread/sleep 2000)
-                                   (utils/sayln :downloading (:url x))
-                                   (merge x {:body (-> x :url utils/download-cache-with-cookie)})))
-                               links-and-texts))
+                             sampled-corpus
                              (fn [x y] (similarity/similar?
                                        (:body x)
                                        (:body y)))))
-           examples        (map rand-nth clusters)]
-       (concat acc examples)))
-   []
+           examples        (map rand-nth clusters)
+
+           leaf-paths      (frequencies
+                            (map
+                             :path
+                             (filter
+                              (fn [x]
+                                (leaf? {:anchor-text (:src-text x)
+                                        :src-url     (:url x)
+                                        :body        (:body x)}))
+                              sampled-corpus)))]
+       (merge-with concat acc {:leaf-paths leaf-paths
+                               :examples examples
+                               :corpus   sampled-corpus})))
+   {}
    xpaths-and-urls))

 (defn crawl-example
@@ -541,6 +555,7 @@
                                                blacklist)
                          prepared (prepare-example (:xpath-nav-info state-action)
                                                    (-> url-queue first :path)
-                                                   url)]
+                                                   url
+                                                   leaf?)]
                      prepared)))))))


Remove console clutter

Remove console clutter

--- src/yada/core.clj
+++ src/yada/core.clj
@@ -280,7 +280,6 @@
               ;; Method Not Allowed
               (link ctx
                 (let [am (allowed-methods ctx)]
-                  (infof "am is %s" (seq am) )
                   (when-not (contains? (allowed-methods ctx) method)
                     (d/error-deferred
                      (ex-info (format "Method not allowed: %s" method)
@@ -454,13 +453,11 @@

                                (assoc-in ctx [:response :headers "last-modified"] (format-date last-modified))))

-                           (do
-                             (infof "No if-modified-since header: %s" (:headers req))
-                             (or
-                              (some->> (if (d/deferrable? last-modified) @last-modified last-modified)
-                                       format-date
-                                       (assoc-in ctx [:response :headers "last-modified"]))
-                              ctx))))))
+                           (or
+                            (some->> (if (d/deferrable? last-modified) @last-modified last-modified)
+                                     format-date
+                                     (assoc-in ctx [:response :headers "last-modified"]))
+                            ctx)))))

                    ;; Create body
                    (fn [ctx]


Minor fix on `normalize` function.

Minor fix on `normalize` function.

--- src/datoteka/core.clj
+++ src/datoteka/core.clj
@@ -212,7 +212,7 @@
       (pt/-path *home*)

       (.startsWith path (str "~" *sep*))
-      (pt/-path (.replace path "~" ^String *home*))
+      (pt/-path (.replace path "~" ^String (.toString ^Object *home*)))

       (not (.startsWith path *sep*))
       (pt/-path (str *cwd* *sep* path))


Form to add new product to the database

Form to add new product to the database

--- src/hurvinek/html_renderer.clj
+++ src/hurvinek/html_renderer.clj
@@ -171,11 +171,24 @@
                 [:div {:class "container-fluid"}
                     [:h2 "Product list"]
                     [:table {:class "table table-hover"}
-                    (for [product product-list]
-                        [:tr
-                            [:td [:a {:href (str "product?product-id=" (:id product))} (:name product)]]
-                            [:td [:a {:href (str "product?product-id=" (:id product))} (:description product)]]])
+                        (for [product product-list]
+                            [:tr
+                                [:td [:a {:href (str "product?product-id=" (:id product))} (:name product)]]
+                                [:td [:a {:href (str "product?product-id=" (:id product))} (:description product)]]])
                     ]
+                    [:br]
+                    [:h3 "New product"]
+                    (form/form-to [:get "add-new-product"]
+                        [:fieldset {:class "form-group"}
+                            [:label {:for "product-name"} "Product name"]
+                            [:input {:type "text" :class "form-control" :id "product-name" :name "product-name" :placeholder "product name"}]
+                        ]
+                        [:fieldset {:class "form-group"}
+                            [:label {:for "product-description"} "Description for product"]
+                            [:input {:type "text" :class "form-control" :id "product-description" :name "description" :placeholder "description"}]
+                        ]
+                        [:button {:type "submit" :class "btn btn-primary"} "Add new product"]
+                    )
                 ]
                 (render-back-link url-prefix)
                 (render-html-footer)


Rename index to create-index.

Rename index to create-index.

--- src/fleetdb/core.clj
+++ src/fleetdb/core.clj
@@ -161,7 +161,7 @@
             old-records)]
     [(assoc db :rmap new-rmap :imap new-imap) num-old-records]))

-(defn- q-index [db {:keys [on where]}]
+(defn- q-create-index [db {:keys [on where]}]
   (let [records (vals (:rmap db))
         index
           (reduce
@@ -183,13 +183,13 @@
          queries)))

 (def- query-fns
-  {:select q-select
-   :count  q-count
-   :insert q-insert
-   :update q-update
-   :delete q-delete
-   :index  q-index
-   :mread  q-mread})
+  {:select        q-select
+   :count         q-count
+   :insert        q-insert
+   :update        q-update
+   :delete        q-delete
+   :create-index  q-create-index
+   :mread         q-mread})

 (defn exec [db [query-type opts]]
   (if-let [queryfn (query-fns query-type)]


Implemented 6/8 cases.

Implemented 6/8 cases.

--- src/forumdb/core.clj
+++ src/forumdb/core.clj
@@ -186,68 +186,87 @@

     (println "liczba tematów utworzonych w 2013 roku")
     (let [operationStart (System/currentTimeMillis)]
-      ;(HGQuery$hg/findAll (HGQuery$hg/and (HGQuery$hg/type ForumThread) (HGQuery$hg/eq "")))
-
-      (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+      (do
+        ;(HGQuery$hg/findAll (HGQuery$hg/and (HGQuery$hg/type ForumThread) (HGQuery$hg/eq "")))
+
+        (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+        )
       )
     (println)

     (println "najbardziej popularny temat w maju 2013")
     (let [operationStart (System/currentTimeMillis)]
-
-      (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+      (do
+
+        (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+        )
       )
     (println)

     (println "średnia długość tekstu posta")
     (let [operationStart (System/currentTimeMillis)]
-      (def posts (HGQuery$hg/getAll @database (HGQuery$hg/type Post)))
-      (println (quot (reduce (fn [count post] (+ (. (. post getContent) length) count)) 0 posts)  (count posts)))
-      (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+      (do
+        (def posts (HGQuery$hg/getAll @database (HGQuery$hg/type Post)))
+        (println (quot (reduce (fn [count post] (+ (. (. post getContent) length) count)) 0 posts) (count posts)))
+        (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+        )
       )
     (println)

     (println "użytkownik wypowiadający się w największej liczbie tematów")
     (let [operationStart (System/currentTimeMillis)]
-      (def userHandles (HGQuery$hg/findAll @database (HGQuery$hg/type User)))
-      (def uniqueThreadsCount (map (fn [userHandle] (. (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type userThreadRelType)]))) size)) userHandles))
-      ;(def uniqueThreadsCount (map (fn [user] (reduce (fn [count thread] (if (> (. (HGQuery$hg/findAll @database (HGQuery$hg/link (into-array HGHandle [user thread]))) size) 0) (+ count 1) count)) 0 (HGQuery$hg/findAll @database (HGQuery$hg/type ForumThread)))) userHandles))
-      (def mostActiveUser (reduce (fn [x y] (if (> (last x) (last y)) x y)) (map vector userHandles uniqueThreadsCount)))
-      (println (. (. @database get (first mostActiveUser)) getLogin) (last mostActiveUser))
-      (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+      (do
+        (def userHandles (HGQuery$hg/findAll @database (HGQuery$hg/type User)))
+        (def uniqueThreadsCount (map (fn [userHandle] (HGQuery$hg/count @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type userThreadRelType)])))) userHandles))
+        ;(def uniqueThreadsCount (map (fn [user] (reduce (fn [count thread] (if (> (. (HGQuery$hg/findAll @database (HGQuery$hg/link (into-array HGHandle [user thread]))) size) 0) (+ count 1) count)) 0 (HGQuery$hg/findAll @database (HGQuery$hg/type ForumThread)))) userHandles))
+        (def mostActiveUser (reduce (fn [x y] (if (> (last x) (last y)) x y)) (map vector userHandles uniqueThreadsCount)))
+        (println (. (. @database get (first mostActiveUser)) getLogin) (last mostActiveUser))
+        (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+        )
       )
     (println)

     (println "użytkownik komentujący największą liczbę innych użytkowników")
     (let [operationStart (System/currentTimeMillis)]
-
-      (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+      (do
+        (def userHandles (HGQuery$hg/findAll @database (HGQuery$hg/type User)))
+        (def postsCount (map (fn [userHandle] (HGQuery$hg/count @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type userPostRelType)])))) userHandles))
+        (def mostActiveUser (reduce (fn [x y] (if (> (last x) (last y)) x y)) (map vector userHandles postsCount)))
+        (println (. (. @database get (first mostActiveUser)) getLogin) (last mostActiveUser))
+        (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+        )
       )
     (println)

     (println "liczba postów zawierających słowo 'Frodo'")
     (let [operationStart (System/currentTimeMillis)]
-      (println (HGQuery$hg/count @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Post) (AtomPartRegExPredicate. (into-array String ["content"]) (Pattern/compile ".*Frodo.*" Pattern/DOTALL))]))))
-      ;(def posts (HGQuery$hg/getAll @database (HGQuery$hg/type Post)))
-      ;(println (count (filter (fn [post] (if (re-find #"Frodo" (. post getContent)) true false)) posts)))
-      (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+      (do
+        (println (HGQuery$hg/count @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Post) (AtomPartRegExPredicate. (into-array String ["content"]) (Pattern/compile ".*Frodo.*" Pattern/DOTALL))]))))
+        ;(def posts (HGQuery$hg/getAll @database (HGQuery$hg/type Post)))
+        ;(println (count (filter (fn [post] (if (re-find #"Frodo" (. post getContent)) true false)) posts)))
+        (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+        )
       )
     (println)

     (println "liczba postów wysłanych przez użytkowników z miasta na literę 'K'")
     (let [operationStart (System/currentTimeMillis)]
-      (def userHandles (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type User) (AtomPartRegExPredicate. (into-array String ["city"]) (Pattern/compile "^K.*" Pattern/MULTILINE))]))))
-      ;(def userHandles (filter (fn [userHandle] (. (. (. @database get userHandle) getCity) startsWith "K")) (HGQuery$hg/findAll @database (HGQuery$hg/type User))))
-      (println (apply + (map (fn [userHandle] (. (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type userPostRelType)]))) size)) userHandles)))
-      (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+      (do
+        (def userHandles (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type User) (AtomPartRegExPredicate. (into-array String ["city"]) (Pattern/compile "^K.*" Pattern/MULTILINE))]))))
+        ;(def userHandles (filter (fn [userHandle] (. (. (. @database get userHandle) getCity) startsWith "K")) (HGQuery$hg/findAll @database (HGQuery$hg/type User))))
+        (println (apply + (map (fn [userHandle] (. (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type userPostRelType)]))) size)) userHandles)))
+        (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+        )
       )
     (println)

     (println "35te najczęściej użyte słowo w treści posta")
     (let [operationStart (System/currentTimeMillis)]
-      (def posts (HGQuery$hg/getAll @database (HGQuery$hg/type Post)))
-      (println (first (nth (sort-by val > (reduce (fn [wordMap post] (merge-with + wordMap (reduce (fn [postWordMap word] (assoc postWordMap word (+ 1 (get postWordMap word 0)))) {} (string/split (string/triml (string/replace (. post getContent) (Pattern/compile "\\W" Pattern/UNICODE_CHARACTER_CLASS) " ")) #"\s+")))) {} posts)) 34)))
-      (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+      (do
+        (def posts (HGQuery$hg/getAll @database (HGQuery$hg/type Post)))
+        (println (first (nth (sort-by val > (reduce (fn [wordMap post] (merge-with + wordMap (reduce (fn [postWordMap word] (assoc postWordMap word (+ 1 (get postWordMap word 0)))) {} (string/split (string/triml (string/replace (. post getContent) (Pattern/compile "\\W" Pattern/UNICODE_CHARACTER_CLASS) " ")) #"\s+")))) {} posts)) 34)))
+        (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
+        )
       )
     (println)


fixes react warnings about "0" vs 0

fixes react warnings about "0" vs 0

--- src/datafrisk/core.cljs
+++ src/datafrisk/core.cljs
@@ -4,7 +4,7 @@
 (declare DataFrisk)

 (defn ExpandButton [{:keys [expanded? path emit-fn]}]
-  [:button {:style {:border "0"
+  [:button {:style {:border 0
                     :backgroundColor "transparent" :width "20px" :height "20px"}
             :onClick #(emit-fn (if expanded? :contract :expand) path)}
    [:svg {:viewBox "0 0 100 100"
@@ -206,7 +206,7 @@

 (defn FriskInlineVisibilityButton
   [visible? update-fn]
-  [:button {:style {:border "0"
+  [:button {:style {:border 0
                     :backgroundColor "transparent" :width "20px" :height "20px"}
             :onClick update-fn}
    [:svg {:viewBox "0 0 100 100"


Preds should end in question marks

Preds should end in question marks

--- src/desdemona/query.clj
+++ src/desdemona/query.clj
@@ -82,7 +82,7 @@
 (def infix->dsl
   (comp parsed-infix->dsl infix-parser))

-(def ^:private free-sym
+(def ^:private free-sym?
   "Check if an object has the free variable metadata annotation."
   (every-pred symbol? (comp ::free meta)))


[#1845]Add instance details to import flow data ex

--- backend/src/akvo/lumen/lib/import/flow.clj
+++ backend/src/akvo/lumen/lib/import/flow.clj
@@ -28,6 +28,11 @@
           (<= version 2) (v2/dataset-columns (flow-common/form @survey formId))
           (<= version 3) (v3/dataset-columns (flow-common/form @survey formId))))
       (records [this]
-        (cond
-          (<= version 2) (v2/form-data headers-fn @survey formId)
-          (<= version 3) (v3/form-data headers-fn @survey formId))))))
+        (try
+          (cond
+            (<= version 2) (v2/form-data headers-fn @survey formId)
+            (<= version 3) (v3/form-data headers-fn @survey formId))
+          (catch Throwable e
+            (if-let [ex-d (ex-data e)]
+              (throw (ex-info (:cause e) (assoc ex-d :instance instance)))
+              (throw e))))))))


Remove dead code that snuck in during a rebase

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -268,28 +268,6 @@
     {:type :subpage :href "#projects" :title "Projects" :subpage :projects}
     {:type :subpage :href "#users" :title "Users" :subpage :users}]))

-(defn account-settings-nav-items []
-  (remove
-    nil?
-    [{:type :subpage :href (routes/v1-account) :title "Notifications" :subpage :notifications}
-     {:type :subpage :href (routes/v1-account-subpage {:subpage "api"}) :title "API Tokens" :subpage :api}
-     {:type :subpage :href (routes/v1-account-subpage {:subpage "heroku"}) :title "Heroku" :subpage :heroku}
-     (when-not (config/enterprise?)
-       {:type :subpage :href (routes/v1-account-subpage {:subpage "plans"}) :title "Plan Pricing" :subpage :plans})
-     (when-not (config/enterprise?)
-       {:type :subpage :href (routes/v1-account-subpage {:subpage "beta"}) :title "Beta Program" :subpage :beta})]))
-
-(defn account-settings-menu [app owner]
-  (reify
-    om/IRender
-    (render [_]
-      (let [subpage (-> app :navigation-data :subpage)]
-        (html
-          [:div.aside-user {:class (when (= :account (:navigation-point app)) "open")}
-           [:header [:h4 "Account Settings"]]
-           [:div.aside-user-options
-            (expand-menu-items (account-settings-nav-items) subpage)]])))))
-
 (defn admin-settings-nav-items []
   (concat
     [{:type :subpage :href "/admin" :title "Overview" :subpage :overview}


Allowing orgs with only an osx plan to see their billing info.

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -243,9 +243,10 @@
       [{:type :subpage :title "Update plan" :href "#containers" :subpage :containers}]
       (when (pm/transferrable-or-piggiebackable-plan? plan)
         [{:type :subpage :title "Organizations" :href "#organizations" :subpage :organizations}])
+      (when (or (pm/paid? plan) (pm/osx? plan))
+        [{:type :subpage :title "Billing info" :href "#billing" :subpage :billing}])
       (when (pm/paid? plan)
-        [{:type :subpage :title "Billing info" :href "#billing" :subpage :billing}
-         {:type :subpage :title "Cancel" :href "#cancel" :subpage :cancel}])))
+        [{:type :subpage :title "Cancel" :href "#cancel" :subpage :cancel}])))
    [{:type :heading :title "Organization"}
     {:type :subpage :href "#projects" :title "Projects" :subpage :projects}
     {:type :subpage :href "#users" :title "Users" :subpage :users}]))


fix cursor jumping in safari and firefox when editing contenteditable input

--- src-cljs/frontend/components/outer.cljs
+++ src-cljs/frontend/components/outer.cljs
@@ -25,6 +25,49 @@
                    [cljs.core.async.macros :as am :refer [go go-loop alt!]])
   (:import [goog.ui IdGenerator]))

+(defn submit-early-access-form [owner]
+  (go
+    (om/update-state! owner (fn [s]
+                              (assoc s :submitting? true :error nil)))
+    ;; we wouldn't typically use ajax in a component--it's not advisable in
+    ;; this case, but we're short on time
+    ;; important to get the state out of owner since we're not re-rendering on update
+    (let [{:keys [company-name employee-count use-case]} (om/get-state owner)
+          res (<! (ajax/managed-ajax :post "/api/v1/early-access" :params {:company-name company-name
+                                                                           :employee-count employee-count
+                                                                           :use-case use-case}))]
+      (if (= :success (:status res))
+        (om/update-state! owner (fn [s]
+                                  (assoc s
+                                         :submitting? false
+                                         :submitted? true
+                                         :error nil
+                                         :company-name ""
+                                         :employee-count ""
+                                         :use-case "")))
+        (do
+          (om/update-state!
+           owner
+           (fn [s]
+             (assoc s
+                    :submitting? false
+
+                    :error
+                    [:p "Oops that didn't work! "
+                     [:a {:on-click #(.stopPropagation %)
+                          :href
+                          (str "mailto:hi@precursorapp.com?"
+                               (url/map->query {:subject "Early Access to Precursor"
+                                                :body (str "Company Name\n"
+                                                           company-name
+                                                           "\n\nTeam Size\n"
+                                                           employee-count
+                                                           "\n\nUse Case\n"
+                                                           use-case)}))}
+                      "Try this email"]
+                     "."])))
+          (put! (om/get-shared owner [:comms :errors]) [:api-error res]))))))
+
 (defn early-access [app owner]
   (reify
     om/IInitState (init-state [_] {:company-name ""
@@ -37,46 +80,7 @@
     om/IRenderState
     (render-state [_ {:keys [company-name employee-count use-case submitting? error submitted?]}]
       (let [{:keys [cast! handlers]} (om/get-shared owner)
-            disabled? (or submitting? (not (utils/logged-in? owner)))
-            submit-form
-            (fn [params]
-              (go
-                (om/update-state! owner (fn [s]
-                                          (assoc s :submitting? true :error nil)))
-                ;; we wouldn't typically use ajax in a component--it's not advisable in
-                ;; this case, but we're short on time
-                (let [res (<! (ajax/managed-ajax :post "/api/v1/early-access" :params params))]
-                  (if (= :success (:status res))
-                    (om/update-state! owner (fn [s]
-                                              (assoc s
-                                                     :submitting? false
-                                                     :submitted? true
-                                                     :error nil
-                                                     :company-name ""
-                                                     :employee-count ""
-                                                     :use-case "")))
-                    (do
-                      (om/update-state!
-                       owner
-                       (fn [s]
-                         (assoc s
-                                :submitting? false
-
-                                :error
-                                [:p "Oops that didn't work! "
-                                 [:a {:on-click #(.stopPropagation %)
-                                      :href
-                                      (str "mailto:hi@precursorapp.com?"
-                                           (url/map->query {:subject "Early Access to Precursor"
-                                                            :body (str "Company Name\n"
-                                                                       company-name
-                                                                       "\n\nTeam Size\n"
-                                                                       employee-count
-                                                                       "\n\nUse Case\n"
-                                                                       use-case)}))}
-                                  "Try this email"]
-                                 "."])))
-                      (put! (om/get-shared owner [:comms :errors]) [:api-error res]))))))]
+            disabled? (or submitting? (not (utils/logged-in? owner)))]
         (html
          [:div.early-access {:class (get-in app [:navigation-data :type] "team")}
           [:div.content
@@ -108,7 +112,7 @@
                               (.preventDefault %)
                               ;; If they hit enter, send them to the next input.
                               (.focus (om/get-node owner "employee-count")))
-              :on-input #(om/set-state! owner :company-name (goog.dom/getRawTextContent (.-target %)))}
+              :on-input #(om/set-state-nr! owner :company-name (goog.dom/getRawTextContent (.-target %)))}
              company-name]
             [:div.adaptive-placeholder.early-access-size
              {:tab-index "3"
@@ -120,7 +124,7 @@
                               (.preventDefault %)
                               ;; If they hit enter, send them to the next input.
                               (.focus (om/get-node owner "use-case")))
-              :on-input #(om/set-state! owner :employee-count (goog.dom/getRawTextContent (.-target %)))}
+              :on-input #(om/set-state-nr! owner :employee-count (goog.dom/getRawTextContent (.-target %)))}
              employee-count]
             [:div.adaptive-placeholder.early-access-uses
              {:tab-index "4"
@@ -133,14 +137,12 @@
                               ;; If they hit enter, send them to the next input.
                               (.focus (om/get-node owner "submit-button"))
                               (.click (om/get-node owner "submit-button")))
-              :on-input #(om/set-state! owner :use-case (goog.dom/getRawTextContent (.-target %)))}
+              :on-input #(om/set-state-nr! owner :use-case (goog.dom/getRawTextContent (.-target %)))}
              use-case]
             [:button.early-access-button {:tab-index "5"
                                           :ref "submit-button"
                                           :disabled (or disabled? submitted?)
-                                          :on-click #(submit-form {:company-name company-name
-                                                                   :employee-count employee-count
-                                                                   :use-case use-case})}
+                                          :on-click #(submit-early-access-form owner)}
              (cond submitting?
                    (html
                     [:span "Request is submitting"


* benchmark/cljs/benchmark_runner.cljs: add map related benchmarks

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -28,6 +28,12 @@
 (simple-benchmark [coll [1 2 3]] (next coll) 1000000)
 (println)

+(println ";;; map ops")
+(simple-benchmark [coll {:foo 1 :bar 2}] (get coll :foo) 1000000)
+(simple-benchmark [coll {:foo 1 :bar 2}] (-lookup coll :foo nil) 1000000)
+(simple-benchmark [coll {:foo 1 :bar 2}] (assoc coll :baz 3) 100000)
+(println)
+
 (println ";;; seq ops")
 (simple-benchmark [coll (range 500000)] (reduce + coll) 1)
 (println)


* benchmark/cljs/benchmark_runner.cljs: 1000000 iters for string hash benchmark

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -85,7 +85,7 @@
              [:i 8] [:j 9] [:k 10] [:l 11] [:m 12] [:n 13] [:o 14] [:p 15]
              [:q 16] [:r 17] [:s 18] [:t 19] [:u 20] [:v 21] [:w 22] [:x 23]
              [:y 24] [:z 25] [:a0 26] [:b0 27] [:c0 28] [:d0 29] [:e0 30] [:f0 31]]))
-(simple-benchmark [key :f0] (hash key) 100000)
+(simple-benchmark [key :f0] (hash key) 1000000)
 (simple-benchmark [coll pmap] (:f0 coll) 100000)
 (simple-benchmark [coll pmap] (get coll :f0) 100000)
 (simple-benchmark [coll pmap] (-lookup coll :f0 nil) 100000)


Handle some issues reading meta

Handle some issues reading meta

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -184,7 +184,11 @@
 (defn read-meta [config thing]
   (let [thing  (ensure-thing thing)
         handle (thing->meta-handle config thing)]
-    (->> handle slurp edn/read-string)))
+    (when (.exists handle) ;; guard against missing files
+      (-> handle
+          slurp
+          (string/replace #"#<.*?>" "nil") ;; FIXME: Hack to ignore unreadable #<>s
+          edn/read-string))))

 (defn read-related
   "Returns a sequence of things representing symbols related to this or prior


Improve tenancy compatibility check

Improve tenancy compatibility check

--- src/onyx/peer/communicator.clj
+++ src/onyx/peer/communicator.clj
@@ -33,13 +33,17 @@
     ;; Race to write the job scheduler and messaging to durable storage so that
     ;; non-peers subscribers can discover which properties to use.
     ;; Only one writer will succeed, and only one needs to.
-
-    (extensions/write-chunk log
-                            :log-parameters
-                            {:job-scheduler (:onyx.peer/job-scheduler peer-config)
-                             :messaging (select-keys peer-config [:onyx.messaging/impl])
-                             :log-version onyx.peer.log-version/version}
-                            nil)
+    (let [log-parameters {:job-scheduler (:onyx.peer/job-scheduler peer-config)
+                          :messaging (select-keys peer-config [:onyx.messaging/impl])
+                          :log-version onyx.peer.log-version/version}]
+      (extensions/write-chunk log :log-parameters log-parameters nil)
+      (let [read-log-parameters (extensions/read-chunk log :log-parameters nil)]
+        (onyx.peer.log-version/check-compatible-log-versions! (:log-version read-log-parameters))
+        (when-not (= (dissoc log-parameters :log-version)
+                     (dissoc read-log-parameters :log-version))
+          (throw (ex-info "Log parameters read from cluster differ from the local parameters."
+                          {:log-parameters log-parameters
+                           :read-log-parameters read-log-parameters})))))
     (let [outbox-ch (chan (arg-or-default :onyx.peer/outbox-capacity peer-config))
           outbox-loop-thread (thread (outbox-loop log outbox-ch group-ch))]
       (assoc component


Assoc bounds and window into trigger event earlier

--- src/onyx/peer/window_state.clj
+++ src/onyx/peer/window_state.clj
@@ -128,39 +128,39 @@
     (let [{:keys [trigger-state extent]} state-event
           {:keys [sync-fn trigger create-state-update apply-state-update]} trigger-state
           extent-state (get state extent)
+          state-event (assoc state-event :extent-state extent-state)
           entry (create-state-update trigger extent-state state-event)
           new-extent-state (apply-state-update trigger extent-state entry)
-          [lower-bound upper-bound] (we/bounds window-extension extent)
-          state-event* (-> state-event
-                           (assoc :window window)
-                           (assoc :lower-bound lower-bound)
-                           (assoc :upper-bound upper-bound)
-                           (assoc :extent-state extent-state)
-                           (assoc :trigger-update entry)
-                           (assoc :next-state new-extent-state))]
-      (sync-fn (:task-event state-event*) window trigger state-event* extent-state)
+          state-event (-> state-event
+                          (assoc :next-state new-extent-state)
+                          (assoc :trigger-update entry))]
+      (sync-fn (:task-event state-event) window trigger state-event extent-state)
       (assoc this
              :state (assoc state extent new-extent-state)
              :event-results (if (= extent-state new-extent-state)
                               event-results
-                              (conj event-results state-event*)))))
+                              (conj event-results state-event)))))

   (trigger [this]
     (let [{:keys [trigger-index trigger-state]} state-event
           {:keys [trigger next-trigger-state trigger-fire? fire-all-extents?]} trigger-state
           new-trigger-state (next-trigger-state trigger (:state trigger-state) state-event)
           ;; TODO, scope this via :trigger/scope
-          fire? (trigger-fire? trigger new-trigger-state state-event)
           fire-all? (or fire-all-extents? (not= (:event-type state-event) :segment))
-          fire-extents (if fire?
-                         (if fire-all?
-                           (keys state)
-                           (:extents state-event))
-                         [])]
+          fire-extents (if fire-all?
+                         (keys state)
+                         (:extents state-event))]
       (reduce (fn [t extent]
-                (trigger-extent (assoc t
-                                       :state-event
-                                       (assoc state-event :extent extent))))
+                (let [[lower-bound upper-bound] (we/bounds window-extension extent)
+                      state-event (-> state-event
+                                      (assoc :window window)
+                                      (assoc :lower-bound lower-bound)
+                                      (assoc :upper-bound upper-bound))]
+                  (if (trigger-fire? trigger new-trigger-state state-event)
+                    (trigger-extent (assoc t
+                                           :state-event
+                                           (assoc state-event :extent extent)))
+                    t)))
               (assoc-in this [:trigger-states trigger-index :state] new-trigger-state)
               fire-extents)))


Add validator for state aggregation calls

--- src/onyx/static/validation.clj
+++ src/onyx/static/validation.clj
@@ -4,7 +4,7 @@
             [schema.core :as schema]
             [onyx.static.planning :as planning]
             [onyx.windowing.units :as u]
-            [onyx.schema :refer [TaskMap Catalog Workflow Job LifecycleCall
+            [onyx.schema :refer [TaskMap Catalog Workflow Job LifecycleCall StateAggregationCall
                                  Lifecycle EnvConfig PeerConfig FlowCondition]]))

 (defn validate-java-version []
@@ -111,6 +111,9 @@
 (defn validate-lifecycle-calls [m]
   (schema/validate LifecycleCall m))

+(defn validate-state-aggregation-calls [m]
+  (schema/validate StateAggregationCall m))
+
 (defn validate-env-config [env-config]
   (schema/validate EnvConfig env-config))


Focus management #38 - corrected focus traversal order calculation

--- src/flatgui/focus.clj
+++ src/flatgui/focus.clj
@@ -12,7 +12,8 @@
             [flatgui.inputchannels.awtbase :as inputbase]
             [flatgui.inputchannels.mouse :as mouse]
             [flatgui.inputchannels.keyboard :as keyboard]
-            [flatgui.util.matrix :as m])
+            [flatgui.util.matrix :as m]
+            [flatgui.util.rectmath :as rect])
   (:import (java.awt.event KeyEvent)
            (java.util Comparator)))

@@ -38,12 +39,28 @@
 (def component-comparator
   (reify Comparator
     (compare [_this o1 o2]
-      (let [by-x (- (m/mx-x (:position-matrix o1)) (m/mx-x (:position-matrix o2)))]
-        (if (= by-x 0)
-          (- (m/mx-y (:position-matrix o1)) (m/mx-y (:position-matrix o2)))
-          by-x)))))
-
-(defn- sort-lines [lines] (map (fn [l] (sort component-comparator l)) lines))
+      (let [x1 (m/mx-x (:position-matrix o1))
+            x2 (m/mx-x (:position-matrix o2))]
+        (if (< x1 x2)
+          -1
+          (if (> x1 x2)
+            1
+            (let [y1 (m/mx-y (:position-matrix o1))
+                  y2 (m/mx-y (:position-matrix o2))]
+              (if (< y1 y2) -1 (if (> y1 y2) 1 0)))))))))
+
+(defn- sort-each-line-by-x [lines] (mapv (fn [l] (sort component-comparator l)) lines))
+
+(def line-comparator
+  (reify Comparator
+    (compare [_this o1 o2]
+      (if (< (:line-y1 o1) (:line-y1 o2))
+        -1
+        (if (> (:line-y1 o1) (:line-y1 o2)) 1 0)))))
+
+(defn- sort-lines-by-y [lines line-y1]
+  (let [line-maps (map (fn [i] {:line (nth lines i) :line-y1 (nth line-y1 i)}) (range 0 (count lines)))]
+    (mapv #(:line %) (sort line-comparator line-maps))))

 (fg/defaccessorfn group-by-lines [component accepting-children]
   (let [cnt (count accepting-children)]
@@ -53,21 +70,21 @@
            i 0]
       (if (< i cnt)
         (let [c (nth accepting-children i)
-              cy (m/mx-y (get-property component [:this (:id c)] :position-matrix))
+              cy1 (m/mx-y (get-property component [:this (:id c)] :position-matrix))
+              cy2 (+ cy1 (m/y (get-property component [:this (:id c)] :clip-size)))
               line-index (if-let [matching (some
-                                             #(if (<= (nth line-y1 %) cy (nth line-y2 %)) %)
+                                             (fn [j] (if (rect/line& cy1 cy2 (nth line-y1 j) (nth line-y2 j)) j))
                                              (range 0 (count lines)))]
                            matching
                            (count lines))
               existing-line (< line-index (count lines))
-              line (if existing-line (nth lines line-index) #{})
-              cy2 (+ cy (m/y (get-property component [:this (:id c)] :clip-size)))]
+              line (if existing-line (nth lines line-index) #{})]
           (recur
-            (if existing-line line-y1 (assoc line-y1 line-index cy))
+            (assoc line-y1 line-index (if existing-line (min cy1 (nth line-y1 line-index)) cy1))
             (assoc line-y2 line-index (if existing-line (max cy2 (nth line-y2 line-index)) cy2))
             (assoc lines line-index (conj line c))
             (inc i)))
-        (sort-lines lines)))))
+        (sort-lines-by-y (sort-each-line-by-x lines) line-y1)))))

 ;;; Sorts focusable components so that they are traversed in left->right, up->down direction.
 ;;; To make such ad order, arranges components in a vector of horizontal "lines"


Get chrome to shut up about caching headers

--- src/frontend/core.clj
+++ src/frontend/core.clj
@@ -36,7 +36,8 @@
   [handler]
   (fn [req]
     (-> (handler req)
-        (response/header "Access-Control-Allow-Origin" "*"))))
+        (response/header "Access-Control-Allow-Origin" "*")
+        (response/header "Vary" "Accept-Encoding"))))

 (defn less-override
   "Serve LESS files instead of letting Stefon handle them. (Needed for sourcemap support)"
@@ -47,7 +48,9 @@
                  (if (= "/app.css.map" path) path)
                  (last (re-matches #"^/((?:(?:assets/css)|components)/.*\.less)$" path)))]
       (if file
-        (response/resource-response file)
+        (-> file
+            (response/resource-response)
+            (response/header "Content-Type" "text/plain; charset=utf-8"))
         (handler req)))))

 (defn wrap-hosted-scripts


add javac task

add javac task

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -13,6 +13,9 @@
    [boot.task-helpers        :as helpers]
    [boot.from.table.core     :as table])
   (:import
+   [java.io File]
+   [java.util Arrays]
+   [javax.tools ToolProvider DiagnosticCollector Diagnostic$Kind]
    [java.util.concurrent LinkedBlockingQueue TimeUnit]))

 ;; Tasks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -324,6 +327,39 @@
             (util/info "Compiling %s...\n" ns)
             (compile ns)))))))

+(core/deftask javac
+  "Compile java sources."
+  []
+  (let [tgt (core/mktgtdir! ::javac-tgt)]
+    (core/with-pre-wrap
+      (let [throw?    (atom nil)
+            diag-coll (DiagnosticCollector.)
+            compiler  (ToolProvider/getSystemJavaCompiler)
+            file-mgr  (.getStandardFileManager compiler diag-coll nil nil)
+            opts      (->> ["-d" (.getPath tgt)] (into-array String) Arrays/asList)
+            handler   {Diagnostic$Kind/ERROR util/fail
+                       Diagnostic$Kind/WARNING util/warn
+                       Diagnostic$Kind/MANDATORY_WARNING util/warn}
+            srcs      (some->> (core/src-files)
+                        (core/by-ext [".java"])
+                        seq
+                        (into-array File)
+                        Arrays/asList
+                        (.getJavaFileObjectsFromFiles file-mgr))]
+        (when srcs
+          (util/info "Compiling Java classes...\n")
+          (-> compiler (.getTask *err* file-mgr diag-coll opts nil srcs) .call)
+          (doseq [d (.getDiagnostics diag-coll) :let [k (.getKind d)]]
+            (when (= Diagnostic$Kind/ERROR k) (reset! throw? true))
+            ((handler k util/info)
+              "%s: %s, line %d: %s\n"
+              (.toString k)
+              (.. d getSource getName)
+              (.getLineNumber d)
+              (.getMessage d nil)))
+          (.close file-mgr)
+          (when @throw? (throw (Exception. "java compiler error"))))))))
+
 (core/deftask jar
   "Build a jar file for the project."


use single config map

use single config map

--- src/gitmirth/core.clj
+++ src/gitmirth/core.clj
@@ -51,23 +51,28 @@
     (io/make-parents file-path)
     (spit file-path xml-str)))

-(def channel-config
-  {:element-preds [:list :channel]
-   :id-preds [:id zip/down zip/node]
-   :name-preds [:name zip/down zip/node]
-   :path "channels"})
+(def config
+  {:channel {:element-preds [:list :channel]
+             :id-preds [:id zip/down zip/node]
+             :name-preds [:name zip/down zip/node]
+             :path "channels"}

-(def codeTemplate-config
-  {:element-preds [:list :codeTemplate]
-   :id-preds [:id zip/down zip/node]
-   :name-preds [:name zip/down zip/node]
-   :path "codeTemplates"})
+   :codeTemplate {:element-preds [:list :codeTemplate]
+                  :id-preds [:id zip/down zip/node]
+                  :name-preds [:name zip/down zip/node]
+                  :path "codeTemplates"}

-(def configurationMap-config
-  {:element-preds [:map]
-   :id-preds [(fn [_] "")]
-   :name-preds [(fn [_] "configurationMap")]
-   :path "server/configurationMap"})
+   :configurationMap {:element-preds [:map]
+                      :id-preds [(fn [_] "")]
+                      :name-preds [(fn [_] "configurationMap")]
+                      :path "server/configurationMap"}
+
+   :globalScripts {:element-preds [:map]
+                   :id-preds [(fn [_] "")]
+                   :name-preds [(fn [_] "globalScripts")]
+                   :path "server/globalScripts"}
+   })
+

 (defn download
   "Serializes all xml found at the api path using the supplied config"
@@ -94,15 +99,9 @@
   "App logic"
   [base-url username password]
   (with-authentication base-url username password
-    (fn [] (do
-            (download base-url channel-config)
-            (download base-url codeTemplate-config)
-            (download base-url configurationMap-config)
-
-            (upload base-url channel-config)
-            (upload base-url codeTemplate-config)
-            (upload base-url configurationMap-config)
-            ))))
+    (fn [] (doseq [c config]
+            (download base-url (val c))
+            (upload base-url (val c))))))

 (defn -main
   [& args]


+(defn refresh-models)

+(defn refresh-models)

--- src/babel/directory.cljc
+++ src/babel/directory.cljc
@@ -3,13 +3,21 @@
             [babel.espanol.grammar :as es]
             [babel.francais.grammar :as fr]
             [babel.italiano.grammar :as it]
-            [babel.latin :as la]))
+            [babel.latin :as la]
+            [clojure.tools.logging :as log]))
 (def models
   {:en (atom (delay (en/model)))
    :es (atom (delay (es/small)))
    :fr (atom (delay (fr/medium)))
-   :la (atom (delay (la/model)))
-   :it (atom (delay (it/model)))})
+   :it (atom (delay (it/model)))
+   :la (atom (delay (la/model)))})

-;; how to reload a model (e.g. english):
-;; (swap! (:en models) (fn [old-model] (delay (en/model))))
+(defn refresh-models []
+  (do
+    (log/info (str "refreshing models.."))
+    (swap! (:en models) (fn [old-model] (delay (en/model))))
+    (swap! (:es models) (fn [old-model] (delay (es/small))))
+    (swap! (:fr models) (fn [old-model] (delay (fr/medium))))
+    (swap! (:it models) (fn [old-model] (delay (it/model))))
+    (swap! (:la models) (fn [old-model] (delay (la/model))))
+    (log/info (str "refreshed models."))))


Add now respects no-filter

Add now respects no-filter

--- src/backloggery/core.clj
+++ src/backloggery/core.clj
@@ -48,7 +48,7 @@
   {"add"
    (fn []
      (let [other-games (data/read-games (:from *opts*))
-           bl-games (data/read-games "backloggery")
+           bl-games (if (:filter *opts*) (data/read-games "backloggery") [])
            new-games (filter-games bl-games other-games)]
        (println "BL " (count bl-games))
        (println "NEW" (count new-games))


RDC - Super helpful formatting changes.

RDC - Super helpful formatting changes.

--- src/icfp2015/unit.clj
+++ src/icfp2015/unit.clj
@@ -7,10 +7,10 @@
     :pivot (f (:pivot unit)) })

 (defn translate
-  ([direction] (fn [unit]
-                 (move unit (translate-dir direction))))
-  ([di dj] (fn [unit]
-             (move unit (fn [cell] (mapv + cell [di dj]))))))
+  ([direction]
+    (fn [unit] (move unit (translate-dir direction))))
+  ([di dj]
+    (fn [unit] (move unit (fn [cell] (mapv + cell [di dj]))))))

 (defn rotate [direction]
   (fn [unit]


build-lookup-table works in usual cases & when some data are missing

--- src/grafter/tabular.clj
+++ src/grafter/tabular.clj
@@ -311,31 +311,32 @@
      (throw (Exception. "Number of columns should be even")))))

 (defn build-lookup-table
-  "Takes a dataset, a vector of any number of integers corresponding
-  to key column numbers and a integer corresponding to the value
-  column number and returns a function, taking a row (a hash-map) as
+  "Takes a dataset, a vector of any number of column names corresponding
+  to key columns and a column name corresponding to the value
+  column.
+  Returns a function, taking a vector of keys as
   argument and returning the value wanted"
   ([dataset key-cols]
-     (let [key-names (map #(resolve-column-id dataset % "this column id doesn't exist!") key-cols)
-           compl-key-cols (vec (clojure.set/difference (set (:column-names dataset))
-                                                       (set (if (sequential? key-cols)
-                                                              key-names
-                                                              [key-names]))))]
-       (build-lookup-table dataset key-cols compl-key-cols)))
+   (let [key-names (map #(resolve-column-id dataset % "this column id doesn't exist!") key-cols)
+         compl-key-cols (vec (clojure.set/difference (set (:column-names dataset))
+                                                     (set (if (sequential? key-cols)
+                                                            key-names
+                                                            [key-names]))))]
+     (build-lookup-table dataset key-cols compl-key-cols)))

   ([dataset key-cols value-col]

-     (let [arg->vector (fn [x] (if (sequential? x) x [x]))
-           keys (:rows (all-columns dataset (arg->vector key-cols)))
-           val (:rows (all-columns dataset (arg->vector value-col)))
-           table (zipmap keys val)]
-
-       (fn [key-cells]
-         (let [lookup (zipmap (arg->vector key-cols) (arg->vector key-cells))
-               value-from-row ((table lookup) value-col)
-               ]
-           value-from-row)
-         ))))
+   (let [arg->vector (fn [x] (if (sequential? x) x [x]))
+         keys (:rows (all-columns dataset (arg->vector key-cols)))
+         val (:rows (all-columns dataset (arg->vector value-col)))
+         table (zipmap keys val)]
+
+     (fn [key-cells]
+       (let [lookup (zipmap (arg->vector key-cols) (arg->vector key-cells))
+             value-from-row (if (nil? (table lookup))
+                              nil
+                              ((table lookup) value-col))]
+         value-from-row)))))

 (comment


Refactor CSV export

Refactor CSV export

--- src/buildviz/handler.clj
+++ src/buildviz/handler.clj
@@ -86,13 +86,13 @@
         buildSummary (zipmap jobNames buildSummaries)]
     (if (= (:mime accept) :json)
       {:body buildSummary}
-      (csv/export-table ["job" "averageRuntime" "totalCount" "failedCount" "flakyCount"]
-                        (map (fn [[job-name job]] [job-name
-                                                   (:averageRuntime job)
-                                                   (:totalCount job)
-                                                   (:failedCount job)
-                                                   (:flakyCount job)])
-                             buildSummary)))))
+      {:body (csv/export-table ["job" "averageRuntime" "totalCount" "failedCount" "flakyCount"]
+                               (map (fn [[job-name job]] [job-name
+                                                          (:averageRuntime job)
+                                                          (:totalCount job)
+                                                          (:failedCount job)
+                                                          (:flakyCount job)])
+                                    buildSummary))})))

 ;; fail phases

@@ -101,19 +101,17 @@
             (map #(assoc % :job job) (vals builds)))
           @builds))

-(defn- comma-separated-fail-phase [{start :start end :end culprits :culprits}]
-  (join [(csv/export [(csv/format-timestamp start)
-                      (csv/format-timestamp end)
-                      (join "|" culprits)])
-         "\n"]))
-
 (defn- get-fail-phases [accept]
   (let [annotated-builds-in-order (sort-by :end (all-builds-in-order))
         fail-phases (pipelineinfo/pipeline-fail-phases annotated-builds-in-order)]
     (if (= (:mime accept) :json)
       {:body fail-phases}
-      (join (cons "start,end,culprits\n"
-                  (map comma-separated-fail-phase fail-phases))))))
+      {:body (csv/export-table ["start" "end" "culprits"]
+                               (map (fn [{start :start end :end culprits :culprits}]
+                                      [(csv/format-timestamp start)
+                                       (csv/format-timestamp end)
+                                       (join "|" culprits)])
+                                    fail-phases))})))

 ;; failures

@@ -142,15 +140,14 @@
 (defn- serialize-nested-testsuites [testsuite-id]
   (join ": " testsuite-id))

-(defn- comma-separated-test-runtimes [job]
+(defn- flat-test-runtimes [job]
   (->> (testsuites/average-testsuite-runtime-as-list (test-runs job))
        (map (fn [{testsuite :testsuite classname :classname name :name average-runtime :averageRuntime}]
-              (join [(csv/export [average-runtime
-                                  job
-                                  (serialize-nested-testsuites testsuite)
-                                  classname
-                                  name])
-                     "\n"])))))
+              [average-runtime
+               job
+               (serialize-nested-testsuites testsuite)
+               classname
+               name]))))

 (defn- has-testsuites? [job]
   (some? (@test-results job)))
@@ -159,8 +156,9 @@
   (let [job-names (filter has-testsuites? (keys @builds))]
     (if (= (:mime accept) :json)
       {:body (zipmap job-names (map testsuites-for job-names))}
-      {:body (join (cons "averageRuntime,job,testsuite,classname,name\n"
-                         (mapcat comma-separated-test-runtimes job-names)))})))
+      {:body (csv/export-table ["averageRuntime" "job" "testsuite" "classname" "name"]
+                               (mapcat flat-test-runtimes
+                                       job-names))})))

 ;; app


resolving remaining conflict

resolving remaining conflict

--- src/io/aviso/rook.clj
+++ src/io/aviso/rook.clj
@@ -238,12 +238,12 @@
          handler' (namespace-middleware handler namespace-name)]
      (compojure/context path [] handler'))))

-  ([namespace]
-   (namespace-middleware rook-handler namespace))
-  ([path namespace & handlers]
+  ([namespace-name]
+   (namespace-middleware rook-handler namespace-name))
+  ([path namespace-name & handlers]
    (let [handler (if (empty? handlers)
                    rook-handler
                    (apply compojure/routes (concat handlers [rook-handler])))
-         handler' (namespace-middleware handler namespace)]
+         handler' (namespace-middleware handler namespace-name)]
      (compojure/context path [] handler'))))


don't need to end bake with nil now since eval-in will return the result string if it is unreadable

--- src/cake/tasks/swank.clj
+++ src/cake/tasks/swank.clj
@@ -5,25 +5,25 @@

 (def current-port (atom nil))

-(defn serve-swank [socket]
+(defn- serve-swank
+  "Run swank connection thread in the project classloader."
+  [socket]
   (bake (:require swank.swank swank.core.server)
         [socket socket]
         (let [socket-serve     (ns-resolve 'swank.core.server 'socket-serve)
               connection-serve (ns-resolve 'swank.swank 'connection-serve)
               opts {:encoding (or (System/getProperty "swank.encoding") "iso-latin-1-unix")}]
           (spit "/tmp/swank" (prn-str socket socket-serve connection-serve))
-          (socket-serve connection-serve socket opts))
-        nil))
+          (socket-serve connection-serve socket opts))))

-(defn wrap-swank-context! []
-  ;; wrap all swank threads in a with-context binding
+(defn- wrap-swank-context!
+  "Wrap all swank threads in a with-context binding." []
   (bake (:use [swank.util.concurrent.thread :only [start-thread]]
               [bake.core :only [with-context current-context]]) []
         (alter-var-root
          #'start-thread
          (fn [start-thread]
-           (fn [f] (start-thread #(with-context (current-context) (f))))))
-        nil))
+           (fn [f] (start-thread #(with-context (current-context) (f))))))))

 (if-ns (:use [swank.core.server :only [start-swank-socket-server!]]
              [swank.util.net.sockets :only [make-server-socket]])


klay: use clj->js where appropriate

klay: use clj->js where appropriate

--- src/cfg/layout/klay.cljs
+++ src/cfg/layout/klay.cljs
@@ -7,11 +7,12 @@

 (defn make
   []
-  #js{"id" "root"
-      "properties" #js{"direction" "DOWN"
-                       "spacing" 40}
-      "children" #js[]
-      "edges" #js[]})
+  (clj->js {"id" "root"
+            "properties" {"direction" "DOWN"
+                          "spacing" 10
+                          "edgeSpacingFactor" 1}
+            "children" []
+            "edges" []}))

 (defn- cfg-bb->klay
@@ -94,7 +95,7 @@
 (defn layout
   [g s e]
   (let [layout-fn (aget klay "layout")]
-    (layout-fn #js{"graph" g
-                   "options" #js{}
-                   "success" s
-                   "error" e})))
+    (layout-fn (clj->js {"graph" g
+                         "options" {}
+                         "success" s
+                         "error" e}))))