Update logging version deps

Update logging version deps

--- backend/project.clj
+++ backend/project.clj
@@ -7,9 +7,9 @@
   :dependencies [[clojurewerkz/scrypt "1.2.0"]
                  [ch.qos.logback/logback-classic "1.2.3"]
                  [org.clojure/tools.logging "0.4.1"]
-                 [org.slf4j/log4j-over-slf4j "1.7.25"]
-                 [org.slf4j/jcl-over-slf4j "1.7.25"]
-                 [org.slf4j/jul-to-slf4j "1.7.25"]
+                 [org.slf4j/log4j-over-slf4j "1.7.26" :exclusions [org.slf4j/slf4j-api]]
+                 [org.slf4j/jcl-over-slf4j "1.7.26" :exclusions [org.slf4j/slf4j-api]]
+                 [org.slf4j/jul-to-slf4j "1.7.26" :exclusions [org.slf4j/slf4j-api]]
                  [cheshire "5.8.0" :exclusions [com.fasterxml.jackson.core/jackson-core]]
                  [clj-http "3.9.0" :exclusions [org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime]]
                  [clj-time "0.14.4"]


fix core/get-template-files to handle only *.clj files

--- src/misaki/core.clj
+++ src/misaki/core.clj
@@ -158,7 +158,8 @@
 (defn get-template-files
   "get all template files(java.io.File) from *template-dir*"
   []
-  (remove #(or (.isDirectory %) (layout-file? %))
+  (remove #(or (.isDirectory %) (layout-file? %)
+               (not (has-extension? ".clj" %)))
           (find-files *template-dir*)))

 ;; COMPILE


code maintenance

code maintenance

--- src/misaki/core.clj
+++ src/misaki/core.clj
@@ -6,13 +6,11 @@
         [pretty-error.core    :only [print-pretty-stack-trace]])
   (:import [java.io File]))

-(declare get-watch-file-extensions)
+;; ## Util

-;; ## Util
 (defn key->sym [k] (symbol (name k)))

 ;; ## Compiler Utilities
-

 ; =stop-compile?
 (defn- stop-compile? [compile-result]
@@ -48,6 +46,12 @@
       (mapcat #(apply call-compiler-fn % fn-sym args) compiler)
       (if-let [f (get compiler fn-sym)] (apply f args)))))

+; =get-watch-file-extensions
+(defn get-watch-file-extensions
+  "Get extensions list to watch."
+  []
+  (map normalize-extension (distinct (call-compiler-fn :-extension))))
+
 ; =handleable-compiler?
 (defn handleable-compiler?
   [compiler file]
@@ -77,12 +81,6 @@

 ;; ## Compiler Functions
-
-; =get-watch-file-extensions
-(defn get-watch-file-extensions
-  "Get extensions list to watch."
-  []
-  (map normalize-extension (distinct (call-compiler-fn :-extension))))

 ; =update-config
 (defn update-config


fix for double auto share.

fix for double auto share.

--- src/oc/storage/api/videos.clj
+++ src/oc/storage/api/videos.clj
@@ -23,7 +23,8 @@
                :existing-board board
                :existing-entry entry}
           updated-entry (entry-res/update-video-data conn video entry)]
-      (when (= (:status updated-entry) "published")
+      (when (and (= (:status updated-entry) "published")
+                 (= (:event_type video) "video_ready"))
         (try
           (entries-api/auto-share-on-publish conn ctx updated-entry)
           (catch Exception e (timbre/error "caught exception: " (.getMessage e)))))
@@ -32,8 +33,10 @@

 (defn- handle-video-webhook [conn ctx]
   (let [body (:data ctx)
-        video (get-in body [:data :video])
-        token (:token video)
+        video-data (get-in body [:data :video])
+        token (:token video-data)
+        event_type (:event_type body)
+        video (assoc video-data :event_type event_type)
         entry (if token
                 (entry-res/get-entry-by-video conn token)
                 false)


added sin, cos, rsin and rcos functions into sandboxed namespace

--- src/clojure/org/turtle/geometry/TurtleGraphics.clj
+++ src/clojure/org/turtle/geometry/TurtleGraphics.clj
@@ -1076,6 +1076,11 @@
                  (intern sandbox-ns 'pen-down pen-down)
                  (intern sandbox-ns 'log log)

+                 (intern sandbox-ns 'cos (fn [x] (Math/cos (deg->rad x))))
+                 (intern sandbox-ns 'sin (fn [x] (Math/sin (deg->rad x))))
+                 (intern sandbox-ns 'rcos (fn [x] (Math/cos (double x))))
+                 (intern sandbox-ns 'rsin (fn [x] (Math/sin (double x))))
+
                  (intern sandbox-ns '** clojure.math.numeric-tower/expt)

                  (intern sandbox-ns


[#1450] Refactor

[#1450] Refactor

--- backend/src/akvo/lumen/lib/import/flow.clj
+++ backend/src/akvo/lumen/lib/import/flow.clj
@@ -13,8 +13,8 @@
   {:internal (:internal-url flow-api)
    :url (:url flow-api)})

-(defn adapter [file version rows-cols col*]
-  col*)
+(defn adapter [{:keys [version rows-cols instance survey-id form-id]} data]
+  data)

 (defmethod import/dataset-importer "AKVO_FLOW"
   [{:strs [instance surveyId formId token email version] :as spec}
@@ -31,10 +31,14 @@
       p/DatasetImporter
       (columns [this]
         (try
-          (let [res (cond
-                  (<= version 2) (v2/dataset-columns (flow-common/form @survey formId) environment)
-                  (<= version 3) (v3/dataset-columns (flow-common/form @survey formId) environment))]
-            (adapter (format "%s-%s-%s" instance surveyId formId) 3 :cols res))
+          (let [data (cond
+                       (<= version 2) (v2/dataset-columns (flow-common/form @survey formId) environment)
+                       (<= version 3) (v3/dataset-columns (flow-common/form @survey formId) environment))]
+            (adapter {:version 3
+                      :rows-cols :cols
+                      :instance instance
+                      :survey-id surveyId
+                      :form-id formId} data))
           (catch Throwable e
             (if-let [ex-d (ex-data e)]
               (do
@@ -49,10 +53,14 @@
               (throw e)))))
       (records [this]
         (try
-          (let [res (cond
-                      (<= version 2) (v2/form-data headers-fn @survey formId)
-                      (<= version 3) (v3/form-data headers-fn instance @survey formId))]
-            (adapter (format "%s-%s-%s" instance surveyId formId) 3 :rows res))
+          (let [data (cond
+                       (<= version 2) (v2/form-data headers-fn @survey formId)
+                       (<= version 3) (v3/form-data headers-fn instance @survey formId))]
+            (adapter {:version 3
+                      :rows-cols :rows
+                      :instance instance
+                      :survey-id surveyId
+                      :form-id formId} data))
           (catch Throwable e
             (if-let [ex-d (ex-data e)]
               (throw (ex-info (or (:cause e) (str "Null cause from instance: " instance))
@@ -84,9 +92,12 @@
                                                          :groupName groupName
                                                          :key false
                                                          :hidden true}))
-                res (apply conj columns new-columns)]
-            (adapter (format "%s-%s-%s" instance surveyId formId) 4 :cols res)
-            )
+                data (apply conj columns new-columns)]
+            (adapter {:version 4
+                      :rows-cols :cols
+                      :instance instance
+                      :survey-id surveyId
+                      :form-id formId} data))
           (catch Throwable e
             (if-let [ex-d (ex-data e)]
               (do
@@ -101,8 +112,12 @@
               (throw e)))))
       (records [this]
         (try
-          (let [res (v4/form-data headers-fn instance @survey formId)]
-            (adapter (format "%s-%s-%s" instance surveyId formId) 4 :rows res))
+          (let [data (v4/form-data headers-fn instance @survey formId)]
+              (adapter {:version 4
+                      :rows-cols :rows
+                      :instance instance
+                      :survey-id surveyId
+                      :form-id formId} data))
           (catch Throwable e
             (if-let [ex-d (ex-data e)]
               (throw (ex-info (or (:cause e) (str "Null cause from instance: " instance))


filter :repl/out :repl/err

filter :repl/out :repl/err

otherwise messages the client sent end up on the client again
which isn't interested in them

--- src/main/shadow/cljs/devtools/server/worker/ws.clj
+++ src/main/shadow/cljs/devtools/server/worker/ws.clj
@@ -67,6 +67,8 @@
         ;; no need to forward :build-log messages to the client
         watch-ignore
         #{:build-log
+          :repl/out
+          :repl/err
           :repl/result
           :repl/error ;; server-side error
           :repl/action


CMR-2446 Fix some indentation after updating if-not in lisp paredit

--- common-app-lib/src/cmr/common_app/services/search/parameter_validation.clj
+++ common-app-lib/src/cmr/common_app/services/search/parameter_validation.clj
@@ -155,16 +155,16 @@
              (map
               (fn [[param settings]]
                 (if-not (map? settings)
-                        [(msg/invalid-settings-for-param param settings)]
-                        ;; handle these parameters separately since they don't allow any options
-                        (if (always-case-sensitive-fields param)
-                          (map #(msg/invalid-opt-for-param param %) (keys settings))
-                          (let [valid-options (valid-options param)]
-                            ;; Only check params we recognize - other validations will handle the rest
-                            (when valid-options
-                              (map #(msg/invalid-opt-for-param param %)
-                                   (set/difference (set (keys settings))
-                                                   valid-options)))))))
+                  [(msg/invalid-settings-for-param param settings)]
+                  ;; handle these parameters separately since they don't allow any options
+                  (if (always-case-sensitive-fields param)
+                    (map #(msg/invalid-opt-for-param param %) (keys settings))
+                    (let [valid-options (valid-options param)]
+                      ;; Only check params we recognize - other validations will handle the rest
+                      (when valid-options
+                        (map #(msg/invalid-opt-for-param param %)
+                             (set/difference (set (keys settings))
+                               valid-options)))))))
               options)))))

 (defmulti valid-sort-keys


Just a small cleanup.

Just a small cleanup.

--- EkekoAspectJ/src/damp/ekeko/aspectj/assumptions.clj
+++ EkekoAspectJ/src/damp/ekeko/aspectj/assumptions.clj
@@ -186,7 +186,6 @@

 ;;===========================================================================================

-;; code is in AJ-LMP-RefineUsedPointcut
 ;;paper 3.1.1 assumption 6
 (defn
   refine|used|pointcut-sub-super


Move `nomis-pp-classpath` within its file


Добавление новых опций в search-view

Добавление новых опций в search-view

--- radiolamp-6P3S/src/ixinfestor/omut.cljs
+++ radiolamp-6P3S/src/ixinfestor/omut.cljs
@@ -1912,7 +1912,8 @@
                            data-rendering-fn
                            add-button-fn
                            tools-top
-                           tools]
+                           tools
+                           show-search-input?]
                     :or   {input-placeholder "введите сюда поисковый запрос"
                            data-update-fn    (fn [app]
                                                (println "Неопределена функция запроса обновления данных (data-update-fn [app] ...)")
@@ -1920,7 +1921,7 @@
                            data-rendering-fn (fn [app]
                                                (println "Неопределена функция запроса перерисовки данных (data-rendering-fn [app] ...)")
                                                (println "параметр на входе: " (str app)))
-                           }}]
+                           show-search-input? true}}]
   (reify
     om/IInitState
     (init-state [_]
@@ -1952,52 +1953,53 @@

         (when tools-top tools-top)

-        (dom/div #js {:className "input-group col-xs-12 col-sm-12 col-md-12 col-lg-12" :style #js {:marginBottom 6}}
-                 (dom/span #js {:className "input-group-btn"}
-                           (ui-button {:type     :default
-                                       :on-click (fn [_]
-                                                   (om/update! app :page 1)
-                                                   (om/update! app [:fts-query :value] "")
-                                                   (put! chan-update 1)
-                                                   1)
-                                       :text     (dom/span #js {:className   "glyphicon glyphicon-remove"
-                                                                :aria-hidden "true"})
-                                       }))
-                 (om/build input (:fts-query app)
-                           {:opts {:placeholder   input-placeholder
-                                   :onKeyPress-fn #(do #_(println
-                                                          (.-type %)
-                                                          (.-which %)
-                                                          (.-timeStamp %))
-
-                                                       (when (= 13 (.-which %))
-                                                         (do
-                                                           (om/update! app :page 1)
-                                                           (put! chan-update 1)))
-                                                       1)
-                                   }})
-
-                 (dom/span #js {:className "input-group-btn"}
-                           (ui-button {:type     :success
-                                       :on-click (fn [_]
-                                                   (om/update! app :page 1)
-                                                   (put! chan-update 1)
-                                                   1)
-                                       :text     (dom/span #js {:className   "glyphicon glyphicon-search"
-                                                                :aria-hidden "true"})
-                                       })
-
-                           (when add-button-fn
-                             (ui-button {:type     :danger
+        (when show-search-input?
+          (dom/div #js {:className "input-group col-xs-12 col-sm-12 col-md-12 col-lg-12" :style #js {:marginBottom 6}}
+                   (dom/span #js {:className "input-group-btn"}
+                             (ui-button {:type     :default
                                          :on-click (fn [_]
-                                                     (add-button-fn)
+                                                     (om/update! app :page 1)
+                                                     (om/update! app [:fts-query :value] "")
+                                                     (put! chan-update 1)
                                                      1)
-                                         :text     (dom/span #js {:className   "glyphicon glyphicon-plus"
+                                         :text     (dom/span #js {:className   "glyphicon glyphicon-remove"
                                                                   :aria-hidden "true"})
                                          }))
-
-                           )
-                 )
+                   (om/build input (:fts-query app)
+                             {:opts {:placeholder   input-placeholder
+                                     :onKeyPress-fn #(do #_(println
+                                                            (.-type %)
+                                                            (.-which %)
+                                                            (.-timeStamp %))
+
+                                                         (when (= 13 (.-which %))
+                                                           (do
+                                                             (om/update! app :page 1)
+                                                             (put! chan-update 1)))
+                                                         1)
+                                     }})
+
+                   (dom/span #js {:className "input-group-btn"}
+                             (ui-button {:type     :success
+                                         :on-click (fn [_]
+                                                     (om/update! app :page 1)
+                                                     (put! chan-update 1)
+                                                     1)
+                                         :text     (dom/span #js {:className   "glyphicon glyphicon-search"
+                                                                  :aria-hidden "true"})
+                                         })
+
+                             (when add-button-fn
+                               (ui-button {:type     :danger
+                                           :on-click (fn [_]
+                                                       (add-button-fn)
+                                                       1)
+                                           :text     (dom/span #js {:className   "glyphicon glyphicon-plus"
+                                                                    :aria-hidden "true"})
+                                           }))
+
+                             )
+                   ))

         ;;(dom/br nil)
         (when tools tools)


Secret api to change the refresh timer

Secret api to change the refresh timer

--- src/cljs/app/ghoul/worker_api.cljs
+++ src/cljs/app/ghoul/worker_api.cljs
@@ -3,7 +3,7 @@
   (:require [ghoul.state :as state]
             [cljs.core.async :as async :refer [<! timeout]]))

-(def refresh-time-milis (* 5 60 1000))
+(def refresh-time-milis (atom (* 5 60 1000)))
 (def update-feed-worker (atom nil))

 (defn feed-update [event]
@@ -11,7 +11,7 @@
     (if (= (:result result) "ok")
       (state/include-feed (:data result)))))

-(defn ^:export read-feed [uid url]
+(defn read-feed [uid url]
   (.log js/console (str "Updating: " uid ", " url))
   (set! (.-onmessage @update-feed-worker) feed-update)
   (.postMessage @update-feed-worker #js {:action "update" :uid uid :url url}))
@@ -24,9 +24,13 @@
             url (second cur-uid-url)]
         (read-feed uid url)))))

-(defn start-feed-worker []
+(defn ^:export start-feed-worker []
   (reset! update-feed-worker (js/Worker. "js/worker.js"))
   (go-loop []
     (update-all-feeds)
-    (<! (timeout refresh-time-milis))
+    (<! (timeout @refresh-time-milis))
+    (.log js/console "Updating feeds")
     (recur)))
+
+(defn ^:export refresh-timer [new-timer]
+  (reset! refresh-time-milis new-timer))


Make form disappear after sending reset link

--- src/cljs/salava/user/ui/reset.cljs
+++ src/cljs/salava/user/ui/reset.cljs
@@ -14,7 +14,9 @@
       (path-for "/obpv1/user/reset/")
       {:params  {:email email}
        :handler (fn [data]
-                  (swap! state assoc :reset-link-sent (:status data)))})))
+                  (do
+                    (swap! state assoc :reset-link-sent (:status data))
+                    (swap! state assoc :form-display "none")))})))

 (defn content [state]
   (let [email-atom (cursor state [:email])]
@@ -27,7 +29,7 @@
                                                   (t :user/Passwordresetlinksent) ": " (:email @state)]
          (= "error" (:reset-link-sent @state)) [:div {:class "alert alert-warning" :role "alert"}
                                                 (t :user/Errorsendingresetlink)])
