adding support for printing and exporting graph

--- src/anyviz/views.clj
+++ src/anyviz/views.clj
@@ -10,6 +10,7 @@
     [:script {:src "http://ajax.googleapis.com/ajax/libs/jquery/2.0.3/jquery.min.js"}]
     [:script {:src "/static/bootstrap/js/bootstrap.min.js"}]
     [:script {:src "http://code.highcharts.com/highcharts.js"}]
+    [:script {:src "http://code.highcharts.com/modules/exporting.js"}]
     [:link {:href "/static/bootstrap/css/lavish-theme.css" :rel "stylesheet" :media "screen"}]
     [:link {:href "/static/css/anyviz.css" :rel "stylesheet" :media "screen"}]
     [:script {:src "/static/js/query-builder.js"}]


Make the comment example a little better

--- src/themis/core.clj
+++ src/themis/core.clj
@@ -49,7 +49,8 @@
   (def valid-paul [[[:name :first] [(fn [t-map data-point opt-map] (and (= data-point "Paul")
                                                                        {:a 1 :b 2}))]]
                    [[:pets 0 0] [::w-pets {:pet-name-starts ""}]]
-                   [[:*] ['degrandis-pets]]])
+                   ;[[:*] ['degrandis-pets]] ;This is valid, but we can also just write:
+                   [:* 'degrandis-pets]])

   (def normal-paul (query/normalize valid-paul))
   (validation-seq paul normal-paul)


Fix transformation core/reverse-geocode spec

--- backend/specs/akvo/lumen/specs/transformation.clj
+++ backend/specs/akvo/lumen/specs/transformation.clj
@@ -317,13 +317,15 @@
 (create-ns  'akvo.lumen.specs.transformation.reverse-geocode.target)
 (alias 'transformation.reverse-geocode.target 'akvo.lumen.specs.transformation.reverse-geocode.target)

-(s/def ::transformation.reverse-geocode/mergeColumn ::db.dsv.column/columnName)
-(s/def ::transformation.reverse-geocode/geoshapeColumn ::db.dsv.column/columnName)
-
+(s/def ::transformation.reverse-geocode.source/datasetId ::db.dsv/dataset-id)
+(s/def ::transformation.reverse-geocode.source/mergeColumn ::db.dsv.column/columnName)
+(s/def ::transformation.reverse-geocode.source/geoshapeColumn ::db.dsv.column/columnName)
+
 (s/def ::transformation.reverse-geocode/source
   (s/keys
-   :req-un [::transformation.reverse-geocode/mergeColumn
-            ::transformation.reverse-geocode/geoshapeColumn]))
+   :req-un [::transformation.reverse-geocode.source/datasetId
+            ::transformation.reverse-geocode.source/mergeColumn
+            ::transformation.reverse-geocode.source/geoshapeColumn]))

 (s/def ::transformation.reverse-geocode.target/geopointColumn ::db.dsv.column/columnName)
 (s/def ::transformation.reverse-geocode.target/title string?)


fixed the end of the function

fixed the end of the function

--- src/watney/core.clj
+++ src/watney/core.clj
@@ -48,10 +48,7 @@
                            (str "*  " (first (:content node))))
                      (convert-entity (:content node) 0))))
             (remove empty?)
-            (str/join "\n")))
-
-   (str prefix-string
-        (convert-entity html-tree))))
+            (str/join "\n"))))

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


remove target ids from return value of (defn generate-question-and-correct-set)

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -187,8 +187,7 @@
                           (first
                            (db/exec-raw [(str "SELECT source.surface AS source, source.id AS source_id,
                                               ARRAY_AGG(target.surface) AS target,ARRAY_AGG(target.root) AS target_root,
-                                              ARRAY_AGG(source.structure::jsonb) AS target_structure,
-                                              ARRAY_AGG(target.id) AS target_id
+                                              ARRAY_AGG(source.structure::jsonb) AS target_structure
                                         FROM (SELECT surface, source.structure->'synsem'->'sem'
                                                      AS sem,
                                                      source.structure AS structure, source.id
@@ -199,7 +198,7 @@
                                              LIMIT 1) AS source
                                   INNER JOIN (SELECT
                                             DISTINCT surface, target.structure->'synsem'->'sem' AS sem,
-                                                     root, structure, target.id
+                                                     root, structure
                                                 FROM expression_with_root AS target
                                                WHERE target.language=?
                                                  AND target.active=true
@@ -222,16 +221,16 @@
                                 (dissoc :target) ;; aggregate 'target' values into 'targets'
                                 (assoc :targets (read-array (:target result)))

-                                (dissoc :target_id) ;; aggregate targets' ids into 'target_ids'
-                                (assoc :target_ids (read-array (:target_id result)))
-
                                 (dissoc :target_root) ;; targets' roots -> 'target_roots'
                                 (assoc :target_roots (read-array (:target_root result)))

                                 (dissoc :target_structure) ;; targets' structures -> 'target structures'

-                                (and show-target-structures
-                                     (assoc :target_structures (read-array (:target_structure result))))
+                                ((fn [retval]
+                                   (or
+                                    (and show-target-structures
+                                         (assoc :target_structures (read-array (:target_structure result))))
+                                    retval)))

                                 )]
                         retval))))))))))


Add better support ifn protocol on map filter and flat-map

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -228,14 +228,14 @@
   based on a predicate."
   [f ob]
   {:pre [(observable? ob)]}
-  (.filter ob (fn [x] (f x))))
+  (.filter ob #(f %)))

 (defn map
   "Apply a function to each element of an observable
   sequence."
   [f ob]
   {:pre [(observable? ob)]}
-  (.map ob f))
+  (.map ob #(f %)))

 (defn flat-map
   "Projects each element of an observable sequence to
@@ -244,7 +244,7 @@
   into one observable sequence."
   [f ob]
   {:pre [(observable? ob)]}
-  (.flatMap ob f))
+  (.flatMap ob #(f %)))

 (defn skip
   "Bypasses a specified number of elements in an


remove testing funtions (preparing for refactoring of board operations)

--- src/client/core.cljs
+++ src/client/core.cljs
@@ -130,39 +130,6 @@
     (doall (for [x (range 10) y (range 22)]
       (draw-cell ctx x y)))))

-; ------------------------------------------------------------
-; TESTING FUNCTIONS
-; ------------------------------------------------------------
-
-(defn test-rotate-piece!
-  "Clear the board, write the piece at 5, 9, rotate the piece, write the piece at 5, 1,
-    print the board."
-  [piece-key]
-  (clear-board!)
-  (write-piece-to-board! (piece-key pieces) 5 9)
-  (write-piece-to-board! (rotate-piece (piece-key pieces)) 5 1)
-  (draw-board)
-  (print-board))
-
-(defn test-piece!
-  "Clear the board, write a piece at 5,9, and print it."
-  [piece-key x y]
-  (clear-board!)
-  (write-piece-to-board! (piece-key pieces) x y)
-  (draw-board)
-  (print-board))
-
-(defn test-collide-piece!
-  "Test collision."
-  [piece-key x y]
-  (clear-board!)
-  (write-piece-to-board! (:J pieces) 5 9)
-  (println (piece-collide? (piece-key pieces) x y))
-  (println "\n")
-  (write-piece-to-board! (piece-key pieces) x y)
-  (draw-board)
-  (print-board))
-
 (defn auto-refresh
   "Automatically refresh the page whenever a cljs file is compiled."
   []


Don't do a full tree refresh when changing tab selection

--- src/net/sekao/nightcode/projects.clj
+++ src/net/sekao/nightcode/projects.clj
@@ -171,6 +171,20 @@
      (when (= -1 (.getSelectedIndex selection-model))
        (.select selection-model (int 0))))))

+(fdef update-project-tree-selection!
+  :args (s/cat :tree spec/pane? :selection string?))
+(defn update-project-tree-selection! [tree new-selection]
+  (let [selection-model (.getSelectionModel tree)]
+    (loop [tree-items (-> tree .getRoot .getChildren seq)]
+      (when-let [tree-item (first tree-items)]
+        (cond
+          (= new-selection (.getPath tree-item))
+          (.select selection-model tree-item)
+          (u/parent-path? (.getPath tree-item) new-selection)
+          (recur (-> tree-item .getChildren seq))
+          :else
+          (recur (rest tree-items)))))))
+
 (fdef update-project-buttons!
   :args (s/cat :pref-state map? :scene spec/scene?))
 (defn update-project-buttons! [pref-state ^Scene scene]
@@ -181,7 +195,7 @@
       (.setDisable rename-button (not (.isFile file)))
       (.setDisable remove-button
         (and (not (contains? (:project-set pref-state) path))
-          (not (.isFile file)))))))
+             (not (.isFile file)))))))

 (fdef move-project-tree-selection!
   :args (s/cat :scene spec/scene? :diff integer?))
