enable collapse resolution

enable collapse resolution

--- src/qttt/game.cljs
+++ src/qttt/game.cljs
@@ -6,9 +6,6 @@
 (def num-players 2)

 (def ^:dynamic *speculative* false)
-
-;; TODO: make hover highlighting work (approach: third top-level activity)
-;; TODO: make cycle collapse work

 (comment
   ;; Game Data Structures
@@ -46,7 +43,7 @@
   "Return information regarding cells entangled with the given cell.

    Return value is a seq of [cell turn] tuples, where turn
-   is the turn the spooky mark was placed. Also exclude
+   is the turn the spooky mark was placed. Exclude
    entanglements which have a classical value already."

   [game cell]
@@ -133,11 +130,52 @@
       ;; check for collapses
       (check-collapses))))

+(defn valid-collapse?
+  "Return true if the given cell and subcell represent
+   a valid choice to collapse"
+  [game cell subcell]
+  (get-in game [:board cell :entanglements subcell :collapsing]))
+
+
+;; will this work with the new data model? Or need refactoring?
+(defn observe
+  "Define an observation as a tuple of [accepted-cell accepted-subcell],
+   where the accepted subcell is that which will be observed and become classical.
+
+  Given an observation, return a set of observations implied based
+  on the accepted cell's entanglements."
+  [game [accepted-cell accepted-subcell]]
+  (map :pair
+    (vals (dissoc (get-in game [:board accepted-cell :entanglements])
+            accepted-subcell))))
+
+(defn observe-all
+  "Given a set of observations, recursively calculate *all* observations inferred from entangled cells"
+  [game observations]
+  (loop [os observations]
+    (let [next-os (apply set/union os (map #(observe game %) os))]
+      (if (= next-os os)
+        next-os
+        (recur next-os)))))
+
 (defn resolve-collapse
   "Given a cell and subcell, resolve any collapse present in the game"
   [game cell subcell]
-  (println "resolving collapse")
-  game)
+  (if-not (valid-collapse? game cell subcell)
+    game
+    (let [observations (observe-all game #{[cell subcell]})
+          observations (if *speculative* (disj observations [cell subcell])
+                                         observations)]
+      (reduce (fn [game [cell subcell]]
+                (let [e (get-in game [:board cell :entanglements subcell])]
+                  (assoc-in game [:board cell :classical]
+                    {:player (:player e)
+                     :turn (:turn e)
+                     :focus *speculative*})))
+        (if *speculative*
+          (assoc-in game [:board cell :entanglements subcell :focus] true)
+          (assoc game :collapsing false))
+        observations))))

 (defn spooky-mark
   "Place a spooky mark at the given cell and subcell"


Fix for bad keyword alias use

Fix for bad keyword alias use

--- src/kixi/datastore/metadata_creator.clj
+++ src/kixi/datastore/metadata_creator.clj
@@ -75,7 +75,7 @@
           file-id (::ms/id payload)]
       (if (ms/authorised metadatastore ::ms/file-read file-id user-groups)
         (let [metadata (ms/retrieve metadatastore file-id)
-              link (fs/create-link filestore file-id (:ms/name metadata))]
+              link (fs/create-link filestore file-id (::ms/name metadata))]
           {:kixi.comms.event/key :kixi.datastore.filestore/download-link-created
            :kixi.comms.event/version "1.0.0"
            :kixi.comms.event/payload {::ms/id file-id


fix figwheel-sidecar.repl-api/app-trans

fix figwheel-sidecar.repl-api/app-trans

--- sidecar/src/figwheel_sidecar/repl_api.clj
+++ sidecar/src/figwheel_sidecar/repl_api.clj
@@ -31,16 +31,16 @@
 (defn figwheel-running? []
   (or *repl-api-system*
       (do
-        (println "Figwheel System not itnitialized.\nPlease start it with figwheel-sidecar.repl-api/start-figwheel")
+        (println "Figwheel System not itnitialized.\nPlease start it with figwheel-sidecar.repl-api/start-figwheel!")
         nil)))

 (defn app-trans
   ([func ids]
-   (when figwheel-running?
+   (when (figwheel-running?)
      (let [system (get-in *repl-api-system* [:figwheel-system :system])]
        (reset! system (func @system ids)))))
   ([func]
-   (when figwheel-running?
+   (when (figwheel-running?)
      (let [system (get-in *repl-api-system* [:figwheel-system :system])]
        (reset! system (func @system))))))


add a title when the action is invalid

add a title when the action is invalid

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -168,34 +168,39 @@
                             renderable-layers))
                (when (= :select tool)
                  (apply dom/g #js {:className "layers interactive-layers"}
-                        (mapv (fn [layer]
-                                (svg-element selected-eids
-                                             (assoc layer
-                                               :onMouseDown #(do
-                                                               (.stopPropagation %)
-                                                               (cond
-                                                                (and (< 1 (count selected-eids))
-                                                                     (contains? selected-eids (:db/id layer)))
-                                                                (cast! :group-selected
-                                                                       {:x (first (cameras/screen-event-coords %))
-                                                                        :y (second (cameras/screen-event-coords %))
-                                                                        :group-eid selected-eid
-                                                                        :layer-eids (disj selected-eids selected-eid)})
-
-                                                                :else
-                                                                (cast! :canvas-aligned-to-layer-center
-                                                                       {:ui-id (:layer/ui-action layer)
-                                                                        :canvas-size (let [size (goog.style/getSize (sel1 "#svg-canvas"))]
-                                                                                {:width (.-width size)
-                                                                                :height (.-height size)})})))
-                                               :className (str "action interactive-layer "
-                                                               (when (and (< 1 (count selected-eids))
-                                                                          (contains? selected-eids (:db/id layer)))
-                                                                 "selected-group ")
-                                                               (when-not (pos? (layer-model/count-by-ui-id @db (:layer/ui-action layer)))
-                                                                 "invalid-action"))
-                                               :key (str "action-" (:db/id layer)))))
-                              (filter :layer/ui-action renderable-layers)))))))))
+                        (for [layer (filter :layer/ui-action renderable-layers)
+                              :let [invalid? (not (pos? (layer-model/count-by-ui-id @db (:layer/ui-action layer))))]]
+                          (dom/g nil
+
+                                 (when invalid?
+                                   (dom/title nil
+                                              (str "This action doesn't point to any named shape. Right-click on a shape to name it " (:layer/ui-id layer))))
+                                 (svg-element selected-eids
+                                              (assoc layer
+                                                :onMouseDown #(do
+                                                                (.stopPropagation %)
+                                                                (cond
+                                                                 (and (< 1 (count selected-eids))
+                                                                      (contains? selected-eids (:db/id layer)))
+                                                                 (cast! :group-selected
+                                                                        {:x (first (cameras/screen-event-coords %))
+                                                                         :y (second (cameras/screen-event-coords %))
+                                                                         :group-eid selected-eid
+                                                                         :layer-eids (disj selected-eids selected-eid)})
+
+                                                                 :else
+                                                                 (cast! :canvas-aligned-to-layer-center
+                                                                        {:ui-id (:layer/ui-action layer)
+                                                                         :canvas-size (let [size (goog.style/getSize (sel1 "#svg-canvas"))]
+                                                                                {:width (.-width size)
+                                                                                :height (.-height size)})})))
+                                                :className (str "action interactive-layer "
+                                                                (when (and (< 1 (count selected-eids))
+                                                                           (contains? selected-eids (:db/id layer)))
+                                                                  "selected-group ")
+                                                                (when invalid?
+                                                                  "invalid-action"))
+                                                :key (str "action-" (:db/id layer)))))))))))))

 (defn subscriber-cursor-icon [tool]
   (case (name tool)


show how many characters are left

show how many characters are left

--- src-cljs/frontend/components/issues.cljs
+++ src-cljs/frontend/components/issues.cljs
@@ -28,7 +28,12 @@
     om/IInitState (init-state [_] {:issue-title ""})
     om/IRenderState
     (render-state [_ {:keys [issue-title submitting?]}]
-      (let [{:keys [issue-db cust cast!]} (om/get-shared owner)]
+      (let [{:keys [issue-db cust cast!]} (om/get-shared owner)
+            char-limit 140
+            chars-left (- char-limit (count issue-title))
+            input-disabled? (or submitting?
+                                (not (utils/logged-in? owner))
+                                (neg? chars-left))]
         (html
          [:form.issue-form {:on-submit #(do (utils/stop-event %)
                                             (go
@@ -62,7 +67,14 @@
                        :required "true"
                        :disabled (or submitting? (not (utils/logged-in? owner)))
                        :onChange #(om/set-state! owner :issue-title (.. % -target -value))}]
-           [:label {:data-typing (gstring/format "Sounds good so far—%s characters left" (count issue-title))
+           [:label {:data-typing (let [chars-left (- char-limit (count issue-title))]
+                                   (if (neg? chars-left)
+                                     (gstring/format "%s character%s too many"
+                                                     (- chars-left)
+                                                     (if (= -1 chars-left) "" "s"))
+                                     (gstring/format "Sounds good so far; %s character%s left"
+                                                     chars-left
+                                                     (if (= 1 chars-left) "" "s"))))
                     :data-label (if (utils/logged-in? owner)
                                   "How can we improve Precursor?"
                                   "Sign in to make an issue.")}]]
@@ -72,7 +84,7 @@
                                   :value (if submitting?
                                            "Submitting..."
                                            "Submit idea.")
-                                  :disabled (when-not (utils/logged-in? owner) true)}]
+                                  :disabled input-disabled?}]

              (om/build common/google-login {:source "Issue form"}))]])))))


Remove run! function

Remove run! function

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -573,8 +573,3 @@
         screen-fn (-> screen-object :options (get fn-name))]
     (apply execute-fn! screen-fn options)
     nil))
-
-(defn run!
-  "Deprecated. Please use `screen!` instead."
-  [& args]
-  (throw (Exception. "Replace run! with screen!")))


