Contains constraint

Contains constraint

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -450,39 +450,96 @@
 ;; CONSTRAINTS

 ;; los and his are inclusive
+
+;; propagate updates the current lo/hi for each var and returns one of:
+;;   failed (no possible solutions)
+;;   changed (possible solutions, los/his changed)
+;;   unchanged (possible solutions, los/his unchanged)
 ;; propagate may assume that los and his are within its current bounds
+;; push stores the current state of the constraint
+;; split either:
+;;   breaks the solutions into two branches, sets one branch and stores the other, returns true
+;;   has only one possible solution, does nothing, returns false
+;; pop restores the last push/split state

 (def unchanged 0)
 (def changed 1)
 (def failed 2)

-(deftype Contains [iterator seek-key ^:mutable lower upper ixes pushed|split pushed-nodes pushed-ixes split-keys]
+;; lower and upper are inclusive
+;; lower is aliased to iterator, must not be mutated
+(deftype Contains [iterator seek-key ^:mutable lower ^:mutable upper ixes pushed|split pushed-nodes pushed-ixes split-lowers split-uppers]
   Object
+  (reset [this]
+         (.reset iterator)
+         (dotimes [i (alength seek-key)]
+           (aset seek-key i least))
+         (set! lower (.seek-gte iterator seek-key))
+         (dotimes [i (alength upper)]
+           (aset upper i greatest))
+         (aclear pushed-nodes)
+         (aclear pushed-ixes)
+         (aclear split-lowers)
+         (aclear split-uppers))
   (propagate [this los his]
-             (dotimes [i (alength ixes)]
-               (aset seek-key i (aget los (aget ixes i)))
-               (aset upper i (aget his (aget ixes i))))
-             (when (key-lt lower seek-key)
-               (.seek iterator seek-key)
-               (if (true? (.-end? iterator))
-                 failed
-                 (let [key (.key iterator)]
-                   (if (key-lt upper lower)
-                     failed
-                     (let [changed? false]
-                       (set! lower (.key iterator))
-                       (dotimes [i (alength ixes)]
-                         (let [ix (aget ixes i)
-                               new-lo (aget lower i)]
-                           (when (val-lt (aget los ix) new-lo)
-                             (aset los ix new-lo)
-                             (set!! changed? true))))
-                       (if (true? changed?)
-                         changed
-                         unchanged)))))))
+             (if (nil? lower)
+               failed
+               (do
+                 (dotimes [i (alength ixes)]
+                   (aset seek-key i (aget los (aget ixes i))))
+                 (when (key-lt lower seek-key)
+                   (set! lower (.seek-gte iterator seek-key)))
+                 (if (or (nil? lower)
+                         (key-lt upper lower))
+                   failed
+                   (let [changed? false]
+                     (dotimes [i (alength ixes)]
+                       (let [ix (aget ixes i)
+                             new-lo (aget lower i)
+                             old-hi (aget his ix)
+                             new-hi (aget upper i)]
+                         (when (val-lt (aget los ix) new-lo)
+                           (aset los ix new-lo)
+                           (set!! changed? true))
+                         (if (val-lt new-hi old-hi)
+                           (do
+                             (aset his ix new-hi)
+                             (set!! changed? true))
+                           (aset upper i old-hi))))
+                     (if (true? changed?)
+                       changed
+                       unchanged))))))
   (push [this]
+        (apush pushed|split true)
         (apush pushed-nodes (.-node iterator))
-        (apush pushed-ixes (.-ix iterator))))
+        (apush pushed-ixes (.-ix iterator)))
+  (split [this]
+         ;; split by value of next unset var
+         (loop [i 0]
+           (if (< i (alength upper))
+             (if (identical? (aget lower i) (aget upper i))
+               (recur (+ i 1))
+               (do
+                 (apush pushed|split false)
+                 (apush split-uppers (aclone upper))
+                 (aset upper i (aget lower i))
+                 (apush split-lowers (aclone upper)) ;; the lower for right-hand branch is the next key after the upper for the left-hand branch
+                 true))
+             false)))
+  (pop [this]
+       (if (true? (.pop pushed|split))
+         (do
+           (set! (.-node iterator) (.pop pushed-nodes))
+           (set! (.-ix iterator) (.pop pushed-ixes)))
+         (do
+           (set! lower (.seek-gt iterator (.pop split-lowers)))
+           (set! upper (.pop split-uppers))))))
+
+(defn contains [iterator ixes]
+  (let [seek-key (least-key (alength ixes))
+        lower (.seek-gte iterator seek-key)
+        upper (greatest-key (alength ixes))]
+    (Contains. iterator seek-key lower upper ixes #js [] #js [] #js [] #js [] #js [])))

 ;; TESTS

@@ -696,7 +753,7 @@
 (defn product-join-prop [key-len]
   (prop/for-all [min-keys gen/s-pos-int
                  actions (gen/vector (gen-action key-len))
-                 movements (gen/vector (gen-seek key-len))]
+                 movements (gen/vector (gen-movement key-len))]
                 (run-product-join-prop min-keys key-len actions movements)))

 (comment


Tweak of sketch

Tweak of sketch

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -354,7 +354,6 @@
   (seek [this key]
         (set! old-node node)
         (set! old-ix ix)
-        (.next this)
         (let [start-node node
               start-ix ix]
           (when (false? end?)
@@ -414,42 +413,45 @@
   (end? [this]
         (.-end? iterator)))

-(deftype Join [seek-key iterators var->iterators end?]
+(deftype Join [seek-key iterators var->iterators ^:mutable end?]
   Object
   (key [this]
-       seek-key)
+       (when (false? end?)
+         seek-key))
   (search [this var]
           ;; assumes prefixes all equal, keys not all equal, iterators sorted by ascending key, nothing at end
-          (when (false? end?)
-            (let [iterators (aget var->iterators var)
-                  num-iterators (alength iterators)]
-              (loop [max-key (.key-at (aget iterators (- num-iterators 1)) var)
-                     current 0]
-                (let [iterator (aget iterators current)
-                      min-key (.key-at iterator var)]
-                  (aset seek-key var max-key)
-                  (let [old-key (.inner-key iterator)]
-                    (.seek iterator seek-key)
-                    (if (.end? iterator)
-                      (do
-                        (.undo iterator)
-                        (.up this var))
-                      (let [new-key (.inner-key iterator)]
-                        (if (prefix-not= old-key new-key var)
-                          (do
-                            (.undo iterator)
-                            (.up this var))
-                          (if (== (.key-at iterator var) max-key)
-                            (.down this var max-key)
-                            (recur min-key (mod (+ current 1) num-iterators)))))))))))))
+          (let [iterators (aget var->iterators var)
+                num-iterators (alength iterators)]
+            (loop [max-key (.key-at (aget iterators (- num-iterators 1)) var)
+                   current 0]
+              (prn :search max-key current)
+              (let [iterator (aget iterators current)
+                    min-key (.key-at iterator var)]
+                (aset seek-key var max-key)
+                (let [old-key (.inner-key iterator)]
+                  (.seek iterator seek-key)
+                  (if (.end? iterator)
+                    (do
+                      (.undo iterator)
+                      (.up this var))
+                    (let [new-key (.inner-key iterator)]
+                      (if (prefix-not= old-key new-key var)
+                        (do
+                          (.undo iterator)
+                          (.up this var))
+                        (if (== (.key-at iterator var) max-key)
+                          (.down this var max-key)
+                          (recur min-key (mod (+ current 1) num-iterators)))))))))))
   (up [this old-var]
       ;; assumes prefixes and keys all equal, nothing at end
+      (prn :up old-var)
       (if (== old-var 0)
-        (set end? true)
+        (set! end? true)
         (let [new-var (- old-var 1)
               iterators (aget var->iterators new-var)
               iterator (aget iterators (- (alength iterators) 1))]
-          (aset seek-key old-var least)
+          (when (< old-var (- (alength var->iterators) 1))
+            (aset seek-key old-var least))
           (.next iterator)
           (if (.end? iterator)
             (do
@@ -458,24 +460,29 @@
             (.search this new-var)))))
   (down [this old-var old-key]
         ;; assumes prefixes all equal, nothing at end
+        (prn :down old-var old-key)
         (if (== old-var (- (alength var->iterators) 1))
           nil ;; done
           (let [new-var (+ old-var 1)
                 iterators (aget var->iterators new-var)]
+            (when (>= old-var 0)
+              (aset seek-key old-var old-key))
+            (dotimes [i (alength iterators)]
+              (doto (aget iterators i) (.reset) (.seek seek-key))) ;; TODO this could be implemented more efficiently
+            (assert (every? #(not (.end? %)) iterators) (js/console.log iterators)) ;; TODO remove this when debugged
             (js/goog.array.sort iterators (fn [i0 i1] (compare (.key-at i0 new-var) (.key-at i1 new-var))))
-            (aset seek-key old-var old-key)
             (if (== (.key-at (aget iterators 0) new-var) (.key-at (aget iterators (- (alength iterators) 1)) new-var))
               (.down this new-var (.key-at (aget iterators 0) new-var))
-              (.search this new-var))))
+              (.search this new-var)))))
   (next [this]
         (let [iterators (aget var->iterators (- (alength var->iterators) 1))
               iterator (aget iterators (- (alength var->iterators) 1))]
-          (.next iterator)
-          (if (.end? iterator)
-            (do
-              (.undo iterator)
-              (.up this new-var))
-            (.search this new-var)))))
+          (.up this (alength var->iterators)))))
+
+(defn join []
+  ;; TODO check if at end in constructor
+  )
+

 (defn iter-seq
   ([iterator]


Ensure seek always consumes at least one key so that leapfrog terminates

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -275,47 +275,52 @@
                   nil)))
             (do
               (set! node (aget (.-children node) (+ ix 1)))
-              (set! ix 0)))))
+              (set! ix 0)
+              (loop []
+                (when-not (nil? (.-children node))
+                  (set! node (aget (.-children node) 0))
+                  (recur)))))))
   (seek [this key]
-        (loop [moved? false]
+        (.next this)
+        (let [start-node node
+              start-ix ix]
           (when (false? end?)
-            (let [upper (.-upper node)]
-              (if (lt upper key)
-                (if (instance? Node (.-parent node))
-                  (do
-                    (set! ix (.-parent-ix node))
-                    (set! node (.-parent node))
-                    (recur true))
-                  (do
-                    (set! end? true)
-                    nil))
-                (loop [moved? moved?]
-                  (set! ix (.seek node key ix))
-                  (if (>= ix (alength (.-keys node)))
+            (loop []
+              (let [upper (.-upper node)]
+                (if (lt upper key)
+                  (if (instance? Node (.-parent node))
                     (do
-                      (set! node (aget (.-children node) ix))
-                      (set! ix 0)
-                      (recur true))
-                    (if (or (not moved?)
-                            (== key (aget (.-keys node) ix))
-                            (nil? (.-children node))
-                            (let [lower (.-upper (aget (.-children node) ix))]
-                              (lt lower key)))
-                      nil
+                      (set! ix (.-parent-ix node))
+                      (set! node (.-parent node))
+                      (recur))
+                    (set! end? true))
+                  (loop []
+                    (set! ix (.seek node key ix))
+                    (if (>= ix (alength (.-keys node)))
                       (do
                         (set! node (aget (.-children node) ix))
                         (set! ix 0)
-                        (recur true)))))))))))
+                        (recur))
+                      (if (or (and (identical? node start-node) (== ix start-ix))
+                              (== key (aget (.-keys node) ix))
+                              (nil? (.-children node))
+                              (let [lower (.-upper (aget (.-children node) ix))]
+                                (lt lower key)))
+                        nil
+                        (do
+                          (set! node (aget (.-children node) ix))
+                          (set! ix 0)
+                          (recur))))))))))))

 (defn iterator [tree]
   (loop [node (.-root tree)]
     (if (nil? (.-children node))
       (if (> (alength (.-keys node)) 0)
-        (Iterator. (.-max-keys tree) node -1 false)
-        (Iterator. (.-max-keys tree) node -1 true))
+        (Iterator. (.-max-keys tree) node 0 false)
+        (Iterator. (.-max-keys tree) node 0 true))
       (recur (aget (.-children node) 0)))))