@@ -214,7 +228,7 @@
                     :else new-index)
         project-tree (.lookup scene "#project_tree")]
     (when (pos? (count paths))
-      (update-project-tree! pref-state-atom project-tree (nth paths new-index)))))
+      (update-project-tree-selection! project-tree (nth paths new-index)))))

 (fdef set-selection-listener!
   :args (s/cat :pref-state-atom spec/atom? :runtime-state-atom spec/atom?


DOM style and attr should return style/attribute value or element.

--- src/cljs/c2/dom.cljs
+++ src/cljs/c2/dom.cljs
@@ -122,8 +122,10 @@
   ([el] (throw (js/Error. "TODO: return map of element styles")))
   ([el x] (match [x]
                  [(k :when keyword?)] (gstyle/getComputedStyle el (name k))
-                 [(m :when map?)] (doseq [[k v] m] (style el k v)))
-     el)
+                 [(m :when map?)]
+                 (do
+                   (doseq [[k v] m] (style el k v))
+                   el)))
   ([el k v] (gstyle/setStyle el (name k)
                              (match [v]
                                     [s :when string?] s
@@ -149,11 +151,14 @@
                       (.-value (aget attrs i))]))))
   ([el x] (match [x]
                  [(k :when keyword?)] (.getAttribute el (name k))
-                 [(m :when map?)] (doseq [[k v] m] (attr el k v))))
+                 [(m :when map?)]
+                 (do (doseq [[k v] m] (attr el k v))
+                     el)))
   ([el k v]
      (if (= :style k)
        (style el v)
-       (.setAttribute el (name k) v))))
+       (.setAttribute el (name k) v))
+     el))

 (defn text
   "Get or set element text."


Use channel instead of string concat for jokes

--- src/cljs/server.cljs
+++ src/cljs/server.cljs
@@ -19,15 +19,27 @@
 (defn fetch-some-jokes
   "Fetch some jokes from The Internet Chuck Norris Database up to given limit"
   [max-len]
-  (go
-    (loop [result (<! (fetch-some-joke))]
-      (if (< (count result) max-len)
-        (recur (str result "\n\n" (<! (fetch-some-joke))))
-        result))))
+  (let [c (chan)]
+    (go
+      (loop [len 0]
+        (if (< len max-len)
+          (let [joke (<! (fetch-some-joke))]
+            (put! c joke)
+            (recur (+ len (count joke))))
+          (close! c))))
+    c))

 (defn handler [req res]
   (.writeHead res 200 {"Content-Type" "text/plain"})
-  (go (.end res (<! (fetch-some-jokes 100)))))
+  (let [jokes-chan (fetch-some-jokes 500)]
+    (go
+      (while
+        (when-let [joke (<! jokes-chan)]
+          (.write res joke)
+          ;; (<! (timeout 2000))
+          ;; curl http://127.0.0.1:1337/
+          (.write res "\n\n")))
+      (.end res))))

 (defn server [handler port]
   (-> (.createServer http handler)


Adjust default :improvement-discount

Adjust default :improvement-discount

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -291,7 +291,7 @@
           ;; A vector containing meta-error categories that can be used for parent selection, but
           ;; do not affect total error. See clojush.evaluate for options.

-          :improvement-discount 0.99
+          :improvement-discount 0.5
           ;; The factor by successively older improvements are discounted when calculating
           ;; discounted-case-improvements meta-errors.


[hotfix][tests] Reformat code in nemesis.clj

--- flink-jepsen/src/jepsen/flink/nemesis.clj
+++ flink-jepsen/src/jepsen/flink/nemesis.clj
@@ -130,14 +130,14 @@
 (defn kill-taskmanagers-bursts-gen
   [time-limit]
   (fgen/time-limit time-limit
-                  (gen/seq (cycle (concat (repeat 20 {:type :info, :f :kill-task-managers})
-                                          [(gen/sleep 300)])))))
+                   (gen/seq (cycle (concat (repeat 20 {:type :info, :f :kill-task-managers})
+                                           [(gen/sleep 300)])))))

 (defn kill-jobmanagers-gen
   [time-limit]
   (fgen/time-limit (+ time-limit job-submit-grace-period)
-                  (gen/seq (cons (gen/sleep job-submit-grace-period)
-                                 (cycle [{:type :info, :f :kill-job-manager}])))))
+                   (gen/seq (cons (gen/sleep job-submit-grace-period)
+                                  (cycle [{:type :info, :f :kill-job-manager}])))))

 (defn fail-name-node-during-recovery
   []


fix bugs

fix bugs

--- src/codestat/git.clj
+++ src/codestat/git.clj
@@ -261,7 +261,7 @@
   (map (fn [e] {(key e) (count (val e))})
        (group-by :author_name
                  (distinct
-                   (map #(select-keys % [:author_name :project_id])
+                   (map #(select-keys % [:author_name :vcs_url])
                         (query-commit))))))

@@ -354,6 +354,9 @@

 (defn collect-all-git-log
   [gitlab-server]
+  (println "start collect all git log ...")
   (doseq [project (get-project-git-list (get-project-list gitlab-server))]
-    (collect-git-log project "/tmp/ws")))
-
+    (collect-git-log project "/tmp/ws"))
+  (println "collect done."))
+
+


More clojure way

More clojure way

--- src/control/core.clj
+++ src/control/core.clj
@@ -7,7 +7,7 @@
         [clojure.walk :only [walk postwalk]]))

 (def ^:dynamic *enable-color* true)
-(def ^{:dynamic true} *enable-logging* true)
+(def ^:dynamic *enable-logging* true)
 (def ^:dynamic *debug* false)
 (def ^:private bash-reset "\033[0m")
 (def ^:private bash-bold "\033[1m")
@@ -156,7 +156,7 @@
                           rsync-options
                           [src (str (ssh-client host user) ":" dst)]))))

-(def ^{:dynamic true} *tmp-dir* nil)
+(def ^:dynamic *tmp-dir* nil)

 (defn scp
   "Copy local files to remote machines:


Don't shutdown agents

Don't shutdown agents

--- src/control/core.clj
+++ src/control/core.clj
@@ -305,5 +305,4 @@
                               (do-begin (cons (name includes) (next args)))))))))))

 (defn begin []
-  (do-begin *command-line-args*)
-  (shutdown-agents))
+  (do-begin *command-line-args*))


:bug: Fix proportion locking.

:bug: Fix proportion locking.

--- frontend/src/app/main/data/workspace.cljs
+++ frontend/src/app/main/data/workspace.cljs
@@ -152,8 +152,6 @@
                      (file-initialized project-id file-id))))
        ))))

-
-
 (defn- file-initialized
   [project-id file-id]
   (ptk/reify ::file-initialized
@@ -995,8 +993,6 @@
 ;; Event mainly used for handling user modification of the size of the
 ;; object from workspace sidebar options inputs.

-;; TODO: maybe replace directly with dwc/update-shapes?
-
 (defn update-dimensions
   [ids attr value]
   (us/verify (s/coll-of ::us/uuid) ids)
@@ -1012,17 +1008,14 @@

 (defn set-shape-proportion-lock
   [id lock]
-  (js/alert "TODO: broken")
-  #_(ptk/reify ::set-shape-proportion-lock
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [page-id (:current-page-id state)
-            shape (get-in state [:workspace-data page-id :objects id])]
-        (if-not lock
-          (assoc-in state [:workspace-data page-id :objects id :proportion-lock] lock))
-          (->> (geom/assign-proportions (assoc shape :proportion-lock lock))
-               (assoc-in state [:workspace-data page-id :objects id]))))))
-
+  (ptk/reify ::set-shape-proportion-lock
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (rx/of (dwc/update-shapes [id] (fn [shape]
+                                       (if-not lock
+                                         (assoc shape :proportion-lock false)
+                                         (-> (assoc shape :proportion-lock true)
+                                             (geom/assign-proportions)))))))))
 ;; --- Update Shape Position

 (s/def ::x number?)


Tasks are now given a unique id.  The previous approach of using :dispatch as an id was flawed.

--- src/re_frame_async_flow_fx/core.cljs
+++ src/re_frame_async_flow_fx/core.cljs
@@ -19,7 +19,7 @@
   return the list of tasks which should now be started.
   In effect, given the list of events seen has changed, what is the consequence."
   [rules now-seen-events started-tasks]
-  (->> (remove (comp started-tasks :id) rules)
+  (->> (remove (comp started-tasks :id) rules)   ;; we identify tasks by `:dispatch`
        (filterv (fn [task] ((:when task) (:events task) now-seen-events)))))

@@ -28,19 +28,21 @@
   "Massage the supplied rules as follows:
     - replace `:when` keyword value with a function which implements the predicate
     - ensure that `:dispatch` is always a list and turn  `:done` into the right event
-    - ensure that :events is a set"
+    - ensure that :events is a set
+    - add a unique id"
   [id rules]
   (let [halt-event  [id :halt]
         when->fn {:seen all-events-seen? :all-events-seen all-events-seen? :any-events-seen any-events-seen?}]
     (->> rules
-         (map (fn [{:keys [when events dispatch]}]
-                {:when      #(when->fn when)
-                 :events    (if (seq events) (set events) #{events})
-                 :disptach  (cond
-                              (vector? dispatch)  (list dispatch)
-                              (list? dispatch)    (map (fn [d] (if (= d :halt) halt-event d) dispatch))
-                              (= :halt dispatch)  (list halt-event)
-                              :else  (js/console.error "aync-flow: dispatch value not valid: " dispatch))})))))
+         (map-indexed (fn [index {:keys [when events dispatch]}]
+                        {:id        index
+                         :when      #(when->fn when)
+                         :events    (if (seq events) (set events) #{events})
+                         :disptach  (cond
+                                      (vector? dispatch)  (list dispatch)
+                                      (list? dispatch)    (map (fn [d] (if (= d :halt) halt-event d) dispatch))
+                                      (= :halt dispatch)  (list halt-event)
+                                      :else  (js/console.error "aync-flow: dispatch value not valid: " dispatch))})))))

 (defn make-flow-event-handler
@@ -100,7 +102,7 @@
                     {:keys [seen-events started-tasks]} (get-state db)
                     new-seen-events    (conj seen-events forwarded-event-id)
                     ready-tasks        (newly-startable-tasks rules new-seen-events started-tasks)
-                    ready-task-ids     (->> ready-tasks (map :dispatch) set)
+                    ready-task-ids     (->> ready-tasks (map :id) set)
                     new-started-tasks  (set/union started-tasks ready-task-ids)]
                 {:db       (set-state db new-seen-events new-started-tasks)
                  :dispatch (concat (map :dispatch ready-tasks))}))))


Websocket conn logs: now debug, not info

--- src/riemann/transport/websockets.clj
+++ src/riemann/transport/websockets.clj
@@ -28,7 +28,7 @@
         [lamina.api            :only [bridge-join]]
         [interval-metrics.measure :only [measure-latency]]
         [clojure.java.io       :only [reader]]
-        [clojure.tools.logging :only [info warn]]
+        [clojure.tools.logging :only [info warn debug]]
         [clj-http.util         :only [url-decode]]
         [clojure.string        :only [split]])
   (:import (java.io OutputStream
@@ -171,7 +171,7 @@
   Responsible for routing requests to the appropriate handler."
   (fn handle [ch req]
     (try
-      (info "Websocket connection from" (:remote-addr req)
+      (debug "Websocket connection from" (:remote-addr req)
             (:uri req)
             (:query-string req))


Running experiments

Running experiments

--- src/diabolo/core.clj
+++ src/diabolo/core.clj
@@ -43,15 +43,15 @@

 (defn encoder
-  [{:keys [input-size hidden-size encoder-activation sparsity-weight sparsity-target] :as config}]
+  [{:keys [input-size hidden-size encoder-activation sparsity-weight sparsity-target dropout] :as config}]
   (stack
     ;;(offset :length input-size :delta -0.5)
     (neural-network :inputs input-size
                     :outputs hidden-size
                     :layers 1
-                    ;; :max-weight-length 4.0
-                    :output-op encoder-activation)
-                    ;; :dropout 0.5)
+                    :max-weight-length 7.0
+                    :output-op encoder-activation
+                    :dropout dropout)
     (sparsifier :length hidden-size :weight sparsity-weight)))

@@ -229,14 +229,15 @@

 (def config
   {:input-size      784
-   :hidden-size     400
-   :classifier-size 400
-   :noise-pct       0.3
-   :sparsity-weight 0.3
-   :sparsity-target 0.1
-   :encoder-activation Ops/LOGISTIC
-   :decoder-activation Ops/LOGISTIC
-   :learning-rate 0.001
+   :hidden-size     1000
+   :classifier-size 200
+   :noise-pct       0.2
+   :dropout         0.3
+   :sparsity-weight 0.2
+   :sparsity-target 0.05
+   :encoder-activation Ops/TANH
+   :decoder-activation Ops/TANH
+   :learning-rate 0.0005

    :classes       MNIST-CLASSES
    :train-data    MNIST-DATA
@@ -244,9 +245,9 @@
    :test-data     MNIST-TEST-DATA
    :test-labels   MNIST-TEST-LABELS

-   :ae-train-secs (* 60 5)
-   :mlp-train-secs (* 60 5)
-   :n-reconstructions 25
+   :ae-train-secs (* 60 10)
+   :mlp-train-secs (* 60 10)
+   :n-reconstructions 100
    })

 (def ex (atom nil))


Fixing schema

Fixing schema

--- src/helda/schema.clj
+++ src/helda/schema.clj
@@ -25,7 +25,8 @@
     :model s/Keyword
     :tags [s/Keyword]
     :attrs {s/Keyword s/Any}
-    :parent-id s/Str
+    (s/optional-key :id) s/Str
+    (s/optional-key :parent-id) s/Str
   })

 (s/defschema ModelListener {


CME-3936: Removed dependency

CME-3936: Removed dependency

--- umm-lib/project.clj
+++ umm-lib/project.clj
@@ -10,8 +10,7 @@
                  [nasa-cmr/cmr-spatial-lib "0.1.0-SNAPSHOT"]]

-  :plugins [[test2junit "1.2.1"]
-            [vscode-test "0.1.0-SNAPSHOT"]]
+  :plugins [[test2junit "1.2.1"]]

   ;; The ^replace is done to disable the tiered compilation for accurate benchmarks


pr-str is now used during logging

pr-str is now used during logging

--- src/frontend/ui.cljs
+++ src/frontend/ui.cljs
@@ -65,13 +65,13 @@
    (-> spec
        (update :control #(fn control
                           [model signal dispatch]
-                          (println prefix "signal =" signal)
+                          (println prefix "signal =" (pr-str signal))
                           (% model signal dispatch)))
        (update :reconcile #(fn reconcile
                             [model action]
-                            (println prefix "  action =" action)
+                            (println prefix "  action =" (pr-str action))
                             (let [result (% model action)]
-                              ;(println prefix "   " model)
-                              ;(println prefix "     ->")
-                              ;(println prefix "   " result)
+                              #_(println prefix "   " (pr-str model))
+                              #_(println prefix "     ->")
+                              #_(println prefix "   " (pr-str result))
                               result))))))


