Notify when SDK-path is not configured (was broken in preview5)

--- src/leiningen/droid/utils.clj
+++ src/leiningen/droid/utils.clj
@@ -8,6 +8,25 @@

 ;; #### Convenient functions to run SDK binaries

+(defmacro ensure-paths
+  "Checks if the given directories or files exist. Aborts Leiningen
+  execution in case either of them doesn't or the value equals nil.
+
+  We assume paths to be strings or lists/vectors. The latter case is
+  used exclusively for Windows batch-files which are represented like
+  `cmd.exe /C batch-file`, so we test third element of the list for
+  the existence."
+  [& paths]
+  `(do
+     ~@(for [p paths]
+         `(cond (nil? ~p)
+                (abort "The value of" (str '~p) "is nil. Abort execution.")
+
+                (or
+                 (and (sequential? ~p) (not (.exists (file (nth ~p 2)))))
+                 (and (string? ~p) (not (.exists (file ~p)))))
+                (abort "The path" ~p "doesn't exist. Abort execution.")))))
+
 (defn windows?
   "Returns true if we are running on Microsoft Windows"
   []
@@ -17,6 +36,7 @@
   "Returns a map of relative paths to different SDK binaries for both
   Unix and Windows platforms."
   [sdk-path]
+  (ensure-paths sdk-path)
   (let [bt-dir (first (.list (file sdk-path "build-tools")))]
    {:dx {:unix ["build-tools" bt-dir "dx"]
          :win ["build-tools" bt-dir "dx.bat"]}
@@ -204,25 +224,6 @@
   [project]
   (not (contains? (-> project meta :included-profiles set) :release)))

-(defmacro ensure-paths
-  "Checks if the given directories or files exist. Aborts Leiningen
-  execution in case either of them doesn't or the value equals nil.
-
-  We assume paths to be strings or lists/vectors. The latter case is
-  used exclusively for Windows batch-files which are represented like
-  `cmd.exe /C batch-file`, so we test third element of the list for
-  the existence."
-  [& paths]
-  `(do
-     ~@(for [p paths]
-         `(cond (nil? ~p)
-                (abort "The value of" (str '~p) "is nil. Abort execution.")
-
-                (or
-                 (and (sequential? ~p) (not (.exists (file (nth ~p 2)))))
-                 (and (string? ~p) (not (.exists (file ~p)))))
-                (abort "The path" ~p "doesn't exist. Abort execution.")))))
-
 (defn wrong-usage
   "Returns a string with the information about the proper function usage."
   ([task-name function-var]


Refactor date formatting in observation queries

--- src/env_logger/db.clj
+++ src/env_logger/db.clj
@@ -127,33 +127,33 @@
 (defn get-all-obs
   "Fetches all observations from the database"
   [db-con]
-  (for [row (j/query db-con
-                     (sql/format (sql/build :select [:brightness
-                                                     :temperature
-                                                     :recorded]
-                                            :from :observations
-                                            :order-by [[:id :asc]])))]
-    ;; Reformat date
-    (merge row
-           {:recorded (format-datetime (:recorded row)
-                                       :date-hour-minute-second)})))
+  (j/query db-con
+           (sql/format (sql/build :select [:brightness
+                                           :temperature
+                                           :recorded]
+                                  :from :observations
+                                  :order-by [[:id :asc]]))
+           {:row-fn #(merge %
+                            {:recorded (format-datetime
+                                        (:recorded %)
+                                        :date-hour-minute-second)})}))

 (defn get-last-n-days-obs
   "Fetches the observations from the last N days"
   [db-con n]
-  (for [row (j/query db-con
-                     (sql/format (sql/build :select [:brightness
-                                                     :temperature
-                                                     :recorded]
-                                            :from :observations
-                                            :where [:>= :recorded
-                                                    (t/minus (t/now)
-                                                             (t/days n))]
-                                            :order-by [[:id :asc]])))]
-    ;; Reformat date
-    (merge row
-           {:recorded (format-datetime (:recorded row)
-                                       :date-hour-minute-second)})))
+  (j/query db-con
+           (sql/format (sql/build :select [:brightness
+                                           :temperature
+                                           :recorded]
+                                  :from :observations
+                                  :where [:>= :recorded
+                                          (t/minus (t/now)
+                                                   (t/days n))]
+                                  :order-by [[:id :asc]]))
+           {:row-fn #(merge %
+                            {:recorded (format-datetime
+                                        (:recorded %)
+                                        :date-hour-minute-second)})}))

 (defn get-obs-within-interval
   "Fetches observations in an interval between either one or two dates"
@@ -173,23 +173,23 @@
                    (f/parse formatter (format "%s 23:59:59" end-date))
                    ;; Hack to avoid SQL WHERE hacks
                    (t/now))]