-(deftype Intersection [iterators end?]
+(deftype Intersection [iterators ^:mutable end?]
   Object
   (key [this]
        (when (false? end?)
@@ -335,13 +340,13 @@
           (.next (aget iterators 0))
           (if (.-end? (aget iterators 0))
             (set! end? true)
-            (.search (+ current 1)))))
+            (.search this 1))))
   (seek [this key]
         (when (false? end?)
           (.seek (aget iterators 0) key)
           (if (.-end? (aget iterators 0))
             (set! end? true)
-            (.search (+ current 1))))))
+            (.search this 1)))))

 (defn intersection [iterators]
   (if (> (alength iterators) 1)
@@ -470,13 +475,14 @@
               (.key iterator)))))

 (defn apply-to-elems [elems movements]
-  (let [elems (atom (cons [least nil] elems))]
+  (let [elems (atom elems)]
     (for [movement movements]
       (case (nth movement 0)
         :next (do
                 (swap! elems rest)
                 (first (first @elems)))
         :seek (do
+                (swap! elems rest)
                 (swap! elems (fn [elems] (drop-while #(lt-fun (nth % 0) (nth movement 1)) elems)))
                 (first (first @elems)))))))

@@ -485,6 +491,7 @@
         sorted-map (apply-to-sorted-map (sorted-map-by compare-keys) actions)
         iterator-results (apply-to-iterator (iterator tree) movements)
         elems-results (apply-to-elems (seq sorted-map) movements)]
+    #_(.pretty-print tree)
     (= iterator-results elems-results)))

 (def iterator-prop


Add volumes to :taktilesbuch

Add volumes to :taktilesbuch

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -432,6 +432,7 @@
                          :braille-grade (braille-grade-raw-to-braille-grade braille-grade)
                          :double-spaced? (get-double-spaced double-spaced?)
                          :accompanying-material (get-accompanying-material raw-item)
+                         :volumes (parse-int volumes)
                          :print-and-braille? print-and-braille?))
       ; default case that shouldn't really happen. When the MARC21
       ; entry contains a faulty format then just return the item with


support custom mapped stacktrace printing

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -117,6 +117,11 @@
        :column <integer>}*]

      :file must be a URL path (without protocol) relative to :output-dir."))
+
+(defprotocol IPrintStacktrace
+  (-print-stacktrace [repl-env stacktrace error build-options]
+    "Implementing REPL evaluation environments are given the opportunity to
+     print the mapped stacktrace themselves. This permits further processing."))

 (defn- env->opts
   "Returns a hash-map containing all of the entries in [repl-env], translating
@@ -295,7 +300,9 @@
                (satisfies? IParseStacktrace repl-env))
         (let [cst (-parse-stacktrace repl-env st ret opts)]
           (if (vector? cst)
-            (print-mapped-stacktrace cst opts)
+            (if (satisfies? IPrintStacktrace repl-env)
+              (-print-stacktrace repl-env cst ret opts)
+              (print-mapped-stacktrace cst opts))
             (println st)))
         (println st))
       (flush))))


canonical file paths and remove JVM working directory from path

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -186,7 +186,9 @@
             [line' column'] (mapped-line-and-column sm line column)
             name' (if function
                     (symbol (name ns) (cljrepl/demunge function))
-                    ns)]
+                    ns)
+            source-file (string/replace (.getCanonicalFile ^File source-file)
+                          (str (System/getProperty "user.dir") File/separator) "")]
         (println (str name' " (" source-file ":" line' ":" column' ")"))))))

 (comment


add note on clearing flag after each turn

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1370,6 +1370,7 @@
             hosted-on-ice (->> (get-in @state [:corp :servers]) seq flatten (mapcat :ices) (mapcat :hosted))]
         (doseq [card (concat rig-cards hosted-cards hosted-on-ice)]
           ;Clear the added-virus-counter flag for each virus in play.
+          ;We do this even on the corp's turn to prevent shenanigans with something like Gorman Drip and Surge
           (when (or (has? card :subtype "Virus") (= (:counter-type card) "Virus"))
             (set-prop state :runner card :added-virus-counter false))))
       (swap! state assoc :end-turn true)


Tell what you paid for installing/rezzing etc.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -35,12 +35,20 @@
              (or (not forfeit-cost) (not (empty? scored))))
       {:costs costs, :forfeit-cost forfeit-cost, :scored scored})))

+(defn cost-names [value attr]
+  (when (> value 0)
+    (case attr
+      :credit (str value " [$]")
+      :click  (->> "[Click]" repeat (take value) (apply str)))))
+
 (defn deduce [state side [attr value]]
   (swap! state update-in [side attr] (if (= attr :memory)
                                        #(- % value) ;; memoryunits may be negative
                                        #(max 0 (- % value))))
   (when (and (= attr :credit) (= side :runner) (get-in @state [:runner :run-credit]))
-    (swap! state update-in [:runner :run-credit] #(max 0 (- % value)))))
+    (swap! state update-in [:runner :run-credit] #(max 0 (- % value))))
+  (when-let [cost-name (cost-names value attr)]
+    cost-name))

 (defn pay [state side card & args]
   (when-let [{:keys [costs forfeit-cost scored]} (apply can-pay? state side args)]
@@ -49,11 +57,14 @@
            (forfeit state side (first scored))
            (prompt! state side card "Choose an Agenda to forfeit" scored
                     {:effect (effect (forfeit target))})))
-    (not (doseq [c costs]
-           (when (= (first c) :click)
-             (trigger-event state side (if (= side :corp) :corp-spent-click :runner-spent-click) nil)
-             (swap! state assoc-in [side :register :spent-click] true))
-           (deduce state side c)))))
+    (->> costs (map #(do
+                       (when (= (first %) :click)
+                         (trigger-event state side (if (= side :corp) :corp-spent-click :runner-spent-click) nil)
+                         (swap! state assoc-in [side :register :spent-click] true))
+                       (deduce state side %)))
+                (filter some?)
+                (interpose " and ")
+                (apply str))))

 (defn gain [state side & args]
   (doseq [r (partition 2 args)]
@@ -297,12 +308,12 @@
 (defn init-trace [state side card {:keys [base] :as ability} boost]
   (trigger-event state side :pre-init-trace card)
   (let [bonus (or (get-in @state [:bonus :trace]) 0)
-        base (if (fn? base) (base state side card nil) base)
+        base (if (fn? base) (base state side card nil) base)
         total (+ base boost bonus)]
-    (system-msg state :corp (str "uses " (:title card)
-                                 " to initiate a trace with strength " total
+    (system-msg state :corp (str "uses " (:title card)
+                                 " to initiate a trace with strength " total
                                  " (" base
-                                 (when (> bonus 0) (str " + " bonus " bonus"))
+                                 (when (> bonus 0) (str " + " bonus " bonus"))
                                  " + " boost " [Credits])"))
     (swap! state update-in [:bonus] dissoc :trace)
     (show-prompt state :runner card (str "Boost link strength?") :credit #(resolve-trace state side %))
@@ -365,23 +376,26 @@
                                cards (distinct-by :title cards))))]
             (prompt! state (or player side) card prompt cs (dissoc ability :choices) {:priority priority})))
         (when (and (or (not counter-cost) (<= counter-cost (or counter 0)))
-                   (or (not advance-counter-cost) (<= advance-counter-cost (or advance-counter 0)))
-                   (apply pay (concat [state side card] cost)))
-          (let [c (-> card
-                      (update-in [:advance-counter] #(- (or % 0) (or advance-counter-cost 0)))
-                      (update-in [:counter] #(- (or % 0) (or counter-cost 0))))]
-            (when (or counter-cost advance-counter-cost)
-              (update! state side c)
-              (when (= (:type card) "Agenda") (trigger-event state side :agenda-counter-spent card)))
-            (when msg
-              (let [desc (if (string? msg) msg (msg state side card targets))]
-                (system-msg state (to-keyword (:side card))
-                            (str "uses " title (when desc (str " to " desc))))))
-            (when effect (effect state side c targets))
-            (when end-turn
-              (swap! state update-in [side :register :end-turn]
-                     #(conj % {:ability end-turn :card card :targets targets}))))
-          (when once (swap! state assoc-in [once (or once-key cid)] true)))))))
+                   (or (not advance-counter-cost) (<= advance-counter-cost (or advance-counter 0))))
+          (when-let [cost-str (apply pay (concat [state side card] cost))]
+            (let [c (-> card
+                        (update-in [:advance-counter] #(- (or % 0) (or advance-counter-cost 0)))
+                        (update-in [:counter] #(- (or % 0) (or counter-cost 0))))]
+              (when (or counter-cost advance-counter-cost)
+                (update! state side c)
+                (when (= (:type card) "Agenda") (trigger-event state side :agenda-counter-spent card)))
+              (when msg
+                (let [desc (if (string? msg) msg (msg state side card targets))]
+                  (system-msg state (to-keyword (:side card))
+                              (str (if (= "" cost-str)
+                                       "uses "
+                                       (str "spends " cost-str " to use "))
+                                   title (when desc (str " to " desc))))))
+              (when effect (effect state side c targets))
+              (when end-turn
+                (swap! state update-in [side :register :end-turn]
+                       #(conj % {:ability end-turn :card card :targets targets}))))
+            (when once (swap! state assoc-in [once (or once-key cid)] true))))))))

 (defn handle-end-run [state side]
   (if-not (empty? (get-in @state [:runner :prompt]))
@@ -527,8 +541,8 @@
   (swap! state update-in [:bonus :cost] (fnil #(+ % n) 0)))

 (defn init-trace-bonus [state side n]
-  (swap! state update-in [:bonus :trace] (fnil #(+ % n) 0)))
-
+  (swap! state update-in [:bonus :trace] (fnil #(+ % n) 0)))
+
 (defn rez-cost [state side {:keys [cost] :as card}]
   (if (nil? cost)
     nil
@@ -1262,22 +1276,24 @@
                   (not (and (has? card :subtype "Current")
                             (get-in @state [side :register :cannot-play-current])))
                   (not (and (has? card :subtype "Priority")
-                            (get-in @state [side :register :spent-click])))
-                  (pay state side card :credit (:cost card) extra-cost
-                       (when-not no-additional-cost additional-cost)))
-         (let [c (move state side (assoc card :seen true) :play-area)]
-           (system-msg state side (str "plays " title))
-           (trigger-event state side (if (= side :corp) :play-operation :play-event) c)
-           (if (has? c :subtype "Current")
-             (do (doseq [s [:corp :runner]]
-                   (when-let [current (first (get-in @state [s :current]))]
-                     (say state side {:user "__system__" :text (str (:title current) " is trashed.")})
-                     (trash state side current)))
-                 (let [moved-card (move state side (first (get-in @state [side :play-area])) :current)]
-                   (card-init state side moved-card)))
-             (do
-               (resolve-ability state side cdef card nil)
-               (move state side (first (get-in @state [side :play-area])) :discard))))))))
+                            (get-in @state [side :register :spent-click]))))
+         (when-let [cost-str (pay state side card :credit (:cost card) extra-cost
+                              (when-not no-additional-cost additional-cost))]
+           (let [c (move state side (assoc card :seen true) :play-area)]
+             (system-msg state side (if (= "" cost-str)
+                                     (str "plays " title)
+                                     (str "spends " cost-str " to play " title)))
+             (trigger-event state side (if (= side :corp) :play-operation :play-event) c)
+             (if (has? c :subtype "Current")
+               (do (doseq [s [:corp :runner]]
+                     (when-let [current (first (get-in @state [s :current]))]
+                       (say state side {:user "__system__" :text (str (:title current) " is trashed.")})
+                       (trash state side current)))
+                   (let [moved-card (move state side (first (get-in @state [side :play-area])) :current)]
+                     (card-init state side moved-card)))
+               (do
+                 (resolve-ability state side cdef card nil)
+                 (move state side (first (get-in @state [side :play-area])) :discard)))))))))

 (defn in-play? [state card]
   (let [dest (when (= (:side card) "Runner")
@@ -1289,7 +1305,6 @@
     (if (:host card)
       (assoc card :host (assoc-host-zones (:host card)))
       card)))
-

 (defn host
   ([state side card target] (host state side card target nil))
@@ -1332,21 +1347,21 @@
                                         (when memoryunits [:memory memoryunits])))]
          (when (and (or (not uniqueness) (not (in-play? state card)) facedown)
                     (if-let [req (:req (card-def card))]
-                      (or facedown (req state side card nil)) true)
-                    (pay state side card cost))
-           (let [c (if host-card
-                     (host state side host-card card)
-                     (move state side card [:rig (if facedown :facedown (to-keyword type))]))
-                 installed-card (card-init state side (assoc c :installed true) (not facedown))]
-             (if facedown
-               (system-msg state side "installs a card facedown" )
-             (if custom-message
-               (system-msg state side custom-message)
-               (system-msg state side (str "installs " title
-                                           (when host-card (str " on " (:title host-card)))
-                                           (when no-cost " at no cost")))))
-             (trigger-event state side :runner-install installed-card)
-             (when (has? c :subtype "Icebreaker") (update-breaker-strength state side c)))))))
+                      (or facedown (req state side card nil)) true))
+           (when-let [cost-str (pay state side card cost)]
+             (let [c (if host-card
+                       (host state side host-card card)
+                       (move state side card [:rig (if facedown :facedown (to-keyword type))]))
+                   installed-card (card-init state side (assoc c :installed true) (not facedown))]
+               (if facedown
+                 (system-msg state side "installs a card facedown" )
+               (if custom-message
+                 (system-msg state side custom-message)
+                 (system-msg state side (str (if (= "" cost-str) "installs " (str "spends " cost-str " to install ")) title
+                                          (when host-card (str " on " (:title host-card)))
+                                          (when no-cost " at no cost")))))
+               (trigger-event state side :runner-install installed-card)
+               (when (has? c :subtype "Icebreaker") (update-breaker-strength state side c))))))))
    (when (has? card :type "Resource") (swap! state assoc-in [:runner :register :installed-resource] true))
    (swap! state update-in [:bonus] dissoc :install-cost)))