Optimize note drawing by keeping track of keys that are touched

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -70,17 +70,15 @@

 (defn draw-piano-keys
   [draw-ctx {w :w h :h playhead :playhead :as instrument}]
-  (let [freqs (-> instrument :piano-keys keys)
+  (let [piano-keys (-> instrument :piano-keys)
         piano-key-w (piano-key-width instrument)]
-    (dotimes [n (count freqs)]
-      (let [note (latest-note instrument (nth freqs n))
-            piano-key-on (and note (-> note :off nil?))]
-        (set! (.-fillStyle draw-ctx)
-              ((if piano-key-on :light :dark) (nth colors (mod n (count colors)))))
-        (.fillRect draw-ctx
-                   (* n piano-key-w)
-                   (t->px instrument playhead)
-                   piano-key-w h)))))
+    (doseq [[n [freq piano-key]] (map-indexed vector piano-keys)]
+      (set! (.-fillStyle draw-ctx)
+            ((if (piano-key :on?) :light :dark) (nth colors (mod n (count colors)))))
+      (.fillRect draw-ctx
+                 (* n piano-key-w)
+                 (t->px instrument playhead)
+                 piano-key-w h))))

 (defn draw-instrument
   [draw-ctx {w :w h :h playhead :playhead :as instrument}]
@@ -105,9 +103,10 @@
 (defn create-instrument
   [scale]
   (let [start (.getTime (js/Date.))]
-    {:piano-keys (into (sorted-map) (map-indexed (fn [i freq] [freq {:n i}])
+    {:piano-keys (into (sorted-map) (map-indexed (fn [i freq] [freq {:n i :on? false}])
                                                  scale))
-     :notes [] :w 0 :h 0 :sound-ready false
+     :notes ()
+     :w 0 :h 0 :sound-ready false
      :px-per-ms 0.04
      :start start
      :playhead start}))
@@ -138,24 +137,34 @@
                   [instrument {touch-id :touch-id time :time :as event}]
                   (let [freq (touch->freq instrument event)
                         piano-key (get-in instrument [:piano-keys freq])]
-                    (do
-                      ;; (println "play")
-                      (.play (.bang (:synth piano-key)))
-                      (assoc instrument :notes
-                             (conj (get instrument :notes)
-                                   {:freq freq :on time :off nil :touch-id touch-id})))))
+                    (if-not (:on? piano-key)
+                      (do
+                        (println "play")
+                        #_(.play (.bang (:synth piano-key)))
+                        (-> instrument
+                            (assoc :notes (conj (get instrument :notes)
+                                                {:freq freq :on time :off nil :touch-id touch-id}))
+                            (assoc-in [:piano-keys freq :on?] true)))
+                      instrument)))
    "touchend" (fn
                 [{piano-keys :piano-keys :as instrument}
                  {touch-id :touch-id time :time :as event}]
-                (assoc instrument :notes
-                       (map (fn [note]
-                              (if (= touch-id (-> note :touch-id))
-                                (do
-                                  ;; (println "release")
-                                  (.release (:synth (get piano-keys (-> note :freq))))
-                                  (assoc note :off time))
-                                note))
-                            (-> instrument :notes))))})
+                (let [freqs-on (atom [])
+                      instrument (assoc instrument :notes
+                                        (doall
+                                         (map (fn [note]
+                                                (if (= touch-id (-> note :touch-id))
+                                                  (do
+                                                    (swap! freqs-on conj (-> note :freq))
+                                                    (println "release")
+                                                    #_(.release (:synth (get piano-keys (-> note :freq))))
+                                                    (assoc note :off time))
+                                                  note))
+                                              (-> instrument :notes))))]
+                  (reduce (fn [inst freq]
+                            (assoc-in inst [:piano-keys freq :on?] false))
+                          instrument
+                          @freqs-on)))})

 (defn fire-event-on-instrument
   [instrument event]


Add big log file to sample data sets

Add big log file to sample data sets

--- sample-app/src/app/cljs/one/sample/samples.cljs
+++ sample-app/src/app/cljs/one/sample/samples.cljs
@@ -16,11 +16,21 @@
   (vec (range 128 256)))

 (def test-script-state
-  {:timestamp 12345678, :state {:host "localhost", :server nil, :port 18760, :script [{:action :create-server} {:action :seed-server, :seed 42} {:action :create-client, :client-id "Alpha"} {:action :create-client, :client-id "Beta"} {:action :create-client, :client-id "Gamma"} {:action :browse-uri, :client-id "Alpha", :uri "/login"} {:action :browse-uri, :client-id "Beta", :uri "/login"} {:action :browse-uri, :client-id "Gamma", :uri "/login"} {:action :click, :client-id "Alpha", :target "login-100"} {:action :click, :client-id "Beta", :target "login-101"} {:action :click, :client-id "Gamma", :target "login-102"} {:action :click, :client-id "Alpha", :target "join-room", :delay 8200} {:action :click, :client-id "Beta", :target "join-room", :delay 3200} {:action :click, :client-id "Gamma", :target "join-room", :delay 3200} {:action :click, :client-id "Alpha", :target "request-game-type-a", :delay 8200} {:action :click, :client-id "Beta", :target "request-game-type-a", :delay 3200} {:action :click, :client-id "Gamma", :target "request-game-type-a", :delay 3200} {:action :destroy-server}]}, :message {:action :create-server}, :level :info} )
+  {:timestamp 12345678, :state {:host "localhost", :server nil, :port 18760, :script [{:action :create-server} {:action :seed-server, :seed 42} {:action :create-client, :client-id "Alpha"} {:action :create-client, :client-id "Beta"} {:action :create-client, :client-id "Gamma"} {:action :browse-uri, :client-id "Alpha", :uri "/login"} {:action :browse-uri, :client-id "Beta", :uri "/login"} {:action :browse-uri, :client-id "Gamma", :uri "/login"} {:action :click, :client-id "Alpha", :target "login-100"} {:action :click, :client-id "Beta", :target "login-101"} {:action :click, :client-id "Gamma", :target "login-102"} {:action :click, :client-id "Alpha", :target "join-room", :delay 8200} {:action :click, :client-id "Beta", :target "join-room", :delay 3200} {:action :click, :client-id "Gamma", :target "join-room", :delay 3200} {:action :click, :client-id "Alpha", :target "request-activity-a", :delay 8200} {:action :click, :client-id "Beta", :target "request-activity-a", :delay 3200} {:action :click, :client-id "Gamma", :target "request-activity-a", :delay 3200} {:action :destroy-server}]}, :message {:action :create-server}, :level :info} )
+
+(def big-log
+  '[{:in app.server.incoming/log-received-message, :direction :receiving, :timestamp "2012-06-06T14:52:37.176-00:00", :user-id 1021770, :comment "Message received from user", :level :debug, :messages [{:from-client true, :user-id 1021770, :refid 0, :location-id 0, :session-id 23805780, :action :set-location}], :location-id 0, :origin :server, :category :messaging}
+{:in app.server.incoming/log-location-state, :timestamp "2012-06-06T14:52:37.216-00:00", :user-id 1021770, :comment "Location state after commit", :level :debug, :location-state {:user-ids #{1021770}, :location-id 0, :parent-location-id 0, :location-type :primary, :seq-num 2, :random-seed 1435286170, :outbox [{:seq-num 0, :action :create-location, :location-id 0, :location-type :primary} {:seq-num 1, :from-client true, :user-id 1021770, :refid 0, :location-id 0, :session-id 23805780, :action :set-location}]}, :location-id 0, :origin :server, :category :state}
+{:in app.server.incoming/log-received-message, :direction :receiving, :timestamp "2012-06-06T14:52:37.357-00:00", :user-id 1021770, :comment "Message received from user", :level :debug, :messages [{:from-client true, :user-id 1021770, :refid 0, :location-id 0, :session-id 23805780, :action :request-game, :activity :activity-one}], :location-id 0, :origin :server, :category :messaging}
+{:in app.server.incoming/log-location-state, :timestamp "2012-06-06T14:52:37.362-00:00", :user-id 1021770, :comment "Location state after commit", :level :debug, :location-state {:requests {:activity-one #{1021770}}, :user-ids #{1021770}, :location-id 0, :parent-location-id 0, :location-type :primary, :seq-num 3, :random-seed 1435286170, :outbox [{:seq-num 0, :action :create-location, :location-id 0, :location-type :primary} {:seq-num 1, :action :set-location, :user-id 1021770, :location-id 0} {:seq-num 2, :from-client true, :user-id 1021770, :refid 0, :location-id 0, :session-id 23805780, :action :request-game, :activity :activity-one}]}, :location-id 0, :origin :server, :category :state}
+{:in app.server.incoming/log-received-message, :direction :receiving, :timestamp "2012-06-06T14:52:37.406-00:00", :user-id 1021771, :comment "Message received from user", :level :debug, :messages [{:from-client true, :user-id 1021771, :refid 1, :location-id 0, :session-id 1125501360, :action :set-location}], :location-id 0, :origin :server, :category :messaging}
+{:in app.server.incoming/log-location-state, :timestamp "2012-06-06T14:52:37.417-00:00", :user-id 1021771, :comment "Location state after commit", :level :debug, :location-state {:requests {:activity-one #{1021770}}, :user-ids #{1021770 1021771}, :location-id 0, :parent-location-id 0, :location-type :primary, :seq-num 4, :random-seed 1435286170, :outbox [{:seq-num 0, :action :create-location, :location-id 0, :location-type :primary} {:seq-num 1, :action :set-location, :user-id 1021770, :location-id 0} {:seq-num 2, :action :request-game, :user-id 1021770, :location-id 0, :activity :activity-one} {:seq-num 3, :from-client true, :user-id 1021771, :refid 1, :location-id 0, :session-id 1125501360, :action :set-location}]}, :location-id 0, :origin :server, :category :state}
+])

 (def all-samples
   ["small map" small-map
    "short vector" short-vector
    "vector of maps" vector-of-maps
    ;;"long vector" long-vector
-   "test script state" test-script-state])+   "test script state" test-script-state
+   "big log file" big-log])


Update intro.cljs

Update intro.cljs

changed "more" into "more complex" for bold text in key points

--- src/prais2/intro.cljs
+++ src/prais2/intro.cljs
@@ -99,7 +99,7 @@
    [:h2 "Key points"]
    [:ul
     [:li "If one hospital has a higher survival rate than another hospital it does not mean that it is better than the other"]
-    [:li "The predicted range is calculated by a formula and depends " [:b "only"] " on the children treated at that hospital. A " [:b "lower"] " predicted range means a hospital treated children with " [:b "more"] " complex medical problems." ]
+    [:li "The predicted range is calculated by a formula and depends " [:b "only"] " on the children treated at that hospital. A " [:b "lower"] " predicted range means a hospital treated children with " [:b "more complex"] " medical problems." ]
     [:li "The survival rate for all UK hospitals is very high."]]])


Really fix hierarchy.

Really fix hierarchy.

--- src/angelic/search/action_set/asplan.clj
+++ src/angelic/search/action_set/asplan.clj
@@ -418,7 +418,7 @@
   (let [name [:achieve-precondition var dst-val]
         av   (action-var var)
         pc   (util/safe-get-in hierarchy [:precondition-context-map var])
-        pc   (:full-context hierarchy)
+;        pc   (:full-context hierarchy)
         ]
     (reify
       env/Action
@@ -459,8 +459,23 @@
         reduced-pm    (dissoc (:precond-map a) effect-var)
         ancestor-vars (util/safe-get-in hierarchy [:ancestor-var-map effect-var])
         child-var-map (:child-var-map hierarchy)
-        pc            (into #{(action-var effect-var)}
-                        (apply concat (map (:fire-action-pc-map hierarchy) (keys reduced-pm))))
+        context-cvm   (util/map-vals
+                       #(filter ancestor-vars  %)
+                       (select-keys child-var-map ancestor-vars))
+        pc (into #{(action-var effect-var)}
+                 (apply concat
+                        (for [v (distinct (apply concat (for [p (keys reduced-pm)] (util/safe-get-in hierarchy [:ancestor-var-map p]))))]
+                          (concat
+                           [v (free-var v) (action-var v)]
+                           (for [c (child-var-map v) :when (ancestor-vars c)] (parent-var v c))))))
+
+
+           #_(into #{(action-var effect-var)}
+                            (apply concat
+                                   (for [p (keys reduced-pm)]
+                                     (cons (parent-var p effect-var)
+                                           (util/safe-get-in hierarchy [:precondition-context-map p])))))
+        ;                                   (map (:fire-action-pc-map hierarchy) (keys reduced-pm))
 ;        pc (:full-context hierarchy)
         ]
 ;    (println "FA" name pc "\n" (clojure.set/difference (:full-context hierarchy) pc))
@@ -477,7 +492,7 @@
         (let [na-tuples         (for [nav   ancestor-vars
                                       :when (not #(state/get-var s (action-var %)))
                                       :let  [child (current-child s child-var-map nav)]
-                                      :when (and child (not (state/get-var s (action-var child))))]
+                                      :when (and child (ancestor-vars child) (not (state/get-var s (action-var child))))]
                                   [nav child])]
          (util/cond-let [x]
           ;; Greedy -- all preconditions satisfied and not assigned elsewhere
@@ -485,10 +500,10 @@
             (do ;(print "g") (flush)
               [[x]])

-          ;; Real deadlock - fail
-          (deadlocked? s child-var-map [])
-            (do ;(print "d") (flush)
-                nil)
+          ;; Real deadlock - fail (for SA, must restrict context...)
+          (deadlocked? s context-cvm [])
+            (do ;(print "d") (flush)
+               nil)

           ;; Deadlocked by something out-of-context -- exit  (note -- need to check for goal means
             ; we should catch these issues earlier..


Don't crash if cue var has no starting value.

--- src/afterglow/web/routes/show_control.clj
+++ src/afterglow/web/routes/show_control.clj
@@ -247,7 +247,7 @@
   (let [last-info (get @clients page-id)
         show (:show last-info)
         current-vars (set (cue-var-values show current-effects))
-        changes (for [change (clojure.set/difference current-vars (:cue-vars last-info))]
+        changes (for [change (filter identity (clojure.set/difference current-vars (:cue-vars last-info)))]
                   {:cue-var-change change})]
     (swap! clients update-in [page-id] assoc :cue-vars current-vars)
     changes))


Add whitespace :yum:

Add whitespace :yum:

--- src/metabase/query_processor/expand.clj
+++ src/metabase/query_processor/expand.clj
@@ -107,6 +107,7 @@
                                                                    (normalize-token unit))})))

 (s/defn ^:ql ^:always-validate expression :- ExpressionRef
+  {:added "0.17.0"}
   [expression-name :- (s/cond-pre s/Str s/Keyword)]
   (i/strict-map->ExpressionRef {:expression-name (name expression-name)}))

@@ -173,7 +174,7 @@
 ;;; ## filter

 (s/defn ^:private ^:always-validate compound-filter :- i/Filter
-  ([compound-type subclause :- i/Filter]
+  ([compound-type, subclause :- i/Filter]
    (log/warn (u/format-color 'yellow "You shouldn't specify an %s filter with only one subclause." compound-type))
    subclause)

@@ -365,6 +366,7 @@

 (s/defn ^:ql ^:always-validate expressions
   "Top-level clause. Add additional calculated fields to a query."
+  {:added "0.17.0"}
   [query, m :- {s/Keyword Expression}]
   (assoc query :expressions m))


fix bug where a topology's status would get corrupted to true if nimbus is restarted while status is rebalancing or killed

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -130,7 +130,8 @@
    :killed {:startup (fn [] (delay-event nimbus
                                          storm-id
                                          (:kill-time-secs status)
-                                         :remove))
+                                         :remove)
+                             nil)
             :kill (kill-transition nimbus storm-id)
             :remove (fn []
                       (log-message "Killing topology: " storm-id)
@@ -141,7 +142,8 @@
    :rebalancing {:startup (fn [] (delay-event nimbus
                                               storm-id
                                               (:delay-secs status)
-                                              :do-rebalance))
+                                              :do-rebalance)
+                                 nil)
                  :kill (kill-transition nimbus storm-id)
                  :do-rebalance (fn []
                                  (do-rebalance nimbus storm-id status)


Accessibility Improvements

Accessibility Improvements

--- src/cljs/salava/location/ui/explore.cljs
+++ src/cljs/salava/location/ui/explore.cljs
@@ -96,10 +96,11 @@
           :max-results     100}])
       :component-did-mount
       (fn []
-        (-> (sel1 ".autocomplete__input")
-            (dommy/set-attr! :aria-label (t placeholder)))
-        (-> (sel1 ".autocomplete__clear-button")
-            (dommy/set-attr! :aria-hidden true)))})))
+        (do
+          (-> (sel1 ".autocomplete__input")
+              (dommy/set-attr! :aria-label (t placeholder)))
+          (-> (sel1 ".autocomplete__clear-button")
+              (dommy/set-attr! :aria-label (t :location/clearField)))))})))

 (defn map-view [state]
   (create-class


Requiring booleans or numbers does not throw anymore

--- src/org/zalando/stups/friboo/config.clj
+++ src/org/zalando/stups/friboo/config.clj
@@ -19,11 +19,18 @@
             [amazonica.aws.kms :as kms]
             [clojure.data.codec.base64 :as b64]))