-      (for [row (j/query db-con
-                         (sql/format (sql/build :select [:brightness
-                                                         :temperature
-                                                         :recorded]
-                                                :from :observations
-                                                :where [:and
-                                                        [:>= :recorded
-                                                         (l/to-local-date-time
-                                                          start-dt)]
-                                                        [:<= :recorded
-                                                         (l/to-local-date-time
-                                                          end-dt)]]
-                                                :order-by [[:id :asc]])))]
-        ;; Reformat date
-        (merge row
-               {:recorded (format-datetime (:recorded row)
-                                           :date-hour-minute-second)})))))
+      (j/query db-con
+               (sql/format (sql/build :select [:brightness
+                                               :temperature
+                                               :recorded]
+                                      :from :observations
+                                      :where [:and
+                                              [:>= :recorded
+                                               (l/to-local-date-time
+                                                start-dt)]
+                                              [:<= :recorded
+                                               (l/to-local-date-time
+                                                end-dt)]]
+                                      :order-by [[:id :asc]]))
+               {:row-fn #(merge %
+                                {:recorded (format-datetime
+                                            (:recorded %)
+                                            :date-hour-minute-second)})}))))

 (defn get-obs-start-and-end
   "Fetches the start (first) and end (last) dates of all observations"


Refer to query results instead of dashcard db instance

--- src/metabase/pulse/render.clj
+++ src/metabase/pulse/render.clj
@@ -390,11 +390,11 @@
     (cond
       (or (= aggregation :rows)
           (contains? #{:pin_map :state :country} (:display card))) nil
-      (or (zero? (-> card :rows count))
+      (or (zero? (-> data :rows count))
           (= [[nil]]
-             (-> card :rows))
+             (-> data :rows))
           (and (= [[0]]
-                  (-> card :rows))
+                  (-> data :rows))
                (= ["count"] aggregation)))                         :empty
       (and (= col-count 1)
            (= row-count 1))                                        :scalar


Emacs broke my regexes

Emacs broke my regexes

--- src/nine90_extractor/core.clj
+++ src/nine90_extractor/core.clj
@@ -53,7 +53,7 @@
   (Rectangle. 2200 y-off 300 row-height))

 (defn parse-name-and-title [name-str]
-  (when-let [[_ _ name title] (re-matches #"\s*(\(\d+\))?s*(.*)s*(.*)s*" name-str)]
+  (when-let [[_ _ name title] (re-matches #"\s*(\(\d+\))?\s*(.*)\s*(.*)\s*" name-str)]
     {:name name :title title}))

 (defn parse-hours [hours-str]


stem-bearing is added to dependencies.

stem-bearing is added to dependencies.

--- src/sweet_crossplane/core.clj
+++ src/sweet_crossplane/core.clj
@@ -17,6 +17,7 @@
                                 [page          :refer :all]
                                 [util          :refer :all])
             (radial-mount       [core          :as    radial-mount])
+            (stem-bearing       [core          :refer :all])
             (twin-spar          [core          :refer :all]))
   (:import  (java.net           URLEncoder)
             (java.sql           SQLException)


BREAKING: Rename `carmine.ring/set-conn` -> `carmine.ring/reset-conn`

--- src/taoensso/carmine/ring.clj
+++ src/taoensso/carmine/ring.clj
@@ -10,7 +10,7 @@
 (defmacro wc [& body] `(carmine/with-conn @~'pool-atom @~'spec-atom ~@body))

 (defprotocol ICarmineSessionStore
-  (set-conn [this pool spec]))
+  (reset-conn [this pool spec]))

 (defrecord CarmineSessionStore [pool-atom spec-atom prefix expiration]
   session-store/SessionStore
@@ -24,7 +24,7 @@
       key))

   ICarmineSessionStore
-  (set-conn [_ pool spec]
+  (reset-conn [_ pool spec]
     (reset! pool-atom pool)
     (reset! spec-atom spec)))


Don't check for flashes if no in-mults

Don't check for flashes if no in-mults

--- src/ligbugs/core.cljs
+++ src/ligbugs/core.cljs
@@ -28,9 +28,10 @@
                              (a/tap m c)
                              c))
                     in-mults)]
-    (go (while @alive
-          (a/alts! in-chs)
-          (swap! energy observed-flash)))
+    (if-not (empty? in-mults)
+      (go (while @alive
+            (a/alts! in-chs)
+            (swap! energy observed-flash))))
     (go (while @alive
           (swap! energy inc)
           (when (>= @energy peak-energy)


Prefix hex colours w #

Prefix hex colours w #

--- src/musicbox/one.cljs
+++ src/musicbox/one.cljs
@@ -8,13 +8,13 @@

 (def timbre js/T)

-(def colors [{:light "6DA0CB" :dark "314B61"}
-             {:light "A76AB9" :dark "4F2F59"}
-             {:light "BB67A2" :dark "5E3152"}
-             {:light "C55D83" :dark "692F44"}
-             {:light "D35E4C" :dark "692B22"}
-             {:light "E18C43" :dark "6B401C"}
-             {:light "E1B040" :dark "69511A"}])
+(def colors [{:light "#6DA0CB" :dark "#314B61"}
+             {:light "#A76AB9" :dark "#4F2F59"}
+             {:light "#BB67A2" :dark "#5E3152"}
+             {:light "#C55D83" :dark "#692F44"}
+             {:light "#D35E4C" :dark "#692B22"}
+             {:light "#E18C43" :dark "#6B401C"}
+             {:light "#E1B040" :dark "#69511A"}])

 ;; later: use pagehide to cancel in-progress presses when leaving tab


pull choose-color into its own fn

pull choose-color into its own fn

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -147,19 +147,21 @@
     ;;"#bdc3c7"
     })

+(defn choose-color [subs client-id requested-color]
+  (let [available-colors (or (seq (apply disj colors (map :color (vals subs))))
+                             (seq colors))]
+    (or (get-in subs [client-id :color])
+        (when (not= -1 (.indexOf available-colors requested-color))
+          requested-color)
+        (rand-nth available-colors))))
+
 (defn subscribe-to-doc [document-id uuid cust-name & {:keys [requested-color]}]
   (swap! document-subs update-in [document-id]
          (fn [subs]
-           (let [available-colors (or (seq (apply disj colors (map :color (vals subs))))
-                                      (seq colors))
-                 color (or (get-in subs [uuid :color])
-                           (when (not= -1 (.indexOf available-colors requested-color))
-                             requested-color)
-                           (rand-nth available-colors))]
-             (-> subs
-                 (assoc-in [uuid :color] color)
-                 (assoc-in [uuid :cust-name] cust-name)
-                 (assoc-in [uuid :show-mouse?] true))))))
+           (-> subs
+             (assoc-in [uuid :color] (choose-color subs uuid requested-color))
+             (assoc-in [uuid :cust-name] cust-name)
+             (assoc-in [uuid :show-mouse?] true)))))

 ;; TODO: subscribe should be the only function you need when you get to a doc, then it should send
 ;;       all of the data asynchronously


Make sure a new InputMultiplexer is made when set-screen! is called

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -97,7 +97,6 @@
   [{:keys [on-create] :or {on-create dummy}}]
   (proxy [Game] []
     (create []
-      (input! :setInputProcessor (InputMultiplexer.))
       (on-create this))))

 (defmacro defgame
@@ -107,6 +106,7 @@
 (defn set-screen!
   [^Game game & screens]
   (let [add-inputs! (fn []
+                      (input! :setInputProcessor (InputMultiplexer.))
                       (doseq [screen screens]
                         (add-input! (:input screen))
                         (add-input! (:gesture screen))))


fix(mesh): fix #59 MeshFace IVertexAccess impl

--- src/thi/ng/geom/meshface.cljc
+++ src/thi/ng/geom/meshface.cljc
@@ -12,9 +12,8 @@
          :cljs [^:mutable _hash])]

   g/IVertexAccess
-  (vertices
-    ([_] vertices)
-    ([_ _] vertices))
+  (vertices [_] vertices)
+  (vertices [_ _] vertices)

   g/IAttributeAccess
   (attribs [_ _] nil)


Work towards displaying block face highlight, part 2

--- src/try_lwjgl/model/block.clj
+++ src/try_lwjgl/model/block.clj
@@ -1,12 +1,13 @@
 (ns try-lwjgl.model.block
-  (:import [org.lwjgl.opengl GL11])
+  (:import [org.lwjgl.opengl GL11]
+           [com.bulletphysics.dynamics DiscreteDynamicsWorld DynamicsWorld RigidBody RigidBodyConstructionInfo])
   (:require [try-lwjgl.display.util :as util]
             [try-lwjgl.shader :as shader]
             [try-lwjgl.physics :as physics]
             [try-lwjgl.math :as math]
             [try-lwjgl.model.wood-block :as wood-block]))

-(defn create [world position]
+(defn create [^DiscreteDynamicsWorld world position]
   (let [width 1
         phys (physics/build-box width position)
         specs {:width width
@@ -25,51 +26,6 @@

 (defn position [block]
   (physics/get-position (:phys block)))
-
-(defn graph-position [block]
-  (let [pos (position block)
-        [x y z] pos
-        width (:width block)
-        offset (/ width 2.0)]
-    [(- x offset) (- y offset) (- z offset)]))
-
-(defn draw-face
-  ([block face]
-     (draw-face (graph-position block) nil nil))
-
-  ([graph-pos translate rotations]
-     (let [[x y z] graph-pos]
-       (shader/with-program
-         (util/with-pushed-matrix
-           (GL11/glTranslatef 0 0 0)
-           (GL11/glTranslatef x y z)
-
-           ;; White
-           (GL11/glColor3f 0.8 0.8 0.8)
-           (util/do-shape GL11/GL_LINES
-                          (GL11/glVertex3f 0 0 0)
-                          (GL11/glVertex3f 1 0 0)
-
-                          (GL11/glVertex3f 1 0 0)
-                          (GL11/glVertex3f 1 1 0)
-
-                          (GL11/glVertex3f 1 1 0)
-                          (GL11/glVertex3f 0 1 0)
-
-                          (GL11/glVertex3f 0 1 0)
-                          (GL11/glVertex3f 0 0 0)))))))
-
-(defn draw [block]
-  (let [graph-pos (graph-position block)
-        [x y z] graph-pos]
-    (util/with-pushed-matrix
-      (GL11/glTranslatef x y z)
-      (wood-block/draw))
-    (draw-face block [[0 0 0] [1 1 0]])))
-
-(defn draw-many [blocks]
-  (doseq [block blocks]
-    (draw block)))

 (defn face-intersect [face pointer]
   ;; intersects in 2D (facing z)
@@ -85,7 +41,6 @@
   ;; intersects in 2D (facing y)
   )

-;;(face-intersect [[0 0 0] [1 1 0]] [[0.5 0.5 0.5] [0.5 0.5 -0.5]])
 (defn slope [line]
   (let [[p1 p2] line
         [p1x p1y] p1
@@ -105,6 +60,9 @@
   (let [[slope1 off1] (slope-offset seg1)
         [slope2 off2] (slope-offset seg2)]
     (cond
+     (and (not slope1) (not slope2))
+     nil
+
      (and slope1 slope2)
      (let [x (/ (- off2 off1) (- slope1 slope2))
            y (+ (* x slope1) off1)]
@@ -123,13 +81,8 @@
      :else
      nil)))

-;;(line-intersect [[1.5 0.5] [1.5 -0.5]] [[0 0] [1 0]])
-;; [1.5 0.0]
-
 (defn rect-contains-point? [rect point]
-  (let [min (fn [a b] (Math/min a b))
-        max (fn [a b] (Math/max a b))
-        [a1 a2] rect
+  (let [[a1 a2] rect
         [a1x a1y] a1
         [a2x a2y] a2
         [px py] point]
@@ -148,14 +101,9 @@
    :else
    nil))

-;;(constrain-intersect [0.5 0 0] [[0.5 0.5] [0.5 -0.5]] [[0 0] [1 0]])
-
 (defn line-segment-intersect [seg1 seg2]
   (let [intersect (line-intersect seg1 seg2)]
     (constrain-intersect intersect seg1 seg2)))
-
-;(line-intersect [[0.5 0.5] [0.5 -0.5]] [[0 0] [1 0]])
-;;(line-segment-intersect [[0.5 0.5] [0.5 -0.5]] [[0 0] [1 0]])

 (defn arm-face-intersect [arm face]
   ;; facing down, towards y-axis
@@ -180,25 +128,107 @@
          i-xy
          [(i-xz 0) (i-xy 1) (i-xz 1)])))

-;; (let [arm  [[0.5 0.5 0.5] [0.5 0.5 -0.5]]
-;;       face [[0 0 0] [1 1 0]]]
-;;   (arm-face-intersect arm face))
-
-(defn faces [pos]
+(let [arm [[0.5 0.5 0.5] [0.5 0.5 -0.5]]
+      face [[0.0 0.0 0.0] [1.0 1.0 0.0]]]
+  (arm-face-intersect arm face))
+
+(defn faces [pos half-width]
   "Location of faces for a given block"
-  (let [[x y z] pos]
-      [
-       [[x y z] [(+ x 1) (+ y 1) z]]
-       [[x y z] [(+ x 1) y (+ z 1)]]
-       [[x y z] [x (+ y 1) (+ z 1)]]
-
-       [[x y (+ z 1)] [(+ x 1) (+ y 1) (+ z 1)]]
-       [[x (+ y 1) z] [(+ x 1) (+ y 1) (+ z 1)]]
-       [[(+ x 1) y z] [(+ x 1) (+ y 1) (+ z 1)]]]))
-
-(defn closest-intersecting-face [phys-pos p1 p2]
-  (let [pos (math/add phys-pos [-0.5 -0.5 -0.5])]
-    (faces pos)))
-
-;;(closest-intersecting-face [0.5 0.5 0.5] [0.5 0.5 1.5] [0.5 0.5 0.5])
-
+  (let [[x y z] pos
+        hw half-width]
+      [;; back -z
+       [[(- x hw) (- y hw) (- z hw)] [(+ x hw) (+ y hw) (- z hw)]]
+       ;; bottom
+       [[(- x hw) (- y hw) (- z hw)] [(+ x hw) (- y hw) (+ z hw)]]
+       ;; side -x
+       [[(- x hw) (- y hw) (- z hw)] [(- x hw) (+ y hw) (+ z hw)]]
+
+       ;; front +z
+       [[(- x hw) (- y hw) (+ z hw)] [(+ x hw) (+ y hw) (+ z hw)]]
+       ;; top
+       [[(- x hw) (+ y hw) (- z hw)] [(+ x hw) (+ y hw) (+ z hw)]]
+       ;; side +x
+       [[(+ x hw) (- y hw) (- z hw)] [(+ x hw) (+ y hw) (+ z hw)]]]))
+
+(defn pythagorean-dist [a b]
+  (Math/sqrt (+ a b)))
+
+(defn distance-2d [p1 p2]
+  (let [[p1x p1y] p1
+        [p2x p2y] p2]
+    (pythagorean-dist (Math/abs (float (- p2x p1x)))
+                      (Math/abs (float (- p2y p1y))))))
+
+(defn distance-3d [p1 p2]
+  (let [[p1x p1y p1z] p1
+        [p2x p2y p2z] p2
+        xy-dist (distance-2d [p1x p1y] [p2x p2y])
+        xz-dist (distance-2d [p1x p1z] [p2x p2z])]
+    (pythagorean-dist xy-dist xz-dist)))
+
+(defn closer-point-3d [point a b]
+  (let [dist-a (distance-3d point a)
+        dist-b (distance-3d point b)
+        min-dist (min dist-a dist-b)]
+    (if (= min-dist dist-a) a b)))
+
+(defn closest-intersecting-face [pos half-width arm]
+  (let [[p1 p2] arm
+        faces-intersects (map (fn [face] {:face face
+                                         :intersect (arm-face-intersect [p1 p2] face)})
+                              (faces pos half-width))
+        matching-faces-intersects (filter :intersect faces-intersects)
+        closer (fn [fia fib] (let [a (:intersect fia)
+                                  b (:intersect fib)
+                                  cp (closer-point-3d p1 a b)]
+                              (if (= cp a) fia fib)))
+        closest-fi (reduce closer matching-faces-intersects)]
+    (:face closest-fi)))
+
+;; (closest-intersecting-face [0.5 0.5 0.5]
+;;                            0.5
+;;                            [[0.5 0.5 1.5] [0.5 0.5 -0.5]])
+
+(defn graph-position [block]
+  (let [pos (position block)
+        [x y z] pos
+        width (:width block)
+        offset (/ width 2.0)]
+    [(- x offset) (- y offset) (- z offset)]))
+
+(defn draw-face
+  ([block face] (draw-face (graph-position block) nil nil))
+  ([graph-pos translate rotations]
+     (let [[x y z] graph-pos]
+       (shader/with-program
+         (util/with-pushed-matrix
+           (GL11/glTranslatef 0 0 0)
+           (GL11/glTranslatef x y z)
+
+           ;; White
+           (GL11/glColor3f 0.8 0.8 0.8)
+           (util/do-shape GL11/GL_LINES
+                          ;; bottom +x
+                          (GL11/glVertex3f 0 0 0)
+                          (GL11/glVertex3f 1 0 0)
+                          ;; up +y
+                          (GL11/glVertex3f 1 0 0)
+                          (GL11/glVertex3f 1 1 0)
+                          ;; top -x
+                          (GL11/glVertex3f 1 1 0)
+                          (GL11/glVertex3f 0 1 0)
+                          ;; down -y
+                          (GL11/glVertex3f 0 1 0)
+                          (GL11/glVertex3f 0 0 0)))))))
+
+(defn draw [block]
+  (let [graph-pos (graph-position block)
+        [x y z] graph-pos]
+    (util/with-pushed-matrix
+      (GL11/glTranslatef x y z)
+      (wood-block/draw))
+    (draw-face block [[0 0 0] [1 1 0]])))
+
+(defn draw-many [blocks]
+  (doseq [block blocks]
+    (draw block)))


Added paginator on url list, shortening the label only if it's a URL

https://app.asana.com/0/50978096561390/67046669038419

--- src/ui/relevance/display.cljs
+++ src/ui/relevance/display.cljs
@@ -58,7 +58,9 @@
 (register-handler
   :app-state-item
   (fn [app-state [_ path item]]
-    (js/ga "send" "screenview" #js {:screenName (name item)})
+    (when (= [:ui-state :section] path)
+      (js/ga "send" "screenview" #js {:screenName (name item)})
+      )
     (assoc-in app-state path item)))

@@ -84,7 +86,9 @@
       (dispatch [::storage-changed {:changes {:data {:newValue (:data (<! (storage/get)))}}}]))
     {:app-state {}
      :settings  default-settings
-     :ui-state  {:section :intro}}))
+     :ui-state  {:section   :intro
+                 :url-page  0
+                 :site-page 0}}))

 (register-handler
@@ -132,7 +136,7 @@
 (def ModalBody (reagent/adapt-react-class js/ReactBootstrap.ModalBody))
 (def ModalFooter (reagent/adapt-react-class js/ReactBootstrap.ModalFooter))
 (def ModalHeader (reagent/adapt-react-class js/ReactBootstrap.ModalHeader))
-
+(def Pagination (reagent/adapt-react-class js/ReactBootstrap.Pagination))

 ;;;;----------------------------
 ;;;; Components
@@ -208,8 +212,9 @@
                 label   (if (empty? title)
                           url
                           title)
-                display (if (< 100 (count label))
-                          (apply str (concat (take 100 label) "..."))
+                display (if (and (empty? title)
+                                 (< 80 (count label)))
+                          (apply str (concat (take 80 label) "..."))
                           label)
                 age-ms  (- now (:ts tab))
                 ;; Colors picked at http://www.w3schools.com/tags/ref_colorpicker.asp
@@ -224,9 +229,9 @@
                 ]
             ^{:key i}
             [:tr
-             [:td {:class "col-sm-2"}
+             [:td {:class "col-sm-1"}
               (time-display (:time tab))]
-             [:td {:class "col-sm-7"}
+             [:td {:class "col-sm-9"}
               [:a
                {:href url :target "_blank"}
                (if favicon
@@ -234,21 +239,39 @@
                         :width  16
                         :height 16}])
                display]]
-             [:td {:class "col-sm-3"}
+             [:td {:class "col-sm-2"}
               [:i (merge {:class "fa fa-circle" :style {:color color}})]
               (time-display (quot age-ms 1000))]
              ]))))))

 (defn div-urltimes []
-  (let [url-times  (subscribe [:data :url-times])
-        site-times (subscribe [:data :site-times])
-        url-values (reaction (filter-tabs (vals @url-times)))
-        to-list    (reaction (sort-by #(* -1 (:time %)) @url-values))
-        total      (reaction (count @to-list))]
+  (let [url-times   (subscribe [:data :url-times])
+        site-times  (subscribe [:data :site-times])
+        url-values  (reaction (filter-tabs (vals @url-times)))
+        to-list     (reaction (sort-by #(* -1 (:time %)) @url-values))
+        total       (reaction (count @to-list))
+        per-page    200
+        chosen-page (subscribe [:ui-state :url-page])
+        num-pages   (reaction (.ceil js/Math (/ @total per-page)))
+        current     (reaction (.min js/Math (.max js/Math @chosen-page 0) @num-pages))
+        list-shown  (reaction (->> @to-list
+                                   (drop (* @current per-page))
+                                   (take per-page)))]
     (fn []
       [:div {:class "row"}
        [:p "Total: " @total " URLs."]
+       (when (< per-page @total)
+         [Pagination
+          {:bsSize     "medium"
+           :items      @num-pages
+           :activePage (inc @current)
+           :first      true
+           :last       true
+           :ellipsis   true
+           :maxButtons 20
+           :onSelect   #(dispatch [:app-state-item [:ui-state :url-page] (dec (aget %2 "eventKey"))])}
+          ])
        [:div {:class "card"}
         [:div {:class "content table-responsive table-full-width"}
          [:table {:class "table table-striped table-hover"}
@@ -258,7 +281,7 @@
             [:th "Title"]
             [:th "Last visit"]]]
           [:tbody
-           (list-urls @to-list @site-times)
+           (list-urls @list-shown @site-times)
            ]]]]
        ])
     ))


CMR-2480: Changed migration to lower-case derived tag keys

--- metadata-db-app/src/migrations/033_replace_tags_namespace_and_value_with_tag_key.clj
+++ metadata-db-app/src/migrations/033_replace_tags_namespace_and_value_with_tag_key.clj
@@ -17,7 +17,7 @@
           ;; Some rows may already have a tag-key instead of namespace and value.
           {:keys [namespace value tag-key]} metadata
           tag-key (or tag-key
-                      (str namespace "." value))
+                      (lower-case (str namespace "." value)))
           metadata (-> metadata
                        (assoc :tag-key tag-key)
                        (dissoc :namespace :value :category)


Changes 'dropped item from tx-report-mult' log to INFO (#1401)

--- scheduler/src/cook/datomic.clj
+++ scheduler/src/cook/datomic.clj
@@ -66,7 +66,7 @@
                                ;; The value for :default is eagerly evaluated, unlike for other clauses
                                :default :dropped
                                :priority true)
-                         :dropped (log/error "dropped item from tx-report-mult--maybe there's a slow consumer?")
+                         :dropped (log/info "dropped item from tx-report-mult--maybe there's a slow consumer?")
                          nil))
                      (catch InterruptedException _ nil)))
                  (catch Exception e


bump drunkard's max to 2000 because we have the perf for it now and it looks cool

--- src/voke/world/visualize.cljs
+++ src/voke/world/visualize.cljs
@@ -118,7 +118,7 @@
    (when (= @selected-tab :drunkard)
      [:div.drunkard-specific
       [:p (str "Dig until there are " @num-empty-cells " empty cells in the grid")]
-      [slider num-empty-cells 0 1000 10]])
+      [slider num-empty-cells 0 2000 10]])

    (when (= @selected-tab :automata)
      [:div.cellular-specific


Remove useless print impl for rstore basic events.

--- src/uxbox/rstore.cljs
+++ src/uxbox/rstore.cljs
@@ -66,23 +66,13 @@
   (reify
     UpdateEvent
     (-apply-update [_ state]
-      (f state))
-
-    IPrintWithWriter
-    (-pr-writer [mv writer _]
-      (-write writer "#<event:rstore/swap-state>"))))
+      (f state))))

 (defn reset-state
   "A event that resets the internal state with
   the provided value."
   [state]
   (reify
-    IPrintWithWriter
-    (-pr-writer [_ writer x]
-      (-write writer "#<event:rstore/reset-state ")
-      (-pr-writer state writer x)
-      (-write writer ">"))
-
     UpdateEvent
     (-apply-update [_ _]
       state)))


Refactored

Refactored

--- src/rpi_challenger/routes.clj
+++ src/rpi_challenger/routes.clj
@@ -27,7 +27,7 @@
   (cond
     (= question "ping") "pong"
     (= question "Say hello to World") "Hello World"
-    :else (str "Don't understand " question)))
+    :else (str "Don't understand: " question)))

 (defroutes app-routes
   (GET "/" [] (using-template views/tournament-overview-page (core/get-participants)))
@@ -35,7 +35,7 @@
   (POST "/register" {params :params} (handle-register-form params))
   (GET "/poll" [] (str (core/poll-participants)))
   (GET "/calculate-score" [] (str (core/calculate-score)))
-  (POST "/hello-world" {body :body, :as request} (handle-hello-world (slurp body)))
+  (POST "/hello-world" {body :body} (handle-hello-world (slurp body)))
   (route/resources "/")
   (route/not-found "Page Not Found"))


find mouse position

find mouse position

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -820,3 +820,9 @@
             (every? #(< -1 % size) new-yx))
           (map #(vec (map + yx %))
                [[-1 0] [0 -1] [0 1] [1 0]])))
+
+(defn find-m [[line & _ :as board]]
+  (for [x (range (count line))
+        y (range (count board))
+       :when (= \M (get-in board [y x]))]
+    [x y]))


[#2309] Organising auth namespace.

[#2309] Organising auth namespace.

--- backend/src/akvo/lumen/auth.clj
+++ backend/src/akvo/lumen/auth.clj
@@ -13,24 +13,77 @@
   (:import com.nimbusds.jose.crypto.RSASSAVerifier
            java.text.ParseException))

-(declare tenant-admin?)
-
-(defn tenant-user?
-  [{:keys [tenant jwt-claims auth-roles] :as data} issuer]
-  (or (tenant-admin? data issuer)
-      (contains? auth-roles
-                 (format "akvo:lumen:%s" tenant))))
-
-(defn tenant-admin?
-  [{:keys [tenant jwt-claims auth-roles]} issuer]
-  (contains? auth-roles
-             (format "akvo:lumen:%s:admin" tenant)))
-
-(defn admin-path? [{:keys [path-info]}]
-  (string/starts-with? path-info "/api/admin/"))
-
-(defn api-path? [{:keys [path-info]}]
-  (string/starts-with? path-info "/api/"))
+
+(defn issuer-type [jwt-claims keycloak-public-client auth0-public-client]
+  (condp = (get jwt-claims "iss")
+    (:issuer keycloak-public-client) :keycloak
+    (:issuer auth0-public-client) :auth0
+    :other))
+
+(s/def ::keycloak-public-client ::keycloak/public-client)
+(s/def ::auth0-public-client ::auth0/public-client)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; JWT Authentication
+;;;
+
+(defn wrap-jwt-authentication
+  "Go get cert from Keycloak and feed it to wrap-jwt-claims. Keycloak url can
+  be configured via the KEYCLOAK_URL env var."
+  [keycloak-public-client auth0-public-client authorizer]
+  (let [keycloak-verifier (RSASSAVerifier. (:rsa-key keycloak-public-client))
+        auth0-verifier (RSASSAVerifier.  (:rsa-key auth0-public-client))]
+    (fn [handler]
+      (fn [{:keys [tenant] :as req}]
+        (if-let [token (jwt/jwt-token req)]
+          (try
+            (if-let [claims (or (jwt/verified-claims token keycloak-verifier
+                                                     (:issuer keycloak-public-client)
+                                                     {})
+                                (jwt/verified-claims token auth0-verifier
+                                                     (:issuer auth0-public-client)
+                                                     {}))]
+              (handler (assoc req
+                              :jwt-claims claims
+                              :auth-roles (if (= :keycloak
+                                                 (issuer-type claims
+                                                              keycloak-public-client
+                                                              auth0-public-client))
+                                            (keycloak/claimed-roles claims)
+                                            (set (map auth0/path->role
+                                                      (:path-groups (p/user authorizer
+                                                                            tenant
+                                                                            (get claims "email"))))))
+                              :jwt-token token))
+              (handler req))
+            (catch ParseException e
+              (handler req)))
+          (handler req))))))
+
+(defmethod ig/init-key :akvo.lumen.auth/wrap-jwt-authentication
+  [_ {:keys [keycloak-public-client auth0-public-client authorizer]}]
+  (wrap-jwt-authentication keycloak-public-client auth0-public-client authorizer))
+
+(defmethod ig/pre-init-spec :akvo.lumen.auth/wrap-jwt-authentication
+  [_]
+  (s/keys :req-un [::keycloak-public-client ::auth0-public-client ::p/authorizer]))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Authorization helpers
+;;;
+
+;; Currently Keycloak API authz is not available when authenticating with Auth0
+;; but only for users with app_metadata set to true in path -> lumen -> features
+;; -> apiAuthz and akvo.org email.
+(defn api-authz? [{:strs [email email_verified] :as jwt-claims}]
+  (let [flag-path ["https://akvo.org/app_metadata" "lumen" "features"
+                   "apiAuthz"]
+        flag (get-in jwt-claims flag-path)]
+    (and (and (some? flag) flag)
+         (and (some? email_verified) email_verified)
+         (and (some? email) (string/ends-with? email "@akvo.org")))))

 (defn- application-json-type
   "code taken from ring.middleware.json/wrap-json-response"
@@ -50,29 +103,27 @@
       (response/status 403)
       application-json-type))

-(def service-unavailable
-  (-> (response/response "Service Unavailable")
-      (response/status 503)
-      application-json-type))
-
-(def internal-server-error
-  (-> (response/response "Internal server errror")
-      (response/status 500)
-      application-json-type))
-
-(defn api-authz? [{:strs [email email_verified] :as jwt-claims}]
-  (let [flag-path ["https://akvo.org/app_metadata" "lumen" "features"
-                   "apiAuthz"]
-        flag (get-in jwt-claims flag-path)]
-    (and (and (some? flag) flag)
-         (and (some? email_verified) email_verified)
-         (and (some? email) (string/ends-with? email "@akvo.org")))))
-
-(defn issuer-type [jwt-claims keycloak-public-client auth0-public-client]
-  (condp = (get jwt-claims "iss")
-    (:issuer keycloak-public-client) :keycloak
-    (:issuer auth0-public-client) :auth0
-    :other))
+(defn admin-path? [{:keys [path-info]}]
+  (string/starts-with? path-info "/api/admin/"))
+
+(defn api-path? [{:keys [path-info]}]
+  (string/starts-with? path-info "/api/"))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; JWT Authorization
+;;;
+
+(defn tenant-admin?
+  [{:keys [tenant jwt-claims auth-roles]} issuer]
+  (contains? auth-roles
+             (format "akvo:lumen:%s:admin" tenant)))
+
+(defn tenant-user?
+  [{:keys [tenant jwt-claims auth-roles] :as data} issuer]
+  (or (tenant-admin? data issuer)
+      (contains? auth-roles
+                 (format "akvo:lumen:%s" tenant))))

 (defn wrap-jwt-authorization
   "Wrap authorization for the API via JWT claims as:
@@ -96,45 +147,18 @@
                                   not-authorized)
             :else not-authorized))))))

-(defn wrap-jwt-authentication
-  "Go get cert from Keycloak and feed it to wrap-jwt-claims. Keycloak url can
-  be configured via the KEYCLOAK_URL env var."
-  [keycloak-public-client auth0-public-client authorizer]
-  (let [keycloak-verifier (RSASSAVerifier. (:rsa-key keycloak-public-client))
-        auth0-verifier (RSASSAVerifier.  (:rsa-key auth0-public-client))]
-    (fn [handler]
-      (fn [{:keys [tenant] :as req}]
-        (if-let [token (jwt/jwt-token req)]
-          (try
-            (if-let [claims (or (jwt/verified-claims token keycloak-verifier (:issuer keycloak-public-client) {})
-                                (jwt/verified-claims token auth0-verifier (:issuer auth0-public-client) {}))]
-              (handler (assoc req
-                              :jwt-claims claims
-                              :auth-roles (if (= :keycloak (issuer-type claims keycloak-public-client auth0-public-client))
-                                            (keycloak/claimed-roles claims)
-                                            (set (map
-                                                  auth0/path->role
-                                                  (:path-groups (p/user authorizer tenant (get claims "email"))))))
-                              :jwt-token token))
-              (handler req))
-            (catch ParseException e
-              (handler req)))
-          (handler req))))))
-
-(defmethod ig/init-key :akvo.lumen.auth/wrap-jwt-authorization  [_ {:keys [keycloak-public-client auth0-public-client]}]
+(defmethod ig/pre-init-spec :akvo.lumen.auth/wrap-jwt-authorization
+  [_]
+  (s/keys :req-un [::keycloak-public-client ::auth0-public-client]))
+
+(defmethod ig/init-key :akvo.lumen.auth/wrap-jwt-authorization
+  [_ {:keys [keycloak-public-client auth0-public-client]}]
   (wrap-jwt-authorization keycloak-public-client auth0-public-client))

-(s/def ::keycloak-public-client ::keycloak/public-client)
-(s/def ::auth0-public-client ::auth0/public-client)
-
-(defmethod ig/pre-init-spec :akvo.lumen.auth/wrap-jwt-authorization [_]
-  (s/keys :req-un [::keycloak-public-client ::auth0-public-client]))
-
-(defmethod ig/init-key :akvo.lumen.auth/wrap-jwt-authentication  [_ {:keys [keycloak-public-client auth0-public-client authorizer]}]
-  (wrap-jwt-authentication keycloak-public-client auth0-public-client authorizer))
-
-(defmethod ig/pre-init-spec :akvo.lumen.auth/wrap-jwt-authentication [_]
-  (s/keys :req-un [::keycloak-public-client ::auth0-public-client ::p/authorizer]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; API Authorization
+;;;

 (defn api-tenant-admin?
   [tenant allowed-paths]
@@ -145,6 +169,16 @@
   (or
    (api-tenant-admin? tenant allowed-paths)
    (contains? allowed-paths tenant)))
+
+(def service-unavailable
+  (-> (response/response "Service Unavailable")
+      (response/status 503)
+      application-json-type))
+
+(def internal-server-error
+  (-> (response/response "Internal server errror")
+      (response/status 500)
+      application-json-type))

 (defmethod ig/init-key :akvo.lumen.auth/wrap-api-authorization
   [_ {:keys [authorizer]}]


Make start-instances more particular about input

--- backend/src/circle/backend/ec2.clj
+++ backend/src/circle/backend/ec2.clj
@@ -258,8 +258,7 @@
     :or {min-count 1
          max-count 1}
     :as args}]
-  (require-args ami availability-zone instance-type keypair-name)
-  (println "start-instances:" args)
+  (require-args ami availability-zone instance-type keypair-name security-groups)
   (with-ec2-client client
     (-> client
         (.runInstances (->


fix int-rotate-left tests, use bit-or to get signed 32bit int

--- test/cljs/cljs/core_test.cljs
+++ test/cljs/cljs/core_test.cljs
@@ -2217,11 +2217,11 @@
              (str 0 "a" true nil :key/word 'symb/ol false [1 2 3 4] 1234.5678 0x09)))

   ;; int-rotate-left
-  (assert (== (int-rotate-left 0x87654321 4) 0x76543218))
-  (assert (== (int-rotate-left 0x87654321 8) 0x65432187))
-  (assert (== (int-rotate-left 0x80000000 1) 0x1))
-  (assert (== (int-rotate-left 0x78123456 4) -2128394905))
-  (assert (== (int-rotate-left 0xffffffff 4) -1))
+  (assert (== (int-rotate-left (bit-or 0x87654321 0) 4) (bit-or 0x76543218 0)))
+  (assert (== (int-rotate-left (bit-or 0x87654321 0) 8) (bit-or 0x65432187 0)))
+  (assert (== (int-rotate-left (bit-or 0x80000000 0) 1) 0x1))
+  (assert (== (int-rotate-left (bit-or 0x78123456 0) 4) (bit-or 0x81234567 0)))
+  (assert (== (int-rotate-left (bit-or 0xffffffff 0) 4) (bit-or 0xffffffff 0)))

   ;; imul
   (assert (== (imul 3 3) 9))


Formatting.

Formatting.

--- clj_record/core.clj
+++ clj_record/core.clj
@@ -7,12 +7,6 @@

 (defn table-name [model-name]
   (pluralize (if (string? model-name) model-name (name model-name))))
-
-(defn get-record [model-name id]
-  (sql/with-connection db
-    (sql/with-query-results rows [(format "select * from %s where id = ?" (table-name model-name)) id]
-      (if (empty? rows) (throw (IllegalArgumentException. "Record does not exist")))
-      (merge {} (first rows)))))

 (defn to-conditions [attributes]
   (let [[parameterized-conditions values] (reduce
@@ -24,13 +18,6 @@
       attributes)]
     (apply vector (str-utils/str-join " AND " parameterized-conditions) values)))

-(defn find-records [model-name attributes]
-  (let [[parameterized-where & values] (to-conditions attributes)
-        select-query (format "select * from %s where %s" (table-name model-name) parameterized-where)]
-    (sql/with-connection db
-      (sql/with-query-results rows (apply vector select-query values)
-        (doall (map #(merge {} %) rows))))))
-
 (defn create [model-name attributes]
   (sql/with-connection db
     (let
@@ -41,6 +28,23 @@
             (sql/with-query-results rows ["VALUES IDENTITY_VAL_LOCAL()"] (:1 (first rows))))] ; XXX: db-vendor-specific
       (get-record model-name id))))

+(defn get-record [model-name id]
+  (sql/with-connection db
+    (sql/with-query-results rows [(format "select * from %s where id = ?" (table-name model-name)) id]
+      (if (empty? rows) (throw (IllegalArgumentException. "Record does not exist")))
+      (merge {} (first rows)))))
+
+(defn find-records [model-name attributes]
+  (let [[parameterized-where & values] (to-conditions attributes)
+        select-query (format "select * from %s where %s" (table-name model-name) parameterized-where)]
+    (sql/with-connection db
+      (sql/with-query-results rows (apply vector select-query values)
+        (doall (map #(merge {} %) rows))))))
+
+(defn update [model-name attributes]
+  (sql/with-connection db
+    (sql/update-values (table-name model-name) ["id = ?" (:id attributes)] (dissoc attributes :id))))
+
 (defn destroy-record [model-name record]
   (sql/with-connection db
     (sql/delete-rows (table-name model-name) ["id = ?" (:id record)])))
@@ -48,10 +52,6 @@
 (defn destroy-records [model-name attributes]
   (sql/with-connection db
     (sql/delete-rows (table-name model-name) (to-conditions attributes))))
-
-(defn update [model-name attributes]
-  (sql/with-connection db
-    (sql/update-values (table-name model-name) ["id = ?" (:id attributes)] (dissoc attributes :id))))

 (defn- defs-from-option-groups [model-name option-groups]
   (reduce


lein-release plugin: preparing 0.3.1 release

--- backend/project.clj
+++ backend/project.clj
@@ -1,4 +1,4 @@
-(defproject lambdaui "0.3.1-SNAPSHOT"
+(defproject lambdaui "0.3.1"
   :description "LambdaCD-Plugin that provides a modern UI for your pipeline."
   :url "https://github.com/sroidl/lambda-ui"
   :license {:name "Apache License 2.0"


fix lein release

fix lein release

--- backend/project.clj
+++ backend/project.clj
@@ -12,6 +12,7 @@
                  [trptcolin/versioneer "0.2.0"]]

   :test-paths ["test"]
+  :scm {:dir ".."}
   :deploy-repositories [["snapshots" {:url "https://clojars.org/repo"
                                       :username [:gpg :env]
                                       :password [:gpg :env]}]


[#2231] Add exclusions

[#2231] Add exclusions

--- backend/project.clj
+++ backend/project.clj
@@ -11,7 +11,7 @@
                  [org.slf4j/jcl-over-slf4j "1.7.26" :exclusions [org.slf4j/slf4j-api]]
                  [org.slf4j/jul-to-slf4j "1.7.26" :exclusions [org.slf4j/slf4j-api]]
                  [cheshire "5.8.1" :exclusions [com.fasterxml.jackson.core/jackson-core]]
-                 [clj-http "3.10.0" :exclusions [org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime]]
+                 [clj-http "3.10.0" :exclusions [org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime commons-io/commons-io]]
                  [clj-time "0.15.1"]
                  [com.layerware/hugsql "0.4.9"]
                  [commons-io/commons-io "2.6"]
@@ -27,7 +27,7 @@
                  [org.akvo/commons "0.4.6" :exclusions [org.postgresql/postgresql org.clojure/java.jdbc]]
                  [org.akvo/resumed "1.46.266acfa5bb52c9b484af19f0bcfbfacb60b97319"]
                  [org.apache.tika/tika-core "1.21"]
-                 [org.apache.tika/tika-parsers "1.21" :exclusions [org.slf4j/slf4j-api com.fasterxml.jackson.core/jackson-core org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime]]
+                 [org.apache.tika/tika-parsers "1.21" :exclusions [org.slf4j/slf4j-api com.fasterxml.jackson.core/jackson-core org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime commons-io/commons-io]]
                  ;; explicit versions of commons deps used by tika-parsers and clj-http
                  [com.fasterxml.jackson.core/jackson-core "2.9.9"]
                  [org.apache.httpcomponents/httpcore "4.4.11"]


change arg order in core/invoke-with-transaction

--- src/asphalt/core.clj
+++ src/asphalt/core.clj
@@ -166,7 +166,7 @@
               (catch Exception _)) ; ignore auto-rollback exceptions
             (throw e))))
       (i/unexpected "javax.sql.DataSource instance" data-source)))
-  ([f isolation ^DataSource data-source]
+  ([f ^DataSource data-source isolation]
     (if (instance? DataSource data-source)
       (with-open [^Connection connection (.getConnection ^DataSource data-source)]
         (.setAutoCommit connection false)
@@ -197,7 +197,7 @@
     (when-not (symbol? connection)
       (i/unexpected "a symbol" connection))
     `(invoke-with-transaction
-       (^:once fn* [~(vary-meta connection assoc :tag java.sql.Connection)] ~@body) ~isolation ~data-source)))
+       (^:once fn* [~(vary-meta connection assoc :tag java.sql.Connection)] ~@body) ~data-source ~isolation)))

 ;; ----- java.sql.PreparedStatement (connection-worker) stuff -----


Change assert to c/assert

Change assert to c/assert

--- src/active/clojure/config.cljc
+++ src/active/clojure/config.cljc
@@ -75,7 +75,7 @@
   (make-range description completer
               (fn [range path f res val]
                 (let [v' (completer range path val)]
-                  (assert (not (range-error? v')) (pr-str v'))
+                  (c/assert (not (range-error? v')) (pr-str v'))
                   (f range path res v')))))

 (defn any-value-range
@@ -218,7 +218,7 @@
               (fn [range path f res val]
                 (loop [rs rs]
                   (if (empty? rs)
-                    (assert false)
+                    (c/assert false)
                     (let [this-range (first rs)
                           v ((range-completer this-range) this-range path val)]
                       (if (range-error? v)
@@ -289,7 +289,7 @@
                        ret)))))
               (fn [this-range path f res val]
                 (let [v ((range-completer this-range) this-range path val)]
-                  (assert (not (range-error? v)) (pr-str v))
+                  (c/assert (not (range-error? v)) (pr-str v))
                   (reduce (fn [res [i x]]
                             ((range-reduce range) range (conj path i) f res x))
                           res
@@ -334,7 +334,7 @@
                   (make-range-error this-range path val)))
               (fn [this-range path f res val]
                 (let [v ((range-completer this-range) this-range path val)]
-                  (assert (not (range-error? v)) (pr-str v))
+                  (c/assert (not (range-error? v)) (pr-str v))
                   (reduce (fn [res [i [v range]]]
                             ((range-reduce range) range (conj path i)
                              f res v))
@@ -370,7 +370,7 @@
                    :else (make-range-error this-range ky vl))))
               (fn [this-range path f res val]
                 (let [v ((range-completer this-range) this-range path val)]
-                  (assert (not (range-error? v)) (pr-str v))
+                  (c/assert (not (range-error? v)) (pr-str v))
                   (reduce (fn [res [k v]]
                             ((range-reduce val-range) val-range (conj path k) f
                              ((range-reduce key-range) key-range path f res k)
@@ -483,7 +483,7 @@
   (let [cmap ((range-completer range) range path val)
         settings (schema-settings-map schema)
         sections (schema-sections-map schema)]
-    (assert (not (range-error? cmap)) (pr-str cmap))
+    (c/assert (not (range-error? cmap)) (pr-str cmap))
     (reduce (fn [res [k v]]
               (if-let [setting (get settings k)]
                 ((range-reduce (setting-range setting))
@@ -618,7 +618,7 @@
                      (let [res
                            (normalize&check-config-map (section-schema section) profile-names {}
                                                        inherited-map (concat path [key]))]
-                       (assert (not (range-error? res)) (pr-str res))
+                       (c/assert (not (range-error? res)) (pr-str res))
                        {key res}))))]

          (let [sections-map (schema-sections-map schema)


For `define-record-type`, check that each constructor argument is actually a field.

--- src/active/clojure/record.cljc
+++ src/active/clojure/record.cljc
@@ -33,6 +33,13 @@
                                 (if (contains? m :doc)
                                   m
                                   (assoc m :doc doc)))))]
+
+    (let [?field-names (set (map first ?field-pairs))]
+      (doseq [?constructor-arg ?constructor-args]
+        (when-not (contains? ?field-names ?constructor-arg)
+          (throw (IllegalArgumentException. (str "constructor argument " ?constructor-arg " is not a field in " *ns* " " (meta &form)))))))
+
+
     `(do
        (defrecord ~?type
            [~@(map first ?field-pairs)]


+:past-participle

+:past-participle

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -447,6 +447,7 @@
              (= k "latin")
              (= k :participle)
              (= k :past)
+             (= k :past-participle)
              (= k :present)
              (= k :1sing)
              (= k :2sing)


Add docstring and buffering to pausable function.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -371,9 +371,20 @@
   (.ignoreElements ob))

 (defn pausable
-  [pauser ob]
-  {:pre [(observable? ob) (observable? pauser)]}
-  (.pausable ob pauser))
+  "Pauses the underlying observable sequence based upon the
+  observable sequence which yields true/false.
+
+  WARNING: The buffered pausable only works with hot
+  observables."
+  ([pauser ob]
+   (pausable pauser false ob))
+   ;; {:pre [(observable? ob) (observable? pauser)]}
+   ;; (.pausable ob pauser))
+  ([pauser buffer? ob]
+   {:pre [(observable? ob) (observable? pauser)]}
+   (if buffer?
+     (.pausableBuffered ob pauser)
+     (.pausable ob pauser))))

 (defn dedupe
   "Returns an observable sequence that contains only


Make ConnectableObservable participate in the cats protocols.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -486,4 +486,7 @@
   (-get-context [_] observable-context)

   js/Rx.Subject
+  (-get-context [_] observable-context)
+
+  js/Rx.ConnectableObservable
   (-get-context [_] observable-context))


Removed some println debugging

Removed some println debugging

--- src/binary/core.cljs
+++ src/binary/core.cljs
@@ -26,10 +26,7 @@

                :bit {:size 1
                      :js-get "getUint8"
-                     :process (fn [value pos]
-                                (println "pos is" (mod pos 8))
-                                (println "value is" value)
-                                (bit-test value (mod pos 8)))}})
+                     :process (fn [value pos] (bit-test value (mod pos 8)))}})

 (def binary-types {
                    :charstring {:sizable true
@@ -52,12 +49,10 @@
 (defn no-process [val _] val)

 (defn read-data [dv {:keys [length formatter le js-type], :or {formatter no-process}} index]
-  (println "type size:" (< (:size js-type) 8))
   (let [get-func (.bind (aget dv (:js-get js-type)) dv)
         adjusted-index (/ index 8)
         {:keys [size process] :or {process identity}} js-type]

-    (println "adjusted-index is" adjusted-index)
     [(* length size)
      (formatter
        (if (> length 1)


fixed bug in expand-list

fixed bug in expand-list

--- src/blind/reader.clj
+++ src/blind/reader.clj
@@ -635,7 +635,7 @@
                        (cond
                          (unquote? item)          (list 'clojure.core/list (second item))
                          (unquote-splicing? item) (second item)
-                         :else                    (list (syntax-quote item))))]
+                         :else                    (list 'clojure.core/list (syntax-quote item))))]
         (recur (next s) ret))
       (seq (persistent! r)))))


Speed up levenshtein by tightening criteria

--- src/blx/sortable.clj
+++ src/blx/sortable.clj
@@ -2,7 +2,7 @@
   (:require [clojure.java.io :as io]
             [clojure.string :as str]
             [cheshire.core :as json]
-            [clj-fuzzy.metrics :refer [levenshtein]]
+;            [clj-fuzzy.metrics :refer [levenshtein]]
             [taoensso.timbre :as timbre]
             [taoensso.timbre.profiling :as p])
   (:gen-class))
@@ -98,6 +98,23 @@
                        (fnil str/lower-case "")
                        :manufacturer))))

+(defn levenshtein
+  "Computes the Levenshtein distance between two sequences."
+  [c1 c2]
+  (let [lev-next-row
+        (fn [previous current]
+            (reduce
+              (fn [row [diagonal above other]]
+                (let [update-val (if (= other current)
+                                   diagonal
+                                   (inc (min diagonal above (peek row))))]
+                  (conj row update-val)))
+              [(inc (first previous))]
+              (map vector previous (next previous) c2)))]
+      (peek
+        (reduce lev-next-row
+                (range (inc (count c2)))
+                c1))))

 (def manufacturer-matchers
   [(fn first-word? [manufacturers candidate]
@@ -108,37 +125,35 @@
      ; This is mainly for things like "OPYMPUS" -> "Olympus"
      (p/p :levenshtein
           (let [min-length 4
+                max-length-delta 3  ; Skip Levenshtein if seq length > 3
                 max-lev-dist 2]
-            (and ; Very short strings are not likely to be similar
-                 (>= (count candidate) min-length)
-
-                 ; Levenshtein is expensive, so require the first letter to match
-                 ; before trying to compute it.
-                 ((set (map first manufacturers)) (first candidate))
-
-                 (let [[guess lev-dist]
-                       (p/p :lev-lev
-                            (->> manufacturers
-                                 (map (juxt identity (partial levenshtein candidate)))
-                                 (apply min-key second)))]
-                   (when (<= lev-dist max-lev-dist)
-                     guess))))))])
+            (and
+              ; Very short strings are not likely to be similar
+              (>= (count candidate) min-length)
+
+              ; Levenshtein is expensive, so require the first letter to match
+              ; before trying to compute it.
+              ((set (map first manufacturers)) (first candidate))
+
+              (when-let [levs
+                         (p/p :lev-lev
+                              (->> manufacturers
+                                   (filter #(< (Math/abs (- (count %) (count candidate)))
+                                               max-length-delta))
+                                   (map (juxt identity
+                                              (partial levenshtein candidate)))
+                                   seq))]
+                (let [[guess lev-dist] (apply min-key second levs)]
+                  (when (<= lev-dist max-lev-dist)
+                    guess)))))))])

 (def match-manufacturer
   (memoize
-    (fn [manufacturers listing-manufacturer]
-      (let [min-prefix-length 2
-            preprocessor #(str/replace-first % #"^(?i)Hewlett\s*Packard" "hp")]
-        (when-let [listing-manufacturer (and (>= (count listing-manufacturer)
-                                                 min-prefix-length)
-                                             (preprocessor listing-manufacturer))]
-          (let [match (->> manufacturer-matchers
-                           ; TODO cache this once we've calculated manufacturers once
-                           (map #(partial % manufacturers))
-                           (apply some-fn))]
-            (->> listing-manufacturer
-                 str/lower-case
-                 match)))))))
+    (fn [manufacturer-matcher listing-manufacturer]
+      (let [preprocessor (comp str/lower-case
+                               #(str/replace-first % #"^(?i)Hewlett\s*Packard" "hp"))]
+        (when-let [listing-manufacturer (preprocessor listing-manufacturer)]
+          (manufacturer-matcher listing-manufacturer))))))

 (defn match-title
@@ -156,13 +171,14 @@
 (p/defnp match-listing
   "Attempts to match listing to a product in products, returning a vector
   [matching-product listing] if successful, else nil."
-  [products listing]
+  [products manufacturer-matcher listing]
   (when-let [manufacturer-guess
-             (p/p :match-manuf (match-manufacturer (keys products)
+             (p/p :match-manuf (match-manufacturer manufacturer-matcher
                                                    (or (:manufacturer listing)
                                                        (first-word (:title listing)))))]
-    (if-let [product-guess (p/p :match-title (match-title (products manufacturer-guess)
-                                                          (:title listing)))]
+    (if-let [product-guess
+             (p/p :match-title (match-title (products manufacturer-guess)
+                                            (:title listing)))]
       [product-guess listing]
       [nil listing])))

@@ -173,8 +189,11 @@
   ; We take in all the listings, as opposed to doing (pmap match-listing listings),
   ; because we need to group the results by Product after matching.
   [products listings]
-  (let [matches (->> listings
-                     (pmap #(match-listing products %))  ; pmap was a 4x speedup
+  (let [manufacturer-matcher (->> manufacturer-matchers
+                                  (map #(partial % (keys products)))
+                                  (apply some-fn))
+        matches (->> listings
+                     (pmap #(match-listing products manufacturer-matcher %))  ; pmap was a 4x speedup
                      )
 ;                     (filter some?))
         product first


+abandon:subcat

+abandon:subcat

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -64,8 +64,11 @@
              :agr {:number :sing}}}

    "abandon" {:synsem {:cat :verb
-                       :sem {:pred :abandon}}}
-
+                       :sem {:pred :abandon}
+                       :subcat {:1 {:cat :noun
+                                    :sem {:human true}}
+                                :2 {:cat :noun
+                                    :sem {:physical-object true}}}}}
    "accept"  {:synsem {:cat :verb
                        :sem {:pred :accept}}}


de-animate some common nouns

de-animate some common nouns

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -84,6 +84,7 @@

    "bag" {:synsem {:cat :noun
                    :sem {:pred :bag
+                         :animate false
                          :place false}}}

    "base" {:synsem {:cat :verb
@@ -264,6 +265,7 @@

    "bicycle" {:synsem {:cat :noun
                        :sem {:pred :bicycle
+                             :animate false
                              :place false}}}
    "black"
    (unify adjective
@@ -319,6 +321,7 @@

    "car" {:synsem {:cat :noun
                    :sem {:pred :car
+                         :animate false
                          :place false}}}

    "carry" {:synsem {:cat :verb
@@ -545,6 +548,7 @@

    "game" {:synsem {:cat :noun
                     :sem {:pred :game
+                          :animate false
                           :games true}}}
    "get angry"
    (let [subject-semantics (atom {:human true})]
@@ -651,6 +655,7 @@
                     :pred :go-downstairs
                     :subj {:animate true}}}
     :english {:past "went downstairs"
+              :participle "going downstairs"
               :present {:3sing "goes downstairs"}}}

    "go out"
@@ -660,6 +665,7 @@
                     :pred :go-out
                     :subj {:animate true}}}
     :english {:past "went out"
+              :participle "going out"
               :present {:3sing "goes out"}}}

    "go upstairs"
@@ -949,6 +955,7 @@

    "key" {:synsem {:cat :noun
                    :sem {:pred :key
+                         :animate false
                          :place false}}}

    "kill" {:synsem {:cat :verb
@@ -1096,6 +1103,7 @@
    {:synsem {:agr {:number :sing}
              :cat :noun
              :sem {:pred :music
+                   :animate false
                    :mass true}}}
    "my"
    (map #(unify %


added verb exit

added verb exit

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -501,6 +501,9 @@

    "exist" {:synsem {:cat :verb
                      :sem {:pred :exist}}}
+
+   "exit" {:synsem {:cat :verb
+                     :sem {:pred :exit}}}

    "express" {:synsem {:cat :verb
                        :sem {:pred :express}}}


Wire up subscription link

Wire up subscription link

--- src/braid/ui/views/header.cljs
+++ src/braid/ui/views/header.cljs
@@ -36,23 +36,7 @@
                     ^{:key (user :id)}
                     [user-pill-view (user :id)])]]))))

-(defn tags-pane-view []
-  (let [open-group-id (subscribe [:open-group-id])
-        tags (subscribe [:tags])
-        group-subscribed-tags (subscribe [:group-subscribed-tags])]
-    (fn []
-      (let [path (routes/page-path {:group-id @open-group-id
-                                    :page-id "tags"})]
-        [:div.tags.shortcut {:class (when (routes/current-path? path) "active")}
-          [:a.title {:href path
-                     :title "Tags"}]
-          [:div.modal
-              (let [sorted-tags (->> @group-subscribed-tags
-                                    (sort-by :threads-count)
-                                     reverse)]
-                (for [tag sorted-tags]
-                  ^{:key (tag :id)}
-                  [tag-pill-view (tag :id)]))]]))))
+

@@ -105,6 +89,16 @@
     (fn []
       [:div.group-name (@group :name)])))

+(defn subscriptions-link-view []
+  (let [group-id (subscribe [:open-group-id])]
+    (fn []
+      (let [path (routes/page-path {:group-id @group-id
+                                    :page-id "tags"})]
+        [:a.subscriptions
+         {:class (when (routes/current-path? path) "active")
+          :href path}
+         "Manage Subscriptions"]))))
+
 (defn settings-link-view []
   (let [group-id (subscribe [:open-group-id])]
     (fn []
@@ -128,7 +122,7 @@
         [current-user-button-view]
         [:div.more]]
       [:div.options
-        [:a.subscriptions {:href ""} "Manage Subscriptions"]
+        [subscriptions-link-view]
         [:a.invite-friend {:href ""} "Invite a Friend"]
         [:a.edit-profile {:href ""} "Edit Your Profile"]
         [settings-link-view]]]])


Cosmetic improvements on streams ns.

Cosmetic improvements on streams ns.


fix gravity timer to reset for every new piece

--- src/client/core.cljs
+++ src/client/core.cljs
@@ -1,5 +1,6 @@
 (ns client.core
-  (:require-macros [cljs.core.async.macros :refer [go]])
+  (:require-macros
+    [cljs.core.async.macros :refer [go alt!]])
   (:require
     [client.board :refer [piece-fits?
                           cell-filled?
@@ -37,6 +38,10 @@

                   :score 0}))

+; required for pausing/resuming the gravity routine
+(def pause-grav (chan))
+(def resume-grav (chan))
+
 ;;------------------------------------------------------------
 ;; STATE MONITOR
 ;;------------------------------------------------------------
@@ -93,7 +98,8 @@
   "Spawns the given piece at the starting position."
   [piece]
     (swap! state assoc :piece piece
-                       :position start-position))
+                       :position start-position)
+    (put! resume-grav 0))

 (defn try-spawn-piece!
   "Checks if new piece can be written to starting position."
@@ -149,6 +155,7 @@
         board (:board @state)]
     (swap! state assoc  :board (write-piece-to-board piece x y board)
                         :piece nil)
+    (put! pause-grav 0)

     ; If collapse routine returns a channel...
     ; then wait for it before spawning a new piece.
@@ -156,21 +163,32 @@
       (go (<! collapse-anim) (try-spawn-piece!))
       (try-spawn-piece!))))

+(defn try-gravity!
+  "Move current piece down 1 if possible, else lock the piece."
+  []
+  (let [piece (:piece @state)
+        [x y] (:position @state)
+        board (:board @state)
+        ny (inc y)]
+    (if (piece-fits? piece x ny board)
+      (swap! state assoc-in [:position 1] ny)
+      (lock-piece!))))
+
 (defn go-go-gravity!
   "Starts the gravity routine."
   []
+  ; Make sure gravity starts in paused mode.
+  ; Spawning the piece will signal the first "resume".
+  (put! pause-grav 0)
+
   (go
     (loop []
-      (<! (timeout 1000))
-      (when (:piece @state)
-        (let [[x y] (:position @state)
-              piece (:piece @state)
-              board (:board @state)
-              ny (inc y)]
-          (if (piece-fits? piece x ny board)
-            (swap! state assoc-in [:position 1] ny)
-            (lock-piece!))))
-      (recur))))
+      (let [cs [(timeout 1000) pause-grav]  ; channels to listen to (timeout, pause)
+            [_ c] (alts! cs)]               ; get the first channel to receive a value
+        (if (= pause-grav c)                ; if "pause" received, wait for "resume"
+          (<! resume-grav)
+          (try-gravity!))
+        (recur)))))

 ;;------------------------------------------------------------
 ;; Input-driven STATE CHANGES
@@ -251,8 +269,8 @@
   (size-canvas!)
   (try-spawn-piece!)
   (add-key-events)
+  (go-go-draw!)
   (go-go-gravity!)
-  (go-go-draw!)

   (repl/connect)
   (connect-socket!)


some more datomic queries

some more datomic queries

--- src/clj/ceres/db.clj
+++ src/clj/ceres/db.clj
@@ -156,13 +156,18 @@
        count)

-  (map #(d/q '[:find (count ?r)
+  (pmap
+   (fn [acc]
+     [acc
+      (ffirst
+       (d/q '[:find (count ?r)
               :in $ ?name
               :where
               [?r :url/address ?url]
               [?r :url/author ?uid]
               [?uid :user/screen-name ?name]]
-            (d/db conn) %) news-accounts)
+            (d/db conn) acc))])
+   news-accounts)

   (aprint (d/entity (d/db conn) (d/tempid :db.part/user)))


[Fix] binding string

[Fix] binding string

--- src/clj_elm/core.clj
+++ src/clj_elm/core.clj
@@ -5,7 +5,8 @@
             [incanter.core :as c :exclude [update]]
             [clojure.core.match :refer [match]]
             [taoensso.timbre.profiling :refer [profile p]])
-  (:import [clj_elm.data DataSet])
+  (:import [clj_elm.data DataSet]
+           [Jama Matrix])
   (:gen-class))

 (def ^:dynamic *sign-reverse* false)
@@ -256,7 +257,7 @@
   (p :main
      (if (= (count args) 9)
        (let [[datap1 classidx1 header1 datap2 classidx2 header2 L n-of-cv sign-m] args]
-         (binding [*sign-reverse* sign-m]
+         (binding [*sign-reverse* (read-string sign-m)]
            (printfl "Start exp\n")
            (def dataset (atom (read-dataset datap1 (read-string classidx1) :header (read-string header1))))
            (printfl (str "Fin read-data " datap1 "\n"))


Update train.clj

Update train.clj

💗💓

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -52,6 +52,7 @@
    (train-coffee :heart)
    (train-coffee :heart)
    (train-coffee :heartpulse)
+   (train-coffee :heartbeat)
    (train-coffee :blockchain)
    (train-coffee :syringe)
    (train-coffee :mushroom)
@@ -86,6 +87,7 @@
    (train-coffee :badger :mushroom)
    (train-coffee :coffeepot :heart)
    (train-coffee :simply_overcaffeinated :coffeespin)
+   (train :heartbeat :heartpulse)
    (train :ffi :coffee)
    (train :blockchain)
    (train :coffeealarm)


Remove unnecessary default value

Remove unnecessary default value

--- src/clj/reply/reader/jline.clj
+++ src/clj/reply/reader/jline.clj
@@ -25,8 +25,7 @@
       (.setPaginationEnabled true)
       (.addCompleter completer))))

-
-(defmulti get-prompt type :default :default)
+(defmulti get-prompt type)
 (defmethod get-prompt :default [ns]
   (format "%s=> " ns))
 (defmethod get-prompt clojure.lang.Namespace [ns]


Use map instead of triple

Use map instead of triple

Internal change for making easier for later on to add support for
passing custom data from request functions.

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -16,8 +16,8 @@
 (defn asynchronize [f ctx]
   (let [parse-response (fn [result]
                          (if (vector? result)
-                           [(first result) (now) (second result)]
-                           [result (now) ctx]))]
+                           {:result (first result) :end-time (now) :context (second result)}
+                           {:result result :end-time (now) :context ctx}))]
     (go
       (try
         (let [result (f ctx)]
@@ -25,27 +25,27 @@
             (parse-response (<! result))
             (parse-response result)))
         (catch Exception _
-          [false (now) ctx])))))
+          {:result false :end-time (now) :context ctx})))))

-(defn async-function-with-timeout [step timeout sent-requests user-id context]
+(defn async-function-with-timeout [step timeout sent-requests user-id original-context]
   (swap! sent-requests inc)
   (go
     (when-let [sleep-before (:sleep-before step)]
-      (<! (async/timeout (sleep-before context))))
+    (<! (async/timeout (sleep-before original-context))))
     (let [start (now)
-          response (asynchronize (:request step) (assoc context :user-id user-id))
-          [[result end new-ctx] c] (alts! [response (async/timeout timeout)])]
+          response (asynchronize (:request step) (assoc original-context :user-id user-id))
+          [{:keys [result end-time context]} c] (alts! [response (async/timeout timeout)])]
       (if (= c response)
         [{:name (:name step)
           :id user-id
           :start start
-          :end end
-          :result result} new-ctx]
+          :end end-time
+          :result result} context]
         [{:name (:name step)
           :id user-id
           :start start
           :end (now)
-          :result false} context]))))
+          :result false} original-context]))))

 (defn- response->result [scenario result]
   {:name (:name scenario)


Adapt code to protocol changes and add byte buffer support to kdf implementations.

--- src/clojure/buddy/core/kdf.clj
+++ src/clojure/buddy/core/kdf.clj
@@ -14,6 +14,7 @@
            org.bouncycastle.crypto.params.KDFDoublePipelineIterationParameters
            org.bouncycastle.crypto.macs.HMac
            org.bouncycastle.crypto.Mac
+           java.nio.ByteBuffer
            clojure.lang.Keyword))

 (defprotocol IKDF
@@ -27,6 +28,11 @@
   (let [buffer (byte-array length)]
     (.generateBytes impl buffer 0 length)
     buffer))
+
+(defn- generate-byte-buffer
+  [impl length]
+  (let [buffer (generate-byte-array impl length)]
+    (ByteBuffer/wrap buffer)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; HKDF interface
@@ -44,9 +50,12 @@
         kdfimpl (HKDFBytesGenerator. digest)]
     (.init kdfimpl params)
     (reify
-      KDFType
-      (generate-bytes! [_ length]
-        (generate-byte-array kdfimpl length)))))
+      IKDF
+      (generate-byte-array! [_ length]
+        (generate-byte-array kdfimpl length))
+
+      (generate-byte-buffer! [_ length]
+        (generate-byte-buffer kdfimpl length)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; KDF1/2 interface
@@ -60,9 +69,12 @@
         kdfimpl (KDF1BytesGenerator. digest)]
     (.init kdfimpl params)
     (reify
-      KDFType
-      (generate-bytes! [_ length]
-        (generate-byte-array kdfimpl length)))))
+      IKDF
+      (generate-byte-array! [_ length]
+        (generate-byte-array kdfimpl length))
+
+      (generate-byte-buffer! [_ length]
+        (generate-byte-buffer kdfimpl length)))))

 (defn kdf2
   "DF2 generator for derived keys and ivs as defined by IEEE P1363a/ISO 18033"
@@ -72,9 +84,12 @@
         kdfimpl (KDF2BytesGenerator. digest)]
     (.init kdfimpl params)
     (reify
-      KDFType
-      (generate-bytes! [_ length]
-        (generate-byte-array kdfimpl length)))))
+      IKDF
+      (generate-byte-array! [_ length]
+        (generate-byte-array kdfimpl length))
+
+      (generate-byte-buffer! [_ length]
+        (generate-byte-buffer kdfimpl length)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Counter mode KDF
@@ -90,9 +105,12 @@
         kdfimpl (KDFCounterBytesGenerator. mac)]
     (.init kdfimpl params)
     (reify
-      KDFType
-      (generate-bytes! [_ length]
-        (generate-byte-array kdfimpl length)))))
+      IKDF
+      (generate-byte-array! [_ length]
+        (generate-byte-array kdfimpl length))
+
+      (generate-byte-buffer! [_ length]
+        (generate-byte-buffer kdfimpl length)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Feedback mode KDF
@@ -113,9 +131,12 @@
         kdfimpl (KDFFeedbackBytesGenerator. mac)]
     (.init kdfimpl params)
     (reify
-      KDFType
-      (generate-bytes! [_ length]
-        (generate-byte-array kdfimpl length)))))
+      IKDF
+      (generate-byte-array! [_ length]
+        (generate-byte-array kdfimpl length))
+
+      (generate-byte-buffer! [_ length]
+        (generate-byte-buffer kdfimpl length)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Feedback mode KDF
@@ -133,6 +154,9 @@
         kdfimpl (KDFDoublePipelineIterationBytesGenerator. mac)]
     (.init kdfimpl params)
     (reify
-      KDFType
-      (generate-bytes! [_ length]
-        (generate-byte-array kdfimpl length)))))
+      IKDF
+      (generate-byte-array! [_ length]
+        (generate-byte-array kdfimpl length))
+
+      (generate-byte-buffer! [_ length]
+        (generate-byte-buffer kdfimpl length)))))


Rename defstack to build-stack

Rename defstack to build-stack

--- src/clojure/picard/helpers.clj
+++ src/clojure/picard/helpers.clj
@@ -22,7 +22,7 @@
 (defn response-headers [[_ headers]] headers)
 (defn response-body    [[_ _ body]]  body)

-(defmacro defstack
+(defmacro build-stack
   "Builds an application stack from downstream to upstream. The last
   argument should be the end application and everything before that
   is middleware."


Hooked up delete button.

Hooked up delete button.

--- src/com/okl/tokenmgr/views.clj
+++ src/com/okl/tokenmgr/views.clj
@@ -389,6 +389,38 @@
     document.location.reload(true);
   }
   });
-});
+
+});
+
+$('.del').live('click', function() {
+  var me = $(this);
+  var id = me.attr('id');
+  var row = dv.getItemById(id);
+  var name = row['name'];
+  var environment = row['environment'];
+  var delconf = confirm('Do you really want to delete the ' + environment +
+                        ' value for the ' + name + 'token?');
+  if (delconf) {
+    $.ajax({ url: '/api/tokens/"
+  ;; need to handle empty app case, as well as non-empty case
+  (if (empty? app)
+    ""
+    (url-encode (str app "/"))) "' + name + '/' + environment,
+             type: 'DELETE',
+             success: function(data) {
+               if(data.status != 'success') {
+                 alert('Error deleting ' + name + ':\\n' + data.message)
+               }
+               document.location.reload(true);
+             },
+             error: function(req, status, message) {
+               alert('Error deleting ' +  name);
+               document.location.reload(true);
+             }
+    });
+  }
+});
+
+
 })"
 )]]))


introducing entities+facts->entities

introducing entities+facts->entities

--- sample/src/sample/core.clj
+++ sample/src/sample/core.clj
@@ -44,6 +44,7 @@
   (cldb/db-rel fact e a v t)

   (defn facts->entities [facts & {:keys [at-t]}]
+    (println "FTE" facts at-t)
     (let [ldb (apply cldb/db facts)
           lres (cldb/with-db ldb
                  (cl/run* [q]
@@ -70,12 +71,12 @@
                                am)]))
              (into {})))))

-  (defrecord Snapshot [state])
+  (defn merge-entities [es1 es2]
+    (merge-with #(merge %1 %2)
+                es1 es2))

-  (defn snapshot [facts t]
-    )
-
-  (defrecord VersionedAttribute [m])
+  (defn entities+facts->entities [entities facts & {:keys [at-t]}]
+    (merge-entities entities (facts->entities facts :at-t at-t)))

   (let [facts1 [[fact 200 :type     :address      1]
                 [fact 200 :street   "street 111"  1]
@@ -93,9 +94,12 @@
                 [fact 101 :name     "bar3"        4]
                 [fact 101 :name     "bar5"        6]
                 [fact 101 :name     "bar2"        3]
-                [fact 101 :name     "bar4"        5]]]
+                [fact 101 :name     "bar4"        5]]

-    (facts->entities facts1 :at-t 5)))
+        facts2 [[fact 101 :name     "bar7"        8]
+                [fact 101 :name     "bar6"        7]]]
+
+    (entities+facts->entities (facts->entities facts1) facts2)))

 ;;; (cltest2)


Resolve #2: Added colours to pressure bars

- added colour to indicate the intensity of pressure

--- app/views/pgm.cljs
+++ app/views/pgm.cljs
@@ -9,6 +9,8 @@
             [om.dom :as dom :include-macros true]
             [om.core :as om :include-macros true]
             [sablono.core :as html :refer-macros [html]]))
+
+(def pressure-colours ["#C25051" "#E09432" "#EFBD2E" "#73B845" "#009BDD"])

 (strokes/bootstrap)

@@ -97,7 +99,7 @@
                      :ref "svg"}
                [:g {:class "data"}
                 (for [d data]
-                  [:rect {:color "red"
+                  [:rect {:style {:fill (nth pressure-colours (:pressure d)) }
                           :height height
                           :width 2
                           :x (x (:timestamp d))}])]


defn fix-files

defn fix-files

--- src/convert/core.clj
+++ src/convert/core.clj
@@ -23,5 +23,15 @@
     (convert fname))
   (println "Files converted:" (count files/fnames)))

+(defn fix-files []
+  (let [files [ "/home/bost/vircurex/2013/08/31/vircurex.2013-08-31_15-05-30.xml"
+                "/home/bost/vircurex/2013/08/31/vircurex.2013-08-31_15-10-37.xml"
+                "/home/bost/vircurex/2013/08/31/vircurex.2013-08-31_15-36-50.xml"
+                "/home/bost/vircurex/2013/08/31/vircurex.2013-08-31_15-20-53.xml"
+                ]]
+        (doseq [fname files]
+          (convert fname))
+        (println "Files fixed: " (count files))))
+
 (defn -main [& args]
   (convert-files!))


Refactored code for scenes

Refactored code for scenes

seems to work.

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

--- src/conexp/graphics/scenes.clj
+++ src/conexp/graphics/scenes.clj
@@ -28,11 +28,36 @@
   []
   (GWindow. Color/WHITE))

+;; setting custom data
+
 (defn- initialize-scene
   "Initializies given scene."
   [#^GScene scn]
-  (.setUserData scn {:hooks {}})
+  (.setUserData scn (ref {}))
   scn)
+
+(defn add-data-to-scene
+  "Adds given data under keyword to scene."
+  [#^GScene scn, key, data]
+  (dosync
+   (alter (.getUserData scn) assoc key data)))
+
+(defn update-data-for-scene
+  "Updates data item associated with keys in scene."
+  [#^GScene scn, keys, data]
+  (dosync
+   (alter (.getUserData scn) assoc-in keys data)))
+
+(defn remove-data-from-scene
+  "Removes all data associated with key from scene."
+  [#^GScene scn, key]
+  (dosync
+   (alter (.getUserData scn) disj key)))
+
+(defn get-data-from-scene
+  "Returns data associated with key from scene."
+  [#^GScene scn, key]
+  (-> scn .getUserData deref (get key)))

 (defn make-scene
   "Makes scene on given window."
@@ -40,6 +65,7 @@
   (let [#^GScene scn (GScene. window)]
     (doto scn
       (initialize-scene)
+      (add-data-to-scene :hooks {})
       (.shouldZoomOnResize true)
       (.shouldWorldExtentFitViewport false)
       (.setStyle *default-scene-style*))
@@ -50,21 +76,23 @@
   [#^GScene scn]
   (.zoom scn 1.0))

+;; hooks
+
 (defn- get-scene-hooks
   "Returns the hooks with their corresponding callbacks for scene."
-  [#^GScene scn]
-  (:hooks (.getUserData scn)))
+  [scn]
+  (get-data-from-scene scn :hooks))

 (defn- set-scene-hooks
   "Sets hash-map of hooks to callbacks as scene hooks."
-  [#^GScene scn, hooks]
-  (.setUserData scn (assoc (.getUserData scn) :hooks hooks)))
+  [scn, hooks]
+  (add-data-to-scene scn :hooks hooks))

 (defn add-hook
   "Adds hook for scene."
-  [#^GScene scn, hook]
+  [scn, hook]
   (when (not (contains? (get-scene-hooks scn) hook))
-    (.setUserData scn (assoc-in (.getUserData scn) [:hooks hook] []))))
+    (update-data-for-scene scn [:hooks hook] [])))

 (defn set-callback-for-hook
   "Sets given functions as callbacks for hook on scene."
@@ -88,6 +116,8 @@
   (doseq [callback (get (get-scene-hooks scn) hook)]
     (apply callback args)))

+;; methods on scenes
+
 (defn start-interaction
   "Starts a given interaction for scene. interaction must be a
   function from a scene to a GInteraction object."
@@ -102,6 +132,11 @@
     [(/ (.getHeight current-world-extent) (.getHeight initial-world-extent)),
      (/ (.getWidth current-world-extent) (.getWidth initial-world-extent))]))

+(defn get-canvas-from-scene
+  "Returns canvas associated with a scene."
+  [#^GScene scn]
+  (.. scn getWindow getCanvas))
+
 ;;;

 nil


more tests

more tests

--- test/clj/app_test.clj
+++ test/clj/app_test.clj
@@ -90,11 +90,35 @@
     (is (not-empty u))
     (is (#(instance? User %) u)) ;;; wrapped in function call, because otherwise test framework
                                  ;;; tends to take wrong instance of User after recompiling test ns
+    (is (= (:db/eid u) 1))
     (is (every? #(instance? Comment %) u-cs))
     (is (= (count u-cs) 2))
     (is (every? #(instance? User %) u-cs0-us))
     (is (= (count u-cs0-us) 1))
     (is (every? #(= (:db/eid %) (:db/eid u)) u-cs0-us))))
+
+
+(deftest get-custom-1
+  (let [facts (lp/with-db *ldb*
+                (ll/run* [q]
+                  (ll/fresh [e a v]
+                    (fl/fact e a v (ll/lvar))
+                    (ll/== e 1)
+                    (ll/== q a))))]
+    (println facts)
+    (is (set facts) #{:user/name :user/birthday :user/gender})))
+
+(deftest get-custom-2
+  (let [facts (->> (lp/with-db *ldb*
+                     (ll/run* [q]
+                       (ll/fresh [e a v]
+                         (fl/fact e a v (ll/lvar))
+                         (ll/== e 1)
+                         (ll/== q [a v]))))
+                   (into {}))]
+    (is (= facts {:user/name "foo1"
+                  :user/birthday #inst "1999-09-09"
+                  :user/gender :f}))))

 #_(fe/entity ldb 1)


modify clj-ajax so that we can collect headers and request-time

--- frontend/utils.cljs
+++ frontend/utils.cljs
@@ -2,6 +2,7 @@
   (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
             [frontend.async :refer [put!]]
             [ajax.core :as ajax]
+            [cljs-time.core :as time]
             [frontend.env :as env]
             [goog.crypt :as crypt]
             [goog.crypt.Md5 :as md5]
@@ -97,15 +98,43 @@
              path
              (str "/" path)))))

-(defn ajax [method url message channel & {:keys [params format response-format keywords? context]
-                                          :or {format :json
-                                               response-format :json
-                                               keywords? true}}]
-  (let [uuid frontend.async/*uuid*]
+;; https://github.com/JulianBirch/cljs-ajax/blob/master/src/ajax/core.cljs
+;; copy of the default json formatter, but adds headers as metadata
+(defn json-response-format
+  "Returns a JSON response format.  Options include
+   :keywords? Returns the keys as keywords
+   :prefix A prefix that needs to be stripped off.  This is to
+   combat JSON hijacking.  If you're using JSON with GET request,
+   you should use this.
+   http://stackoverflow.com/questions/2669690/why-does-google-prepend-while1-to-their-json-responses
+   http://haacked.com/archive/2009/06/24/json-hijacking.aspx"
+  ([{:keys [prefix keywords? url method start-time]}]
+     {:read (fn read-json [xhrio]
+              (let [json (.getResponseJson xhrio prefix)
+                    headers (js->clj (.getResponseHeaders xhrio))
+                    request-time (try
+                                   (time/in-millis (time/interval start-time (time/now)))
+                                   (catch :default e
+                                     (merror e)
+                                     0))]
+                (with-meta (js->clj json :keywordize-keys keywords?) {:response-headers headers
+                                                                      :url url
+                                                                      :method method
+                                                                      :request-time request-time})))
+      :description (str "JSON"
+                        (if prefix (str " prefix '" prefix "'"))
+                        (if keywords? " keywordize"))}))
+
+
+;; XXX only implementing JSON format and not implementing prefixes for now since we don't use either
+(defn ajax [method url message channel & {:keys [params keywords? context]
+                                          :or {keywords? true}}]
+  (let [uuid frontend.async/*uuid*
+        start-time (time/now)]
     (put! channel [message :started context])
     (ajax/ajax-request url method
                        (ajax/transform-opts
-                        {:format format
+                        {:format (json-response-format {:keywords? keywords? :url url :method method :start-time start-time})
                          :response-format response-format
                          :keywords? keywords?
                          :params params


Fix the Clojure download link for real

Fix the Clojure download link for real

Turns out the URL is the same as before, they simply disabled HTTP. I should
have read the error message more carefully. :-)

--- spec/reply/integration_spec.clj
+++ spec/reply/integration_spec.clj
@@ -23,7 +23,7 @@

 (def clojure
   {:local-path "spec/clojure-1.7.0.jar"
-   :remote-url "https://search.maven.org/artifact/org.clojure/clojure/1.7.0/jar"})
+   :remote-url "https://repo1.maven.org/maven2/org/clojure/clojure/1.7.0/clojure-1.7.0.jar"})

 (defn ensure-test-jar [{:keys [local-path remote-url]}]
   (let [file (java.io.File. local-path)]


Add ability to use any option in display-config on CLI

--- src/degasolv/cli.clj
+++ src/degasolv/cli.clj
@@ -518,7 +518,22 @@
               ""])))
     (let [global-options options
           subcommand (first arguments)
-          subcmd-cli (get subcommand-cli subcommand)]
+          subcmd-cli (if (not (= subcommand "display-config"))
+                       (get subcommand-cli subcommand)
+                       ; this grabs all other options as part of display-config
+                       (t/it-> subcommand-cli
+                               (vals it)
+                               (map :cli it)
+                               (filter #(not (nil? %)) it)
+                               (apply concat it)
+                               (map #(concat [nil] (subvec % 1)) it)
+                               (map #(do [(first %) %]) it)
+                               (into {} it)
+                               (vals it)
+                               (assoc
+                                (get subcommand-cli subcommand)
+                                :cli
+                                it)))]
       (when (nil? subcmd-cli)
         (exit 1 (error-msg [(str "Unknown command: " subcommand)])))
       (let [{:keys [options arguments errors summary]}


pagination naive score returned

pagination naive score returned

--- src/crawler/rich_extractor.clj
+++ src/crawler/rich_extractor.clj
@@ -175,6 +175,39 @@
         thresh-sims  (filter #(> % 0.8) similarities)]
     (> (count thresh-sims) (* 0.5 (count samples)))))

+(defn updated
+  [xpaths-hrefs1 xpaths-hrefs2]
+  (let [xpaths (set (map first xpaths-hrefs1))
+        upds   (map
+                (fn [xpath] (count
+                            (clojure.set/difference
+                             (set (xpaths-hrefs1 xpath))
+                             (set (xpaths-hrefs2 xpath)))))
+                xpaths)]
+    (apply + upds)))
+
+(defn pick-paginator
+  "Picks one XPath for pagination
+
+   Args:
+    {xpath: sample-bodies,...}
+   Returns:
+    picked xpath"
+  [src-xpaths-hrefs pagination-candidates blacklist]
+  (let [candidate-xpaths (map first pagination-candidates)]
+    (first ; don't return the score as well
+     (last
+      (sort-by
+       second
+       (map
+        (fn [[xpath sampled]]
+          (let [s (map
+                   (fn [a-sampled-page]
+                     (updated src-xpaths-hrefs a-sampled-page))
+                   sampled)]
+            [xpath (/ (apply + s) (count s))]))
+        pagination-candidates))))))
+
 (defn weak-pagination-detector
   ([page-src url]
      (weak-pagination-detector page-src url (set [])))
@@ -201,7 +234,23 @@
            xpaths-samples       (map
                                  (fn [[xpath links]]
                                    [xpath (sample/sample-some-links links blacklist)])
-                                 xpaths-considered)]
-       (println xpaths-considered)
-       (flush)
-       (map first (filter #(pagination? page-src %) xpaths-samples)))))
+                                 xpaths-considered)
+           xpaths-samples-map   (into {} xpaths-samples)
+           pagination-cands     (map
+                                 first
+                                 (filter
+                                  #(pagination? page-src %)
+                                  xpaths-samples))
+           pagination-ds        (map
+                                 (fn [an-xpath]
+                                   [an-xpath (map (fn [a-sample]
+                                                    (into
+                                                     {} (map
+                                                         (fn [[xpath nodes]]
+                                                           [xpath (map #(-> % :href) nodes)])
+                                                         (dom/xpaths-hrefs-tokens
+                                                          (dom/html->xml-doc a-sample)
+                                                          url))))
+                                                  (xpaths-samples-map an-xpath))])
+                                 pagination-cands)]
+       (pick-paginator xpaths-hrefs pagination-ds blacklist))))