@@ -1364,13 +1379,17 @@
      (when (or (#{"Asset" "ICE" "Upgrade"} (:type card)) (:install-rezzed (card-def card)))
        (trigger-event state side :pre-rez-cost card)
        (let [cdef (card-def card) cost (rez-cost state side card)]
-         (when (or no-cost (pay state side card :credit cost (:additional-cost cdef)))
+         (when-let [cost-str (or no-cost (pay state side card :credit cost (:additional-cost cdef)))]
            (card-init state side (assoc card :rezzed true))
            (doseq [h (:hosted card)]
              (update! state side (-> h
                                      (update-in [:zone] #(map to-keyword %))
                                      (update-in [:host :zone] #(map to-keyword %)))))
-           (system-msg state side (str "rez " (:title card) (when no-cost " at no cost")))
+           (system-msg state side (str (if (or (nil? cost-str)
+                                               (= "" cost-str))
+                                         "rez "
+                                         (str "spends " cost-str " to rez "))
+                                       (:title card) (when no-cost " at no cost")))
            (when (#{"ICE"} (:type card)) (update-ice-strength state side card))
            (trigger-event state side :rez card))))
      (swap! state update-in [:bonus] dissoc :cost)))
@@ -1390,28 +1409,28 @@
                  install-cost (if (and (= (:type c) "ICE") (not no-install-cost))
                                 (count dest-zone) 0)
                  install-state (or install-state (:install-state cdef))]
-             (when (and (not (and (has? c :subtype "Region")
-                                  (some #(has? % :subtype "Region") dest-zone)))
-                        (pay state side card extra-cost :credit install-cost))
-               (when (#{"Asset" "Agenda"} (:type c))
-                 (when-let [prev-card (some #(when (#{"Asset" "Agenda"} (:type %)) %) dest-zone)]
-                   (system-msg state side (str "trashes " (if (:rezzed prev-card)
-                                                            (:title prev-card) "a card") " in " server))
-                   (trash state side prev-card {:keep-server-alive true})))
-               (let [card-name (if (or (= :rezzed install-state) (= :face-up install-state) (:rezzed c))
-                                 (:title card) "a card")]
-                 (if (> install-cost 0)
-                   (system-msg state side (str "pays " install-cost " [Credits] to install "
+             (when (not (and (has? c :subtype "Region")
+                             (some #(has? % :subtype "Region") dest-zone)))
+               (when-let [cost-str (pay state side card extra-cost :credit install-cost)]
+                 (when (#{"Asset" "Agenda"} (:type c))
+                   (when-let [prev-card (some #(when (#{"Asset" "Agenda"} (:type %)) %) dest-zone)]
+                     (system-msg state side (str "trashes " (if (:rezzed prev-card)
+                                                              (:title prev-card) "a card") " in " server))
+                     (trash state side prev-card {:keep-server-alive true})))
+                 (let [card-name (if (or (= :rezzed install-state) (= :face-up install-state) (:rezzed c))
+                                   (:title card) "a card")]
+                   (system-msg state side (str (if (= "" cost-str)
+                                                  "installs "
+                                                  (str "spends " cost-str " to install "))
                                                card-name " in " server))
-                   (system-msg state side (str "installs " card-name " in " server))))
-               (let [moved-card (move state side c slot)]
-                 (trigger-event state side :corp-install moved-card)
-                 (when (= (:type c) "Agenda")
-                   (update-advancement-cost state side moved-card))
-                 (when (= install-state :rezzed)
-                   (rez state side moved-card {:no-cost true}))
-                 (when (= install-state :face-up)
-                   (card-init state side (assoc (get-card state moved-card) :rezzed true) false)))))))))
+                 (let [moved-card (move state side c slot)]
+                   (trigger-event state side :corp-install moved-card)
+                   (when (= (:type c) "Agenda")
+                     (update-advancement-cost state side moved-card))
+                   (when (= install-state :rezzed)
+                     (rez state side moved-card {:no-cost true}))
+                   (when (= install-state :face-up)
+                     (card-init state side (assoc (get-card state moved-card) :rezzed true) false)))))))))))

 (defn play [state side {:keys [card server]}]
   (case (:type card)


Stop emailing rvitillo for alerts.

Stop emailing rvitillo for alerts.

It turns out that rvitillo was added to every email alert through a
subscription to the entire Histogram Regression detector.

No one else used that system, so just remove it from the email list.

Fixes mozilla/cerberus#29

--- src/clj/medusa/db.clj
+++ src/clj/medusa/db.clj
@@ -242,7 +242,7 @@
                      (map :user_id)
                      (apply hash-set))

-        subs (let [subs (set/union metric-subs detector-subs)]
+        subs (let [subs (set/union metric-subs)]
                (map #(-> (select user (where (= :id %)))
                          first
                          :email)


Change doc-string.

Change doc-string.

--- src/clj_stan/core.clj
+++ src/clj_stan/core.clj
@@ -82,9 +82,9 @@

 (defmulti model-path
   "Takes a file name, a file object, a resource url, or similar.
-  Returns a file path that can be passed to the `stanc` executable; if
-  necessary by writing out the data to a new file in the `target`
-  directory. Returns `nil` if this is not possible."
+  Returns a file path that can be passed to the `stanc` executable (if
+  necessary by writing out the content of the resource to a new file
+  in the `target` directory). Returns `nil` if this is not possible."
   type)

 (defmethod model-path :default [_] nil)


cleanup initialise-db events

cleanup initialise-db events

--- priv/ui/src/cljs/holiday_ping_ui/auth/events.cljs
+++ priv/ui/src/cljs/holiday_ping_ui/auth/events.cljs
@@ -30,9 +30,8 @@
          auth-route?  (routes/auth-route? path)]
      (cond
        (and auth-route? logged-in?)
-       {:db         db/default-db
-        :dispatch-n [[:navigate :channel-list]
-                     [:user-load {:access_token stored-token}]]}
+       {:db       db/default-db
+        :dispatch [:login-success {:access_token stored-token}]}

        (and (not auth-route?) (not logged-in?))
        {:db       db/default-db
@@ -48,7 +47,7 @@

        stored-token
        {:db       db/default-db
-        :dispatch [:user-load {:access_token stored-token}]}
+        :dispatch [:store-token stored-token]}

        :else
        {:db db/default-db}))))
@@ -73,17 +72,16 @@
 (re-frame/reg-event-fx
  :login-success
  (fn [_ [_ response]]
-   {:dispatch-n [[:navigate :channel-list]
-                 [:user-load response]]}))
+   {:dispatch-n [[:store-token (:access_token response)]
+                 [:navigate :channel-list]]}))

 (re-frame/reg-event-fx
- :user-load
+ :store-token
  (fn
-   [{:keys [db]} [_ response]]
-   (let [token (:access_token response)]
-     {:db              (assoc db :access-token token)
-      :set-local-store ["access_token" token]
-      :dispatch        [:channel-load]})))
+   [{:keys [db]} [_ token]]
+   {:db              (assoc db :access-token token)
+    :set-local-store ["access_token" token]
+    :dispatch        [:channel-load]})) ;; TODO try to remove this, load in the view instead

 (re-frame/reg-event-fx
  :logout


Non-working start on run-all fn

Non-working start on run-all fn

--- src/cooljure/core.clj
+++ src/cooljure/core.clj
@@ -8,7 +8,8 @@
 (ns ^{:doc "Cooljure - Cool stuff you wish was in Clojure"
       :author "Alan Thompson"}
   cooljure.core
-    (:require [clojure.test      :as test] ) )
+    (:require [clojure.string       :as str]
+              [clojure.test         :as test] ) )

 (defn truthy?
  "[arg]
@@ -129,3 +130,31 @@
   ]
   nil ))

+
+;************************************************************
+; awtawt TODO:  broken, needs fix!
+;
+(defn f1 [] (println "*** f1 ***"))
+(defn f2 [] (println "*** f2 ***"))
+
+(defn run-all
+  "[& fn-list]
+  Convenience fn to run a function in the REPL after first reloading its namespace from
+  disk.  Functions must be fully namespace-qualified.  Example:
+
+    (run-all 'cooljure.core/main 'cooljure.csv/demo)
+
+  This will reload cooljure.core, and cooljure.csv, then execute the corresponging main
+  and test functions."
+  [& fn-list]
+  (spy-expr fn-list)
+  (doseq [curr-fn fn-list]
+    (let [  _ (spy-expr curr-fn)
+          ns-str      (str/replace (str curr-fn) #"/.*$" "")
+          curr-ns     (symbol ns-str) ]
+      (println "reloading:" ns-str)
+      (require curr-ns :reload-all)
+      (println "running" curr-fn)
+      (eval curr-fn)
+    )))
+


delaney.clj: added a (dsymbol) implementation for Java type DelaneySymbol

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -170,8 +170,8 @@
             (assert-arg "E" E #(and (integer? %) (pos? %)) "a positive integer")
             (assert (= (v ds i (inc i) D) (v ds i (inc i) E)))
             (assert (= (v ds (dec i) i D) (v ds (dec i) i E)))
-            (assert (nil? (s ds i D)))
-            (assert (nil? (s ds i E)))
+            (assert (= E (or (s ds i D) E)) "must unglue first")
+            (assert (= D (or (s ds i E) D)) "must unglue first")
             (DSymbol. (max dim i)
                       (max size D E)
                       (assoc s# i (assoc (s# i) D E, E D))
@@ -290,6 +290,24 @@
                 (parse-number-lists spins))]
     d-sym))

+(defmethod dsymbol DSymbol [ds] ds)
+
+(defmethod dsymbol DelaneySymbol [ds]
+  (let [emap (zipmap (.elements ds) (range 1 (inc (size ds))))
+        imap (zipmap (indices ds) (range (inc (dim ds))))
+        gluings (for [i (indices ds), D (orbit-reps ds [i])]
+                  [(imap i) (emap D) (emap (s ds i D))])
+        spins (for [[i j] (zipmap (indices ds) (rest (indices ds)))
+                    D (orbit-reps ds [i j])]
+                [(imap i) (emap D) (v ds i j D)])
+        d-set (reduce (fn [ds [i D E]] (glue ds i D E))
+                      (DSymbol. (dim ds) (size ds) {} {})
+                      gluings)
+        d-sym (reduce (fn [ds [i D v]] (spin ds i (inc i) D v))
+                      d-set
+                      spins)]
+    d-sym))
+
 ;; === Tests

 (deftest adding-elements


Refactor admin.clj

Refactor admin.clj


didnt mean to push this before

didnt mean to push this before


refactor code

refactor code


(SERVER-73) Log message when puppetserver is ready

Log a message when puppet-server's jetty server has finished
starting up and is ready to receive requests.

--- src/clj/puppetlabs/services/master/master_service.clj
+++ src/clj/puppetlabs/services/master/master_service.clj
@@ -26,4 +26,8 @@
      (add-ring-handler
       (compojure/context path [] (core/compojure-app handle-request))
       path))
-   context))
+   context)
+  (start
+    [this context]
+    (log/info "Puppet Server has successfully started and is now ready to handle requests")
+    context))