+(defn- nil-or-empty?
+  "If x is a string, returns true if nil or empty. Else returns true if x is nil"
+  [x]
+  (if (string? x)
+      (empty? x)
+      (nil? x)))
+
 (defn require-config
   "Helper function to fail of a configuration value is missing."
   [configuration key]
   (let [value (get configuration key)]
-    (if (empty? value)
+    (if (nil-or-empty? value)
       (throw (IllegalArgumentException. (str "Configuration " key " is required but is missing.")))
       value)))


pending endorsements, endorsement list

pending endorsements, endorsement list

--- src/cljs/salava/badge/ui/endorsement.cljs
+++ src/cljs/salava/badge/ui/endorsement.cljs
@@ -6,7 +6,8 @@
             [salava.core.ui.helper :refer [path-for private?]]
             [salava.core.ui.modal :as mo]
             [clojure.string :refer [blank?]]
-            [reagent.session :as session]))
+            [reagent.session :as session]
+            [salava.user.ui.helper :refer [profile-picture]]))

 (defn endorsement-row [endorsement]
@@ -38,21 +39,72 @@
               (for [endorsement @endorsements]
                 (endorsement-row endorsement)))]])))

+;; User Endorsements
+
+(defn init-user-badge-endorsement [state]
+  (ajax/GET
+    (path-for (str "/obpv1/badge/user/endorsement/" (:id @state)))
+    {:handler (fn [data]
+                (swap! state assoc :user-badge-endorsements data)
+                (when (some #(= (:endorser_id %) (:endorser-id @state)) data)
+                  (swap! state assoc :show-link "none"
+                         :show-content "none"
+                         :show-endorsement-status "block")))}))
+
+
+(defn init-pending-endorsements [state]
+  (ajax/GET
+    (path-for "/obpv1/badge/user/pending_endorsement/")
+    {:handler (fn [data]
+                (swap! state assoc :pending data)
+                )}
+    )
+  )
+
 (defn save-endorsement [state]
-  )
+  (ajax/POST
+    (path-for (str "/obpv1/badge/endorsement/" (:id @state)))
+    {:params {:content @(cursor state [:endorsement-comment]) }
+     :handler (fn [data]
+                (when (= (:status data) "success")
+                  (swap! state assoc :show-link "none"
+                         :show-content "none"
+                         :show-endorsement-status "block")
+                  ))}))
+
+(defn update-status [id status user_badge_id state reload-fn]
+  (ajax/POST
+    (path-for (str "/obpv1/badge/endorsement/update_status/" id))
+    {:params {:user_badge_id user_badge_id
+              :status status}
+     :handler (fn [data]
+                (when (= "success" (:status data))
+                  (reload-fn state)))}))
+
+(defn delete-endorsement [id user_badge_id state]
+  (ajax/DELETE
+    (path-for (str "/obpv1/badge/endorsement/" user_badge_id "/" id))
+    {:handler (fn [data]
+                (when (= "success" (:status data))
+                  (init-user-badge-endorsement state)))}))

 (defn process-text [s state]
   (let [text (-> js/document
                  (.getElementById "claim")
                  (.-innerHTML))
-        endorsement-claim (str text (if (blank? text) "" "\n\n") "*" s)]
+        endorsement-claim (str text (if (blank? text) "" "\n\n") "* " s)]
     (reset! (cursor state [:endorsement-comment]) endorsement-claim)))

 (defn endorse-badge-content [state]
   (fn []
     [:div {:style {:display @(cursor state [:show-content])}}
      [:hr]
+     [:div.row
+      [:div.col-xs-12 [:a.cancel.pull-right {:href "#" :on-click #(do
+                                                                    (.preventDefault %)
+                                                                    (swap! state assoc :show-link "block"
+                                                                           :show-content "none"))} [:i.fa.fa-remove]]]]

      [:div.endorse {:style {:margin "5px"}} (t :badge/Endorsehelptext)]

@@ -66,7 +118,6 @@
         [:a.list-group-item {:href "#" :on-click #(do
                                                     (.preventDefault %)
                                                     (process-text (t :badge/Endorsephrase2) state)
-                                                    ; (reset! endorsement (conj @endorsement))
                                                     )} [:i.fa.fa-plus-circle](t :badge/Endorsephrase2)]
         [:a.list-group-item {:href "#" :on-click #(do
                                                     (.preventDefault %)
@@ -84,29 +135,38 @@
      [:div.form-group
       [:label {:for "claim"} (t :badge/Composeyourendorsement)  ]
       [:textarea.form-control {:id "claim"
-                               :rows 10
-                               :cols 60
+                               :rows "5"
+                               :cols "60"
+                               :max-length "1500"
                                :type "text"
                                :value @(cursor state [:endorsement-comment])
                                :on-change #(do
                                              (reset! (cursor state [:endorsement-comment]) (.-target.value %))
-                                             )}]]
+                                             )
+                               #_:on-key-down #_(if (= (.-which %) 13)
+                                               #_(add-tag tags-atom new-tag-atom))}]]
      [:div
-      [:button.btn.btn-primary {
-                                 :on-click #(do
-                                              (.preventDefault %)
-                                              ;;save endorsement
-                                              )
-                                 :disabled (blank? @(cursor state [:endorsement-comment]))
-
-                                 } (t :badge/endorse)]
-      [:a {:href "#" :on-click #(do
-                                  (.preventDefault %)
-                                  (swap! state assoc :show-link "block"
-                                         :show-content "none"))} (t :core/Cancel)]]
+      [:button.btn.btn-primary {:on-click #(do
+                                             (.preventDefault %)
+                                             (save-endorsement state)
+                                             ;;save endorsement
+                                             )
+                                :disabled (blank? @(cursor state [:endorsement-comment]))
+
+                                } (t :badge/endorse)]]
      [:hr]]))