-       [:form
+       [:form {:style {:display (:form-display @state)}}
         [:div.form-group
          [:label {:for "input-email"} (t :user/Emailaddress)]
          [input/text-field {:name "email" :atom email-atom}]]
@@ -38,7 +40,8 @@

 (defn handler [site-navi params]
   (let [state (atom {:email ""
-                     :reset-link-sent nil})
+                     :reset-link-sent nil
+                     :form-display "block"})
         lang (:lang params)]
     (if (and lang (some #(= lang %) (session/get :languages)))
       (session/assoc-in! [:user :language] lang))


fix formatting

fix formatting

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -613,15 +613,15 @@
             :let [existing-assignment (get existing-assignments topology-id)
                   topology-details (.getById topologies topology-id)]]
       (if (= existing-assignment assignment)
-      (log-debug "Assignment for " topology-id " hasn't changed")
-      (do
-        (log-message "Setting new assignment for topology id " topology-id ": " (pr-str assignment))
-        (.set-assignment! storm-cluster-state topology-id assignment)
-        (.assignSlots ^INimbus (:inimbus nimbus)
-                      (for [[id port] (newly-added-slots existing-assignment assignment)]
-                        (WorkerSlot. id port))
-                      topology-details)
-        )))))
+        (log-debug "Assignment for " topology-id " hasn't changed")
+        (do
+          (log-message "Setting new assignment for topology id " topology-id ": " (pr-str assignment))
+          (.set-assignment! storm-cluster-state topology-id assignment)
+          (.assignSlots ^INimbus (:inimbus nimbus)
+                        (for [[id port] (newly-added-slots existing-assignment assignment)]
+                          (WorkerSlot. id port))
+                        topology-details)
+          )))))

 (defn- start-storm [nimbus storm-name storm-id]
   (let [storm-cluster-state (:storm-cluster-state nimbus)


fix race condition - ensure that scheduling code is not called concurrently (this was a regression)

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -735,7 +735,8 @@
                         (conf NIMBUS-MONITOR-FREQ-SECS)
                         (fn []
                           (when (conf NIMBUS-REASSIGN)
-                            (mk-assignments nimbus))
+                            (locking (:submit-lock nimbus)
+                              (mk-assignments nimbus)))
                           (do-cleanup nimbus)
                           ))
     ;; Schedule Nimbus inbox cleaner


cleanup handler

cleanup handler

--- src/cljs/swarmpit/component/handler.cljs
+++ src/cljs/swarmpit/component/handler.cljs
@@ -1,31 +0,0 @@
-(ns swarmpit.component.handler
-  (:refer-clojure :exclude [get])
-  (:require [ajax.core :as ajax]
-            [swarmpit.component.state :as state]
-            [swarmpit.storage :as storage]
-            [clojure.walk :refer [keywordize-keys]]
-            [clojure.string :as str :refer [capitalize]]))
-
-(defn- resource
-  [handler]
-  (first (str/split (name handler) "-")))
-
-(defn- execute
-  ([success-fx error-fx]
-   {:headers       {"Authorization" (storage/get "token")}
-    :handler       (fn [response]
-                     (let [resp (keywordize-keys response)]
-                       (-> resp success-fx)))
-    :error-handler (fn [response]
-                     (let [resp (keywordize-keys response)]
-                       (-> resp error-fx)))}))
-
-(defn get
-  ([api success-fx]
-   (get api success-fx (fn [{:keys [status]}]
-                         (if (= status 401)
-                           (state/set-value {:handler :unauthorized} [:location])
-                           (state/set-value {:handler :error} [:location])))))
-  ([api success-fx error-fx]
-   (ajax/GET api
-             (execute success-fx error-fx))))


Add :new-instruction-diversifying and :new-size-diversifying

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1081,6 +1081,21 @@
              (not= errs (take (count errs) (:parent2-errors argmap))))))
     (assoc ind :diversifying true)))

+(defn new-instruction-diversifying?
+  [ind {:keys [parent1-genome parent2-genome] :as argmap}]
+  (let [child-instructions (set (map :instruction (:genome ind)))
+        parent-instructions (set (map :instruction
+                                      (concat parent1-genome parent2-genome)))]
+    (assoc ind :diversifying
+      (not (empty? (clojure.set/difference child-instructions parent-instructions))))))
+
+(defn new-size-diversifying?
+  [ind {:keys [parent1-genome parent2-genome] :as argmap}]
+  (let [child-size (count (:genome ind))]
+    (assoc ind :diversifying
+      (and (not= child-size (count parent1-genome))
+           (not= child-size (count parent2-genome))))))
+
 (defn diversifying?
   "Returns ind with :diversifying set to true if it staisfies all test
   specified in (:autoconstructive-diversification-test argmap), or false
@@ -1108,6 +1123,8 @@
                 :not-a-clone not-a-clone-diversifying?
                 :minimum-genetic-difference minimum-genetic-difference-diversifying?
                 :different-errors different-errors-diversifying?
+                :new-instruction-diversifying new-instruction-diversifying?
+                :new-size-diversifying new-size-diversifying?
                 :none (fn [ind argmap] i))
               i
               argmap)
@@ -1171,3 +1188,4 @@

+


CMR-4558 Fix accidental syntax error

CMR-4558 Fix accidental syntax error

--- search-app/src/cmr/search/site/data.clj
+++ search-app/src/cmr/search/site/data.clj
@@ -91,7 +91,7 @@
         result (query-exec/execute-query context query)]
     (sort-by :entry-title (:items result))))