planning TODO item (pause)

planning TODO item (pause)

--- src/mantra/core.cljs
+++ src/mantra/core.cljs
@@ -213,8 +213,20 @@
   TODO:
     - 'mute' functionality, stops oscs but also keeps track of their state so
       they can be restarted when 'unmuted'
-    - a generic `play` function that will do the right thing, depending on the types of the arguments
-        e.g. multiple arguments are treated as a sequence of notes, a collection of notes is treated as a chord
-    - higher-level abstractions for pitch and duration, i.e. a G#5 half note at 100 bpm
+    - a generic `play` function that will do the right thing, depending on the
+      types of the arguments
+      e.g. multiple arguments are treated as a sequence of notes, a collection
+      of notes is treated as a chord
+    - higher-level abstractions for pitch and duration, i.e. a G#5 half note at
+      100 bpm
+    - 'pause' functionality -- can add a `pause!` function to chronoid which
+      will take a snapshot of the events currently scheduled (noting their
+      deadlines relative to the current time) and unschedule them, and
+      `unpause!` and/or `toggle-pause!` to re-schedule the saved events
+      relative to the new current time.
+
+      For mantra, should use a combination of chronoid `pause!` and muting any
+      currently active oscillators. When pause is toggled off, the oscillators
+      should be unmuted and the clock un-paused.
 ")


closer still. now just misses the last one...

--- statspop/src/statspop/detection.cljs
+++ statspop/src/statspop/detection.cljs
@@ -57,9 +57,9 @@
         :else (if (>= (count active-region) minsize)
                 (do
                   (println {:stage "run broken, appending to all-regions" :all all-regions :active active-region :item cur-idx :rest remaining})
-                  (recur (conj all-regions active-region) [] (first remaining) (rest remaining)))
+                  (recur (conj all-regions active-region) (conj [] cur-idx) (first remaining) (rest remaining)))
                 (do (println {:stage "run-broken, not appending (too small)" :all all-regions :active active-region :item cur-idx :rest remaining})
-                    (recur all-regions [] (first remaining) (rest remaining))))))))
+                    (recur all-regions (conj [] cur-idx) (first remaining) (rest remaining))))))))

 (def test-lines "123 abc
   foo bar baa


Adding the fuzzystrmatch extension to the documentation on db setup.

- need to automate this at some point

--- src/movertone/db.clj
+++ src/movertone/db.clj
@@ -52,9 +52,10 @@

 ;; prepare search
 ;;-----------------------
-;; http://bartlettpublishing.com/site/bartpub/blog/3/entry/350
-;; CREATE EXTENSION pg_trgm;
-;; CREATE INDEX ragas_name_trigram_idx ON ragas USING gist(name gist_trgm_ops);
+ ;; http://bartlettpublishing.com/site/bartpub/blog/3/entry/350
+ ;; CREATE EXTENSION pg_trgm;
+ ;; create extension fuzzystrmatch;
+ ;; CREATE INDEX ragas_name_trigram_idx ON ragams USING gist(name gist_trgm_ops);

 ;; prepare query
 ;;-----------------------


snapshot: updated get-proxy and calling service

--- src/naojure/core.clj
+++ src/naojure/core.clj
@@ -1,23 +1,23 @@
 (ns naojure.core)

 (def proxy-classes {
-                    :audio-player "com.aldebaran.proxy.ALAudioPlayerProxy"
-                    :backlight-detection "com.aldebaran.proxy.ALBacklightingDetectionProxy"
-                    :battery "com.aldebaran.proxy.ALBatteryProxy"
-                    :behaviour-manager "com.aldebaran.proxy.ALBehaviorManagerProxy"
-                    :darkness-detection "com.aldebaran.proxy.ALDarknessDetectionProxy"
-                    :leds "com.aldebaran.proxy.ALLedsProxy"
-                    :memory "com.aldebaran.proxy.ALMemoryProxy"
-                    :motion "com.aldebaran.proxy.ALMotionProxy"
-                    :navigation "com.aldebaran.proxy.ALNavigationProxy"
-                    :photo-capture "com.aldebaran.proxy.ALPhotoCaptureProxy"
-                    :posture "com.aldebaran.proxy.ALRobotPostureProxy"
-                    :preferences "com.aldebaran.proxy.ALPreferencesProxy"
-                    :sensors "com.aldebaran.proxy.ALSensorsProxy"
-                    :sonar "com.aldebaran.proxy.ALSonarProxy"
-                    :sound-detection "com.aldebaran.proxy.ALSoundDetectionProxy"
-                    :speech-recognition "com.aldebaran.proxy.ALSpeechRecognitionProxy"
-                    :tts "com.aldebaran.proxy.ALTextToSpeechProxy"
+                    :audio-player "ALAudioPlayer"
+                    :backlight-detection "ALBacklightingDetection"
+                    :battery "ALBattery"
+                    :behaviour-manager "ALBehaviorManager"
+                    :darkness-detection "ALDarknessDetection"
+                    :leds "ALLeds"
+                    :memory "ALMemory"
+                    :motion "ALMotion"
+                    :navigation "ALNavigation"
+                    :photo-capture "ALPhotoCapture"
+                    :posture "ALRobotPosture"
+                    :preferences "ALPreferences"
+                    :sensors "ALSensors"
+                    :sonar "ALSonar"
+                    :sound-detection "ALSoundDetection"
+                    :speech-recognition "ALSpeechRecognitionProxy"
+                    :tts "ALTextToSpeechProxy"
                     })

 (def joint-names '("HeadYaw", "HeadPitch",
@@ -44,16 +44,21 @@
 (def FRAME_ROBOT 2)

 ; From http://stackoverflow.com/questions/9167457/in-clojure-how-to-use-a-java-class-dynamically
-(defn construct
-  "Construct an instance of class from class and arguments."
-  [klass & args]
-  (clojure.lang.Reflector/invokeConstructor klass (into-array Object args)))
+;; (defn construct
+;;   "Construct an instance of class from class and arguments."
+;;   [klass & args]
+;;   (clojure.lang.Reflector/invokeConstructor klass (into-array Object args)))
+
+;; (defn make-proxy
+;;   "Build a proxy from a robot and the symbol representing a proxy"
+;;   [robot proxy-sym]
+;;   (construct (Class/forName (proxy-classes proxy-sym))
+;;              (:hostname robot) (:port robot)))

 (defn make-proxy
-  "Build a proxy from a robot and the symbol representing a proxy"
-  [robot proxy-sym]
-  (construct (Class/forName (proxy-classes proxy-sym))
-             (:hostname robot) (:port robot)))
+  "Build a proxy from a session and the symbol for the service"
+  [session proxy-sym]
+  (.service session (proxy-classes proxy-sym)))

 (defn add-proxies
   "Adds the proxies passed as symbols to the robot definition"
@@ -74,6 +79,8 @@
   []
   (com.aldebaran.qimessaging.Application.))

+
+; java function to wait on the future?
 (defn make-session
   "Create a session connected to a robot"
   [hostname port]
@@ -88,6 +95,11 @@
   (let [p (proxy robot)]
     (if (nil? p) (make-proxy robot proxy) p)))

+(defn call-service
+  "Call an operation on a service"
+  [robot proxy-sym operation params]
+  (.call (get-proxy robot proxy-sym) operation (into-array params)))
+
 ;; (defn make-variant
 ;;   "Make instance of Aldebaran ALValue (Variant in java)"
 ;;   [val]
@@ -288,7 +300,7 @@
 (defn say
   "Say something"
   [robot text]
-  (.say (get-proxy robot :tts) text))
+  (.call (get-proxy robot :tts) "say" (into-array [text])))

 (defn get-language
   "Get the currently defined text-to-speech language"


Add handler for login.

Add handler for login.

--- src/ombs/handler.clj
+++ src/ombs/handler.clj
@@ -11,19 +11,29 @@
   "Handler. show index page"
   (view/index ctxt))

-(defn user [params]
+(defn regpage [_] (view/register {}))
+
+(defn log-user [uname]
   "Generate user page, with his name and events."
-  (view/user (:username params))
+  (sess/put! uname)
+  (redirect "/")
   )
-
-(defn regpage [_] (view/register {}))

 (defn register [params]
   (if (core/reg-ok? (params "username") (params "pass1") (params "pass2"))
-    (do
+    ;true
+    (do
       (db/add-user (params "username") (params "pass1") (params "birthdate") (core/rate (params "student-flag")))
-      (sess/put! :username (params "username"))
-      (redirect "/") )
+      (log-user (params "username")) )
+    ;fasle
     (view/register params)
     ))

+
+(defn login [{{uname :username pass :password} :params}]
+  (if  (= pass (:password (db/get-user uname)))
+    (log-user uname)
+    (view/index {:error "wrong login/pass"})
+    )
+  )
+


Move towards applying of infra being a POST

--- src/pedantic/web.clj
+++ src/pedantic/web.clj
@@ -161,6 +161,9 @@
        (app-schedule env name action interval))

   (GET "/:env/apps/:name/apply" [env name]
+       (apply-app-config env name))
+
+  (POST "/:env/apps/:name/apply" [env name]
        (apply-app-config env name)))

 (defroutes routes


updating jdbc-set

updating jdbc-set

--- src/poky/kv/jdbc.clj
+++ src/poky/kv/jdbc.clj
@@ -22,14 +22,11 @@
   (mget* [this b ks]
     (into {} (map (juxt :key :data) (jdbc-mget @conn b ks))))
   (set* [this b k value]
-    (when-let [ret (jdbc-set @conn b k value)]
-      (cond
-        (and (seq? ret) (util/first= ret 1)) :updated
-        (and (seq? ret) (util/first= ret 0)) :rejected
-        (map? ret) :inserted
-        :else false)))
+    (set* this b k value {}))
   (set* [this b k value params]
-    (set* this b k value))
+    (if-let [modified (get params :modified nil)]
+      (jdbc-set @conn b k value modified)
+      (jdbc-set @conn b k value)))
   (delete* [this b k]
     (util/first= (jdbc-delete @conn b k) 1))