-;; User Endorsements
+(defn endorsement-text [state]
+  (let [user-endorsement (->> @(cursor state [:user-badge-endorsements])
+                              (filter #(= (:endorser-id @state) (:endorser_id %))))]
+    (if (seq user-endorsement)
+      (case  (->> user-endorsement first :status)
+        "accepted" [:span.label.label-success (t :badge/Youendorsebadge)]
+        "declined" [:span.label.label-danger (t :badge/Declinedendorsement)]
+        [:span.label.label-info (t :badge/Pendingendorsement)]
+        )
+      [:span.label.label-info (t :badge/Pendingendorsement)])))
+
 (defn endorse-badge-link [state]
   (fn []
     [:div
@@ -116,21 +176,120 @@
                        (.preventDefault %)
                        (swap! state assoc :show-link "none"
                               :show-content "block")
-                       ;(mo/open-modal [:badge :endorse] badge-id)
-                       )}[:i.fa.fa-handshake-o] (t :badge/Endorsethisbadge)]]))
+                       )}[:i.fa.fa-handshake-o] (t :badge/Endorsethisbadge)]
+     [:div {:style {:display @(cursor state [:show-endorsement-status])}} [:i.fa.fa-thumbs-up] (endorsement-text state)]]))
+
+(defn profile-link-inline [id first_name last_name picture]
+  [:div [:a {:href "#"
+             :on-click #(mo/open-modal [:user :profile] {:user-id id})}
+         [:img {:src (profile-picture picture)}]
+         (str first_name " " last_name " ")]  (t :badge/Hasendorsedyou)])
+
+(defn pending-endorsements []
+  (let [state (atom {:user-id (-> (session/get :user) :id)})]
+    (init-pending-endorsements state)
+    (fn []
+      [:div#endorsebadge
+       (reduce (fn [r endorsement]
+                 (let [{:keys [id user_badge_id image_file name content first_name last_name profile_picture endorser_id]} endorsement]
+                   (conj r
+                         [:div
+                          [:div.col-md-12
+                           [:div.thumbnail
+                            [:div.endorser.col-md-12
+                             [profile-link-inline endorser_id first_name last_name profile_picture id]
+                             [:hr.border]
+                             ]
+                            [:div.caption.row
+                             [:div.position-relative.text-center.col-md-3
+                              [:img{:src (str "/" image_file)}]]
+
+                             [:div.col-md-9 [:h4.media-heading name]
+                              [:div.thumbnail-description.smaller {:dangerouslySetInnerHTML {:__html content}}]]
+                             ]
+
+                            [:div.caption.card-footer.text-center
+                             [:hr]
+                             [:ul.list-inline.buttons
+                              [:a.button {:href "#"
+                                          :on-click #(do
+                                                       (.preventDefault %)
+                                                       (update-status id "accepted" user_badge_id state init-pending-endorsements)
+                                                       )} [:li [:i.fa.fa-check] ]]
+                              [:a.button {:href "#"
+                                          :on-click #(do
+                                                       (.preventDefault %)
+                                                       (update-status id "declined" user_badge_id state init-pending-endorsements))}[:li.cancel [:i.fa.fa-remove]]]]]]]]))) [:div.row] @(cursor state [:pending]))
+       ])))

 (defn endorse-badge [badge-id]
   (let [state (atom {:id badge-id
                      :show-link "block"
                      :show-content "none"
                      :endorsement-comment ""
-                     :endorser-id (-> (session/get :user) :id)})]
-    [:div#endorsebadge {:style {:margin-top "10px"}}
-     [endorse-badge-link state]
-     [endorse-badge-content state]
-     ]
-    )
-  )
+                     :endorser-id (-> (session/get :user) :id)
+                     :show-endorsement-status "none"})]
+    (init-user-badge-endorsement state)
+    (fn []
+      [:div#endorsebadge {:style {:margin-top "10px"}}
+       [endorse-badge-link state]
+       [endorse-badge-content state]])))
+
+(defn endorsement-list [badge-id]
+  (let [state (atom {:id badge-id})]
+    (init-user-badge-endorsement state)
+
+    (fn []
+      (when (seq @(cursor state [:user-badge-endorsements]))
+        [:div
+         [:div.row
+          [:label.col-md-12.sub-heading (t :badge/Endorsements)]]
+         [:div#endorsebadge
+
+          (reduce (fn [r endorsement]
+                    (let [{:keys [id user_badge_id image_file name content first_name last_name profile_picture endorser_id status]} endorsement]
+                      (conj r [:div.panel.panel-default.endorsement
+                               [:div.panel-heading {:id (str "heading" id)}
+                                [:div.panel-title
+                                 (case status
+                                   "accepted" [:span.label.label-success (t :core/Accepted)]
+                                   "declined" [:span.label.label-danger (t :core/Declined)]
+                                   "pending" [:span.label.label-info (t :core/Pending)]
+                                   [:span.label.label-info (t :core/Pending)])
+                                 [:div.row.flip.settings-endorsement
+                                  [:div.col-md-9
+                                   [:a {:href "#"
+                                        :on-click #(mo/open-modal [:user :profile] {:user-id endorser_id})}
+                                    [:img.small-image {:src (profile-picture profile_picture)}]
+                                    (str first_name " " last_name " ")] ]]]
+
+                                [:div [:button {:type "button"
+                                                :aria-label "OK"
+                                                :class "close"
+                                                :on-click #(do (.preventDefault %)
+                                                             (delete-endorsement id user_badge_id state))
+                                                }
+                                       [:i.fa.fa-trash.trash]]]]
+                               [:div.panel-body
+                                [:div {:dangerouslySetInnerHTML {:__html content}}]
+                                (when (= "pending" status)
+                                  [:div.caption
+                                   [:hr]
+                                   [:div.text-center
+                                    [:ul.list-inline.buttons.buttons
+                                     [:a.button {:href "#"
+                                                 :on-click #(do
+                                                              (.preventDefault %)
+                                                              (update-status id "accepted" user_badge_id state init-user-badge-endorsement)
+                                                              )} [:li [:i.fa.fa-check] ]]
+                                     [:a.button {:href "#"
+                                                 :on-click #(do
+                                                              (.preventDefault %)
+                                                              (update-status id "declined" user_badge_id state init-user-badge-endorsement))}[:li.cancel [:i.fa.fa-remove]]]]]])
+                                ]]))
+
+                    ) [:div] @(cursor state [:user-badge-endorsements]))]]))))
+
 (defn request-endorsement [])
-(defn pending-endorsement [])
-
+
+


minor tweaks of winkler01 settings

minor tweaks of winkler01 settings

--- src/clojush/problems/tozier/winkler01.clj
+++ src/clojush/problems/tozier/winkler01.clj
@@ -118,7 +118,7 @@
 (def winkler-atom-generators
   (concat (take 100 (repeat 'in1))
           (take 50 (repeat (fn [] (lrand-int 65536)))) ;Integer ERC [0,65536]
-          (registered-for-stacks [:integer :code :boolean :exec :vector_integer])))
+          (registered-for-stacks [:integer :code :boolean :exec :vector_integer :char :string :float])))


small fix for dimensions

small fix for dimensions

