reworked influence counting

reworked influence counting

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -20,16 +20,19 @@
 (defn found? [query cards]
   (some #(if (= (.toLowerCase (:title %)) query) %) cards))

+(defn influencelimit [identity]
+  "Returns influence limit of an identity or INFINITY in case of draft IDs."
+  (if (= (:setname identity) "Draft") INFINITY (:influencelimit identity)))
+
 (defn mostwanted? [card]
   "Returns true if card is on Most Wanted NAPD list."
   (let [napdmwl '("Cerberus \"Lady\" H1" "Clone Chip" "Desperado" "Parasite" "Prepaid VoicePAD"
                    "Architect" "AstroScript Pilot Program" "Eli 1.0" "NAPD Contract" "SanSan City Grid")]
-    (some #(= (:title card) %) napdmwl))
-  )
-
-(defn influencelimit [identity]
-  "Returns influence limit of an identity or INFINITY in case of draft IDs."
-  (if (= (:setname identity) "Draft") INFINITY (:influencelimit identity)))
+    (some #(= (:title card) %) napdmwl)))
+
+(defn noinfcost? [identity card]
+  (or (= (:faction card) (:faction identity))
+      (zero? (:factioncost card)) (= INFINITY (influencelimit identity))))

 (defn search [query cards]
   (filter #(if (= (.indexOf (.toLowerCase (:title %)) query) -1) false true) cards))
@@ -62,6 +65,10 @@
 (defn parse-deck [side deck]
   (reduce #(if-let [card (parse-line side %2)] (conj %1 card) %1) [] (split-lines deck)))

+(defn faction-label [card]
+  "Returns faction of a card as a keyword"
+  (-> card :faction .toLowerCase (.replace " " "-")))
+
 (defn allowed? [card {:keys [side faction title] :as identity}]
   "Checks if a card is allowed in deck of a given identity - not accounting for influence"
   (and (not= (:type card) "Identity")
@@ -113,20 +120,28 @@
     (om/set-state! owner :deck-edit str)))

 (defn influence [deck]
+  "Returns a map of faction keywords to influence values from the faction's cards."
   (let [identity (:identity deck)
         cards (:cards deck)
-        inf (reduce #(let [card (:card %2)]
-                       (if (= (:faction card) (:faction identity))
-                         %1
-                         (+ %1 (* (:qty %2) (:factioncost card)))))
-                    0 (:cards deck))]
+        infhelper (fn [currmap line]
+                    (let [card (:card line)]
+                      (if (= (:faction card) (:faction identity))
+                        currmap
+                        (update-in currmap [(keyword (faction-label card))]
+                                   (fnil (fn [curinf] (+ curinf (* (:qty line) (:factioncost card))))
+                                         0)))))
+        infmap (reduce infhelper {} cards)]
     (if (= (:title identity) "The Professor: Keeper of Knowledge")
-      (- inf (reduce #(+ %1 (get-in %2 [:card :factioncost])) 0
-                     (filter #(let [card (:card %)]
-                                (and (= (:type card) "Program")
-                                     (not= (:faction card) (:faction identity))))
-                             cards)))
-      inf)))
+      (let [progs (filter #(= "Program" (:type (:card %))) cards)
+            ;importedprogs (filter #((complement noinfcost?) identity (:card %)) progs)
+            singledprogs (reduce #(conj %1 (assoc-in %2 [:qty] 1)) '() progs)
+            singledinfmap (reduce infhelper {} singledprogs)]
+      (merge-with - infmap singledinfmap))
+      infmap)))
+
+(defn influence-count [deck]
+  "Returns sum of influence count used by a deck"
+  (apply + (vals (influence deck))))

 (defn card-count [cards]
   (reduce #(+ %1 (:qty %2)) 0 cards))
@@ -141,7 +156,7 @@

 (defn valid? [{:keys [identity cards] :as deck}]
   (and (>= (card-count cards) (:minimumdecksize identity))
-       (<= (influence deck) (influencelimit identity))
+       (<= (influence-count deck) (influencelimit identity))
        (every? #(and (allowed? (:card %) identity)
                      (<= (:qty %) (or (get-in % [:card :limited]) 3))) cards)
        (or (= (:side identity) "Runner")
@@ -370,7 +385,7 @@
                    [:div count " cards"
                     (when (< count min-count)
                       [:span.invalid (str "(minimum " min-count ")")])])
-                 (let [inf (influence deck)
+                 (let [inf (influence-count deck)
                        limit (influencelimit identity)]
                    [:div "Influence: "
                     [:span {:class (when (> inf limit) "invalid")} inf]
@@ -399,8 +414,7 @@
                        (:qty line) " "
                        (if-let [name (get-in line [:card :title])]
                          (let [card (:card line)
-                               infaction (or (= (:faction card) (:faction identity))
-                                            (zero? (:factioncost card)) (= INFINITY (influencelimit identity)))
+                               infaction (noinfcost? identity card)
                                wanted (mostwanted? card)]
                            [:span
                             [:span {:class (if (allowed? card identity) "fake-link" "invalid")
@@ -409,7 +423,7 @@
                             (when (or wanted (not infaction))
                               (let [influence (* (:factioncost card) (:qty line))]
                                 [:span.influence
-                                 {:class (-> card :faction .toLowerCase (.replace " " "-"))
+                                 {:class (faction-label card)
                                   :dangerouslySetInnerHTML
                                   #js {:__html (str (if-not infaction (apply str (for [_ (range influence)] "●")))
                                                     (if wanted (apply str (for [_ (range (:qty line))] "○"))))}}]))])


updated circumcircle

updated circumcircle

--- src/cljs/triangulator/handlers.cljs
+++ src/cljs/triangulator/handlers.cljs
@@ -40,12 +40,12 @@

 (defn draw-line
   "draw line between p1 and p2"
-  [p1 p2 draw-chan options]
+  [p1 p2 draw-chan options color]
   (let [m (geom/midpoint p1 p2)
         l (geom/distance p1 p2)
         [q1 q2 s1 s2] (geom/perp-bisector [p1 p2])]
     (go (>! draw-chan
-            [(dt/style {:fill :grey-2})
+            [(dt/style {:stroke color :fill :grey-2})
              (dt/point p1)
              (dt/point p2)
              (dt/line [p1 p2])])
@@ -57,20 +57,17 @@
             (>! draw-chan
                 [(dt/style {:stroke :lt-grey})
                  (dt/line [p3 p4])
-                 (dt/style {:stroke :red})
+                 (dt/style {:fill :lt-red})
                  (dt/point m)])))
         (when (contains? options :circles)
           (>! draw-chan
-              [(dt/style {:stroke :red
+              [(dt/style {:stroke :lt-red
                           :fill :lt-blue})
                (dt/circle p1 l)
                (dt/circle p2 l)
                (dt/circle m (/ l 2))
                (dt/style {:fill :grey-2})
-               ;; draw perpendicular bisector
-               ;; and points on the perp-bisector
-               ;; at +- 1 root3 units from the midpoint
-               ;;(dt/style {:stroke :lt-green})
+
                (dt/line [s1 s2])
                (dt/point q1)
                (dt/point q2)
@@ -81,8 +78,7 @@
             (>! draw-chan
                 [(dt/style {:stroke :lt-grey})
                  (dt/line [p1 p3])
-                 (dt/line [p2 p4])
-                 (dt/style {:stroke :red})]))))))
+                 (dt/line [p2 p4])]))))))

 (defn draw-circle
   "clear-screen draw item draw point and coords of value"
@@ -97,10 +93,9 @@

 (defn draw-circle-2
   "clear-screen draw item draw point and coords of value"
-  [center radius draw-chan]
+  [center radius draw-chan style]
   (go (>! draw-chan
-          [(dt/style {:stroke :red
-                      :fill :grey-2})
+          [(dt/style style)
            (dt/circle center radius)
            (dt/point center)])))

@@ -110,13 +105,14 @@
   (let [circumcenter (geom/circumcenter [p1 p2 p3])
         _ (println "circumcenter: " circumcenter)]
     (when (contains? options :circumcircle)
-      (draw-line p1 circumcenter draw-chan #{})
-      (draw-line p2 circumcenter draw-chan #{})
-      (draw-line p3 circumcenter draw-chan #{})
-      (draw-circle-2 circumcenter (geom/distance p1 circumcenter) draw-chan))
-    (draw-line p1 p2 draw-chan #{:perp-bisector})
-    (draw-line p2 p3 draw-chan #{:perp-bisector})
-    (draw-line p3 p1 draw-chan #{:perp-bisector})
+      (draw-circle-2 circumcenter (geom/distance p1 circumcenter)
+                     draw-chan {:stroke :blue :fill :lt-blue})
+      (draw-line p1 circumcenter draw-chan #{} :lt-blue)
+      (draw-line p2 circumcenter draw-chan #{} :lt-blue)
+      (draw-line p3 circumcenter draw-chan #{} :lt-blue))
+    (draw-line p1 p2 draw-chan #{:perp-bisector} :red)
+    (draw-line p2 p3 draw-chan #{:perp-bisector} :red)
+    (draw-line p3 p1 draw-chan #{:perp-bisector} :red)
     (when (contains? options :circumcenter)
       (draw-point circumcenter draw-chan))))

@@ -153,7 +149,7 @@
             (draw-point-coords value draw-chan)
             current-state)
         1 (let [p1 (:p1 current-state)]
-            (draw-line p1 value draw-chan #{:circles :midpoint})
+            (draw-line p1 value draw-chan #{:circles :midpoint} :red)
             current-state)))
     :click
     (condp = (:step current-state)
@@ -186,15 +182,15 @@
             (draw-point-coords value draw-chan)
             current-state)
         1 (let [p1 (:p1 current-state)]
-            (draw-line p1 value draw-chan #{:circles})
+            (draw-line p1 value draw-chan #{:circles} :red)
             current-state)
         2 (let [p1 (:p1 current-state)
                 p2 (:p2 current-state)
                 base (geom/altitude p1 p2 value)]
-            (draw-line p1 p2 draw-chan #{:circles :extended})
-            (draw-line p2 value draw-chan nil)
-            (draw-line value p1 draw-chan nil)
-            (draw-line value base draw-chan nil)
+            (draw-line p1 p2 draw-chan #{:circles :extended} :red)
+            (draw-line p2 value draw-chan nil :red)
+            (draw-line value p1 draw-chan nil :red)
+            (draw-line value base draw-chan nil :red)
             current-state)))
     :click
     (condp = (:step current-state)
@@ -232,15 +228,15 @@
             (draw-point-coords value draw-chan)
             current-state)
         1 (let [p1 (:p1 current-state)]
-            (draw-line p1 value draw-chan #{})
+            (draw-line p1 value draw-chan #{} :red)
             current-state)
         2 (let [p1 (:p1 current-state)
                 p2 (:p2 current-state)
                 base (geom/altitude p1 p2 value)]
-            (draw-line p1 p2 draw-chan #{:extended})
-            (draw-line p2 value draw-chan nil)
-            (draw-line value p1 draw-chan nil)
-            (draw-line value base draw-chan nil)
+            (draw-line p1 p2 draw-chan #{:extended} :red)
+            (draw-line p2 value draw-chan nil :red)
+            (draw-line value p1 draw-chan nil :red)
+            (draw-line value base draw-chan nil :red)
             current-state)))
     :click
     (condp = (:step current-state)
@@ -271,14 +267,13 @@
     :move
     (do
       (go
-       (>! draw-chan clear)
-       (>! out [:draw :triangle draw-chan]))
+       (>! draw-chan clear))
       (condp = (:step current-state)
         0 (do
             (draw-point-coords value draw-chan)
             current-state)
         1 (let [p1 (:p1 current-state)]
-            (draw-line p1 value draw-chan #{})
+            (draw-line p1 value draw-chan #{} :red)
             current-state)
         2 (let [p1 (:p1 current-state)
                 p2 (:p2 current-state)
@@ -344,14 +339,14 @@
             (draw-point-coords value draw-chan)
             current-state)
         1 (let [p1 (:p1 current-state)]
-            (draw-line p1 value draw-chan nil)
+            (draw-line p1 value draw-chan nil :red)
             current-state)
         2 (let [p1 (:p1 current-state)
                 p2 (:p2 current-state)
                 ref (geom/reflection p1 p2)
                 image (ref value)]
-            (draw-line p1 p2 draw-chan #{:extended})
-            (draw-line value image draw-chan #{:midpoint})
+            (draw-line p1 p2 draw-chan #{:extended} :red)
+            (draw-line value image draw-chan #{:midpoint} :red)
             current-state)
         3 (let [p1 (:p1 current-state)
                 p2 (:p2 current-state)
@@ -360,11 +355,11 @@
                 ref (geom/reflection p1 p2)
                 image1 (ref A)
                 image2 (ref B)]
-            (draw-line p1 p2 draw-chan #{:extended})
-            (draw-line A image1 draw-chan #{:midpoint})
-            (draw-line B image2 draw-chan #{:midpoint})
-            (draw-line A B draw-chan #{:extended})
-            (draw-line image1 image2 draw-chan #{:extended})
+            (draw-line p1 p2 draw-chan #{:extended} :red)
+            (draw-line A image1 draw-chan #{:midpoint} :red)
+            (draw-line B image2 draw-chan #{:midpoint} :red)
+            (draw-line A B draw-chan #{:extended} :red)
+            (draw-line image1 image2 draw-chan #{:extended} :red)
             current-state)
         4 (let [p1 (:p1 current-state)
                 p2 (:p2 current-state)
@@ -375,13 +370,13 @@
                 image1 (ref A)
                 image2 (ref B)
                 image3 (ref C)]
-            (draw-line p1 p2 draw-chan #{:extended})
-            (draw-line A B draw-chan #{})
-            (draw-line B C draw-chan #{})
-            (draw-line C A draw-chan #{})
-            (draw-line image1 image2 draw-chan #{})
-            (draw-line image2 image3 draw-chan #{})
-            (draw-line image3 image1 draw-chan #{})
+            (draw-line p1 p2 draw-chan #{:extended} :red)
+            (draw-line A B draw-chan #{} :red)
+            (draw-line B C draw-chan #{} :red)
+            (draw-line C A draw-chan #{} :red)
+            (draw-line image1 image2 draw-chan #{} :red)
+            (draw-line image2 image3 draw-chan #{} :red)
+            (draw-line image3 image1 draw-chan #{} :red)
             current-state)))
     :click
     (condp = (:step current-state)
@@ -413,8 +408,9 @@
                 inversion (:inversion current-state)
                 A value
                 image (inversion A)]
-            (draw-circle-2 center radius draw-chan)
-            (draw-line center A draw-chan #{:extended})
+            (draw-circle-2 center radius draw-chan
+                           {:stroke :red :fill :grey-2})
+            (draw-line center A draw-chan #{:extended} :red)
             (draw-point image draw-chan)
             current-state)
         3 (let [center (:center current-state)
@@ -427,9 +423,10 @@
                 line (geom/param-line A B)
                 pre-image-points (map line (geom/parts 24))
                 image-points (map inversion pre-image-points)]
-            (draw-circle-2 center radius draw-chan)
-            (draw-line center A draw-chan #{:extended})
-            (draw-line center B draw-chan #{:extended})
+            (draw-circle-2 center radius draw-chan
+                           {:stroke :red :fill :grey-2})
+            (draw-line center A draw-chan #{:extended} :red)
+            (draw-line center B draw-chan #{:extended} :red)
             (draw-point image1 draw-chan)
             (draw-point image2 draw-chan)
             (doseq [p image-points]
@@ -455,7 +452,8 @@
                 image-points1 (map inversion pre-image-points1)
                 image-points2 (map inversion pre-image-points2)
                 image-points3 (map inversion pre-image-points3)]
-            (draw-circle-2 center radius draw-chan)
+            (draw-circle-2 center radius draw-chan
+                           {:stroke :red :fill :grey-2})
             (draw-point image1 draw-chan)
             (draw-point image2 draw-chan)
             (doseq [p image-points1]
@@ -506,7 +504,7 @@
                 p1 value
                 homotheties (:homotheties current-state)
                 images (map (fn [f] (f p1)) homotheties)]
-            (draw-line (first images) (last images) draw-chan nil)
+            (draw-line (first images) (last images) draw-chan nil :red)
             (doseq [pi images]
               (draw-point pi draw-chan))
             (draw-point p1 draw-chan)
@@ -519,15 +517,15 @@
                 images1 (map (fn [f] (f p1)) homotheties)
                 images2 (map (fn [f] (f p2)) homotheties)]

-            (draw-line (first images1) (last images1) draw-chan nil)
-            (draw-line (first images2) (last images2) draw-chan nil)
+            (draw-line (first images1) (last images1) draw-chan nil :red)
+            (draw-line (first images2) (last images2) draw-chan nil :red)

             (doseq [[i1 i2] (map vector images1 images2)]
-              (draw-line i1 i2 draw-chan nil))
+              (draw-line i1 i2 draw-chan nil :red))

             (draw-point p1 draw-chan)
             (draw-point p2 draw-chan)
-            (draw-line p1 p2 draw-chan nil)
+            (draw-line p1 p2 draw-chan nil :red)

             (draw-point center draw-chan)

@@ -582,14 +580,14 @@
             (draw-point-coords value draw-chan)
             current-state)
         1 (let [pi (:pi current-state)]
-            (draw-line pi value draw-chan nil)
+            (draw-line pi value draw-chan nil :red)
             current-state)
         2 (let [pi (:pi current-state)
                 pf (:pf current-state)
                 p1 value
                 translation (:translation current-state)
                 image (translation p1)]
-            (draw-line pi pf draw-chan nil)
+            (draw-line pi pf draw-chan nil :red)
             (draw-point p1 draw-chan)
             (draw-point image draw-chan)
             current-state)
@@ -600,13 +598,13 @@
                 translation (:translation current-state)
                 image1 (translation p1)
                 image2 (translation p2)]
-            (draw-line pi pf draw-chan nil)
+            (draw-line pi pf draw-chan nil :red)
             (draw-point p1 draw-chan)
             (draw-point image1 draw-chan)
             (draw-point p2 draw-chan)
             (draw-point image2 draw-chan)
-            (draw-line p1 p2 draw-chan nil)
-            (draw-line image1 image2 draw-chan nil)
+            (draw-line p1 p2 draw-chan nil :red)
+            (draw-line image1 image2 draw-chan nil :red)
             current-state)
         4 (let [pi (:pi current-state)
                 pf (:pf current-state)
@@ -617,19 +615,19 @@
                 image1 (translation p1)
                 image2 (translation p2)
                 image3 (translation p3)]
-            (draw-line pi pf draw-chan nil)
+            (draw-line pi pf draw-chan nil :red)
             (draw-point p1 draw-chan)
             (draw-point image1 draw-chan)
             (draw-point p2 draw-chan)
             (draw-point image2 draw-chan)
             (draw-point p3 draw-chan)
             (draw-point image3 draw-chan)
-            (draw-line p1 p2 draw-chan nil)
-            (draw-line image1 image2 draw-chan nil)
-            (draw-line p2 p3 draw-chan nil)
-            (draw-line image2 image3 draw-chan nil)
-            (draw-line p3 p1 draw-chan nil)
-            (draw-line image3 image1 draw-chan nil)
+            (draw-line p1 p2 draw-chan nil :red)
+            (draw-line image1 image2 draw-chan nil :red)
+            (draw-line p2 p3 draw-chan nil :red)
+            (draw-line image2 image3 draw-chan nil :red)
+            (draw-line p3 p1 draw-chan nil :red)
+            (draw-line image3 image1 draw-chan nil :red)
             current-state)))
     :click
     (condp = (:step current-state)


And one more sample

And one more sample

--- src/clojure/funcatron/tron/core.clj
+++ src/clojure/funcatron/tron/core.clj
@@ -17,6 +17,9 @@

 (set! *warn-on-reflection* true)

+(s/fdef ordered-tron-env
+  :args (s/cat :m map?)
+  :ret vector?)

 (defn- ordered-tron-env
   "Return the elements of the map that begin with TRON_ ordered by their number"
@@ -28,6 +31,8 @@
     (sort-by first)
     (map second)
     (into [])))
+
+(stest/instrument 'ordered-tron-env)

 (defn -main
   "The uberjar entrypoint"


Add docs to reader2

Add docs to reader2

--- src/com/wsscode/pathom/connect.cljc
+++ src/com/wsscode/pathom/connect.cljc
@@ -813,6 +813,19 @@
       (p/join (atom x) env))))

 (defn reader2
+  "Recommended reader to use with Pathom serial parser.
+
+  This reader uses the connect index to compute a EQL property requirement.
+
+  The process goes as:
+
+  - find possible paths to realize the attribute, given the current available data, generating a plan
+  - executes the plan
+  - in case a resolver fails (due to exception, or missing required data) the reader will
+    try to backtrack and execute another path (if there is one available).
+
+  This only handles sync process, if you return a core.async channel, the channel itself
+  will be the response. If you need to handle async use `async-reader2`."
   [{::keys   [indexes max-resolver-weight]
     ::p/keys [processing-sequence]
     :or      {max-resolver-weight 3600000}
@@ -983,7 +996,8 @@
             (<?maybe (call-resolver env e))))))))

 (defn async-reader2
-  "Like reader2, but supports async values on resolver return."
+  "Works in the same way `reader2`, but supports async values (core.async channels)
+   on resolver return."
   [{::keys   [indexes max-resolver-weight]
     ::p/keys [processing-sequence]
     :or      {max-resolver-weight 3600000}


Remove duplicated add-error call

Remove duplicated add-error call

--- src/com/wsscode/pathom/connect.cljc
+++ src/com/wsscode/pathom/connect.cljc
@@ -504,7 +504,6 @@
                      (p/add-error env response)
                      (>! ch {::pp/provides       out
                              ::pp/response-value (zipmap out-left (repeat ::p/reader-error))})
-                     (p/add-error env response)
                      (async/close! ch))

                    :else


added set-context

added set-context

--- src/conexp/gui/editors/contexts.clj
+++ src/conexp/gui/editors/contexts.clj
@@ -181,68 +181,6 @@
 (defmethod get-table :conexp.gui.editors.util/table-control
   [x] x)

-
-(defn-swing do-mk-context-editor-widget
-  "Creates a control for editing contexts.
-
-  Parameters:
-     & setup     _an optional number of vectors that may contain additional
-                  tweaks that are called after widget creation"
-  [& setup]
-  (let [ self (promise)
-         root (JRootPane.)
-         table (make-table-control
-                 [set-row-count 10]
-                 [set-column-count 10])
-
-         toolbar (make-toolbar-control :vert
-                   [add-button
-                     (make-button "Copy"
-                       (get-ui-icon "OptionPane.informationIcon")
-                       [set-handler (fn [] (copy-to-clipboard table))] )]
-                   [add-button
-                     (make-button "Paste"
-                       (get-ui-icon "OptionPane.informationIcon")
-                       [set-handler (fn [] (paste-from-clipboard table))] ) ])
-
-
-         widget {:managed-by-conexp-gui-editors-util "context-editor-widget"
-
-         :widget root
-         :table table
-         :control (get-control table)
-         :context (ref nil)
-
-         :associate-context
-         (fn-doc "Associates a context with the widget object and implicitly
-  updates the control
-
-  Parameters:
-    ectx      _editable context"
-           [ectx]
-           (let [ ctx (if (editable-context? ectx) ectx
-                       (make-editable-context ectx))
-                  ctx-ref (@self :context)
-                  old-ctx @ctx-ref]
-             (do
-               (dosync-wait (ref-set ctx-ref nil))
-               (if (not (nil? old-ctx)) (!! old-ctx :remove-widget- @self))
-               (!! ctx :add-widget- @self))
-               (dosync-wait (ref-set ctx-ref ctx))))
-
-
-         }
-
-         defaults []]
-    (do
-      (deliver self widget)
-      (.. root getContentPane
-        (add (get-widget toolbar) BorderLayout/LINE_START))
-      (.. root getContentPane
-        (add (get-widget table)))
-      (doseq [x defaults] (unroll-parameters-fn-map widget x))
-      (doseq [x setup] (unroll-parameters-fn-map widget x))
-      widget )))

 (declare change-attribute-name change-object-name change-incidence-cross)

@@ -402,6 +340,26 @@
     (set-hook table "cell-value"
       (fn [r c s] (ectx-cell-value-hook e-ctx r c s)))))

+(inherit-multimethod set-context ::editable-context
+  "Sets the bound fca-context of an editable context object to ctx.
+
+   Parameters:
+    ectx   _editable-context object
+    ctx    _new context")
+
+(defmethod
+  set-context ::editable-context
+  [ectx ctx]
+  (let [ new (make-editable-context ctx)
+         widgets @(:widgets ectx) ]
+    (dosync-wait
+      (ref-set (:widgets ectx) @(:widgets new))
+      (ref-set (:context ectx) @(:context new))
+      (ref-set (:attr-cols ectx) @(:attr-cols new))
+      (ref-set (:obj-rows ectx) @(:obj-rows new)))
+    (call-many widgets (rho add-widget ectx))))
+
+

 (declare change-attribute-name change-object-name change-incidence-cross)

@@ -510,340 +468,6 @@
                           given 0 new-name)))))
           new-name)))))

-
-
-(defn make-editable-context2
-  "Takes an optional context as input and returns the appropriate
-   editable context structure.
-
-  Parameters:
-    context-in     _context or editable context"
-  ([context-in]
-    (let [ self (promise)
-           ctx (get-context context-in)
-           obj (objects ctx)
-           attr (attributes ctx)
-           inc (incidence ctx)
-           obj-map (map-to-unique-strings obj)
-           attr-map (map-to-unique-strings attr)
-           compatible-obj (map obj-map obj)
-           compatible-attr (map attr-map attr)
-           compatible-inc  (map (fn [x] [(obj-map (first x))
-                                          (attr-map (second x))]) inc)
-           compatible-ctx (make-context compatible-obj
-                            compatible-attr compatible-inc)
-           attr-range (range 1 (+ 1 (count compatible-attr)))
-           obj-range (range 1 (+ 1 (count compatible-obj)))
-
-
-           assoc-widgets   (ref #{})
-           context         (ref compatible-ctx)
-           attr-cols       (ref (conj (zipmap compatible-attr attr-range)
-                                  (zipmap attr-range compatible-attr)))
-           obj-rows        (ref (conj (zipmap compatible-obj obj-range)
-                                  (zipmap obj-range compatible-obj)))
-
-
-           extend-rows-hook
-           (fn-doc "This hook is called when the number of rows is extended by
-  pasting content that is too big for the table.
-
-  Parameters:
-    widget   _the widget object where the paste operation takes place
-    old-rows _the number of rows that were present in the table before
-    new-rows _the number of rows that will be needed for the paste"
-             [table old-rows new-rows]
-             (let [ other-widgets (filter
-                                    (fn [w] (not= (w :table) table))
-                                    @assoc-widgets)]
-               (do
-                 (doseq [w other-widgets] (!!!! (w :table)
-                                            :extend-rows-to new-rows))
-                 (doseq [x (range old-rows new-rows)] (!! table
-                                                        :set-value-at-index x 0
-                                                        "new object")))))
-
-           extend-columns-hook
-           (fn-doc "This hook is called when the number of columns is extended
-  by pasting content that is too big for the table.
-
-  Parameters:
-    widget      _the widget object where the paste operation takes place
-    old-columns _the number of rows that were present in the table before
-    new-columns _the number of rows that will be needed for the paste"
-             [table old-columns new-columns]
-             (let [ other-widgets (filter
-                                    (fn [w] (not= (w :table) table))
-                                    @assoc-widgets)]
-               (do
-                 (doseq [w other-widgets]
-                   (!!!! (w :table) :extend-columns-to new-columns))
-                 (doseq [x (range old-columns new-columns)]
-                   (!! table :set-value-at-index 0 x "new attribute")))))
-
-           update-incidence
-           (fn-doc "This function updates the incidence relation.
-
-  Parameters:
-    object     _the object
-    attribute  _the attribute
-    cross      _true, if object has attribute, false otherwise"
-             [object attribute cross]
-             (dosync-wait (commute context
-                            (fn [x]
-                              (let [ objs (objects x)
-                                     attrs (attributes x)
-                                     inc (incidence x)
-                                     op (if cross conj disj)]
-                                (make-context objs attrs
-                                  (op inc [object attribute])))))))
-
-
-           change-object-name
-           (fn-doc "This function will change the name of the object in
-  the specified row to the new given name, if the new name does not conflict,
-  or otherwise to a conflict free new name; and returns the new name of the
-  object.
-
-  Parameters:
-    model-row      _row of the object in the model
-    req-name       _requested new object name"
-             [model-row req-name]
-             (dosync-wait
-               (let [ objs (objects (get-context @context))
-                      current-name (@obj-rows model-row)
-                      other-objs (disj objs current-name)
-                      new-name (req-unique-string other-objs
-                                 req-name) ]
-                 (do
-                   (if (not= current-name new-name)
-                     (let [ omap (fn [x] (if (= x current-name) new-name x))]
-                       (dosync
-                         (commute context
-                           (fn [x] (let [os (conj (disj (objects x)
-                                                    current-name)
-                                              new-name)
-                                         as (attributes x)
-                                         inc (map
-                                               (fn [x] [ (omap (first x))
-                                                         (second x)])
-                                               (incidence x))]
-                                     (make-context os as inc))))
-                         (commute obj-rows switch-bipartit-auto
-                           model-row current-name
-                           model-row new-name))))
-                   new-name))))
-
-           set-cell-value-hook
-           (fn-doc "This hook is called when a cell's value in the table widget
-  has been changed, the passed contents have to be translated into allowed con-
-  tents that will eventually be set in the widget.
-
-  Parameters:
-    widget     _the widget object
-    row        _integer identifying a row
-    column     _integer identifying a column
-    contents   _the desired new contents
-
-  Returns the new allowed contents for the cell (as string)."
-             [table row column contents]
-             (let [ model-column column
-                    model-row row
-                    good-value
-                    (cond (= model-column model-row 0) "⇊objects⇊"
-                      (= model-row 0)
-                      (let [attrib-cols @attr-cols
-                            current-name (attrib-cols model-column)]
-                        (if (= contents current-name) current-name
-                          (change-attribute-name model-column contents)))
-                      (= model-column 0)
-                      (let [object-rows @obj-rows
-                             current-name (object-rows model-row)]
-                        (if (= contents current-name) current-name
-                          (change-object-name model-row contents)))
-                      true ;else
-                      (let [ cross (string-to-cross contents)
-                             obj-name (@obj-rows model-row)
-                             attr-name (@attr-cols model-column)
-                             fca-ctx (get-context @context)
-                             inc (incidence fca-ctx)
-                             current-state (contains? inc [obj-name attr-name])]
-                        (do
-                          (if (not= current-state cross)
-                            (update-incidence obj-name attr-name cross))
-                          (if cross "X" " ")))
-                      )
-                    other-widgets (filter
-                                    (fn [w] (not= (w :table) table))
-                                    @assoc-widgets)]
-               (do
-                 (doseq [w other-widgets]
-                   (!! (w :table) :update-value-at-index
-                             row column good-value))
-                 good-value)))
-
-
-           set-table-extents
-           (fn-doc "This function will set the row and column count of the
-  table widget to the appropriate sizes.
-
-  Parameters:
-    table  _table widget"
-             [table]
-             (dosync
-               (let [ ctx @context
-                      fca-ctx (get-context ctx)
-                      attrs (attributes fca-ctx)
-                      attr-count (count attrs)
-                      objs (objects fca-ctx)
-                      obj-count (count objs)]
-                 (do
-                   (!! table :set-column-count (+ 1 attr-count))
-                   (!! table :set-row-count (+ 1 obj-count))))))
-
-
-           fill-table-widget
-           (fn-doc "This function will fill the given table widget with the
-  contents of the editable context.
-
-  Parameters:
-    table   _table widget"
-             [table]
-             (dosync
-               (let [ ctx @context
-                      fca-ctx (get-context ctx)
-                      attrs (attributes fca-ctx)
-                      inc (incidence fca-ctx)
-                      get-cross (fn [obj att] (if (contains? inc [obj att])
-                                                "X" " "))
-                      attr-count (count attrs)
-                      objs (objects fca-ctx)
-                      obj-count (count objs)
-                      attrib-cols @attr-cols
-                      object-rows @obj-rows]
-                 (do
-                   (!! table :set-column-count (+ 1 attr-count))
-                   (!! table :set-row-count (+ 1 obj-count))
-                   (!! table :set-value-at-index 0 0 "")
-                   (doseq [x attrs]
-                     (let [column (attrib-cols x)]
-                               (!! table :set-value-at-index 0 column x)))
-                   (doseq [x objs]
-                     (let [row (object-rows x)]
-                               (!! table :set-value-at-index row 0 x)))
-                   (doseq [a attrs]
-                    (doseq [o objs]
-                                 (let [ row (object-rows o)
-                                        column (attrib-cols a)]
-                                   (!! table :set-value-at-index row column
-                                     (get-cross o a)))))))))
-
-
-
-           editable-ctx
-           {:editable-context 1
-           :context context
-           :associated-widgets assoc-widgets
-           :attribute-columns attr-cols
-           :object-rows obj-rows
-
-           :get
-           (fn-doc "Returns the fca-context that is associated with the
-  current state of the editable context."
-             [] (get-context @context))
-
-           :set
-           (fn-doc "Sets the current state of the editable context to the
-  given fca context.
-
-  Parameters:
-    context-in  _(fca) context"
-             [context-in]
-             (let [ ctx (get-context context-in)
-                    obj (objects ctx)
-                    attr (attributes ctx)
-                    inc (incidence ctx)
-                    obj-map (map-to-unique-strings obj)
-                    attr-map (map-to-unique-strings attr)
-                    compatible-obj (map obj-map obj)
-                    compatible-attr (map attr-map attr)
-                    compatible-inc  (map (fn [x] [(obj-map (first x))
-                                                   (attr-map (second x))])
-                                      inc)
-                    compatible-ctx (make-context compatible-obj
-                                     compatible-attr compatible-inc)
-                    attr-range (range 1 (+ 1 (count compatible-attr)))
-                    obj-range (range 1 (+ 1 (count compatible-obj)))
-
-
-
-                    new-attr-cols  (conj (zipmap compatible-attr attr-range)
-                                     (zipmap attr-range compatible-attr))
-                    new-obj-rows   (conj (zipmap compatible-obj obj-range)
-                                     (zipmap obj-range compatible-obj)) ]
-               (do
-                 (dosync-wait
-                   (ref-set context compatible-ctx)
-                   (ref-set attr-cols new-attr-cols)
-                   (ref-set obj-rows new-obj-rows))
-                 (!! @self :update-))))
-
-           :update-
-           (fn-doc "Updates all widgets that are associated with the editable
-  context by forcing a complete table refresh from data."
-             []
-             (let [ widgets @assoc-widgets
-                    tables  (map :table widgets)]
-               (dosync
-                 (doseq [t tables] (set-table-extents t))
-                 (doseq [t tables] (fill-table-widget t)))))
-
-           :remove-widget-
-           (fn-doc "Removes a widget from associated widgets.
-  Parameters:
-    widget     _widget to be removed"
-             [widget]
-             (do
-               (dosync-wait (commute assoc-widgets disj widget))
-               (let [ table (widget :table)
-                      empty-ext-hook (fn-doc "Empty extend hook"
-                                       [widget old-rows new-rows] nil)
-                      empty-val-hook (fn-doc "Empty set cell value hook"
-                        [widget row column contents]
-                        contents)]
-                 (do
-                   (!! table :set-handler-and-wait
-                     :set-cell-value-hook empty-val-hook)
-                   (!! table :set-handler-and-wait
-                     :extend-columns-hook empty-ext-hook)
-                   (!! table :set-handler-and-wait
-                     :extend-rows-hook empty-ext-hook)))))
-
-           :add-widget-
-           (fn-doc "Adds a widget to associated widgets and updates the control
-  accordingly.
-
-  Parameters:
-    widget    _context-widget to be added"
-             [widget]
-             (do
-               (dosync-wait (commute assoc-widgets conj widget))
-               (let [ table (widget :table)]
-                 (do
-                   (!! table :set-handler-and-wait
-                     :set-cell-value-hook set-cell-value-hook)
-                   (!! table :set-handler-and-wait
-                     :extend-columns-hook extend-columns-hook)
-                   (!! table :set-handler-and-wait
-                     :extend-rows-hook extend-rows-hook)
-                   (fill-table-widget table)))))
-          }]
-               (do
-                 (deliver self editable-ctx)
-                 editable-ctx)))
- ([]
-   (make-editable-context (make-context [] [] []))))
-
 (def ctx (conexp.fca/make-context ["a" "b" "c"] [1 2 3] [["a" 1] ["c" 3]]))
 (def ctx2 (make-context #{"Apfel" "Birne" "Möhre" "Gurke"}
             #{"lecker" "geht so" "iieh"}


Add Analytics tracking code to all pages

--- src/foreclojure/utils.clj
+++ src/foreclojure/utils.clj
@@ -1,6 +1,6 @@
 (ns foreclojure.utils
   (:use (hiccup [core :only [html]]
-                [page-helpers :only [doctype include-css]])
+                [page-helpers :only [doctype include-css javascript-tag]])
         [amalloy.utils.transform :only [transform-if]])
   (:require [sandbar.stateful-session :as session]
             (ring.util [response :as response])
@@ -52,7 +52,19 @@
    [:html
     [:head
      [:title "4Clojure"]
-     (include-css "/style.css")]
+     (include-css "/style.css")
+     (javascript-tag
+      " var _gaq = _gaq || [];
+        _gaq.push(['_setAccount', 'UA-22844856-1']);
+        _gaq.push(['_trackPageview']);
+
+        (function() {
+          var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
+          ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
+          var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
+        })();
+"
+      )]
     [:body
      [:div {:id "header"}
       [:img {:id "logo" :src "/logo.png"}]


Bump cljs version, add `:fn-invoke-direct` compiler option

--- build.boot
+++ build.boot
@@ -1,7 +1,7 @@
 (set-env!
   :resource-paths #{"src/main/cljc" "src/spec/cljc" "src/main/js/foreign"}
   :dependencies   '[[org.clojure/clojure         "1.9.0-alpha17"]
-                    [org.clojure/clojurescript   "1.9.562"]
+                    [org.clojure/clojurescript   "1.9.660"]

                     [adzerk/boot-test            "1.2.0"  :scope "test"]
                     [adzerk/boot-reload          "0.5.1"  :scope "test"]
@@ -150,8 +150,9 @@
    i id  VAL str "The id of the build."]
   (boot-cljs/cljs
     :ids              [(fix-slashes (or id "browser/index"))]
-    :compiler-options {:static-fns    true
-                       :optimizations (or opt :none)}))
+    :compiler-options {:static-fns       true
+                       :fn-invoke-direct true
+                       :optimizations    (or opt :none)}))

 (deftask run-browser-repl
   "Compiles the cljs sources, serves them on localhost:3000, and sets up


Revert "Fix repo url on build.boot."

Revert "Fix repo url on build.boot."

This reverts commit 8a120ef3e6746a22a3234bffd6ace5e01c58bb74.

--- build.boot
+++ build.boot
@@ -54,8 +54,8 @@
   (comp (pom :project     'funcool/promesa
              :version     +version+
              :description "A promise library for ClojureScript"
-             :url         "https://github.com/funcool/promesa"
-             :scm         {:url "https://github.com/funcool/promesa"}
+             :url         "https://github.com/funcool/promise"
+             :scm         {:url "https://github.com/funcool/promise"}
              :license     {"BSD (2 Clause)" "http://opensource.org/licenses/BSD-2-Clause"})
         (jar)))


Update boot version

Update boot version

There was a bug in log level keyword namespacing

--- build.boot
+++ build.boot
@@ -51,7 +51,7 @@
                           ;; netty isn't shy about breaking backwards compatibility
                           ;; between build versions.
                           [aleph "0.4.7-alpha3"]
-                          [com.frereth/weald "0.0.4-gacd4108"]
+                          [com.frereth/weald "0.0.4-ga530ad0"]
                           ;; TODO: Eliminate these logging dependencies.
                           ;; I have no business imposing them on library
                           ;; users


update boot file

update boot file

--- build.boot
+++ build.boot
@@ -9,7 +9,7 @@
 (require '[adzerk.bootlaces :refer :all])

-(def +version+ "0.1.0")
+(def +version+ "0.1.0-SNAPSHOT")
 (bootlaces! +version+)

 (task-options!


Small change on build

Small change on build

--- build.boot
+++ build.boot
@@ -2,17 +2,18 @@

 (set-env! :repositories #(conj % ["mavencentral" {:url "https://repo.maven.apache.org/maven2"}])
 	:dependencies '[[org.joml/joml "1.7.1"] [org.lwjgl/lwjgl "3.0.0b"] [org.lwjgl/lwjgl-platform "3.0.0b" :classifier "natives-linux"]]
-	:resource-paths #{"src"})
+	:resource-paths #{"src/"})

 (deftask build
   "Build YAW Project."
   []
   (comp
-	(pom :project 'YAW-project :version "0.1.0")
+	(pom :project 'yaw :version "0.1.0")
 	(javac "./src/gameEngine/*.java")
 	(javac "./src/gameEngine/light/*.java")
-	(jar :file "YAW.jar")
-	(install)))
+;;	(jar :file "YAW.jar")
+;;	(install)
+	))


Reinstate cljs

Reinstate cljs

--- build.boot
+++ build.boot
@@ -140,7 +140,7 @@
   []
   (comp
    (sass :output-style :compressed)
-   #_(cljs :ids #{"edge"} :optimizations :advanced)))
+   (cljs :ids #{"edge"} :optimizations :advanced)))

 (deftask build
   []


Небольшая оптимизация редактора

Небольшая оптимизация редактора

--- radiolamp-6P3S/src/r6p3s/cpt/markdown_editor.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/markdown_editor.cljs
@@ -103,7 +103,8 @@
         (@app :tabs) 1
         (dom/div #js {:style #js {:overflow "auto" :padding 5}
                       :dangerouslySetInnerHTML
-                      #js {:__html (str (md->html (@app :value)))}}
+                      #js {:__html (str (when (-> @app :tabs nav-tabs/active-tab (= 1))
+                                          (md->html (@app :value))))}}
                  nil))))))


Pass the correct directory to build. Closes #13.

We only need to pass the directory for the sample application to the build
function. Dependencies will be found on the classpath.

--- src/lib/clj/one/tools.clj
+++ src/lib/clj/one/tools.clj
@@ -9,7 +9,7 @@
   "Emit both a JavaScript file containing the compiled ClojureScript
   application and the host HTML page."
   [config]
-  (build "src" (assoc (cljs-build-opts config)
-                      :optimizations :advanced
-                      :output-to (str "out/" (production-js config))))
+  (build "src/app/cljs" (assoc (cljs-build-opts config)
+                          :optimizations :advanced
+                          :output-to (str "out/" (production-js config))))
   (spit "out/public/index.html" (application-host config :production)))


tag => tags

tag => tags

--- src/lepo/page.clj
+++ src/lepo/page.clj
@@ -3,10 +3,11 @@
             [clojure.string :as string]))

 (def posts-path "posts")
+(def tags-path "tags")

 (defn tag-uri
   [tag]
-  (utils/uri "tag" (str tag ".html")))
+  (utils/uri tags-path (str tag ".html")))

 (def archive-uri
   (utils/uri posts-path "index.html"))


don't need to pull in `om.dom`

don't need to pull in `om.dom`

use `js/React.createElement` instead

--- src/main/devcards_om_next/core.cljs
+++ src/main/devcards_om_next/core.cljs
@@ -3,9 +3,7 @@
                    [devcards-om-next.core :refer [om-next-root defcard-om-next]])
   (:require [devcards.core :as dc]
             [devcards.util.utils :refer [html-env?]]
-            [om.next]
-            [om.dom :as dom]))
-
+            [om.next]))

 (defonce-react-class OmNextNode
   #js {:getInitialState
@@ -89,6 +87,6 @@
                  options (:options card)
                  unique-id (dc/get-state this :omnext$unique-id)
                  data_atom (dc/get-state this :data_atom)
-                 main (cond->> (dom/div #js {:id unique-id})
+                 main (cond->> (js/React.createElement "div" #js {:id unique-id})
                         (false? (:watch-atom options)) (dc/dont-update (dc/get-state this :state_change_count)))]
              (dc/render-all-card-elements main data_atom card))))})


simple mapper now works with {} or #{} (still default), get-fn implemented

--- src/net_ns/server/simple_mapper.clj
+++ src/net_ns/server/simple_mapper.clj
@@ -10,7 +10,8 @@
       ([client-map host]
        (assoc client-map host #{}))
       ([client-map host init-set]
-       (if (instance? clojure.lang.PersistentHashSet init-set)
+       (if (some #(instance? % init-set) [clojure.lang.PersistentHashSet
+                                          clojure.lang.PersistentArrayMap])
          (assoc client-map host init-set)
          (register-client client-map host))))

@@ -30,6 +31,8 @@
       (dissoc-in client-map [host f]))

     (get-fn
-      ([client-map f])
-      ([client-map f host])))
+      ([client-map f]
+       (some #(get-in client-map [% f]) (keys client-map)))
+      ([client-map f host]
+       (get-in client-map [host f]))))


Fix a.l.component.handler specs definition

Reuse reitit.spec specs

--- backend/src/akvo/lumen/component/handler.clj
+++ backend/src/akvo/lumen/component/handler.clj
@@ -4,6 +4,7 @@
             [akvo.lumen.specs.components :refer [integrant-key]]
             [akvo.lumen.endpoint.commons :as commons]
             [reitit.ring :as ring]
+            [reitit.spec :as rs]
             [reitit.coercion.spec]
             [clojure.tools.logging :as log]
             [muuntaja.core :as m]
@@ -30,9 +31,9 @@
 (defmethod ig/init-key :akvo.lumen.component.handler/handler-verify  [_ {:keys [path middleware routes] :as opts}]
   [path {:middleware middleware} routes])

-(s/def ::endpoints any? #_(s/map-of string? (s/coll-of vector? :distinct true)))
+(s/def ::endpoints  (s/coll-of ::rs/raw-routes))

-(s/def ::middleware any? #_(s/coll-of fn? :distinct true))
+(s/def ::middleware (s/coll-of fn? :distinct true))

 (s/def ::config (s/keys :req-un [::endpoints ::middleware]))


Refactor

Refactor

--- backend/src/akvo/lumen/component/handler.clj
+++ backend/src/akvo/lumen/component/handler.clj
@@ -17,10 +17,9 @@

 (defmethod ig/init-key :akvo.lumen.component.handler/handler  [_ {:keys [endpoints middleware handler] :as opts}]
   (if-not handler
-    (let [routes  endpoints
-          handler (ring/ring-handler
-                   (ring/router routes
-                                {:data {:middleware middleware}
+    (let [handler (ring/ring-handler
+                   (ring/router endpoints
+                                {:data      {:middleware middleware}
                                  :conflicts (constantly nil)}))]
       (assoc opts :handler handler))
     opts))


Improve comments

Improve comments

--- src/re_frame/middleware.cljs
+++ src/re_frame/middleware.cljs
@@ -17,7 +17,7 @@
   "Acts as an adaptor, allowing handlers to be writen as pure functions.
   The re-frame router will pass in an atom as the first parameter. This middleware
   adapts that to the value within the atom.
-  If you strip away the error/efficiency checks, this middleware does this:
+  If you strip away the error/efficiency checks, this middleware is just:
      (reset! app-db (handler @app-db event-vec))"
   [handler]
   (fn new-handler
@@ -36,7 +36,7 @@

 (defn debug
-  "Middleware which logs (console) debug information for each event.
+  "Middleware which logs debug information to js/console for each event.
   Includes a clojure.data/diff of the db, before vs after, showing changes."
   [handler]
   (fn new-handler
@@ -62,8 +62,13 @@

 (defn trim-v
-  "Middleware which removes the first element of v. It means you can write
-  more asthetically pleasing handlers"
+  "Middleware which removes the first element of v. Its use means you can write
+  more asthetically pleasing handlers.
+  Your handlers will look like this:
+      (defn my-handler
+        [db [x y z]]    ;; <-- instead of [_ x y z]
+        ....)
+  "
   [handler]
   (fn new-handler
     [db v]
@@ -71,9 +76,9 @@

 (defn path
-  "Supplies a sub-tree of `app-db` to the handler.
+  "Supplies a sub-tree of `db` to the handler. A narrowed view.
   Assumes \"pure\" is in the middleware pipeline prior.
-  Grafts the result back into app-db."
+  Grafts the result back into db."
   [p]
   (fn middleware
     [handler]


satellite-master: Fix nesting of black hole detection filters.

--- satellite-master/config/riemann-config.clj
+++ satellite-master/config/riemann-config.clj
@@ -23,10 +23,10 @@
 (def task-totals-time-stream
   (by :host
       (combine difference-since-beginning
-               (project [(service "mesos/slave/total-tasks-failed")
-                         (service "mesos/slave/total-tasks-started")
-                         (service "mesos/slave/total-tasks-finished")]
-                        (where (> (:interval event) 600)
+               (where (> (:interval event) 600)
+                      (project [(service "mesos/slave/total-tasks-failed")
+                                (service "mesos/slave/total-tasks-started")
+                                (service "mesos/slave/total-tasks-finished")]
                                (smap (partial fold-blackhole-thresholds satellite.core/settings)
                                      (where (state "critical")
                                             #(warn "Host failing too many tasks:" %)


def out the common base gears, and make svg max width

--- src/parinfer/core.cljs
+++ src/parinfer/core.cljs
@@ -112,26 +112,29 @@

   (js/scrollMonitor.recalculateLocations))

+(def base-gears
+  {:paren  {:x 240 :y 70
+            :factor 96 ;:hole-radius 0.5
+            :classes ["paren-gear"]
+            :caption {:text "Parens" :side :left}}
+   :indent {:x 460 :y 70
+            :factor 96
+            :classes ["indent-gear"]
+            :caption {:text "Indentation" :side :right}
+            }})
+
 (defn create-index-gears!
   []
   (create-gears!
     "#naive-gears"
-    {:init-gears {:paren  {:x 240 :y 70
-                           :factor 96 ;:hole-radius 0.5
-                           :classes ["paren-gear"]
-                           :caption {:text "Parens" :side :left}}
-                  :indent {:x 460 :y 70
-                           :factor 96
-                           :classes ["indent-gear"]
-                           :caption {:text "Indentation" :side :right}
-                           }}
+    {:init-gears base-gears
      :anim-frames [{:gear-attrs {:paren {:power 0.01}
                                  :indent {:power 0}}
                     :dt 1000}
                    {:gear-attrs {:paren {:power 0}
                                  :indent {:power -0.01}}
                     :dt 1000}]}
-    {:width 722
+    {:width "100%"
      :height 200}))

 (defn render-index! []


hardcode freesound sampled-piano ids so that a search doesn't have to be made to load them in (requiring a network connection)


Fix missing adzerk.env dependency

Fix missing adzerk.env dependency

--- resources/leiningen/new/lambone/common/build.boot
+++ resources/leiningen/new/lambone/common/build.boot
@@ -45,7 +45,8 @@
                     ;; dev only
                     [boot/core "2.6.0" :scope "test"]
                     [boot/pod "2.6.0" :scope "test"]
-                    [adzerk/boot-test "1.1.1" :scope "test"]])
+                    [adzerk/boot-test "1.1.1" :scope "test"]
+                    [adzerk/env "0.3.0" :scope "test"]])
 <% endif %><% if any frontend %>
 ;; All the deps are "test" because they are only need for compiling to
 ;; JavaScript, not "real" project dependencies.


Fix missing paren, sorry about that

Fix missing paren, sorry about that

--- resources/leiningen/new/lambone/common/build.boot
+++ resources/leiningen/new/lambone/common/build.boot
@@ -164,7 +164,7 @@
    :cljs-repl {:nrepl-opts {:port 5088}}
    :test-cljs {:suite-ns '<<project-ns>>.suite}
    :serve {:dir "assets"
-           :port 8000})
+           :port 8000}})

 (defmethod boot/options [:frontend :dev]
   [selection]


more informative error message

more informative error message

--- src/polismath/math/conversation.clj
+++ src/polismath/math/conversation.clj
@@ -652,7 +652,7 @@
                       group-votes)
                     extremity (or (get extremities tid)
                                   (do
-                                    (log/warn "No extremity for tid" tid)
+                                    (log/warn "No extremity for tid" tid "zid" (:zid conv))
                                     ;; Default to 0 just in case, but this shouldn't happen (bugfix)
                                     0))]
                 (priority-metric (meta-tids tid) A P S extremity)))


More aggressive error messages

More aggressive error messages

--- src/protobuf/codec.clj
+++ src/protobuf/codec.clj
@@ -13,8 +13,13 @@
   (let [proto (protodef proto)
         min   (alength (protobuf-dump proto {:_len 0}))
         max   (alength (protobuf-dump proto {:_len Integer/MAX_VALUE}))]
-    (when-not (= min max)
-      (throw (Exception. "_len must be of type fixed32 or fixed64")))
+    (letfn [(check [test msg]
+              (when test
+                (throw (Exception. (format "In %s: %s" (.getFullName proto) msg)))))]
+      (check (zero? min)
+             "_len field is required for repeated protobufs")
+      (check (= min max)
+             "_len must be of type fixed32 or fixed64"))
     (gloss/compile-frame (gloss/finite-frame max (protobuf-codec proto))
                          #(hash-map :_len %)
                          :_len)))


[#2127] Add groupName and groupId in static groups response

--- backend/src/akvo/lumen/lib/dataset.clj
+++ backend/src/akvo/lumen/lib/dataset.clj
@@ -135,7 +135,13 @@
                                  {:as-arrays? true}))]
       (-> (select-keys dataset [:updated :created :modified])
           remove-token
-          (assoc :rows data :columns columns :status "OK" :datasetId id :groupId group-id)))))
+          (assoc :rows data
+                 :columns (map (fn [col]
+                                 (cond-> col
+                                   true (assoc "groupId" group-id)
+                                   (contains? #{"main" "transformations" "metadata"} group-id)
+                                   (assoc "groupName" group-id))) columns)
+                 :status "OK" :datasetId id :groupId group-id)))))

 (defn sort-text
   [tenant-conn id column-name limit order]


[#3091] Give more time to try async op

[#3091] Give more time to try async op

--- backend/test/akvo/lumen/test_utils.clj
+++ backend/test/akvo/lumen/test_utils.clj
@@ -41,7 +41,7 @@
 (defn retry-job-execution [tenant-conn job-execution-id with-job? & [job-type silent-exception?]]
   (let [res (dh/with-retry {:retry-if (fn [v e] (not v))
                             :max-retries 20
-                            :delay-ms 100}
+                            :delay-ms 300}
               (let [job (job-execution-by-id tenant-conn {:id job-execution-id})
                     ds-job (when (= :import job-type) (datasource-job-execution-by-id tenant-conn {:id job-execution-id}))
                     status (:status job)
@@ -93,7 +93,7 @@
 (defn try-latest-dataset-version-2 [conn dataset-id & [version]]
   (let [res (dh/with-retry {:retry-if (fn [v e] (not v))
                         :max-retries 20
-                        :delay-ms 100}
+                        :delay-ms 300}
           (if version
             (db.dataset-version/dataset-version-2-by-dataset-id-and-version
              conn


helpers for finding canvas edges

helpers for finding canvas edges

--- src-cljs/frontend/camera.cljs
+++ src-cljs/frontend/camera.cljs
@@ -55,6 +55,34 @@
         (update-in [:x] (fn [x] (+ x (* (- x_s x) (- 1 (/ new-zf old-zf))))))
         (update-in [:y] (fn [y] (+ y (* (- y_s y) (- 1 (/ new-zf old-zf)))))))))

+(defn x-left [camera viewport]
+  (/ (- (:x camera)) (:zf camera)))
+
+(defn x-right [camera viewport]
+  (+ (/ (:width viewport) (:zf camera)) (x-left camera viewport)))
+
+(defn y-top [camera viewport]
+  (/ (- (:y camera)) (:zf camera)))
+
+(defn y-bottom [camera viewport]
+  (+ (/ (:height viewport) (:zf camera)) (y-top camera viewport)))
+
+(defn top-left [camera viewport]
+  [(x-left camera viewport)
+   (y-top camera viewport)])
+
+(defn top-right [camera viewport]
+  [(x-right camera viewport)
+   (y-top camera viewport)])
+
+(defn bottom-left [camera viewport]
+  [(x-left camera viewport)
+   (y-bottom camera viewport)])
+
+(defn bottom-right [camera viewport]
+  [(x-right camera viewport)
+   (y-bottom camera viewport)])
+
 (defn move-camera [camera dx dy]
   (-> camera
    (update-in [:x] + dx)


Redirect docs to Cloud in Enterprise.

Redirect docs to Cloud in Enterprise.

--- src-cljs/frontend/routes.cljs
+++ src-cljs/frontend/routes.cljs
@@ -1,11 +1,7 @@
 (ns frontend.routes
-  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
-            [clojure.string :as str]
+  (:require [clojure.string :as str]
             [frontend.async :refer [put!]]
-            [goog.events :as events]
-            [frontend.models.project :as proj-mod]
-            [frontend.utils.docs :as doc-utils]
-            [frontend.utils :as utils :include-macros true]
+            [frontend.config :as config]
             [secretary.core :as sec :include-macros true :refer-macros [defroute]])
   (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]))

@@ -119,9 +115,13 @@
     (logout! nav-ch))

   (defroute v1-doc "/docs" []
-    (open-to-outer! nav-ch :documentation {}))
+    (if (config/enterprise?)
+      (.replace js/location "https://circleci.com/docs")
+      (open-to-outer! nav-ch :documentation {})))
   (defroute v1-doc-subpage (FragmentRoute. "/docs/:subpage") {:keys [subpage] :as params}
-    (open-to-outer! nav-ch :documentation (assoc params :subpage (keyword subpage))))
+    (if (config/enterprise?)
+      (.replace js/location (str "https://circleci.com/docs/" subpage))
+      (open-to-outer! nav-ch :documentation (assoc params :subpage (keyword subpage)))))

   (defroute v1-about (FragmentRoute. "/about") {:as params}
     (open-to-outer! nav-ch :about (assoc params


Proposed fix

Proposed fix

--- src/re_frame/subs.cljc
+++ src/re_frame/subs.cljc
@@ -185,7 +185,7 @@
       query-id
       (fn subs-handler-fn
         ([db query-vec]
-         (let [subscriptions (inputs-fn query-vec)
+         (let [subscriptions (inputs-fn query-vec nil)
                reaction-id   (atom nil)
                reaction      (make-reaction
                                (fn []


on-dispose should always be called in Reaction

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -121,7 +121,7 @@
                                      (dissoc cached-reactions key))
                                (when (some? obj)
                                  (set! (.-reaction obj) nil))
-                               (when (some-> destroy .-destroy)
+                               (when (some-> destroy .-destroy some?)
                                  (.destroy destroy))))
             v (-deref r)]
         (set! cached-reactions (assoc cached-reactions key r))
@@ -129,7 +129,7 @@
           (set! (.-reaction obj) r))
         v)
       (let [res (f)]
-        (when (some-> destroy .-destroy)
+        (when (some-> destroy .-destroy some?)
           (.destroy destroy))
         res))))

@@ -401,14 +401,19 @@
   IDeref
   (-deref [this]
     (-check-clean this)
-    (if (and (nil? auto-run) (nil? *ratom-context*))
-      (when-not (== dirtyness clean)
-        (let [oldstate state
-              newstate (f)]
-          (set! state newstate)
-          (when (and (some? watches)
-                     (not= oldstate newstate))
-            (-notify-watches this oldstate newstate))))
+    (if (and (nil? *ratom-context*)
+             (nil? auto-run))
+      (do
+        (when-not (== dirtyness clean)
+          (let [oldstate state
+                newstate (f)]
+            (set! state newstate)
+            (when (and (some? watches)
+                       (not= oldstate newstate))
+              (-notify-watches this oldstate newstate))))
+        (when (and (some? on-dispose)
+                   (nil? watches))
+          (on-dispose)))
       (do
         (notify-deref-watcher! this)
         (when-not (== dirtyness clean)


Fix bind checking in slack mk-sender

Fix bind checking in slack mk-sender

--- src/yetibot/core/adapters/slack.clj
+++ src/yetibot/core/adapters/slack.clj
@@ -64,7 +64,7 @@

 (defn mk-sender-with-verified-bindings [f]
   (fn [msg]
-    (if (bound? *config* *conn*)
+    (if (and *config* @*conn*)
       (f msg)
       (let [[conn config] (determine-conn-and-config-from-chat-source-hash)]
         (binding [*conn* conn


Use binding form to be consistent

Use binding form to be consistent

--- src/runbld/util/io.clj
+++ src/runbld/util/io.clj
@@ -47,8 +47,9 @@
         (flush))

       ;; write to the logfile
-      (.println logfile line)
-      (.flush logfile)
+      (binding [*out* logfile]
+        (println line)
+        (flush))

       ;; update the stats
       (swap! bs + (inc ;; for the newline


Add version of (arc) that takes optional mode parameter. Close #76.

--- src/quil/core.clj
+++ src/quil/core.clj
@@ -145,8 +145,7 @@
   with emissive, specular, and shininess in setting the material
   properties of shapes."
   [rgb]
-  (.ambient
-   (current-surface) (int rgb)))
+  (.ambient (current-surface) (int rgb)))

 (defn
   ^{:requires-bindings true
@@ -198,16 +197,23 @@
   inverse of the transform, so avoid it whenever possible. The
   equivalent function in OpenGL is glMultMatrix()."
   ([n00 n01 n02 n10 n11 n12]
-     (.applyMatrix (current-surface) (float n00) (float n01) (float n02)
+     (.applyMatrix (current-surface)
+                   (float n00) (float n01) (float n02)
                    (float n10) (float n11) (float n12)))
   ([n00 n01 n02 n03
     n10 n11 n12 n13
     n20 n21 n22 n23
     n30 n31 n32 n33]
-     (.applyMatrix (current-surface) (float n00) (float n01) (float n02) (float 03)
+     (.applyMatrix (current-surface)
+                   (float n00) (float n01) (float n02) (float 03)
                    (float n10) (float n11) (float n12) (float 13)
                    (float n20) (float n21) (float n22) (float 23)
                    (float n30) (float n31) (float n32) (float 33))))
+
+(def ^{:private true}
+  arc-modes {:open PConstants/OPEN
+             :chord PConstants/CHORD
+             :pie PConstants/PIE})

 (defn
   ^{:requires-bindings true
@@ -220,10 +226,14 @@
   edge of an ellipse defined by the x, y, width and height
   parameters. The origin or the arc's ellipse may be changed with the
   ellipseMode() function. The start and stop parameters specify the
-  angles at which to draw the arc."
-  [x y width height start stop]
-  (.arc (current-surface) (float x)(float y) (float width) (float height)
+  angles at which to draw the arc. The mode is either :open, :chord or :pie."
+  ([x y width height start stop]
+    (.arc (current-applet) (float x) (float y) (float width) (float height)
         (float start) (float stop)))
+  ([x y width height start stop mode]
+    (let [arc-mode (resolve-constant-key mode arc-modes)]
+      (.arc (current-applet) (float x) (float y) (float width) (float height)
+        (float start) (float stop) (int arc-mode)))))

 (defn
   ^{:requires-bindings false


clean up a few things.

clean up a few things.

--- src/metabase/api/user.clj
+++ src/metabase/api/user.clj
@@ -29,26 +29,24 @@
   ;; TODO - permissions check
   ;; TODO - validations (email address must be unique)
   (let-404 [user (sel :one User :id user-id)]
-    ;; TODO - how can we pass a useful error message in the 500 response on error?
-    (do
-     ;; TODO - is there a more idiomatic way to do this?  update row, then select it for output
-     (upd User user-id
-          ;; TODO - find a way to make this cleaner.  we don't want to modify the value if it doesn't exist
-          :email (get body :email (:email user))
-          :first_name (get body :first_name (:first_name user))
-          :last_name (get body :last_name (:last_name user)))
-     (let [updated-user (sel :one User :id user-id)]
-       (select-keys updated-user [:id :email :first_name :last_name :last_login :is_superuser])))))
-
-
-(defendpoint PUT "/:user-id/password" [user-id :as {body :body}]
-  ;; TODO - password validation
-  ;; TODO - match old password against current one
-  (let-404 [user (sel :one User :id user-id)]
     (upd User user-id
-         :password (get body :password))
+      :email (get body :email (:email user))
+      :first_name (get body :first_name (:first_name user))
+      :last_name (get body :last_name (:last_name user)))
     (let [updated-user (sel :one User :id user-id)]
       (select-keys updated-user [:id :email :first_name :last_name :last_login :is_superuser]))))

+(defendpoint PUT "/:user-id/password" [user-id :as {body :body}]
+  (if-not (and (:old_password body) (:password body))
+    {:status 400 :body "You must specifby both old_password and password"}
+    (let-404 [user (sel :one User :id user-id)]
+      ;; TODO - match old password against current one
+      ;; TODO - password encryption
+      (upd User user-id
+        :password (get body :password))
+      (let [updated-user (sel :one User :id user-id)]
+        (select-keys updated-user [:id :email :first_name :last_name :last_login :is_superuser])))))
+
+
 (define-routes)


run chrome headless

run chrome headless

--- test/functional/functional_test.clj
+++ test/functional/functional_test.clj
@@ -13,6 +13,7 @@
             [clojure.java.io :refer [make-parents]]
             [environ.core :refer [env]])
   (:import org.openqa.selenium.chrome.ChromeDriver
+           org.openqa.selenium.chrome.ChromeOptions
            org.openqa.selenium.firefox.FirefoxDriver
            org.openqa.selenium.Dimension
            io.github.bonigarcia.wdm.ChromeDriverManager
@@ -30,7 +31,10 @@
     :firefox (do (.setup (FirefoxDriverManager/getInstance))
                  (FirefoxDriver.))
     (do (.setup (ChromeDriverManager/getInstance))
-        (ChromeDriver.))))
+        (let [options (ChromeOptions.)]
+          (do
+            (.addArguments options ["--headless" "--disable-gpu"])
+            (ChromeDriver. options))))))

 (defn functional-fixture [test-fn]
   (let [driver (create-driver)]


Fix failing interceptor test

Fix failing interceptor test

--- test/re_frame/interceptor_test.cljs
+++ test/re_frame/interceptor_test.cljs
@@ -112,11 +112,11 @@

 (deftest test-fx-handler-interceptor
   (let [event   [:a :b]
-        coeffect {:db 4 :event event}
+        coeffect {:db 4 :event event :original-event event}
         effect   {:db 5 :dispatch [:a]}

         handler (fn [world v]
-                  ;; make sure it was given the right arguements
+                  ;; make sure it was given the right arguments
                   (is (= world coeffect))
                   (is (= v event))


Fix failing test after previous commit

Fix failing test after previous commit


add collect! & score methods to IVertex proto, switch to namespaced KWs in vertex state, add support for edge opts (i.e. weights), simplify async-context execute! & update to produce result map via promise, update example (SSSP)

--- src/thi/ng/fabric/async.cljc
+++ src/thi/ng/fabric/async.cljc
@@ -4,15 +4,19 @@
    [taoensso.timbre :refer [info warn error]]))

 (defprotocol IVertex
-  (connect-to! [_ v sig-fn])
+  (connect-to! [_ v sig-fn edge-opts])
   (disconnect-from! [_ v])
   (disconnect! [_])
   (input-channel [_])
+  (collect! [_])
+  (score-collect [_])
   (signal! [_])
+  (score-signal [_])
   (receive-signal [_ src sig]))

 (defprotocol IComputeGraph
   (add-vertex! [_ vstate])
+  (vertex-for-id [_ id])
   (vertices [_]))

 (defprotocol IGraphExecutor
@@ -20,44 +24,61 @@

 (defn default-collect
   [vertex]
-  (swap! (:state vertex) #(update % :val into (:uncollected %))))
-
-(defn signal-forward [state] (:val state))
+  (swap! (:state vertex) #(update % ::val into (::uncollected %))))
+
+(defn signal-forward
+  [state _] (::val state))

 (defn default-score-signal
-  [{:keys [state last-sig-state] :as vertex}]
-  (if (= (:val @state) @last-sig-state) 0 1))
+  "Computes vertex signal score. Returns 0 if state's ::val
+  equals :last-sig-state, else returns 1."
+  [{:keys [state last-sig-state]}]
+  (if (= (::val @state) @last-sig-state) 0 1))

 (defn default-score-collect
-  [vertex] (-> vertex :state deref :uncollected count))
+  "Computes vertex collect score, here simply the number
+  of ::uncollected signal values."
+  [vertex] (-> vertex :state deref ::uncollected count))

 (defn should-signal?
-  [vertex thresh]
-  (> ((-> vertex :state deref :score-signal) vertex) thresh))
+  [vertex thresh] (> (score-signal vertex) thresh))

 (defn should-collect?
-  [vertex thresh]
-  (> ((-> vertex :state deref :score-collect) vertex) thresh))
+  [vertex thresh] (> (score-collect vertex) thresh))

 (defrecord Vertex [id state last-sig-state in outs]
+  clojure.lang.IDeref
+  (deref [_] (::val @state))
   IVertex
+  (collect! [_] ((::collect-fn @state) _))
+  (score-collect [_] ((::score-collect-fn @state) _))
   (connect-to!
-    [_ v sig-fn]
-    (swap! outs assoc v sig-fn) _)
+    [_ v sig-fn opts]
+    (info (format "%d connecting to %d (%s)" id (:id v) (pr-str opts)))
+    (swap! outs assoc v [sig-fn opts]) _)
   (disconnect-from!
-    [_ v] (swap! outs dissoc v) _)
+    [_ v]
+    (info (format "%d disconnecting from %d" id (:id v)))
+    (swap! outs dissoc v)
+    _)
   (disconnect! [_]
-    (close! in) _)
+    (info (format "%d disconnecting..." id))
+    (close! in)
+    _)
   (input-channel
     [_] in)
+  (score-signal [_] ((::score-signal-fn @state) _))
   (signal!
     [_]
     (let [state @state]
-      (reset! last-sig-state (:val state))
+      (reset! last-sig-state (::val state))
       (go-loop [outs @outs]
-        (let [[v f] (first outs)]
+        (let [[v [f opts]] (first outs)]
           (when v
-            (>! (input-channel v) [id (f state)])
+            (let [signal (f state opts)]
+              (if-not (nil? signal)
+                (>! (input-channel v) [id signal])
+                (warn (format "signal fn for %d return nil, skipping..." (:id v)))))
             (recur (next outs)))))
       _))
   (receive-signal
@@ -65,23 +86,28 @@
     (swap! state
            (fn [state]
              (-> state
-                 (update :uncollected conj sig)
-                 (assoc-in [:signal-map src] sig))))
+                 (update ::uncollected conj sig)
+                 (assoc-in [::signal-map src] sig))))
     _))

+#?(:clj
+   (defmethod clojure.pprint/simple-dispatch Vertex
+     [^Vertex o] ((get-method clojure.pprint/simple-dispatch clojure.lang.IPersistentMap) o)))
+#?(:clj
+   (defmethod print-method Vertex
+     [^Vertex o ^java.io.Writer w] (.write w (.toString (into {} o)))))
+
 (def default-vertex-state
-  {:uncollected       []
-   :signal-map        {}
-   :score-collect     default-score-collect
-   :score-signal      default-score-signal
-   :collect-fn        default-collect})
+  {::uncollected      []
+   ::signal-map       {}
+   ::score-collect-fn default-score-collect
+   ::score-signal-fn  default-score-signal
+   ::collect-fn       default-collect})

 (def default-context-opts
   {:collect-thresh 0
    :signal-thresh  0
-   :collections    0
-   :signals        0
-   :timeout        1000
+   :timeout        100
    :max-ops        1e6})

 (defn vertex
@@ -107,6 +133,8 @@
                  (update :vertices assoc id v)
                  (assoc  :curr-vertex v)))))
         :curr-vertex))
+  (vertex-for-id
+    [_ id] (-> @state :vertices id))
   (vertices
     [_] (-> @state :vertices vals)))

@@ -119,18 +147,25 @@
     (go-loop []
       (let [[src-id sig] (<! in)]
         (if sig
-          (do (info id "receive from " src-id sig)
+          (do (info id "receive from" src-id sig)
               (receive-signal vertex src-id sig)
               (when (should-collect? vertex collect-thresh)
                 (when (>! ctrl [:collect id])
-                  ((:collect-fn @state) vertex)
-                  (swap! state assoc :uncollected [])
+                  (collect! vertex)
+                  (swap! state assoc ::uncollected [])
                   (when (should-signal? vertex signal-thresh)
                     (>! ctrl [:signal id])
                     (signal! vertex))))
               (recur))
-          (info id "disconnected"))))
+          (info id "stopped"))))
     vertex))
+
+(defn execution-result
+  [p t0 colls sigs]
+  (deliver
+   p {:collections colls
+      :signals     sigs
+      :time        (* (- (System/nanoTime) t0) 1e-6)}))

 (defn async-context
   [opts]
@@ -138,46 +173,75 @@
         ctx      (merge default-context-opts {:ctrl ctrl} opts)
         c-thresh (:collect-thresh ctx)
         s-thresh (:signal-thresh ctx)
-        ctx      (atom ctx)]
+        max-ops  (:max-ops ctx)
+        max-t    (:timeout ctx)]
     (reify
       clojure.lang.IDeref
-      (deref [_] @ctx)
+      (deref [_] ctx)
       IGraphExecutor
-      (execute! [_ vertices]
-        (go
-          (loop [verts vertices]
-            (when-let [v (first verts)]
-              (when (should-signal? v s-thresh)
-                (signal! v))
-              (recur (next verts))))
-          (loop []
-            (if (<= (+ (:collections @ctx) (:signals @ctx)) (:max-ops @ctx))
-              (let [t (timeout (:timeout @ctx))
-                    [[evt v ex] port] (alts! [ctrl t])]
-                (if (= port t)
-                  (info "graph converged, done...")
-                  (case evt
-                    :collect (do (swap! ctx update :collections inc) (recur))
-                    :signal  (do (swap! ctx update :signals inc) (recur))
-                    :error   (warn ex "@ vertex" v)
-                    (info "done" (:collections @ctx) (:signals @ctx)))))
-              (info "reached max ops: " (:max-ops @ctx)))))))))
+      (execute! [_ g]
+        (let [t0  (System/nanoTime)
+              res (promise)]
+          (go
+            (loop [verts (vertices g)]
+              (when-let [v (first verts)]
+                (when (should-collect? v c-thresh)
+                  ((-> v :state deref ::collect-fn) vertex))
+                (when (should-signal? v s-thresh)
+                  (signal! v))
+                (recur (next verts))))
+            (loop [colls 0 sigs 0]
+              (if (<= (+ colls sigs) max-ops)
+                (let [t (timeout max-t)
+                      [[evt v ex] port] (alts! [ctrl t])]
+                  (if (= port t)
+                    (do (info "graph converged, done...")
+                        (execution-result res t0 colls sigs))
+                    (case evt
+                      :collect (recur (inc colls) sigs)
+                      :signal  (recur colls (inc sigs))
+                      :error   (warn ex "@ vertex" v)
+                      (do (info "wrong event" evt v)))))
+                (do (info "reached max ops: " max-ops)
+                    (execution-result res t0 colls sigs)))))
+          res)))))

 (def g (compute-graph))
 (def ctx (async-context {}))

-(def a (eager-async-vertex (add-vertex! g {:val 'a :collect-fn default-collect}) ctx))
-(def b (eager-async-vertex (add-vertex! g {:val '[b] :collect-fn default-collect}) ctx))
-(def c (eager-async-vertex (add-vertex! g {:val '[c] :collect-fn default-collect}) ctx))
-
-(connect-to! a b signal-forward)
-(connect-to! a c signal-forward)
-(connect-to! b c signal-forward)
-
-(execute! ctx (vertices g))
+(defn signal-sssp
+  [state dist] (if-let [v (::val state)] (+ dist v)))
+
+(defn collect-sssp
+  [vertex]
+  (swap! (:state vertex)
+         (fn [{:keys [val] :as state}]
+           (update state ::val
+                   (if val
+                     (fn [_] (reduce min _ (::uncollected state)))
+                     (fn [_] (reduce min (::uncollected state))))))))
+
+(def a (eager-async-vertex (add-vertex! g {::val 0   ::collect-fn collect-sssp}) ctx))
+(def b (eager-async-vertex (add-vertex! g {::val nil ::collect-fn collect-sssp}) ctx))
+(def c (eager-async-vertex (add-vertex! g {::val nil ::collect-fn collect-sssp}) ctx))
+(def d (eager-async-vertex (add-vertex! g {::val nil ::collect-fn collect-sssp}) ctx))
+
+(connect-to! a b signal-sssp 1)
+(connect-to! a c signal-sssp 3)
+(connect-to! b c signal-sssp 1)
+(connect-to! c d signal-sssp 1)
+
+(prn @(execute! ctx g))
+
+(prn @a)
+(prn @b)
+(prn @c)
+(prn @d)
+

 (comment
   (disconnect! a)
   (disconnect! b)
   (disconnect! c)
+  (disconnect! d)
   )


changed predicate from italian venire to english come

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -200,7 +200,7 @@
                      :sem {:pred :check}}}

    "come" {:synsem {:cat :verb
-                    :sem {:pred :venire}}
+                    :sem {:pred :come}}
            :english {:past "came"}}

    "comment" {:synsem {:cat :verb


added Juan y yo

added Juan y yo

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -276,6 +276,17 @@
              {:synsem {:cat :verb
                        :sem {:pred :talk
                              :subj {:human true}}}}]
+
+    "Juan y yo"
+      [{:synsem {:cat :noun
+                 :pronoun true
+                 :case :nom
+                 :agr {:gender :masc
+                       :person :1st
+                       :number :plur}
+                 :sem {:human true
+                       :pred :Juan-and-I}
+                 :subcat '()}}]

    "la"
    (unify determiner


Fix email on copyright notice on middleware ns.

--- src/buddy/auth/middleware.clj
+++ src/buddy/auth/middleware.clj
@@ -1,4 +1,4 @@
-;; Copyright 2013-2015 Andrey Antukh <niwi@niwi.be>
+;; Copyright 2013-2015 Andrey Antukh <niwi@niwi.nz>
 ;;
 ;; Licensed under the Apache License, Version 2.0 (the "License")
 ;; you may not use this file except in compliance with the License.


Don't force set partition.

Don't force set partition.

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -250,13 +250,6 @@
                   {:recoverable? false
                    :payload m}))

-          (nil? message-partition)
-          (throw (ex-info
-                  (str "Unable to write message payload to Kafka! "
-                       "Both :kafka/partition, and :partition in message payload "
-                       "are missing!")
-                  {:recoverable? false
-                   :payload m}))
           :else
           (ProducerRecord. message-topic message-partition k (serializer-fn message)))))


Calc number of points in the 'calc-size' command

--- src/whisper2cyanite/core.clj
+++ src/whisper2cyanite/core.clj
@@ -25,6 +25,7 @@
 (def pstore-error-files (atom (sorted-set)))

 (def cassandra-data-size (atom 0))
+(def points-count (atom 0))

 (defprotocol Processor
   (process-metrics [this rollup period retention points path file series])
@@ -141,7 +142,8 @@
               index-size (+ part-key-size (* clust-col-size points))
               rows-size (* row-size points)
               archive-size (+ index-size rows-size)]
-          (swap! cassandra-data-size + archive-size)))
+          (swap! cassandra-data-size + archive-size)
+          (swap! points-count + points)))
       (process-path [this path file])
       (fetch-data? [this]
         false))))
@@ -406,6 +408,7 @@
   (newline)
   (println "Estimated Cassandra data size:"
            (humanize/filesize @cassandra-data-size))
+  (println "Number of points:" @points-count)
   (println "Don't forget to multiply size by replication factor!")
   (wlog/exit 0))


adds metadata capabilities to the schema

--- src/pc/datomic/schema.clj
+++ src/pc/datomic/schema.clj
@@ -20,11 +20,21 @@
   {:db/id (d/tempid :db.part/user)
    :db/ident ident})

+;; Attributes that annotate the schema, have to be transacted first
+;; Note: metadata needs a migration for it to be removed (or it can be set to false)
+(def metadata-schema
+  [(attribute :metadata/unescaped
+              :db.type/boolean
+              :db/doc "indicates that an attribute can be changed by a user, so should be escaped")
+   ])
+
 (def schema
   [
+
    (attribute :layer/name
               :db.type/string
-              :db/doc "Layer name")
+              :db/doc "Layer name"
+              :metadata/unescaped true)

    (attribute :layer/uuid
               :db.type/uuid
@@ -62,13 +72,15 @@
               :db/doc "Border radius")

    (attribute :layer/fill
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :layer/stroke-width
               :db.type/float)

    (attribute :layer/stroke-color
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :layer/opacity
               :db.type/float)
@@ -90,16 +102,19 @@
               :db.type/float)

    (attribute :layer/font-family
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :layer/text
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :layer/font-size
               :db.type/long)

    (attribute :layer/path
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    ;; Wonder what happens if we make a layer a child of one of its children...
    (attribute :layer/child
@@ -109,11 +124,13 @@

    (attribute :layer/ui-id
               :db.type/string
-              :db/doc "User-provided identifier for layer")
+              :db/doc "User-provided identifier for layer"
+              :metadata/unescaped true)

    (attribute :layer/ui-target
               :db.type/string
-              :db/doc "User-provided action for layer")
+              :db/doc "User-provided action for layer"
+              :metadata/unescaped true)

    (attribute :layer/ancestor
               :db.type/long
@@ -126,14 +143,16 @@
               :db/index true)

    (attribute :session/client-id
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :document/uuid
               :db.type/uuid
               :db/index true)

    (attribute :document/name
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :document/creator
               :db.type/uuid
@@ -164,10 +183,12 @@
               :db/doc "invalid document/id that was migrated")

    (attribute :chat/body
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :chat/color
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :server/timestamp
               :db.type/instant)
@@ -178,12 +199,14 @@
    (attribute :cust/email
               :db.type/string
               :db/index true
-              :db/doc "User email")
+              :db/doc "User email"
+              :metadata/unescaped true)

    (attribute :cust/name
               :db.type/string
               :db/index false
-              :db/doc "User-submitted name")
+              :db/doc "User-submitted name"
+              :metadata/unescaped true)

    (attribute :cust/verified-email
               :db.type/boolean)
@@ -209,19 +232,23 @@
               :db/doc "Session key stored in the cookie that is used to find the user")

    (attribute :cust/first-name
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :cust/last-name
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :cust/birthday
               :db.type/instant)

    (attribute :cust/gender
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :cust/occupation
-              :db.type/string)
+              :db.type/string
+              :metadata/unescaped true)

    (attribute :permission/document
               :db.type/long
@@ -324,7 +351,8 @@

    (attribute :access-grant/email
               :db.type/string
-              :db/doc "email that was granted access")
+              :db/doc "email that was granted access"
+              :metadata/unescaped true)

    (attribute :access-grant/token
               :db.type/string
@@ -404,6 +432,14 @@
 (defn get-ident [a]
   (:db/ident (first (filter #(= a (:db/id %)) @schema-ents))))

+(defn metadata [a]
+  (let [ent (first (filter #(or (= a (:db/id %))
+                                (= a (:db/ident %))) @schema-ents))]
+    (select-keys ent (filter #(= "metadata" (namespace %)) (keys ent)))))
+
+(defn unescaped? [a]
+  (:metadata/unescaped (metadata a)))
+
 (defn get-schema-ents [db]
   (pcd/touch-all '{:find [?t]
                    :where [[?t :db/ident ?ident]]}
@@ -412,7 +448,8 @@
 (defn ensure-schema
   ([] (ensure-schema (pcd/conn)))
   ([conn]
-   (let [res @(d/transact conn schema)
+   (let [meta-res @(d/transact conn metadata-schema)
+         res @(d/transact conn schema)
          ents (get-schema-ents (:db-after res))]
      (reset! schema-ents ents)
      res)))


Re-synced with upstream

Re-synced with upstream

--- src/play_clj/entities.clj
+++ src/play_clj/entities.clj
@@ -42,6 +42,7 @@
       (when color
         (.setColor ^Batch batch Color/WHITE)))))

+
 (defrecord SpriteEntity [object] Entity
   (draw! [{:keys [^Sprite object
                           alpha
@@ -78,6 +79,7 @@
     (if alpha
       (.draw object ^Batch batch alpha)
       (.draw object ^Batch batch))))
+

 (defrecord NinePatchEntity [object] Entity
   (draw! [{:keys [^NinePatch object x y width height]} _ batch]


fix title on blog page, new post page

fix title on blog page, new post page

--- src/smallblog/core.clj
+++ src/smallblog/core.clj
@@ -41,13 +41,13 @@
 					(clj-time-format/formatters :basic-date-time)
 					(clj-time-coerce/from-date (:created_date blog)))})

-(defn render-html-posts [posts url blogid]
-	(templates/main {:blogname "XXX first blog name", :posts posts
+(defn render-html-posts [posts url blogname blogid]
+	(templates/main {:blogname blogname, :posts posts
 				:user (data/get-current-user) :url url
 				:is-blog-owner (data/blog-owner? blogid)}))

-(defn render-html-newpost []
-	(templates/newpost {:blogname "XXX first blog name"
+(defn render-html-newpost [blogname]
+	(templates/newpost {:blogname blogname
 				:user (data/get-current-user)}))

 (defn render-html-account [url]
@@ -142,12 +142,15 @@

 	; "post urls"
 	(GET "/blog/:bid/post/" [bid :as request]
-		(render-html-posts (data/get-posts (Integer/parseInt bid) 10 0)
-				(util/uri-from-request request) bid))
+		(render-html-posts
+				(data/get-posts (Integer/parseInt bid) 10 0)
+				(util/uri-from-request request)
+				(:title (data/get-blog (Integer/parseInt bid)))
+				bid))
 	(GET "/blog/:bid/post/new" [bid]
 		(if (not (data/blog-owner? bid))
 			(redirect templates/*permission-denied-uri*)
-			(render-html-newpost)))
+			(render-html-newpost (:title (data/get-blog (Integer/parseInt bid))))))
 	(POST "/blog/:bid/post/new" [bid title content :as request]
 		(if (not (data/blog-owner? bid))
 			(redirect templates/*permission-denied-uri*)


Make sure the JSON gets the correct content type

--- src/clj/attendance/server.clj
+++ src/clj/attendance/server.clj
@@ -7,13 +7,13 @@
             [ring.middleware.json :refer [wrap-json-body wrap-json-response]]
             [environ.core :refer [env]]
             [ring.adapter.jetty :refer [run-jetty]]
-
             [attendance.google.sheets :refer [reflect-spreadsheets]])
   (:gen-class))

 (defroutes routes
   (resources "/")
-  (GET "/sheets" _ (reflect-spreadsheets)))
+  (GET "/sheets" _
+    {:body (reflect-spreadsheets)}))

 (def http-handler
   (-> routes


Don't print port message when starting REPL.

--- src/clj/cljs/repl/browser.clj
+++ src/clj/cljs/repl/browser.clj
@@ -247,10 +247,9 @@
 (defn start-server
   "Start the server on the specified port."
   [opts]
-  (do (println "Starting Server on Port:" (:port opts))
-      (let [ss (ServerSocket. (:port opts))]
-        (future (server-loop opts ss))
-        (swap! server-state (fn [old] (assoc old :socket ss :port (:port opts)))))))
+  (let [ss (ServerSocket. (:port opts))]
+    (future (server-loop opts ss))
+    (swap! server-state (fn [old] (assoc old :socket ss :port (:port opts))))))

 (defn stop-server
   []