Refactored integrity violation tests

Refactored integrity violation tests

--- test/rdf_path_examples/core_test.clj
+++ test/rdf_path_examples/core_test.clj
@@ -37,7 +37,8 @@
         has-constraint-violation? (comp #(ask-query % has-constraint-violation-query)
                                         json-ld->rdf-model
                                         #(ByteArrayInputStream. (.getBytes %))
-                                        :body)]
+                                        :body)
+        response-for-path (comp app (partial generate-examples :body) resource->string)]
     (testing "Requests are sent using HTTP POST"
       (is (= (status-code (generate-examples :method :get)) 405)))
     (testing "Other input MIME types than JSON-LD are not supported"
@@ -52,16 +53,26 @@
       (is (is-400? (generate-examples :params {:selection-method "invalid"}))
           "selection-method must be supported."))
     (testing "RDF path must not be empty"
-      (let [response (app (generate-examples :body (resource->string "no_path.jsonld")))]
-        (is (= (-> response :status) 400))
+      (let [response (response-for-path "no_path.jsonld")]
+        (is (= (:status response) 400))
         (is (has-constraint-violation? response))))
-    (is (is-400? (generate-examples :body (resource->string "missing_edge_property.jsonld")))
-        "Edges of RDF path must have rpath:start, rpath:edgeProperty, and rpath:end.")
-    (is (is-400? (generate-examples :body (resource->string "discontinuous_path.jsonld")))
-        "Paths must be continuous.")
-    (is (is-400? (generate-examples :body (resource->string "start_datatype.jsonld")))
-        "Only edge ends can be datatypes.")
-    (is (is-400? (generate-examples :body (resource->string "missing_type.jsonld")))
-        "Edge starts and ends must have a type.")
-    (is (is-400? (generate-examples :body (resource->string "more_than_1_path.jsonld")))
-        "Only 1 RDF path may be provided.")))
+    (testing "Edges of RDF path must have rpath:start, rpath:edgeProperty, and rpath:end."
+      (let [response (response-for-path "missing_edge_property.jsonld")]
+        (is (= (:status response) 400))
+        (is (has-constraint-violation? response))))
+    (testing "Paths must be continuous."
+      (let [response (response-for-path "discontinuous_path.jsonld")]
+        (is (= (:status response) 400))
+        (is (has-constraint-violation? response))))
+    (testing "Only edge ends can be datatypes."
+      (let [response (response-for-path "start_datatype.jsonld")]
+        (is (= (:status response) 400))
+        (is (has-constraint-violation? response))))
+    (testing "Edge starts and ends must have a type."
+      (let [response (response-for-path "missing_type.jsonld")]
+        (is (= (:status response) 400))
+        (is (has-constraint-violation? response))))
+    (testing "Only 1 RDF path may be provided."
+      (let [response (response-for-path "more_than_1_path.jsonld")]
+        (is (= (:status response) 400))
+        (is (has-constraint-violation? response))))))


♻ Split command handler tests

♻ Split command handler tests

Why:
- We will need multiple tests per command for all the error conditions,
  so it's more convenient to have one deftest per command.

--- test/territory_bro/gis_user_test.clj
+++ test/territory_bro/gis_user_test.clj
@@ -26,18 +26,38 @@

 (use-fixtures :once (join-fixtures [db-fixture process-managers-fixture event-actor-fixture]))

