Add virtual streams for projections

Add virtual streams for projections

--- src/photon/streams.clj
+++ src/photon/streams.clj
@@ -25,6 +25,7 @@
 (defonce publications (ref {}))
 (defonce global-channels (ref {}))
 (defonce active-streams (ref {}))
+(defonce virtual-streams (ref {}))

 ;; Stream protocols and multimethods
@@ -46,6 +47,7 @@
   (init-stream-manager! [this])
   (update-streams! [this stream-name])
   (create-stream-endpoint! [this stream-name])
+  (create-virtual-stream-endpoint! [this stream-name])
   (streams [this]))

 (defmulti stream (fn [_ params]
@@ -149,6 +151,12 @@
                     (assoc-in old-active-streams
                               [this :real-streams]
                               (conj real-streams stream-name)))))))))
+  (create-virtual-stream-endpoint! [this stream-name]
+    (let [ch (chan (sliding-buffer 1))]
+      (dosync (alter virtual-streams assoc stream-name ch))
+      (mcc/stream-source
+       {:m m} (str "virtual/" stream-name)
+       (fn [params] ch))))
   (create-stream-endpoint! [this stream-name]
     ;; TODO: Fix this mess
     (if (not (nil? m))
@@ -173,9 +181,11 @@
   (next! [this] (go (<! (:channel (global-channel this)))))
   EventProcessor
   (register-query! [this projection-name stream-name lang f init]
+    (create-virtual-stream-endpoint! this projection-name)
     (let [s-name (if (nil? stream-name) "__all__" stream-name)
           function-descriptor (generate-function lang f)
           function (:computable function-descriptor)
+          ch (get @virtual-streams projection-name)
           s (stream this {"from" "0" "stream-type" "hot-cold"
                           "stream-name" s-name})
           running-query (ref {:projection-name projection-name
@@ -201,37 +211,41 @@
                                 (.printStackTrace e)
                                 e))
                   current-time (- (System/currentTimeMillis) start-ts)]
+              (>! ch new-value)
               (if (instance? Exception new-value)
-                (dosync
-                  (alter running-query
-                         merge {:last-event current-event
-                                :avg-time (next-avg
+                (do
+                  (close! ch)
+                  (dosync
+                   (alter virtual-streams dissoc projection-name)
+                   (alter running-query
+                          merge {:last-event current-event
+                                 :avg-time (next-avg
                                             (:avg-time @running-query)
                                             current-time
                                             (:processed @running-query))
-                                :processed (inc (:processed @running-query))
-                                :last-error new-value
-                                :status :failed}))
+                                 :processed (inc (:processed @running-query))
+                                 :last-error new-value
+                                 :status :failed})))
                 (do
                   (dosync
-                    (alter running-query
-                           merge {:last-event current-event
-                                  :avg-time (next-avg
-                                              (:avg-time @running-query)
-                                              current-time
-                                              (:processed @running-query))
-                                  :current-value new-value
-                                  :processed (inc (:processed @running-query))}))
+                   (alter running-query
+                          merge {:last-event current-event
+                                 :avg-time (next-avg
+                                            (:avg-time @running-query)
+                                            current-time
+                                            (:processed @running-query))
+                                 :current-value new-value
+                                 :processed (inc (:processed @running-query))}))
                   (recur new-value (<! s))))))))))
   (process-event! [this msg]
-    ;; Think about the order of store+send to taps
-    (println "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! " (pr-str msg))
-    (update-streams! this (get msg "stream-name"
-                               (get msg :stream-name)))
-    (go (>! (:channel (global-channel this)) msg)
-        (>! (:channel (publisher this)) msg))
-    (db/store db msg)
-    {:correct "true"}))
+                  ;; Think about the order of store+send to taps
+                  (println "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! " (pr-str msg))
+                  (update-streams! this (get msg "stream-name"
+                                             (get msg :stream-name)))
+                  (go (>! (:channel (global-channel this)) msg)
+                      (>! (:channel (publisher this)) msg))
+                  (db/store db msg)
+                  {:correct "true"}))

 (defmethod stream "cold" [a-stream params]
   (log/info "cold-stream" (pr-str params))


Smallmods

Smallmods

--- src/connect5_ai/core.clj
+++ src/connect5_ai/core.clj
@@ -157,7 +157,7 @@
              :else 0))
            ))
         ; Types identiques ou mur
