correct styling when playing back an editor recording

--- src/parinfer/editor.cljs
+++ src/parinfer/editor.cljs
@@ -5,6 +5,8 @@
     [cljs.core.async :refer [<! timeout chan]]
     [clojure.string :as string :refer [join]]
     [parinfer.formatter :refer [format-text]]
+    [goog.dom.classlist :as classlist]
+    [goog.dom :as gdom]
     [cljsjs.codemirror]
     [cljsjs.codemirror.mode.clojure-parinfer]))

@@ -251,16 +253,33 @@
   [key-]
   (swap! vcr assoc-in [key- :recording?] false))

+(defn freeze-editor!
+  [cm]
+  (let [element (.getWrapperElement cm)
+        cursor (gdom/getElementByClass "CodeMirror-cursors" element)]
+    (.setOption cm "readOnly" "nocursor")
+    (classlist/add element "CodeMirror-focused")
+    (set! (.. cursor -style -visibility) "visible")))
+
+(defn thaw-editor!
+  [cm]
+  (let [element (.getWrapperElement cm)
+        cursor (gdom/getElementByClass "CodeMirror-cursors" element)]
+    (.setOption cm "readOnly" false)))
+
 (defn play-recording!
   [key-]
   (let [cm (get-in @state [key- :cm])
-        recording (get @vcr key-)]
+        recording (get @vcr key-)
+        element (.getWrapperElement cm)]
+    (freeze-editor! cm)
     (go
       (swap! state assoc-in [key- :text] (:init-value recording))
       (doseq [{:keys [change selections dt] :as data} (:changes recording)]
-        (<! (timeout dt))
+        (<! (timeout (/ dt 2)))
         (cond
           change (apply-change cm change)
           selections (apply-selections cm selections)
-          :else nil)))))
-
+          :else nil))
+      (thaw-editor! cm))))
+


fix bug preventing newline from being inserted at end of line

--- src/parinfer/editor.cljs
+++ src/parinfer/editor.cljs
@@ -61,8 +61,18 @@
           line-no (.. change -from -line)
           line (.getLine cm line-no)
           insert-x (.indexOf line text from-x)]
-      (if (= -1 insert-x)
+      (cond
+
+        ;; pressing return, keep current position then.
+        (= text "\n")
+        nil
+
+        ;; typed character not found, we probably prevented it. keep cursor where it was.
+        (= -1 insert-x)
         (.setCursor cm line-no from-x)
+
+        ;; move cursor to after the typed characters were found.
+        :else
         (.setCursor cm line-no (+ insert-x (count text)))))))

 ;;----------------------------------------------------------------------


Code addition

Code addition

--- src/connect5_ai/core.clj
+++ src/connect5_ai/core.clj
@@ -438,6 +438,39 @@
       ;(gen-successors grid-w grid-h is-first-player state)
       ))