+(def cong-id (UUID. 1 0))
+(def user-id (UUID. 2 0))
+(def test-time (Instant/ofEpochSecond 1))
+
+(def congregation-created {:event/type :congregation.event/congregation-created
+                           :event/version 1
+                           :congregation/id cong-id
+                           :congregation/name "Cong1 Name"
+                           :congregation/schema-name "cong1_schema"})
+(def gis-user-created {:event/type :congregation.event/gis-user-created
+                       :event/version 1
+                       :event/time test-time
+                       :event/user user-id
+                       :congregation/id cong-id
+                       :user/id user-id
+                       :gis-user/username "gis_user_0000000000000001_0000000000000002"
+                       :gis-user/password "secret123"})
+(def gis-user-deleted {:event/type :congregation.event/gis-user-deleted
+                       :event/version 1
+                       :event/time test-time
+                       :event/user user-id
+                       :congregation/id cong-id
+                       :user/id user-id
+                       :gis-user/username "gis_user_0000000000000001_0000000000000002"})
+
 (defn- apply-events [events]
   (testutil/apply-events gis-user/gis-users-view events))

 (deftest gis-users-view-test
+  ;; TODO: reuse the event examples also in this test
   (testing "congregation created"
-    (let [cong-id (UUID. 0 1)
-          user-id (UUID. 0 2)
-          events [{:event/type :congregation.event/congregation-created
-                   :event/version 1
-                   :congregation/id cong-id
-                   :congregation/name "Cong1 Name"
-                   :congregation/schema-name "cong1_schema"}]
+    (let [events [congregation-created]
           expected {::gis-user/congregations
                     {cong-id {:congregation/id cong-id
                               :congregation/schema-name "cong1_schema"}}
@@ -122,73 +142,64 @@
         new-events (gis-user/handle-command command events injections)]
     (events/validate-events new-events)))

-(deftest commands-test
-  (let [cong-id (UUID. 1 0)
-        user-id (UUID. 2 0)
-        test-time (Instant/ofEpochSecond 1)
-        injections {:now (constantly test-time)
+(deftest create-gis-user-test
+  (let [injections {:now (constantly test-time)
                     :generate-password (constantly "secret123")
                     :db-user-exists? (constantly false)}
-        create-command {:command/type :gis-user.command/create-gis-user
-                        :command/time test-time
-                        :command/user user-id
-                        :congregation/id cong-id
-                        :user/id user-id}
-        created-event {:event/type :congregation.event/gis-user-created
-                       :event/version 1
-                       :event/time test-time
-                       :event/user user-id
-                       :congregation/id cong-id
-                       :user/id user-id
-                       :gis-user/username "gis_user_0000000000000001_0000000000000002"
-                       :gis-user/password "secret123"}
-        delete-command {:command/type :gis-user.command/delete-gis-user
-                        :command/time test-time
-                        :command/user user-id
-                        :congregation/id cong-id
-                        :user/id user-id}
-        deleted-event {:event/type :congregation.event/gis-user-deleted
-                       :event/version 1
-                       :event/time test-time
-                       :event/user user-id
-                       :congregation/id cong-id
-                       :user/id user-id
-                       :gis-user/username "gis_user_0000000000000001_0000000000000002"}]
-
-    (testing "create GIS user"
-      (is (= [created-event]
-             (handle-command create-command [] injections))))
-
-    (testing "create is idempotent"
-      (is (empty? (handle-command create-command [created-event] injections))))
-
-    (testing "delete GIS user"
-      (is (= [deleted-event]
-             (handle-command delete-command [created-event] injections)))
-      (is (= [(assoc deleted-event :gis-user/username "foo")]
-             (handle-command delete-command [(assoc created-event :gis-user/username "foo")] injections))
-          "username comes from the created event and is not re-generated"))
-
-    (testing "delete is idempotent"
-      (is (empty? (handle-command delete-command [] injections))
-          "not created")
-      (is (empty? (handle-command delete-command [created-event deleted-event] injections))
-          "already deleted"))
-
-    (testing "create enforces unique usernames"
+        command {:command/type :gis-user.command/create-gis-user
+                 :command/time test-time
+                 :command/user user-id ;; TODO: should be system
+                 :congregation/id cong-id
+                 :user/id user-id}]
+
+    (testing "valid command"
+      (is (= [gis-user-created]
+             (handle-command command [] injections))))
+
+    (testing "enforces unique usernames"
       (let [injections (assoc injections :db-user-exists? (fn [schema]
                                                             (contains? #{"gis_user_0000000000000001_0000000000000002"}
                                                                        schema)))]
-        (is (= [(assoc created-event :gis-user/username "gis_user_0000000000000001_0000000000000002_1")]
-               (handle-command create-command [] injections))))
+        (is (= [(assoc gis-user-created :gis-user/username "gis_user_0000000000000001_0000000000000002_1")]
+               (handle-command command [] injections))))
       (let [injections (assoc injections :db-user-exists? (fn [schema]
                                                             (contains? #{"gis_user_0000000000000001_0000000000000002"
                                                                          "gis_user_0000000000000001_0000000000000002_1"
                                                                          "gis_user_0000000000000001_0000000000000002_2"
                                                                          "gis_user_0000000000000001_0000000000000002_3"}
                                                                        schema)))]
-        (is (= [(assoc created-event :gis-user/username "gis_user_0000000000000001_0000000000000002_4")]
-               (handle-command create-command [] injections)))))))
+        (is (= [(assoc gis-user-created :gis-user/username "gis_user_0000000000000001_0000000000000002_4")]
+               (handle-command command [] injections)))))
+
+    (testing "is idempotent"
+      (is (empty? (handle-command command [gis-user-created] injections))
+          "already created"))
+
+    (testing "recreating"
+      (is (= [gis-user-created]
+             (handle-command command [gis-user-created gis-user-deleted] injections))))))
+
+(deftest delete-gis-user-test
+  (let [injections {:now (constantly test-time)}
+        command {:command/type :gis-user.command/delete-gis-user
+                 :command/time test-time
+                 :command/user user-id ;; TODO: should be system
+                 :congregation/id cong-id
+                 :user/id user-id}]
+
+    (testing "valid command"
+      (is (= [gis-user-deleted]
+             (handle-command command [gis-user-created] injections))))
+
+    (testing "username comes from the gis-user-created event and is not re-generated"
+      (is (= [(assoc gis-user-deleted :gis-user/username "foo")]
+             (handle-command command [(assoc gis-user-created :gis-user/username "foo")] injections))))
+
+    (testing "is idempotent"
+      (is (empty? (handle-command command [] injections))
+          "not created")
+      (is (empty? (handle-command command [gis-user-created gis-user-deleted] injections))
+          "already deleted"))))

 (defn- gis-db-spec [username password]
   {:connection-uri (-> (:database-url config/env)


debug info

debug info

--- src/kvm/provider.clj
+++ src/kvm/provider.clj
@@ -46,7 +46,9 @@
     (with-connection
       (let [image (get-in domain [:image :template]) target (select-keys domain [:name :cpu :ram])]
         (clone-domain connection image target)
+        (debug "clone done")
         (wait-for-status this "running" [5 :minute])
+        (debug "in running state")
         (wait-for-ssh (.ip this) (domain :user) [5 :minute])
          this
         )))
@@ -78,8 +80,10 @@

   (ip [this]
     (with-connection
-      (public-ip connection (domain :user) node (domain :name)))
-    ))
+      (let [ip  (public-ip connection (domain :user) node (domain :name))]
+        (debug "domain public ip is" ip) ip)))
+
+  )

 (defn machine-ts
   "Construcuting machine transformations"


(sub)sets are now in the latte-sets library

--- src/latte/subset.clj
+++ src/latte/subset.clj
@@ -1,289 +0,0 @@
-(ns latte.subset
-  "Set-theoretic notions based on the subset
-  approach of type theory.
-
-  The main idea is to consider a typed variant of
-  a mathematical set as a predicate over a given type.
-
-  In LaTTe what is called a **set** will be technically-speaking
-  a subset of a type, hence a predicate over a given type.
-
-  The main drawback of the approach is that sets
-  are not considered as types (hence type inhabitation
-  and set elemthood are distinct notions).
-
-  The advantage is that it is quite an effective approach in
-  practice,
-  and that it does not require any extension to the kernel
-  such as dependent pairs and sigma-types."
-
-  (:refer-clojure :exclude [and or not set])
-
-  (:require [latte.core :as latte :refer [definition defthm forall assume have proof lambda]])
-
-  (:require [latte.prop :as p :refer [<=> and or not]])
-
-  (:require [latte.equal :as eq :refer [equal]])
-  )
-
-(definition set
-  "The set (or subset of a type) constructor."
-  [[T :type]]
-  (==> T :type))
-
-(definition elem
-  "Set membership."
-  [[T :type] [x T] [s (set T)]]
-  (s x))
-
-(definition subseteq
-  "Subset or equal relation."
-  [[T :type] [s1 (set T)] [s2 (set T)]]
-  (forall [x T]
-    (==> (elem T x s1)
-         (elem T x s2))))
-
-(defthm subseteq-refl
-  "The subset relation is reflexive."
-  [[T :type] [s (set T)]]
-  (subseteq T s s))
-
-(proof subseteq-refl :script
-  (assume [x T
-           H (elem T x s)]
-    (have a (elem T x s) :by H)
-    (have b (==> (elem T x s)
-                 (elem T x s)) :discharge [H a])
-    (have c (subseteq T s s) :discharge [x b])
-    (qed c)))
-
-(defthm subseteq-trans
-  "The subset relation is transitive."
-  [[T :type] [s1 (set T)] [s2 (set T)] [s3 (set T)]]
-  (==> (subseteq T s1 s2)
-       (subseteq T s2 s3)
-       (subseteq T s1 s3)))
-
-(proof subseteq-trans :script
-  (assume [H1 (subseteq T s1 s2)
-           H2 (subseteq T s2 s3)]
-    (assume [x T]
-      (have a (==> (elem T x s1)
-                   (elem T x s2)) :by (H1 x))
-      (have b (==> (elem T x s2)
-                   (elem T x s3)) :by (H2 x))
-      (have c (==> (elem T x s1)
-                   (elem T x s3)) :by ((p/impl-trans (elem T x s1)
-                                                     (elem T x s2)
-                                                     (elem T x s3)) a b))
-      (have d (subseteq T s1 s3) :discharge [x c]))
-    (qed d)))
-
-(definition seteq
-  "Equality on sets."
-  [[T :type] [s1 (set T)] [s2 (set T)]]
-  (and (subseteq T s1 s2)
-       (subseteq T s2 s1)))
-
-(defthm seteq-refl
-  "Set equality is reflexive."
-  [[T :type] [s (set T)]]
-  (seteq T s s))
-
-(proof seteq-refl :script
-  (have a (subseteq T s s) :by (subseteq-refl T s))
-  (have b (and (subseteq T s s)
-               (subseteq T s s))
-        :by ((p/and-intro (subseteq T s s)
-                          (subseteq T s s)) a a))
-  (qed b))
-
-(defthm seteq-sym
-  "Set equality is symmetric."
-  [[T :type] [s1 (set T)] [s2 (set T)]]
-  (==> (seteq T s1 s2)
-       (seteq T s2 s1)))
-
-(proof seteq-sym :script
-  (assume [H (seteq T s1 s2)]
-    (have a (subseteq T s1 s2) :by ((p/and-elim-left (subseteq T s1 s2)
-                                                       (subseteq T s2 s1)) H))
-    (have b (subseteq T s2 s1) :by ((p/and-elim-right (subseteq T s1 s2)
-                                                        (subseteq T s2 s1)) H))
-    (have c (seteq T s2 s1) :by ((p/and-intro (subseteq T s2 s1)
-                                              (subseteq T s1 s2)) b a))
-    (qed c)))
-
-(defthm seteq-trans
-  "Set equality is transitive."
-  [[T :type] [s1 (set T)] [s2 (set T)] [s3 (set T)]]
-  (==> (seteq T s1 s2)
-       (seteq T s2 s3)
-       (seteq T s1 s3)))
-
-(proof seteq-trans :script
-  (assume [H1 (seteq T s1 s2)
-           H2 (seteq T s2 s3)]
-    (have a1 (subseteq T s1 s2) :by ((p/and-elim-left (subseteq T s1 s2)
-                                                      (subseteq T s2 s1)) H1))
-    (have b1 (subseteq T s2 s3) :by ((p/and-elim-left (subseteq T s2 s3)
-                                                      (subseteq T s3 s2)) H2))
-    (have c1 (subseteq T s1 s3) :by ((subseteq-trans T s1 s2 s3) a1 b1))
-    (have a2 (subseteq T s2 s1) :by ((p/and-elim-right (subseteq T s1 s2)
-                                                       (subseteq T s2 s1)) H1))
-    (have b2 (subseteq T s3 s2) :by ((p/and-elim-right (subseteq T s2 s3)
-                                                       (subseteq T s3 s2)) H2))
-    (have c2 (subseteq T s3 s1) :by ((subseteq-trans T s3 s2 s1) b2 a2))
-    (have d (seteq T s1 s3) :by ((p/and-intro (subseteq T s1 s3)
-                                              (subseteq T s3 s1)) c1 c2))
-    (qed d)))
-
-
-(definition union
-  "Set union."
-  [[T :type] [s1 (set T)] [s2 (set T)]]
-  (lambda [x T]
-    (or (elem T x s1)
-        (elem T x s2))))
-
-(defthm union-commute
-  "Set union commutes."
-  [[T :type] [s1 (set T)] [s2 (set T)]]
-  (seteq T
-         (union T s1 s2)
-         (union T s2 s1)))
-
-(proof union-commute :script
-  (assume [x T
-           H (elem T x (union T s1 s2))]
-    (have a1 (or (elem T x s1)
-                 (elem T x s2)) :by H)
-    (have a2 _ :by (p/or-sym (elem T x s1) (elem T x s2)))
-    (have a3 (or (elem T x s2)
-                (elem T x s1)) :by (a2 a1))
-    (have a4 (elem T x (union T s2 s1)) :by a3)
-    (have a5 (==> (elem T x (union T s1 s2))
-                  (elem T x (union T s2 s1))) :discharge [H a4])
-    (have a (subseteq T
-                      (union T s1 s2)
-                      (union T s2 s1)) :discharge [x a5]))
-  (assume [x T
-           H (elem T x (union T s2 s1))]
-    (have b1 (elem T x (union T s1 s2))
-          :by ((p/or-sym (elem T x s2) (elem T x s1)) H))
-    (have b2 (==> (elem T x (union T s2 s1))
-                  (elem T x (union T s1 s2))) :discharge [H b1])
-    (have b (subseteq T
-                      (union T s2 s1)
-                      (union T s1 s2)) :discharge [x b2]))
-  (have c (seteq T
-                 (union T s1 s2)
-                 (union T s2 s1))
-        :by ((p/and-intro (subseteq T (union T s1 s2) (union T s2 s1))
-                          (subseteq T (union T s2 s1) (union T s1 s2)))
-             a b))
-  (qed c))
-
-(definition intersection
-  "Set intersection."
-  [[T :type] [s1 (set T)] [s2 (set T)]]
-  (lambda [x T]
-    (and (elem T x s1)
-         (elem T x s2))))
-
-(defthm intersection-elim-left
-  "Elimination rule for intersection (left operand)."
-  [[T :type] [s1 (set T)] [s2 (set T)] [x T]]
-  (==> (elem T x (intersection T s1 s2))
-       (elem T x s1)))
-
-(proof intersection-elim-left :script
-  (assume [H (elem T x (intersection T s1 s2))]
-    (have a (elem T x s1) :by ((p/and-elim-left (elem T x s1)
-                                                (elem T x s2)) H))
-    (qed a)))
-
-(defthm intersection-elim-right
-  "Elimination rule for intersection (right operand)."
-  [[T :type] [s1 (set T)] [s2 (set T)] [x T]]
-  (==> (elem T x (intersection T s1 s2))
-       (elem T x s2)))
-
-(proof intersection-elim-right :script
-  (assume [H (elem T x (intersection T s1 s2))]
-    (have a (elem T x s2) :by ((p/and-elim-right (elem T x s1)
-                                                 (elem T x s2)) H))
-    (qed a)))
-
-(defthm intersection-commute
-  "Set intersection commutes."
-  [[T :type] [s1 (set T)] [s2 (set T)]]
-  (seteq T
-         (intersection T s1 s2)
-         (intersection T s2 s1)))
-
-(proof intersection-commute :script
-  (assume [x T
-           H (elem T x (intersection T s1 s2))]
-    (have a1 (elem T x (intersection T s2 s1))
-          :by ((p/and-sym (elem T x s1) (elem T x s2)) H))
-    (have a2 (==> (elem T x (intersection T s1 s2))
-                  (elem T x (intersection T s2 s1))) :discharge [H a1])
-    (have a (subseteq T
-                      (intersection T s1 s2)
-                      (intersection T s2 s1)) :discharge [x a2]))
-  (assume [x T
-           H (elem T x (intersection T s2 s1))]
-    (have b1 (elem T x (intersection T s1 s2))
-          :by ((p/and-sym (elem T x s2) (elem T x s1)) H))
-    (have b2 (==> (elem T x (intersection T s2 s1))
-                  (elem T x (intersection T s1 s2))) :discharge [H b1])
-    (have b (subseteq T
-                      (intersection T s2 s1)
-                      (intersection T s1 s2)) :discharge [x b2]))
-  (have c (seteq T
-                 (intersection T s1 s2)
-                 (intersection T s2 s1))
-        :by ((p/and-intro (subseteq T (intersection T s1 s2) (intersection T s2 s1))
-                          (subseteq T (intersection T s2 s1) (intersection T s1 s2)))
-             a b))
-  (qed c))
-
-
-(definition fullset
-  "The full set of a type
-(all the inhabitants of the type are element
-of the full set)."
-  [[T :type]]
-  (lambda [x T] p/truth))
-
-(defthm fullset-intro
-  "Introduction rule for the full set."
-  [[T :type]]
-  (forall [x T]
-    (elem T x (fullset T))))
-
-(proof fullset-intro :script
-  (assume [x T]
-    (have a (elem T x (fullset T)) :by p/truth-is-true)
-    (have b _ :discharge [x a])
-    (qed b)))
-
-(definition emptyset
-  "The empty set of a type."
-  [[T :type]]
-  (lambda [x T] p/absurd))
-
-(defthm emptyset-prop
-  "The main property of the empty set."
-  [[T :type]]
-  (forall [x T]
-    (not (elem T x (emptyset T)))))
-
-(proof emptyset-prop :script
-  (assume [x T
-           H (elem T x (emptyset T))]
-    (have a p/absurd :by H)
-    (have b (not (elem T x (emptyset T))) :discharge [H a])
-    (have c _ :discharge [x b])
-    (qed c)))


optionally allow for a hostname for the http server to bind to in config.json (needed for certain environments)

--- src/server/core.cljs
+++ src/server/core.cljs
@@ -428,7 +428,9 @@
       (.use (.static express (str js/__dirname "/public"))))

     ; start server