-(defn-timed collection-data :default
+(defmethod collection-data :default
   [context tag provider-id]
   (get-collection-data context tag provider-id))


CMR-2854 Removes unused bindings in test

--- access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
@@ -428,12 +428,7 @@
         acl9 (ingest-acl token (assoc-in (assoc (catalog-item-acl "All Granules PROV2")
                                                 :group_permissions
                                                 [{:group_id (:concept_id group2) :permissions ["create"]}])
-                                         [:catalog_item_identity :provider_id] "PROV2"))
-
-        first-result [acl7]
-        second-result [acl4 acl7]
-        third-result [acl4 acl5 acl6 acl7 acl9]
-        group2-concept-id (:concept_id group2)]
+                                         [:catalog_item_identity :provider_id] "PROV2"))]
     (u/wait-until-indexed)
     (testing "Search with every criteria"
       (are3 [params acls]


pixelfont example

pixelfont example

--- examples/pixelfont/src/pixelfont/core.cljs
+++ examples/pixelfont/src/pixelfont/core.cljs
@@ -19,14 +19,15 @@
   (go
     (<! (r/load-resources canvas :bg ["img/fonts.png"]))

-    (pf/pixel-font :big "img/fonts.png" [127 84] [250 128]
+    (pf/pixel-font :big "img/fonts.png" [127 84] [500 128]
                    :chars ["ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                            "abcdefghijklmnopqrstuvwxyz"
                            "0123456789!?#`'.,"])

     (m/with-sprite canvas :bg
-      [text (pf/make-text :big "TestWordage")]
+      [text (pf/make-text :big "The quick brown fox jumped over the lazy sequence!"
+                          {"fo" -2  "ro" -1 "la" -1 })]
       (while true (<! (e/next-frame)))
       )


CMR-1294: Fixed spelling in docstring

CMR-1294: Fixed spelling in docstring

--- metadata-db-app/src/migrations/012_add_granule_index_with_revision_date.clj
+++ metadata-db-app/src/migrations/012_add_granule_index_with_revision_date.clj
@@ -11,7 +11,7 @@
     (h/sql (format "create index %s_crddr on %s (concept_id, revision_id, deleted, delete_time, revision_date)"))
     (h/sql (format "drop index %s_crdi" t))))
 (defn down
-  "Migrates the database down from vedrsion 12."
+  "Migrates the database down from version 12."
   []
   (println "migrations.012-add-granule-index-with-revision-date down...")
   (doseq [t (h/get-granule-tablenames)]


use contains? in function position

use contains? in function position

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -429,7 +429,7 @@
       [:div.logomark
        (common/ico :logo)]]

-     [:a.aside-item {:class (when (dashboard-subpages current-route) "current")
+     [:a.aside-item {:class (when (contains? dashboard-subpages current-route) "current")
                      :data-placement "right"
                      :data-trigger "hover"
                      :title "Builds"
@@ -439,7 +439,7 @@
       [:div.nav-label "Builds"]]

      (when (feature/enabled? :workflows-poc)
-       [:a.aside-item {:class (when (workflows-subpages current-route) "current")
+       [:a.aside-item {:class (when (contains? workflows-subpages current-route) "current")
                        :data-placement "right"
                        :data-trigger "hover"
                        :title "Workflows"
@@ -447,7 +447,7 @@
         (icon/workflows)
         [:div.nav-label "Workflows"]])

-     [:a.aside-item {:class (when (insights-subpages current-route)
+     [:a.aside-item {:class (when (contains? insights-subpages current-route)
                               "current")
                      :data-placement "right"
                      :data-trigger "hover"
@@ -547,7 +547,7 @@
   "New side nav, to be used in conjunction with the top bar"
   (html
     [:nav.aside-left-nav
-     [:a.aside-item {:class (when (dashboard-subpages current-route)
+     [:a.aside-item {:class (when (contains? dashboard-subpages current-route)
                               "current")
                      :data-placement "right"
                      :data-trigger "hover"
@@ -558,7 +558,7 @@
       [:div.nav-label "Builds"]]

      (when (feature/enabled? "workflows-poc")
-       [:a.aside-item {:class (when (workflows-subpages current-route)
+       [:a.aside-item {:class (when (contains? workflows-subpages current-route)
                                 "current")
                        :data-placement "right"
                        :data-trigger "hover"
@@ -567,7 +567,7 @@
         (icon/workflows)
         [:div.nav-label "Workflows"]])

-     [:a.aside-item {:class (when (insights-subpages current-route)
+     [:a.aside-item {:class (when (contains? insights-subpages current-route)
                               "current")
                      :data-placement "right"
                      :data-trigger "hover"


Added 'cleanup' mutator card.

Added 'cleanup' mutator card.

--- src/clj/funstructor/cards_functions.clj
+++ src/clj/funstructor/cards_functions.clj
@@ -300,6 +300,7 @@
      (fn [funstruct]
        (assoc funstruct pos (gap))))))

+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; APPLY-CARD ACTION
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -334,7 +335,7 @@
       game-map)))

 (defmethod apply-card
-  :cleanup
+  :mutator-cleanup
   [game player-key card & args]
   ((apply-to-funstruct game player-key)
    (fn [funstruct]


Make util/with-temp more flexible #182

Make util/with-temp more flexible #182

--- src/clj/lambdacd/util/internal/temp.clj
+++ src/clj/lambdacd/util/internal/temp.clj
@@ -23,9 +23,8 @@
 (defmacro with-temp
   "evaluates the body, then deletes the given file or directory.
   returns the result of the evaluation of the body"
-  [f body]
+  [f & body]
   `(try
-     (let [result# ~body]
-       result#)
+     ~@body
      (finally
        (fs/delete-dir ~f LinkOption/NOFOLLOW_LINKS))))


Updating visual spatial search demo.

Updating visual spatial search demo.

--- src/cmr/demos/visual_spatial_search.clj
+++ src/cmr/demos/visual_spatial_search.clj
@@ -18,7 +18,11 @@
             [cmr.spatial.dev.viz-helper :as viz-helper]
             [cmr.spatial.serialize :as srl]
             [cmr.common.dev.util :as dev-util]
-            [cmr.spatial.lr-binary-search :as lbs]))
+            [cmr.spatial.lr-binary-search :as lbs])
+  (:import cmr.spatial.point.Point
+           cmr.spatial.ring.Ring
+           cmr.spatial.mbr.Mbr
+           cmr.spatial.polygon.Polygon))

 (defn polygon
   "Creates a single ring polygon with the given ordinates. Points must be in counter clockwise order."
@@ -35,59 +39,67 @@
   [shape]
   (assoc (srl/shape->lr shape) :options {:color "AA76775E"}))

+(defmulti ords-str->shape
+  (fn [spatial-type ords-str]
+    spatial-type))
+
+(defmethod ords-str->shape :polygon
+  [spatial-type ords-str]
+  (let [ords (map #(Double. ^String %) (str/split ords-str #","))]
+    (derived/calculate-derived (apply polygon ords))))
+
+(defmethod ords-str->shape :bounding_box
+  [spatial-type ords-str]
+  (let [[w n e s] (map #(Double. ^String %) (str/split ords-str #","))]
+    (m/mbr w n e s)))
+
 (defn handle-search-area-moved
   "This is the VDD callback function. Everytime the search area is moved this will be called with the
   new ordinates of the search area. It removes the existing MBR and LR of the search area, recalculates
   and displays them. It then searches for matches and says the number of hits that match."
-  [ords-str]
-  (println "Search area moved: " ords-str)
+  [id-ords-str]
+  (println "Search area moved: " id-ords-str)

-  (let [ords (map #(Double. ^String %) (str/split ords-str #","))
-        ring (derived/calculate-derived (apply polygon ords))
-        mbr (assoc-in (srl/shape->mbr ring)
-                      [:options :id] "search-mbr")
-        lr (assoc-in (shape->lr ring) [:options :id] "search-lr")]
+  (let [[id ords-str] (str/split id-ords-str #":")
+        spatial-type (keyword id)
+        shape (ords-str->shape spatial-type ords-str)]

-    (viz-helper/remove-geometries ["search-lr" "search-mbr"])
-    (viz-helper/add-geometries [mbr lr])
-
-    (let [results (search/find-refs :granule {:polygon (cmr.spatial.codec/url-encode
-                                                         (p/polygon [ring]))})
-          hits (:hits results)]
-      (dev-util/speak (str hits)))))
+    (let [results (search/find-refs :granule {spatial-type (cmr.spatial.codec/url-encode
+                                                             shape)})
+          {:keys [hits errors]} results]
+      (if errors
+        (doseq [error errors]
+          (dev-util/speak error))
+        (dev-util/speak (str hits))))))

 (defn visual-interactive-search
-  "Execute this to start a visual interactive search. The polygons will be ingested as granules. The
-  search area will be displayed on the map as a draggable ring. As the search area is moved
+  "Execute this to start a visual interactive search. The shapes will be ingested as granules. The
+  search area will be displayed on the map as a draggable shape. As the search area is moved
   searches will be executed to find granules that match."
-  [polygons search-area]
-  (let [polygons (map derived/calculate-derived polygons)]
+  [shapes search-area]
+  (let [shapes (map derived/calculate-derived shapes)]
     (ingest/reset)
     (ingest/create-provider "PROV1")

     (let [coll (d/ingest "PROV1" (dc/collection {:spatial-coverage (dc/spatial :geodetic)}))]
-      (doseq [polygon polygons]
-        (d/ingest "PROV1" (dg/granule coll {:spatial-coverage (dg/spatial polygon)}))))
+      (doseq [shape shapes]
+        (d/ingest "PROV1" (dg/granule coll {:spatial-coverage (dg/spatial shape)}))))
     (index/refresh-elastic-index)

-    ;; Save the polygons for display
+    ;; Save the shapes for display
     (viz-helper/clear-geometries)
-    (viz-helper/add-geometries
-      (concat polygons
-              (map srl/shape->mbr polygons)
-              (map shape->lr polygons)))
+    (viz-helper/add-geometries shapes)

     (let [callback "cmr.demos.visual-spatial-search/handle-search-area-moved"
           search-area (-> search-area
                           derived/calculate-derived
-                          (assoc
-                            :options {:callbackFn callback
+                          (update-in [:options]
+                                     merge
+                                     {:callbackFn callback
                                       :style {:width 5 :color "9918A0ff"}
-                                      :draggable true}))
-          mbr (assoc-in (srl/shape->mbr search-area) [:options :id] "search-mbr")
-          lr (assoc-in (shape->lr search-area) [:options :id] "search-lr")]
-      (viz-helper/add-geometries [search-area mbr lr]))))
+                                      :draggable true}))]
+      (viz-helper/add-geometries [search-area]))))

 (comment
@@ -97,8 +109,58 @@
         hole1 (r/ords->ring 6.95,2.05, 2.98,2.06, 3.92,-0.08, 6.95,2.05)
         hole2 (r/ords->ring 5.18,6.92, -1.79,7.01, -2.65,5, 4.29,5.05, 5.18,6.92)
         polygon-with-holes  (p/polygon [outer hole1 hole2])
-        search-area (polygon 0 0, 1 0, 1 1, 0 1, 0 0)]
+        search-area (polygon 0 0, 1 0, 1 1, 0 0)]
     (visual-interactive-search [polygon-with-holes] search-area))
+
+
+  ;; A bunch of bounding rectangles
+  (let [brs (for [lon (range -170 170 40)
+                  lat (range -70 70 20)]
+              (m/mbr lon (+ lat 5) (+ lon 10) lat))
+        ;; Search area as a polygon
+        ; search-area (assoc (polygon 8.38,12.57,11.38,14.8,3.39,22.53,0.35,21.85,8.38,12.57)
+        ;                    :options {:id "polygon"})
+
+
+        ;; Search area as a bounding rectangle
+        search-area (assoc (m/mbr -5 5 5 -5) :options {:id "bounding_box"})]
+    (visual-interactive-search brs search-area))
+
+  (let [touches-np (m/mbr 45 90 55 70)
+        touches-sp (m/mbr -160 -70 -150 -90)
+        across-am-br (m/mbr 170 10 -170 -10)
+        normal-br (m/mbr 10 10 20 0)
+
+        ;; Polygons
+        wide-north (polygon -70 20, 70 20, 70 30, -70 30, -70 20)
+        wide-south (polygon -70 -30, 70 -30, 70 -20, -70 -20, -70 -30)
+        across-am-poly (polygon 170 35, -175 35, -170 45, 175 45, 170 35)
+        on-np (polygon 45 85, 135 85, -135 85, -45 85, 45 85)
+        on-sp (polygon -45 -85, -135 -85, 135 -85, 45 -85, -45 -85)
+        normal-poly (polygon -20 -10, -10 -10, -10 10, -20 10, -20 -10)
+
+        ;; polygon with holes
+        outer (r/ords->ring -5.26,-2.59, 11.56,-2.77, 10.47,8.71, -5.86,8.63, -5.26,-2.59)
+        hole1 (r/ords->ring 6.95,2.05, 2.98,2.06, 3.92,-0.08, 6.95,2.05)
+        hole2 (r/ords->ring 5.18,6.92, -1.79,7.01, -2.65,5, 4.29,5.05, 5.18,6.92)
+        polygon-with-holes  (p/polygon [outer hole1 hole2])
+
+        search-area (assoc (polygon -6.45,-3.74,12.34,-4.18,12,9.45,-6.69,9.2,-6.45,-3.74)
+                           :options {:id "polygon"})
+        ; search-area (assoc (m/mbr -23.43 5 25.54 -6.31) :options {:id "bounding_box"})
+
+        ]
+    (visual-interactive-search [touches-sp
+                                across-am-br
+                                touches-np
+                                normal-br
+                                wide-north
+                                wide-south
+                                across-am-poly
+                                on-np
+                                on-sp
+                                normal-poly
+                                polygon-with-holes] search-area))

   ;; A set of polygons and a search area that can be displayed.
@@ -110,7 +172,15 @@
         polygon-south-pole (polygon -45 -80, -135 -80, 135 -80, 45 -80, -45 -80)
         polygon-antimeridian (polygon 135 -10, -135 -10, -135 10, 135 10, 135 -10)
         polygon-near-sp (polygon 168.1075 -78.0047, 170.1569,-78.4112, 172.019,-78.0002, 169.9779,-77.6071, 168.1075 -78.0047)
-        search-area (polygon 8.38,12.57,11.38,14.8,3.39,22.53,0.35,21.85,8.38,12.57)]
+
+        ;; Search area as a polygon
+        ; search-area (assoc (polygon 8.38,12.57,11.38,14.8,3.39,22.53,0.35,21.85,8.38,12.57)
+        ;                    :options {:id "polygon"})
+
+
+        ;; Search area as a bounding rectangle
+        search-area (assoc (m/mbr -5 5 5 -5) :options {:id "bounding_box"})
+        ]

     (visual-interactive-search [polygon-ne
                                 polygon-se


added link to issue for comment

added link to issue for comment

--- src/frontend/cljs/alibi/entry_page.cljs
+++ src/frontend/cljs/alibi/entry_page.cljs
@@ -112,6 +112,7 @@
 ; if you wonder why we introduce an itermediate IRender here: it seems Om
 ; ref-cursors only work if there is at least one om/root that binds to the root
 ; atom, so we do that here even though it is not passed on to om/build
+; see also https://github.com/omcljs/om/issues/864
 (om/root
   (let [dispatch! (partial dispatch! state)] ; make sure entry-bar-form gets a constant state
     (fn [_ owner]


update comment

update comment

--- src/io/perun/contrib/inject_scripts.clj
+++ src/io/perun/contrib/inject_scripts.clj
@@ -13,5 +13,5 @@
 (defn inject-scripts [scripts in-path out-path]
   (let [html (-> in-path io/file slurp)
         updated-html (inject html scripts)]
-    (u/info "Injecting JS scripts %s into %s\n" scripts in-path)
+    (u/info "Injected JS scripts %s into %s\n" scripts in-path)
     (spit (io/file out-path) updated-html)))


add instance support to acceptance testing framework

--- acceptance/puppetlabs-aws-expect/test/clojure/puppetlabs_aws_expect/test.clj
+++ acceptance/puppetlabs-aws-expect/test/clojure/puppetlabs_aws_expect/test.clj
@@ -24,6 +24,13 @@
 (def loadbalancers (:load-balancer-descriptions
   (describe-load-balancers region)))

+(def instances (flatten
+  (map :instances
+    (:reservations (describe-instances region)))))
+
+(def instance-names (map :value
+  (filter #(= (:key %) "Name") (flatten (map :tags instances)))))
+
 (def loadbalancer-names (map :load-balancer-name loadbalancers))

 (expect 4 (count groups))
@@ -35,3 +42,9 @@
 (expect 1 (count loadbalancers))

 (expect (in? loadbalancer-names "lb-1"))
+
+(expect 3 (count instances))
+
+(expect (in? instance-names "web-1"))
+(expect (in? instance-names "web-2"))
+(expect (in? instance-names "db"))


add delay

add delay

--- cloc-scheduler/test/cloc_scheduler/active_tasks_test.clj
+++ cloc-scheduler/test/cloc_scheduler/active_tasks_test.clj
@@ -139,7 +139,9 @@
       (-> (r/table table)
           (r/get 1)
           (r/update {:state "finished"})
-          (r/run (:db-conn @spec))))
+          (r/run (:db-conn @spec)))
+
+      (Thread/sleep 1000))

     (is (some? (poll! chan)))))


(PDB-3611) Deduplicate facts (again)

(PDB-3611) Deduplicate facts (again)

Previously, we had changed fact storage to put the value in the facts table, in
order to simplify storage and sidestep the problematic garbage collection issues
when fact values had their own table. But this proved to make queries too slow,
especially when dealing with queries which have multiple conditions on facts.

This commit contains the schema migration to move facts back to the deduplicated
table structure, with a separate fact_values table.

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -59,7 +59,8 @@
             [clj-time.core :refer [now]]
             [puppetlabs.puppetdb.jdbc :as jdbc :refer [query-to-vec]]
             [puppetlabs.puppetdb.config :as conf]
-            [puppetlabs.i18n.core :refer [trs]]))
+            [puppetlabs.i18n.core :refer [trs]]
+            [puppetlabs.puppetdb.scf.hash :as hash]))

 (defn init-through-2-3-8
   []
@@ -1300,6 +1301,85 @@
    "alter table catalogs add column job_id text default null"
    "create index reports_job_id_idx on reports(job_id) where job_id is not null"
    "create index catalogs_job_id_idx on catalogs(job_id) where job_id is not null"))
+
+(defn rededuplicate-facts []
+  (jdbc/do-commands
+   "CREATE SEQUENCE fact_values_id_seq;"
+
+   ;; will add not-null constraint on value_hash below; we don't have all the
+   ;; values for this yet
+   "CREATE TABLE fact_values (
+      id bigint DEFAULT nextval('fact_values_id_seq'::regclass) NOT NULL,
+      value_hash bytea,
+      value_type_id bigint NOT NULL,
+      value_integer bigint,
+      value_float double precision,
+      value_string text,
+      value_boolean boolean,
+      value jsonb
+    );"
+
+   "CREATE TABLE facts_transform (
+       factset_id bigint NOT NULL,
+       fact_path_id bigint NOT NULL,
+       fact_value_id bigint NOT NULL
+    );"
+
+   "INSERT INTO fact_values (value_type_id, value_integer, value_float, value_string, value_boolean, value)
+       SELECT distinct value_type_id, value_integer, value_float, value_string, value_boolean, value FROM facts"
+
+   "INSERT INTO facts_transform (factset_id, fact_path_id, fact_value_id)
+       SELECT f.factset_id, f.fact_path_id, fv.id
+         FROM facts f
+        INNER JOIN fact_values fv
+                ON fv.value_type_id = f.value_type_id
+               AND fv.value_integer IS NOT DISTINCT FROM f.value_integer
+               AND fv.value_float   IS NOT DISTINCT FROM f.value_float
+               AND fv.value_string  IS NOT DISTINCT FROM f.value_string
+               AND fv.value_boolean IS NOT DISTINCT FROM f.value_boolean
+               AND fv.value         IS NOT DISTINCT FROM f.value")
+
+  ;; populate fact_values.value_hash
+  (jdbc/call-with-query-rows
+   ["select id, value::text from fact_values"]
+   (fn [rows]
+     (doseq [{:keys [id value] :as row} rows]
+       (jdbc/update! "fact_values"
+                     {:value_hash (-> value
+                                      json/parse
+                                      hash/generic-identity-hash
+                                      sutils/munge-hash-for-storage)}
+                     ["id=?" id]))))
+
+  (jdbc/do-commands
+   "DROP TABLE facts"
+   "ALTER TABLE facts_transform rename to facts"
+
+   "ALTER TABLE fact_values alter column value_hash set not null"
+   "ALTER TABLE fact_values ADD CONSTRAINT fact_values_pkey PRIMARY KEY (id);"
+   "ALTER TABLE fact_values ADD CONSTRAINT fact_values_value_hash_key UNIQUE (value_hash);"
+   "CREATE INDEX fact_values_value_float_idx ON fact_values USING btree (value_float);"
+   "CREATE INDEX fact_values_value_integer_idx ON fact_values USING btree (value_integer);"
+
+   "ALTER TABLE facts ADD CONSTRAINT facts_factset_id_fact_path_id_fact_key UNIQUE (factset_id, fact_path_id);"
+   "CREATE INDEX facts_fact_path_id_idx ON facts USING btree (fact_path_id);"
+   "CREATE INDEX facts_fact_value_id_idx ON facts USING btree (fact_value_id);"
+
+   "ALTER TABLE facts ADD CONSTRAINT fact_path_id_fk
+      FOREIGN KEY (fact_path_id)
+      REFERENCES fact_paths(id);"
+
+   "ALTER TABLE facts ADD CONSTRAINT fact_value_id_fk
+      FOREIGN KEY (fact_value_id)
+      REFERENCES fact_values(id)
+      ON UPDATE RESTRICT
+      ON DELETE RESTRICT;"
+
+   "ALTER TABLE facts ADD CONSTRAINT factset_id_fk
+     FOREIGN KEY (factset_id)
+     REFERENCES factsets(id)
+     ON UPDATE CASCADE
+     ON DELETE CASCADE;"))

 (def migrations
   "The available migrations, as a map from migration version to migration function."
@@ -1341,7 +1421,8 @@
    60 fix-missing-edges-fk-constraint
    61 add-latest-report-timestamp-to-certnames
    62 reports-partial-indices
-   63 add-job-id})
+   63 add-job-id
+   64 rededuplicate-facts})

 (def desired-schema-version (apply max (keys migrations)))


Remove request body parsing in middleware.

--- src/rsvp_backend/middleware/logging.clj
+++ src/rsvp_backend/middleware/logging.clj
@@ -13,8 +13,7 @@
  [handler]
   (fn [request]
    (log/debug {:event    ::request
-               :request  (select-keys request standard-ring-request-keys)
-               :payload  (json/parse-string (req/body-string request) true)})
+               :request  (select-keys request standard-ring-request-keys)})
    (let [response (handler request)]
      (log/debug {:event    ::response
                  :response response})


correction

correction

--- src/regression_test_score.clj
+++ src/regression_test_score.clj
@@ -171,7 +171,7 @@
 ;; @@
 (defn ind-score [indv]

-  (fit-poly (:genotype indv) xys test-data)
+  (:sse (fit-poly (:genotype indv) xys test-data))

   )


[scamp] comment 'MessageTypeSchema

[scamp] comment 'MessageTypeSchema

--- modules/scamp/src/scamp/core.clj
+++ modules/scamp/src/scamp/core.clj
@@ -51,13 +51,28 @@
    (s/optional-key :removed?) s/Bool})

 (def MessageTypesSchema
-  (s/enum :forwarded-subscription
-          :new-upstream-node
-          :node-unsubscription ;; currently only for self-unsubscription
-          :node-replacement
-          :node-removal
-          :new-subscription
-          ))
+  (s/enum
+   ;; first [re]contact: [re]subscribe a new node
+   :new-subscription
+
+   ;; new node joining cluster, recipient will probabilistically add this new node to :downstream, else forward it again
+   :forwarded-subscription
+
+   ;; inform newly :downstream node that you are now in its :upstream
+   :new-upstream-node
+
+   ;; I added this to make it possible to instruct a node to unsubscribe.
+   :node-unsubscription
+
+   ;; instruct an upstream node and a downstream node to connect directly, without me in the middle
+   :node-replacement
+
+   ;; alternative to :node-replacement, used when upstream/downstream don't get a replacement
+   :node-removal
+
+   ;; just for saying "Hi" and "please don't assume you've been partitioned from the rest of the cluster"
+   :heartbeat
+   ))

 (def MessageEnvelopeSchema
   [(s/one (s/eq :message-envelope) "envelope variant type")


Removed *resources* hashmap - premature optimisation

--- base/compojure.clj
+++ base/compojure.clj
@@ -33,7 +33,7 @@

 (defn match-route
   "Match a path against a parsed route. Returns a map of keywords and their
-   matching path values."
+  matching path values."
   [[regex symbols] path]
   (let [matcher (re-matcher regex path)]
     (if (. matcher (matches))
@@ -46,10 +46,10 @@
      * FixNum        - updates status code
      * map           - updates headers
      * string or seq - updates body
-   Additionally, multiple updates can be chained through a vector.
+  Additionally, multiple updates can be chained through a vector.

-   e.g (update-response! \"Foo\")       ; write 'Foo' to response body
-       (update-response! [200 \"Bar\"]) ; set status to 200, and write 'Bar'"
+  e.g (update-response! \"Foo\")       ; write 'Foo' to response body
+      (update-response! [200 \"Bar\"]) ; set status to 200, and write 'Bar'"
   [#^HttpServletResponse response change]
   (cond
     (string? change)
@@ -67,26 +67,27 @@
       (doseq c change
         (update-response! response c))))

-(def *resources* {})
+(def #^{:doc
+  "A global list of all registered resources. A resource is a vector
+  consisting of a HTTP method, a parsed route, and a list of evaluatable
+  actions.
+  e.g.
+  [\"GET\" (parse-route \"/welcome/:name\")
+   '((str \"Hello \" (path :name))]"}
+  *resources* '())

 (defn add-resource
-  "Add a resource to the global *resources* map. A resource is a HTTP
-   method keyword, a route, and a body to be evaluated in order to generate
-   a response.
-   e.g. (add-resource :GET \"/welcome/:name\"
-          '(str \"Hello \" (path :name)))"
+  "Add a resource to the global *resources*."
   [method route & body]
   (def *resources*
-    (assoc *resources* method
-      (cons [(parse-route route) body]
-        (*resources* method)))))
+    (cons [method (parse-route route) body] *resources*)))

 (defn find-resource
   "Find the first resource that matches the HttpServletRequest"
   [#^HttpServletRequest request]
   (let [method    (. request (getMethod))
         path      (. request (getPathInfo))
-        resources (*resources* (keyword method))
-        matches?  (fn [[route body]]
-                    (if (match-route route path) body))]
-    (some matches? resources)))
+        matches?  (fn [[meth route body]]
+                    (if (and (= meth method) (match-route route path))
+                       body))]
+    (some matches? *resources*)))


Pulled the refs into 'main', they are not global any more.

--- ClojureScript/hello.cljs
+++ ClojureScript/hello.cljs
@@ -9,29 +9,29 @@
         [goog :only [Timer]]
         ))

-; State (AAAAHAHAHG, don't touch it!)
-(def pos (atom [0 100]))
-(def keys-pressed (atom (set)))
-
 (def my-code-url "https://github.com/pauldoo/scratch/blob/master/ClojureScript/hello.cljs")

 (defn print-to-log [v]
     (.log js/console v))

-(defn input-event [event]
-    (cond
-        (= (.type event) goog.events.EventType/KEYUP)
-            (swap! keys-pressed disj (.keyCode event))
-        (= (.type event) goog.events.EventType/KEYDOWN)
-            (swap! keys-pressed conj (.keyCode event))
-        :else
-            nil))
+(defn input-event [input-state-ref event]
+    (swap! input-state-ref
+        (fn [{keys :keys}]
+            {:keys
+                (cond
+                    (= (.type event) goog.events.EventType/KEYUP)
+                        (disj keys (.keyCode event))
+                    (= (.type event) goog.events.EventType/KEYDOWN)
+                        (conj keys (.keyCode event))
+                    :else keys)})))

-(defn tick []
-    (swap! pos (fn [[x y]] [(inc x) (* (count (deref keys-pressed)) 50)])))
+(defn tick [game-state-ref input-state]
+    (swap! game-state-ref
+        (fn [{[x y] :pos}]
+            {:pos [(inc x) (* 50 (count (:keys input-state)))]})))

-(defn rerender [canvas-element]
-    (let [[x y] (deref pos)
+(defn rerender [canvas-element game-state]
+    (let [{[x y] :pos} game-state
         graphics (goog.graphics/createGraphics 400 300)]
         (do
             (.drawCircle graphics x y 30 (Stroke. 2 "green") (SolidFill. "yellow"))
@@ -41,6 +41,8 @@

 (defn ^:export main []
     (let [
+        game-state-ref (atom {:pos [0 0]})
+        input-state-ref (atom {:keys (set)})
         canvas (goog.dom/createDom "div" {} "")
         button (goog.dom/createDom "button" {} "Click!")
         tick-timer (Timer. 100)
@@ -49,11 +51,11 @@
         (do
             (. tick-timer (start))
             (. render-timer (start))
-            (goog.events/listen button goog.events.EventType/CLICK input-event)
-            (goog.events/listen document.body goog.events.EventType/KEYDOWN input-event true)
-            (goog.events/listen document.body goog.events.EventType/KEYUP input-event true)
-            (goog.events/listen tick-timer goog.Timer/TICK tick)
-            (goog.events/listen render-timer goog.Timer/TICK #(rerender canvas))
+            (goog.events/listen button goog.events.EventType/CLICK (partial input-event input-state-ref))
+            (goog.events/listen document.body goog.events.EventType/KEYDOWN (partial input-event input-state-ref) true)
+            (goog.events/listen document.body goog.events.EventType/KEYUP (partial input-event input-state-ref) true)
+            (goog.events/listen tick-timer goog.Timer/TICK #(tick game-state-ref (deref input-state-ref)))
+            (goog.events/listen render-timer goog.Timer/TICK #(rerender canvas (deref game-state-ref)))
             (goog.dom/appendChild document.body (goog.dom/createDom "div" {}
                 (goog.dom/createDom "h1" {} "Work in progress..")
                 (goog.dom/createDom "div" {} "Try clicking the button, or pressing keys.")


adds kill messages for shell scheduler instances (#432)

--- waiter/src/waiter/scheduler/shell.clj
+++ waiter/src/waiter/scheduler/shell.clj
@@ -251,7 +251,7 @@

 (defn- kill-instance
   "Deletes the instance corresponding to service-id/instance-id and returns the updated id->service map"
-  [id->service service-id instance-id port->reservation-atom port-grace-period-ms completion-promise]
+  [id->service service-id instance-id message port->reservation-atom port-grace-period-ms completion-promise]
   (try
     (if (contains? id->service service-id)
       (let [{:keys [id->instance]} (get id->service service-id)
@@ -263,8 +263,10 @@
             (deliver completion-promise :deleted)
             (-> id->service
                 (update-in [service-id :service :instances] dec)
-                (assoc-in [service-id :id->instance instance-id :killed?] true)
-                (assoc-in [service-id :id->instance instance-id :shell-scheduler/process] nil)))
+                (update-in [service-id :id->instance instance-id] assoc
+                           :killed? true
+                           :message message
+                           :shell-scheduler/process nil)))
           (do
             (log/info "instance" instance-id "does not exist")
             (deliver completion-promise :no-such-instance-exists)
@@ -325,10 +327,12 @@
     (let [exit-value (.exitValue process)]
       (log/info "instance exited with value" {:instance instance :exit-value exit-value})
       (release-port! port->reservation-atom port port-grace-period-ms)
-      (assoc instance :healthy? false
-                      :failed? (if (zero? exit-value) false true)
-                      :killed? true ; does not actually mean killed -- using this to mark inactive
-                      :exit-code exit-value))
+      (assoc instance
+        :exit-code exit-value
+        :failed? (if (zero? exit-value) false true)
+        :healthy? false
+        :killed? true ; does not actually mean killed -- using this to mark inactive
+        :message (str "Exited with code " exit-value)))
     instance))

 (defn- enforce-grace-period
@@ -340,10 +344,12 @@
         (do (log/info "unhealthy instance exceeded its grace period, killing instance"
                       {:instance instance :start-time started-at :current-time current-time :grace-period-secs grace-period-secs})
             (kill-process! instance port->reservation-atom port-grace-period-ms)
-            (assoc instance :failed? true
-                            :killed? true
-                            :flags #{:never-passed-health-checks}
-                            :shell-scheduler/process nil))
+            (assoc instance
+              :failed? true
+              :flags #{:never-passed-health-checks}
+              :killed? true
+              :message (str "Exceeded grace period of " grace-period-secs " seconds")
+              :shell-scheduler/process nil))
         instance))
     instance))

@@ -356,11 +362,13 @@
       (if (and memory-used (> memory-used memory-allocated))
         (do (log/info "instance exceeds memory limit, killing instance" {:instance instance :memory-limit memory-allocated :memory-used memory-used})
             (kill-process! instance port->reservation-atom port-grace-period-ms)
-            (assoc instance :healthy? false
-                            :failed? true
-                            :killed? true
-                            :flags #{:memory-limit-exceeded}
-                            :shell-scheduler/process nil))
+            (assoc instance
+              :failed? true
+              :flags #{:memory-limit-exceeded}
+              :healthy? false
+              :killed? true
+              :message "Exceeded allocated memory usage"
+              :shell-scheduler/process nil))
         instance))
     instance))

@@ -555,8 +563,9 @@

   (kill-instance [this {:keys [id service-id] :as instance}]
     (if (scheduler/service-exists? this service-id)
-      (let [completion-promise (promise)]
-        (send id->service-agent kill-instance service-id id
+      (let [completion-promise (promise)
+            message "Killed using scheduler API"]
+        (send id->service-agent kill-instance service-id id message
               port->reservation-atom port-grace-period-ms
               completion-promise)
         (let [result (deref completion-promise)


tested carry/entangle

tested carry/entangle

--- test/unit/core.cljc
+++ test/unit/core.cljc
@@ -14,12 +14,15 @@

 (defn is-readonly-atom
   [a]
-  (is (not= @a {:val :new-value}) "self test")
+  (assert (map? @a) "self test")
+  (assert (not= @a {:val :new-value}) "self test")
+
   (is (carry/read-only? a))
   (u/is-error-thrown
     #"^read-only atom was set to \{:val :new-value\}"
     (swap! a assoc :val :new-value)))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; App
 (deftest
   app-model-is-read-only-atom
   (let [spec {:initial-model {:val 100}
@@ -162,4 +165,34 @@
     ; assert
     (is (= {:val 102} @(:model app)))
     (testing "model is still read-only"
-      (is-readonly-atom (:model app)))))+      (is-readonly-atom (:model app)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Entangle
+(deftest
+  entangled-atom-is-read-only
+  (let [source-atom (atom {:val 100})
+        entangled-atom (carry/entangle source-atom identity)]
+    (is-readonly-atom entangled-atom)))
+
+(deftest
+  entangled-atom-reacts-to-source-atom-changes-using-specified-function
+  (let [source-atom (atom {:val 100})
+        entangled-atom (carry/entangle source-atom #(update % :val inc))]
+    (is (= {:val 101} @entangled-atom))
+
+    (swap! source-atom assoc :val 200)
+    (is (= {:val 201} @entangled-atom))
+
+    ; just in case:
+    (is-readonly-atom entangled-atom)))
+
+(deftest
+  entangle-supports-custom-atom-constructor
+  (let [source-atom (atom {:val 100})
+        custom-constructor-used? (atom false)
+        custom-constructor #(do (reset! custom-constructor-used? true)
+                                (atom %))
+        entangled-atom (carry/entangle source-atom #(update % :val inc) custom-constructor)]
+    (is @custom-constructor-used?)
+    (is (= {:val 101} @entangled-atom))
+    (is-readonly-atom entangled-atom)))


CMR-2482: Removed proto/save

CMR-2482: Removed proto/save

--- indexer-app/src/cmr/indexer/data/concepts/collection.clj
+++ indexer-app/src/cmr/indexer/data/concepts/collection.clj
@@ -58,7 +58,6 @@
                 :exclude-metadata true
                 :latest true}
         tag-associations (mdb/find-concepts context params :tag-association)]
-    (proto/save 1)
     ;; we only want the tag associations that have no associated revision id or one equal to the
     ;; revision of this collection
     (filter (fn [ta] (let [rev-id (:associated-revision-id ta)]


rename query fn

rename query fn

--- dada-core/src/main/clojure/org/dada/dsl.clj
+++ dada-core/src/main/clojure/org/dada/dsl.clj
@@ -426,7 +426,7 @@
 	   (insert *metamodel* metamodel)
 	   [metamodel prefix '()]))]))

-(defn ? [[metadata-fn direct-fn]]
+(defn ?2 [[metadata-fn direct-fn]]
   (let [metadata (metadata-fn)
 	direct (direct-fn)]
     [ ;; metadata
@@ -438,8 +438,8 @@
 (defn thread-chain [chain model]
   (reduce (fn [results operator] (operator results)) model (reverse chain)))

-(defn ?2 [chain model]
-  (? (thread-chain chain model)))
+(defn ? [chain model]
+  (?2 (thread-chain chain model)))

 (defn meta-view [#^String suffix #^Model src-metamodel f]
   ;; create a metamodel into which t place our results...


Add icon kind

Add icon kind

--- src-cljs/frontend/components/pieces/button.cljs
+++ src-cljs/frontend/components/pieces/button.cljs
@@ -7,7 +7,7 @@
   "A standard button.

   :on-click  - A function called when the button is clicked.
-  :kind      - The kind of button. One of #{:primary :secondary :danger :flat}.
+  :kind      - The kind of button. One of #{:primary :secondary :danger :flat :icon}.
                (default: :secondary)
   :disabled? - If true, the button is disabled. (default: false)
   :size      - The size of the button. One of #{:full :medium}.
@@ -33,7 +33,7 @@
                    frontend.utils.html/open-ext.
   :href          - The link target.
   :on-click      - A function called when the link is clicked.
-  :kind          - The kind of button. One of #{:primary :secondary :danger :flat}.
+  :kind          - The kind of button. One of #{:primary :secondary :danger :flat :icon}.
                    (default: :secondary)"
   [{:keys [class href on-click kind size data-external]
     :or {kind :secondary size :full}}
@@ -55,7 +55,7 @@
   "A managed button.

   :on-click     - A function called when the button is clicked.
-  :kind         - The kind of button. One of #{:primary :secondary :danger :flat}.
+  :kind         - The kind of button. One of #{:primary :secondary :danger :flat :icon}.
                   (default: :secondary)
   :disabled?    - If true, the button is disabled. (default: false)
   :size         - The size of the button. One of #{:full :medium}.


add a generate-a-dungeon button

add a generate-a-dungeon button

--- src/voke/world/visualize.cljs
+++ src/voke/world/visualize.cljs
@@ -1,7 +1,9 @@
 (ns voke.world.visualize
   (:require [cljs.spec :as s]
+            [cljs.core.async :refer [chan <! put!]]
             [reagent.core :as r]
-            [voke.world.generation :as generate]))
+            [voke.world.generation :as generate])
+  (:require-macros [cljs.core.async.macros :refer [go]]))

 (s/def ::active-cell ::generate/cell)
 (s/def ::dungeon (s/keys :req [::generate/grid ::active-cell]))
@@ -10,10 +12,14 @@

 ; TODO construct some sort of system that takes a ::generation/world and draws its progress over time

-(let [world (-> (generate/full-grid 30 30)
-                (generate/drunkards-walk 150))]
-  (def dungeon (r/atom {::generate/grid (world ::generate/grid)
-                        ::active-cell   [2 2]})))
+(defn make-dungeon []
+
+  (let [world (-> (generate/full-grid 30 30)
+                  (generate/drunkards-walk 150))]
+    {::generate/grid (world ::generate/grid)
+     ::active-cell   [2 2]}))
+
+(defonce dungeon (r/atom (make-dungeon)))

 (defn row [a-row y]
   [:div.row
@@ -27,12 +33,19 @@
            ^{:key ["row" y]} [row a-row y])

          (let [[x y] (@dungeon ::active-cell)]
-           [:div.cell.active {:style {:left (* cell-size x)
-                                      :top  (* cell-size y)}}]))])
+           ^{:key "active-cell"} [:div.cell.active {:style {:left (* cell-size x)
+                                                            :top  (* cell-size y)}}]))])

+(defn ui [dungeon]
+  [:div.content
+   ^{:key "dungeon"} [grid dungeon]
+   ^{:key "button"} [:button {:on-click (fn [e]
+                                          (.preventDefault e)
+                                          (reset! dungeon (make-dungeon)))}
+                     "generate"]])

 (defn ^:export main []
-  (r/render-component [grid dungeon]
+  (r/render-component [ui dungeon]
                       (js/document.getElementById "content")))


Add render-detail to render node details

--- src/web/components/nodes.cljs
+++ src/web/components/nodes.cljs
@@ -40,6 +40,11 @@
         "work-item" (not (empty? mapped-here))
         "tag" true)))

+  (render-detail [this label content]
+    (dom/div #js {:className "node-detail"}
+      (dom/div #js {:className "node-detail-label"} label)
+      (dom/div #js {:className "node-detail-content"} content)))
+
   (render [this]
     (let [{:keys [name title kind description children
                   mapped-to mapped-here tags tagged
@@ -66,60 +71,38 @@
                              " node-details-collapsed"))}
           (dom/div #js {:className "node-details-table"}
             (when description
-              (dom/div #js {:className "node-detail"}
-                (dom/div #js {:className "node-detail-label"}
-                  "Description")
-                (dom/div #js {:className "node-detail-content"}
-                  (markdown {:text description}))))
+              (let [text {:text description}]
+                (.render-detail this "Description" (markdown text))))
             (when parent
-              (dom/div #js {:className "node-detail"}
-                (dom/div #js {:className "node-detail-label"}
-                  "Parent")
-                (dom/div #js {:className "node-detail-content"}
-                  (node-link parent))))
+              (.render-detail this "Parent" (node-link parent)))
             (when (some #{kind} ["component" "work-item"])
-              (dom/div #js {:className "node-detail"}
-                (dom/div #js {:className "node-detail-label"}
-                  "Mapped here")
-                (dom/div #js {:className "node-detail-content"}
-                  (if (empty? mapped-here)
-                    (dom/div #js {:className "error"}
-                      (if (= "component" kind)
-                        "No requirements have been mapped here yet."
-                        (str "No requirements or components have been "
-                             "mapped here yet.")))
-                    (for [source mapped-here]
-                      (node-link source))))))
+              (.render-detail this "Mapped here"
+                (if (empty? mapped-here)
+                  (dom/div #js {:className "error"}
+                    (if (= "component" kind)
+                      "No requirements have been mapped here yet."
+                      (str "No requirements or components have been "
+                           "mapped here yet.")))
+                  (for [source mapped-here]
+                    (node-link source)))))
             (when (some #{kind} ["requirement" "component"])
-              (dom/div #js {:className "node-detail"}
-                (dom/div #js {:className "node-detail-label"}
-                  "Mapped to")
-                (dom/div #js {:className "node-detail-content"}
-                  (if (empty? mapped-to)
-                    (dom/div #js {:className "error"}
-                      (if (= "requirement" kind)
-                        (str "Not mapped to any components or "
-                             "work items yet.")
-                        (str "Not mapped to any work items yet.")))
-                    (for [target mapped-to]
-                      (node-link target))))))
-            (when-not (or (= "tag" kind)
-                          (empty? tags))
-              (dom/div #js {:className "node-detail"}
-                (dom/div #js {:className "node-detail-label"}
-                  "Tags")
-                (dom/div #js {:className "node-detail-content"}
-                  (for [target tags]
+              (.render-detail this "Mapped to"
+                (if (empty? mapped-to)
+                  (dom/div #js {:className "error"}
+                    (if (= "requirement" kind)
+                      (str "Not mapped to any components or "
+                           "work items yet.")
+                      (str "Not mapped to any work items yet.")))
+                  (for [target mapped-to]
                     (node-link target)))))
+            (when-not (or (= "tag" kind) (empty? tags))
+              (.render-detail this "Tags" (mapv node-link tags)))
             (when (= "tag" kind)
-              (dom/div #js {:className "node-detail"}
-                (dom/div #js {:className "node-detail-label"}
-                  "Tagged")
-                (dom/div #js {:className "node-detail-content"}
-                  (if (empty? tagged)
-                    "Nothing has been tagged with this yet."
-                    (for [source tagged]
-                      (node-link source))))))))
+              (.render-detail this "Tagged"
+                (if (empty? tagged)
+                  "Nothing has been tagged with this yet."
+                  (for [source tagged]
+                    (node-link source)))))))
         (dom/div #js {:className "node-subnodes"}
           (for [child children]
             (node


Fix :all-complete? subscription

Fix :all-complete? subscription

--- examples/todomvc/src/todomvc/subs.cljs
+++ examples/todomvc/src/todomvc/subs.cljs
@@ -148,7 +148,7 @@
   :all-complete?
   :<- [:todos]
   (fn [todos _]
-    (seq todos)))
+    (every? :done todos)))

 (reg-sub
   :completed-count


Add interface to users for querying all users

--- src/zipping_checkin/users.clj
+++ src/zipping_checkin/users.clj
@@ -21,5 +21,7 @@
 (defn query-user [user-id]
   (get @users user-id))

-(defn query-users [user-ids]
-  (select-keys @users user-ids))
+(defn query-users
+  ([] (vals @users))
+  ([user-ids]
+     (vals (select-keys @users user-ids))))


Fix migrate version parsing

Fix migrate version parsing


:lipstick: Cosmetic changes on auth events ns.

--- frontend/src/uxbox/main/data/auth.cljs
+++ frontend/src/uxbox/main/data/auth.cljs
@@ -69,7 +69,7 @@
 ;; --- Logout

 (def clear-user-data
-  (reify
+  (ptk/reify ::clear-user-data
     ptk/UpdateEvent
     (update [_ state]
       (merge state (dissoc initial-state :route :router)))
@@ -85,7 +85,7 @@
       (i18n/set-default-locale!))))

 (def logout
-  (reify
+  (ptk/reify ::logout
     ptk/WatchEvent
     (watch [_ state s]
       (rx/of (rt/nav :auth/login)
@@ -104,7 +104,7 @@
   [data on-error]
   (s/assert ::register-params data)
   (s/assert ::us/fn on-error)
-  (reify
+  (ptk/reify ::register
     ptk/WatchEvent
     (watch [_ state stream]
       (letfn [(handle-error [{payload :payload}]
@@ -128,7 +128,7 @@
 (defn recovery-request
   [data]
   (s/assert ::recovery-request-params data)
-  (reify
+  (ptk/reify ::recover-request
     ptk/WatchEvent
     (watch [_ state stream]
       (letfn [(on-error [{payload :payload}]
@@ -171,7 +171,7 @@
 (defn recovery
   [{:keys [token password] :as data}]
   (s/assert ::recovery-params data)
-  (reify
+  (ptk/reify ::recovery
     ptk/WatchEvent
     (watch [_ state stream]
       (letfn [(on-error [{payload :payload}]


Add `:inline` to `valid-binary?`

Add `:inline` to `valid-binary?`

--- src/cljc/mikron/runtime/processor/validate.cljc
+++ src/cljc/mikron/runtime/processor/validate.cljc
@@ -39,6 +39,7 @@

 (defn valid-binary?
   "Returns `true` if `value` is a binary value, `false` otherwise."
+  #?(:clj {:inline (fn [value] `(bytes? ~value))})
   [value]
   #?(:clj  (bytes? value)
      :cljs (instance? js/ArrayBuffer value)))


updated base-api-url

updated base-api-url

--- src/cljs/wombats_web_client/constants/urls.cljs
+++ src/cljs/wombats_web_client/constants/urls.cljs
@@ -4,7 +4,7 @@
 #_(def base-api-url "//dev.wombats.io")

 ;; Local Dev
-(def base-api-url "//192.168.179.248:8888")
+(def base-api-url "//localhost:8888")

 (def self-url (str base-api-url "/api/v1/self"))
 (def github-signout-url (str base-api-url "/api/v1/auth/github/signout"))


kafka port

kafka port


Turn sound back on

Turn sound back on

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -139,8 +139,8 @@
                         piano-key (get-in instrument [:piano-keys freq])]
                     (if-not (:on? piano-key)
                       (do
-                        (println "play")
-                        #_(.play (.bang (:synth piano-key)))
+                        ;; (println "play")
+                        (.play (.bang (:synth piano-key)))
                         (-> instrument
                             (assoc :notes (conj (get instrument :notes)
                                                 {:freq freq :on time :off nil :touch-id touch-id}))
@@ -156,8 +156,9 @@
                                                 (if (= touch-id (-> note :touch-id))
                                                   (do
                                                     (swap! freqs-on conj (-> note :freq))
-                                                    (println "release")
-                                                    #_(.release (:synth (get piano-keys (-> note :freq))))
+                                                    ;; (println "release")
+                                                    (.release (:synth (get piano-keys
+                                                                           (-> note :freq))))
                                                     (assoc note :off time))
                                                   note))
                                               (-> instrument :notes))))]


allow length 4 moves

allow length 4 moves

--- src/quoridor/core.clj
+++ src/quoridor/core.clj
@@ -85,6 +85,12 @@
                     move)
          (not (contains? (set [current-position other-position]) move)))))

+(defn- allowed-wall-move?
+  [state move]
+  (if (= (count move) 4)
+    true
+    false))
+
 (defn- black-won?
   [state]
   (= (Character/digit (second (state :black)) 10) 8))


Small modifications for DL interaction

Small modifications for DL interaction

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

--- src/conexp/contrib/dl/languages/interaction.clj
+++ src/conexp/contrib/dl/languages/interaction.clj
@@ -8,8 +8,8 @@

 (ns conexp.contrib.dl.languages.interaction
   (:use conexp.main
-	conexp.contrib.dl.framework.syntax
-	conexp.contrib.dl.framework.semantics))
+        conexp.contrib.dl.framework.syntax
+        conexp.contrib.dl.framework.semantics))

 ;;;

@@ -19,11 +19,11 @@
   rebound."
   [subsumption]
   (let [answer (ask (str "Do you accept the subsumption \n\n"
-			 (print-str subsumption)
-			 " ?\n\n")
+                         (print-str subsumption)
+                         " ?\n\n")
                     read
-		    '#{yes no}
-		    "Please enter yes or no.\n")]
+                    '#{yes no}
+                    "Please enter yes or no.\n")]
     (if (= answer 'yes)
       false
       true)))
@@ -38,61 +38,67 @@
                       (print-str subsumption)
                       " is already wrong in model."))
   (let [language    (interpretation-language model),
-	old-objects (interpretation-base-set model),
+        old-objects (interpretation-base-set model),

-	new-objects (loop []
-		      (println "Please enter your new objects:")
-		      (let [new-objects (read-string (str "#{" (first (drop-while empty? (repeatedly read-line))) "}"))]
-			(if-not (empty? (intersection old-objects new-objects))
-			  (do
-			    (println "The objects " (difference new-objects old-objects)
-				     " are already definied in the given model. Please use other names.")
-			    (recur))
-			  (if-not (every? #(Character/isUpperCase ^Character (first (str %)))
-					  new-objects)
-			    (do
-			      (println (str "New objects need to start with a capital letter."))
-			      (recur))
-			    new-objects)))),
+        new-objects (loop []
+                      (println "Please enter your new objects:")
+                      (let [new-objects (read-string (str "#{" (first (drop-while empty? (repeatedly read-line))) "}"))]
+                        (cond
+                         (not-empty (intersection old-objects new-objects))
+                         (do
+                           (println "The objects " (difference new-objects old-objects)
+                                    " are already definied in the given model. Please use other names.")
+                           (recur)),
+
+                         (some #(not (Character/isUpperCase ^Character (first (str %))))
+                                 new-objects)
+                         (do
+                           (println (str "New objects need to start with a capital letter."))
+                           (recur)),
+
+                         :else
+                         new-objects))),

-	interpretation (loop [objects (seq new-objects),
-			      attributes {}]
-			 (if (empty? objects)
-			   attributes
-			   (let [next-object (first objects),
-				 new-attributes
-				 (loop []
-				   (let [_ (println (str "Please enter concept- and role-names which are satisfied by " next-object ":"))
-					 new-attributes (read-string (str "(" (read-line) ")"))]
-				     (if-let [invalid (first (filter #(not (or (symbol? %)
-									       (and (seq? %) (= 2 (count %)))))
-								     new-attributes))]
-				       (do
-					 (println (str "Attribute " invalid " is invalid, i.e. it's neither a symbol nor a pair."))
-					 (recur))
-				       (if-let [invalid (first (for [att new-attributes
-								     :when (or (and (symbol? att)
-										    (not (contains? (concept-names language) att)))
-									       (and (seq? att)
-										    (or (not (contains? (role-names language) (first att)))
-											(not (contains? new-objects (second att))))))]
-								 att))]
-					 (do
-					   (if (symbol? invalid)
-					     (println (str invalid " is not a valid concept name"))
-					     (println (str invalid " does not contain a valid role name or has an invalid object\n"
-							   "(note that you can only use new objects in role specifications.")))
-					   (recur))
-					 new-attributes))))]
-			     (recur (rest objects)
-				    (assoc attributes next-object new-attributes))))),
+        interpretation (loop [objects (seq new-objects),
+                              attributes {}]
+                         (if (empty? objects)
+                           attributes
+                           (let [next-object (first objects),
+                                 new-attributes
+                                 (loop []
+                                   (println (str "Please enter concept- and role-names which are satisfied by " next-object ":"))
+                                   (let [new-attributes (read-string (str "(" (read-line) ")"))]
+                                     (if-let [invalid (first (filter #(not (or (symbol? %)
+                                                                               (and (seq? %) (= 2 (count %)))))
+                                                                     new-attributes))]
+                                       (do
+                                         (println (str "Attribute " invalid " is invalid, i.e. it's neither a symbol nor a pair."))
+                                         (recur))
+                                       (if-let [invalid (first (for [att new-attributes
+                                                                     :when (or (and (symbol? att)
+                                                                                (not (contains? (concept-names language) att)))
+                                                                               (and (seq? att)
+                                                                                (or (not (contains? (role-names language) (first att)))
+                                                                                (not (contains? new-objects (second att))))))]
+                                                                 att))]
+                                         (do
+                                           (if (symbol? invalid)
+                                             (println (str invalid
+                                                           " is not a valid concept name"))
+                                             (println (str invalid
+                                                           " does not contain a valid role name or has an invalid object\n"
+                                                           "(note that you can only use new objects in role specifications.")))
+                                           (recur))
+                                         new-attributes))))]
+                             (recur (rest objects)
+                                    (assoc attributes next-object new-attributes))))),

-	new-att-map (loop [pairs   interpretation,
-			   att-map (interpretation-function model)]
-		      (if (empty? pairs)
-			att-map
-			(let [[object attributes] (first pairs)]
-			  (recur (rest pairs)
+        new-att-map (loop [pairs   interpretation,
+                           att-map (interpretation-function model)]
+                      (if (empty? pairs)
+                        att-map
+                        (let [[object attributes] (first pairs)]
+                          (recur (rest pairs)
                                  (reduce (fn [att-map att]
                                            (if (symbol? att)
                                              (update-in att-map [att] conj object)
@@ -100,11 +106,12 @@
                                          att-map
                                          attributes))))),

-	new-model (make-interpretation language (union old-objects new-objects) new-att-map)]
+        new-model (make-interpretation language (union old-objects new-objects) new-att-map)]
+
     (if (holds-in-interpretation? new-model subsumption)
       (do
-	(println (str "New model does not contradict subsumption " (print-str subsumption) ", restarting."))
-	(recur model subsumption))
+        (println (str "New model does not contradict subsumption " (print-str subsumption) ", restarting."))
+        (recur model subsumption))
       new-model)))

 ;;;


Fixed wrong v-scrollbar v size initialization

--- flatguiwidgets/src/flatgui/widgets/scrollpanel.clj
+++ flatguiwidgets/src/flatgui/widgets/scrollpanel.clj
@@ -123,7 +123,7 @@
                                              (m/y (get-property component [] :clip-size))
                                              (get-property component [:h-scrollbar] :scroll-bar-thickness))
                                            0))
-              :content-size (fg/accessorfn (:clip-size component))
+              :content-size (fg/accessorfn (get-property component [:this] :clip-size))
               :position-matrix (fg/accessorfn (m/mx-set
                                                 m/IDENTITY-MATRIX
                                                 0 3


Updated when.

Updated when.

It passes the tests - for the first time in a long time all the tests I
have pass. That's pretty nice.

The implementation itself features a rather, uh, strange usage of mapcat,
but that was the only way I could think of to split one node into many
nodes. I'm pretty sure that's more a failure of my imagination than
anything else, and that there's totally a way to do it more idiomatically
which I've missed horribly.

On the other hand it works!

--- formatter/src/formatter/extensions/when.clj
+++ formatter/src/formatter/extensions/when.clj
@@ -3,15 +3,29 @@
             [clojure.data :as data]
             [formatter.parser :as par]))

+(defn replace-nodes
+  "Replaces nodes within a (if pred (do ... )) node. Changes the [if] to a
+  [when] and pulls the body of the [do] up one level on the tree."
+  [if-node do-node node]
+  (letfn [(compare-node [node]
+            (condp = node
+              if-node [[:Symbol "when"]]
+              do-node (->> (rest node)
+                      (drop-while string?)
+                      (remove #{"(" ")" [:Symbol "do"]})
+                      (into []))
+                [node]))]
+    (mapcat compare-node node)))
+
 (defn replace-when-not [& args]
-  (let [[pre-strs main-vec] (split-with string? args)
-        [if-vec pred-vec do-vec & dne] (filter vector? main-vec)
-        [do-key do-sym-vec & more] (filter #(or (vector? %) (keyword? %)) do-vec)]
-    (if (and (= nil dne)
-             (= if-vec [:Symbol "if"])
-             (= do-key :Eval)
-             (= do-sym-vec [:Symbol "do"]))
-        (->> (concat pre-strs [[:Symbol "when"] " " pred-vec] more [")"])
+  (let [[if-node pred-node do-node & dne] (filter vector? args)
+        do-vecs (filter vector? do-node)]
+    (if (and (= nil dne)
+             (= if-node [:Symbol "if"])
+             (= (first do-node) :Eval)
+             (= (first do-vecs) [:Symbol "do"]))
+        (->> args
+             (replace-nodes if-node do-node)
              (cons :Eval)
              (into []))
         (into [] (cons :Eval args)))))


working on a resource leak with initialize

--- src/lcmap/clownfish/setup/initialize.clj
+++ src/lcmap/clownfish/setup/initialize.clj
@@ -57,14 +57,12 @@
                     (mount/start #'lcmap.clownfish.configuration/config
                                  #'lcmap.clownfish.db/db-cluster
                                  #'lcmap.clownfish.setup.cassandra/setup
-                                 (mount/with-args {:environment environment}))
-                    (mount/stop  #'lcmap.clownfish.configuration/config
-                                 #'lcmap.clownfish.db/db-cluster
-                                 #'lcmap.clownfish.setup.cassandra/setup))
+                                 (mount/with-args {:environment environment})))
     (catch Exception e
       (stacktrace/print-stack-trace e)
       (log/errorf "error initializing cassandra: %s"
-                  (stacktrace/root-cause e)))))
+                  (stacktrace/root-cause e)))
+    (finally (mount/stop))))

 (defn rabbitmq
   "Manual operation to set up rabbit queues, exchanges and bindings."
@@ -76,12 +74,9 @@
                                  #'event/amqp-connection
                                  #'event/amqp-channel
                                  #'lcmap.clownfish.setup.rabbitmq/setup
-                                 (mount/with-args {:environment environment}))
-                    (mount/stop #'lcmap.clownfish.configuration/config
-                                #'lcmap.clownfish.event/amqp-connection
-                                #'lcmap.clownfish.event/amqp-channel
-                                #'lcmap.clownfish.setup.rabbitmq/setup))
+                                 (mount/with-args {:environment environment})))
     (catch Exception e
       (stacktrace/print-stack-trace e)
       (log/errorf "error initializing event system: %s"
-                  (stacktrace/root-cause e)))))
+                  (stacktrace/root-cause e)))
+    (finally (mount/stop))))