+(defn- is-it-a-win?
+  ""
+  [grid-w grid-h state]
+  (let [point (state :last-move)
+        _ (prn "tptptp" point)
+        max-lines ((state :lines) :max)
+        min-lines ((state :lines) :min)
+        indexes (line-index-from-point point grid-w)
+        paths (map (fn [[linetype-max max-lines-for-type] [linetype-min min-lines-for-type]]
+                     (assert (= linetype-max linetype-min) (str "Map is not mixing the same lines - " linetype-max " with " linetype-min))
+                     (let [line-index (indexes linetype-max)
+                           max-line (or (max-lines-for-type line-index) #{})
+                           min-line (or (min-lines-for-type line-index) #{})
+                           ]
+
+                       (map
+                         (fn [[nx ny :as new-point]]
+                           (let [index-in-line (if (= linetype-max :v) ny nx)]
+                             (cond
+                               (not (in-bounds? grid-w grid-h new-point)) :wall
+                               (contains? max-line index-in-line) :max
+                               (contains? min-line index-in-line) :min
+                               :else :empty)))
+                         (map (partial map + point) (directors linetype-max)))))
+                   max-lines min-lines)]
+    (boolean (some true? (map (fn [path]
+                                (let [parts (partition 5 1 (assoc (into [] path) 5 :max))]
+                                  (reduce #(or %1
+                                               (apply (partial = :max) %2))
+                                          false
+                                          parts)
+                                  )) paths)))))
+
 (defn- negamax-inner
   ""
   [state alpha beta got-time? is-first-player max-depth grid-width grid-height]
@@ -448,22 +481,30 @@

   (if (empty? (state true))
     {:best-move [(long (/ grid-width 2)) (long (/ grid-height 2))]}
-    (if (is-terminal-state? state)
-      {:best-move  (state :last-move)
-       :best-value (state :heuristic-result)}
+    (if (and (is-terminal-state? state)
+             (is-it-a-win? grid-width grid-height state))
+      (let [who-wins? (if is-a-win
+                        (not is-first-player)
+                        nil)]
+        {:best-move  (state :last-move)
+         :best-value (state :heuristic-result)
+         :who-win?   who-wins?})
+
       (if (= max-depth 0)
         {:best-move  (state :last-move)
-         :best-value (state :heuristic-result)}
+         :best-value (state :heuristic-result)
+         :who-win?   nil}

         (loop
             [sucessors (generate-successor-states state grid-width grid-height (not is-first-player)) ; Flip is first player.
              best {:best-value Double/NEGATIVE_INFINITY
-                   :best-move  []}
+                   :best-move  []
+                   :who-win?   nil}
              alpha alpha]

           (if (empty? sucessors)
             best
-            (let [{child-best-move :best-move tmp-child-best-value :best-value} (negamax-inner (first (first sucessors))
+            (let [{child-best-move :best-move tmp-child-best-value :best-value who-win? :who-win?} (negamax-inner (first (first sucessors))
                                                                                (- beta)
                                                                                (- alpha)
                                                                                got-time?
@@ -473,15 +514,23 @@
                                                                                grid-height)
                   child-best-value (- tmp-child-best-value)]

+              (if (and (= child-best-value (best :best-value) Double/POSITIVE_INFINITY)
+                       (not= who-win? nil))
+                {:best-value child-best-value :best-move child-best-move :who-win? who-win?}
+                (if (and (= (best :best-value) Double/POSITIVE_INFINITY)
+                         (< child-best-value (best :best-value)))
+                  best
               (if (> child-best-value (best :best-value))
-                (let [best {:best-value child-best-value :best-move child-best-move}]
+                (let [best {:best-value child-best-value :best-move child-best-move :who-win? who-win?}]
                   (if (> (best :best-value) alpha)
                     (let [alpha (best :best-value)]
-                      (if (>= alpha beta)
+                      (if (and (>= alpha beta)
+                               (or (not= child-best-value Double/POSITIVE_INFINITY)
+                                   (not= who-win? nil)))
                         best
                         (recur (rest sucessors) best alpha)))
                     (recur (rest sucessors) best alpha)))
-                (recur (rest sucessors) best alpha)))))))))
+                (recur (rest sucessors) best alpha)))))))))))

 (defn negamax
   ""


[registry] Fallback to using resolve in clj world (for now).

--- src/cortex/registry.cljc
+++ src/cortex/registry.cljc
@@ -8,10 +8,22 @@
 (defn register-module* [module-name module-cons]
   (swap! module-registry* assoc module-name (fn [params] (module-cons params))))

+#?(:clj
+    (defmacro register-module [module-name])
+   :cljs
+
 (defmacro register-module [module-name]
   "Register a module with the module registry."
-  `(register-module* ~(name module-name) (fn [params#] (new ~module-name params#))))
+  `(register-module* ~(name module-name) (fn [params#] (new ~module-name params#)))))
+

 (defn lookup-module [module-name]
   "Look up a module from the module registry."
-  (get @module-registry* module-name))
+  #?(:clj
+      (let [last-dot (.lastIndexOf module-name ".")
+            ns-name (.substring module-name 0 last-dot)
+            item-name (.substring module-name (+ 1 last-dot))
+            cons-fn (resolve (symbol ns-name (str "map->" item-name)))]
+        cons-fn)
+     :cljs
+      (get @module-registry* module-name)))


Improved comment

Improved comment

--- src/re_frame/router.cljs
+++ src/re_frame/router.cljs
@@ -8,7 +8,11 @@

 ;; -- Router Loop ------------------------------------------------------------
 ;;
-;; Conceptually, the task is to process events in a perpetual loop, one after
+;; A call to "re-frame.core/dispatch" places an event on a queue.  Sometime
+;; shortly afterwards the associated event handler will be run.  The following
+;; code handles this process.
+;;
+;; So, the task is to process events in a perpetual loop, one after
 ;; the other, FIFO, calling the right event-handler for each, being idle when
 ;; there are no events, and firing up when one arrives, etc. The processing
 ;; of an event happens "asynchronously" sometime after the event is
@@ -27,20 +31,20 @@
 ;; control. So now we hand-roll our own, finite-state-machine and all.
 ;;
 ;; The strategy is this:
-;;   - maintain a queue of `dispatched` events.
+;;   - maintain a FIFO queue of `dispatched` events.
 ;;   - when a new event arrives, "schedule" processing of this queue using
 ;;     goog.async.nextTick, which means it will happen "very soon".
-;;   - when processing events, do ALL the ones currently queued. Don't stop.
+;;   - when processing events, do ALL the those currently queued. Don't stop.
 ;;     Don't yield to the browser. Hog that CPU.
-;;   - but if any new events arrive during this cycle of processing, don't do
-;;     them immediately. Leave them queued. Yield first to the browser, and
-;;     do these new events in the next processing cycle. That way we drain
+;;   - but if any new events are dispatched during this cycle of processing,
+;;     don't do them immediately. Leave them queued. Yield first to the browser,
+;;     and do these new events in the next processing cycle. That way we drain
 ;;     the queue up to a point, but we never hog the CPU forever. In
 ;;     particular, we handle the case where handling one event will beget
 ;;     another event. The freshly begat event will be handled next cycle,
-;;     with yielding in between.
+;;     with yielding in-between.
 ;;   - In some cases, an event should not be run until after the GUI has been
-;;     updated, i.e., after the next reagent animation frame. In such a case,
+;;     updated, i.e., after the next Reagent animation frame. In such a case,
 ;;     the event should be dispatched with :flush-dom metadata like this:
 ;;       (dispatch ^:flush-dom [:event-id other params])
 ;;     Such an event will temporarily block all further processing because


23-31

--- src/sandbox/4clojure.clj
+++ src/sandbox/4clojure.clj
@@ -73,3 +73,40 @@
    (if (empty? (rest col))
      nbr
      (recur (rest col) (inc nbr))))
+
+;;23 Reverse a Sequence
+#(loop [col % rcol '()]
+   (if (empty? col)
+     rcol
+     (recur (rest col) (conj rcol (first col)))))
+
+;;24 Sum It All Up
+reduce +
+
+;;25 Find the odd numbers
+filter odd?
+
+;;26 Fibonacci Sequence
+(fn [nbr]
+  (->> (iterate (fn[[a b]] [b (+ a b)]) [1 1])
+       (map first)
+       (take nbr)))
+
+;;27 Palindrome Detector
+#(= (seq %) (reverse %))
+
+;;28 Flatten a Sequence
+(partial (fn flat[res col]
+           (let [fst (first col) rst (rest col)]
+             (-> res
+                 (#(if (sequential? fst) (flat % fst) (conj % fst)))
+                 (#(if (empty? rst) % (flat % rst)))))) [])
+
+;;29 Get the Caps
+(fn [s] (apply str (filter #(Character/isUpperCase %) s)))
+
+;;30 Compress a Sequence
+reduce #(if-not (= (last %1) %2) (conj %1 %2) %1) []
+
+;;31 Pack a Sequence
+partition-by identity


Minor fixes

Minor fixes

--- src/trumpet_server/domain/sse_service.clj
+++ src/trumpet_server/domain/sse_service.clj
@@ -33,8 +33,8 @@
 (defn- stale? [client]
   (< @(:last-accessed client) (client-expiry-time)))

-(defn- remove-stale-clients []
-  (log/info "Removing stale clients")
+(defn- evict-stale-clients! []
+  (log/info "Evicting stale SSE clients")
   (let [stale-clients (filter #(stale? (val %)) @clients)]
     (doseq [stale-client stale-clients]
       (log/info "Closing SSE channel for trumpeteer with id " (first stale-client))
@@ -42,5 +42,5 @@
   ; TODO Implement remove-vals instead of using lib
   (swap! clients #(remove-vals % stale?)))

-#_(def stale-client-remover
-  (schedule {:min (range 0 60 5)} remove-stale-clients))+(def stale-clients-evictor
+  (schedule {:min (range 0 60 5)} evict-stale-clients!))


Show the new app name when renaming an app

As simply as adding :color "black" to the css :)

--- src/webapp/framework/client/webhosting/hostmain.cljs
+++ src/webapp/framework/client/webhosting/hostmain.cljs
@@ -54,7 +54,7 @@

                     (cond
                       (and (= (read-ui app [:submode]) "editappname") (= (<-- :id ) (read-ui app [:app-id])))
-                      (input-field {:style {:marginBottom "20px"} :placeholder  "Enter name"}
+                      (input-field {:style {:marginBottom "20px" :color "black"} :placeholder  "Enter name"}
                                    app
                                    (fn [new-name]
                                      (let [id (read-ui app [:app-id])]


Euler one ready for being solved.

Euler one ready for being solved.

--- clojure-functional/src/test/clojure/no/knowit/clojure_functional/euler_one.clj
+++ clojure-functional/src/test/clojure/no/knowit/clojure_functional/euler_one.clj
@@ -14,28 +14,24 @@
   [coll] (apply + coll))

 (defn multiples-of-3-or-5 [num]
-  (let [mod-of #(zero? (mod num %1))]
-    (or (mod-of 3) (mod-of 5))))
+  )

 ;; Use standard filter, sum and range.
 (defn euler-one-sum-beneath [limit]
-  (sum (filter multiples-of-3-or-5 (range 1 limit))))
-
-(defn- sum-modof-coll [coll]
-  (reductions +
-    (filter multiples-of-3-or-5 coll)))
+  )

 ;; Try implementing it using a lazy collection. Hint reductions.
 (defn euler-one-sum-beneath-lazy [limit]
-  (last
-    (sum-modof-coll (range 1 limit))))
+  )

 ; Test code
+#_
 (deftest euler-one-sum
   (is (= (euler-one-sum-beneath 10) 23))
   (is (= (euler-one-sum-beneath 1000) 233168)))

+#_
 (deftest euler-one-lazy
   (is (= (euler-one-sum-beneath-lazy 10) 23))
   (is (= (euler-one-sum-beneath-lazy 1000) 233168)))


Remove flush watcher safeguard from comparable trace to reduce test flaky failures

--- test/com/wsscode/pathom/connect_test.cljc
+++ test/com/wsscode/pathom/connect_test.cljc
@@ -1355,7 +1355,9 @@
          res))))

 (defn comparable-trace [trace]
-  (mapv #(dissoc % ::pt/timestamp ::pt/id) trace))
+  (into [] (comp (map #(dissoc % ::pt/timestamp ::pt/id))
+                 (remove (comp #{:com.wsscode.pathom.parser/flush-watcher-safeguard}
+                               ::pt/event))) trace))

 (deftest test-path-cost
   (is (= (pc/path-cost {} ['a 'b 'c])


Added time/datestamps for now.

Added time/datestamps for now.

--- src/dragon/blog/post.clj
+++ src/dragon/blog/post.clj
@@ -78,7 +78,9 @@
       :month-short (util/month->short-name (:month date))
       :timestamp timestamp
       :timestamp-long (Long/parseLong timestamp-clean)
-      :datestamp datestamp)))
+      :datestamp datestamp
+      :now-timestamp (util/format-timestamp (util/datetime-now))
+      :now-datestamp (util/format-datestamp (util/datetime-now)))))

 (defn add-counts
   [data]


Housekeeping, disallow coercion of empty strings or sets (illegal DB values)

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -102,6 +102,7 @@

 (defn- db-val->clj-val
   "Returns the Clojure value of given AttributeValue object."
+  ;; TODO Nippy support
   [^AttributeValue x]
   (or (.getS x)
       (some->> (.getN  x) str->num)
@@ -110,7 +111,7 @@
       (some->> (.getNS x) (map str->num) (into #{}))
       (some->> (.getBS x) (map bb->ba)   (into #{}))))

-(defn- set-of [pred s] (and (set? s) (every? pred s)))
+(defn- set-of [pred s] (and (set? s) (seq s) (every? pred s)))
 (def ^:private ^:const ba-class (Class/forName "[B"))
 (defn- ba? [x] (instance? ba-class x))
 (defn- ba-buffer [^bytes ba] (ByteBuffer/wrap ba))
@@ -121,18 +122,21 @@

 (defn- clj-val->db-val
   "Returns an AttributeValue object for given Clojure value."
-  ;; TODO Nippy support (will require special marker bin-wrapping)
-  ;; TODO More efficient set-type dispatch
+  ;; TODO Nippy support (will require special marker bin-wrapping), incl.
+  ;; Serialized (boxed) type (should allow empty strings & ANY type of set)
+  ;; Maybe require special wrapper types for writing bins/serialized
   [x]
   (cond
-   (string? x)        (doto (AttributeValue.) (.setS x))
-   (simple-num? x)    (doto (AttributeValue.) (.setN (str x)))
-   (ba?     x)        (doto (AttributeValue.) (.setB (ba-buffer x)))
-   (set-of string? x) (doto (AttributeValue.) (.setSS x))
-   (set-of number? x) (doto (AttributeValue.) (.setNS (map str x)))
-   (set-of ba?     x) (doto (AttributeValue.) (.setBS (map ba-buffer x)))
-   (set? x)           (throw (Exception. "Set must contain values of the same type."))
-   :else              (throw (Exception. (str "Unknown value type: " (type x))))))
+   (string? x)          (if (.isEmpty ^String x)
+                          (throw (Exception. "\"\" is not a legal DynamoDB value!"))
+                          (doto (AttributeValue.) (.setS x)))
+   (simple-num? x)        (doto (AttributeValue.) (.setN (str x)))
+   (ba? x)                (doto (AttributeValue.) (.setB (ba-buffer x)))
+   (set-of string? x)     (doto (AttributeValue.) (.setSS x))
+   (set-of simple-num? x) (doto (AttributeValue.) (.setNS (map str x)))
+   (set-of ba? x)         (doto (AttributeValue.) (.setBS (map ba-buffer x)))
+   (set? x) (throw (Exception. "Sets must be non-empty & contain values of the same type!"))
+   :else    (throw (Exception. (str "Unknown value type: " (type x))))))

 (comment (map clj-val->db-val ["foo" 10 3.14 (.getBytes "foo")
                                 #{"a" "b" "c"} #{1 2 3.14} #{(.getBytes "foo")}]))


added :char-allfromstring missing args test

--- test/push/instructions/base/char_test.clj
+++ test/push/instructions/base/char_test.clj
@@ -22,8 +22,10 @@
     ;; all the letters
     :string    '("foo")         :char-allfromstring   :char     '(\f \o \o)
     :string    '("4\n5")        :char-allfromstring   :char     '(\4 \newline \5)
+    :string    '("")            :char-allfromstring   :char     '()
     ;; missing args
-    :string    '("")            :char-allfromstring   :char     '())
+    :string    '()              :char-allfromstring   :char     '())
+

 (tabular


Fix nml-map :dec mapping

Fix nml-map :dec mapping

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -183,7 +183,7 @@
                 :c identity
                 :complex string_id
                 :dataref string_id
-                :dec (fn [point int] (str point int))
+                :dec (fn [point & int] (str point int))
                 :exp string_lc
                 :false string_lc
                 :int string_id


blurbs about the junit feature flags (commented out for now)

--- frontend/components/project_settings.cljs
+++ frontend/components/project_settings.cljs
@@ -350,14 +350,25 @@
             "know what you think about them"] "."
            " These " [:em "are"] " works-in-progress, though, and there may be some sharp edges. Be careful!"]
           [:ul
-           (describe-flag {:flag :junit
-                           :title "JUnit support"
-                           :blurb [:p
-                                   "We've been experimenting with better ways to display and manage "
-                                   "test result data, especially for large test suites. This adds flags "
-                                   "to some of our inferred commands, and collects data supplied by JUnit and "
-                                   "JUnit-compatabile test runners. It only works for a handful of test "
-                                   "runners for now, and the data is only available through our API, though!"]})
+           ;; Comment out while we wait for the backend to deploy
+           ;; (describe-flag {:flag :junit
+           ;;                 :title "JUnit support"
+           ;;                 :blurb [:p
+           ;;                         "We've been experimenting with better ways to display and manage "
+           ;;                         "test result data, especially for large test suites. This adds flags "
+           ;;                         "to some of our inferred commands to collect structured test output supplied by "
+           ;;                         "JUnit-compatible test runners. It currently works with RSpec and Cucumber if "
+           ;;                         "you're using our inferred test steps. For RSpec, we also require our fork of the "
+           ;;                         "rspec_junit_formatters gem (see the flag below). If you're using parallelism, we'll "
+           ;;                         "automatically use the timing data to give you better test splits. You'll also be able to "
+           ;;                         "fetch the test data via our API at https://circleci.com/api/v1/project/:org-name/:repo-name/:build-num/tests"]})
+           ;; (describe-flag {:flag :inject-rspec-junit
+           ;;                 :title "Automatically inject the rspec_junit_formatters gem"
+           ;;                 :blurb (list [:p
+           ;;                               "Used with the JUnit support above, this will inject our rspec_junit_formatter "
+           ;;                               "gem into your Gemfile, which lets us capture test information for RSpec. Alternatively, "
+           ;;                               "you can include the gem in your gemfile:"]
+           ;;                              [:p [:code "gem 'rspec_junit_formatter', :git => 'git@github.com:circleci/rspec_junit_formatter.git'"]])})
            (describe-flag {:flag :set-github-status
                            :title "GitHub Status updates"
                            :blurb [:p


Fixing some typos

Fixing some typos

--- src/voxxed/polymorph.clj
+++ src/voxxed/polymorph.clj
@@ -46,8 +46,8 @@
 (defmethod handle-event  "JButton" [_]
   (println "Only buttons here :)"))

-;(defmethod handle-event "JRadioButton" [_]
-;  (println "Listenin' to the radio!"))
-;
+(defmethod handle-event "JRadioButton" [_]
+  (println "Listenin' to the radio!"))
+
 ;(defmethod handle-event "JLabel" [_]
 ;  (println "Labels all around..."))


diagram reductions -> reduce

diagram reductions -> reduce

--- 2021/src/adventofcode2021/day05.clj
+++ 2021/src/adventofcode2021/day05.clj
@@ -50,11 +50,7 @@
         rows (inc (apply max (map second points)))
         row (into [] (take cols (repeat 0)))
         grid (into [] (take rows (repeat row)))]
-    (reductions #(do
-                   (println [%2 %1])
-                   (update-in %1 (reverse %2) inc))
-                grid
-                points)))
+    (reduce #(update-in %1 (reverse %2) inc) grid points)))

 (comment
   (part-1 test-input)


CMR-5588: Store size as double.

CMR-5588: Store size as double.

--- indexer-app/src/cmr/indexer/data/index_set.clj
+++ indexer-app/src/cmr/indexer/data/index_set.clj
@@ -587,8 +587,8 @@
      ;; No longer indexing to :temporals due to performance issues, but cannot
      ;; delete from elastic index
      :temporals temporal-mapping
-     :size (m/stored m/float-field-mapping)
-     :size-doc-values (-> m/float-field-mapping m/stored m/doc-values)
+     :size (m/stored m/double-field-mapping)
+     :size-doc-values (-> m/double-field-mapping m/stored m/doc-values)

      :cloud-cover (m/stored m/float-field-mapping)
      :cloud-cover-doc-values (-> m/float-field-mapping m/stored m/doc-values)


Function documentation

Function documentation

--- src/wireframes/shape.clj
+++ src/wireframes/shape.clj
@@ -76,6 +76,9 @@
 (defn- intervals->radians [num-intervals]
    (/ (* (Math/atan 1) 8.0) (double num-intervals)))

+(defn degrees->radians [d]
+  (/ (* (double d) Math/PI) 180.0))
+
 (defn make-circle
   "Approximate a circle in the X-Y plane around the origin wth radius r and n points"
   [r n]
@@ -99,14 +102,20 @@
       circle
       n2)))

-(defn make-cube [n]
+(defn make-cube
+  "Start with a point, extrude to a line alone the Z-plane, then extrude that
+   line in the Y-axis to make a square... extrude again along the X-axis to
+   complete the square. "[n]
   (->>
     (make-point 0 0 0)
     (extrude (translate 0 0 n))
     (extrude (translate 0 n 0))
     (extrude (translate n 0 0))))

-(defn make)
+(defn make-cylinder [r n h]
+  (->>
+    (make-circle r n)
+    (extrude (translate 0 0 h))))

 (comment


Attempting to quiet the slf4j output.

Attempting to quiet the slf4j output.

--- common-lib/project.clj
+++ common-lib/project.clj
@@ -25,7 +25,8 @@

                  ;; Needed for timeout a function execution
                  [clojail "1.0.6"]
-                 [com.github.fge/json-schema-validator "2.2.6"]]
+                 [com.github.fge/json-schema-validator "2.2.6"]
+                 [com.dadrox/quiet-slf4j "0.1"]]

   :plugins [[lein-test-out "0.3.1"]
             [lein-exec "0.3.2"]]


CMR-3195: removed assert-invalid-schema

CMR-3195: removed assert-invalid-schema

--- system-int-test/test/cmr/system_int_test/ingest/collection_validation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/collection_validation_test.clj
@@ -83,16 +83,6 @@
      (is (= {:status 422
              :errors [{:path field-path
                        :errors errors}]}
-            (select-keys response [:status :errors]))))))
-
-(defn assert-invalid-schema
-  ([coll-attributes errors]
-   (assert-invalid coll-attributes errors nil))
-  ([coll-attributes errors options]
-   (let [response (d/ingest "PROV1" (dc/collection coll-attributes)
-                            (merge {:allow-failure? true} options))]
-     (is (= {:status 422
-             :errors [errors]}
             (select-keys response [:status :errors]))))))

 (defn assert-invalid-keywords


added explicit call to System::gc

added explicit call to System::gc

--- src/fowles/requester.clj
+++ src/fowles/requester.clj
@@ -31,6 +31,7 @@
       (if (= i batch-size)
         ;; We always pause after every batch.
         (do
+          (System/gc)
           (Thread/sleep interval-ms)
           (recur 0))


Docstrings -> comments

Docstrings -> comments

--- src/graphql_clj/spec.clj
+++ src/graphql_clj/spec.clj
@@ -267,7 +267,6 @@
 ;; Multimethod to decomplect getting base-spec and parent-type-name for fields

 (defmulti spec-for-field
-  "Handle children of fragments, lists, and root fields differently"
   (fn [{:keys [v/path v/parent]} parent-node s]
     (cond (#{:fragment-definition :inline-fragment} (:node-type parent))         :fragment-child
           (= :LIST (:kind parent-node))                                          :list-child
@@ -275,7 +274,7 @@
                                       (= (first path) (:mutation-root-name s)))) :root-field)))

 (defmethod spec-for-field :fragment-child
-  "Child fields of named and inline fragments jump out of the nesting path to the top level"
+  ;; Child fields of named and inline fragments jump out of the nesting path to the top level
   [{:keys [v/path v/parent]} _ s]
   (let [parent-type-name (name (:base-spec parent))
         spec             (named-spec s [parent-type-name (last path)])
@@ -283,7 +282,7 @@
     {:n spec :m {:base-spec base-spec :parent-type-name parent-type-name}}))

 (defmethod spec-for-field :list-child
-  "Child fields of list types need to be unwrapped to get to the parent and base types"
+  ;; Child fields of list types need to be unwrapped to get to the parent and base types
   [{:keys [v/path]} parent-node s]
   (let [{:keys [type-name inner-type]} parent-node
         parent-type-name (or (:type-name inner-type) type-name) ;; TODO multiple levels of nesting?
@@ -292,13 +291,13 @@
     {:n base-named-spec :m {:parent-type-name parent-type-name :base-spec base-spec}}))

 (defmethod spec-for-field :root-field
-  "Root fields smuggle their base types via metadata from visitor bootstrap"
+  ;; Root fields smuggle their base types via metadata from visitor bootstrap
   [{:keys [v/path]} _ s]
   (let [base-spec (named-spec s [(last (resolve-path path))])] ;; Convert rootField => TypeName
     (register-idempotent s path base-spec {:parent-type-name (first path) :base-spec base-spec})))

 (defmethod spec-for-field :default
-  "By default, link this field to its parent object type path"
+  ;; By default, link this field to its parent object type path
   [{:keys [v/path]} parent-node s]
   (let [parent-type-name (:type-name parent-node)
         base-spec  (named-spec s (conj (:v/path parent-node) (last path)))]


Update core.clj

Update core.clj

witzige Idee: versteck den response statt in json in jQuery vom html
hihi

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -27,7 +27,7 @@
 (defn page [name]
   (str "<html><body>"
        (if name
-  (str "Nice to meet you, " name "! \n" (sqlquery name) )
+  (str "Nice to meet you, " name "! \n" "<div id='mgm_response' data='"(sqlquery name)"'><\div>")
         (str "<form>"
               "Name: <input name='name' type='text'>"
               "<input type='submit'>"


CMR-3780: Minor cleanup changes for PR

CMR-3780: Minor cleanup changes for PR

--- access-control-app/int_test/cmr/access_control/int_test/enable_disable_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/enable_disable_test.clj
@@ -1,5 +1,5 @@
 (ns cmr.access-control.int-test.enable-disable-test
-  "CMR Ingest Enable/Disable endpoint test"
+  "CMR Access Control Enable/Disable endpoint test"
   (:require
     [clojure.test :refer :all]
     [cmr.access-control.int-test.fixtures :as fixtures]
@@ -109,8 +109,11 @@
     (testing "save, update, and delete group fails after disable"
       (let [group3 (u/make-group {:name "group3" :members ["user1" "user2" "user3"]})
             {:keys [status]} (u/create-group token group3 {:allow-failure? true})]
+        ;; check save response
         (is (= 503 status))
+        ;; test update
         (is (= 503 (:status (u/update-group token concept-id2 {:name "Updated3" :description "Updated3"}))))
+        ;; test delete
         (is (= 503 (:status (u/delete-group token concept-id2 {:allow-failure? true}))))))

     ;; re-eneable writes for access control service
@@ -119,8 +122,11 @@
     (testing "save, update, and delete group succeeds after re-enable"
      (let [group3 (u/make-group {:name "group4" :members ["user1" "user5"]})
             {:keys [status]} (u/create-group token group3)]
+        ;; check save response
         (is (= 200 status))
+        ;; test update
         (is (= 200 (:status (u/update-group token concept-id2 {:name "Updated3" :description "Updated3"}))))
+        ;; test delete
         (is (= 200 (:status (u/delete-group token concept-id2 {:allow-failure? true}))))))))


Bumps version to 1.51.5-SNAPSHOT

Bumps version to 1.51.5-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.51.4"
+(defproject cook "1.51.5-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Snapshot version

Snapshot version

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.17.1"
+(defproject cook "1.17.2-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Bumps version to 1.51.8-SNAPSHOT

Bumps version to 1.51.8-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.51.7"
+(defproject cook "1.51.8-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


handle fetching

handle fetching

--- src/frontend/cljs/alibi/entry_page_state.cljs
+++ src/frontend/cljs/alibi/entry_page_state.cljs
@@ -179,4 +179,8 @@
                                   [:entries-cache (:for-date payload)]
                                   (:entries payload))

+    :entries-loading-cache (assoc-in prev-state
+                                  [:entries-cache (:for-date payload)]
+                                  :fetching)
+
     prev-state))


set the charset to utf-8 before returning the html responses ring & jetty do some weird stuff with the charset - if the header isn't set, jetty assumes ISO8859-1 or whatever.  If your pages are actually UTF-8 (which mine are, Enlive renders out stuff like · into UTF-8), it'll be encoded incorrectly.

--- src/smallblog/core.clj
+++ src/smallblog/core.clj
@@ -20,10 +20,21 @@
               [clj-time.coerce :as clj-time-coerce]
               [clj-json.core :as json]))

-(defn json-response [data & [status]]
+(defn json-response
+    "called on all JSON responses to set content-type, status, render as json -
+    should be ring middleware?"
+    [data & [status]]
     {:status (or status 200)
-     :headers {"Content-Type" "application/json"}
+     :headers {"Content-Type" "application/json;charset=utf-8"}
      :body (json/generate-string data)})
+
+(defn html-response
+    "called on all HTML responses to set content-type, status, etc -
+    should be ring middleware?"
+    [data & [status]]
+    {:status (or status 200)
+     :headers {"Content-Type" "text/html;charset=utf-8"}
+     :body data})

 (defn render-post-json [post]
     {:id (:id post), :title (:title post), :content (:content post),
@@ -145,17 +156,18 @@
                                          (str ":" (:server-port request))))
                      uri (:uri request)]
                    (let [domain (data/get-domain server-name)]
-                       (if (not (nil? domain))
-                           (render-html-posts-helper (:blogid domain) request)
-                           (templates/about)))))
+                       (html-response
+                           (if (not (nil? domain))
+                               (render-html-posts-helper (:blogid domain) request)
+                               (templates/about))))))

            ; "account urls"
-           (GET templates/*permission-denied-uri* [] (permission-denied))
+           (GET templates/*permission-denied-uri* [] (html-response (permission-denied)))
            (GET templates/*logout-url* [] (logout! {}))
            (GET templates/*login-url* [url :as request]
                (if (not (ensure-secure request))
                    {:status 403}
-                   (templates/login {:url url})))
+                   (html-response (templates/login {:url url}))))
            (POST templates/*login-redirect-url* [url :as request]
                (if (not (ensure-secure request))
                    {:status 403}
@@ -165,7 +177,7 @@
            (GET templates/*account-url* [:as request]
                (if (not (ensure-secure request))
                    {:status 403}
-                   (render-html-account (util/uri-from-request request))))
+                   (html-response (render-html-account (util/uri-from-request request)))))
            (POST templates/*account-url* [:as request]
                (if (not (ensure-secure request))
                    {:status 403}
@@ -210,13 +222,14 @@
                                      (println "XXX should be a log not a print" request)
                                      {:status 400 :body "bad form parameters"})))))
            (GET templates/*signup-url* [token :as request]
-                (if (and
-                        (ensure-secure request)
-                        (or
-                            (nil? *signup-token*)
-                            (= token *signup-token*)))
-                    (render-html-signup)
-                    (templates/signup-restricted)))
+                (html-response
+                    (if (and
+                            (ensure-secure request)
+                            (or
+                                (nil? *signup-token*)
+                                (= token *signup-token*)))
+                        (render-html-signup)
+                        (templates/signup-restricted))))
            (POST templates/*signup-url* [email newpw confirmpw :as request]
                (if (not (ensure-secure request))
                    {:status 403}
@@ -227,13 +240,15 @@

            ; "post urls"
            (GET "/blog/:blogid/post/" [blogid :as request]
-               (render-html-posts-helper (Integer/parseInt blogid) request))
+               (html-response (render-html-posts-helper (Integer/parseInt blogid) request)))
            (GET "/blog/:bid/post/new" [bid]
                (if (not (data/blog-owner? bid))
                    (redirect templates/*permission-denied-uri*)
                    (let [int-blogid (Integer/parseInt bid)]
-                       (render-html-newpost (:title (data/get-blog int-blogid))
-                                            int-blogid))))
+                       (html-response
+                           (render-html-newpost
+                               (:title (data/get-blog int-blogid))
+                               int-blogid)))))
            (POST "/blog/:bid/post/new" [bid title content postdate :as request]
                (if (not (data/blog-owner? bid))
                    (redirect templates/*permission-denied-uri*)
@@ -246,8 +261,8 @@

            ; "image urls"
            (GET templates/*image-url* []
-               (render-html-images (data/get-images
-                                       (:id (data/get-current-user)) 10 0)))
+               (html-response (render-html-images (data/get-images
+                                                      (:id (data/get-current-user)) 10 0))))
            (wrap-multipart-params
                (POST templates/*image-url* {params :params}
                    (let [image (get params "image")
@@ -273,7 +288,7 @@

            ; contact/about
            (GET "/contact" []
-                (templates/contact))
+                (html-response (templates/contact)))
            (POST "/contact" [:as request]
                 (let [params (:params request)
                       email (get params "email")
@@ -289,7 +304,7 @@
                     (data/send-email email admin-email subject body)
                     (redirect-after-post "/")))
            (GET "/about" []
-                (templates/about))
+                (html-response (templates/about)))

            ; "api urls"


updated slide! output, and changed to use move-tile-to


Refactor some duplicated code by extracting a function.

--- src/rdf-repository/grafter/rdf/repository.clj
+++ src/rdf-repository/grafter/rdf/repository.clj
@@ -216,7 +216,7 @@

   By default this function will return a repository initialised with a
   Sesame MemoryStore."
-  ([] (repo (MemoryStore.)))
+  ([] (sail-repo (MemoryStore.)))
   ([sail]
    (doto (SailRepository. sail)
      (.initialize))))
@@ -229,6 +229,11 @@
      acc
      (rdf/add acc v))))

+(defn- coerce-into-repo [repo-or-data]
+  (if (instance? Repository repo-or-data)
+                    repo-or-data
+                    (rdf/add (sail-repo) (rdf/statements repo-or-data))))
+
 (defn fixture-repo
   "Adds the specified data to a SPARQL repository.  If the first
   argument is a Repository that object is used, otherwise the first
@@ -240,12 +245,9 @@

   (fixture-repo \"test-data.trig\" \"more-test-data.trig\")"
   ([] (sail-repo))
-  ([repo-or-data] repo-or-data)
+  ([repo-or-data] (coerce-into-repo repo-or-data))
   ([repo-or-data & data]
-   (let [repo (if (instance? Repository repo-or-data)
-                repo-or-data
-                (rdf/add (sail-repo) (rdf/statements repo-or-data)))]
-
+   (let [repo (coerce-into-repo repo-or-data)]
      (let [xf (mapcat (fn [d]
                         (cond
                           (satisfies? pr/ITripleReadable d) (rdf/statements d)


[#10771] Fix loading of tx history before 10000000th block

--- src/status_im/ethereum/transactions/core.cljs
+++ src/status_im/ethereum/transactions/core.cljs
@@ -158,8 +158,8 @@
          (fn [{:keys [min-block] :as acc}
               {:keys [block hash]}]
            (cond
-             (or (nil? min-block) (> min-block block))
-             {:min-block                 block
+             (or (nil? min-block) (> min-block (js/parseInt block)))
+             {:min-block                 (js/parseInt block)
               :min-block-transfers-count 1}

              (and (= min-block block)
@@ -168,7 +168,8 @@

              :else acc))
          {:min-block
-          (get-min-known-block db address)
+          (when-let [min-block-string (get-min-known-block db address)]
+            (js/parseInt min-block-string))

           :min-block-transfers-count
           (min-block-transfers-count db address)}


species.clj edited online with Bitbucket

--- resources/species.clj
+++ resources/species.clj
@@ -1,11 +1,11 @@
-{:cyanobacteria {:size 0.3e20
+{:cyanobacteria {:size 0.2e20
                  :max-size 1e20
                  :min-size 100
-                 :production-rate 0.03
+                 :production-rate 0.04
                  :influence {:detrit 1e-20}
                  :tolerance {:detrit {:model :limit
                                       :ideal 25
-                                      :radius 1.5}}}
+                                      :radius 5}}}
  :lichens {:size 3e4
            :max-size 1e5
            :min-size 10
@@ -14,15 +14,15 @@
            :tolerance {:detrit {:model :limit
                                 :ideal 75
                                 :radius 40}}}
- :soilbacteria {:size 0.3e30
-                :max-size 1e30
+ :soilbacteria {:size 0.2e20
+                :max-size 1e20
                 :min-size 100
-                :production-rate 0.01
+                :production-rate 0.05
                 :tolerance {:detrit {:model :limit
-                                     :ideal 30
-                                     :radius -10}}
-                :influence {:detrit -0.5e-30
-                            :soil 0.04e-30}}
+                                     :ideal 25
+                                     :radius -5}}
+                :influence {:detrit -1.4e-20
+                            :soil 0.1e-20}}
  :fungus {:size 0.3e9
           :max-size 1e10
           :min-size 100


Added method to draw nodes with coordinates and connections

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

--- conexp/graphics/base.clj
+++ conexp/graphics/base.clj
@@ -1,4 +1,5 @@
 (ns conexp.graphics.base
+  (:use [clojure.contrib.seq-utils :only (flatten)])
   (:import [javax.swing JFrame JButton JPanel JLabel]
 	   [java.awt Color Dimension Font BorderLayout]
 	   [java.awt.event ActionListener]
@@ -62,50 +63,56 @@
 			      (.setBackgroundColor (Color. 23 11 84)))
 			    style))

-(defn add-node [scn x y]
-  (let [segment (GSegment.)
-	object (proxy [GObject] []
-		 (draw []
-		   (let [[x y] (position this)]
-		     (.setGeometryXy segment (Geometry/createCircle (double x) (double y) 10.0)))))
-	style (GStyle.)]
-    (doto segment
-      (.setStyle *default-node-style*))
-    (doto object
-      (.addSegment segment)
-      (.setUserData (ref {:type :node,
-			  :position [x y]}))
-      (.setName (str [x y])))
-    (doto scn
-      (.add object))
-    object))
+(defn add-node
+  ([scn x y]
+     (add-node scn x y (str [x y])))
+  ([scn x y name]
+     (let [segment (GSegment.)
+	   object (proxy [GObject] []
+		    (draw []
+		      (let [[x y] (position this)]
+			(.setGeometryXy segment (Geometry/createCircle (double x) (double y) 10.0)))))
+	   style (GStyle.)]
+       (doto segment
+	 (.setStyle *default-node-style*))
+       (doto object
+	 (.addSegment segment)
+	 (.setUserData (ref {:type :node,
+			     :position [(double x) (double y)]}))
+	 (.setName name))
+       (doto scn
+	 (.add object))
+       object)))

 (def *default-line-style* (let [style (GStyle.)]
 			    (doto style
 			      (.setLineWidth 3.0))
 			    style))

-(defn connect-nodes [scn x y]
-  (let [line (GSegment.)
-	c       (proxy [GObject] []
-		  (draw []
-		    (let [[x1 y1] (position (lower-node this))
-			  [x2 y2] (position (upper-node this))]
-		      (.setGeometry line (double x1) (double y1) (double x2) (double y2)))))]
-    (doto scn
-      (.add c))
-    (doto line
-      (.setStyle *default-line-style*))
-    (doto c
-      (.addSegment line)
-      (.toBack)
-      (.setUserData (ref {:type :connection,
-			  :lower x,
-			  :upper y}))
-      (.setName (str (.getName x) " -> " (.getName y))))
-    (dosync
-     (alter (.getUserData x) update-in [:upper] conj c)
-     (alter (.getUserData y) update-in [:lower] conj c))))
+(defn connect-nodes
+  ([scn x y]
+     (connect-nodes scn x y (str (.getName x) " -> " (.getName y))))
+  ([scn x y name]
+     (let [line (GSegment.)
+	   c       (proxy [GObject] []
+		     (draw []
+		       (let [[x1 y1] (position (lower-node this))
+			     [x2 y2] (position (upper-node this))]
+			 (.setGeometry line (double x1) (double y1) (double x2) (double y2)))))]
+       (doto scn
+	 (.add c))
+       (doto line
+	 (.setStyle *default-line-style*))
+       (doto c
+	 (.addSegment line)
+	 (.toBack)
+	 (.setUserData (ref {:type :connection,
+			     :lower x,
+			     :upper y}))
+	 (.setName name))
+       (dosync
+	(alter (.getUserData x) update-in [:upper] conj c)
+	(alter (.getUserData y) update-in [:lower] conj c)))))

 ;;; move nodes around
@@ -137,7 +144,7 @@

 	[new-x new-y] [(+ x dx) (+ y dy)]]

-    ; move nodes on the device
+    ; move node on the device
     (let [[dx-1 dy-1] (world-to-device scn dx dy)
 	  [zx zy]     (world-to-device scn 0 0)
 	  device-dx   (- dx-1 zx)
@@ -180,6 +187,19 @@
 	   nil)))))

+;;; draw nodes with coordinates and connections on a scene
+
+(defn draw-nodes-with-connections [scn node-coordinate-map node-connections]
+  (let [node-map (apply hash-map
+			(flatten (map (fn [[node [x y]]]
+					[node
+					 (add-node scn x y (str node))])
+				      node-coordinate-map)))]
+    (doseq [[node-1 node-2] node-connections]
+      (connect-nodes scn (node-map node-1) (node-map node-2)))
+    node-map))
+
+
 ;;; some testing

 (defn- show-some-picture []
@@ -189,12 +209,9 @@
     (doto scn
       (.setWorldExtent 0.0 0.0 100.0 100.0)
       (.shouldZoomOnResize false)
-      (.shouldWorldExtentFitViewport false))
-    (let [x (add-node scn 100 100)
-	  y (add-node scn 50 50)
-	  z (add-node scn 0 0)]
-      (connect-nodes scn z y)
-      (connect-nodes scn y x))
+      (.shouldWorldExtentFitViewport false)
+      (draw-nodes-with-connections {:x [100 100], :y [50 50], :z [0 0]}
+				   [[:z :y], [:y :x]]))
     (doto frm
       (.setLayout (BorderLayout.))
       (.. getContentPane (add (.getCanvas wnd) BorderLayout/CENTER))


autoshift: handles better whether it follows a paredit command or not.

--- ccw.core/src/clj/ccw/editors/clojure/PareditAutoAdjustWhitespaceStrategyImpl.clj
+++ ccw.core/src/clj/ccw/editors/clojure/PareditAutoAdjustWhitespaceStrategyImpl.clj
@@ -31,12 +31,10 @@
                                {:offset (.offset command)
                                 :length (.length command)
                                 :text   (.text command)})]
-        (support/add-command! command modif)
-        (set! (.shiftsCaret command) false)
-        (set! (.caretOffset command)
-              ;; if prev-caret-offset not set, then no paredit command has been
-              ;; applied => let the offset be what AutoAdjust strategy devised
-              (if (= -1 prev-caret-offset)
-                offset
-                prev-caret-offset))))))
+        (support/add-command! command modif)
+        ;; if prev-caret-offset not set, then no paredit command has been
+        ;; applied => force the offset be what AutoAdjust strategy computed
+        (when-not (pos? prev-caret-offset)
+          (set! (.shiftsCaret command) false)
+          (set! (.caretOffset command) offset))))))


CMR-1172: Address pull request comments. Added demo of polygon with hole validation.

--- spatial-lib/src/cmr/spatial/point.clj
+++ spatial-lib/src/cmr/spatial/point.clj
@@ -1,4 +1,5 @@
 (ns cmr.spatial.point
+  "This namespace defines a Point type along with functions for working with points."
   (:require [cmr.spatial.math :refer :all]
             [primitive-math]
             [clojure.pprint]
@@ -34,9 +35,7 @@

 ;; Point type definition
 ;; It is a Type and not a record because it has some special rules that don't follow normal
-;; equality semantics.
-;; - A point on a pole is equal to another point on the pole regardless of longitude
-;; - -180 and 180 degrees longitude are equivalent.
+;; equality semantics. This implements enough functions and protocols to simulate a record.
 ;; Also Point maintains cached versions of lon and lat in radians. It keeps those values consistent
 ;; when creating a new point with a different lon or lat in assoc.
 (deftype Point
@@ -98,6 +97,9 @@
     [this]
     (pr-str this))

+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Protocols implemented to simulate a clojure Record.
+
   clojure.lang.IPersistentMap
   (assoc
     [_ k v]


Always use the new app main margin

Always use the new app main margin

--- src-cljs/frontend/components/app.cljs
+++ src-cljs/frontend/components/app.cljs
@@ -143,10 +143,7 @@
               (when (and inner? logged-in?)
                 (om/build aside/aside-nav (dissoc app-without-container-data :current-build-data)))

-              [:main.app-main {:ref "app-main"
-                               :class (when (feature/enabled? :ui-v2)
-                                        "new-app-main-margin")}
-
+              [:main.app-main.new-app-main-margin {:ref "app-main"}
                (when (and inner? logged-in? (feature/enabled? :ui-fp-top-bar))
                  (om/build top-nav/top-nav app-without-container-data))


Doc tweaks.

Doc tweaks.

--- src/algebolic/evolution/transform.clj
+++ src/algebolic/evolution/transform.clj
@@ -11,6 +11,7 @@
 ;; * Helpers *

 (defn apply-to-fraction
+  "Apply a transformation to a randomly selected fraction of the population."
   [transform fraction population]
   (map
     #(if (< (rand) fraction) (transform %) %)


Bumps version to 1.48.2-SNAPSHOT

Bumps version to 1.48.2-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.48.1"
+(defproject cook "1.48.2-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


correct validation spec

correct validation spec

--- src/clj/clj_money/models/entities.clj
+++ src/clj/clj_money/models/entities.clj
@@ -22,7 +22,7 @@
 (s/def ::user-id integer?)
 (s/def ::monitored-account-ids (s/coll-of integer?))
 (s/def ::inventory-method #{:fifo :lifo})
-(s/def ::settings (s/keys :opt-un [::inventory-method ::monitored-account-id]))
+(s/def ::settings (s/keys :opt-un [::inventory-method ::monitored-account-ids]))
 (s/def ::new-entity (s/keys :req-un [::name ::user-id] :opt-un [::settings]))
 (s/def ::existing-entity (s/keys :req-un [::id ::name] :opt-un [::user-id ::settings]))


apply sort to all query types

apply sort to all query types

--- src/clj/iwaswhere_web/graph/query.clj
+++ src/clj/iwaswhere_web/graph/query.clj
@@ -163,13 +163,15 @@
         matched-ids (cond
                       ; full-text search
                       (:ft-search query)
-                      (sort-fn (ft/search query))
+                      (ft/search query)

                       ; set with the one timestamp in query
-                      (:timestamp query) #{(Long/parseLong (:timestamp query))}
+                      (:timestamp query)
+                      #{(Long/parseLong (:timestamp query))}

                       ; set with timestamps matching the day
-                      (:date-string query) (sort-fn (get-nodes-for-day g query))
+                      (:date-string query)
+                      (get-nodes-for-day g query)

                       ; query is for specific story
                       (:story query)
@@ -190,10 +192,10 @@

                       ; set with timestamps matching tags and mentions
                       (or (seq (:tags query)) (seq (:mentions query)))
-                      (sort-fn (get-tags-mentions-matches g query))
-                      ; set with all timestamps (leads to full scan at worst)
+                      (get-tags-mentions-matches g query)
+                      ; set with all timestamps
                       :else (:sorted-entries state))
-        matched-entries (map mapper-fn matched-ids)
+        matched-entries (map mapper-fn (sort-fn matched-ids))
         parent-ids (filter identity (map :comment-for matched-entries))
         parents (map mapper-fn parent-ids)
         entries (flatten [matched-entries parents])]


some stuff

some stuff

--- src/cljs/omnext_routing_one/core.cljs
+++ src/cljs/omnext_routing_one/core.cljs
@@ -7,10 +7,134 @@

 ;; URL helper functions

+(defn parse-url-hash [h]
+  (let [
+      h (subs h 2)
+      [path params] (string/split h #"\u003f")
+      path (string/split path \/) ; TODO: filter identity ???
+      params (into {} (map (comp
+                    (fn [[k v]] [(keyword (js/decodeURIComponent k))
+                                 (if v
+                                   (js/decodeURIComponent v)
+                                   v
+                                   )
+                                 ])
+                    #(string/split % "=")) (string/split params "&")))
+      ]
+  {:path path
+   :params params}
+  )
+  )
+
+
+;; Tab components
+
+(defui CountriesTab
+  static om/IQueryParams
+  (params [_]
+          ; ...
+          )
+
+  static om/IQuery
+  (query [_]
+         '[:countries {:page ?page}]
+         )
+
+  Object
+  (render [this]
+          (apply dom/ul nil
+                 (map (fn [country]
+                        (dom/li nil country)
+                        )
+                      )
+                 )
+          )
+  )
+
+(defui OceansTab
+  static om/IQueryParams
+  (params [_]
+          ; ...
+          )
+
+  static om/IQuery
+  (query [_]
+         '[:oceans-tab]
+         )
+
+  Object
+  (render [this]
+          (apply dom/ul nil
+                 (map (fn [country]
+                        (dom/li nil country)
+                        )
+                      )
+                 )
+          )
+  )
+
+(defui HelloTab
+  static om/IQueryParams
+  (params [_]
+          ; ...
+          )
+
+  static om/IQuery
+  (query [_]
+         '[:countries {:page ?page}]
+         )
+
+  Object
+  (render [this]
+          (apply dom/ul nil
+                 (map (fn [country]
+                        (dom/li nil country)
+                        )
+                      )
+                 )
+          )
+  )
+
+;; Tabs list
+
+(def tabs
+  [
+   {:key :countries
+    :url ["countries"]
+    :title "Countries"
+    :component CountriesTab
+    }
+   {:key :oceans
+    :url ["oceans"]
+    :title "Oceans"
+    :component OceansTab
+    }
+   {:key :hello
+    :url ["hello-world"]
+    :title "Just «Hello, World!» in it"
+    :component HelloTab
+    }
+   ]
+  )
+
+;; Processing the initial URL
+
+(def initial-url
+  js/window.location.hash)
+
+(

 ;; Components

 (defui RootView
+  static om/IQueryParams
+  (params [_]
+    )
+
+  static om/IQuery
+  (query [_]
+    )
+
   Object
   (render [this]
     (dom/div #js {:className "container"}


CRM-564: Added code to strip out xml processing instructions form embedded echo10

--- src/cmr/search/api/search_results.clj
+++ src/cmr/search/api/search_results.clj
@@ -8,6 +8,7 @@
             [clojure.data.xml :as x]
             [clojure.set :as set]
             [clojure.data.csv :as csv]
+            [clojure.string :as s]
             [cmr.search.models.results :as r]
             [cmr.transmit.transformer :as t])
   (:import
@@ -66,6 +67,15 @@
                (x/element :location {} location)
                (x/element :revision-id {} (str revision-id)))))

+(defn- remove-xml-processing-instructions
+  "Removes xml processing instructions from XML so it can be embedded in another XML document"
+  [xml]
+  (let [processing-regex #"<\?.*?\?>"
+        doctype-regex #"<!DOCTYPE.*?>"]
+    (-> xml
+        (s/replace processing-regex "")
+        (s/replace doctype-regex ""))))
+
 (defmulti reference+echo10->xml-element
   "Converts a search result + echo10 data into an XML element"
   (fn [reference echo10-xml]
@@ -123,6 +133,7 @@
                  (x/element :hits {} (str hits))
                  (x/element :took {} (str took))
                  (map (fn [reference echo10-xml]
-                        (reference+echo10->xml-element reference echo10-xml))
+                        (reference+echo10->xml-element reference
+                                                       (remove-xml-processing-instructions echo10-xml)))
                       references echo10)))))


Small test for implications

Small test for implications

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

--- src/conexp/tests/fca/implications.clj
+++ src/conexp/tests/fca/implications.clj
@@ -24,7 +24,8 @@
 (deftest test-Implication-equals
   (is (= (make-implication [] []) (make-implication [] [])))
   (is (= (make-implication [1] [2]) (make-implication [1] [1 2])))
-  (is (= (make-implication '[a] '[b c d]) (make-implication '#{a} '#{b c d}))))
+  (is (= (make-implication '[a] '[b c d]) (make-implication '#{a} '#{b c d})))
+  (is (not= (make-implication '[a] '[b c d]) (make-implication '[b] '[a c d]))))

 ;;;


pre/post vector test will become obsolete in the future. CLJ-1473 contains a patch which makes this test part of standard compiler when accepted

--- test/clj/source_test.clj
+++ test/clj/source_test.clj
@@ -64,6 +64,8 @@
                   (vector? (nth form 3))
                   (= pp (nth form 4)))))))

+; This is perhaps coming to future versions of Clojure built-in. Will likely be obsolete when
+; this feature is incorporated in standard Clojure: http://dev.clojure.org/jira/browse/CLJ-1473
 (defn pre-post-not-vector? [form]
   (when-let [pp (pre-post form)]
     (not (every? vector? (vals pp)))))


events.cljs: Refactor

events.cljs: Refactor

Reduce the overall nesting level in the test.  Each `testing'
statement now fits on a single screen, instead of spanning hundreds of
lines.

The final top-level expression went from 16 to 5 consecutive closing
parens.

Signed-off-by: Goran Jovic <fc686822162e6f379ea05b6f92d78d206147085c@gmail.com>

--- test/cljs/status_im/test/contacts/events.cljs
+++ test/cljs/status_im/test/contacts/events.cljs
@@ -192,280 +192,272 @@

     (rf/dispatch [:initialize-db])

-    (let [contacts        (rf/subscribe [:get-contacts])
-          contact-groups  (rf/subscribe [:get-contact-groups])
-          view-id         (rf/subscribe [:get :view-id])]
-
-      (testing ":load-contacts event"
-
-        ;;Assert the initial state
-        (is (and (map? @contacts) (empty? @contacts)))
-
-        (rf/dispatch [:load-contacts]))
-
-      (testing ":load-contact-groups event"
-
-        ;;Assert the initial state
-        (is (and (map? @contact-groups) (empty? @contact-groups)))
-
-        (rf/dispatch [:load-contact-groups])
-
-        (is (= {(:group-id test-contact-group) test-contact-group}
-               @contact-groups)))
-
-      (testing ":load-default-contacts! event"
-
-        ;; :load-default-contacts! event dispatches next 5 events
-        ;;
-        ;; :add-contact-groups
-        ;; :add-contacts
-        ;; :add-contacts-to-group
-        ;;TODO :add-chat
-        ;;TODO :load-commands!
-        (rf/dispatch [:load-default-contacts!])
-
-        (rf/dispatch [:set-in [:group/contact-groups "dapps" :timestamp] 0])
-
-        (is (= {"dapps" dapps-contact-group
-                (:group-id test-contact-group) test-contact-group}
-               @contact-groups))
-
-        (testing "it adds a default contact"
-          (is (= demo-bot-contact (get @contacts "demo-bot"))))
-
-        (testing "it adds the console bot"
-          (is (= console-contact (get @contacts "console"))))
-
-        (testing "it does not add any other contact"
-          (is (= 2 (count (keys @contacts))))))
-
-      (let [new-contact-public-key "0x048f7d5d4bda298447bbb5b021a34832509bd1a8dbe4e06f9b7223d00a59b6dc14f6e142b21d3220ceb3155a6d8f40ec115cd96394d3cc7c55055b433a1758dc74"
-            new-contact-address "5392ccb49f2e9fef8b8068b3e3b5ba6c020a9aca"
-            new-contact {:name ""
-                         :photo-path ""
-                         :whisper-identity new-contact-public-key
-                         :address new-contact-address}
-            contact (rf/subscribe [:contact-by-identity new-contact-public-key])
-            current-chat-id (rf/subscribe [:get-current-chat-id])]
-
-        (testing ":add-contact-handler event - new contact"
-
-          (rf/dispatch [:set :view-id nil])
-          (rf/dispatch [:set :current-chat-id nil])
-
-          ;; :add-contact-handler event dispatches next 4 events for new contact
-          ;;
-          ;; :add-new-contact-and-open-chat
-          ;; :status-im.contacts.events/add-new-contact
-          ;; :status-im.contacts.events/send-contact-request
-          ;;TODO :start-chat
-
-          (rf/dispatch [:set :contacts/new-identity new-contact-public-key])
-          (rf/dispatch [:add-contact-handler])
-
-          (testing "it returns the new contact from the contact-by-identity sub"
-            (is (= new-contact (assoc @contact :photo-path "" :name ""))))
-
-          (testing "it adds the new contact to the list of contacts"
-            (is (= new-contact
-                   (-> @contacts
-                       (get new-contact-public-key)
-                       (assoc :photo-path "" :name "")))))
-
-          (testing "it loads the 1-1 chat"
-            (is (= :chat @view-id)))
-
-          (testing "it adds the new contact to the chat"
-            (is (= new-contact-public-key @current-chat-id))))
-
-        (testing ":contact-request-received event"
-
-          ;; :contact-request-received event dispatches next 3 events
-          ;;
-          ;; :update-contact!
-          ;; :watch-contact
-          ;;TODO :update-chat!
-          (rf/reg-event-db :update-chat! (fn [db _] db))
-
-          (let [received-contact {:name "test"
-                                  :profile-image ""
-                                  :address new-contact-address
-                                  :status "test status"
-                                  :fcm-token "0xwhatever"}
-                received-contact' (merge new-contact
-                                         (dissoc received-contact :profile-image)
-                                         {:public-key new-contact-public-key
-                                          :private-key ""})]
-
-            (rf/dispatch [:contact-request-received {:from new-contact-public-key
-                                                     :payload {:contact received-contact
-                                                               :keypair {:public new-contact-public-key
-                                                                         :private ""}}}])
-
-            (testing "it adds the new contact to the list of contacts"
-              (is (= received-contact'
-                     (get @contacts new-contact-public-key))))
-
-            (testing ":contact-update-received event"
-
-              ;; :contact-update-received event dispatches next 2 events
-              ;;
-              ;; :update-contact!
-              ;;TODO :update-chat!
-              (let [timestamp (datetime/now-ms)
-                    received-contact'' (assoc received-contact'
-                                              :last-updated timestamp
-                                              :status "new status"
-                                              :name "new name")]
-
-                (rf/dispatch [:contact-update-received {:from new-contact-public-key
-                                                        :payload {:content {:profile {:profile-image ""
-                                                                                :status "new status"
-                                                                                :name "new name"}}
-                                                                  :timestamp timestamp}}])
-
-                (testing "it updates the contact and set the :last-updated key"
-                  (is (= received-contact''
-                         (get @contacts new-contact-public-key))))
-
-                (testing ":hide-contact event"
-
-                  ;; :hide-contact event dispatches next 2 events
-                  ;;
-                  ;; :update-contact!
-                  ;;TODO :account-update-keys
-                  (rf/reg-event-db :account-update-keys (fn [db _] db))
-
-                  (rf/dispatch [:hide-contact @contact])
-
-                  (testing "it sets the pending? flag to true"
-                    (is (= (assoc received-contact'' :pending? true)
-                           (get @contacts new-contact-public-key)))))
-
-                (testing ":add-contact-handler event - :add-pending-contact"
-
-                  ;; :add-contact-handler event dispatches next 4 events
-                  ;;
-                  ;; :add-pending-contact
-                  ;; :status-im.contacts.events/add-new-contact
-                  ;; :status-im.contacts.events/send-contact-request
-                  ;;TODO :discoveries-send-portions
-                  (rf/reg-event-db :discoveries-send-portions (fn [db _] db))
-
-                  (rf/dispatch [:set :view-id nil])
-                  (rf/dispatch [:set :current-chat-id nil])
-                  (rf/dispatch [:set :contacts/new-identity new-contact-public-key])
-                  (rf/dispatch [:add-contact-handler])
-
-                  (testing "it sets the pending? flag to false"
-                    (is (= (assoc received-contact'' :pending? false)
-                           (get @contacts new-contact-public-key))))
-
-                  (testing "it loads the 1-1 chat"
-                    (is (= :chat @view-id)))
-
-                  (testing "it adds the new contact to the chat"
-                    (is (= new-contact-public-key @current-chat-id))))
-
-                (testing ":create-new-contact-group event"
-
-                  (let [new-group-name "new group"]
-
-                    (rf/dispatch [:select-contact new-contact-public-key])
-                    (rf/dispatch [:select-contact "demo-bot"])
-                    (rf/dispatch [:select-contact "browse"])
-                    (rf/dispatch [:deselect-contact "browse"])
-
-                    (rf/dispatch [:create-new-contact-group new-group-name])
-
-                    (rf/dispatch [:deselect-contact "demo-bot"])
-                    (rf/dispatch [:deselect-contact new-contact-public-key])
-
-                    (let [new-group-id (->> @contact-groups
-                                            (vals)
-                                            (filter #(= (:name %) new-group-name))
-                                            (first)
-                                            (:group-id))
-                          new-group {:group-id    new-group-id
-                                     :name        new-group-name
-                                     :order       2
-                                     :timestamp   0
-                                     :contacts   [{:identity new-contact-public-key}
-                                                  {:identity "demo-bot"}]}
-                          groups-with-new-group {new-group-id new-group
-                                                 "dapps" dapps-contact-group
-                                                 (:group-id test-contact-group) test-contact-group}]
-
-                      (rf/dispatch [:set-in [:group/contact-groups new-group-id :timestamp] 0])
-
-                      (is (= groups-with-new-group @contact-groups))
-
-                      (let [groups-with-new-group' (update groups-with-new-group new-group-id assoc :name "new group name")]
-
-                        (testing ":set-contact-group-name event"
-
-                          (rf/reg-event-db ::prepare-group-name
-                                           (fn [db _] (assoc db
-                                                             :new-chat-name "new group name"
-                                                             :group/contact-group-id new-group-id)))
-
-                          (rf/dispatch [::prepare-group-name])
-                          (rf/dispatch [:set-contact-group-name])
-
-                          (is (= groups-with-new-group' @contact-groups)))
-
-                        (let [groups-with-new-group'' (-> groups-with-new-group'
-                                                          (update new-group-id assoc :order 1)
-                                                          (update "dapps" assoc :order 2))]
-
-                          (testing ":save-contact-group-order event"
-
-                            (rf/reg-event-db ::prepare-groups-order
-                                             (fn [db _]
-                                               (assoc db :group/groups-order
-                                                      (->> (vals (:group/contact-groups db))
-                                                           (remove :pending?)
-                                                           (sort-by :order >)
-                                                           (map :group-id)))))
-
-                            (rf/dispatch [::prepare-groups-order])
-                            (rf/dispatch [:change-contact-group-order 1 0])
-                            (rf/dispatch [:save-contact-group-order])
-
-                            (is (= groups-with-new-group'' @contact-groups)))
-
-                          (testing ":add-selected-contacts-to-group event"
-
-                            (rf/dispatch [:select-contact "browse"])
-                            (rf/dispatch [:add-selected-contacts-to-group])
-                            (rf/dispatch [:deselect-contact "browse"])
-
-                            (is (= (update groups-with-new-group'' new-group-id assoc :contacts [{:identity new-contact-public-key}
-                                                                                {:identity "demo-bot"}
-                                                                                {:identity "browse"}])
-                                   @contact-groups)))
-
-                          (testing ":remove-contact-from-group event"
-
-                            (rf/dispatch [:remove-contact-from-group "browse" new-group-id])
-
-                            (is (= groups-with-new-group'' @contact-groups)))
-
-
-                          (testing ":add-contacts-to-group event"
-
-                            (rf/dispatch [:add-contacts-to-group new-group-id ["browse"]])
-
-                            (is (= (update groups-with-new-group'' new-group-id assoc :contacts [{:identity new-contact-public-key}
-                                                                                {:identity "demo-bot"}
-                                                                                {:identity "browse"}])
-                                   @contact-groups))
-
-                            (rf/dispatch [:remove-contact-from-group "browse" new-group-id]))
-
-                          (testing ":delete-contact-group event"
-
-                            (rf/dispatch [:delete-contact-group])
-
-                            (is (= (update groups-with-new-group'' new-group-id assoc :pending? true)
-                                   @contact-groups))))))))))))))))
+    (def contacts (rf/subscribe [:get-contacts]))
+    (def contact-groups (rf/subscribe [:get-contact-groups]))
+    (def view-id         (rf/subscribe [:get :view-id]))
+
+    (testing ":load-contacts event"
+
+      ;;Assert the initial state
+      (is (and (map? @contacts) (empty? @contacts)))
+      (rf/dispatch [:load-contacts]))
+
+    (testing ":load-contact-groups event"
+
+      ;;Assert the initial state
+      (is (and (map? @contact-groups) (empty? @contact-groups)))
+      (rf/dispatch [:load-contact-groups])
+      (is (= {(:group-id test-contact-group) test-contact-group}
+             @contact-groups)))
+
+    (testing ":load-default-contacts! event"
+
+      ;; :load-default-contacts! event dispatches next 5 events
+      ;;
+      ;; :add-contact-groups
+      ;; :add-contacts
+      ;; :add-contacts-to-group
+      ;;TODO :add-chat
+      ;;TODO :load-commands!
+      (rf/dispatch [:load-default-contacts!])
+
+      (rf/dispatch [:set-in [:group/contact-groups "dapps" :timestamp] 0])
+
+      (is (= {"dapps" dapps-contact-group
+              (:group-id test-contact-group) test-contact-group}
+             @contact-groups))
+
+      (testing "it adds a default contact"
+        (is (= demo-bot-contact (get @contacts "demo-bot"))))
+
+      (testing "it adds the console bot"
+        (is (= console-contact (get @contacts "console"))))
+
+      (testing "it does not add any other contact"
+        (is (= 2 (count (keys @contacts))))))
+
+    (def new-contact-public-key "0x048f7d5d4bda298447bbb5b021a34832509bd1a8dbe4e06f9b7223d00a59b6dc14f6e142b21d3220ceb3155a6d8f40ec115cd96394d3cc7c55055b433a1758dc74")
+    (def new-contact-address "5392ccb49f2e9fef8b8068b3e3b5ba6c020a9aca")
+    (def new-contact {:name ""
+                      :photo-path ""
+                      :whisper-identity new-contact-public-key
+                      :address new-contact-address})
+    (def contact (rf/subscribe [:contact-by-identity new-contact-public-key]))
+    (def current-chat-id (rf/subscribe [:get-current-chat-id]))
+
+    (testing ":add-contact-handler event - new contact"
+
+      (rf/dispatch [:set :view-id nil])
+      (rf/dispatch [:set :current-chat-id nil])
+
+      ;; :add-contact-handler event dispatches next 4 events for new contact
+      ;;
+      ;; :add-new-contact-and-open-chat
+      ;; :status-im.contacts.events/add-new-contact
+      ;; :status-im.contacts.events/send-contact-request
+      ;;TODO :start-chat
+
+      (rf/dispatch [:set :contacts/new-identity new-contact-public-key])
+      (rf/dispatch [:add-contact-handler])
+
+      (testing "it returns the new contact from the contact-by-identity sub"
+        (is (= new-contact (assoc @contact :photo-path "" :name ""))))
+
+      (testing "it adds the new contact to the list of contacts"
+        (is (= new-contact
+               (-> @contacts
+                   (get new-contact-public-key)
+                   (assoc :photo-path "" :name "")))))
+
+      (testing "it loads the 1-1 chat"
+        (is (= :chat @view-id)))
+
+      (testing "it adds the new contact to the chat"
+        (is (= new-contact-public-key @current-chat-id))))
+
+    (testing ":contact-request-received event"
+
+      ;; :contact-request-received event dispatches next 3 events
+      ;;
+      ;; :update-contact!
+      ;; :watch-contact
+      ;;TODO :update-chat!
+      (rf/reg-event-db :update-chat! (fn [db _] db))
+      (def received-contact {:name "test"
+                             :profile-image ""
+                             :address new-contact-address
+                             :status "test status"
+                             :fcm-token "0xwhatever"})
+      (def received-contact1 (merge new-contact
+                                    (dissoc received-contact :profile-image)
+                                    {:public-key new-contact-public-key
+                                     :private-key ""}))
+
+      (rf/dispatch [:contact-request-received {:from new-contact-public-key
+                                               :payload {:contact received-contact
+                                                         :keypair {:public new-contact-public-key
+                                                                   :private ""}}}])
+
+      (testing "it adds the new contact to the list of contacts"
+        (is (= received-contact1
+               (get @contacts new-contact-public-key)))))
+
+    (testing ":contact-update-received event"
+
+      ;; :contact-update-received event dispatches next 2 events
+      ;;
+      ;; :update-contact!
+      ;;TODO :update-chat!
+      (let [timestamp (datetime/now-ms)]
+        (def received-contact2 (assoc received-contact1
+                                      :last-updated timestamp
+                                      :status "new status"
+                                      :name "new name"))
+
+        (rf/dispatch [:contact-update-received {:from new-contact-public-key
+                                                :payload {:content {:profile {:profile-image ""
+                                                                              :status "new status"
+                                                                              :name "new name"}}
+                                                          :timestamp timestamp}}]))
+
+      (testing "it updates the contact and set the :last-updated key"
+        (is (= received-contact2
+               (get @contacts new-contact-public-key)))))
+
+    (testing ":hide-contact event"
+
+      ;; :hide-contact event dispatches next 2 events
+      ;;
+      ;; :update-contact!
+      ;;TODO :account-update-keys
+      (rf/reg-event-db :account-update-keys (fn [db _] db))
+
+      (rf/dispatch [:hide-contact @contact])
+
+      (testing "it sets the pending? flag to true"
+        (is (= (assoc received-contact2 :pending? true)
+               (get @contacts new-contact-public-key)))))
+
+    (testing ":add-contact-handler event - :add-pending-contact"
+
+      ;; :add-contact-handler event dispatches next 4 events
+      ;;
+      ;; :add-pending-contact
+      ;; :status-im.contacts.events/add-new-contact
+      ;; :status-im.contacts.events/send-contact-request
+      ;;TODO :discoveries-send-portions
+      (rf/reg-event-db :discoveries-send-portions (fn [db _] db))
+
+      (rf/dispatch [:set :view-id nil])
+      (rf/dispatch [:set :current-chat-id nil])
+      (rf/dispatch [:set :contacts/new-identity new-contact-public-key])
+      (rf/dispatch [:add-contact-handler])
+
+      (testing "it sets the pending? flag to false"
+        (is (= (assoc received-contact2 :pending? false)
+               (get @contacts new-contact-public-key))))
+
+      (testing "it loads the 1-1 chat"
+        (is (= :chat @view-id)))
+
+      (testing "it adds the new contact to the chat"
+        (is (= new-contact-public-key @current-chat-id))))
+
+    (testing ":create-new-contact-group event"
+
+      (def new-group-name "new group")
+      (rf/dispatch [:select-contact new-contact-public-key])
+      (rf/dispatch [:select-contact "demo-bot"])
+      (rf/dispatch [:select-contact "browse"])
+      (rf/dispatch [:deselect-contact "browse"])
+
+      (rf/dispatch [:create-new-contact-group new-group-name])
+
+      (rf/dispatch [:deselect-contact "demo-bot"])
+      (rf/dispatch [:deselect-contact new-contact-public-key])
+      (def new-group-id (->> @contact-groups
+                             (vals)
+                             (filter #(= (:name %) new-group-name))
+                             (first)
+                             (:group-id)))
+      (def new-group {:group-id new-group-id
+                      :name new-group-name
+                      :order 2
+                      :timestamp 0
+                      :contacts [{:identity new-contact-public-key}
+                                 {:identity "demo-bot"}]})
+      (def groups-with-new-group {new-group-id new-group
+                                  "dapps" dapps-contact-group
+                                  (:group-id test-contact-group) test-contact-group})
+      (def groups-with-new-group1 (update groups-with-new-group new-group-id assoc :name "new group name"))
+      (def groups-with-new-group2 (-> groups-with-new-group1
+                                      (update new-group-id assoc :order 1)
+                                      (update "dapps" assoc :order 2)))
+
+      (rf/dispatch [:set-in [:group/contact-groups new-group-id :timestamp] 0])
+
+      (is (= groups-with-new-group @contact-groups)))
+
+    (testing ":set-contact-group-name event"
+
+      (rf/reg-event-db ::prepare-group-name
+                       (fn [db _] (assoc db
+                                         :new-chat-name "new group name"
+                                         :group/contact-group-id new-group-id)))
+
+      (rf/dispatch [::prepare-group-name])
+      (rf/dispatch [:set-contact-group-name])
+
+      (is (= groups-with-new-group1 @contact-groups)))
+
+    (testing ":save-contact-group-order event"
+
+      (rf/reg-event-db ::prepare-groups-order
+                       (fn [db _]
+                         (assoc db :group/groups-order
+                                (->> (vals (:group/contact-groups db))
+                                     (remove :pending?)
+                                     (sort-by :order >)
+                                     (map :group-id)))))
+
+      (rf/dispatch [::prepare-groups-order])
+      (rf/dispatch [:change-contact-group-order 1 0])
+      (rf/dispatch [:save-contact-group-order])
+
+      (is (= groups-with-new-group2 @contact-groups)))
+
+    (testing ":add-selected-contacts-to-group event"
+
+      (rf/dispatch [:select-contact "browse"])
+      (rf/dispatch [:add-selected-contacts-to-group])
+      (rf/dispatch [:deselect-contact "browse"])
+
+      (is (= (update groups-with-new-group2 new-group-id assoc :contacts [{:identity new-contact-public-key}
+                                                                          {:identity "demo-bot"}
+                                                                          {:identity "browse"}])
+             @contact-groups)))
+
+    (testing ":remove-contact-from-group event"
+
+      (rf/dispatch [:remove-contact-from-group "browse" new-group-id])
+
+      (is (= groups-with-new-group2 @contact-groups)))
+
+
+    (testing ":add-contacts-to-group event"
+
+      (rf/dispatch [:add-contacts-to-group new-group-id ["browse"]])
+
+      (is (= (update groups-with-new-group2 new-group-id assoc :contacts [{:identity new-contact-public-key}
+                                                                          {:identity "demo-bot"}
+                                                                          {:identity "browse"}])
+             @contact-groups))
+
+      (rf/dispatch [:remove-contact-from-group "browse" new-group-id]))
+
+    (testing ":delete-contact-group event"
+
+      (rf/dispatch [:delete-contact-group])
+
+      (is (= (update groups-with-new-group2 new-group-id assoc :pending? true)
+             @contact-groups)))))


improve logging

improve logging

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -199,8 +199,8 @@
                           )
                         )
                        candidate-heads))]
-        (log/debug (str "lightning-bolt: #LEXICAL: parent=" (get-in parent [:rule]) ":" (count lexical)))
-        (log/debug (str "lightning-bolt: #PHRASAL: parent=" (get-in parent [:rule]) ":" (count phrasal)))
+        (log/debug (str "lightning-bolt: #lexical children of " (get-in parent [:rule]) ":" (count lexical)))
+        (log/debug (str "lightning-bolt: #phrasal children of " (get-in parent [:rule]) ":" (count phrasal)))
         (if (lexemes-before-phrases)
           (lazy-cat lexical phrasal)
           (lazy-cat phrasal lexical))))))


Sort the records by creator, title, subtitles and name-of-part

also sort using the Swiss german locale

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -3,13 +3,17 @@
   (:require [clj-time
              [coerce :as time.coerce]
              [format :as time.format]]
+            [clojure.data.zip.xml :refer [attr= text xml-> xml1->]]
+            [clojure.java.io :as io]
             [clojure
              [string :as string]
              [xml :as xml]
              [zip :as zip]]
-            [clojure.data.zip.xml :refer [attr= text xml-> xml1->]]
-            [clojure.java.io :as io]
-            [medley.core :refer [assoc-some]]))
+            [medley.core :refer [assoc-some]])
+  (:import java.text.Collator
+           java.util.Locale))
+
+(def ^:private collator (Collator/getInstance (Locale. "de_CH")))

 (def ^:private param-mapping
   "Mapping from Marc21 XML to parameters. See [MARC 21 Format for Bibliographic Data](http://www.loc.gov/marc/bibliographic/)"
@@ -339,12 +343,38 @@
      (mapcat collate-duplicate-items [braille-items musiknoten-items taktile-items])
      others)))

+(defn locale-compare [x y]
+  (cond
+    (and (nil? x) (nil? y)) 0
+    (nil? x) -1
+    (nil? y) 1
+    :else (. collator compare x y)))
+
+(defn- by-vector [v1 v2]
+  (let [c1 (count v1)
+        c2 (count v2)]
+    (cond
+      (< c1 c2) -1
+      (> c1 c2) 1
+      :else (reduce
+             (fn [_ [s1 s2]]
+               (let [comparison (locale-compare s1 s2)]
+                 (if (not= 0 comparison)
+                   (reduced comparison)
+                   comparison)))
+             nil (partition 2 (interleave v1 v2))))))
+
 (defn order-and-group [items]
   (->>
    items
    collate-all-duplicate-items
-   ;; sort by creator, title. If there is no creator then sort just by title
-   (sort-by (juxt #(or (:creator %) (:title %)) :title))
+   ;; sort by creator, title, subtitles and name-of-part. If there is
+   ;; no creator then sort just by title. Likewise if there are no
+   ;; subtitles then sort by name-of-part.
+   (sort-by (juxt #(or (:creator %) (:title %))
+                  :title
+                  #(or (and (:subtitles %) (string/join (:subtitles %))) (:name-of-part %))
+                  :name-of-part) by-vector)
    (reduce
     (fn [m {:keys [format genre sub-genre] :as item}]
       (let [update-keys


clj-time.jdbc fix

clj-time.jdbc fix

--- src/chronojob/sql.clj
+++ src/chronojob/sql.clj
@@ -3,6 +3,7 @@
             [clojure.java.jdbc :as jdbc]
             [clojure.string :as str]
             [clojure.tools.logging :as log]
+            clj-time.jdbc
             [honeysql
              [core :as honey]
              [format :as honey-format]


clarify the need for pluggability of :wrap by custom REPL evaluation environments

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -489,6 +489,8 @@
      (assoc env :ns (ana/get-namespace ana/*cljs-ns*))
      "<cljs repl>"
      form
+     ;; the pluggability of :wrap is needed for older JS runtimes like Rhino
+     ;; where catching the error will swallow the original trace
      ((or (:wrap opts) wrap-fn) form)
      opts)))

@@ -599,7 +601,7 @@
      'load-file load-file-fn
      'clojure.core/load-file load-file-fn
      'load-namespace
-     (fn self
+     (fn selfe
        ([repl-env env form]
         (self env repl-env form nil))
        ([repl-env env [_ ns :as form] opts]


Support for "first time this turn" abilities.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -382,7 +382,10 @@
   (doseq [{:keys [ability] :as e} (get-in @state [:events event])]
     (when-let [card (get-card state (:card e))]
       (when (or (not (:req ability)) ((:req ability) state side card targets))
-        (resolve-ability state side ability card targets)))))
+        (resolve-ability state side ability card targets))))
+  (swap! state update-in [:turn-events] #(cons [event targets] %))
+  ;(system-msg state side (pr-str "EVENTS " (:turn-events @state)))
+  )

 (defn card-init [state side card]
   (let [cdef (card-def card)
@@ -884,7 +887,8 @@
         (trigger-event state side :corp-turn-ends))
       (doseq [a (get-in @state [side :register :end-turn])]
         (resolve-ability state side (:ability a) (:card a) (:targets a)))
-      (swap! state assoc :end-turn true))))
+      (swap! state assoc :end-turn true)
+      (swap! state dissoc :turn-events))))

 (defn purge [state side]
   (let [rig-cards (apply concat (vals (get-in @state [:runner :rig])))
@@ -1140,4 +1144,10 @@
     (system-msg state side "stops looking at his deck and shuffles it")
     (system-msg state side "shuffles his deck")))

+(defn turn-events [state side ev]
+  (mapcat #(rest %) (filter #(= ev (first %)) (:turn-events @state))))
+
+(defn first-event [state side ev]
+  (empty? (turn-events state side ev)))
+
 (load "cards")


fix socket and connection timeout for clojure 1.3

Clojure 1.3 makes numbers Longs by default, where Apache's http client
takes only Integers for numerical settings

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -43,8 +43,10 @@
       (doto http-client
         (set-client-param ClientPNames/COOKIE_POLICY
                           CookiePolicy/BROWSER_COMPATIBILITY)
-        (set-client-param "http.socket.timeout" socket-timeout)
-        (set-client-param "http.connection.timeout" conn-timeout))
+        (set-client-param "http.socket.timeout" (and socket-timeout
+                                                     (Integer. socket-timeout)))
+        (set-client-param "http.connection.timeout" (and conn-timeout
+                                                         (Integer. conn-timeout))))
       (if (nil? (#{"localhost" "127.0.0.1"} server-name))
         (when-let [proxy-host (System/getProperty (str scheme ".proxyHost"))]
           (let [proxy-port (Integer/parseInt


Add missing key attr on shape rendering.

--- frontend/uxbox/shapes.cljs
+++ frontend/uxbox/shapes.cljs
@@ -55,24 +55,25 @@
   (select-keys shape [:width :height :view-box :x :y :cx :cy]))

 (defmethod -render :builtin/icon
-  [{:keys [data] :as shape} attrs]
+  [{:keys [data id] :as shape} attrs]
   (let [attrs (as-> shape $
                 (extract-attrs $)
                 (remove-nil-vals $)
                 (merge $ attrs)
                 (transform-attrs $))]
     (html
-     [:svg attrs data])))
+     [:svg (merge attrs {:key (str id)})
+      data])))

 (defmethod -render :builtin/icon-svg
-  [{:keys [image] :as shape} attrs]
+  [{:keys [image id] :as shape} attrs]
   (let [attrs (as-> shape $
                 (extract-attrs $)
                 (remove-nil-vals $)
                 (merge $ attrs)
                 (transform-attrs $))]
     (html
-     [:svg attrs
+     [:svg (merge attrs {:key (str id)})
       [:image image]])))

 (defmethod -move ::shape


cleanup: move (add-complement-to-bolts) to the only place where it's used

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -13,8 +13,6 @@
 (def concurrent false)
 (declare path-to-map)
 (declare add-complement)
-(declare add-all-complements-to-bolts)
-(declare add-complements-to-bolts)

 (declare lightning-bolt)
 (declare generate-all)
@@ -71,13 +69,17 @@
                   (log/debug (str "generate-all(details): " (show-spec spec)))
                   (let [lb (lightning-bolt (lazy-shuffle grammar)
                                            lexicon
-                                           spec 0 index nil morph)]
+                                           spec 0 index nil morph)
+                        add-complements-to-bolts
+                        (fn [bolts path]
+                          (mapcat #(add-complement % path :top grammar lexicon index morph)
+                                  bolts))]
                     (-> lb
                         ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
-                        (add-complements-to-bolts [:head :head :head :comp] :top grammar lexicon index morph)
-                        (add-complements-to-bolts [:head :head :comp]       :top grammar lexicon index morph)
-                        (add-complements-to-bolts [:head :comp]             :top grammar lexicon index morph)
-                        (add-complements-to-bolts [:comp]                   :top grammar lexicon index morph)))))))
+                        (add-complements-to-bolts [:head :head :head :comp])
+                        (add-complements-to-bolts [:head :head :comp])
+                        (add-complements-to-bolts [:head :comp])
+                        (add-complements-to-bolts [:comp])))))))

 (defn lexemes-before-phrases []
   ;; TODO: take depth as an argument; make phrases decreasingly likely as depth increases.
@@ -108,7 +110,7 @@
   (let [maxdepth 3 ;; maximum depth of a lightning bolt: H1 -> H2 -> H3 where H3 must be a lexeme, not a phrase.
         debug (log/trace (str "lightning-bolt@" depth " grammar:" (string/join ", " (map #(get-in % [:rule]) grammar))))
         depth (if depth depth 0)
-        debug (log/debug (str "looking for candidate head phrases with parent: " (:rule parent)))
+        debug (if parent (log/debug (str "looking for candidate head phrases with parent: " (:rule parent))))

         candidate-heads (filter #(not (fail? %))
                                   (map (fn [rule]
@@ -200,10 +202,11 @@
           (lazy-cat lexical phrasal)
           (lazy-cat phrasal lexical))))))

-(defn add-complement [bolt path spec grammar lexicon cache morph]
+(defn add-complement [bolt path spec grammar lexicon cache morph & [depth]]
   (let [input-spec spec
         from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
         bolt-spec (get-in bolt path :no-path)
+        depth (if depth depth 0)
         spec (unifyc spec bolt-spec)]
     (log/debug (str "add-complement at path: " path " to bolt with bolt:["
                     (if (map? bolt) (get-in bolt [:rule]))
@@ -247,10 +250,9 @@
                         (not (fail? result)))
                       (map (fn [complement]
                              (let [debug (log/debug (str "adding complement to: ["
-                                                         (get-in bolt [:rule]) " "
-                                                         (morph bolt) "]: trying lexical complement:" (morph complement)))
-                                   debug (if (= "" (morph complement))
-                                           (log/error (str "WHY IS IT EMPTY: " complement)))
+                                                         (get-in bolt [:rule]) " '"
+                                                         (morph bolt) "']: "
+                                                         "trying lexical complement:'" (morph complement) "'"))
                                    result
                                    (unify (copy bolt)
                                           (path-to-map path
@@ -335,19 +337,13 @@
                 )

               ;; else, return-val was not empty.
-              (do (log/debug (str "add-complement after adding complement: "
-                                  (morph (first return-val)) ",.."))
+              (do (log/debug (str "first add-complement after adding complement: "
+                                  (morph (first return-val))))
                   return-val)))))

       ;; path doesn't exist in bolt: simply return the bolt unmodified.
       (do
         (list bolt)))))
-
-(defn add-complements-to-bolts [bolts path spec grammar lexicon cache morph]
-  (if (not (empty? bolts))
-    (lazy-cat (if (or true (not (fail? (first bolts)))) ;; experimenting with using (or true ..) to disable this fail? check.
-                (add-complement (first bolts) path spec grammar lexicon cache morph))
-              (add-complements-to-bolts (rest bolts) path spec grammar lexicon cache morph))))

 (defn path-to-map [path val]
   (let [feat (first path)]


move clojurescript-only file to .cljs

move clojurescript-only file to .cljs

--- src/babel/runner.cljc
+++ src/babel/runner.cljc
@@ -1,11 +0,0 @@
-(ns babel.runner
-  (:require #?(:cljs [doo.runner :refer-macros [doo-tests]])
-            [babel.core]))
-
-#?(:cljs (doo-tests 'babel.test.pos))
-;#?(:cljs (doo-tests 'babel.test.de))
-;#?(:cljs (doo-tests 'babel.test.en))
-;#?(:cljs (doo-tests 'babel.test.es))
-;#?(:cljs (doo-tests 'babel.test.fr))
-;#?(:cljs (doo-tests 'babel.test.it))
-;;#?(:cljs (doo-all-tests))


CMR-3703 pr comments

CMR-3703 pr comments

--- umm-spec-lib/src/cmr/umm_spec/validation/related_url.clj
+++ umm-spec-lib/src/cmr/umm_spec/validation/related_url.clj
@@ -84,7 +84,7 @@
   [url-content-type type sub-type]
   (when (and (some #(= type %) (keys (get valid-url-content-types-map url-content-type)))
              (or (nil? sub-type)
-                 (some (partial = sub-type) (get-in valid-url-content-types-map [url-content-type type]))))
+                 (some #(= sub-type %) (get-in valid-url-content-types-map [url-content-type type]))))
     true))

 (defn related-url-type-validation


CMR-3703 pr comments

CMR-3703 pr comments

--- umm-spec-lib/src/cmr/umm_spec/validation/related_url.clj
+++ umm-spec-lib/src/cmr/umm_spec/validation/related_url.clj
@@ -79,7 +79,7 @@
    "DataCenterURL" {"HOME PAGE" []}
    "DataContactURL" {"HOME PAGE" []}})

-(defn valid-url-content-types-combo?
+(defn- valid-url-content-types-combo?
   "Returns true if valid Type and SubType for URLContentType, nil otherwise."
   [url-content-type type sub-type]
   (when (and (some #(= type %) (keys (get valid-url-content-types-map url-content-type)))
@@ -87,7 +87,7 @@
                  (some #(= sub-type %) (get-in valid-url-content-types-map [url-content-type type]))))
     true))

-(defn related-url-type-validation
+(defn- related-url-type-validation
   "Validate the Type and SubType being valid for the accompanying URLContentType"
   [field-path value]
   (let [{:keys [URLContentType Type SubType]} value]