-    (.listen server (:port config))
+    (if (:host config)
+      (.listen server (:port config) (:host config))
+      (.listen server (:port config)))
     (util/tlog "t3tr0s server listening on port " (:port config))

     ; wait for next game to start


Show history

Show history

--- src/showkr/form.cljs
+++ src/showkr/form.cljs
@@ -21,7 +21,7 @@
           (d/input (assoc input :id id)))))))

 (q/defcomponent Form
-  [{:keys [form data]} setter]
+  [{:keys [form] :as data} setter]
   (d/form {:className "form-horizontal"
            :onSubmit (fn [e]
                        (.preventDefault e)
@@ -59,14 +59,14 @@
                             :onChange #(setter :set (.. % -target -value))}})

         (d/div {:className "control-group"}
-          (if false
+          (if-not (empty? (:sets data))

             (d/div {:className "controls"}
               "Or select something from your history: "
               (apply d/ul nil
-                (for [[key name] []]
+                (for [[key info] (:sets data)]
                   (d/li nil
-                    (d/a {:href (str "#" key)} name)))))
+                    (d/a {:href (str "#" key)} (:title info))))))

             (d/div {:className "controls"}
               "Or watch an "
@@ -81,7 +81,16 @@
                             :placeholder "User id or username"
                             :tabIndex 2
                             :value (:user form "")
-                            :onChange #(setter :user (.. % -target -value))}})))
+                            :onChange #(setter :user (.. % -target -value))}})
+
+        (if-not (empty? (:users data))
+          (d/div {:className "controls"}
+            "Or browse someone from your history: "
+            (apply d/ul nil
+              (for [[key info] (:users data)]
+                (when (:sets info)
+                  (d/li nil
+                    (d/a {:href (str "#user/" key)} key)))))))))

     (d/div {:className "form-actions"}
       (d/input {:type "submit"


show hello.loop when running jar (temporarily)

--- src/maqueta/core.clj
+++ src/maqueta/core.clj
@@ -1,93 +1,7 @@
 (ns maqueta.core
-  (:use (maqueta application assets))
-  (:import com.jme3.collision.CollisionResults
-           com.jme3.font.BitmapText
-           (com.jme3.math ColorRGBA Ray Vector3f)
-           (com.jme3.scene Node Geometry)
-           (com.jme3.scene.shape Box Sphere))
+  (:require maqueta.hello.loop)
   (:gen-class))

-(defn make-cube
-  [name x y z]
-  (let [box (Box. (Vector3f. x y z) 1 1 1)
-        cube (Geometry. name box)
-        mat (load-material "Common/MatDefs/Misc/Unshaded.j3md")]
-    (.setColor mat "Color" (ColorRGBA/randomColor))
-    (.setMaterial cube mat)
-    cube))
-
-(defn make-floor
-  []
-  (let [box (Box. (Vector3f. 0 -4 -5) 15 0.2 15)
-        floor (Geometry. "the Floor" box)
-        mat (load-material "Common/MatDefs/Misc/Unshaded.j3md")]
-    (.setColor mat "Color" ColorRGBA/Gray)
-    (.setMaterial floor mat)
-    floor))
-
-(def shootables (doto (Node. "Shootables")
-                  (.attachChild (make-cube "a Dragon" -2 0 1))
-                  (.attachChild (make-cube "a tin can" 1 -2 0))
-                  (.attachChild (make-cube "the Sheriff" 0 1 -2))
-                  (.attachChild (make-cube "the Deputy" 1 0 -4))
-                  (.attachChild (make-floor))))
-
-(def mark (let [sphere (Sphere. 30 30 0.2)
-                mark (Geometry. "BOOM!" sphere)
-                mat (load-material "Common/MatDefs/Misc/Unshaded.j3md")]
-            (.setColor mat "Color" ColorRGBA/Red)
-            (.setMaterial mark mat)
-            mark))
-
-(defn shoot
-  [app is-pressed tpf]
-  (if (not is-pressed)
-    (let [root-node (.getRootNode app)
-          results (CollisionResults.)
-          cam (.getCamera app)
-          ray (Ray. (.getLocation cam) (.getDirection cam))]
-      (.collideWith shootables ray results)
-      (println "-----" "Collisions?" (.size results) "-----")
-      (doall (map (fn [i]
-                    (let [collision (.getCollision results i)
-                          dist (.getDistance collision)
-                          pt (.getContactPoint collision)
-                          hit (.getName (.getGeometry collision))]
-                      (println "* Collision #" i)
-                      (println " You shot" hit "at" pt "," dist "wu away.")))
-                  (range (.size results))))
-      (if (> (.size results) 0)
-        (let [closest (.getClosestCollision results)]
-          (.setLocalTranslation mark (.getContactPoint closest))
-          (.attachChild root-node mark))
-        (.detachChild root-node mark)))))
-
-(def on-action {:button-left shoot})
-
-(defn init-cross-hairs
-  [gui-node]
-  (let [font (load-font "Interface/Fonts/Default.fnt")
-        ch (BitmapText. font false)]
-    (.detachAllChildren gui-node)
-    (doto ch
-      (.setSize (* 2 (.getRenderedSize (.getCharSet font))))
-      (.setText "+")
-      (.setLocalTranslation (- (/ (.getWidth *app-settings*) 2)
-                               (* 2
-                                  (/ (.getRenderedSize (.getCharSet font))
-                                     3)))
-                            (+ (/ (.getHeight *app-settings*) 2)
-                               (/ (.getLineHeight ch) 2))
-                            0))
-    (.attachChild gui-node ch)))
-
-(defn setup-fn
-  [app]
-  (let [root-node (.getRootNode app)
-        gui-node (.getGuiNode app)]
-    (init-cross-hairs gui-node)
-    (.attachChild root-node shootables)))
-
-(defn -main [& args]
-  (.start (make-app :setup-fn setup-fn
-                    :on-action on-action)))
+(defn -main
+  [& args]
+  (apply maqueta.hello.loop/-main args))


Make sure we archive each iso properly

Make sure we archive each iso properly

--- src/mdr2/archive.clj
+++ src/mdr2/archive.clj
@@ -59,10 +59,15 @@
 (defn- container-id
   "Return the name of a archive spool directory for a given
   `production` and `sektion`"
-  [production sektion]
-  (case sektion
-    :master (prod/dam-number production)
-    :dist-master (str "ds" (:library_signature production))))
+  ([production sektion]
+   (container-id production sektion nil))
+  ([production sektion volume]
+   (case sektion
+     :master (prod/dam-number production)
+     :dist-master (str "ds" (:library_signature production)
+                       (when (and volume
+                                  (prod/multi-volume? production))
+                         (str "_" volume))))))

 (defn- container-path
   "Return the path to the archive spool directory for a given
@@ -74,10 +79,12 @@
 (defn- container-rdf-path
   "Return the path to the rdf file in the archive spool for a given
   `production` and `sektion`"
-  [production sektion]
-  (let [id (container-id production sektion)
-        rdf-name (str id ".rdf")]
-    (.getPath (file spool-dir id rdf-name))))
+  ([production sektion]
+   (container-rdf-path production sektion nil))
+  ([production sektion volume]
+   (let [path (container-id production sektion)
+         rdf-name (str (container-id production sektion volume) ".rdf")]
+     (.getPath (file spool-dir path rdf-name)))))

 (defn- add-to-db
   "Insert a `production` into the archive db for the given `sektion`.
@@ -85,11 +92,13 @@
   and concludes the archiving process from the point of view of the
   production system."
   [production sektion]
-  (let [new-job
-        {:verzeichnis (container-id production sektion)
-         :sektion (if (= sektion :master) "master" "cdimage")}
-        job (merge default-job new-job)]
-    (jdbc/insert! db :container job)))
+  (let [entries (case sektion :master 2 :dist-master (inc (:volumes production)))]
+    (doseq [volume (range 1 entries)]
+      (let [new-job
+            {:verzeichnis (container-id production sektion volume)
+             :sektion (case :master "master" :dist-master "cdimage")}
+            job (merge default-job new-job)]
+        (jdbc/insert! db :container job)))))

 (defn- copy-files
   "Copy a `production` to the archive spool dir for the given
@@ -103,10 +112,7 @@
         (fs/copy-dir (path/recorded-path production) archive-path)
         :dist-master
         (doseq [volume (range 1 (inc (:volumes production)))]
-          (let [iso-archive-name (str (container-id production :dist-master)
-                                      (when (prod/multi-volume? production)
-                                        (str  "_" volume))
-                                      ".iso")
+          (let [iso-archive-name (str (container-id production sektion volume) ".iso")
                 iso-archive-path (.getPath (file archive-path iso-archive-name))]
             (fs/copy+ (path/iso-name production
                                      (when (prod/multi-volume? production) volume))
@@ -118,8 +124,10 @@
   directory"
   [production sektion]
   (let [rdf (rdf/rdf production)
-        rdf-path (container-rdf-path production sektion)]
-    (spit rdf-path rdf)))
+        entries (case sektion :master 2 :dist-master (inc (:volumes production)))]
+    (doseq [volume (range 1 entries)]
+      (let [rdf-path (container-rdf-path production sektion volume)]
+        (spit rdf-path rdf)))))

 (defn- archive-sektion
   "Archive a `production` for given `sektion`. For the :master sektion


leader heartbeat

leader heartbeat

--- src/tabby/server.clj
+++ src/tabby/server.clj
@@ -131,8 +131,14 @@
           (broadcast-request-vote)))
     state))

+(defn- leader-heartbeat [state]
+  (if (= :leader (:type state))
+    (broadcast-heartbeat state)
+    state))
+
 (defn update [state dt]
-  (swap! state #(-> %1
+   (swap! state #(-> %1
+                    (leader-heartbeat)
                     (update-in [:election-timeout] - dt)
                     (apply-commit-index)
                     (check-election-timeout)))


Adapt bench/dev code to interval tree api changes.

--- dev/bench/core.cljs
+++ dev/bench/core.cljs
@@ -81,33 +81,33 @@

 (defn test-interval
   []
-  (let [tree (doto (it/create)
-               (.add #js [1 5])
-               (.add #js [5 7])
-               (.add #js [-4 -1])
-               (.add #js [-10 -3])
-               (.add #js [-20 -10])
-               (.add #js [20 30])
-               (.add #js [3 9])
-               (.add #js [100 200])
-               (.add #js [1000 2000])
-               (.add #js [6 9])
-               )]
+  (let [tree (it/create)]
+    (it/add tree #js [1 5])
+    (it/add tree #js [5 7])
+    (it/add tree #js [-4 -1])
+    (it/add tree #js [-10 -3])
+    (it/add tree #js [-20 -10])
+    (it/add tree #js [20 30])
+    (it/add tree #js [3 9])
+    (it/add tree #js [100 200])
+    (it/add tree #js [1000 2000])
+    (it/add tree #js [6 9])
+
     (js/console.dir tree #js {"depth" nil})
-    (js/console.log "contains", 4, (.contains tree 4))
-    (js/console.log "contains", 0, (.contains tree 0))
+    (js/console.log "contains", 4, (it/contains tree 4))
+    (js/console.log "contains", 0, (it/contains tree 0))
     ))

 (defn main
   [& [type]]
   (cond
-    (= type "init")
+    (= type "kd-init")
     (bench-init)

-    (= type "knn")
+    (= type "kd-search")
     (bench-knn)

-    (= type "test")
+    (= type "kd-test")
     (test-accuracity)

     (= type "interval")


Cleanup omnibus.util namespace form

Cleanup omnibus.util namespace form


added test cases for :paredit-close-round


use canvas for painting

use canvas for painting

--- src/sormilla/gui.clj
+++ src/sormilla/gui.clj
@@ -1,9 +1,13 @@
 (ns sormilla.gui
-  (:import [java.awt Color Graphics2D]
+  (:require [clojure.java.io :as io])
+  (:import [java.awt Canvas Color Graphics2D Font]
            [java.awt.geom Ellipse2D$Double]
            [javax.swing JFrame JComponent]))

 (set! *warn-on-reflection* true)
+
+(def cutive (with-open [in (io/input-stream (io/resource "CutiveMono-Regular.ttf"))]
+              (Font/createFont Font/TRUETYPE_FONT in)))

 (defn ->safe [throttle f]
   (fn [& args]
@@ -17,32 +21,41 @@
 (defn make-frame [source render & {:keys [interval safe safe-throttle max-size top exit-on-close] :or {interval 50 safe-throttle 500 max-size true}}]
   (let [run (atom true)
         frame (JFrame.)
+        canvas (Canvas.)
         source (if safe (->safe safe-throttle source) source)
         render (if safe (->safe safe-throttle render) render)]
     (if max-size
       (.setExtendedState frame JFrame/MAXIMIZED_BOTH)
-      (.setSize frame 500 500))
+      (.setSize frame 800 500))
     (when top
       (.setAlwaysOnTop frame true))
-    (.setLocationByPlatform frame true)
     (when exit-on-close
       (.setDefaultCloseOperation frame JFrame/EXIT_ON_CLOSE))
+    (.setIgnoreRepaint frame true)
+    (.setIgnoreRepaint canvas true)
+    (.add frame canvas)
+    (.pack frame)
     (.setVisible frame true)
-    (.createBufferStrategy frame 2)
-    (let [strategy (.getBufferStrategy frame)]
+    (.createBufferStrategy canvas 2)
+    (let [strategy (.getBufferStrategy canvas)]
       (future
         (try
           (while (deref run)
-            (when-let [data (source)]
-              (loop [contents-lost? true]
-                (loop [restored? true]
-                  (let [g (.getDrawGraphics strategy)]
-                    (render g (.getWidth frame) (.getHeight frame) data)
-                    (.dispose g))
-                  (when (.contentsRestored strategy) (recur true)))
-                (.show strategy)
-                (when (.contentsLost strategy) (recur true))))
-            (Thread/sleep interval))
+            (let [start (System/currentTimeMillis)
+                  data (source)]
+              (when data
+                (loop [contents-lost? true]
+                  (loop [restored? true]
+                    (let [g (.getDrawGraphics strategy)]
+                      (render g (.getWidth canvas) (.getHeight canvas) data)
+                      (.dispose g))
+                    (when (.contentsRestored strategy) (recur true)))
+                  (.show strategy)
+                  (when (.contentsLost strategy) (recur true))))
+              (let [time-left (- (System/currentTimeMillis) start interval)]
+                #_(println "time-left:" time-left interval)
+                (when (pos? time-left)
+                  (Thread/sleep time-left)))))
           (catch Throwable e
             (println "Oh shit!" e)
             (throw e))))
@@ -61,20 +74,12 @@
   (defn r [^Graphics2D g ^long w ^long h data]
     (.setColor g Color/DARK_GRAY)
     (.fillRect g 0 0 w h)
-    (let [s (min (/ w 1000.0) (/ h 1000.0))]
-      (.translate g (/ w 2.0) (/ h 2.0))
-      (.scale g s s))
-    (doseq [[cx cy r ^Color c] data]
-      (let [d (* 2 r)
-          x (- cx r)
-          y (- cy r)]
-        (.setColor g c)
-        (.fill g (Ellipse2D$Double. (double x) (double y) (double d) (double d))))))
+    (.setColor g Color/RED)
+    (.drawLine g 0 0 w h)
+    (.drawLine g 0 h w 0))

   (defn s []
-    [[0 0 10 Color/GREEN]
-     [-400 -400 50 Color/RED]
-     [400 400 50 Color/BLUE]])
+    "foo")

   (def f (make-frame #'s #'r))
   (close-frame! f))


Fix main function

Fix main function

--- src/storemi/core.clj
+++ src/storemi/core.clj
@@ -5,11 +5,11 @@
     [ring.server.standalone :refer [serve]]
     [storemi.handler :refer [app init]]))

-(defn -main [& port]
+(defn -main [& [port]]
   (serve
     (-> app
         (wrap-file "resources")
         wrap-file-info)
-    {:port (or port 5050)
+    {:port (or (java.lang.Integer. port) 5050)
      :init init
      :join false}))


clojurify the code

clojurify the code

--- src/uglify2/core.clj
+++ src/uglify2/core.clj
@@ -1,16 +1,66 @@
 (ns uglify2.core
+  (:require [clojure.java.io :as io])
   (:import
    [java.io StringWriter]
    [javax.script ScriptEngine ScriptEngineManager ScriptException ScriptEngineFactory]))

+;; see
+;; https://github.com/mishoo/UglifyJS2/issues/122
+;; https://github.com/clojure/clojurescript/blob/c72e9c52156b3b348aa66857830c2ed1f0179e8c/src/main/clojure/cljs/repl/nashorn.clj#L29

-;; https://github.com/mishoo/UglifyJS2/issues/122

-(let [engine (.getEngineByName (ScriptEngineManager.)  "javascript")
-      context (.getContext engine)
+;;;;;;;;;;;;;
+;; Helpers ;;
+;;;;;;;;;;;;;
+
+(defn eval-str
+  "evaluate a string into an engine
+  returns nil - the result is contained in the engine
+  Stolen from ClojureScript"
+  [^ScriptEngine engine ^String s]
+  (.eval engine s))
+
+(defn eval-resource
+  "Evaluate a file on the classpath in the engine."
+  [^ScriptEngine engine path]
+  (let [r (io/resource path)]
+    (eval-str engine (slurp r))
+    (println "loaded: " path)))
+
+(defn js-engine
+  "create a js engine"
+  []
+  (.getEngineByName (ScriptEngineManager.)  "javascript"))
+
+(defn get-context
+  "get the context from an engine"
+  [^ScriptEngine engine]
+  (.getContext engine))
+
+(defn set-writer! [context writer]
+  (.setWriter context writer))
+
+;;;;;;;;;;;;;;;;
+;; Public API ;;
+;;;;;;;;;;;;;;;;
+
+;; (defn minify-str
+;;   "Minify a string"
+;;   [^String s]
+;;   nil)
+
+;; (defn uglify
+;;   "a wrapper around uglifyJS2
+;;   TODO see args"
+;;   [path out-path]
+;;   nil)
+
+
+(let [engine  (js-engine)
+      context (get-context engine)
       writer (StringWriter.)]

-  (.setWriter context writer)
-  (.eval engine "print('hello');")
-  (println (.toString writer))
+  (set-writer! context writer)
+  (eval-str engine "print('hello JS');")
+  (println (str writer))
   )


template project.clj

template project.clj

--- re-view-template/project.clj
+++ re-view-template/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view/lein-template "0.1.3"
+(defproject re-view/lein-template "0.1.4"
   :description "Template for creating re-view apps."
   :url "https://www.github.com/re-view/re-view"
   :license {:name "Eclipse Public License"


ensure that main class is compiled (#821)

--- ssclj/jar/build.boot
+++ ssclj/jar/build.boot
@@ -110,12 +110,14 @@
            (sift :include #{#".*_test\.clj"
                             #".*test_utils\.clj"
                             #"test_helper\.clj"
+                            #".*seeds.*"
                             #".*Test\.java"
                             #".*simu_result.txt"
                             #"config-hsqldb-mem.edn"
                             #"config-hsqldb.edn"
                             #"log4j.properties"}
                  :invert true)
+           (aot :namespace #{'com.sixsq.slipstream.ssclj.app.main})
            (uber :exclude #{ #"(?i)^META-INF/INDEX.LIST$"
                              #"(?i)^META-INF/[^/]*\.(MF|SF|RSA|DSA)$"
                              #".*log4j\.properties" })


make figwheel.cljs reloadable (close #3)

--- cljs/src/dev/plastic/dev/figwheel.cljs
+++ cljs/src/dev/plastic/dev/figwheel.cljs
@@ -8,16 +8,17 @@

 ; note: figwheel does not play well with advanced optimizations, do not include it

-(log "patching figwheel's ns-to-js-file")
-(def original-ns-to-js-file reloading/ns-to-js-file)
-(set! reloading/ns-to-js-file
-  (fn [ns]
-    (let [res (original-ns-to-js-file ns)]
-      (condp = res
-        "goog/string/format.js" "goog/string/stringformat.js"
-        res))))
+(defonce _
+  (let [original-ns-to-js-file reloading/ns-to-js-file]
+    (log "patching figwheel's ns-to-js-file")
+    (set! reloading/ns-to-js-file
+      (fn [ns]
+        (let [res (original-ns-to-js-file ns)]
+          (condp = res
+            "goog/string/format.js" "goog/string/stringformat.js"
+            res))))))

-(def need-loophole? true)
+(defonce need-loophole? true)

 (defn eval [code]
   (if need-loophole?


CMR-195: made changes per Leo's feedback

--- test/cmr/system_int_test/search/collection_campaign_search_test.clj
+++ test/cmr/system_int_test/search/collection_campaign_search_test.clj
@@ -5,7 +5,6 @@
             [cmr.system-int-test.utils.search-util :as search]
             [cmr.system-int-test.utils.index-util :as index]
             [cmr.system-int-test.data2.collection :as dc]
-            [cmr.system-int-test.data2.granule :as dg]
             [cmr.system-int-test.data2.core :as d]))

 (use-fixtures :each (ingest/reset-fixture "CMR_PROV1" "CMR_PROV2"))
@@ -60,11 +59,11 @@
            2 {:campaign "EPI"}
            2 {:campaign "EpI", "options[campaign][ignore_case]" "true"}))
     (testing "search by unique campaign sn terms to get max collections"
-      (is (= 4 (count
-                 (search/find-refs :collection {"campaign[]" ["ESI" "EVI" "EPI" "Esi"]})))))
+       (is (d/refs-match? [coll3 coll4 coll5 coll6]
+                          (search/find-refs :collection {"campaign[]" ["ESI" "EVI" "EPI" "Esi"]}))))
     (testing "search by wild card to get max collections"
-      (is (= 4 (count
-                 (search/find-refs :collection {:campaign "E*", "options[campaign][pattern]" "true"})))))
+      (is (d/refs-match? [coll3 coll4 coll5 coll6]
+                         (search/find-refs :collection {:campaign "E*", "options[campaign][pattern]" "true"}))))
     (testing "search by campaign sn terms ORed"
       (are [expected campaign-kvs] (= expected (count (search/find-refs :collection campaign-kvs)))
            1 {"campaign[]" ["ESI" "EPI" "EVI"], "options[campaign][and]" "true"}


Bump log4j2 dep

Bump log4j2 dep

--- resources/leiningen/new/lambone/common/build.boot
+++ resources/leiningen/new/lambone/common/build.boot
@@ -14,12 +14,12 @@
                           [org.clojure/tools.reader "0.10.0"]
                           [org.clojure/tools.cli "0.3.3"]
                           [org.clojure/tools.logging "0.3.1"]
-                          [org.apache.logging.log4j/log4j-api "2.5" :scope "runtime"]
-                          [org.apache.logging.log4j/log4j-core "2.5" :scope "runtime"]
-                          [org.apache.logging.log4j/log4j-jcl "2.5" :scope "runtime"]
-                          [org.apache.logging.log4j/log4j-jul "2.5" :scope "runtime"]
-                          [org.apache.logging.log4j/log4j-1.2-api "2.5" :scope "runtime"]
-                          [org.apache.logging.log4j/log4j-slf4j-impl "2.5" :scope "runtime"]
+                          [org.apache.logging.log4j/log4j-api "2.6.2" :scope "runtime"]
+                          [org.apache.logging.log4j/log4j-core "2.6.2" :scope "runtime"]
+                          [org.apache.logging.log4j/log4j-jcl "2.6.2" :scope "runtime"]
+                          [org.apache.logging.log4j/log4j-jul "2.6.2" :scope "runtime"]
+                          [org.apache.logging.log4j/log4j-1.2-api "2.6.2" :scope "runtime"]
+                          [org.apache.logging.log4j/log4j-slf4j-impl "2.6.2" :scope "runtime"]
                           [mount "0.1.10"]
                           [robert/hooke "1.3.0"]
                           [cprop "0.1.8"]


Refactored function test-job? in the results module

--- src/emender_jenkins/results.clj
+++ src/emender_jenkins/results.clj
@@ -130,12 +130,17 @@
              :testSummary (test-summary jenkins-url job-name message)
             })))

+(defn test-job?
+    [job-name jobs-prefix preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix]
+    (and (.startsWith job-name jobs-prefix)
+         (or (.endsWith job-name preview-jobs-suffix)
+             (.endsWith job-name stage-jobs-suffix)
+             (.endsWith job-name prod-jobs-suffix))))
+
 (defn filter-test-jobs
     [all-jobs jobs-prefix preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix]
-    (filter #(and (.startsWith (get %1 "name") jobs-prefix)
-                  (or (.endsWith (get %1 "name") preview-jobs-suffix)
-                      (.endsWith (get %1 "name") stage-jobs-suffix)
-                      (.endsWith (get %1 "name") prod-jobs-suffix)))
+    (filter #(test-job? (get %1 "name")
+                        jobs-prefix preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)
             all-jobs))

 (defn read-list-of-test-jobs


Assoc editable to profiles.

Assoc editable to profiles.

--- src-cljs/kixi/hecuba/tabs/hierarchy/profiles.cljs
+++ src-cljs/kixi/hecuba/tabs/hierarchy/profiles.cljs
@@ -59,15 +59,16 @@
              [:h3.text-center category [:br ] [:small timestamp]]]))]))))

 (defn panel-heading [data owner profile title {:keys [add-btn edit-btn]} keys]
-  (let [{:keys [editing adding]} (om/get-state owner)]
+  (let [{:keys [editing adding]} (om/get-state owner)
+        editable (:editable profile)]
     [:div.btn-toolbar
      title
-     (when edit-btn
+     (when (and edit-btn editable)
        [:button {:type "button" :class (str "btn btn-primary btn-xs pull-right "
                                             (when (or adding editing) "hidden"))
                  :on-click (fn [_] (om/set-state! owner :editing true))}
         [:div {:class "fa fa-pencil-square-o"}]])
-     (when add-btn
+     (when (and add-btn editable)
        [:button {:type "button" :class (str "btn btn-primary btn-xs pull-right "
                                             (when (or adding editing) "hidden"))
                  :on-click (fn [_] (om/set-state! owner :adding true))}
@@ -934,7 +935,11 @@
     om/IRender
     (render [_]
       (let [selected-property-id (-> data :active-components :properties)
-            profiles             (sort-by :timestamp (get-profiles selected-property-id data))]
+            properties           (-> data :properties)
+            property             (-> (filter #(= (:entity_id %) selected-property-id) (-> properties :data)) first)
+            editable             (:editable property)
+            profiles             (map #(assoc % :editable editable)
+                                      (sort-by :timestamp (get-profiles selected-property-id data)))]
         (html
          [:div
           [:h3 "Profiles"]


fix consultant ru markup

fix consultant ru markup

--- src/cljs_workcalendar/datasource/consultantru.clj
+++ src/cljs_workcalendar/datasource/consultantru.clj
@@ -47,7 +47,7 @@
                   (:body (http/get url))
                   (catch Exception e ""))
         page (html/html-resource (java.io.StringReader. rawPage))
-        month-calendars (html/select page [:.month-block])]
+        month-calendars (html/select page [:.cal])]
     (mapcat (fn [calendar month-index]
               (extract-non-working-days calendar year month-index))
             month-calendars


CMR-3703 fixes potential bug with setting default Types

--- umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/iso_shared/distributions_related_url.clj
+++ umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/iso_shared/distributions_related_url.clj
@@ -175,7 +175,10 @@
   {:URL (value-of url "gmd:linkage/gmd:URL")
    :Description (:Description types-and-desc)
    :URLContentType (or (:URLContentType types-and-desc) "PublicationURL")
-   ;; Type VIEW RELATED INFORMATION is invalid for many URLContentTypes, so this will fail
-   ;; URLContentType/Type/SubType custom validation for RelatedUrls.
-   :Type (or (:Type types-and-desc) "VIEW RELATED INFORMATION")
+   ;; Types are validated against the URLContentType, so if URLContentType is
+   ;; CollectionURL then use the valid DATA SET LANDING PAGE type, otherwise use
+   ;; VIEW RELATED INFORMATION which is valid for PublicationURL
+   :Type (or (:Type types-and-desc) (if (:URLContentType "CollectionURL")
+                                      "DATA SET LANDING PAGE"
+                                      "VIEW RELATED INFORMATION"))
    :Subtype (:Subtype types-and-desc)}))


Added a :test plan for testing the runs on ec2.


Add test for get-asset-uri combined with a stack

--- spec/io/aviso/twixt_spec.clj
+++ spec/io/aviso/twixt_spec.clj
@@ -247,6 +247,12 @@
           (should= (read-resource-content "expected/bedrock.js")
                    (read-asset-content @asset))))

+    (context "get-asset-uri"
+      (it "always returns the stack asset URI"
+          (should= "/assets/[hash]/stack/bedrock.stack"
+                   (->> (get-asset-uri @twixt-context "stack/bedrock.stack")
+                        remove-hash-from-uri))))
+
     (context "get-asset-uris"

       (it "returns a list of component asset URIs in place of a stack"


more state to reset

more state to reset

--- src-cljs/frontend/state.cljs
+++ src-cljs/frontend/state.cljs
@@ -60,6 +60,7 @@
    :editing-eids    {:editing-eids #{}}
    :show-landing? false
    :overlays []
+   :frontend-id-state nil
    :mouse {}})

 (defn reset-state [state]
@@ -69,7 +70,8 @@
                          :drawing :document/id
                          :subscribers :selected-eids
                          :editing-eids :mouse
-                         :show-landing? :overlays]))))
+                         :show-landing? :overlays
+                         :frontend-id-state]))))

 (def user-path [:current-user])


alias utils.set/select-in to utils/select-in

--- src-cljs/frontend/utils.cljs
+++ src-cljs/frontend/utils.cljs
@@ -13,7 +13,8 @@
             [goog.Uri]
             [goog.events :as ge]
             [goog.net.EventType :as gevt]
-            [sablono.core :as html :include-macros true])
+            [sablono.core :as html :include-macros true]
+            [frontend.utils.seq :as seq-util])
   (:require-macros [frontend.utils :refer (inspect timing defrender)])
   (:import [goog.format EmailAddress]))

@@ -215,3 +216,5 @@
   (let [id (aget x "_rootNodeID")]
     (assert id)
     id))
+
+(def select-in seq-util/select-in)


default port

default port

--- server/src/gratefulplace/server.clj
+++ server/src/gratefulplace/server.clj
@@ -8,4 +8,4 @@
 (defn start
   "Start the jetty server"
   []
-  (run-jetty #'app {:port (config :port) :join? false}))
+  (run-jetty #'app {:port (or (config :port) 8080) :join? false}))


chill stickers

chill stickers

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

--- src/status_im/ui/screens/chat/stickers/views.cljs
+++ src/status_im/ui/screens/chat/stickers/views.cljs
@@ -10,7 +10,8 @@
             [status-im.ui.screens.chat.stickers.styles :as styles]
             [status-im.ui.components.animation :as anim]
             [status-im.utils.contenthash :as contenthash]
-            [status-im.utils.platform :as platform]))
+            [status-im.utils.platform :as platform]
+            [status-im.utils.debounce :as debounce]))

 (def icon-size 28)
 (def icon-horizontal-margin 8)
@@ -48,7 +49,7 @@
      (for [{:keys [hash] :as sticker} stickers]
        ^{:key (str hash)}
        [react/touchable-highlight {:style    {:height 75 :width 75 :margin 5}
-                                   :on-press #(re-frame/dispatch [:chat/send-sticker sticker])}
+                                   :on-press #(debounce/dispatch-and-chill [:chat/send-sticker sticker] 1000)}
         [react/image {:style {:resize-mode :cover :width "100%" :height "100%"}
                       :accessibility-label :sticker-icon
                       :source {:uri (contenthash/url (str "0x" hash))}}]])]]])