skip core.async parsing to focus on cljs core

--- src/core.clj
+++ src/core.clj
@@ -43,9 +43,9 @@
    "clojure.string"         {"clojurescript" {"string.cljs"      "src/cljs/clojure"}}
    "clojure.walk"           {"clojurescript" {"walk.cljs"        "src/cljs/clojure"}}
    "clojure.zip"            {"clojurescript" {"zip.cljs"         "src/cljs/clojure"}}
-   "clojure.data"           {"clojurescript" {"data.cljs"        "src/cljs/clojure"}}
-   "cljs.core.async"        {"core.async"    {"async.cljs"       "src/main/clojure/cljs/core"}}
-   "cljs.core.async.macros" {"core.async"    {"macros.clj"       "src/main/clojure/cljs/core/async"}}})
+   "clojure.data"           {"clojurescript" {"data.cljs"        "src/cljs/clojure"}}})
+   ;;"cljs.core.async"        {"core.async"    {"async.cljs"       "src/main/clojure/cljs/core"}}
+   ;;"cljs.core.async.macros" {"core.async"    {"macros.clj"       "src/main/clojure/cljs/core/async"}}})

 ;;------------------------------------------------------------
 ;; Form Reading


adding :session-id and :order markers

adding :session-id and :order markers

:order, once implemented, will allow to maintain stop/start order