-        (let [op (if (or (= :min prev-left-streak-type) (= :min prev-right-streak-type)) - +)]
+        (let [op (if (or (= :min prev-left-streak-type) (= :min prev-right-streak-type)) + +)]
           (op (cond
           (= :wall prev-left-streak-type prev-right-streak-type) 0;
           (= 4 (+ prev-left-direct-streak prev-right-direct-streak)) (if (or
@@ -398,9 +398,9 @@
         tstate (transient state)]

     (assoc! tstate is-first-player (conj (state is-first-player) position))
-    (assoc! tstate :heuristic-result (get-value-for-state grid-w
+    (assoc! tstate :heuristic-result (- (get-value-for-state grid-w
                                                           grid-h
-                                                          state))
+                                                          state)))
     (persistent! tstate)))

   (defn generate-successor-states
@@ -507,7 +507,7 @@
     "Gets the next best move"
     [charmat timeout]
     (let [ret-chan (async/chan (async/sliding-buffer 1))
-          timeout-chan (async/timeout (- timeout 10))
+          timeout-chan (async/timeout timeout)
           got-time? (atom true)
           charmat-seq (lazy-seq charmat)
           state (gen-map-from-charmat charmat-seq {true #{} false #{}} 0)


Now the toolbar is on top

Now the toolbar is on top

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

--- conexp/gui/base.clj
+++ conexp/gui/base.clj
@@ -119,8 +119,11 @@
       (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
       (.setSize 1000 800)
       (.setJMenuBar (JMenuBar.))
-      (.setContentPane (JPanel. (BorderLayout.)))
-      (.. getContentPane (add (JToolBar.))))
+      (.setContentPane (JPanel. (BorderLayout.))))
     (add-menus main-frame *standard-menus*)
-    (add-icons main-frame *standard-icons*)
+    (let [toolbar (JToolBar.)]
+      (.. main-frame getContentPane (add toolbar BorderLayout/PAGE_START))
+      (add-icons main-frame *standard-icons*))
+    (let [main-panel (JPanel.)]
+      (.. main-frame getContentPane (add main-panel)))
     main-frame))


add a navbar showing the current user

add a navbar showing the current user

--- src/greybear/pages/layout.clj
+++ src/greybear/pages/layout.clj
@@ -9,4 +9,13 @@
     [:title (str "Grey Bear - " subtitle)]
     (include-css "/bootstrap/css/bootstrap.css")]
    [:body
+    [:div.navbar
+     [:div.navbar-inner
+      [:a.brand {:href "/"} "Greybear"]
+      [:div#user-links
+       [:ul.nav
+        (let [username (session-get :username false)]
+          (if username
+            [:li [:a {:href (str "/users/" username)} username]]
+            [:li [:a {:href "/login"} "Login"]]))]]]]
     [:div#content content]]))


Unnecessary functions removed from routes.core namespace

--- src/hellhound/routes/core.clj
+++ src/hellhound/routes/core.clj
@@ -49,42 +49,3 @@
                    func
                    (bidi/tag func tag))]
      {method [url handler]})))
-
-(defn get_
-  "A shortcut function to create a route which is responsible
-  a get request to the given url."
-  [url func]
-  (make-route :get url func))
-
-(def POST
-  "A shortcut function to create a route which is responsible
-  a get request to the given url."
-  (partial make-route :post))
-
-(def HEAD
-  "A shortcut function to create a route which is responsible
-  a get request to the given url."
-  (partial make-route :head))
-
-(def DELETE
-  "A shortcut function to create a route which is responsible
-  a get request to the given url."
-  (partial make-route :delete))
-
-(def PUT
-  "A shortcut function to create a route which is responsible
-  a get request to the given url."
-  (partial make-route :put))
-
-(def PATCH
-  "A shortcut function to create a route which is responsible
-  a get request to the given url."
-  (partial make-route :patch))
-
-
-(defn defroutes
-  [name & body]
-  (let [res (merge body [true (fn [req]  {:status 404
-                                          :headers {"Content-Type" "text/plain"}
-                                          :body "nnnn"})])]
-    (make-handler body)))


fixed stopwords syntax error

fixed stopwords syntax error

--- src/help_me_im_dumb/index.clj
+++ src/help_me_im_dumb/index.clj
@@ -11,10 +11,10 @@
 (def URL-MAPPING-FILENAME "resources/url-mapping.txt")
 (def DOCID-DOC-MAPPING-DB "docid-doc-mapping")

+; List of words to ignore
+; source: http://www.wordfrequency.info/free.asp?s=y
 (def STOP-WORDS
-  "List of words to ignore"
-  " source: http://www.wordfrequency.info/free.asp?s=y "
-  #{"the" "be" "and" "of" "a" "in" "to" "have" "it" "i" "that" "for" "you" "he" "she" "with" "on" "do" "say" "this" "they" "at" "but" "we" "is" "his" "hers"})
+  #{"the" "am" "be" "and" "of" "a" "in" "to" "have" "it" "i" "that" "for" "you" "he" "she" "with" "on" "do" "say" "this" "they" "at" "but" "we" "is" "his" "hers"})

 (defn not-stop-word?
   [w]


Fix session windows cljs support.

Fix session windows cljs support.

--- src/onyx/windowing/window_extensions.cljc
+++ src/onyx/windowing/window_extensions.cljc
@@ -78,8 +78,12 @@
   [extents session-time]
   (loop [extent (first extents)
          vs (rest extents)
-         closest-below [Long/MAX_VALUE nil]
-         closest-above [Long/MAX_VALUE nil]]
+         closest-below [#?(:clj Long/MAX_VALUE
+                           :cljs (.-POSITIVE_INFINITY js/Number))
+                        nil]
+         closest-above [#?(:clj Long/MAX_VALUE
+                           :cljs (.-POSITIVE_INFINITY js/Number))
+                        nil]]
     (if (nil? extent)
       [(second closest-below)
        (second closest-above)]


Additional logging to debug deadlocked test (#46)

--- waiter/test/waiter/metrics_sync_test.clj
+++ waiter/test/waiter/metrics_sync_test.clj
@@ -14,6 +14,7 @@
             [clojure.set :as set]
             [clojure.string :as str]
             [clojure.test :refer :all]
+            [clojure.tools.logging :as log]
             [qbits.jet.client.websocket :as ws]
             [waiter.async-utils :as au]
             [waiter.metrics :as metrics]
@@ -280,6 +281,7 @@
       (incoming-router-metrics-handler router-metrics-agent 10 encrypt decrypt ws-request)
       (let [release-chan (async/chan 1)]
         (async/go-loop [iteration 0]
+          (log/debug "processing iteration" iteration)
           (let [raw-data (cond-> {:router-metrics {"s1" {:iteration iteration}, "s2" {:iteration iteration}},
                                   :source-router-id source-router-id,
                                   :time (str "time-" iteration)}
@@ -288,10 +290,11 @@
           (when (< iteration iteration-limit)
             (recur (inc iteration))))
         (async/<!! release-chan))
-      (test-helpers/wait-for
-        #(let [out-router-metrics-state @router-metrics-agent]
-           (= (str "time-" iteration-limit) (get-in out-router-metrics-state [:last-update-times source-router-id])))
-        :interval 1000, :unit-multiplier 1)
+      (is (test-helpers/wait-for
+            #(let [out-router-metrics-state @router-metrics-agent]
+               (log/debug "router-metrics-state:" out-router-metrics-state)
+               (= (str "time-" iteration-limit) (get-in out-router-metrics-state [:last-update-times source-router-id])))
+            :interval 1000, :unit-multiplier 1))
       (let [query-agent-state (fn [agent-state response-chan] (async/>!! response-chan agent-state) agent-state)
             response-chan (async/promise-chan)
             _ (send router-metrics-agent query-agent-state response-chan)


Add constrained edge flipping.

Add constrained edge flipping.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -44,7 +44,7 @@
    {:class "clickable"
     :id id
     :d (make-line-dirs from to)
-    :stroke color
+    :stroke (name color)
     :stroke-width "10px"
     :fill "none"
     :marker-start "url(#Vertex)"
@@ -60,15 +60,19 @@
       (.-id)))

-(def vertex-loc [[40 40]
-                 [300 40]
-                 [300 300]
-                 [40 300]])
+(def vertices [[0 [40 40]]
+               [1 [300 40]]
+               [2 [300 300]]
+               [1 [40 300]]])

-(def bare-edges [[0 1 "red"]
-                [1 2 "blue"]
-                [2 3 "red"]
-                [3 1 "red"]])
+
+(def bare-edges [[0 1 :red]
+                 [1 2 :blue]
+                 [2 3 :red]
+                 [3 1 :red]])
+
+(def color->value {:red 1
+                   :blue 2})

 (defn name-edges [bare-edges]
   (let [edge-ids (map (partial str "edge") (range))]
@@ -91,7 +95,7 @@

 (defn make-edges [{:keys [vertices edges]}]
-  (vertex-id->points edges vertices))
+  (vertex-id->points edges (mapv second vertices)))

 (defn make-svg [[width height] edges]
@@ -109,19 +113,31 @@
                                 (make-svg [1000 1000]
                                           (make-edges world-state))])))

-(defn flip-edge [[left right color]]
-  [right left color])
+(defn ok-to-flip? [{:keys [vertices edges]} [left right color]]
+  (let [this-value (color->value color)
+        entering-right (filter #(= right (second (second %))) edges)
+        sum-into-right (apply + (map #(color->value ((second %) 2)) entering-right))
+        right-value (first (vertices right))]
+    (if (< (- sum-into-right this-value) right-value)
+      false
+      true)))
+
+(defn flip-edge [world-state [left right color :as edge]]
+  (if (ok-to-flip? world-state edge)
+    [right left color]
+    edge))

 (defn update-state [event world-state]
-  (let [clicked-what (event->targetid event)]
-    (if (= clicked-what "forsvg")
-      world-state
-      (update-in world-state [:edges clicked-what] flip-edge))))
+  (let [clicked-what (event->targetid event)
+        constrained-flip (partial flip-edge world-state)]
+    (if (re-matches #"edge.*" clicked-what)
+      (update-in world-state [:edges clicked-what] constrained-flip)
+      world-state)))

 (go
   (big-bang!
-    :initial-state {:vertices vertex-loc
+    :initial-state {:vertices vertices
                     :edges (name-edges bare-edges)}
     :to-draw draw-world
     :on-click update-state))


selfdual2d.clj: little bit of refactoring.

--- clojure/org/gavrog/clojure/selfdual2d.clj
+++ clojure/org/gavrog/clojure/selfdual2d.clj
@@ -12,8 +12,12 @@

 (defn proto-euclidean? [ds] (>= (curvature ds 1) 0))

+(defn andp [& preds]
+  (fn [& args]
+    (reduce #(and %1 (apply %2 args)) true preds)))
+
 (defn d-sets [max-size]
   (let [G (FundamentalGroup. (DSymbol. "1:1,1,1:0,0"))]
-    (filter #(and (self-dual? %) (proto-euclidean? %))
+    (filter (andp self-dual? proto-euclidean?)
             (map #(.flat (DSCover. G %))
                  (SmallActionsIterator. (.getPresentation G) max-size false)))))


simplify3d.clj: some work toward recognizing local 2 cuts

--- clojure/org/gavrog/clojure/simplify3d.clj
+++ clojure/org/gavrog/clojure/simplify3d.clj
@@ -1,8 +1,6 @@
 (ns org.gavrog.clojure.simplify3d
-  (:use (org.gavrog.clojure
-          delaney
-          fundamental
-          util)))
+  (:use (clojure set)
+        (org.gavrog.clojure delaney fundamental util)))

 (defn merge-volumes [ds]
   (let [idx (last (indices ds))]
@@ -23,6 +21,9 @@
   (-> ds dual merge-facets dual))

 ;; === The following are specific to 3d symbols
+
+(defn- orbits [ds idcs]
+  (map (partial orbit-elements ds idcs) (orbit-reps ds idcs)))

 (defn- representatives-map [ds idcs]
   (into {} (for [D (orbit-reps ds idcs)
@@ -49,6 +50,25 @@
   (when-let [[D E] (first (local-1-cuts ds))]
     (pinch-face ds D E)))

+(defn- face-intersections [ds]
+  (let [vert-rep (representatives-map ds [1 2])
+        ori (partial-orientation ds)
+        faces (vec (map (partial filter (comp pos? ori)) (orbits ds [0 1])))]
+    (for [i (range (count faces))
+          j (range (inc i) (count faces))
+          :let [[f g] (map faces [i j])
+                [vf vg] (map (comp set (partial map vert-rep)) [f g])
+                common (intersection vf vg)]
+          :when (pos? (count common))]
+      [f g common])))
+
+(defn- local-2-cuts [ds]
+  (filter (fn [[f g common]]
+            (let [verts (map (fn [D] (set (orbit-elements ds [1 2] D))) common)
+                  _ (println verts)]
+            ))
+          (face-intersections ds)))
+
 (defn- pinch-tile [ds D E]
   (let [[D* E*] (map (partial s ds 0) [D E])
         [F G F* G*] (map (partial s ds 2) [D E D* E*])


Improve styling of code blocks

Improve styling of code blocks

--- src/braid/client/ui/styles/message.cljs
+++ src/braid/client/ui/styles/message.cljs
@@ -5,6 +5,8 @@
             [braid.client.ui.styles.hljs :refer [hljs-styles]]
             [garden.arithmetic :as m]
             [garden.units :refer [rem px]]))
+
+(def message-left-pad  (m/+ avatar-size (rem 0.5)))

 (def message
   [:.message
@@ -73,7 +75,7 @@
     {:white-space "pre-wrap"
      :word-break "break-word"
      :display "inline-block"
-     :padding-left (m/+ avatar-size (rem 0.5))
+     :padding-left message-left-pad
      :width "100%"
      :box-sizing "border-box"
      :line-height "1.25em"
@@ -102,18 +104,30 @@

     [:&.inline
      {:padding "0.25em 0.5em"
-      :display "inline-block"}]
+      :display "inline-block"
+      :text-overflow "ellipsis"
+      :overflow-x "hidden"
+      :max-width "100%"
+      :vertical-align "middle"
+      :margin 0}
+
+     [:&:hover
+      {:text-overflow "initial"
+       :overflow-x "scroll"}]]

     [:&.multiline
      {:display "block"
-      :text-overflow "ellipsis"
-      :white-space "pre"
-      :word-break "normal"
-      :width "100%"
-      :overflow-x "hidden"
-      :box-sizing "border-box"
-      :padding "0.5em"}
+      :margin [[0 0 0 (m/* -1 (m/+ pad message-left-pad))]]
+      :width card-width}

-     [:&:hover
-      {:text-overflow "initial"
-       :overflow-x "scroll"}]]]])
+     [:>code
+      {:overflow-x "hidden"
+       :display "block"
+       :box-sizing "border-box"
+       :padding "1em"
+       :width "100%"
+       :text-overflow "ellipsis"}
+
+       [:&:hover
+        {:text-overflow "initial"
+         :overflow-x "scroll"}]]]]])


make things private that don't need to be public

--- src/clj/lambdacd/internal/execution.clj
+++ src/clj/lambdacd/internal/execution.clj
@@ -55,7 +55,7 @@
     (finally
       (async/close! (:result-channel ctx)))))

-(defn reuse-from-history-if-required [{:keys [step-id] :as ctx} {build-number-to-resuse :reuse-from-build-number :as result}]
+(defn- reuse-from-history-if-required [{:keys [step-id] :as ctx} {build-number-to-resuse :reuse-from-build-number :as result}]
   (if build-number-to-resuse
     (let [state @(:_pipeline-state ctx)
           old-result (get-in state [build-number-to-resuse step-id])]
@@ -120,7 +120,7 @@
     out-ch))

-(defn unify-statuses [statuses]
+(defn- unify-statuses [statuses]
   (let [has-failed (util/contains-value? :failure statuses)
         has-running (util/contains-value? :running statuses)
         all-waiting (every? #(= % :waiting) statuses)
@@ -207,16 +207,16 @@
                                                           :step-id []
                                                           :build-number build-number})))))

-(defn add-result [new-build-number retriggered-build-number initial-ctx [step-id result]]
+(defn- add-result [new-build-number retriggered-build-number initial-ctx [step-id result]]
   (let [ctx (assoc initial-ctx :build-number new-build-number :step-id step-id)
         result-with-annotation (assoc result :retrigger-mock-for-build-number retriggered-build-number)]
     (pipeline-state/update ctx result-with-annotation)))

-(defn to-be-duplicated? [step-id-retriggered [cur-step-id _]]
+(defn- to-be-duplicated? [step-id-retriggered [cur-step-id _]]
   (let [result (step-id/before? cur-step-id step-id-retriggered)]
     result))

-(defn duplicate-step-results-not-running-again [new-build-number retriggered-build-number pipeline-history context step-id-to-run]
+(defn- duplicate-step-results-not-running-again [new-build-number retriggered-build-number pipeline-history context step-id-to-run]
   (let [do-add-result (partial add-result new-build-number retriggered-build-number context)
         history-to-duplicate (filter (partial to-be-duplicated? step-id-to-run) pipeline-history)]
     (dorun (map do-add-result history-to-duplicate))))


title section keys

title section keys

--- src/cljs/swarmpit/component/common.cljs
+++ src/cljs/swarmpit/component/common.cljs
@@ -11,10 +11,12 @@
 (defn edit-title [title & subtitle]
   [(comp/typography
      {:variant   "h5"
+      :key       "title"
       :className "Swarmpit-form-title"}
      title)
    (comp/typography
      {:variant   "body1"
+      :key       "subtitle"
       :className "Swarmpit-form-subtitle"}
      subtitle)])


renaming

renaming

--- src/cljs/triboard/logic/transition.cljs
+++ src/cljs/triboard/logic/transition.cljs
@@ -68,13 +68,13 @@
     (keep #(seek-jump-source-toward board point %))
     cst/directions))

-(defn- empty-cell-conversion
+(defn- add-destination-jump
   "Create a move to take an empty cell"
-  [player point]
-  {:destination point
+  [player destination]
+  {:destination destination
    :winner player
    :looser :empty
-   :taken [point]})
+   :taken [destination]})

 (defn- apply-jump
   "Apply a move onto the board, yielding a new board"
@@ -84,7 +84,7 @@
 (defn add-destination
   [jumps]
   (if-let [{:keys [winner destination]} (first jumps)]
-    (conj jumps (empty-cell-conversion winner destination))
+    (conj jumps (add-destination-jump winner destination))
     jumps))

 (defn- map-transition-tree


reuse

reuse

--- src/clojure/zensols/nlparse/feature.clj
+++ src/clojure/zensols/nlparse/feature.clj
@@ -42,6 +42,13 @@
   otherwise return 0."
   [check val-fn]
   (if check (val-fn check) 0))
+
+(defn ratio-true
+  "Return the ratio of **items** whose evaluation of **true-fn** is `true`."
+  [items true-fn]
+  (/ (->> items (map true-fn)
+          (filter true?) count)
+     (count items)))

 ;; propbank
 (defn first-sent-propbank-label
@@ -132,12 +139,8 @@
   "Dictionary features include in/out-of-vocabulary ratio."
   [tokens]
   (let [lemmas (map :lemma tokens)]
-    (letfn [(ratio [mfn]
-              (/ (->> lemmas (map mfn)
-                      (filter true?) count)
-                 (count lemmas)))]
-      {:in-dict-ratio (ratio wn/in-dictionary?)
-      :in-english-word-list-ratio (ratio #(wl/in-word-list? %))})))
+    {:in-dict-ratio (ratio-true lemmas wn/in-dictionary?)
+     :in-english-word-list-ratio (ratio-true lemmas #(wl/in-word-list? %))}))

 (defn dictionary-feature-metas []
   [[:in-dict-ratio 'numeric]])


Add a simple reaction to clicking on vertex.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -122,9 +122,15 @@
 (defn update-state [event world-state]
   (let [clicked-what (event->targetid event)
         constrained-flip (partial flip-edge world-state)]
-    (if (re-matches #"edge.*" clicked-what)
-      (update-in world-state [:edges clicked-what] constrained-flip)
-      world-state)))
+    (cond
+      (re-matches #"edge.*" clicked-what) (update-in world-state
+                                                     [:edges clicked-what]
+                                                     constrained-flip)
+
+      (re-matches #"vertex.*" clicked-what) (do
+                                               (.log js/console clicked-what)
+                                               world-state)
+      :else world-state)))


Add stats example.

Add stats example.

--- test/dsbdp/test/local_dpp_self_adaptivity_tests.clj
+++ test/dsbdp/test/local_dpp_self_adaptivity_tests.clj
@@ -14,3 +14,10 @@
     [clojure.test :refer :all]
     [dsbdp.local-dpp-self-adaptivity :refer :all]))

+(def four-staged-pipeline-stats-example
+  {3 {:out 17460, :dropped 1082},
+   2 {:out 18542, :dropped 1697469},
+   1 {:out 1716523, :dropped 611647},
+   0 {:out 2328170, :dropped 2911553},
+   :pipeline {:in 5239723, :dropped 7764598}})
+


(TK-300) schema tweaks based on PR feedback

* Removed the schema for the return type from `run-lifecycle-fn!`
  because we don't use the return value anywhere.
* Added some additional assertions in the shutdown-on-error* fn,
  to bring us back to parity with our previous assertions.

--- src/puppetlabs/trapperkeeper/internal.clj
+++ src/puppetlabs/trapperkeeper/internal.clj
@@ -141,7 +141,7 @@
         required    []]
     (first (cli! cli-args specs required))))

-(schema/defn ^:always-validate run-lifecycle-fn! :- a/TrapperkeeperAppContext
+(schema/defn ^:always-validate run-lifecycle-fn!
   "Run a lifecycle function for a service.  Required arguments:

   * app-context: the app context atom; can be updated by the lifecycle fn
@@ -302,6 +302,10 @@
      ; since it is likely to just get lost in a `future`.  Instead,
      ; invalid arguments will simply cause the shutdown promise to be delivered.
      (schema/validate a/TrapperkeeperAppContext @app-context)
+     (schema/validate schema/Keyword svc-id)
+     (assert (contains? (:service-contexts @app-context) svc-id))
+     (schema/validate IFn f)
+     (schema/validate (schema/maybe IFn) on-error-fn)

      (f)
      (catch Throwable t


added timing to distillery.tasks/long-task

--- src/distillery/tasks.clj
+++ src/distillery/tasks.clj
@@ -25,7 +25,7 @@
   [msg & body]
   `(do
      (print-progress (str "BEGIN " ~msg "..."))
-       (let [result# (do ~@body)]
+       (let [result# (time (do ~@body))]
          (print-progress (str "END   " ~msg))
          result#)))


[scamp] add 'world->dot to produce .dot representations of clusters

--- modules/scamp/src/scamp/core.clj
+++ modules/scamp/src/scamp/core.clj
@@ -1,5 +1,6 @@
 (ns scamp.core
-  (:require [taoensso.timbre :as timbre]
+  (:require [clojure.string :as str]
+            [taoensso.timbre :as timbre]
             [schema.core :as s]))

 (s/set-fn-validation! true)
@@ -586,8 +587,26 @@
     world
     (recur (do-comm world))))

+(s/defn world->dot
+  [world :- WorldSchema]
+  (let [node-id->int #(str/replace % #"node-id" "")]
+    (str "digraph {"
+         (->> (:network world)
+              (reduce (fn [r [self {:keys [downstream]}]]
+                        (apply str r (map #(str (node-id->int self)
+                                                " -> "
+                                                (node-id->int %)
+                                                ";")
+                                          downstream)))
+                      ""))
+         "}")))
+
 (comment
   [1] "Peer-to-Peer Membership Management for Gossip-Based Protocols"
+
+  (spit "/tmp/wemp.dot" (world->dot world))
+  ;; dot -Tpng -O /tmp/wemp.dot
+  ;; circo -Tpng -O /tmp/wemp.dot

   (binding [scamp.core/*rand* testing-rand*]
     (reset-rand-state!)


Upd non-existing entity doc example (closes #329)

--- src/datascript/core.cljc
+++ src/datascript/core.cljc
@@ -29,7 +29,7 @@

              If entity does not exist, `nil` is returned:

-                 (entity db -1) ; => nil
+                 (entity db 100500) ; => nil

              Creating an entity by id is very cheap, almost no-op, as attr access is on-demand:


Avoid allocation in ratom

Avoid allocation in ratom

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -8,14 +8,18 @@

 (defn running [] @-running)

-(defn- capture-derefed [f]
-  ;; TODO: Get rid of allocation.
-  (binding [*ratom-context* (clojure.core/atom #{})]
-    [(f) @*ratom-context*]))
+(defn- capture-derefed [f obj]
+  (set! (.-captured obj) nil)
+  (binding [*ratom-context* obj]
+    (f)))

 (defn- notify-deref-watcher! [derefable]
-  (when-not (nil? *ratom-context*)
-    (swap! *ratom-context* conj derefable)))
+  (let [obj *ratom-context*]
+    (when-not (nil? obj)
+      (let [captured (.-captured obj)]
+        (set! (.-captured obj)
+              (conj (if (nil? captured) #{} captured)
+                    derefable))))))

 (deftype RAtom [state meta validator watches]
   IEquiv
@@ -106,7 +110,8 @@
   IRunnable
   (run [this]
     (let [oldstate state
-          [res derefed] (capture-derefed f)]
+          res (capture-derefed f this)
+          derefed (.-captured this)]
       (when (not= derefed watching)
         (-update-watching this derefed))
       (when-not active?
@@ -157,5 +162,5 @@
 (defn make-reaction [f & {:keys [auto-run on-set on-dispose]}]
   (let [runner (if (= auto-run true) run auto-run)]
     (Reaction. f nil true false
-               #{} {}
+               nil {}
                runner on-set on-dispose)))


CMR-5106 Replaces entry-titles with concept-ids

--- search-app/src/cmr/search/services/acls/granule_acls.clj
+++ search-app/src/cmr/search/services/acls/granule_acls.clj
@@ -51,17 +51,12 @@
   [context coll-ids-by-prov _ acls]
   (filter (fn [acl]
             (let [{{:keys [provider-id] :as cii} :catalog-item-identity} acl
-                  entry-titles (map string/trim (get-in cii [:collection-identifier :entry-titles]))
-                  acl-coll-ids (->> entry-titles
-                                    (map (partial coll-cache/get-collection context provider-id))
-                                    ;; It's possible an ACL refers to an entry title that doesn't exist
-                                    (remove nil?)
-                                    (map :concept-id))]
+                  acl-coll-ids(map string/trim (get-in cii [:collection-identifier :concept-ids]))]
               (and (:granule-applicable cii)
                    ;; applies to a provider the user is searching
                    (coll-ids-by-prov provider-id)
                    (or ; The ACL applies to no specific collection
-                       (empty? entry-titles)
+                       (empty? acl-coll-ids)
                        ;; The acl applies to a specific collection that the user is searching
                        (some (coll-ids-by-prov provider-id) acl-coll-ids)))))
           acls))
@@ -127,43 +122,17 @@
       cqm/match-none)
     (cqm/string-conditions :collection-concept-id concept-ids true)))

-(defn- provider+entry-titles->collection-condition
-  "Converts a provider and entry titles from an ACL into a an equivalent query condition.
-  This goes through each entry title and get the equivalent collection and replace it with a
-  concept id. If the collection isn't in the cache it adds a collection query condition of all the
-  entry titles together. "
-  [context query-coll-ids provider-id entry-titles]
-  (when (seq entry-titles)
-    (let [{:keys [concept-ids entry-titles]}
-          (reduce (fn [condition-map entry-title]
-                    (if-let [{:keys [concept-id]} (coll-cache/get-collection context provider-id entry-title)]
-                      (update-in condition-map [:concept-ids] conj concept-id)
-                      (update-in condition-map [:entry-titles] conj (string/trim entry-title))))
-                  {:concept-ids nil
-                   :entry-titles nil}
-                  entry-titles)
-          concept-ids-cond (when concept-ids
-                             (concept-ids->collection-condition query-coll-ids concept-ids))
-          entry-titles-cond (when entry-titles
-                              (q/->CollectionQueryCondition
-                                (gc/and-conds [(cqm/string-condition :provider-id provider-id true false)
-                                               (cqm/string-conditions :entry-title entry-titles true)])))]
-      (if (and concept-ids-cond entry-titles-cond)
-        (gc/or-conds [concept-ids-cond entry-titles-cond])
-        (or concept-ids-cond entry-titles-cond)))))
-
 (defn collection-identifier->query-condition
   "Converts an acl collection identifier to an query condition. Switches implementations based
   on whether the user's query contained collection ids. This implementation assumes the query-coll-ids
   passed in are limited to the provider of the collection identifier."
   [context query-coll-ids provider-id collection-identifier]
   (let [colls-in-prov-cond (provider->collection-condition query-coll-ids provider-id)]
-    (if-let [{:keys [concept-ids entry-titles access-value temporal]} collection-identifier]
+    (if-let [{:keys [concept-ids access-value temporal]} collection-identifier]
       (let [concept-ids-cond (provider->collection-condition concept-ids provider-id)
             access-value-cond (some-> (access-value->query-condition access-value)
                                       q/->CollectionQueryCondition)
             temporal-cond (some-> temporal temporal->query-condition q/->CollectionQueryCondition)]
-
         (gc/and-conds (remove nil? [concept-ids-cond
                                     colls-in-prov-cond
                                     access-value-cond


Event-to-json uses pre-dump-event.

Event-to-json uses pre-dump-event.

--- src/riemann/common.clj
+++ src/riemann/common.clj
@@ -112,7 +112,7 @@
 (defn event-to-json
   "Convert an event to a JSON string."
   [event]
-  (json/generate-string event))
+  (json/generate-string (pre-dump-event event)))

 (defn decode-inputstream
   "Decode an InputStream to a message. Decodes the protobuf representation of


renamed  by

renamed  by

--- src/ctia/flows/hooks.clj
+++ src/ctia/flows/hooks.clj
@@ -25,40 +25,40 @@

 (defn find-hooks
   "Should return a list of `Hook` in the correct order"
-  [hook-name]
+  [hook-type]
   :todo)

 (defn add-hook!
-  "Add a `Hook` for the hook `hook-name`"
-  [hook-name hook]
-  (swap! hooks update-in [hook-name] conj hook))
+  "Add a `Hook` for the hook `hook-type`"
+  [hook-type hook]
+  (swap! hooks update-in [hook-type] conj hook))

 (defn add-hooks!
-  "Add a list of `Hook` for the hook `hook-name`"
-  [hook-name hook-list]
-  (swap! hooks update-in [hook-name] concat hook-list))
+  "Add a list of `Hook` for the hook `hook-type`"
+  [hook-type hook-list]
+  (swap! hooks update-in [hook-type] concat hook-list))

 (defn init!
   "Initialize hooks"
   []
-  (doseq [hook-name (keys @hooks)]
-    (let [hook-list (find-hooks hook-name)]
-      (add-hooks! hook-name hook-list))))
+  (doseq [hook-type (keys @hooks)]
+    (let [hook-list (find-hooks hook-type)]
+      (add-hooks! hook-type hook-list))))

 (defn init-hooks!
   "Should search Jar, Namespaces and init Objects"
   []
-  (doseq [hook-name (keys @hooks)]
-    (doseq [hook (get @hooks hook-name)]
+  (doseq [hook-type (keys @hooks)]
+    (doseq [hook (get @hooks hook-type)]
       (init hook)
-      (add-hook! hook-name hook)))
+      (add-hook! hook-type hook)))
   @hooks)

 (defn destroy-hooks
   "Should call all destructor for each hook in reverse order."
   []
-  (doseq [hook-name (keys @hooks)]
-    (doseq [hook (reverse (get @hooks hook-name))]
+  (doseq [hook-type (keys @hooks)]
+    (doseq [hook (reverse (get @hooks hook-type))]
       (destroy hook))))

 (defn bind-realized
@@ -69,7 +69,7 @@
     -> RealizedObject
     -> RealizedObject

-  If The hook return nil, doens't modify the realized object returned."
+  If the hook returns nil, it doens't modify the realized object returned."
   [realized-object hook prev-object type-name]
   (let [result (handle hook type-name realized-object prev-object)]
     (if (nil? result)
@@ -83,7 +83,7 @@
             (bind-realized acc f prev-object type-name)) realized-object hook-list))

 (defn apply-hooks
-  "Apply all hooks for some hook-name"
-  [type-name realized-object prev-object hook-name]
-  (apply-hook-list type-name realized-object prev-object (get @hooks hook-name)))
+  "Apply all hooks for some hook-type"
+  [type-name realized-object prev-object hook-type]
+  (apply-hook-list type-name realized-object prev-object (get @hooks hook-type)))


Removed commented-out Vinyasa code

Removed commented-out Vinyasa code

--- link/.lein/profiles.clj
+++ link/.lein/profiles.clj
@@ -10,23 +10,6 @@

                      ;; Spyscope is for tracing.
                      (require 'spyscope.core)
-
-                     ;; ;; Vinyasa: https://github.com/zcaudate/vinyasa
-                     ;; (require '[vinyasa.inject :as inj])
-                     ;; (inj/inject 'clojure.core
-                     ;;             '[[vinyasa.inject inject]
-                     ;;               [vinyasa.pull pull]
-                     ;;               [vinyasa.lein lein]
-                     ;;               [vinyasa.reimport reimport]
-                     ;;               [user dlet plet]])
-                     ;; (inj/inject 'clojure.core '>
-                     ;;             '[[clojure.tools.namespace.repl refresh]
-                     ;;               [clojure.repl apropos dir doc find-doc source
-                     ;;                pst [root-cause >cause]]
-                     ;;               [clojure.pprint pprint]
-                     ;;               [clojure.java.shell sh]
-                     ;;               [clojure.tools.trace trace-ns trace-vars
-                     ;;                untrace-ns untrace-vars]])
                      ]
         :dependencies [[org.clojure/java.classpath "0.2.2"]
                        [org.clojure/tools.namespace "0.2.4"]


fix: No "Delete" option for a group chat from the home screen if user has been removed from it

Signed-off-by: andrey <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/chat/sheets.cljs
+++ src/status_im/ui/screens/chat/sheets.cljs
@@ -102,7 +102,8 @@

 (defn group-chat-accents []
   (fn [{:keys [chat-id group-chat chat-name color invitation-admin]}]
-    (let [{:keys [joined?]} @(re-frame/subscribe [:group-chat/inviter-info chat-id])]
+    (let [{:keys [joined?]} @(re-frame/subscribe [:group-chat/inviter-info chat-id])
+          removed? @(re-frame/subscribe [:group-chat/removed-from-current-chat?])]
       (if invitation-admin
         [quo/list-item
          {:theme               :accent
@@ -137,7 +138,14 @@
              :title               (i18n/label :t/leave-chat)
              :accessibility-label :leave-chat-button
              :icon                :main-icons/arrow-left
-             :on-press            #(re-frame/dispatch [:group-chats.ui/leave-chat-pressed chat-id])}])]))))
+             :on-press            #(re-frame/dispatch [:group-chats.ui/leave-chat-pressed chat-id])}])
+         (when removed?
+           [quo/list-item
+            {:theme               :accent
+             :title               (i18n/label :t/remove)
+             :accessibility-label :remove-group-chat
+             :icon                :main-icons/delete
+             :on-press            #(hide-sheet-and-dispatch [:group-chats.ui/remove-chat-confirmed chat-id])}])]))))

 (defn actions [{:keys [chat-type]
                 :as current-chat}]


[Fix #2900] Unread badge counter doesn't fit large numbers

Signed-off-by: Oskar Thoren <aeed71d78dc09e4764ceac69b111eee9b50cfdd0@oskarthoren.com>

--- src/status_im/ui/screens/home/styles.cljs
+++ src/status_im/ui/screens/home/styles.cljs
@@ -111,11 +111,12 @@
    :ios     {:font-size 15}})

 (def new-messages-container
-  {:width            22
-   :height           22
-   :margin-left      15
-   :background-color component.styles/new-messages-count-color
-   :border-radius    50})
+  {:min-width          22
+   :height             22
+   :padding-horizontal 8
+   :margin-left        15
+   :background-color   component.styles/new-messages-count-color
+   :border-radius      50})

 (defstyle new-messages-text
   {:left       0


feat: read from std-in

feat: read from std-in

--- src/main/clojure/pdok/featured/core.clj
+++ src/main/clojure/pdok/featured/core.clj
@@ -25,7 +25,7 @@
         projectors (cond-> [] (not no-projectors) (conj (config/projectors persistence projection))
                            (not (or no-timeline no-state)) (conj (config/timeline persistence)))
         processor (processor/create persistence projectors)]
-    (with-open [s (file-stream json-file)]
+    (with-open [s (if json-file (file-stream json-file) (clojure.java.io/reader *in*))]
       (dorun (consume processor (features-from-stream s :dataset dataset-name)))
       (do (log/info "Shutting down.")
           (shutdown processor))))
@@ -41,11 +41,12 @@
   (let [{:keys [options arguments summary options]} (parse-opts args cli-options)]
     (cond
       (:help options) (exit 0 summary)
-      (not (:json-file options)) (exit 0 "json-file required")
+      (not (or (:json-file options) (:std-in options))) (exit 0 "json-file or std-in required")
       :else (execute options))))

 (def cli-options
   [["-f" "--json-file FILE" "required JSON-file with features"]
+   [nil "--std-in" "Read from std-in"]
    ["-d" "--dataset-name DATASET" "dataset"]
    [nil "--no-projectors"]
    [nil "--no-timeline"]


Remove unnecessary unbox

Remove unnecessary unbox

--- src/graphql_clj/type.clj
+++ src/graphql_clj/type.clj
@@ -1,6 +1,5 @@
 (ns graphql-clj.type
-  (:require [graphql-clj.error :as gerror]
-            [graphql-clj.box :as box]))
+  (:require [graphql-clj.error :as gerror]))

 (def default-types
   {"Int"     {:type-name "Int"     :kind :SCALAR}
@@ -75,7 +74,7 @@
   (when arguments
     (reduce (fn [result argument]
               (if (:default-value argument)
-                (assoc result (name (:argument-name argument)) (box/box->val (:default-value argument))) ;; TODO remove box->val
+                (assoc result (name (:argument-name argument)) (:default-value argument))
                 result))
             {} arguments)))


Refactor api-calls

Refactor api-calls

--- src/devtools/format.cljs
+++ src/devtools/format.cljs
@@ -186,22 +186,18 @@
 ;;;;;;;;; API CALLS

 (defn header-api-call [value]
-  (if (surrogate? value)
-    (.-header value)
-    (if (satisfies? IDevtoolsFormat value)
-      (-header value)
-      (build-header value))))
+  (cond
+    (satisfies? IDevtoolsFormat value) (-header value)
+    (surrogate? value) (.-header value)
+    :else (build-header value)))

 (defn has-body-api-call [value]
-  (if (surrogate? value)
-    (.-hasBody value)
-    (if (satisfies? IDevtoolsFormat value)
-      (-has-body value)
-      false))) ; body is emulated using references
+  (cond
+    (satisfies? IDevtoolsFormat value) (-has-body value)
+    (surrogate? value) (.-hasBody value)
+    :else false)) ; body is emulated using surrogate references

 (defn body-api-call [value]
-  (if (surrogate? value)
-    (build-surrogate-body value)
-    (if (satisfies? IDevtoolsFormat value)
-      (-body value)
-      (build-body value))))+  (cond
+    (satisfies? IDevtoolsFormat value) (-body value)
+    (surrogate? value) (build-surrogate-body value)))


Fix Cast error in take/drop filters (#144)

--- src/selmer/filters.clj
+++ src/selmer/filters.clj
@@ -170,12 +170,12 @@
             :take
             (fn [coll n]
               (throw-when-expecting-seqable coll)
-              (take n coll))
+              (take (Long/valueOf ^String n) coll))

             :drop
             (fn [coll n]
               (throw-when-expecting-seqable coll)
-              (drop n coll))
+              (drop (Long/valueOf ^String n) coll))

             ;;; Get the ith digit of a number
             ;;; 1 is the rightmost digit


Update the new session modification schemas.

--- src/shale/sessions.clj
+++ src/shale/sessions.clj
@@ -47,8 +47,8 @@

 (def TagChange
   "Add/remove a session/node tag"
-  {:resource (s/either :session :node)
-   :action   (s/either :add :remove)
+  {:resource (s/either (literal-pred :session) (literal-pred :node))
+   :action   (s/either (literal-pred :add) (literal-pred :remove))
    :tag      s/Str})

 (def Requirement
@@ -212,10 +212,10 @@

 (def ModifyArg
   "Modification to a session"
-  (s/either
-    (s/pair :change-tag "action" TagChange "tag change")
-    (s/pair :go-to-url  "action" s/Str     "url")
-    (s/pair :reserve    "action" s/Bool    "reserve")))
+  (any-pair
+    :change-tag TagChange
+    :go-to-url s/Str
+    :reserve s/Bool))

 (defn save-session-tags-to-redis [session-id tags]
   (with-car* (sset-all (session-tags-key session-id) tags)))
@@ -255,7 +255,7 @@
 (def CreateArg
   "Session-creation args"
   {(s/optional-key :browser-name) s/Str
-   (s/optional-key :capabilities) Capabilities
+   (s/optional-key :capabilities) {}
    (s/optional-key :node-id) s/Str})

 (defn create-session


fix: do not fail on error while generation

--- src/site/generator.clj
+++ src/site/generator.clj
@@ -12,12 +12,19 @@
     (fs/mkdir dir-path)
     (spit fl-path res)))

+(defn safe-dispatch [& args]
+  (try
+    (apply s/dispatch args)
+    (catch Exception e
+      (println "ERROR: " args (.toString e))
+      {:body (str "<pre>" e "</pre>")})))
+
 (defn *generate [{path :path params :params} routes]
   (doseq [[k v] routes]
     (println path k)
     (cond
       (= :GET k) (let [uri (str/join "/" path)
-                       res (s/dispatch {:uri uri :request-method k})]
+                       res (safe-dispatch {:uri uri :request-method k})]
                    (dump path (:body res)))
       (vector? k) (let [k (first k)
                         gen (get routes k)]


changed all the tense names to english (imperfetto and futuro)

--- babel/english/grammar.clj
+++ babel/english/grammar.clj
@@ -232,32 +232,32 @@
                            {:rule "s-future-phrasal-head"
                             :head {:phrasal true}
                             :synsem {:aux false
-                                     :infl :futuro
-                                     :cat :verb
-                                     :sem {:tense :futuro}}})
+                                     :infl :future
+                                     :cat :verb
+                                     :sem {:tense :future}}})
                    (unifyc c10
                            root-is-head
                            {:rule "s-future-nonphrasal-head"
                             :head {:phrasal false}
                             :synsem {:aux false
-                                     :infl :futuro
-                                     :cat :verb
-                                     :sem {:tense :futuro}}})
-                   (unifyc c10
-                           root-is-head-root
-                           {:rule "s-imperfetto-phrasal-head"
+                                     :infl :future
+                                     :cat :verb
+                                     :sem {:tense :future}}})
+                   (unifyc c10
+                           root-is-head-root
+                           {:rule "s-imperfect-phrasal-head"
                             :head {:phrasal true}
                             :synsem {:aux false
-                                     :infl :imperfetto
+                                     :infl :imperfect
                                      :cat :verb
                                      :sem {:aspect :progressive
                                            :tense :past}}})
                    (unifyc c10
                            root-is-head-root
-                           {:rule "s-imperfetto-nonphrasal-head"
-                            :head {:phrasal false}
-                            :synsem {:aux false
-                                     :infl :imperfetto
+                           {:rule "s-imperfect-nonphrasal-head"
+                            :head {:phrasal false}
+                            :synsem {:aux false
+                                     :infl :imperfect
                                      :cat :verb
                                      :sem {:aspect :progressive
                                            :tense :past}}})
@@ -313,13 +313,13 @@
                    (unifyc h21
                            {:rule "vp-future"
                             :synsem {:aux false
-                                     :infl :futuro
+                                     :infl :future
                                      :cat :verb}})

                    (unifyc h21
-                          {:rule "vp-imperfetto"
+                          {:rule "vp-imperfect"
                            :synsem {:aux false
-                                    :infl :imperfetto
+                                    :infl :imperfect
                                     :cat :verb}})

                    (unifyc h21


First attempt at doing reservations. Seems to work for simple cases, still a lot of things to fix though.

--- src/vacation2/main.clj
+++ src/vacation2/main.clj
@@ -20,13 +20,17 @@
   [["-c" "--customers N" "Number of customers"
     :default 100
     :parse-fn #(Integer/parseInt %)]
-   ["-r" "--reservations N" "Number of reservations"
-    ; Corresponds to parameter -t in vacation.
+   ["-n" "--queries N" "Number of queries per relation per reservation"
+    ; In vacation, this is the total number of queries per reservation; here,
+    ; this is the number of queries per relation per reservation, so / 3.
+    :default 100
+    :parse-fn #(Integer/parseInt %)]
+   ["-r" "--relations N" "Number of flights/rooms/cars"
+    :default 500
+    :parse-fn #(Integer/parseInt %)]
+   ["-t" "--reservations N" "Number of reservations"
+    ; Reservations are called "transactions" in vacation.
     :default 1000
-    :parse-fn #(Integer/parseInt %)]
-   ["-n" "--relations N" "Number of flights/rooms/cars"
-    ; Corresponds to parameter -r in vacation.
-    :default 500
     :parse-fn #(Integer/parseInt %)]
    ;["-w" "--workers N" "Number of workers"
    ; :default 20
@@ -62,18 +66,35 @@
     (when (:debug options)
       (def log log-debug))
     (if proceed?
-      (do
+      (let [options {:n-customers    (:customers options)
+                     :n-reservations (:reservations options)
+                     :n-relations    (:relations options)
+                     :n-queries      (:queries options)}]
         (log "options: " options)
         options)
       nil)))

 ; HELPER FUNCTIONS

-(defn initialize-data [n-customers n-reservations n-relations]
+(defn zip [& lists]
+  "Zip m lists of n elements into list of n m-tuples.
+
+  > (zip [1 2 3 4] [5 6 7 8] [9 10 11 12])
+  ([1 5 9] [2 6 10] [3 7 11] [4 8 12])
+
+  Based on http://stackoverflow.com/a/2588385/8137"
+  (apply map vector lists))
+
+(defn random-subset [n coll]
+  "Get `n` randomly picked elements from `coll`.
+  Sampling is done with replacement, i.e. elements may appear multiple times."
+  (repeatedly n #(rand-nth coll)))
+
+(defn initialize-data [{:keys [n-reservations n-relations]}]
   (letfn [(rand-seats []
-            (* (+ (rand 5) 1) 100))
+            (* (+ (rand-int 5) 1) 100))
           (rand-price []
-            (+ (* (rand 5) 10) 50))
+            (+ (* (rand-int 5) 10) 50))
           (generate-relation []
             (for [i (range n-relations)]
               (ref {:id i :seats (rand-seats) :price (rand-price)})))]
@@ -84,23 +105,55 @@
      :flights (generate-relation)
      :rooms   (generate-relation)}))

-(defn zip [& lists]
-  "Zip m lists of n elements into list of n m-tuples.
+(defn- look-for-seats [relations n-seats]
+  "Look for a relation with `n-seats` free seats in `relations`, and return the
+  one with the minimal price. Return nil if no such relation can be found."
+  ; Vacation searches for the maximal price, we return the cheapest option. This
+  ; makes more sense to me: you want the reserve the cheapest car/flight/room.
+  (dosync
+    (->> relations
+      (filter #(>= (:seats (deref %)) n-seats))
+      (sort-by (comp :price deref))
+      (first))))

-  > (zip [1 2 3 4] [5 6 7 8] [9 10 11 12])
-  ([1 5 9] [2 6 10] [3 7 11] [4 8 12])
+(defn reserve [reservation relation n-seats]
+  "Reserve `n-seats` on `relation`, for `reservation`.

-  Based on http://stackoverflow.com/a/2588385/8137"
-  (apply map vector lists))
+  Decreases the number of seats in `relation`, and updates the total in
+  `reservation`."
+  (dosync
+    (alter relation update :seats - n-seats)
+    (alter reservation update :total + (:price @relation))))
+
+(defn process-reservation
+  [reservation
+   {:keys [cars flights rooms]}
+   {:keys [n-queries]}]
+  "Process a reservation: find a car, flight, and room for the reservation and
+  update the data structures."
+  ; TODO: does vacation always only reserve 1 seat?
+  (dosync
+    (let [found-car    (look-for-seats (random-subset n-queries cars) 1)
+          found-flight (look-for-seats (random-subset n-queries flights) 1)
+          found-room   (look-for-seats (random-subset n-queries rooms) 1)]
+      (when found-car    (reserve reservation found-car 1))
+      (when found-flight (reserve reservation found-flight 1))
+      (when found-room   (reserve reservation found-room 1))
+      (alter reservation assoc :fulfilled?
+        (some? (or found-car found-flight found-room))))))
+; TODO: add some logging

 ; BEHAVIORS

+; TODO: this is not really a customer, but more a manager.
+; TODO: what is a customer then? what is the difference between a customer and
+; a reservation?
 (def customer-behavior
   (behavior
-    [customer-id]
+    [customer-id data options]
     [reservation done?]
     (log "start reservation" (:id @reservation) "by customer" customer-id)
-    ; TODO
+    (process-reservation reservation data options)
     (deliver done? true)))

 ; MAIN
@@ -108,20 +161,27 @@
 (defn -main [& args]
   "Main function. `args` should be a list of command line arguments."
   (when-let [options (parse-args args)]
-    (let [{n-customers    :customers
-           n-reservations :reservations
-           n-relations    :relations} options
-          {:keys [reservations cars flights rooms]}
-            (initialize-data n-customers n-reservations n-relations)
+    (let [{:keys [n-customers n-reservations]} options
+          {:keys [reservations cars flights rooms] :as data}
+            (initialize-data options)
           customer-actors
-            (map #(spawn customer-behavior %) (range n-customers))
+            (map #(spawn customer-behavior % data options) (range n-customers))
           done-promises
             (repeatedly n-reservations promise)]
       (when (not= (rem n-reservations n-customers) 0)
         (println "WARNING: number of reservations is not divisible by number"
           "of customers."))
+      (log "reservations:" reservations)
+      (log "cars:" cars)
+      (log "flights:" flights)
+      (log "rooms:" rooms)
       (doseq [[customer reservation done?] (zip (cycle customer-actors) reservations done-promises)]
         (send customer reservation done?))
       (doseq [done? done-promises]
-        (deref done?))))
+        (deref done?))
+      (log "reservations:" reservations)
+      (log "cars:" cars)
+      (log "flights:" flights)
+      (log "rooms:" rooms)))
+  (Thread/sleep 1000) ; XXX
   (shutdown-agents))


Introduce master actor, instead of putting everything in main. Avoids having `n-reservations` done? promises.

--- src/vacation2/main.clj
+++ src/vacation2/main.clj
@@ -182,13 +182,40 @@
 ; In vacation, this corresponds to a client.
 (def worker-behavior
   (behavior
-    [worker-id data options]
-    [reservation done?]
+    [worker-id master data options]
+    [reservation]
     ; Note: as opposed to the vacation benchmark, we only support making
     ; reservations, not deleting customers or updating tables.
     (log "start reservation" (:id @reservation) "by worker" worker-id)
     (process-reservation reservation data options)
-    (deliver done? true)))
+    (send master :done (:id @reservation))))
+
+(def done? (promise))
+
+(def master-waiting-behavior
+  (behavior
+    [n]
+    [_done _reservation-id]
+    (if (= n 1)
+      (do
+        (log "done")
+        #_(log-data data)
+        (deliver done? true))
+      (become :same (dec n)))))
+
+(def master-initial-behavior
+  (behavior
+    [{:keys [n-workers n-reservations] :as options}]
+    [_start]
+    (let [{:keys [reservations cars flights rooms] :as data}
+            (initialize-data options)
+          worker-actors
+            (map #(spawn worker-behavior % *actor* data options)
+              (range n-workers))]
+      #_(log-data data)
+      (doseq [[worker reservation] (zip (cycle worker-actors) reservations)]
+        (send worker reservation))
+      (become master-waiting-behavior n-reservations))))

 ; MAIN

@@ -202,19 +229,7 @@
 (defn -main [& args]
   "Main function. `args` should be a list of command line arguments."
   (when-let [options (parse-args args)]
-    (let [{:keys [n-workers n-reservations]} options
-          {:keys [reservations cars flights rooms] :as data}
-            (initialize-data options)
-          worker-actors
-            (map #(spawn worker-behavior % data options) (range n-workers))
-          done-promises
-            (repeatedly n-reservations promise)]
-      #_(log-data data)
-      (doseq [[worker reservation done?]
-                (zip (cycle worker-actors) reservations done-promises)]
-        (send worker reservation done?))
-      (doseq [done? done-promises]
-        (deref done?))
-      #_(log-data data)))
-  (log "done")
+    (send (spawn master-initial-behavior options) :start)
+    (deref done?))
+  (log "exit")
   (System/exit 0))


Update release-date parser.

Update release-date parser.

--- src/uk/co/anthonycampbell/imdb/parser.clj
+++ src/uk/co/anthonycampbell/imdb/parser.clj
@@ -264,16 +264,38 @@
                     (if (not-empty genre-string)
                         (ccstring/trim genre-string)))))))

+(defn select-release-date-from-meta-list
+    "Attempts to select all of the tags which contain a datePublished attribute"
+    [list]
+    (loop [date-string ""
+           item-list list]
+        (if (not-empty item-list)
+            ; Recurrsively look for meta tag with date published attributes
+            (recur
+                (let [item (first item-list)]
+                    (let [link-title (:title (:attrs item))]
+
+                        (if (= "See all release dates" link-title)
+                            (let [release-date (first (:content item))]
+                                (debug "-----", release-date)
+                                (str (str date-string " ") release-date))
+                            date-string)))
+                (rest item-list))
+            date-string)))
+
 (defn construct-release-date
     "Construct a release date string based on the provided parsed page content"
     [page-content]
     (if (not-empty page-content)

         ; Select title attribute from first infobar span element
-        (let [infobar-anchor (html/select page-content [:div.infobar :a])]
-            (if (not-empty infobar-anchor)
-                (ccstring/trim (nth (re-find #"([a-zA-Z0-9  ]+)(\(UK\))?"
-                    (ccstring/trim (first (:content (last infobar-anchor))))) 1))))))
+        (let [meta-list (html/select page-content [:span :a])]
+            (debug "- Looking for release dates...")
+
+            (if (not-empty meta-list)
+                (let [release-date-string (select-release-date-from-meta-list meta-list)]
+                    (if (not-empty release-date-string)
+                        (ccstring/trim release-date-string)))))))

 (defn construct-description
     "Construct a description string based on the provided parsed page content"


set visibility only if layer is available

--- src/hatti/map/utils.cljs
+++ src/hatti/map/utils.cljs
@@ -39,6 +39,8 @@
                        :reset #js {:color "#f30"}}
           :hover #js {:color "#631400"}
           :clicked #js {:color "#ad2300"}}})
+
+(def circle-border-id "point-casting")

 (defn marker->geotype
   "Returns geotype (:point :line or :shape) based on marker."
@@ -593,10 +595,10 @@
   "Show/or hide geopoints. Hide geopoints if hide-points is true."
   [map layer-id & [hide-points?]]
   (let [visibility (if hide-points? "none" "visible")]
-    (.setLayoutProperty
-     map layer-id "visibility" visibility)
-    (.setLayoutProperty
-     map "point-casting" "visibility" visibility)))
+    (when (.getLayer map layer-id)
+      (.setLayoutProperty map layer-id "visibility" visibility))
+    (when (.getLayer map circle-border-id)
+      (.setLayoutProperty map circle-border-id "visibility" visibility))))

 (defn remove-layer
   "Remove layer from map and it's source from map."
@@ -697,8 +699,7 @@
    {:keys [geofield owner tiles-url geojson] :as map-data}]
   (let [{:keys [layer-type layout style]} (geotype->marker-style geofield)
         {:keys [stops layer-opts show-hexbins? show-heatmap?]}
-        (om/get-state owner)
-        circle-border "point-casting"]
+        (om/get-state owner)]
     (when (or (-> geojson :features count pos?) tiles-url)
       (om/set-state! owner :loaded? false)
       (add-mapboxgl-source map id_string map-data)
@@ -712,10 +713,11 @@
       ;; otherwise remove the layer if it exists
       (if (= :point style)
         (add-mapboxgl-layer map id_string layer-type
-                            :layer-id circle-border
+                            :layer-id circle-border-id
                             :tiles-url tiles-url
                             :paint {:circle-color "#fff" :circle-radius 6})
-        (when (.getLayer map circle-border) (.removeLayer map circle-border)))
+        (when (.getLayer map circle-border-id)
+          (.removeLayer map circle-border-id)))
       (when show-hexbins? (show-hexbins owner map id_string geojson
                                         layer-opts))
       (when show-heatmap? (show-heatmap owner map id_string geojson


Oracle Realtime support V.01

Oracle Realtime support V.01

Very alpha, but it is starting to create the Oracle tables

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -321,6 +321,27 @@

+(defn does-table-exist [table-name]
+  (let [table-exists-result      (korma.core/exec-raw
+                                   [(cond
+                                      (= *database-type* "postgres" )
+                                      "select * from pg_tables where schemaname='public' and tablename=?"
+                                      (= *database-type* "oracle" )
+                                      "select count(*) from all_objects   where object_type in ('TABLE','VIEW')   and object_name =?"
+                                      ) [(cond (= *database-type* "postgres" ) table-name (= *database-type* "oracle" ) (.toUpperCase table-name))]]
+                                   :results)
+
+        table-exists?   (cond
+                          (= *database-type* "postgres" )
+                          (> (count table-exists-result) 0)
+
+                          (= *database-type* "oracle" )
+                          (> (first (vals (first table-exists-result)  )) 0))
+        ]
+
+    (println (str table-name " table-exists-result: " (count table-exists-result)))
+    (println (str table-name " table exists: " table-exists?))
+    table-exists?))

@@ -456,27 +477,31 @@

 (defn make-todo-table []
-  (let [coils-admin-tables      (korma.core/exec-raw
-                                 [" select * from pg_tables where schemaname='public' and tablename='coils_todo_items'" []]
-                                 :results)
-
-        coils-admin-table-exists   (pos? (count coils-admin-tables))
-
-        sql-to-create-admin-table "
-        CREATE TABLE coils_todo_items
-        (
-        id                   serial NOT NULL,
-        item                 character varying,
-        item_status          character varying,
-
-        CONSTRAINT todo_items_pkey PRIMARY KEY (id)
-        );
-        "
-        ]
-
-    (println "Coils todo table exists: " coils-admin-table-exists)
-    (if (not coils-admin-table-exists )
-      (korma.core/exec-raw   [sql-to-create-admin-table []]   [])
+  (let [sql-to-create-todo-table
+        (cond
+          (= *database-type* "postgres" )
+          "
+          CREATE TABLE coils_todo_items
+          (
+          id                   serial NOT NULL,
+          item                 character varying,
+          item_status          character varying,
+
+          CONSTRAINT todo_items_pkey PRIMARY KEY (id)
+          );"
+
+          (= *database-type* "oracle" )
+          "
+          CREATE TABLE coils_todo_items
+          (id                 NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          ITEM                VARCHAR2(200 BYTE),
+          ITEM_STATUS         VARCHAR2(200 BYTE),
+          CONSTRAINT  COILS_TODO_PK PRIMARY KEY (ID)
+          )")
+        ]
+
+    (if (not (does-table-exist  "coils_todo_items"))
+      (korma.core/exec-raw   [sql-to-create-todo-table []]   [])
       nil)))

@@ -495,25 +520,30 @@

 (defn make-users-table []
-  (let [coils-admin-tables      (korma.core/exec-raw
-                                 [" select * from pg_tables where schemaname='public' and tablename='coils_users'" []]
-                                 :results)
-
-        coils-admin-table-exists   (pos? (count coils-admin-tables))
-
-        sql-to-create-admin-table "
-        CREATE TABLE coils_users
-        (
-        id character varying NOT NULL,
-        user_name character varying,
-        CONSTRAINT users_pkey PRIMARY KEY (id)
-        );
-        "
-        ]
-
-    (println "Coils users table exists: " coils-admin-table-exists)
-    (if (not coils-admin-table-exists )
-      (korma.core/exec-raw   [sql-to-create-admin-table []]   [])
+  (let [sql-to-create-users-table
+        (cond
+          (= *database-type* "postgres" )
+          "
+          CREATE TABLE coils_users
+          (
+          id character varying NOT NULL,
+          user_name character varying,
+          CONSTRAINT users_pkey PRIMARY KEY (id)
+          );
+          "
+
+          (= *database-type* "oracle" )
+          "
+          CREATE TABLE coils_users
+          (ID                 NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          USER_NAME           VARCHAR2(200 BYTE),
+          CONSTRAINT  COILS_USERS_PK PRIMARY KEY (ID)
+          );
+          ")
+        ]
+
+    (if (not (does-table-exist  "coils_users"))
+      (korma.core/exec-raw   [sql-to-create-users-table []]   [])
       nil)))


populate now populates everything using upsert, suggest returns top 10 only

--- src/eatme/item_store.clj
+++ src/eatme/item_store.clj
@@ -4,6 +4,7 @@
             [cheshire.generate]
             [monger.core :as m]
             [monger.collection :as mc]
+            [monger.query :as mq]
             [monger.joda-time]
             [eatme.item-library :as library])
   (:import [org.bson.types ObjectId]
@@ -16,18 +17,22 @@
   (m/set-db! (m/get-db))) ;; db name is in the uri

 (defn add-item [category item]
-  (mc/insert "item" (assoc item :category category)))
+  (mc/update "item" {:ProductId (:ProductId item)} (assoc item :category category) :upsert true))

 (defn- replace-_id [i]
   (let [id (str (:_id i))]
     (assoc (dissoc i :_id) :id id)))

 (defn suggest-item [q]
-  (map #(select-keys % [:Name])
-       (mc/find-maps "item" {:Name {$regex (str ".*" q ".*") $options "i"}})))
+  (map replace-_id
+       (mq/with-collection "item"
+         (mq/find {:Name {$regex (str ".*" q ".*") $options "i"}})
+         (mq/fields [:Name])
+         (mq/limit 10))))

 ;; currently only does the first 2 (of 500+) categories
 (defn populate-from-library []
-  (doseq [category (take 2 (library/all-shelves))]
+  (doseq [category (library/all-shelves)]
+    (println "Populating category" category)
     (doseq [p (library/products (-> category :shelf :Id))]
       (add-item category p))))


Make specs-from-form always return a set

--- src/expound/printer.cljc
+++ src/expound/printer.cljc
@@ -61,7 +61,7 @@
               (and (vector? x) (= :kw (first x)))))
            (map second)
            set)
-      [])))
+      #{})))

 (defn key->spec [keys problems]
   (doseq [p problems]


Minor fix: mongo hostname

Minor fix: mongo hostname

--- src/eventstore/mongo.clj
+++ src/eventstore/mongo.clj
@@ -6,7 +6,7 @@
 (def page-size 100)

 (defn mongo-conn []
-  (m/make-connection "eventstore" :host 10.90.228.88))
+  (m/make-connection "eventstore" :host "10.90.228.88"))

 (defrecord LocalMongoDB [db collection]
   db/DB


Fixes regex to work on both older and newer CLJS versions

--- src/expound/printer.cljc
+++ src/expound/printer.cljc
@@ -26,7 +26,7 @@
               (clojure.main/demunge f-n))))
          :cljs
          (let [fn-parts (string/split (second (re-find
-                                               #"object\[([^\(]+)\]"
+                                               #"object\[([^\( \]]+).*(\n|\])?"
                                                (pr-str f)))
                                       #"\$")
                ns-n (string/join "." (butlast fn-parts))


reenable cnstr records for this major push

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -208,7 +208,7 @@
                 (list `fn '[f c] (list `with-constraints 'f 'c)) c#))
       nil)))

-#_(defmacro defconstrainedrecord
+(defmacro defconstrainedrecord
   [name slots & etc]
   (let [fields   (->> slots (partition 2) (map first) vec)
         defaults (->> slots (partition 2) (map second))


playing around with constrained records.  doesn't work yet

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -259,7 +259,7 @@
 )

 (defmacro defconstrainedrecord
-  [name slots & etc]s
+  [name slots & etc]
   (let [fields   (->> slots (partition 2) (map first) vec)
         defaults (->> slots (partition 2) (map second))]
     `(do


Requiring that contracts have a docstrings and throwing a compile-time except when it's not there

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -45,8 +45,9 @@

 (defn- build-pre-post-map
   "Takes a vector of the form `[pre ... => post ...]` and infers the expectations described
-   therein.  The map that comes out will look like Clojure's default pre- and post-conditions
-   map.
+   therein.  The map that comes out will look like Clojure's default pre- anlein d post-conditions
+   map.  If the argument is already a map then it's assumed that the default pre/post map is used and
+   as a result is used directly without manipulation.
   "
   [cnstr]
   (if (vector? cnstr)
@@ -176,16 +177,18 @@
    the keyword `:constraints`.
   "
   [n docstring & constraints]
-  (let [raw-cnstr   (partition 2 constraints)
-        arity-cnstr (for [[a c] raw-cnstr]
-                      (build-constraints-map a c))
-        fn-arities  (for [b arity-cnstr]
-                      (build-contract docstring b))
-        body (list* 'fn n fn-arities)]
-    `(with-meta
-       ~body
-       {:constraints (into {} '~arity-cnstr)
-        :docstring ~docstring})))
+  (if (not (string? docstring))
+    (throw (IllegalArgumentException. "Sorry, but contracts require docstrings"))
+    (let [raw-cnstr   (partition 2 constraints)
+          arity-cnstr (for [[a c] raw-cnstr]
+                        (build-constraints-map a c))
+          fn-arities  (for [b arity-cnstr]
+                        (build-contract docstring b))
+          body (list* 'fn n fn-arities)]
+      `(with-meta
+         ~body
+         {:constraints (into {} '~arity-cnstr)
+          :docstring ~docstring}))))

 (defn with-constraints
   "A contract combinator.
@@ -261,7 +264,7 @@
            (= t# (type r#))))

        (let [chk# (contract ~(symbol (str "chk-" name))
-                            (str "Invariant contract for " (str ~name))
+                            ~(str "Invariant contract for " name)
                             [{:keys ~fields :as m#}] ~invariants)]
          (defconstrainedfn ~factory-name
            ([] [] (with-meta


Remove unused code from canvas.

Remove unused code from canvas.

--- frontend/uxbox/ui/workspace/canvas.cljs
+++ frontend/uxbox/ui/workspace/canvas.cljs
@@ -125,17 +125,7 @@
   []
   (let [page (rum/react wb/page-state)
         page-width (:width page)
-        page-height (:height page)
-        ;; selection-uuids (rum/react selected-ids)
-        ;; selected-shapes (rum/react selected-shapes)
-        ;; raw-shapes (into []
-        ;;                  (comp
-        ;;                   (filter :shape/visible?)
-        ;;                   (filter #(not (contains? selection-uuids (:shape/uuid %))))
-        ;;                   (map :shape/data))
-        ;;                  shapes)
-        item (first _icons/+external+)
-        ]
+        page-height (:height page)]
     (html
      [:svg.page-canvas
       {:x wb/document-start-x
@@ -147,24 +137,12 @@
        (fn [event]
          (rx/push! wb/selected-shape-b :nothing)
          (dom/stop-propagation event))
-
-       ;; :on-mouse-down cs/on-mouse-down
-       ;; :on-mouse-up cs/on-mouse-up
        }
       (background)
       [:svg.page-layout {}
        (for [shapeid (:shapes page)
              :let [item (get-in page [:shapes-by-id shapeid])]]
-         (rum/with-key (shape item) (str shapeid)))]
-      #_(apply vector :svg#page-layout (map shapes/shape->svg raw-shapes))
-      #_(when-let [shape (rum/react drawing)]
-          (shapes/shape->drawing-svg shape))
-      #_(when-not (empty? selected-shapes)
-          (let [rs selected-shapes]
-            (vec (cons :g
-                       (concat
-                        (map shapes/shape->selected-svg rs)
-                        (map shapes/shape->svg rs))))))])))
+         (rum/with-key (shape item) (str shapeid)))]])))

 (def canvas
   (util/component


svg path img tag

svg path img tag

--- cloc-webapp/src-cljs/dash/dash.cljs
+++ cloc-webapp/src-cljs/dash/dash.cljs
@@ -69,15 +69,17 @@
   (reify
     om/IRender
     (render [this]
-      (dom/div nil
-        (dom/select
-          #js {:onChange (fn [ev]
-                           (let [this (.-target ev)
-                                 opt-value (aget (.-options this) (.-selectedIndex this) "value")]
-                              (aset (om/get-node owner "badge-link") "value" opt-value)))}
-          (dom/option #js {:value (get state "svg_badge_url")} "SVG badge")
-          (dom/option #js {:value (get state "png_badge_url")} "PNG badge"))
-        (dom/textarea #js {:value (get state "svg_badge_url") :ref "badge-link"})))))
+      (let [svg-path (get state "svg_badge_url")]
+        (dom/div nil
+          (dom/img #js{:src svg-path})
+          (dom/select
+            #js {:onChange (fn [ev]
+                             (let [this (.-target ev)
+                                   opt-value (aget (.-options this) (.-selectedIndex this) "value")]
+                                (aset (om/get-node owner "badge-link") "value" opt-value)))}
+            (dom/option #js {:value svg-path} "SVG badge")
+            (dom/option #js {:value (get state "png_badge_url")} "PNG badge"))
+          (dom/textarea #js {:value svg-path :ref "badge-link"}))))))

 ;; {:auth - :repo -}
 (defn repo-config-panel [state owner]
@@ -88,7 +90,6 @@
             current-state (nth (om/observe owner (registered-state-cur index)) 0)
             current-repo (nth (:repos @app-state) index)]

-        (prn (get current-repo "registered"))
         (case current-state
           :registered (dom/div nil
                         (dom/h2 nil (get current-repo "full_name"))


Parse Lambda input as json

Parse Lambda input as json

--- src/lambda_demo/core.clj
+++ src/lambda_demo/core.clj
@@ -1,6 +1,9 @@
 (ns lambda-demo.core
-  (:require [uswitch.lambada.core :refer [deflambdafn]]))
+  (:require [uswitch.lambada.core :refer [deflambdafn]]
+            [clojure.java.io :as io]
+            [cheshire.core :refer [parse-stream]]))

 (deflambdafn lambda-demo.LambdaFn
   [in out ctx]
-  (println "Hello from Lambda"))
+  (let [input (parse-stream (io/reader in) true)]
+    (println "Hello from Lambda with input" input)))


Updating docs and api to support blocking api + adding cancel and commit functions, closes #84

--- src/org/libraryweasel/ligature/core.clj
+++ src/org/libraryweasel/ligature/core.clj
@@ -16,12 +16,11 @@
     Calling this function will not create a new collection, it just binds a Store and Collection name.")
   (create-collection [this collection-name]
     "Creates a new collection or does nothing if collection already exists.
-    This function returns a future with the created collection.")
+    Regardless the collection is returned.")
   (delete-collection [this collection-name]
-    "Deletes the collection of the name given and does nothing if the collection doesn't exist.
-    Returns a future.")
+    "Deletes the collection of the name given and does nothing if the collection doesn't exist.")
   (all-collections [this]
-    "Returns a channel that outputs of all existing collections.")
+    "Returns a seq of all existing collections.")
   (close [this]
     "Close connection with the Store.")
   (details [this]
@@ -31,9 +30,9 @@
   "Manages a collection of Statements and Rules, supports ontologies, and querying."
   (collection-name [this])
   (readTx [this]
-    "Returns a future with a ReadTx.")
+    "Returns a ReadTx.")
   (write [this f]
-    "Returns a future with a ReadTx/WriteTx."))
+    "Returns a ReadTx/WriteTx."))
 ;  (sparql-query [this query]
 ;    "")
 ;  (wander-query [this query]
@@ -47,7 +46,9 @@
   (all-rules [this]
     "Accepts nothing but returns a channel of all Rules in the Collection.")
   (match-rules [this pattern]
-    "Is passed a pattern and returns a channel with all matching rules."))
+    "Is passed a pattern and returns a channel with all matching rules.")
+  (cancel [this]
+    "Cancels this transaction."))

 (defprotocol WriteTx
   (new-identifier [this]
@@ -59,7 +60,9 @@
   (add-rule [this rule]
     "Accepts a rule tuple")
   (remove-rule [this rule]
-    "Accepts a rule tuple"))
+    "Accepts a rule tuple")
+  (commit [this]
+    "Commits this transaction."))

 (defn identifier?
   "Accepts a String representing an identifier and returns true or false depending on if it is valid."


RR: check for new-field and on-load for initial load

--- src/hatti/views/map.cljs
+++ src/hatti/views/map.cljs
@@ -391,7 +391,9 @@
     (.on mapboxgl-map "style.load" load-layers)
     (.on mapboxgl-map "render" #(fitBounds
                                  (om/get-state owner [:geojson])))
-    (when geojson (load-layers) (om/set-state! owner :geojson geojson))
+    (when geojson
+      (.on mapboxgl-map "style.load" load-layers)
+      (om/set-state! owner :geojson geojson))
     (om/set-state! owner :mapboxgl-map mapboxgl-map)
     (om/set-state! owner :layer-id id_string)
     (om/update! app-state [:map-page :mapboxgl-map] mapboxgl-map)))
@@ -439,7 +441,7 @@
                              (if (or (f/geoshape? new-field)
                                      (f/osm? new-field))
                                new-map-data new-data))]
-            (when (and (not-empty old-field) (not= geojson new-geojson))
+            (when (and (not-empty new-field) (not= geojson new-geojson))
               (when (.getLayer mapboxgl-map layer-id)
                 (.removeLayer mapboxgl-map layer-id)
                 (.removeSource mapboxgl-map layer-id))


Add one-item? helper to check whether a coll has exactly one item

--- src/main/workflo/macros/props/util.cljc
+++ src/main/workflo/macros/props/util.cljc
@@ -6,6 +6,18 @@
             #?(:cljs [cljs.spec.impl.gen :as gen]
                :clj  [clojure.spec.gen :as gen])
             [clojure.string :refer [capitalize]]))
+
+(s/fdef one-item?
+        :args (s/cat :coll coll?)
+        :ret  boolean?
+        :fn   (s/or :true  (s/and #(= 1 (count (:coll (:args %))))
+                                  #(true? (:ret %)))
+                    :false (s/and #(not= 1 (count (:coll (:args %))))
+                                  #(false? (:ret %)))))
+
+(defn one-item?
+  [coll]
+  (= 1 (count coll)))

 (s/fdef combine-properties-and-groups
   :args (s/cat :props-and-groups vector?)


(PE-2427) 'config' namespace documentation

--- src/puppetlabs/trapperkeeper/config.clj
+++ src/puppetlabs/trapperkeeper/config.clj
@@ -1,3 +1,20 @@
+;;;;
+;;;; This namespace contains trapperkeeper's built-in configuration service,
+;;;; which is based on .ini config files.
+;;;;
+;;;; This service provides a function, `get-in-config`, which can be used to
+;;;; retrieve the config data read from the ini files.  For example,
+;;;; given an .ini file with the following contents:
+;;;;
+;;;;   [foo]
+;;;;   bar = baz
+;;;;
+;;;; The value of `(get-in-config [:foo :bar])` would be `"baz"`.
+;;;;
+;;;; Also provides a second function, `get-config`, which simply returns
+;;;; the entire map of configuration data.
+;;;;
+
 (ns puppetlabs.trapperkeeper.config
   (:import  (java.io FileNotFoundException))
   (:require [clojure.java.io :refer [file]]
@@ -6,22 +23,9 @@
             [puppetlabs.trapperkeeper.logging :refer [configure-logging!]]))

 (defn config-service
-  "A simple configuration service based on .ini config files.  Expects
+  "Returns trapperkeeper's configuration service.  Expects
    to find a command-line argument value for `:config`; the value of this
-   parameter should be the path to an .ini file or a directory of .ini
-   files.
-
-   Provides a function, `get-in-config`, which can be used to
-   retrieve the config data read from the ini files.  For example,
-   given an ini file with the following contents:
-
-       [foo]
-       bar = baz
-
-   The value of `(get-in-config [:foo :bar])` would be `\"baz\"`.
-
-   Also provides a second function, `get-config`, which simply returns
-   the entire configuration map."
+   parameter should be the path to an .ini file or a directory of .ini files."
   [config]
   ((service :config-service
     {:depends  []


read-edn uses edn-options.

read-edn uses edn-options.

--- common/src/ipogudin/collie/edn.cljc
+++ common/src/ipogudin/collie/edn.cljc
@@ -1,5 +1,6 @@
 (ns ipogudin.collie.edn
   (:require #?(:clj [clojure.java.io :as io])
+            #?(:clj [clojure.edn :as edn])
             #?(:clj [clj-time.format :as f]
                :cljs [cljs-time.format :as f])
             #?(:cljs [cljs.reader :as reader]))
@@ -57,7 +58,7 @@
          (->> p
               descriptor
               slurp
-              read-string)))))
+              (edn/read-string edn-options))))))

 #?(:clj
    (defn write-edn [file-path o]