Improve cortex.layers docs

Improve cortex.layers docs

--- src/cortex/layers.clj
+++ src/cortex/layers.clj
@@ -23,6 +23,7 @@
     (cortex.impl.wiring.FunctionModule. f nil {:gradient-fn gradient-fn})))

 (defn logistic
+  "Creates a logistic module of the given shape."
   ([shape]
     (when-not (coll? shape)
       (error "logistic layer constructor requires a shape vector"))
@@ -31,23 +32,27 @@
       (m/ensure-mutable (m/new-array :vectorz shape)))))

 (defn softmax
-  [shape]
-  (when-not (coll? shape)
-    (error "softmax layer constructor requires a shape vector"))
-  (cortex.impl.layers.Softmax.
-      (m/ensure-mutable (m/new-array :vectorz shape))
-      (m/ensure-mutable (m/new-array :vectorz shape))))
+  "Creates a softmax module of the given shape."
+  ([shape]
+    (when-not (coll? shape)
+      (error "softmax layer constructor requires a shape vector"))
+    (cortex.impl.layers.Softmax.
+        (m/ensure-mutable (m/new-array :vectorz shape))
+        (m/ensure-mutable (m/new-array :vectorz shape)))))

 (defn relu
-  [shape & {:keys [negval]
+  "Creates a rectified linear (ReLU) module of the given shape.
+
+   An optional lower bound may be provided, which otherwise defaults to 0.0"
+  ([shape & {:keys [negval]
             :or {negval 0.0 }}]
-  (when-not (coll? shape)
-    (error "relu layer constructor requires a shape vector"))
-  (cortex.impl.layers.RectifiedLinear.
-      (m/ensure-mutable (m/new-array :vectorz shape))
-      (m/ensure-mutable (m/new-array :vectorz shape))
-      (m/ensure-mutable (m/new-array :vectorz shape))
-      negval))
+    (when-not (coll? shape)
+      (error "relu layer constructor requires a shape vector"))
+    (cortex.impl.layers.RectifiedLinear.
+        (m/ensure-mutable (m/new-array :vectorz shape))
+        (m/ensure-mutable (m/new-array :vectorz shape))
+        (m/ensure-mutable (m/new-array :vectorz shape))
+        negval)))

 (defn linear
   "Constructs a weighted linear transformation module using a dense matrix and bias vector.


Add to doc listing.

Add to doc listing.


minor cleanup of basic-test (#170)

minor cleanup of basic-test (#170)


Fixed flattening of child item lists

Fixed flattening of child item lists

--- test/hyjinks_test.clj
+++ test/hyjinks_test.clj
@@ -154,6 +154,13 @@
   (is (= (:attrs (tag 'div.clear#content)) (attrs :id "content" :className "clear")))
   (is (= (:attrs (tag :div.clear#content)) (attrs :id "content" :className "clear"))))

+(deftest child-items
+  (testing "when some child items are lists"
+    (let [t (div "numbers:" [1 2 3])]
+
+      (testing "child items should be flattened into one long list"
+        (is (= (:items t) ["numbers:" 1 2 3]))))))
+
 (deftest class-name-attribute
   (testing "when :className attribute is set to a list"
     (let [t (div {:className ["a" "b" "c"]})]


Added new logfile fields

Added new logfile fields

--- src/demogorgon/nh.clj
+++ src/demogorgon/nh.clj
@@ -531,7 +531,10 @@
       [:gender0 "TEXT"]
       [:align0 "TEXT"]
       [:flags "TEXT"]
-      [:region "TEXT"])
+      [:region "TEXT"]
+      [:event "TEXT"]
+      [:carried "TEXT"]
+      [:elbereths "INT"])
      (let [lines (read-lines (str (:un-dir config) "xlogfile"))]
        (doseq [line lines]
          (insert-xlogfile-line-db "eu" line)))


RS | #22 | Escape html before markdown parsing

--- src/objective8/handlers/front_end.clj
+++ src/objective8/handlers/front_end.clj
@@ -5,6 +5,7 @@
             [endophile.core :as ec]
             [endophile.hiccup :as eh]
             [hiccup.core :as hc]
+            [hiccup.util :as hc-util]
             [cheshire.core :as json]
             [org.httpkit.client :as http]
             [objective8.responses :refer :all]
@@ -331,7 +332,7 @@
 (defn edit-draft-post [{{o-id :id} :route-params
                         {content :content action :action} :params
                         :as request}]
-  (let [parsed-markdown (eh/to-hiccup (ec/mp content))
+  (let [parsed-markdown (eh/to-hiccup (ec/mp (hc-util/escape-html content)))
         objective-id (Integer/parseInt o-id)]
     (cond
       (= action "preview")


Drop the produced_date from the ABACUS export

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -167,11 +167,9 @@
            ;; updating metadata
            (dissoc :production_type :revision_date))))))

-(def ^:private date-format "%1$td.%1$tm.%1$tY")
-
 (defn- export-sexp
   [{:keys [product_number total_time state audio_format
-           multimedia_type produced_date volumes depth] :as production}]
+           multimedia_type volumes depth] :as production}]
   [:AbaConnectContainer
    [:TaskCount 1]
    [:Task
@@ -186,8 +184,6 @@
       [:ProductNumber product_number]
       [:Ascii3 (string/capitalize state)]
       [:_USERFIELD13 (quot (or total_time 0) (* 1000 60))] ; in minutes
-      [:_USERFIELD52 (and produced_date
-                          (format date-format produced_date))] ; Date of production end
       [:_USERFIELD54 volumes]
       [:__USERFIELD53 depth]
       [:__USERFIELD54 audio_format]


Sort columns and rows, don't be flaky

Sort columns and rows, don't be flaky

--- src/greenyet/view.clj
+++ src/greenyet/view.clj
@@ -13,6 +13,8 @@
 (defn- environment-table [environments host-list]
   (->> host-list
        (group-by :system)
+       (sort (fn [[system1 _] [system2 _]]
+               (compare system1 system2)))
        (map (fn [[_ system-host-list]]
               (system-row environments system-host-list)))))

@@ -46,6 +48,6 @@

 (defn render [host-list-with-status]
-  (let [environments (distinct (map :environment host-list-with-status))
+  (let [environments (sort (distinct (map :environment host-list-with-status)))
         rows (environment-table environments host-list-with-status)]
     (environment-table-as-html environments rows)))


Support attr-val listeners on non-unique attrs. Support not-found arg in get-in.

--- src/re_db/core.cljs
+++ src/re_db/core.cljs
@@ -84,8 +84,7 @@
   [db-snap pattern]
   (let [[id attr val] (mapv #(if (= % '_) nil %) pattern)]
     (cond (and id attr) :entity-attr
-          (and attr val) (do (assert (unique? db-snap attr))
-                             :attr-val)
+          (and attr val) :attr-val
           id :id
           attr :attr
           :else nil)))
@@ -170,9 +169,16 @@

 (defn get-in
   "Get-in the entity with given id."
-  [db-snap id ks]
-  (when-let [id (resolve-id db-snap id)]
-    (apply get-in* (cons db-snap (cons id ks)))))
+  ([db-snap id ks]
+   (when-let [id (resolve-id db-snap id)]
+     (some-> *access-log*
+             (swap! update-in [:entity-attr id] (fnil conj #{}) (first ks)))
+     (get-in* db-snap (cons :data (cons id ks)))))
+  ([db-snap id ks not-found]
+   (when-let [id (resolve-id db-snap id)]
+     (some-> *access-log*
+             (swap! update-in [:entity-attr id] (fnil conj #{}) (first ks)))
+     (get-in* db-snap (cons :data (cons id ks)) not-found))))

 (defn select-keys
   "Select keys from entity of id"
@@ -358,10 +364,12 @@
        (mapv (fn [q]
                (set (cond (fn? q)
                           (reduce-kv (fn [s id entity] (if ^:boolean (q entity) (conj s id) s)) #{} (get* db-snap :data))
+
                           (keyword? q)
                           (do (some-> *access-log*
                                       (swap! update :attr conj [nil q nil]))
                               (reduce-kv (fn [s id entity] (if ^:boolean (contains?* entity q) (conj s id) s)) #{} (get* db-snap :data)))
+
                           :else
                           (let [[attr val] q]
                             (some-> *access-log*


tab -> tabs for commands that affect tabs

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/tabs.cljs
+++ src/lt/objs/tabs.cljs
@@ -576,14 +576,14 @@
                       )})

 (cmd/command {:command :tabs.close-all
-              :desc "Tab: Close all tabs"
+              :desc "Tabs: Close all tabs"
               :exec (fn []
                       (let [objs (object/by-tag :tabset.tab)]
                         (doseq [obj objs]
                           (object/raise obj :close))))})

 (cmd/command {:command :tabs.close-others
-              :desc "Tab: Close tabs except current tab"
+              :desc "Tabs: Close tabs except current tab"
               :exec (fn []
                       (let [cur (active-tab)
                             objs (object/by-tag :tabset.tab)]


print http req & resp

print http req & resp

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -48,6 +48,9 @@
                   [k (replace-opts v opts)]))
           (filter #(or include-empty (not (str/blank? (second %)))))
           (into {})))))
+
+(defn print-http-message [req res]
+  )

 (defn diff* [a b]
   (let [ldiff (cond


automatic generate period strings

automatic generate period strings

--- src/open_company/resources/report.clj
+++ src/open_company/resources/report.clj
@@ -8,8 +8,15 @@
 (def ^:private table-name :reports)
 (def ^:private primary-key :symbol-year-period)

-(def periods #{"Q1" "Q2" "Q3" "Q4"
-               "M1" "M2" "M3" "M4" "M5" "M6" "M7" "M8" "M9" "M10" "M11" "M12"})
+(defn get-periods [prefix n]
+  (let [r (range 1 (+ n 1))]
+    (into #{} (for [a r] (str prefix a)))))
+
+(def periods (into #{}
+              (concat
+                (get-periods "Q" 4)
+                (get-periods "M" 12)
+                (get-periods "W" 52))))

 (defn- key-for
   ([report] (key-for (:symbol report) (:year report) (:period report)))


fix force float

fix force float

--- src/notifier/core.clj
+++ src/notifier/core.clj
@@ -84,7 +84,7 @@
         (doseq [[stock price] new-prices
                 :let[event-prices (@asx-prices stock {})
                      changes (for [[pct prev-price] event-prices
-                                   :let [change (-> (- price prev-price) (/ prev-price) (* 100))]
+                                   :let [change (-> (- price prev-price) (/ prev-price) (* 100.0))]
                                    :when #(>= (Math/abs change) pct)] [pct change])]]
           (doseq [[pct change] changes]
             (publish-event (str "ASX-" stock "-" pct) (str price)


save frontend ids for the docs

save frontend ids for the docs

--- src/pc/models/doc.clj
+++ src/pc/models/doc.clj
@@ -1,23 +1,25 @@
 (ns pc.models.doc
   (:require [pc.datomic :as pcd]
             [pc.models.chat-bot :as chat-bot-model]
-            [datomic.api :refer [db q] :as d]))
+            [datomic.api :refer [db q] :as d])
+  (:import java.util.UUID))

 (defn create! [doc-attrs]
   (let [temp-id (d/tempid :db.part/user)
         {:keys [tempids db-after]} @(d/transact (pcd/conn)
                                                 [(assoc doc-attrs :db/id temp-id)])]
-    (->> (d/resolve-tempid db-after
+    (let [eid (d/resolve-tempid db-after
                            tempids
-                           temp-id)
-         (d/entity db-after)
-         pcd/touch+)))
+                           temp-id)]
+      (-> (d/transact (pcd/conn) [[:db/add eid :frontend/id (UUID. eid eid)]])
+        deref
+        :db-after
+        (d/entity eid)))))

 (def default-name "Untitled")

 (defn create-public-doc! [doc-attrs]
-  (create! (merge {:dummy :dummy/dummy
-                   :document/name "Untitled"
+  (create! (merge {:document/name "Untitled"
                    :document/privacy :document.privacy/public}
                   doc-attrs)))


remove reify usage from success and failure callback impl

--- src/promesa/impl.cljc
+++ src/promesa/impl.cljc
@@ -70,6 +70,22 @@
      (-catch [it cb]
        (pt/-catch (pt/-promise it) cb))))

+#?(:clj
+   (deftype CallbackSuccessFunction [callback bindings]
+     Function
+     (apply [_ v]
+       (clojure.lang.Var/resetThreadBindingFrame bindings)
+       (callback v))))
+
+#?(:clj
+   (deftype CallbackFailureFunction [callback bindings]
+     Function
+     (apply [_ e]
+       (clojure.lang.Var/resetThreadBindingFrame bindings)
+       (if (instance? CompletionException e)
+         (callback (.getCause ^Exception e))
+         (callback e)))))
+
 #?(:clj
    (extend-type CompletableFuture
      pt/ICancellable
@@ -81,28 +97,17 @@
      pt/IPromise
      (-map [it cb]
        (let [binds (clojure.lang.Var/getThreadBindingFrame)
-             func (reify Function
-                    (apply [_ v]
-                      (clojure.lang.Var/resetThreadBindingFrame binds)
-                      (cb v)))]
+             func (CallbackSuccessFunction. cb binds)]
          (.thenApplyAsync it ^Function func ^Executor (get-executor))))

      (-bind [it cb]
        (let [binds (clojure.lang.Var/getThreadBindingFrame)
-             func (reify Function
-                    (apply [_ v]
-                      (clojure.lang.Var/resetThreadBindingFrame binds)
-                      (cb v)))]
+             func (CallbackSuccessFunction. cb binds)]
          (.thenComposeAsync it ^Function func ^Executor (get-executor))))

      (-catch [it cb]
        (let [binds (clojure.lang.Var/getThreadBindingFrame)
-             func (reify Function
-                    (apply [_ e]
-                      (clojure.lang.Var/resetThreadBindingFrame binds)
-                      (if (instance? CompletionException e)
-                        (cb (.getCause ^Exception e))
-                        (cb e))))]
+             func (CallbackFailureFunction. cb binds)]
          (.exceptionally it ^Function func)))

      pt/IState


merging machine data

merging machine data

--- src/proxmox/model.clj
+++ src/proxmox/model.clj
@@ -4,11 +4,11 @@
     [celestial.model :refer (clone hypervisor)]
     [celestial.common :refer (get!)]))

-(defmethod clone :proxmox [spec clone-spec]
+(defmethod clone :proxmox [spec {:keys [machine] :as clone-spec}]
   "Clones the model replace unique identifiers in the process"
   (-> spec
       (dissoc-in* [:proxmox :vmid])
-      (dissoc-in* [:machine :ip])
+      (update-in [:machine] #(merge % machine))
       ))

 (defn get-node [node]


require enlive and adding a private parse function that returns an enlive tree that is used as a basis

--- src/watney/core.clj
+++ src/watney/core.clj
@@ -1,4 +1,12 @@
-(ns watney.core)
+(ns watney.core
+  (:require [net.cgrand.enlive-html :as html]))
+
+(defn ^:private parse
+  "Parse the given HTML using Enlive and return the tree"
+  [html-string]
+  (-> html-string
+      java.io.StringReader.
+      html/html-resource))

 (defn convert
   "Convert the HTML string given into Markdown"


Fixed deprecation warning to use correct new function.

The `update` deprecation warning was recursive. Now it is not.

--- src/riemann/index.clj
+++ src/riemann/index.clj
@@ -123,5 +123,5 @@

 (defn update
   [index-instance event]
-  (deprecated "Update is now a reserved name in clojure, please use update!"
+  (deprecated "Update is now a reserved name in clojure, please use insert!"
               (insert index-instance event)))


Align to template version

Align to template version

--- modules/cljs/src/modular/cljs.clj
+++ modules/cljs/src/modular/cljs.clj
@@ -4,7 +4,7 @@
   (:require
    [com.stuartsierra.component :as component]
    [modular.bidi :refer (WebService)]
-   [modular.template :refer (TemplateData)]
+   [modular.template :refer (TemplateModel)]
    [bidi.bidi :refer (->Files)]
    [shadow.cljs.build :as cljs]
    [clojure.java.io :as io]
@@ -119,8 +119,8 @@
   JavaScripts
   (get-javascript-paths [this] (:javascripts this))

-  TemplateData
-  (template-data [this] {:javascripts (get-javascript-paths this)}))
+  TemplateModel
+  (template-model [this _] {:javascripts (get-javascript-paths this)}))

 (defn new-cljs-builder [& {:as opts}]
   (->> opts


Added fully-qualify

Added fully-qualify

--- src/shuriken/core.clj
+++ src/shuriken/core.clj
@@ -19,3 +19,17 @@
           false)))))

 (def not? complement)
+
+(defn fully-qualify
+  ([sym]
+   (fully-qualify *ns* sym))
+  ([ns sym]
+    (if-let [r (ns-resolve *ns* sym)]
+      (if (class? r)
+        (-> r str
+            (clojure.string/replace #"(?:class|interface) " "")
+            symbol)
+        (-> r meta :ns str
+            (str "/" (.sym r))
+            symbol))
+      sym)))


Dry up the mutation code.

Dry up the mutation code.

--- src/snergly/core.cljs
+++ src/snergly/core.cljs
@@ -139,7 +139,10 @@
       {:value value}
       {:value :not-found}))

-(defmulti produce-maze-value (fn [k v s] k))
+(defmulti produce-maze-value (fn [k v s] (keyword "snergly.core" (name k))))
+
+(run! #(derive % ::integer)
+      [::rows ::columns ::cell-size ::start-row ::start-col ::end-row ::end-col])

 (defn mutate [{:keys [state] :as env} key {:keys [maze-key value] :as params}]
   (if (= 'snergly.core/set-maze key)
@@ -148,28 +151,11 @@
        :action #(swap! state assoc-in [:maze maze-key] new-value)})
     {:value nil}))

-(defmethod produce-maze-value :algorithm
+(defmethod produce-maze-value :default
   [_ form-value _]
   form-value)

-(defmethod produce-maze-value :analysis
-  [_ form-value _]
-  form-value)
-
-(defmethod produce-maze-value :active
-  [_ form-value _]
-  form-value)
-
-(defmethod produce-maze-value :anim-chan
-  [_ form-value _]
-  form-value)
-
-(defmethod produce-maze-value :grid
-  [_ new-value {:keys [maze] :as state}]
-  (let [{:keys [algorithm rows columns grid]} maze]
-    new-value))
-
-(defmethod produce-maze-value :default
+(defmethod produce-maze-value ::integer
   [_ form-value _]
   (js/parseInt form-value))

@@ -202,7 +188,7 @@
   Object
   (componentDidMount [this]
     (handle-maze-change this))
-  (componentDidUpdate [this prev-props prev-state]
+  (componentDidUpdate [this _ _]
     (handle-maze-change this))
   (render [this]
     (let [{:keys [grid rows columns algorithm cell-size active] :as maze} (om/props this)]


Status display and disable form when active

--- src/snergly/core.cljs
+++ src/snergly/core.cljs
@@ -15,6 +15,9 @@

 (declare reconciler)

+(defn set-maze-param! [key val]
+  (om/transact! reconciler `[(snergly.core/set-maze {:maze-key ~key :value ~val})]))
+
 (def init-data
   {:app/algorithms (sort algs/algorithm-names)
    :app/analyses ["none" "distances"] ; "path" "longest path"
@@ -28,7 +31,9 @@
           :start-row 0
           :start-col 0
           :end-row 0
-          :end-col 0}})
+          :end-col 0
+
+          :active nil}})

 (defn run [algorithm-name rows columns]
   (let [algorithm (algs/synchronous-algorithm algorithm-name)]
@@ -49,6 +54,7 @@
   )

 (defn produce-maze-async [{:keys [rows columns algorithm] :as maze-params}]
+  (set-maze-param! :active "Carving maze …")
   (let [intermediate-chan (async/chan)
         _ (println (str "algorithm: " algorithm))
         algorithm-fn (algs/algorithm-functions algorithm)
@@ -57,17 +63,18 @@
              (let [new-maze (async/<! intermediate-chan)]
                (if new-maze
                  (do
-                   (om/transact! reconciler `[(snergly.core/set-maze {:maze-key :grid :value ~(atom new-maze)})])
+                   (set-maze-param! :grid (atom new-maze))
                    (async/<! (async/timeout 1))
                    (recur))
                  (let [maze (async/<! result-chan)]
-                   (om/transact! reconciler `[(snergly.core/set-maze {:maze-key :grid :value ~(atom maze)})])))))))
+                   (set-maze-param! :grid (atom maze))))))))

 (defn run-animation [maze-params]
   (go
     (let [maze (async/<! (produce-maze-async maze-params))
           ; maze (async/<! (produce-analysis-async maze maze-params))
-          ])))
+          ]
+      (set-maze-param! :active nil))))

 ;; -----------------------------------------------------------------------------
 ;; Parsing
@@ -95,6 +102,10 @@
   form-value)

 (defmethod produce-maze-value :analysis
+  [_ form-value _]
+  form-value)
+
+(defmethod produce-maze-value :active
   [_ form-value _]
   form-value)

@@ -123,7 +134,7 @@
 (defui MazeDisplay
   static om/IQuery
   (query [this]
-    '[{:maze [:grid :rows :columns :cell-size :algorithm]}])
+    '[{:maze [:grid :rows :columns :cell-size :algorithm :active]}])
   Object
   (componentDidMount [this]
     (let [{:keys [grid cell-size] :as maze} (om/props this)
@@ -140,10 +151,12 @@
       )
     )
   (render [this]
-    (let [{:keys [grid rows columns algorithm cell-size] :as maze} (om/props this)]
+    (let [{:keys [grid rows columns algorithm cell-size active] :as maze} (om/props this)]
       (let [height (inc (* cell-size rows))
             width (inc (* cell-size columns))]
+        (println (str "Active: " active))
         (dom/div nil
+                 (dom/div nil (or active "\u00a0")) ;
                  (dom/canvas #js {:id "c1"
                                   :height height
                                   :width width
@@ -155,15 +168,20 @@
 (defui MazeControlPanel
   static om/IQuery
   (query [this]
-    '[:app/algorithms :app/analyses {:maze [:algorithms :rows :columns :grid :analysis :start-row :start-col :end-row :end-col]}])
+    '[:app/algorithms :app/analyses
+      {:maze [:algorithm :rows :columns :grid
+              :analysis :start-row :start-col :end-row :end-col
+              :active]}])
   Object
   (render [this]
     (let [{:keys [app/algorithms app/analyses maze]} (om/props this)
           {:keys [algorithm rows columns grid
-                  analysis start-row start-col end-row end-col]} maze
+                  analysis start-row start-col end-row end-col
+                  active]} maze
           modify (fn [maze-key e]
                    (om/transact! this `[(snergly.core/set-maze {:maze-key ~maze-key :value ~(aget e "target" "value")})]))
           go-async (fn [maze e] (run-animation maze))]
+      ;; TODO: remember how to disable form elements by group, rather than one-at-a-time.
       (dom/div
         nil
         (dom/div
@@ -171,6 +189,7 @@
           (dom/label nil
                      "Algorithm: "
                      (dom/select #js {:value algorithm
+                                      :disabled active
                                       :onChange (partial modify :algorithm)}
                                  (concat [(dom/option #js {:key ""} "")]
                                          (map
@@ -182,6 +201,7 @@
           (dom/label nil
                      "Rows: "
                      (dom/input #js {:type "number"
+                                     :disabled active
                                      :value rows
                                      :min 2
                                      :max 99
@@ -190,6 +210,7 @@
           (dom/label nil
                      "Columns: "
                      (dom/input #js {:type "number"
+                                     :disabled active
                                      :value columns
                                      :min 2
                                      :max 99
@@ -200,6 +221,7 @@
           (dom/label nil
                      "Analysis: "
                      (dom/select #js {:value analysis
+                                      :disabled active
                                       :onChange (partial modify :analysis)}
                                  (map (fn [name] (dom/option #js {:key name} name)) analyses))))
         (when (contains? #{"distances" "path"} analysis)
@@ -208,6 +230,7 @@
             (dom/label nil
                        "Start Row: "
                        (dom/input #js {:type "number"
+                                       :disabled active
                                        :value start-row
                                        :min 0
                                        :max (dec rows)
@@ -216,6 +239,7 @@
             (dom/label nil
                        "Start Column: "
                        (dom/input #js {:type "number"
+                                       :disabled active
                                        :value start-col
                                        :min 0
                                        :max (dec columns)
@@ -227,6 +251,7 @@
             (dom/label nil
                       "End Row: "
                        (dom/input #js {:type "number"
+                                       :disabled active
                                        :value end-row
                                        :min 0
                                        :max (dec rows)
@@ -235,6 +260,7 @@
             (dom/label nil
                       "End Column: "
                        (dom/input #js {:type "number"
+                                       :disabled active
                                        :value end-col
                                        :min 0
                                        :max (dec columns)
@@ -242,7 +268,7 @@
                                        :onInput (partial modify :end-col)}))))
         (dom/div
           nil
-          (dom/button #js {:disabled (not (ready-to-go maze))
+          (dom/button #js {:disabled (or active (not (ready-to-go maze)))
                            :onClick (partial go-async maze)}
                       "Go!"))
         (when grid (dom/div nil (maze-display maze)))


Use reduce instead run! for compatibility with older clojure versions.

--- src/suricatta/dsl.clj
+++ src/suricatta/dsl.clj
@@ -640,11 +640,11 @@
    {:pre [(map? kv)]}
    (defer
      (let [t (-unwrap t)]
-       (run! (fn [[k v]]
-               (let [k (-unwrap k)
-                     v (-unwrap v)]
-                 (.set t (-field k) v))) kv)
-       t)))
+       (reduce-kv (fn [acc k v]
+                 (let [k (-unwrap k)
+                       v (-unwrap v)]
+                   (.set acc (-field k) v)))
+                  t kv))))
   ([t k v]
    (defer
      (let [v (-unwrap v)


Clear game info on component unmount.

Clear game info on component unmount.

--- src/cljs/wombats_web_client/panels/game-play.cljs
+++ src/cljs/wombats_web_client/panels/game-play.cljs
@@ -35,6 +35,7 @@
   (re-frame/dispatch [:game/update-frame nil])
   (re-frame/dispatch [:game/clear-chat-messages])
   (re-frame/dispatch [:game/stats-update {}])
+  (re-frame/dispatch [:game/info nil])
   (ws/send-message :leave-game {:game-id @game-id})
   (reset! game-id nil)
   (re-frame/dispatch [:set-modal nil]))


Luminus updates (#4332)

Luminus updates (#4332)

* Updating to latest version of Elixir, Cowboy, Ranch, Poision

* Adding proper release

* 127.0.0.1->0.0.0.0

* Updating dependencies to more recent versions

--- frameworks/Clojure/luminus/project.clj
+++ frameworks/Clojure/luminus/project.clj
@@ -3,18 +3,18 @@
   :description "TechEmpower Luminus benchmark"
   :url "https://github.com/TechEmpower/FrameworkBenchmarks"

-  :dependencies [[org.clojure/clojure "1.9.0-alpha15"]
+  :dependencies [[org.clojure/clojure "1.10.0"]
                  [cheshire "5.7.0"]
                  [selmer "1.10.7"]
                  [markdown-clj "0.9.98"]
                  [metosin/muuntaja "0.2.1"]
                  [metosin/ring-http-response "0.8.2"]
                  [bouncer "1.0.1"]
-                 [org.webjars/bootstrap "4.0.0-alpha.2"]
-                 [org.webjars/font-awesome "4.7.0"]
-                 [org.webjars.bower/tether "1.4.0"]
-                 [org.webjars/jquery "3.2.0"]
-                 [org.clojure/tools.logging "0.3.1"]
+                 [org.webjars/bootstrap "4.2.1"]
+                 [org.webjars/font-awesome "5.6.1"]
+                 [org.webjars.bower/tether "1.4.4"]
+                 [org.webjars/jquery "3.3.1"]
+                 [org.clojure/tools.logging "0.4.1"]
                  [com.taoensso/tower "3.0.2"]
                  [compojure "1.5.2"]
                  [ring-webjars "0.1.1"]


PDB-463 Add back missing query-resources

I had removed limited-query-resources but not replaced it with something
that actually peforms the SQL query. This patch replaces limited-query-resources
with query-resources which really just wraps the limited-* version with
a zero limit.

Signed-off-by: Ken Barber <470bc578162732ac7f9d387d34c4af4ca6e1b6f7@bob.sh>

--- src/com/puppetlabs/puppetdb/http/v1/resources.clj
+++ src/com/puppetlabs/puppetdb/http/v1/resources.clj
@@ -97,6 +97,7 @@
   (try
     (with-transacted-connection db
       (-> (r/query->sql version (json/parse-string query true))
+          (r/query-resources)
           (:result)
           (munge-result-rows)
           (pl-http/json-response)))


Cleaning up

Cleaning up

--- src/cljs/go.clj
+++ src/cljs/go.clj
@@ -22,22 +22,10 @@
        go->str
        println)

-  (println
-   (cljs.closure/build '[(ns hello.core)
-                         (defn ^{:export greet} greet [n] (str "Hola " n))
-                         (defn ^:export sum [xs] 42)]
-                       {:optimizations :none :output-to "hello.js"}))
+  (cljs.closure/build '[(ns hello.core)
+                        (defn ^{:export greet} greet [n] (str "Hola " n))
+                        (defn ^:export sum [xs] 42)]
+                      {:optimizations :none}))

-  (cljs.closure/build "samples/hello/src"
-                      {:optimizations :none})
-
-  (->> (str "checkouts/clojurescript/" "samples/hello/src/hello/core.cljs")
-       cljs->go
-       go->str
-       println)
-
-  (->> (str "checkouts/clojurescript/" "samples/hello/src")
-       cljs->go
-       go->str
-       println)
-)
+(cljs.closure/build "samples/hello/src"
+                    {:optimizations :none})


Add test to verify charset is nil for multipart requests

--- test/clj_http/test/multipart_test.clj
+++ test/clj_http/test/multipart_test.clj
@@ -2,9 +2,10 @@
   (:require [clj-http.multipart :refer :all]
             [clojure.test :refer :all])
   (:import (java.io File ByteArrayOutputStream ByteArrayInputStream)
+           (java.nio.charset Charset)
            (org.apache.http.entity.mime.content FileBody StringBody ContentBody
                                                 ByteArrayBody InputStreamBody)
-           (java.nio.charset Charset)))
+           (org.apache.http.util EntityUtils)))

 (defn body-str [^StringBody body]
   (-> body .getReader slurp))
@@ -173,3 +174,8 @@
         (is (= (Charset/forName "ascii") (body-charset body)))
         (is (= test-file (.getFile body) ))
         (is (= "testname" (.getFilename body)))))))
+
+(deftest test-multipart-content-charset
+  (testing "charset is nil for all multipart requests"
+    (let [mp-entity (create-multipart-entity [] nil)]
+      (is (nil? (EntityUtils/getContentCharSet mp-entity))))))


Tests for functions: job-name->product-name, job-name->version, job-name->book-name, and job-name->environment

--- test/emender_jenkins/results_test.clj
+++ test/emender_jenkins/results_test.clj
@@ -42,3 +42,27 @@
         (is (callable? 'emender-jenkins.results/store-results))))

+(deftest test-job-name->product-name-existence
+    "Check that the emender-jenkins.results/job-name->product-name definition exists."
+    (testing "if the emender-jenkins.results/job-name->product-name definition exists."
+        (is (callable? 'emender-jenkins.results/job-name->product-name))))
+
+
+(deftest test-job-name->version-existence
+    "Check that the emender-jenkins.results/job-name->version definition exists."
+    (testing "if the emender-jenkins.results/job-name->version definition exists."
+        (is (callable? 'emender-jenkins.results/job-name->version))))
+
+
+(deftest test-job-name->book-name-existence
+    "Check that the emender-jenkins.results/job-name->book-name definition exists."
+    (testing "if the emender-jenkins.results/job-name->book-name definition exists."
+        (is (callable? 'emender-jenkins.results/job-name->book-name))))
+
+
+(deftest test-job-name->environment-existence
+    "Check that the emender-jenkins.results/job-name->environment definition exists."
+    (testing "if the emender-jenkins.results/job-name->environment definition exists."
+        (is (callable? 'emender-jenkins.results/job-name->environment))))
+
+


Fix comment typo

Fix comment typo

--- src-cljs/frontend/components/app.cljs
+++ src-cljs/frontend/components/app.cljs
@@ -130,7 +130,7 @@
                                                   (and (= (.-tagName target) "INPUT")
                                                        (= (.-type target) "submit")))
                                             ;; If the clicked element was a button or an
-                                            ;; input.submit, that's the button.
+                                            ;; input[type=submit], that's the button.
                                             target
                                             ;; Otherwise, it's the button (if any) that
                                             ;; contains the clicked element.


improve hud tray rendering

improve hud tray rendering

--- src-cljs/frontend/components/hud.cljs
+++ src-cljs/frontend/components/hud.cljs
@@ -55,14 +55,15 @@
           [:div.hud-tray.hud-item {:class (when chat-opened? ["chat-opened"])}
            [:div.tray-positive
             (when new-here?
-              [:div.new-here
-               [:a.new-here-button {:data-text "New here?" :role "button"}]
-               [:div.new-here-items
-                [:a.new-here-item {:href "/home" :target "_self" :role "button" :title "Home"} "Precursor"]
-                [:a.new-here-item {:href ""      :target "_self" :role "button" :title "Pricing"} "Pricing"]
-                [:a.new-here-item {:href "/blog" :target "_self" :role "button" :title "Blog"} "Blog"]
-                [:a.new-here-item {:href "/blog" :target "_self" :role "button" :title "Blog"} "Sign in"]
-                [:div.new-here-ghost]]])
+              (html
+               [:div.new-here
+                [:a.new-here-button {:data-text "New here?" :role "button"}]
+                [:div.new-here-items
+                 [:a.new-here-item {:href "/home" :target "_self" :role "button" :title "Home"} "Precursor"]
+                 [:a.new-here-item {:href ""      :target "_self" :role "button" :title "Pricing"} "Pricing"]
+                 [:a.new-here-item {:href "/blog" :target "_self" :role "button" :title "Blog"} "Blog"]
+                 [:a.new-here-item {:href "/blog" :target "_self" :role "button" :title "Blog"} "Sign in"]
+                 [:div.new-here-ghost]]]))
             [:div.mouse-stats
              {:data-text (if (seq mouse)
                            (pr-str (select-keys mouse [:x :y :rx :ry]))


Fix print-title

Fix print-title

--- benchmarks/caesium/bench_utils.clj
+++ benchmarks/caesium/bench_utils.clj
@@ -1,9 +1,9 @@
 (ns caesium.bench-utils)

 (defn print-title
-  [title]
+  [& title-parts]
   (println)
-  (println title))
+  (apply println title-parts))

 (defn fmt-bytes
   [n]


CMR-3232: Fixed handling of granule deletion event for virtual products.

--- virtual-product-app/src/cmr/virtual_product/services/virtual_product_service.clj
+++ virtual-product-app/src/cmr/virtual_product/services/virtual_product_service.clj
@@ -15,6 +15,10 @@
             [cmr.common.util :as u :refer [defn-timed]]
             [cmr.virtual-product.config :as config]
             [cmr.virtual-product.data.source-to-virtual-mapping :as svm]))
+
+(def ^:private num-retries-delete-not-found
+  "Number of retries for not found error during deletion of source granule"
+  2)

 (defmulti handle-ingest-event
   "Handles an ingest event. Checks if it is an event that should be applied to virtual granules. If
@@ -150,11 +154,17 @@
            :entry-title entry-title)))

 (defn- handle-delete-response
-  "Handle response received from ingest service to a delete request. Status codes which do not
-  fall between 200 and 299 or not equal to 409 will cause an exception which in turn causes the
-  corresponding queue event to be put back in the queue to be retried."
+  "Handle response received from ingest service to a delete request. Returns true if the source
+  granule deletion event need to be retried. Status codes which do not fall between 200 and 299
+  or not equal to 404 or 409 will cause an exception which in turn causes the corresponding queue
+  event to be put back in the queue to be retried indefinitely. Status code 404 will be retried
+  twice. Other status codes are treated as success."
   [response granule-ur retry-count]
-  (let [{:keys [status body]} response]
+  (let [{:keys [status body]} response
+        retry-count (or retry-count 0)
+        needs-retry (when (and (= status 404)
+                               (< retry-count num-retries-delete-not-found))
+                      true)]
     (cond
       (<= 200 status 299)
       (info (format "Deleted virtual granule [%s] with the following response: [%s]"
@@ -179,14 +189,14 @@
       ;;    maximum number of retries for an event. After the retries, the delete event will be
       ;;    considered as a success.
       (= status 404)
-      (if (>= retry-count (count (queue-config/rabbit-mq-ttls)))
+      (if (< retry-count num-retries-delete-not-found)
+        (info (format (str "Received a response with status code [404] and the following "
+                           "response body when deleting the virtual granule [%s] : [%s]. "
+                           "The delete request will be retried.")
+                      granule-ur (pr-str body)))
         (info (format (str "The number of retries has exceeded the maximum retry count."
-                           "The delete event for the virtual granule [%s] will be ignored") granule-ur))
-        (errors/internal-error!
-          (format (str "Received a response with status code [404] and the following response body "
-                       "when deleting the virtual granule [%s] : [%s]. The delete request will be "
-                       "retried.")
-                  granule-ur (pr-str body))))
+                           "The delete event for the virtual granule [%s] will be ignored")
+                      granule-ur)))

       ;; Conflict (status code 409)
       ;; This would occurs if a delete event with lower revision-id is consumed after an event with
@@ -200,23 +210,33 @@
       (errors/internal-error!
         (format (str "Received unexpected status code [%s] and the following response when "
                      "deleting the virtual granule [%s] : [%s]")
-                status granule-ur (pr-str response))))))
+                status granule-ur (pr-str response))))
+    needs-retry))

 (defn-timed apply-source-granule-delete-event
   "Applies a source granule delete event to the virtual granules"
   [context {:keys [provider-id revision-id granule-ur entry-title retry-count]}]
   (let [vp-config (svm/source-to-virtual-product-mapping
-                    [(svm/provider-alias->provider-id provider-id) entry-title])]
-    (doseq [virtual-coll (:virtual-collections vp-config)]
-      (let [new-granule-ur (svm/generate-granule-ur provider-id
-                                                    (:short-name vp-config)
-                                                    (:short-name virtual-coll)
-                                                    granule-ur)
-            resp (ingest/delete-concept context {:provider-id provider-id
-                                                 :concept-type :granule
-                                                 :native-id new-granule-ur}
-                                        (build-ingest-headers revision-id) true)]
-        (handle-delete-response resp new-granule-ur retry-count)))))
+                    [(svm/provider-alias->provider-id provider-id) entry-title])
+        virtual-colls (:virtual-collections vp-config)
+        delete-virtual-granule (fn [virtual-coll]
+                                 (let [new-granule-ur (svm/generate-granule-ur
+                                                        provider-id
+                                                        (:short-name vp-config)
+                                                        (:short-name virtual-coll)
+                                                        granule-ur)
+                                       resp (ingest/delete-concept
+                                              context
+                                              {:provider-id provider-id
+                                               :concept-type :granule
+                                               :native-id new-granule-ur}
+                                              (build-ingest-headers revision-id) true)]
+                                   (handle-delete-response resp new-granule-ur retry-count)))
+        need-retries (doall (map delete-virtual-granule virtual-colls))]
+    (when (some true? need-retries)
+      (errors/internal-error!
+        (format "Need to retry deletion of source granule [%s] due to virtual granule deletion warnings"
+                granule-ur)))))

 (defmethod handle-ingest-event :concept-delete
   [context event]


lein-release plugin: bumped version from 0.4.3 to 0.4.4-SNAPSHOT for next development cycle

--- re_view/project.clj
+++ re_view/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view "0.4.3"
+(defproject re-view "0.4.4-SNAPSHOT"
   :description "ClojureScript React Library"
   :url "https://www.github.com/braintripping/re-view/tree/master/re_view"
   :license {:name "Eclipse Public License"


route53 for our cluster etc

route53 for our cluster etc

--- src/terraboot/vpc.clj
+++ src/terraboot/vpc.clj
@@ -99,6 +99,15 @@

              (vpc-resource "aws_eip" "vpn" {:instance (vpc-id-of "aws_instance" "vpn")
                                             :vpc true})
+
+             (resource "aws_route53_zone" "kixi" {:name "kixi.io"})
+
+             (vpc-resource "aws_route53_record" "vpn"
+                           {:zone_id (id-of "aws_route53_zone" "kixi")
+                            :name "vpn.kixi.io"
+                            :type "A"
+                            :ttl 300
+                            :records [(vpc-output-of "aws_instance" "vpn" "public_ip")]})

              (security-group "allow_outbound" {}
                              {:type "egress"


Explicit about returning vector on split

--- src/tick/interval.clj
+++ src/tick/interval.clj
@@ -248,7 +248,7 @@
   ;; TODO: Rename? Not always narrow, sometimes widen, or generally modify - perhaps 'derive'
   (narrow [_ beginning end] "Narrow the interval to the new given bounds")
   (splice [ival1 ival2] "Splice two intervals together")
-  (split [ival t] "Split ival into 2 intervals, at t"))
+  (split [ival t] "Split ival into 2 intervals at t, returned as a vector"))

 (defn split-with-assert [ival t]
   (assert


Add a doc string to the namespace

Add a doc string to the namespace

--- src/mdr2/dtbook.clj
+++ src/mdr2/dtbook.clj
@@ -1,55 +1,56 @@
 (ns mdr2.dtbook
+  "Functionality around [DTBook XML](http://www.daisy.org/z3986/2005/Z3986-2005.html)"
   (:require [clojure.data.xml :as xml]))

-(defn- dtbook-sexp [production]
-  (let [{:keys [title creator subject description publisher date identifier source language rights
-                sourceDate sourceEdition sourcePublisher sourceRights sourceTitle
-                multimediaType multimediaContent narrator producedDate
-                revision revisionDate revisionDescription
-                totalTime audioFormat]} production]
-    [:dtbook {:xmlns "http://www.daisy.org/z3986/2005/dtbook/"
-              :version "2005-3" :xml:lang language}
-     [:head
-      [:head {:name "dc:Title" :content title}]
-      [:head {:name "dc:Creator" :content creator}]
-      [:head {:name "dc:Subject" :content subject}]
-      [:head {:name "dc:Description" :content description}]
-      [:head {:name "dc:Publisher" :content publisher}]
-      [:head {:name "dc:Date" :content date}]
-      [:head {:name "dc:Type" :content "Text"}]
-      [:head {:name "dc:Format" :content "ANSI/NISO Z39.86-2005"}]
-      [:head {:name "dc:Identifier" :content identifier}]
-      [:head {:name "dc:Source" :content source}]
-      [:head {:name "dc:Language" :content language}]
-      [:head {:name "dc:Rights" :content rights}]
-      [:head {:name "dtb:uid" :content identifier}]
-      [:head {:name "dtb:sourceDate" :content sourceDate}]
-      [:head {:name "dtb:sourceEdition" :content sourceEdition}]
-      [:head {:name "dtb:sourcePublisher" :content sourcePublisher}]
-      [:head {:name "dtb:sourceRights" :content sourceRights}]
-      [:head {:name "dtb:sourceTitle" :content sourceTitle}]
-      [:head {:name "dtb:multimediaType" :content multimediaType}]
-      [:head {:name "dtb:multimediaContent" :content multimediaContent}]
-      [:head {:name "dtb:narrator" :content narrator}]
-      [:head {:name "dtb:producer" :content publisher}]
-      [:head {:name "dtb:producedDate" :content producedDate}]
-      [:head {:name "dtb:revision" :content revision}]
-      [:head {:name "dtb:revisionDate" :content revisionDate}]
-      [:head {:name "dtb:revisionDescription" :content revisionDescription}]
-      [:head {:name "dtb:totalTime" :content totalTime}]
-      [:head {:name "dtb:audioFormat" :content audioFormat}]]
-     [:book
-      [:frontmatter
-       [:doctitle title]
-       [:docauthor creator]
-       [:level1 [:p]]]
-      [:bodymatter
-       [:level1
-        [:h1]
-        [:p]]]]]))
+(defn- dtbook-sexp
+  [{:keys [title creator subject description publisher date identifier source language rights
+           sourceDate sourceEdition sourcePublisher sourceRights sourceTitle
+           multimediaType multimediaContent narrator producedDate
+           revision revisionDate revisionDescription
+           totalTime audioFormat]}]
+  [:dtbook {:xmlns "http://www.daisy.org/z3986/2005/dtbook/"
+            :version "2005-3" :xml:lang language}
+   [:head
+    [:head {:name "dc:Title" :content title}]
+    [:head {:name "dc:Creator" :content creator}]
+    [:head {:name "dc:Subject" :content subject}]
+    [:head {:name "dc:Description" :content description}]
+    [:head {:name "dc:Publisher" :content publisher}]
+    [:head {:name "dc:Date" :content date}]
+    [:head {:name "dc:Type" :content "Text"}]
+    [:head {:name "dc:Format" :content "ANSI/NISO Z39.86-2005"}]
+    [:head {:name "dc:Identifier" :content identifier}]
+    [:head {:name "dc:Source" :content source}]
+    [:head {:name "dc:Language" :content language}]
+    [:head {:name "dc:Rights" :content rights}]
+    [:head {:name "dtb:uid" :content identifier}]
+    [:head {:name "dtb:sourceDate" :content sourceDate}]
+    [:head {:name "dtb:sourceEdition" :content sourceEdition}]
+    [:head {:name "dtb:sourcePublisher" :content sourcePublisher}]
+    [:head {:name "dtb:sourceRights" :content sourceRights}]
+    [:head {:name "dtb:sourceTitle" :content sourceTitle}]
+    [:head {:name "dtb:multimediaType" :content multimediaType}]
+    [:head {:name "dtb:multimediaContent" :content multimediaContent}]
+    [:head {:name "dtb:narrator" :content narrator}]
+    [:head {:name "dtb:producer" :content publisher}]
+    [:head {:name "dtb:producedDate" :content producedDate}]
+    [:head {:name "dtb:revision" :content revision}]
+    [:head {:name "dtb:revisionDate" :content revisionDate}]
+    [:head {:name "dtb:revisionDescription" :content revisionDescription}]
+    [:head {:name "dtb:totalTime" :content totalTime}]
+    [:head {:name "dtb:audioFormat" :content audioFormat}]]
+   [:book
+    [:frontmatter
+     [:doctitle title]
+     [:docauthor creator]
+     [:level1 [:p]]]
+    [:bodymatter
+     [:level1
+      [:h1]
+      [:p]]]]])

 (defn dtbook
-  "Create a minimal DTBook template according to http://www.daisy.org/z3986/2005/Z3986-2005.html"
+  "Create a minimal DTBook XML template according to [the spec](http://www.daisy.org/z3986/2005/Z3986-2005.html) for a given `production`"
   [production]
   (-> production
       dtbook-sexp


Removed copy-pasting.

Removed copy-pasting.

--- src/vertigo/views.clj
+++ src/vertigo/views.clj
@@ -17,6 +17,10 @@
   [:div
     [:span (link-to (str "/movies/" (:event-id show)) (:title show))] (:time show)])

+(defn- render-genres [coll genres]
+  (for [genre genres]
+    [:td (map render-show (genre coll))]))
+
 (defn- shows-table [shows]
   [:table
     [:tr
@@ -25,7 +29,7 @@
       [:th "Action/Adventure/Sci-fi/Fantasy"]
       [:th "Drama/Romance"]
       [:th "Others"]]
-    (for [date (take 4 (iterate #(.plusDays % 1) (now)))]
+    (for [date (take 7 (iterate #(.plusDays % 1) (now)))]
       (let [genres (group-by
                      (fn [{genres :genres}]
                        (cond (and (some #{"Komedia"} genres)
@@ -39,10 +43,8 @@
                              shows))]
         [:tr
           [:td (common/format-date date)]
-          [:td (map render-show (:comedy genres))]
-          [:td (map render-show (:action genres))]
-          [:td (map render-show (:drama genres))]
-          [:td (map render-show (:other genres))]]))])
+          (render-genres genres [:comedy :action :drama :other])]))])
+

 (defn shows [shows]
   (layout (shows-table shows)))


opening up "cleanup-if-dirty"

opening up "cleanup-if-dirty"

to solve random cljs compile/resolution problems

--- src/mount/core.cljc
+++ src/mount/core.cljc
@@ -45,7 +45,7 @@
     (nth f 2)                      ;; magic 2 is to get the body => ["fn*" "[]" "(fn body)"]
     f))

-(defn- cleanup-if-dirty
+(defn cleanup-if-dirty
   "in case a namespace is recompiled without calling (mount/stop),
    a running state instance will still be running.
    this function stops this 'lost' state instance.


new-> restart listener

new-> restart listener

--- src/mount/core.cljc
+++ src/mount/core.cljc
@@ -319,6 +319,11 @@
       (apply stop states)
       (apply start states))))

+(defn restart-listner
+  ([]
+   (restart-listner {}))
+  ([watchers]
+   (RestartListener. (atom watchers))))

 ;; explicit, not composable (subject to depreciate?)


Request all URLs

Request all URLs

--- src/odva/server.clj
+++ src/odva/server.clj
@@ -39,15 +39,20 @@
   [ctx]
   (let [start (System/currentTimeMillis) m (qc/from-job-data ctx)]
     (println (str "Map: " (.toString m)))
-    (let [urls (get m "urls")]
-      (println urls)
-      (map (fn [x] (println (str "Url: " x))) urls)
-      (httpclient/get "http://minfin.ru/ru/opendata/")
-      (let [finish (System/currentTimeMillis)]
-        (println (format "Elapsed time in millis: %1$d" (- finish start)))
-        (prometheus/track-observation @metrics/store (get m "store-name") "client_http_request" (- finish start) ["minfin_ru_ru_opendata"])
-        )
-      )))
+    (doall (map (fn [x] (println (str "Url: " x))
+                  (let [start-1 (System/currentTimeMillis)]
+                    (httpclient/get x)
+                    (let [finish-1 (System/currentTimeMillis)]
+                      (println (format "Elapsed time in millis: %1$d" (- finish-1 start-1)))
+                      )
+                    )
+                  ) (get m "urls")))
+    (httpclient/get "http://minfin.ru/ru/opendata/")
+    (let [finish (System/currentTimeMillis)]
+      (println (format "Elapsed time in millis: %1$d" (- finish start)))
+      (prometheus/track-observation @metrics/store (get m "store-name") "client_http_request" (- finish start) ["minfin_ru_ru_opendata"])
+      )
+    ))

 (def cli-options
   [


[ref][style]

[ref][style]

--- src/ombs/db/old.clj
+++ src/ombs/db/old.clj
@@ -77,10 +77,7 @@

 (defn admin? [username] (->
                           (sql/select users (sql/where {:name username :role admin-role-value}))
-                          first
-                          nil?
-                          not
-                          ))
+                          first nil?  not))

 ;============================================== EVENT =================================================
 ; (defrecord Event [name date price author status] )


pep-395 wip

pep-395 wip

--- src/pep_395/wip.clj
+++ src/pep_395/wip.clj
@@ -7,12 +7,17 @@
 (defn sin [n] (Math/sin n))
 (defn acos [n] (Math/acos n))

+; http://www.wolframalpha.com/input/?i=internal+angles+3+4+5+triangle
+; http://www.wolframalpha.com/input/?i=cos%5E-1%284%2F5%29
+
 (acos (/ 4 5)) ; radians 0.6435011087932843
 (acos (/ 3 5)) ; radians 0.9272952180016123

 (* (acos (/ 4 5)) (/ 180 pi)) ; degrees 36.86989764584401
 (* (acos (/ 3 5)) (/ 180 pi)) ; degrees 53.13010235415599

+
+;;; Heavily Inspired by https://github.com/johnlawrenceaspden/hobby-code/blob/master/fractaltree-stuart-halloway.clj

 (import javax.swing.JFrame)
 (import javax.swing.JPanel)
@@ -65,7 +70,7 @@
   (proxy [JPanel] []
     (paintComponent [g]
       (proxy-super paintComponent g)
-      ;(System/gc)
+      (System/gc)
       (time (render g (. this getWidth) (. this getHeight))))))

 (doto
@@ -74,6 +79,57 @@
   (.setSize 640 400)
   (.setVisible true))

-;;;
+; http://mathworld.wolfram.com/RotationMatrix.html
+; | cos(@) -sin(@) |
+; | sin(@)  cos(@) |

-; TODO Graphics2D g2 = (Graphics2D) g; g2.setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)+
+;;; http://www.html5rocks.com/en/tutorials/webgl/webgl_transforms/#toc-matrices
+; |  c -s |
+; |  s  c |
+
+;  i = 0
+; | 1 0 |
+; | 0 1 |
+
+; (double (/ 4 5)) ; 0.8
+; (double (/ 3 5)) ; 0.6
+
+;   left rotation
+; |  0.8 -0.6 |
+; |  0.6  0.8 |
+
+;   left scale
+; |  0.8  0   |
+; |  0    0.8 |
+
+;   left translate --> try
+
+;   right rotation
+; |  0.6  0.8 |
+; | -0.8  0.6 |
+
+;   right scale
+; |  0.6  0   |
+; |  0    0.6 |
+
+;   right translate --> try
+
+(reduce matrix-mul [state, left_translate, left_rotate, left_scale])
+(reduce matrix-mul [state, right_translate, right_rotate, right_scale])
+
+; Mathematica
+; http://reference.wolfram.com/legacy/v5/Built-inFunctions/AdvancedDocumentation/LinearAlgebra/2.7.html
+
+;left_rotation = MatrixForm[{{0.8,-0.6,0},{0.6,0.8,0},{0,0,1}}]
+;left_scale = MatrixForm[{{0.8,0,0},{0,0.8,0},{0,0,1}}]
+; {{0.8,-0.6,0},{0.6,0.8,0},{0,0,1}}.{{0.8,0,0},{0,0.8,0},{0,0,1}}
+; IdentityMatrix[3].{{0.8, -0.6, 0}, {0.6, 0.8, 0}, {0, 0, 1}}.{{0.8, 0, 0}, {0, 0.8,0}, {0, 0, 1}}
+
+;ListPlot[{{0., 1.}, {0.64, 1.48}, {-0.48, 1.64}, {0.16,2.12}}, AspectRatio -> 1, DataRange -> {0, 3},AxesOrigin -> {0, 0}]
+
+
+
+; TODO Graphics2D g2 = (Graphics2D) g; g2.setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)
+
+; TODO WebGL center+radius http://dl.dropboxusercontent.com/u/17612367/OpenGL%20to%20WebGL/exercise%202.3.5%20-%20flurry%20diamond/index.html


have removed state

have removed state

--- src/webapi/core.clj
+++ src/webapi/core.clj
@@ -45,6 +45,11 @@
                                     (assoc body
                                            :finished (str (.progress task) "%"))))

+                     (= (.state task) "removed")
+                     (assoc result
+                            :body (generate-string
+                                    body))
+
                      :else
                      {:status 500
                       :body (str "unknow state of task '" (.state task) "'")}


Fix error in worker

Fix error in worker

--- src/worker/core.clj
+++ src/worker/core.clj
@@ -80,6 +80,6 @@
     (let [ch (lch/open conn)]
       (lq/declare ch jobs-q {:durable true :auto-delete false})
       (le/fanout ch events-x {:durable false :auto-delete false})
-      (lb/qos ch (int (env "WORKER_MAX_JOBS" 1)))
+      (lb/qos ch (Integer/parseInt (env "WORKER_MAX_JOBS" 1)))
       (println "Worker" worker-id "Waiting for jobs")
       (lc/blocking-subscribe ch jobs-q on-message))))


Start to nameify countries

Start to nameify countries

--- raw_data/convert_players.clj
+++ raw_data/convert_players.clj
@@ -1,4 +1,4 @@
-(use '[clojure.string :only (split-lines split)])
+(use '[clojure.string :only (split-lines split capitalize)])

 (defn read-tabular-file [filename]
   (let [data (slurp filename)
@@ -6,13 +6,16 @@
         split-by-tab #(split % #"\t")]
     (map split-by-tab lines)))

+(defn nameify [s]
+  (capitalize s))
+
 (defn convert-player [country data]
-  (let []
+  (let [shirt (data 0)]
     {
-      :id (str country "_" (data 0))
-      :country country
+      :id (str country "_" shirt)
+      :country (nameify country)
       :name (data 1)
-      :shirt_number (data 0)
+      :shirt_number shirt
       :date_of_birth (data 2)
       :position (data 3)
       :club (data 4)


add TODO comment

add TODO comment

--- src/braid/client/ui/views/header.cljs
+++ src/braid/client/ui/views/header.cljs
@@ -28,6 +28,8 @@
   [conf]
   (let [open-group-id (subscribe [:open-group-id])
         current-path (subscribe [:page-path])]
+    ; TODO: reaction for path = current-path? Would close over conf, probably
+    ; not worthwhile
     (fn [{:keys [route-fn route-args title class body]}]
       (let [path (route-fn (merge route-args {:group-id @open-group-id}))]
         [:a {:class (str class (when (= path @current-path) " active"))


Change mtg card master to pull card info directly from mtgjson.com

--- src/clj/decktouch/mtg_card_master.clj
+++ src/clj/decktouch/mtg_card_master.clj
@@ -17,14 +17,14 @@
 (def card-multiverseids
   (filter #(not (nil? (get % "multiverseId")))
     (flatten
-      (let [all-sets (json/read-str (slurp "resources/AllSets.json"))]
+      (let [all-sets (json/read-str (slurp "http://mtgjson.com/json/AllSets.json"))]
         (for [set-code (keys all-sets)]
           (for [set-card (get (get all-sets set-code) "cards")]
             {"name"         (set-card "name")
              "multiverseId" (set-card "multiverseid")}))))))

 (def mtg-cards
-  (let [allcards (json/read-str (slurp "resources/AllCards.json"))]
+  (let [allcards (json/read-str (slurp "http://mtgjson.com/json/AllCards.json"))]
     (reduce add-multiverseid-to-card-in-map allcards card-multiverseids)))

 (def card-names (keys mtg-cards))