--- src/mount/mount.clj
+++ src/mount/mount.clj
@@ -1,6 +1,19 @@
 (ns mount
   (:require [clojure.tools.macro :as macro]
+            [clojure.tools.namespace.repl :refer [disable-reload!]]
             [clojure.tools.logging :refer [info]]))
+
+(disable-reload!)
+
+(defonce ^:private session-id (System/currentTimeMillis))
+(defonce ^:private state-seq (atom 0))
+(defonce ^:private state-order (atom {}))
+
+(defn- make-state-seq [state]
+  (or (@state-order state)
+      (let [nseq (swap! state-seq inc)]
+        (swap! state-order assoc state nseq)
+        nseq)))

 ;;TODO validate stop and the fact that start and stop are fns
 (defn- validate [{:keys [start stop]}]
@@ -9,9 +22,13 @@
   {:start start :stop stop})

 (defmacro defstate [state & body]
+  (info "calling defstate: " state ", body: " body)
   (let [[state [c cf d df]] (macro/name-with-attributes state body)
         {:keys [start stop]} (validate {c cf d df})]
-    (let [s-meta (-> {:state (str `~state) :start `(fn [] (~@start)) :started? true}
+    (let [s-meta (-> {:session-id session-id
+                      :order (make-state-seq state)
+                      :start `(fn [] (~@start))
+                      :started? true}
                      (cond-> df (assoc :stop `(fn [] (~@stop)))))]
       `(defonce ~(with-meta state (merge (meta state) s-meta))
          (~@start)))))
@@ -30,7 +47,7 @@
   (->> (all-ns)
        (mapcat ns-interns)
        (map second)
-       (filter #(:state (meta %)))
+       (filter #(= (:session-id (meta %)) session-id))
        (map #(f % (meta %)))))

 (defn start []


chord added

chord added


Generating class

Generating class

--- src/ralang/core.clj
+++ src/ralang/core.clj
@@ -2,9 +2,6 @@
   (:use [clojure.algo.generic.functor :only (fmap)])
   (:use [clojure.java.io])
   (:require [clojure.string :as string])
-  (comment (:require [clojure.edn]))
-  (comment (:require [rhizome.dot]))
-  (comment (:require [rhizome.viz]))
   (:require [instaparse.core :as insta])
   (:require [clojure.walk :as walk])
   (:gen-class))
@@ -25,12 +22,22 @@
   [bytecode]
   (spit outputFile bytecode :append true))

+(defn genClass
+  "Generates a class"
+  [name]
+  (println ".class public" (read-string name))
+  (println ".super java/lang/Object")
+  (println ".method public <init>()V)"))
+
 (defn tokenReader
   "Reads a token."
   [token]
-  (def t (parser token))
-  (println (apply array-map t))
-  (println (second t)))
+  (def tkey (first token))
+  (def tval (second token))
+  (case tkey
+    :token (tokenReader tval)
+    :class (genClass tval)
+    (println "Not recognised")))

 (defn removeEmptyLineOrComment
   "Find and remove empty lines and comments from the source code."
@@ -50,7 +57,7 @@
     (def source
       (for [line (line-seq rdr)] (removeEmptyLineOrComment line)))
     (doseq [x (remove empty? source)]
-      (tokenReader x))))
+      (tokenReader (parser x)))))

 (defn checkSource
   "Check if source file exists."


don't override content type

don't override content type

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -75,7 +75,7 @@
   (time (try
      (client/request {:url url
                       :method (keyword (str/lower-case verb))
-                      :content-type :json
+                      ;; :content-type :json
                       :headers headers
                       :query-params params
                       :body (if (string? payload) payload


color output, concurrent execution

color output, concurrent execution

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -48,35 +48,41 @@
                    :body payload}))

 (defn verify-response [{:keys [status body headers] :as resp}
-                       {:keys[exp-status exp-headers exp-body]}]
-
-  (let [body* (json->clj body)]
-    (or
-     (and (not= status exp-status)
-          (str "status " status " not equal to expected " exp-status))
-     (some #(fn [[header value]]
-              (if (not= value (headers header))
-                (str "header " header " was " (headers header) " expected " value))) exp-headers)
-     (if-let [diff (and (not-empty exp-body) (first (data/diff exp-body body*)))]
-       (->> diff json/generate-string (str "expected body missing:" ))))))
+                       {:keys [exp-status exp-headers exp-body]}]
+  (let [body* (json->clj body)
+        error (or
+               (and (not= status exp-status)
+                    (str "status " status " not equal to expected " exp-status))
+               (some #(fn [[header value]]
+                        (if (not= value (headers header))
+                          (str "header " header " was " (headers header) " expected " value))) exp-headers)
+               (if-let [diff (and (not-empty exp-body) (first (data/diff exp-body body*)))]
+                 (->> diff json/generate-string (str "expected body missing:" ))))]
+    (if error [error resp])))

 (defn test-all [base-url suites]
-  (for [{:keys[suite tests]} suites]
+  (for [{:keys[suite tests]} suites
+        :let [results (doall (map #(future [(% :test)
+                                            (verify-response (mk-request base-url %) %)]) tests))]]
     {:suite suite
-     :results (map #(vector (% :test)
-                            (or (verify-response (mk-request base-url %) %) :OK)) tests)}))
+     :results results
+     :total (count results)
+     :failures (count (filter #(second @%) results))}))

 (defn print-test-results [suites]
-  (println "=============================================================")
-  (doseq [{:keys [suite results]} suites]
-    (println suite)
-    (doseq [[test result] results]
-      (print "...")
-      (print test (apply str (repeat (- 20 (count test)) ".")))
-      (println result))))
+  (let [total (reduce + (map :total suites))
+        fail-count (reduce + (map :failures suites))]
+    (println "=============================================================")
+    (println "Test cases:" total ", failed:" fail-count)
+    (doseq [{:keys [suite results]} suites]
+      (println suite)
+      (doseq [result results :let [[test result] @result]]
+        (print (if result "\u001B[31m [x] " "\u001B[32m [v] "))
+        (println test "\t" (or (first result) :OK))))
+    (print "\u001B[0m")))

 (defn -main
   "Give me a CSV with API rest cases and I will verify them"
   [& args]
-  (print-test-results
-   (doall (test-all (first args) (tests-from (second args))))))
+  (print-test-results (test-all (first args) (tests-from (second args))))
+  (shutdown-agents))


Fix #928 - Fixed dynamic class loading

Fix #928 - Fixed dynamic class loading

--- src/riemann/bin.clj
+++ src/riemann/bin.clj
@@ -110,6 +110,7 @@
   (let [thread (Thread/currentThread)
         cl (.getContextClassLoader thread)]
     (when-not (instance? DynamicClassLoader cl)
+      (.bindRoot clojure.lang.Compiler/LOADER cl)
       (.setContextClassLoader thread (DynamicClassLoader. cl)))))

 (defn run-app!


expose Reconciler API for sync updates

expose Reconciler API for sync updates

--- src/scrum/core.cljs
+++ src/scrum/core.cljs
@@ -19,7 +19,21 @@
   (r/Reconciler. state controllers (:meta options)))

 (defn dispatch!
-  "Invoke an action on particular controller
+  "Invoke an action on particular controller asynchronously
+
+    (scrum/dispatch! reconciler :users :load \"id\")
+
+  Arguments
+
+    reconciler - an instance of Reconciler
+    controller - name of a controller
+    action     - a dispatch value of a method defined in the controller
+    args       - arguments to be passed into the controller"
+  [reconciler controller action & args]
+  (r/dispatch! reconciler controller action args))
+
+(defn dispatch-sync!
+  "Invoke an action on particular controller synchronously

     (scrum/dispatch! reconciler :users :load \"id\")

@@ -33,7 +47,20 @@
   (r/dispatch! reconciler controller action args))

 (defn broadcast!
-  "Invoke an action on all controllers
+  "Invoke an action on all controllers synchronously
+
+    (scrum/broadcast! reconciler :init)
+
+  Arguments
+
+    reconciler - an instance of Reconciler
+    action     - a dispatch value of a method defined in the controller
+    args       - arguments to be passed into the controller"
+  [reconciler action & args]
+  (r/broadcast! reconciler action args))
+
+(defn broadcast-sync!
+  "Invoke an action on all controllers asynchronously

     (scrum/broadcast! reconciler :init)


enable export

enable export

--- src/survey/core.clj
+++ src/survey/core.clj
@@ -115,9 +115,9 @@
                                  :handle-ok (slurp "resources/data/questionnaire.json")))
   (ANY "/answers" []
      (resource
-      :allowed-methods [:post]
+      :allowed-methods [:post :get]
       :available-media-types ["application/json"]
-;;      :handle-ok (read-answer)
+      :handle-ok (read-answer)
       :post! (fn [ctx]
                (if-let [body (body-as-string ctx)]
                  (try