--- core/src/samsara_core/kernel.clj
+++ core/src/samsara_core/kernel.clj
@@ -239,18 +239,27 @@
           (var-set kv-state new-state'))))))

-(defn- compile-input-topic-config [{:keys [input-topic] :as stream} config]
-  {input-topic {:topic-filter (compile-partition-filter stream)
-                :handler (compile-input-topic-handler stream config)}})
+(defn- compile-input-topic-config [{:keys [input-topic state] :as stream} config]
+  (when (or (= state :none) (= state :partitioned))
+    {input-topic {:topic-filter (compile-partition-filter stream)
+                  :handler (compile-input-topic-handler stream config)}}))

 (defn- compile-kv-state-handler [{:keys [input-topic state] :as stream}]
   (fn [output-collector stream partition key message]
     (kv-restore! input-topic message)))

-(defn- compile-state-topic-config [{:keys [state-topic state] :as stream}]
-  (when (= state :partitioned)
+(defn- compile-state-topic-config [{:keys [state-topic state input-topic] :as stream}]
+  (cond
+
+    (= state :partitioned)
     {state-topic {:topic-filter (compile-partition-filter stream)
-                  :handler (compile-kv-state-handler stream)}}))
+                  :handler (compile-kv-state-handler stream)}}
+
+    (= state :global)
+    {input-topic {:topic-filter (compile-partition-filter stream)
+                  :handler (compile-kv-state-handler stream)}}
+    ))
+

 (defn- compile-stream-config
   [stream config]
@@ -267,7 +276,9 @@

 (defn init-stores [config]
-  (let [streams (map :input-topic (filter (where :state = :partitioned) (:streams config)))
+  (let [streams (map :input-topic
+                     (filter (where [:or [:state = :partitioned] [:state = :global]])
+                             (:streams config)))
         _ (log/info "Initializing kv-store for the following streams: " streams)
         local-store (constantly (thread-local (kv/make-in-memory-kvstore)))]
     (into {} (map (juxt identity local-store) streams))))
@@ -287,6 +298,8 @@

   (init-pipeline! config)

+  (keys (compile-config config))
+
   (def stream (-> config :streams first))

   (defn out-> [all-output]


small sample fix

small sample fix

--- core/src/samsara_core/kernel.clj
+++ core/src/samsara_core/kernel.clj
@@ -396,7 +396,7 @@

   ((:handler (*dispatchers* "dimension1")) out-> "dimension1" 0 "ciao" "[\"ciao\",1,{\"a\":1}]")

-  (global-kv-restore! "dimension1" "[\"ciao\",1,{\"a\":1}]")
+  (global-kv-restore! :dimension1 "[\"ciao\",1,{\"a\":1}]")

 )


added better error message for missing closing tags

--- src/selmer/parser.clj
+++ src/selmer/parser.clj
@@ -154,6 +154,8 @@
            cur-tag  start-tag
            end-tags end-tags]
       (cond
+        (and (nil? ch) (not-empty end-tags))
+        (throw (Exception. (str "No closing tag found for " start-tag)))
         (nil? ch)
         tags
         (open-tag? ch rdr)


Started framework for In-Close

Started framework for In-Close

but it may take some more time until we have a working implementation.

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

--- src/conexp/contrib/algorithms/bitwise.clj
+++ src/conexp/contrib/algorithms/bitwise.clj
@@ -268,6 +268,20 @@

 ;; In-Close (:in-close)

+(defn in-close
+  ""
+  [object-count attribute-count incidence-matrix A B r y]
+  )
+
+(defn is-cannonical?
+  ""
+  [object-count attribute-count incidence-matrix A B r y]
+  )
+
+(defmethod concepts :in-close [_ context]
+  )
+
+

 ;;; Luxenburger Basis


Removed general sorted set from TITANIC implementation

since it does not pay off.

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

--- src/conexp/contrib/algorithms/titanic.clj
+++ src/conexp/contrib/algorithms/titanic.clj
@@ -7,8 +7,7 @@
 ;; You must not remove this notice, or any other, from this software.

 (ns conexp.contrib.algorithms.titanic
-  (:use conexp.main
-        conexp.contrib.util.general-sorted-sets))
+  (:use conexp.main))

 (ns-doc
  "Implements the TITANIC algorithm. Note that this implementation is
@@ -47,7 +46,9 @@
       (let [m   (first elements),
             X+m (conj X m),
             s   (or (set-weight X+m)
-                    (let [weight (minimum (map set-weight (directly-below-in-gss keys X+m)))]
+                    (let [weight (minimum (doall (for [K keys, ;bottleneck!
+                                                       :when (subset? K X+m)]
+                                                   (set-weight K))))]
                       (set-val! set-weight X+m weight)
                       weight))]
         (recur (if (= s (set-weight X))
@@ -79,22 +80,20 @@
             subset-weight (memoize (partial subset-weight max-weight)),
             minimum       weight-minimum]

-    (let [keys (make-general-sorted-set subset? [#{}])]
-      (loop [key-set    #{#{}},
-             candidates (set-of #{m} [m base-set])]
-        (set! set-weight (into set-weight (weigh candidates)))
-        (doseq [X key-set]
-          (set-val! closure X (titanic-closure X base-set keys candidates)))
-        (let [next-key-set (set-of X [X candidates,
-                                      :when (not= (subset-weight X)
-                                                  (set-weight X))])]
-          (if-not (empty? next-key-set)
-            (do
-              (doseq [key next-key-set]
-                (add-to-gss! keys key))
-              (recur next-key-set
-                     (titanic-generate next-key-set)))
-            (distinct (map closure (gss-elements keys)))))))))
+    (loop [key-set    #{#{}},
+           candidates (set-of #{m} [m base-set]),
+           keys       [#{}]]
+      (set! set-weight (into set-weight (weigh candidates)))
+      (doseq [X key-set]
+        (set-val! closure X (titanic-closure X base-set keys candidates)))
+      (let [next-key-set (set-of X [X candidates,
+                                    :when (not= (subset-weight X)
+                                                (set-weight X))])]
+        (if-not (empty? next-key-set)
+          (recur next-key-set
+                 (titanic-generate next-key-set)
+                 (concat keys next-key-set))
+          (distinct (map closure keys)))))))

 ;;;


First reasonable results from TITANIC

First reasonable results from TITANIC

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

--- src/conexp/contrib/algorithms/titanic.clj
+++ src/conexp/contrib/algorithms/titanic.clj
@@ -37,7 +37,7 @@
   "The maximal weight possible. To be rebound.")

 (defn- titanic-closure
-  ""
+  "Computes the closure of X by the weights of its subsets."
   [X base-set key-set candidates]
   (let [Y (apply union X (map #(closure (disj X %)) X))]
     (loop [Y Y,
@@ -46,11 +46,11 @@
         (let [m   (first elements),
               X+m (conj X m),
               s   (if (contains? candidates X+m)
-                    (set-weight X+m)
+                    (get set-weight X+m max-weight)
                     (minimum (for [K key-set,
                                    :when (subset? K X+m)]
-                               (set-weight K))))]
-          (recur (if (= s (set-weight X))
+                               (get set-weight K max-weight))))]
+          (recur (if (= s (get set-weight X max-weight))
                    (conj Y m)
                    Y)
                  (rest elements)))
@@ -68,8 +68,8 @@
                                      (contains? key-set (disj both x))))])]
     (doseq [X C]
       (set-val! subset-weight X
-                (minimum (conj max-weight
-                               (map #(set-weight (disj X %)) X)))))
+                (minimum (conj (map #(get set-weight (disj X %) max-weight) X)
+                               max-weight))))
     C))

 (defn titanic
@@ -91,19 +91,19 @@
       (let [empty-weight (set-weight #{})]
         (doseq [m base-set]
           (set-val! subset-weight #{m} empty-weight)))
-      (loop [key-set    [#{}],
+      (loop [key-set    #{#{}},
              candidates (set-of #{m} [m base-set]),
              key-sets   [key-set]]
         (set! set-weight (into set-weight (weigh candidates)))
         (doseq [X key-set]
           (set-val! closure X (titanic-closure X base-set key-set candidates)))
         (let [next-key-set (set-of X [X candidates,
-                                      :when (not= (subset-weight X)
-                                            (set-weight X))])]
+                                      :when (not= (get subset-weight X max-weight)
+                                            (get set-weight X max-weight))])]
           (if-not (empty? next-key-set)
             (recur next-key-set
-                   (titanic-generate key-set)
-                   (conj key-sets key-set))
+                   (titanic-generate next-key-set)
+                   (conj key-sets next-key-set))
             (distinct (mapcat #(map closure %) key-sets))))))))


give stateful button a displayname (added for debugging)

--- frontend/components/forms.cljs
+++ frontend/components/forms.cljs
@@ -68,6 +68,7 @@
   when the response comes back, it replaces the button with the data-:status-text for a second."
   [hiccup-form owner]
   (reify
+    om/IDisplayName (display-name [_] "Stateful button")
     om/IInitState
     (init-state [_]
       {:lifecycle [:idle]


Remove duplication

Remove duplication

--- src/cake/tasks/jar.clj
+++ src/cake/tasks/jar.clj
@@ -75,8 +75,8 @@
       (ant Replace {:file cake-clj :token "(comment context)" :value (pr-str `(quote ~*context*))}))))

 (defn build-jar []
-  (let [maven (format "META-INF/maven/%s/%s" (:group-id *project*) (:artifact-id *project*))
-        cake  (format "META-INF/cake/%s/%s"  (:group-id *project*) (:artifact-id *project*))]
+  (let [[maven cake] (for [tool '[maven cake]]
+                       (format "META-INF/%s/%s/%s" tool (:group-id *project*) (:artifact-id *project*)))]
     (when (:bake *project*)
       (build-context))
     (ant Jar {:dest-file (jarfile)}


Prepare user-friendly samples #15

Prepare user-friendly samples #15

--- src/flatgui/samples/forms/helloworld.clj
+++ src/flatgui/samples/forms/helloworld.clj
@@ -15,6 +15,7 @@
         flatgui.widgets.checkbox)
   (:require flatgui.skins.flat
             flatgui.appcontainer
+            [flatgui.util.matrix :as m]
             [flatgui.base :as fg]
             [flatgui.comlogic :as fgc]
             [flatgui.awt :as awt]))
@@ -33,7 +34,7 @@
     window
     :hello
     {:clip-size (fgc/defpoint 3 1.5)
-     :position-matrix (flatgui.util.matrix/transtation-matrix 1 1)
+     :position-matrix (m/transtation-matrix 1 1)
      :text "Hello World Example"}

     (fg/defcomponent
@@ -41,14 +42,14 @@
       :say-hello
       {:clip-size (fgc/defpoint 1.75 0.25 0)
        :text "Greeting"
-       :position-matrix (flatgui.util.matrix/transtation-matrix 0.125 0.75)})
+       :position-matrix (m/transtation-matrix 0.125 0.75)})

     (fg/defcomponent
       label
       :greeting
       {:text nogreeting-text
        :clip-size (fgc/defpoint 2.25 0.25 0)
-       :position-matrix (flatgui.util.matrix/transtation-matrix 1.0 0.75)
+       :position-matrix (m/transtation-matrix 1.0 0.75)
        :evolvers {:text greeting-evolver}})))

 ;;;; TODO use defcontainer marco instead


error handling on unknown ids

error handling on unknown ids

--- src/checkmate/core.clj
+++ src/checkmate/core.clj
@@ -36,7 +36,11 @@
       {:error "There's already a list of this name, please choose a different one"})))

 (defn find-list [id]
-  (mc/find-map-by-id "lists" (ObjectId. id)))
+  (try
+    (mc/find-map-by-id "lists" (ObjectId. id))
+    (catch Exception e
+      (println e)
+      {:error (str "list " id " could not be found")})))

 (defn get-all-lists []
   (mc/find-maps "lists"))


Open the door for custom initialization code

--- src/clj/reply/main.clj
+++ src/clj/reply/main.clj
@@ -64,29 +64,30 @@
           (with-meta sym (assoc (meta value-var) :ns (the-ns ns)))
           @value-var))

-(def startup-code
+(def default-init-code
   '(do
+    (println "Welcome to REPL-y!")
+    (println "Clojure" (clojure-version))
+    (use '[clojure.repl :only (source apropos dir pst doc find-doc)])
+    (use '[clojure.java.javadoc :only (javadoc)])
+    (use '[clojure.pprint :only (pp pprint)])
+    (require '[cd-client.core])
     (def exit reply.main/exit)
     (def quit reply.main/exit)
     (def help reply.main/help)
+    (help)
     (reply.main/intern-with-meta 'user 'clojuredocs #'cd-client.core/pr-examples)))

-(defn setup-conveniences []
-  (in-ns 'user)
-  (use '[clojure.repl :only (source apropos dir pst doc find-doc)])
-  (use '[clojure.java.javadoc :only (javadoc)])
-  (use '[clojure.pprint :only (pp pprint)])
-  (require '[cd-client.core])
-  (eval startup-code)
-  (in-ns 'reply.main))
+(defn setup-conveniences
+  ([& {:keys [skip-default-init custom-init] :as options}]
+    (in-ns 'user)
+    (when-not skip-default-init (eval default-init-code))
+    (when custom-init (eval custom-init))
+    (in-ns 'reply.main)))

 (defn launch [args]
   (set-signal-handler! "INT" handle-ctrl-c)
   (set-signal-handler! "CONT" handle-resume)
-
-  (println "Welcome to REPL-y!")
-  (println "Clojure" (clojure-version))
-  (help)

   (with-redefs [clojure.core/print-sequential hacks.printing/print-sequential
                 complete/resolve-class hacks.complete/resolve-class
@@ -94,7 +95,7 @@
     (clojure.main/repl :read reply-read
           :eval reply-eval
           :print reply-print
-          :init setup-conveniences
+          :init #(setup-conveniences :skip-default-init false :custom-init '())
           :prompt (constantly false)
           :need-prompt (constantly false)))


get-price-from-url now parses price string to decimal

--- src/hackerati_interval_web_app/scrape.clj
+++ src/hackerati_interval_web_app/scrape.clj
@@ -1,6 +1,5 @@
 (ns hackerati-interval-web-app.scrape
-  (:require [clojure.string :as str]
-            [hackerati-interval-web-app.schema :as db])
+  (:require [clojure.string :as str])
   (:gen-class))

 (def ^:dynamic *user-agent*
@@ -37,8 +36,15 @@
 (defn get-price-from-url
   "URL should be from Amazon's mobile website
   http://www.amazon.com/gp/aw/h.html"
-  [url]
-  (second (re-matches price-regex (fetch-url url))))
+  [url]
+  (let [parse-$ #(if (= (first %1) \$)
+                   (Float/parseFloat (apply str (rest %1)))
+                   (Float/parseFloat %1))]
+    (->> url
+         fetch-url
+         (re-matches price-regex)
+         second
+         parse-$)))

 (defn get-price-from-urls
   "URL should be from Amazon's mobile website


dependencies updated

dependencies updated

--- iwaswhere-web/project.clj
+++ iwaswhere-web/project.clj
@@ -4,7 +4,7 @@
   :license {:name "GNU GENERAL PUBLIC LICENSE"
             :url  "http://www.gnu.org/licenses/gpl-3.0.en.html"}
   :dependencies [[org.clojure/clojure "1.8.0"]
-                 [org.clojure/clojurescript "1.8.34"]
+                 [org.clojure/clojurescript "1.8.40"]
                  [org.clojure/core.async "0.2.374"]
                  [org.clojure/tools.logging "0.3.1"]
                  [org.clojure/tools.namespace "0.2.11"]
@@ -20,9 +20,9 @@
                  [com.drewnoakes/metadata-extractor "2.8.1"]
                  [ubergraph "0.2.1"]
                  [camel-snake-kebab "0.3.2"]
-                 [matthiasn/systems-toolbox "0.5.16"]
+                 [matthiasn/systems-toolbox "0.5.17"]
                  [matthiasn/systems-toolbox-ui "0.5.7"]
-                 [matthiasn/systems-toolbox-sente "0.5.14"]
+                 [matthiasn/systems-toolbox-sente "0.5.15"]
                  [clj-time "0.11.0"]]

   :source-paths ["src/clj/"]


Use TaggedValue extension macro for BlobRef.

--- src/vault/blob.clj
+++ src/vault/blob.clj
@@ -47,13 +47,8 @@
     (str (name algorithm) ":" digest)))

-(extend-type BlobRef
-  data/TaggedValue
-  (edn-tag [this] 'vault/ref)
-  (edn-value [this] (str this)))
-
-
-(data/defprint-method BlobRef)
+; FIXME: this doesn't need to be here, could be declared later to remove dependency on vault.data
+(data/extend-tagged-str BlobRef vault/ref)


get rid of old comments

get rid of old comments

--- frontend/components/project_settings.cljs
+++ frontend/components/project_settings.cljs
@@ -1176,7 +1176,6 @@
          (if-not (get-in project-data [:project :vcs_url]) ; wait for project-settings to load
            [:div.loading-spinner common/spinner]
            [:div#project-settings
-            ; [:aside sidebar]
             [:div.project-settings-inner
              (om/build common/flashes (get-in data state/error-message-path))
              [:div#subpage
@@ -1187,7 +1186,6 @@
                 :setup (om/build dependencies project-data)
                 :tests (om/build tests project-data)
                 :hooks (om/build notifications project-data)
-                ; :webhooks (om/build webhooks project-data)
                 :badges (om/build status-badges project-data)
                 :ssh (om/build ssh-keys project-data)
                 :checkout (om/build checkout-ssh-keys {:project-data project-data :user user})
@@ -1196,5 +1194,4 @@
                 :heroku (om/build heroku {:project-data project-data :user user})
                 :deployment (om/build other-deployment project-data)
                 :aws (om/build aws project-data)
-                (om/build overview project-data))]]
-             ]))))))
+                (om/build overview project-data))]]]))))))


better logging?

better logging?

--- src/main/clojure/pdok/featured/config.clj
+++ src/main/clojure/pdok/featured/config.clj
@@ -6,14 +6,14 @@
              [projectors :as proj]
              [timeline :as timeline]]
             [environ.core :refer [env]]))
-;;LogManager.getLogManager().getLogger(Logger.GLOBAL_LOGGER_NAME).setLevel(Level.FINE);

 (-> (java.util.logging.LogManager/getLogManager) (.readConfiguration (io/input-stream (io/resource "logging.properties"))))

 (Thread/setDefaultUncaughtExceptionHandler
  (reify Thread$UncaughtExceptionHandler
    (uncaughtException [_ thread throwable]
-     (log/error throwable))))
+     (log/error throwable "Stacktrace:"
+                (print-str (clojure.stacktrace/print-stack-trace throwable))))))

 (def processor-db {:subprotocol "postgresql"
                      :subname (or (env :processor-database-url) "//localhost:5432/pdok")


:lipstick: Increment default persistence debounce timeout.

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -430,7 +430,7 @@
                               stream)
             notifier (->> stream
                           (rx/filter (ptk/type? ::commit-changes))
-                          (rx/debounce 1000)
+                          (rx/debounce 2000)
                           (rx/merge stoper))]
         (rx/merge
          (->> stream


fixed refined model

fixed refined model

--- src/crawler/corpus.clj
+++ src/crawler/corpus.clj
@@ -265,10 +265,10 @@
                                   (sort-by second (frequencies restrictions))))]
          (merge
           acc
-          {[(if (empty? (rest as))
+          {[(if (empty? (rest (reverse as)))
               nil
-              (rest as))
-            (first as)] chosen-restriction})))
+              (rest (reverse as)))
+            (first (reverse as))] chosen-restriction})))
      {}
      action-steps)))


pagination added

pagination added

--- src/crawler/corpus.clj
+++ src/crawler/corpus.clj
@@ -1,8 +1,10 @@
 (ns crawler.corpus
   "Tools for processing a downloaded corpus"
   (:require [cheshire.core :as json]
-            [clojure.java.io :as io])
-  (:use [clojure.pprint :only [pprint]]
+            [clojure.java.io :as io]
+            [crawler.dom :as dom])
+  (:use [clj-xpath.core :only [$x:node+]]
+        [clojure.pprint :only [pprint]]
         [structural-similarity.xpath-text :only [similar?]])
   (:import [java.io PushbackReader]))

@@ -38,6 +40,52 @@
           :candidate? (pagination-candidate? src-body tgt-body)}))
      corpus))))

+(defn body-links
+  [body]
+  (let [processed (dom/html->xml-doc body)
+        anchors   ($x:node+ ".//a" processed)]
+    (set
+     (map
+      #(dom/node-attribute % "href")
+      anchors))))
+
+(defn scored-pagination
+  [candidates-ns corpus]
+  (map
+   (fn [[candidate freq]]
+     (let [candidate-action (cons
+                             (:action candidate)
+                             (:src-xpath candidate))
+
+           items-at-action  (map
+                             (fn [[u x]]
+                               [u (:src-url x) (:body x)])
+                             (filter
+                              (fn [[u x]]
+                                (= (:src-xpath x)
+                                   candidate-action))
+                              corpus))
+
+           grouped-by-url   (group-by second items-at-action)
+
+           per-url-ratio    (map
+                             (fn [[url items]]
+                               (let [item-links (map
+                                                 (fn [[_ _ body]]
+                                                   (body-links body))
+                                                 items)
+
+                                     union (reduce clojure.set/union item-links)
+                                     int   (reduce clojure.set/intersection item-links)]
+                                 (count int)))
+                             grouped-by-url)
+
+           candidate-avg (double
+                          (/ (reduce + per-url-ratio)
+                             (count per-url-ratio)))]
+       [candidate candidate-avg]))
+   candidates-ns))
+
 (defn pagination-in-corpus
   [corpus]
   (let [candidates (-> corpus pagination-candidates frequencies)
@@ -54,8 +102,7 @@
                              (:src-xpath c))))
                   sorted-candidates)))
          sorted-candidates)]
-    (sort-by
-     pagination-candidate-score)))
+    (scored-pagination spurious-candidates-removed corpus)))

 (defn pagination-in-corpus-file
   [a-corpus-file]


Unbitrot codedeploy project settings.

Unbitrot codedeploy project settings.

Also update for new CodeDeploy revision_location structure.

--- frontend/components/project_settings.cljs
+++ frontend/components/project_settings.cljs
@@ -1131,20 +1131,18 @@
   (reify
     om/IRender
     (render [_]
-      (let [controls-ch (om/get-shared owner [:comms :controls])
-            input-path (fn [& ks] (apply conj state/inputs-path :aws :services :codedeploy ks))]
-        (html
-          [:div
-           [:form
-            [:input#application-name
-              {:required true, :type "text"
-               :on-change #(utils/edit-input controls-ch (conj state/inputs-path :project-settings-codedeploy-app-name) %)}]
-            [:label {:placeholder "Application Name"}]
-            [:input {:value "Add app settings",
-                     :type "submit"
-                     :on-click #(do
-                                 (put! controls-ch [:new-codedeploy-app-name-entered])
-                                 false)}]]])))))
+      (html
+        [:div
+         [:form
+          [:input#application-name
+            {:required true, :type "text"
+             :on-change #(utils/edit-input owner (conj state/inputs-path :project-settings-codedeploy-app-name) %)}]
+          [:label {:placeholder "Application Name"}]
+          [:input {:value "Add app settings",
+                   :type "submit"
+                   :on-click #(do
+                               (raise! owner [:new-codedeploy-app-name-entered])
+                               false)}]]]))))

 (defn aws-codedeploy-app-details [project-data owner]
   (reify
@@ -1178,12 +1176,11 @@
                                            (get-in inputs [:aws :services :codedeploy]))

             [app-name settings] (first applications)
-            {:keys [bucket key_pattern]} (:revision_location settings)
+            {:keys [bucket key_pattern]} (-> settings :revision_location :s3_location)
             application-root (:application_root settings)
             aws-region (:region settings)

             project-id (project-model/id project)
-            controls-ch (om/get-shared owner [:comms :controls])
             input-path (fn [& ks] (apply conj state/inputs-path :aws :services :codedeploy ks))]
         (html
          [:form
@@ -1194,7 +1191,7 @@
             [:select {:class (when (not aws-region) "placeholder")
                       :value (or aws-region "")
                       ;; Updates the project cursor in order to trigger a re-render
-                      :on-change #(utils/edit-input controls-ch (conj state/project-path :aws :services :codedeploy app-name :region) %)}
+                      :on-change #(utils/edit-input owner (conj state/project-path :aws :services :codedeploy app-name :region) %)}
              [:option {:value ""} "Choose AWS Region..."]
              [:option {:disabled "disabled"} "-----"]
              [:option {:value "us-east-1"} "us-east-1"]
@@ -1204,7 +1201,7 @@
            [:div.input-with-help
             [:input#application-root
              {:required true, :type "text", :value (or application-root "")
-              :on-change #(utils/edit-input controls-ch (input-path app-name :application_root) %)}]
+              :on-change #(utils/edit-input owner (input-path app-name :application_root) %)}]
             [:label {:placeholder "Application Root"}]
             [:i.fa.fa-question-circle#app-root-popover-hack {:title "Application Root"}]]]

@@ -1213,14 +1210,14 @@
            [:div.input-with-help
             [:input#s3-bucket
              {:required true, :type "text", :value (or bucket "")
-              :on-change #(utils/edit-input controls-ch (input-path app-name :revision_location :bucket) %)}]
+              :on-change #(utils/edit-input owner (input-path app-name :revision_location :s3_location :bucket) %)}]
             [:label {:placeholder "Bucket Name"}]
             [:i.fa.fa-question-circle#bucket-popover-hack {:title "S3 Bucket Name"}]]

            [:div.input-with-help
             [:input#s3-key-prefix
              {:required true, :type "text", :value (or key_pattern "")
-              :on-change #(utils/edit-input controls-ch (input-path app-name :revision_location :key_pattern) %)}]
+              :on-change #(utils/edit-input owner (input-path app-name :revision_location :s3_location :key_pattern) %)}]
             [:label {:placeholder "Key Pattern"}]
             [:i.fa.fa-question-circle#key-pattern-popover-hack {:title "S3 Key Pattern"}]]]

@@ -1232,8 +1229,9 @@
                           :value "Save app",
                           :type "submit"
                           :on-click #(do
-                                      (put! controls-ch [:saved-project-settings {:project-id project-id
-                                                                                :merge-paths [[:aws :services :codedeploy]]}])
+                                      (raise! owner [:edited-input {:path (input-path app-name :revision_location :revision_type) :value "S3"}])
+                                      (raise! owner [:saved-project-settings {:project-id project-id
+                                                                              :merge-paths [[:aws :services :codedeploy]]}])
                                       false)}])
            (forms/managed-button
             [:input.remove {:data-failed-text "Failed",
@@ -1242,10 +1240,9 @@
                             :value "Remove app",
                             :type "submit"
                             :on-click #(do
-                                         (put! controls-ch [:edited-input {:path (input-path) :value nil}])
-                                         (put! controls-ch [:saved-project-settings {:project-id project-id}])
+                                         (raise! owner [:edited-input {:path (input-path) :value nil}])
+                                         (raise! owner [:saved-project-settings {:project-id project-id}])
                                          false)}])]])))))
-

 (defn aws-codedeploy [project-data owner]
   (reify
@@ -1297,8 +1294,10 @@
                       "        application_root: /\n"
                       "        region: us-east-1\n"
                       "        revision_location:\n"
-                      "          bucket: my-bucket\n"
-                      "          key_pattern: appname-1234-{BRANCH}-{SHORT_COMMIT}\n"
+                      "          revision_type: S3\n"
+                      "          s3_location:\n"
+                      "            bucket: my-bucket\n"
+                      "            key_pattern: appname-1234-{BRANCH}-{SHORT_COMMIT}\n"
                       "        deployment_group: my-deployment-group\n"))]]]]])))))

 (defn follow-sidebar [project owner]


Use ajax instead of post (for which externs were failing)

--- src-cljs/dakait/net.cljs
+++ src-cljs/dakait/net.cljs
@@ -17,7 +17,10 @@
 (defn http-post
   "Post an HTTP request"
   [path params scb ecb]
-  (let [r (.post js/jQuery path (clj->js params))]
+  (let [r (.ajax js/jQuery
+                 (clj->js {:url path
+                           :type "POST"
+                           :data params}))]
     (doto r
       (.success scb)
       (.fail ecb))))
@@ -26,8 +29,8 @@
   "Post an HTTP delete request"
   [url scb ecb]
   (let [r (.ajax js/jQuery
-                 (js-obj "url" url
-                         "type" "DELETE"))]
+                 (clj->js {:url url
+                          :type "DELETE"}))]
     (doto r
       (.success scb)
       (.fail ecb))))


Add create entry link to topic in board response.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -29,12 +29,16 @@
 (defn- item-link [org-slug board-slug entry timestamp]
   (hateoas/item-link (url org-slug board-slug entry timestamp) {:accept mt/entry-media-type}))

-(defn- partial-update-link [org-slug board-slug entry timestamp]
-  (hateoas/partial-update-link (url org-slug board-slug entry timestamp) {:content-type mt/entry-media-type
-                                                                          :accept mt/entry-media-type}))
+(defn- create-link [org-slug board-slug topic-slug]
+  (hateoas/create-link (str (url org-slug board-slug topic-slug) "/") {:content-type mt/entry-media-type
+                                                                       :accept mt/entry-media-type}))

-(defn- delete-link [org-slug board-slug entry timestamp]
-  (hateoas/delete-link (url org-slug board-slug entry timestamp)))
+(defn- partial-update-link [org-slug board-slug topic-slug timestamp]
+  (hateoas/partial-update-link (url org-slug board-slug topic-slug timestamp) {:content-type mt/entry-media-type
+                                                                               :accept mt/entry-media-type}))
+
+(defn- delete-link [org-slug board-slug topic-slug timestamp]
+  (hateoas/delete-link (url org-slug board-slug topic-slug timestamp)))

 (defn- collection-link [org-slug board-slug topic-slug]
   (hateoas/collection-link (url org-slug board-slug topic-slug) {:accept mt/entry-collection-media-type}))
@@ -44,11 +48,13 @@
 (defn- entry-collection-links
   [entry board-slug org-slug access-level]
   (let [timestamp (:created-at entry)
+        topic-slug (:topic-slug entry)
         links [(collection-link org-slug board-slug entry)
                (item-link org-slug board-slug entry timestamp)]
         full-links (if (= access-level :author)
-                      (concat links [(partial-update-link org-slug board-slug entry timestamp)
-                                     (delete-link org-slug board-slug entry timestamp)])
+                      (concat links [(partial-update-link org-slug board-slug topic-slug timestamp)
+                                     (delete-link org-slug board-slug topic-slug timestamp)
+                                     (create-link org-slug board-slug topic-slug)])
                       links)]
     (assoc entry :links full-links)))


Remove debug

Remove debug

--- src/doctopus/shell.clj
+++ src/doctopus/shell.clj
@@ -17,9 +17,6 @@
     ([command args]
         (apply sh/sh (cons command args)))
     ([command args root-dir]
-     (println command)
-     (println args)
-     (println root-dir)
         (apply sh/sh (cons command (conj args :dir root-dir)))))

 (defn git-clone


fix formatting and tweak error message

fix formatting and tweak error message

--- src/overtone/sc/machinery/ugen/specs.clj
+++ src/overtone/sc/machinery/ugen/specs.clj
@@ -129,11 +129,11 @@
   (let [cur-rate (REVERSE-RATES (:rate ugen))
         ugen-args (filter sc-ugen? (:args ugen))]
     (when-let [bad-input (some
-                        (fn [ug]
-                          (if (< (UGEN-RATE-SPEED cur-rate)
-                                 (UGEN-RATE-SPEED (get REVERSE-RATES (:rate ug))))
-                            ug false))
-                        ugen-args)]
+                          (fn [ug]
+                            (if (< (UGEN-RATE-SPEED cur-rate)
+                                   (UGEN-RATE-SPEED (get REVERSE-RATES (:rate ug))))
+                              ug false))
+                          ugen-args)]
       ;;special cases
       (when-not (or
                  ;; Special case the a2k ugen
@@ -162,7 +162,7 @@
               cur-rate-name (get HUMAN-RATES cur-rate)
               in-rate-name  (get HUMAN-RATES (:rate-name bad-input))]
           (throw (Exception.
-                  (format "Invalid ugen rate.  The %s ugen is %s rate, but it has a %s input ugen running at the faster %s rate.  Besides the a2k ugen and demand rate ugens (which are allowed kr inputs), all ugens must be the same speed or faster than their inputs."
+                  (format "Invalid ugen rate.  The %s ugen is %s rate, but it has a %s input ugen running at the faster %s rate.  Besides special cases, the a2k ugen and demand rate ugens (which are allowed kr inputs), all ugens must be the same speed or faster than their inputs."
                           ugen-name cur-rate-name
                           in-name in-rate-name))))))
     ;;simply return the ugen if there's no problem with rates


Fixed kibit error in es-spatial-plugin.

Fixed kibit error in es-spatial-plugin.

--- es-spatial-plugin/src/cmr/es_spatial_plugin/spatial_script_helper.clj
+++ es-spatial-plugin/src/cmr/es_spatial_plugin/spatial_script_helper.clj
@@ -28,7 +28,7 @@
           false)
         (catch Throwable t
           (.printStackTrace t)
-          (.error logger (s/join "\n" (map #(.toString ^Object %) (.getStackTrace t))) nil)
+          (.error logger (s/join "\n" (map str (.getStackTrace t))) nil)
           (.info logger (pr-str ords-info) nil)
           (.info logger (pr-str ords) nil)
           (throw t))))


Hide y labels and horizontal lines on charts

--- src-cljs/acfe/chart.cljs
+++ src-cljs/acfe/chart.cljs
@@ -28,7 +28,9 @@
 		final-rows (map (partial map string->float) (cons first-row rest-rows))
 		data (.arrayToDataTable google.visualization (clj->js final-rows))
 		opts {:title (first first-row)
-			  :vAxis {:minValue 0}
+			  :vAxis {:minValue 0
+					  :textPosition "none"
+					  :gridlines {:color "transparent"}}
 			  :legend {:position "top" :maxLines 3}
 			  :isStacked (if stacked? "percent" false)}
 		chart (case chart-type


short-circuit pairs

short-circuit pairs

--- src/angelic/search/implicit/fah_astar_eval2.clj
+++ src/angelic/search/implicit/fah_astar_eval2.clj
@@ -28,6 +28,7 @@
 ;; TODO: tail caching?
 ;; TODO: cache refine-inputs and/or other SPs.
 ;; TODO: encapsulate stub/sp behaviors somehow.
+;; TODO: garbage collect dead stuff

 ;; TODO: remove extra stub indirection step when not needed?
 ;; (i.e., either reverse directions, or just have get-stub-output when known..)
@@ -133,6 +134,11 @@
     (do (summaries/connect! p c false)
         (add-watcher! c f))))

+(defn make-wrapping-stub [[name in-set] inner-stub sp-fn]
+  (let [ret (traits/reify-traits [summaries/or-summarizable (simple-stub name in-set)])]
+    (connect-and-watch-stub! ret inner-stub #(set-stub-output! ret (sp-fn ret %)))
+    ret))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -238,16 +244,14 @@

-
 ;; TODO: collect children too ?
 (declare make-output-collecting-subproblem)
 (defn make-output-collecting-stub [inner-stub]
   (assert (not (= (first (stub-name inner-stub)) :OS)))
-  (assert (not (= (first (stub-name inner-stub)) :SA)))
-  (let [in-set (input-set inner-stub)
-        ret (traits/reify-traits [summaries/or-summarizable (simple-stub [:OS (stub-name inner-stub) in-set] in-set)])]
-    (connect-and-watch-stub! ret inner-stub #(set-stub-output! ret (make-output-collecting-subproblem ret %)))
-    ret))
+  (assert (not (= (first (stub-name inner-stub)) :SA)))
+  (make-wrapping-stub
+   [[:OS (stub-name inner-stub)] (input-set inner-stub)]
+   inner-stub make-output-collecting-subproblem))

 (defn =-state-sets [s1 s2]
@@ -265,7 +269,7 @@
         (if (=-state-sets (output-set inner-sp) (output-set o))
           (do (connect-and-watch! ret o child-watch)
               (summaries/summary-changed! ret))
-          (do (if (#{:SA :OS} (first (stub-name (stub o))))
+          (do (if (#{:SA :OS} (first (subproblem-name o)))
                 (add-sp-child! ret o)
                 (connect-and-watch-stub! ret (make-output-collecting-stub (stub o)) #(add-sp-child! ret %)))))))
     ret))
@@ -275,9 +279,7 @@

 (declare make-state-abstracted-subproblem)
 (defn make-eager-state-abstracted-stub [inner-stub in-set]
-  (let [ret (traits/reify-traits [summaries/or-summarizable (simple-stub [:SA (stub-name inner-stub) in-set] in-set)])]
-    (connect-and-watch-stub! ret inner-stub #(set-stub-output! ret (make-state-abstracted-subproblem ret %)))
-    ret))
+  (make-wrapping-stub [[:SA (stub-name inner-stub)] in-set] inner-stub make-state-abstracted-subproblem))

 ;; DOTO: reduce overhead with deliberate?
@@ -422,15 +424,12 @@
                      (when (and (not @left-done?)
                                 (not (summary/live? (summaries/summary left-sp)))
                                 (not (= Double/NEGATIVE_INFINITY (summary/max-reward (summaries/summary left-sp))))) ;; TODO:??
-                       (reset! left-done? true) #_(println "BOO" pair-stub left-sp right-sp (class right-sp))
+                       (reset! left-done? true)
                        (summaries/disconnect! s ss)
                        (add-watcher! left-sp (fn [o] (def *sum* [s left-sp o])
                                                (throw (RuntimeException. "Solved and children."))))
-                       ;; TODO: do more efficiently?
                        (connect-and-watch-stub! s (make-pair-stub2 subsuming-sp left-sp (stub right-sp))
-                                           (fn [os] (connect-and-watch! s os #(add-sp-child! s %))))
- ;                       (add-sp-child! s (make-pair-subproblem subsuming-sp pair-stub left-sp right-sp))
-                       )
+                                           (fn [os] (connect-and-watch! s os #(add-sp-child! s %)))))
                      (summaries/or-summary s b))))
              (fn [s ri] (make-pair-stub1 s (refine-input left-sp ri)
                           (subproblem-name right-sp) #(refine-input right-sp %)))
@@ -446,31 +445,34 @@

     ret))

-;; TODO: remove children as they are no longer needed ?
 (defn- make-pair-stub2 [subsuming-sp left-sp right-stub]
-  (let [ret (traits/reify-traits
-             [summaries/sum-summarizable
-              (simple-stub [:Pair (subproblem-name left-sp) (stub-name right-stub)]
-                           (input-set (stub left-sp)))])]
-    (connect-subsuming! ret subsuming-sp)
-    (summaries/connect! ret (tree-summarizer left-sp) false)
-    (connect-and-watch-stub! ret right-stub
-      #(set-stub-output! ret (make-pair-subproblem subsuming-sp ret left-sp %)))
-    ret))
+  (let [nm [:Pair (subproblem-name left-sp) (stub-name right-stub)]
+        is (input-set (stub left-sp))]
+    (if (get-stub-output right-stub) ;; short-circuit the mess below
+      (doto (make-wrapping-stub [nm is] right-stub #(make-pair-subproblem subsuming-sp %1 left-sp %2))
+        (-> get-stub-output assert)) ;; summary of wrapping stub would be wrong, otherwise...
+      (let [ret (traits/reify-traits [summaries/sum-summarizable (simple-stub nm is)])]
+        (connect-subsuming! ret subsuming-sp)
+        (summaries/connect! ret (tree-summarizer left-sp) false)
+        (connect-and-watch-stub! ret right-stub
+                                 #(set-stub-output! ret (make-pair-subproblem subsuming-sp ret left-sp %)))
+        ret))))

 (defn- make-pair-stub1 [subsuming-sp left-stub right-name right-stub-fn]
-  (let [ret (traits/reify-traits [summaries/or-summarizable
-                                  (simple-stub [:Pair1 (stub-name left-stub) right-name]
-                                               (input-set left-stub))])]
-    (connect-subsuming! ret subsuming-sp)
-    (connect-and-watch-stub! ret left-stub
-      (fn [lo]
-        (connect-and-watch-stub! ret
-          (make-pair-stub2 subsuming-sp lo (right-stub-fn (output-set lo)))
-          #(set-stub-output! ret %))
-        (summaries/summary-changed! ret))) ;; TODO: wasteful?
+  (if-let [left-sp (get-stub-output left-stub)]
+    (make-pair-stub2 subsuming-sp left-sp (right-stub-fn (output-set left-sp)))
+   (let [nm [:Pair1 (stub-name left-stub) right-name]
+         is (input-set left-stub)
+         ret (traits/reify-traits [summaries/or-summarizable (simple-stub nm is)])]
+     (connect-subsuming! ret subsuming-sp)
+     (connect-and-watch-stub! ret left-stub
+       (fn [lo]
+         (connect-and-watch-stub! ret
+           (make-pair-stub2 subsuming-sp lo (right-stub-fn (output-set lo)))
+           #(set-stub-output! ret %))
+         (summaries/summary-changed! ret))) ;; TODO: wasteful?

-    ret))
+     ret)))

 (defn- make-fs-seq-stub


Delete comment

Delete comment

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -319,7 +319,6 @@
      (printer/indent (string/join ", " (:val problem)))
      (if (:print-specs? opts) (relevant-specs problems) ""))))

-;; HERE
 (defmethod problem-group-str :problem/fspec-ret-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]


Refactor

Refactor

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -88,28 +88,29 @@
    that helps the user understand where that path is located
    in the form"
   [opts spec-name form path value]
-  ;; TODO - refactor
-  (if (= :fn spec-name)
-    (printer/indent (binding [*print-namespace-maps* false] (ansi/color (pr-str form) :bad-value)))
-    ;; TODO - refactor to lift binding
-    ;; TODO - refactor to cond
-    (if (= form value)
-      (printer/indent (binding [*print-namespace-maps* false] (ansi/color (printer/pprint-str value) :bad-value)))
-      (if path
-        ;; FIXME: It's silly to reconstruct a fake "problem"
-        ;; after I've deconstructed it, but I'm not yet ready
-        ;; to break the API for value-in-context BUT
-        ;; I do want to test that a problems-based API
-        ;; is useful.
-        ;; See https://github.com/bhb/expound#configuring-the-printer
-        (printer/indent (problems/highlighted-value opts
+  (binding [*print-namespace-maps* false]
+    (cond
+      (= :fn spec-name)
+      (printer/indent (ansi/color (pr-str form) :bad-value))
+
+      (= form value)
+      (printer/indent (ansi/color (printer/pprint-str value) :bad-value))
+
+      ;; FIXME: It's silly to reconstruct a fake "problem"
+      ;; after I've deconstructed it, but I'm not yet ready
+      ;; to break the API for value-in-context BUT
+      ;; I do want to test that a problems-based API
+      ;; is useful.
+      ;; See https://github.com/bhb/expound#configuring-the-printer
+      path
+      (printer/indent (problems/highlighted-value opts
                                                     {:expound/form form
                                                      :expound/in path
                                                      :expound/value value}))
-
-        (printer/format
-         "Part of the value\n\n%s"
-         (printer/indent (binding [*print-namespace-maps* false] (ansi/color (pr-str form) :bad-value))))))))
+      :else
+      (printer/format
+       "Part of the value\n\n%s"
+       (printer/indent (ansi/color (pr-str form) :bad-value))))))

 (defn ^:private spec-str [spec]
   (if (keyword? spec)
@@ -307,7 +308,6 @@
        (conformed-value problems invalid-value)
        ""))))

-;; TODO - rename val -> form
 (defmethod value-str :default [_type spec-name form path problems opts]
   (show-spec-name spec-name (value-and-conformed-value problems spec-name form path {:show-conformed? true})))


Added new constraints

Added new constraints

--- infant/src/infant/constraint/constraint.clj
+++ infant/src/infant/constraint/constraint.clj
@@ -42,3 +42,15 @@
                              (sp/support-role? (::sp/channel field) (sp/get-measure-type field))
                              )
                            )})
+
+
+(def spec-constraints #{
+                        ->Constraint
+                        "no-repeated-channel"
+                        "Each encoding shall be used only once"
+                        #{::sp/channel}
+                        true
+                        (fn [spec]
+                          (apply distinct?
+                                 (map (fn [f] (::sp/channel f)) (::sp/fields spec))))
+                        })


Doc and better support for parsing exceptions

--- src/aerobio/pgmgraph.clj
+++ src/aerobio/pgmgraph.clj
@@ -59,7 +59,19 @@

-(defmacro future+ [& body]
+(defmacro future+
+  "Protected future task running. `body' is a set of expressions to run
+  in a separate thread. These are wrapped in a `try' expression with
+  specific arms for Error, ExceptionInfo, and general runtime
+  Exception. For each of these an attempt is made to construct a
+  meaningful message from the various pieces of exception
+  information.
+
+  This is used to launch all program flow graph nodes, so that any
+  problems in the processing of a node may be caught and (with a
+  dollop of luck...) handled and then used in a controlled shutdown of
+  the remaining graph."
+  [& body]
   `(future
      (try
        ~@body
@@ -69,9 +81,11 @@
                     (str/split #"\n") first (str/split #": ") rest
                     (->> (str/join ": ")))})
        (catch clojure.lang.ExceptionInfo e#
-         {:error (type e#) :msg (str (.getMessage e#) ": " (.getData e#))})
+         {:error (type e#)
+          :msg (str (.getMessage e#) ": " (.getData e#))})
        (catch Exception e#
-         {:error (type e#), :msg ((Throwable->map e#) :cause)}))))
+         {:error (type e#), :cause ((Throwable->map e#) :cause)
+          :msg (-> e# Throwable->map :via first :message)}))))

 (defn init-pgms
@@ -846,9 +860,10 @@

 (defn run-flow-program
-  "Takes a data flow graph, as produced by a 'make-pipeline',
-   activates the nodes and runs the graph to completion
-  "
+  "Takes a data flow graph, as produced by a 'make-pipeline', activates
+  the nodes and runs the graph to completion. Wraps each node body in
+  exception protection and ensures errors are propagated to driver for
+  status report."
   [dfg]
   (mapv (fn[node]
           (future+
@@ -864,11 +879,13 @@
                                  msg))
                        (format "Done, node %s" (-> node first :id)))]
              (infof "%s" msg)
-             {:request {:name (-> node first :name)
+             {:request {:name (-> node first :id)
                         :args (-> node first :args)
                         :msg msg}
               :result jnres})))
         dfg))
+
+

 (comment


master: Fixed a couple of syntax errors.

--- src/gmail_clj/core.clj
+++ src/gmail_clj/core.clj
@@ -244,7 +244,7 @@
 (defn label-delete
   "Deletes the specified label and removes it from any messages and threads that it is applied to."
   [label-id]
-  (api-request :delete (str "/users/me/labels/" label-id) params :auth (get-token)))
+  (api-request :delete (str "/users/me/labels/" label-id) {} :auth (get-token)))

 (defn label-list
   "Lists all labels in the user's mailbox."
@@ -316,7 +316,7 @@
   [& {:keys [includeSpamTrash labelIds maxResults pageToken q]
       :or {includeSpamTrash false maxResults 25}}]
   (let [labelIds (clojure.string/join "&" (map #(str "labelIds=" %) labelIds))
-        params {:includeSpamTrash includePamTrash
+        params {:includeSpamTrash includeSpamTrash
                 :maxResults maxResults
                 :pageToken pageToken
                 :q q}]


Rename random 2d sequence generator

Rename random 2d sequence generator

--- src/gol/client/bl.cljs
+++ src/gol/client/bl.cljs
@@ -23,10 +23,10 @@
   [w h]
   (comp set (partial filter-on-viewport w h) step))

-(defn rand-2d
+(defn rand-2d-seq
   [width height]
-  (cons [(rand-int width) (rand-int height)] (lazy-seq (rand-2d width height))))
+  (cons [(rand-int width) (rand-int height)] (lazy-seq (rand-2d-seq width height))))

 (defn rand-population
   [width height]
-  (distinct (rand-2d width height)))
+  (distinct (rand-2d-seq width height)))


more consistent naming of an argument

more consistent naming of an argument

--- src/cu/results.clj
+++ src/cu/results.clj
@@ -12,8 +12,8 @@
 (defn job-names [log-keys]
   (set (map job-name log-keys)))

-(defn- passed-job-name? [job-name]
-  (re-find #"-exit-0$" job-name))
+(defn- passed-job-name? [log-key]
+  (re-find #"-exit-0$" log-key))

 (defn passed-job-names [log-keys]
   (job-names (filter passed-job-name? log-keys)))


omit special handling of array arguments containing result column types

--- src/asphalt/internal.clj
+++ src/asphalt/internal.clj
@@ -408,15 +408,7 @@
             (aset row i (read-column-value result-set j))
             (recur j))))
       row))
-  (^objects [^ResultSet result-set ^long column-count ^bytes column-types]
-    (let [^objects row (object-array column-count)]
-      (loop [i (int 0)]
-        (when (< i column-count)
-          (let [j (unchecked-inc i)]
-            (aset row i (read-column-value result-set j (aget ^bytes column-types i)))
-            (recur j))))
-      row))
-  (^objects [^ResultSet result-set ^long column-count column-types _]
+  (^objects [^ResultSet result-set ^long column-count column-types]
     (let [^objects row (object-array column-count)]
       (loop [i (int 0)]
         (when (< i column-count)
@@ -610,7 +602,7 @@
       (read-column-value result-set column-index)))
   (read-row   [m ^ResultSet result-set ^long column-count]
     (if-let [types (:result-types m)]
-      (read-columns result-set column-count types :vector)
+      (read-columns result-set column-count types)
       (read-columns result-set column-count)))
   ;;====
   String