cleanup `derivatives-pool docstring

cleanup `derivatives-pool docstring

--- src/org/martinklepsch/derivatives.cljc
+++ src/org/martinklepsch/derivatives.cljc
@@ -104,20 +104,14 @@
       nil)))

 (defn derivatives-pool
-  "Given a derivatives spec return a map with `get!` and `free!` functions.
-
-  - (get! derivative-id token) will retrieve a derivative for
+  "Given a derivatives spec return an instance of `DerivativesPool`.
+
+  - `(get! pool derivative-id token)` will retrieve a derivative for
     `derivative-id` registering the usage with `token`
-  - (free! derivative-id token) will indicate the derivative `derivative-id`
-    is no longer needed by `token`, if there are no more tokens needing
-    the derivative it will be removed"
+  - `(release! pool derivative-id token)` will indicate the derivative
+    `derivative-id` is no longer needed by `token`, if there are no
+    more tokens needing the derivative it will be removed"
   [spec]
-  #_(let [dm (map->DerivativesPool {:spec spec
-                                  :watch-key-prefix (prefix-id)
-                                  :graph (spec->graph spec)
-                                  :state (atom {})})]
-    {:get! (partial get! dm)
-     :release! (partial release! dm)})
   (map->DerivativesPool {:spec spec
                          :watch-key-prefix (prefix-id)
                          :graph (spec->graph spec)


change pagination

change pagination

--- src_cljs/rrms/corecljs.cljs
+++ src_cljs/rrms/corecljs.cljs
@@ -14,12 +14,7 @@

 (def storage (r/atom {:documents {}
                       :current-page 1
-                      :total-pages 1
-                      :document {}}))
-
-(def documents (r/atom nil))
-
-(def document (r/atom {}))
+                      :total-pages 1}))

 (defn set-key-value [k v]
   (reset! storage (assoc @storage k v)))
@@ -37,14 +32,12 @@
   (let [total-pages (get-total-rec-no (count data))
         pag-start (* 10 (dec current-page))
         pag-end (+ pag-start 9)]
-    (cond (<= total-pages 1) ((set-key-value :current-page 1)
-                              (set-key-value :total-pages 1)
-                              (clj->js (keep-indexed #(if (< %1 10) %2) data)))
-          :else ((set-key-value :total-pages total-pages)
-                 (when (< total-pages (get-value! :current-page))
-                   (set-key-value :current-page total-pages))
-                 (clj->js (keep-indexed
-                           #(if (and (>= %1 pag-start) (<= %1 pag-end)) %2) data))))))
+    (cond (<= total-pages 1) (do (set-key-value :current-page 1)
+                                 (set-key-value :total-pages 1)
+                                 (clj->js (keep-indexed #(if (< %1 10) %2) data)))
+          :else (do (set-key-value :total-pages total-pages)
+                    (clj->js (keep-indexed
+                              #(if (and (>= %1 pag-start) (<= %1 pag-end)) %2) data))))))

 (defn url-format [url title]
@@ -135,6 +128,7 @@

 (defn save [event]
   (let [onres (fn[data] (set! (.-location js/window) "http://localhost:8193"))]
+    (js/console.log (get-documents-formdata))
     (http-post "http://localhost:8193/documents/add"
                onres  (.serialize (Serializer.) (clj->js (get-documents-formdata))))))

@@ -267,7 +261,7 @@
 (defroute documents-path1 "/documents/update/:id" [id]
   (r/render [document-update-template id
              (first (filter (fn[obj]
-                              (=(.-id obj) (.parseInt js/window id))) @documents))]
+                              (=(.-id obj) (.parseInt js/window id))) (get-value! :documents)))]
             (js/document.getElementById "update")))

 (defroute "*" []


AW & FM | 155 | fixed issue with missing mongodb uri for image lookup

--- src/stonecutter/db/user.clj
+++ src/stonecutter/db/user.clj
@@ -121,7 +121,7 @@
       (dissoc :password)))

 (defn update-profile-picture! [request uid]
-  (let [conn (monger/connect)
+  (let [conn (monger/connect (config/mongo-uri (get-in request [:context :config-m])))
         fs (monger/get-gridfs conn "profile-pictures")
         uploaded-file-path (get-in request [:params :profile-photo :tempfile])
         content-type (get-in request [:params :profile-photo :content-type])
@@ -132,7 +132,7 @@
     (monger/disconnect conn)))

 (defn retrieve-profile-picture [uid config-m]
-  (let [conn (monger/connect)
+  (let [conn (monger/connect (config/mongo-uri config-m))
         fs (monger/get-gridfs conn "profile-pictures")
         uid-regex (str uid ".*")
         file (first (grid-fs/find-by-filename fs {$regex uid-regex}))]


fix out of date use of model fn

fix out of date use of model fn

--- dada-core/src/main/clojure/org/dada/core.clj
+++ dada-core/src/main/clojure/org/dada/core.clj
@@ -345,7 +345,7 @@
   (let [result-set (.executeQuery (.prepareStatement connection sql))
 	metadata (record-metadata [:id] [] nil (sql-attributes (.getMetaData result-set))) ;lets use records...
 	data (sql-data metadata result-set)
-	sql-model (model model-name nil metadata)]
+	sql-model (model model-name metadata)]
     (.close result-set)
     (insert-n sql-model data)
     sql-model))


Remove unreachable code.

Remove unreachable code.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -454,13 +454,8 @@
             (let [path (mapv make-key (:path body))]
               `(make-optional-clause (path-exists-without-binding-clause ~path)))
             (let [[mode body] body
-                  mflat?      (flat? mode)
-                  path        (mapv make-key (if mflat? body (:path body)))]
-              ;; FIXME: this if is always false see line 451?
-              ;; could it be analogue to line 439 'flat? mode'?
-              (if (optional? mode)
-                `(make-optional-clause (path-exists-without-binding-clause ~path))
-                `(path-exists-without-binding-clause ~path))))
+                  path (mapv make-key (if (flat? mode) body (:path body)))]
+              `(path-exists-without-binding-clause ~path)))

           :path-exists-with-binding
           (let [path (mapv make-key (:path body))


get the examples using update and the cleanup-rules

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

--- src/aurora/runtime/core.cljs
+++ src/aurora/runtime/core.cljs
@@ -92,44 +92,47 @@
                              (- {:name :ui/event-listener :id id :entity entity :event event}))
                        ])

+  (def timer-cleanup-rules [(rule {:name :wait :time t :id i}
+                                  (- {:name :wait :time t :id i}))])
+
+  (def io-cleanup-rules [(rule ^get {:name :http-get}
+                               (- get))])
+
+
   (def tick (run-env {:kn #{[3 5] [9 8 7] [:tick]}
-                      :tick-rules [(rule {:name :wait :time t :id i}
-                                         (- {:name :wait :time t :id i}))]
-                      :rules [(rule [:tick]
-                                  (- [:tick])
-                                  (+ {:name :wait :time 1000 :id 1}))
-                              (rule {:name :tick :id 1 :timestamp ts}
-                                  (+ [:tick])
-                                  (+ ["hi!" ts]))]}))
+                      :cleanup-rules (concat ui-cleanup-rules timer-cleanup-rules
+                                             [])
+                      :tick-rules [(rule [:tick]
+                                         (- [:tick])
+                                         (+ {:name :wait :time 1000 :id 1}))]
+                      :rules [(rule {:name :tick :id 1 :timestamp ts}
+                                    (+ [:tick])
+                                    (+ ["hi!" ts]))]}))

   (pause tick)
   (unpause tick)
   @tick

-  (def clock (run-env {:kn #{{:name :tick :id "clock" :timestamp ""}}
-                       :tick-rules [(rule {:name :wait :time t :id i}
-                                          (- {:name :wait :time t :id i}))
-                                    (rule {:name :ui/text :id "time-0" :text text}
-                                          (- {:name :ui/text :id "time-0" :text text}))
-                                    (rule {:name :tick :id "clock" :timestamp ts}
-                                          (+ {:name :wait :time 1000 :id "clock"}))
-                                    ]
+  (def clock (run-env {:kn #{{:name :tick :id "clock"}}
+                       :cleanup-rules (concat ui-cleanup-rules timer-cleanup-rules
+                                              [])
+                       :tick-rules [(rule {:name :tick :id "clock"}
+                                          (+ {:name :wait :time 1000 :id "clock"}))]
                        :rules [[(rule {:name :tick :id "clock" :timestamp ts}
-                                      (+s (hiccup [:p {:id "time"} (str "time is: " (js/Date. ts))])))
-                                ]]
+                                      (+s (hiccup [:p {:id "time"} (str "time is: " (js/Date. ts))])))]]
                        }))

   (pause clock)
   (unpause clock)
-  @clock
+  (-> @clock :kn :old)

   (def incrementer (run-env {:kn #{{:name "counter" :value 0}}
-                             :tick-rules [(rule {:name :ui/text :id "counter-ui-0" :text text}
-                                                (- {:name :ui/text :id "counter-ui-0" :text text}))
-                                          (rule {:name :ui/onClick :id "incr-button"}
+                             :cleanup-rules (concat ui-cleanup-rules timer-cleanup-rules
+                                                    [])
+                             :tick-rules [(rule {:name :ui/onClick :id "incr-button"}
                                                 {:name "counter" :value v}
-                                                (- {:name "counter" :value v})
-                                                (+ {:name "counter" :value (inc v)}))]
+                                                (= z (inc v))
+                                                (> {:name "counter"} {:value z}))]
                              :rules [[(rule {:name "counter" :value v}
                                             (+s (hiccup
                                                  [:p {:id "counter-ui"} v]
@@ -137,20 +140,16 @@

   (pause incrementer)
   (unpause incrementer)
-  (:kn @incrementer)
+  (-> @incrementer :kn :old)

   (def fetcher (run-env {:kn #{{:name "content" :value "Click button to fetch google"}}
-                         :tick-rules [(rule {:name :ui/text :id "content-ui-0" :text text}
-                                             (- {:name :ui/text :id "content-ui-0" :text text}))
-                                       (rule {:name :http-get :url "https://google.com" :id "google"}
-                                             (- {:name :http-get :url "https://google.com" :id "google"}))
-                                       (rule {:name :ui/onClick :id "fetch-button"}
-                                             (+ {:name :http-get :url "https://google.com" :id "google"}))
-                                       (rule {:name :http-response :id "google" :data data}
-                                             {:name "content" :value v}
-                                             (- {:name "content" :value v})
-                                             (+ {:name "content" :value data}))
-                                       ]
+                         :cleanup-rules (concat ui-cleanup-rules timer-cleanup-rules io-cleanup-rules
+                                                [])
+                         :tick-rules [(rule {:name :ui/onClick :id "fetch-button"}
+                                            (+ {:name :http-get :url "https://google.com" :id "google"}))
+                                      (rule {:name :http-response :id "google" :data data}
+                                            (> {:name "content"} {:value data}))
+                                      ]
                          :rules [[(rule {:name "content" :value v}
                                         (+s (hiccup
                                              [:p {:id "content-ui"} v]
@@ -175,11 +174,8 @@
                       :cleanup-rules (concat ui-cleanup-rules
                                              [])
                       :tick-rules [;;on change
-                                   (rule {:name :ui/onChange :id "todo-input"}
-                                         {:name :todo/current-text :value v}
-                                         (- {:name :todo/current-text :value v}))
                                    (rule {:name :ui/onChange :id "todo-input" :value v}
-                                         (+ {:name :todo/current-text :value v}))
+                                         (> {:name :todo/current-text} {:value v}))

                                    ;;submit
                                    (rule {:name :ui/onClick :id "add-todo"}
@@ -191,64 +187,46 @@
                                    (rule {:name :todo/new!}
                                          {:name "counter" :value v}
                                          {:name :todo/current-text :value text}
+                                         (= new-count (inc v))
                                          (- {:name :todo/new!})
-                                         (- {:name "counter" :value v})
-                                         (- {:name :todo/current-text :value text})
-                                         (+ {:name :todo/current-text :value ""})
-                                         (+ {:name "counter" :value (inc v)})
-                                         (+ {:name "todo" :id (inc v) :text text :order (inc v)})
-                                         (+ {:name "todo-editing" :id (inc v) :editing? "false"})
-                                         (+ {:name "todo-done" :id (inc v) :done? "false"})
-                                         )
+                                         (> {:name "counter"} {:value new-count})
+                                         (> {:name :todo/current-text} {:value ""})
+                                         (+ {:name "todo" :id new-count :text text :order new-count})
+                                         (+ {:name "todo-editing" :id new-count :editing? "false"})
+                                         (+ {:name "todo-done" :id new-count :done? "false"}))

                                    ;;todo editing
                                    (rule {:name :ui/onDoubleClick :entity ent}
                                          {:name "todo-editing" :id ent :editing? "false"}
-                                         (- {:name "todo-editing" :id ent :editing? "false"})
-                                         (+ {:name "todo-editing" :id ent :editing? "true"})
-                                         )
+                                         (> {:name "todo-editing" :id ent} {:editing? "true"}))

                                    (rule {:name :ui/onBlur :entity ent}
                                          {:name "todo-editing" :id ent :editing? "true"}
-                                         (- {:name "todo-editing" :id ent :editing? "true"})
-                                         (+ {:name "todo-editing" :id ent :editing? "false"})
-                                         )
-
-
-                                   (rule {:name :ui/onChange :id "todo-editor"}
-                                         {:name :todo/edit-text :value v}
-                                         (- {:name :todo/edit-text :value v}))
+                                         (> {:name "todo-editing" :id ent} {:editing? "false"}))
+
                                    (rule {:name :ui/onChange :id "todo-editor" :value v}
+                                         (> {:name :todo/edit-text} {:value v})
                                          (+ {:name :todo/edit-text :value v}))

                                    (rule {:name :ui/onKeyDown :id "todo-editor" :keyCode 13 :entity ent}
-                                         {:name "todo" :id ent :text text :order order}
                                          {:name :todo/edit-text :value new-value}
-                                         (- {:name "todo" :id ent :text text :order order})
-                                         (+ {:name "todo" :id ent :text new-value :order order})
-                                         (- {:name "todo-editing" :id ent :editing? "true"})
-                                         (+ {:name "todo-editing" :id ent :editing? "false"}))
-
-
-                                   (rule {:name :ui/onChange :event-key "todo-checkbox" :entity ent}
-                                         {:name "todo-done" :id ent :done? done}
-                                         (- {:name "todo-done" :id ent :done? done}))
+                                         (> {:name "todo" :id ent} {:text new-value})
+                                         (> {:name "todo-editing" :id ent} {:editing? "false"}))
+
                                    (rule {:name :ui/onChange :event-key "todo-checkbox" :entity ent :value v}
-                                         (+ {:name "todo-done" :id ent :done? v}))
-
-
-
-
+                                         (> {:name "todo-done" :id ent} {:done? v}))
                                    ]
                       :rules [
                               [(rule {:name "todo" :id id :text text :order order}
-                                     (+s (hiccup
-                                           [:input {:id (str "todo-checkbox" id)
+                                     (= parent-id (str "todo" id))
+                                     (= child-id (str "todo-checkbox" id))
+                                     (+s (hiccup
+                                           [:input {:id child-id
                                                     :event-key "todo-checkbox"
                                                     :entity id
                                                     :events ["onChange"]
                                                     :type "checkbox"}]))
-                                     (+ {:name :ui/child :id (str "todo" id) :child (str "todo-checkbox" id) :pos -1}))
+                                     (+ {:name :ui/child :id parent-id :child child-id :pos -1}))
                                (rule {:name "todo" :id id :text text :order order}
                                      {:name "todo-done" :id id :done? "true"}
                                      (+ {:name :ui/attr :id id :attr "checked" :value "checked"})) ]
@@ -257,12 +235,13 @@
                                      (+s (hiccup
                                           [:li {:id (str "todo" id) :entity id :event-key "todo" :events ["onDoubleClick"]}
                                            text]))
-                                     (+ {:name :ui/child :id "todo-list" :child (str "todo" id) :pos order}))
+                                     (= child-id (str "todo" id))
+                                     (+ {:name :ui/child :id "todo-list" :child child-id :pos order}))
                                (rule {:name "todo" :id id :text text :order order}
                                      {:name "todo-editing" :id id :editing? "true"}
                                      (+s (hiccup
                                           [:input {:id (str "todo-editor") :entity id :event-key "todo-editor" :defaultValue text :events ["onChange" "onKeyDown" "onBlur"]}]))
-                                     (+ {:name :ui/child :id "todo-list" :child (str "todo-editor") :pos order}))
+                                     (+ {:name :ui/child :id "todo-list" :child "todo-editor" :pos order}))
                                ]
                               [(rule {:name :todo/current-text :value v}
                                      (+s (hiccup
@@ -277,6 +256,8 @@
                                      )]
                               ]}))

+  ((query ^todo {:name :todo/edit-text}
+          (+ todo)) (-> @todo :kn))

   (enable-console-print!)
   )


serve index.html

serve index.html

--- server/src/gratefulplace/middleware/routes.clj
+++ server/src/gratefulplace/middleware/routes.clj
@@ -1,6 +1,7 @@
 (ns gratefulplace.middleware.routes
   (:require compojure.route
             compojure.handler
+            [ring.util.response :as resp]
             [gratefulplace.controllers.topics :as topics]
             [gratefulplace.controllers.watches :as watches]
             [gratefulplace.controllers.watched-topics :as watched-topics]
@@ -27,11 +28,18 @@

 (defroutes routes
   (authroute GET "/scripts/load-session.js" js/load-session)
+
+  ;; TODO clean this up

   (apply compojure.core/routes
          (map #(compojure.route/files "/" {:root %})
               (config :html-paths)))
-
+  (apply compojure.core/routes
+         (map #(compojure.route/resources "/" {:root %})
+              (config :html-paths)))
+  (GET "/" [] (resp/file-response "index.html" {:root "html-app"}))
+  (GET "/" [] (resp/resource-response "index.html" {:root "html-app"}))
+
   ;; Topics
   (route GET "/topics" topics/query)
   (authroute GET "/topics/:id" topics/show)


Add point read/write handler to transit.

--- src/uxbox/util/transit.cljs
+++ src/uxbox/util/transit.cljs
@@ -7,34 +7,44 @@
 (ns uxbox.util.transit
   "A lightweight abstraction for transit serialization."
   (:require [cognitect.transit :as t]
+            [com.cognitect.transit :as tr]
             [uxbox.util.data :refer (parse-int)]
+            [uxbox.util.geom.point :as gpt]
             [uxbox.util.datetime :as dt]))

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Read/Write Transit handlers
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; --- Transit Handlers

-(def ^:private datetime-write-handler
-  (reify
-    Object
-    (tag [_ v] "m")
-    (rep [_ v] (dt/format v :offset))
-    (stringRep [this v] (str (dt/format v :offset)))))
+(def datetime-write-handler
+  (t/write-handler (constantly "m")
+                   #(str (dt/format % :offset))))

-(defn- datetime-read-handler
-  [v]
-  (dt/datetime (parse-int v)))
+(def datetime-read-handler
+  (t/read-handler
+   #(dt/datetime (parse-int %))))
+
+(def point-write-handler
+  (t/write-handler
+   (constantly "point")
+   (fn [v]
+     (let [ret #js []]
+       (.push ret (:x v))
+       (.push ret (:y v))
+       ret))))
+
+(def point-read-handler
+  (t/read-handler
+   #(gpt/point (js->clj %))))

 (def ^:privare +read-handlers+
   {"u" uuid
-   "m" datetime-read-handler})
+   "m" datetime-read-handler
+   "point" point-read-handler})

 (def ^:privare +write-handlers+
-  {dt/DateTime datetime-write-handler})
+  {dt/DateTime datetime-write-handler
+   gpt/Point point-write-handler})

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Public Api
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; --- Public Api

 (defn decode
   [data]


Renaming write function to writeTx

Renaming write function to writeTx

--- src/org/libraryweasel/ligature/core.clj
+++ src/org/libraryweasel/ligature/core.clj
@@ -31,7 +31,7 @@
   (collection-name [this])
   (readTx [this]
     "Returns a ReadTx.")
-  (write [this f]
+  (writeTx [this f]
     "Returns a ReadTx/WriteTx."))

 (defprotocol ReadTx


(PDB-2986) Externalize migration log strings

Externalize the log messages in migrate.clj for internationalization

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1255,9 +1255,9 @@
   (try
     (f)
     (catch java.sql.SQLException e
-      (log/error e "Caught SQLException during migration")
+      (log/error e (trs "Caught SQLException during migration"))
       (when-let [next (.getNextException e)]
-        (log/error next "Unravelled exception"))
+        (log/error next (trs "Unravelled exception")))
       (binding [*out* *err*] (flush)) (flush)
       (System/exit 1))))

@@ -1314,7 +1314,7 @@
         (sutils/analyze-small-tables small-tables)
         true)
       (do
-        (log/info "There are no pending migrations")
+        (log/info (trs "There are no pending migrations"))
         false))))

 ;; SPECIAL INDEX HANDLING
@@ -1323,11 +1323,11 @@
   "Create trgm indexes if they do not currently exist."
   []
   (when-not (sutils/index-exists? "fact_paths_path_trgm")
-    (log/info "Creating additional index `fact_paths_path_trgm`")
+    (log/info (trs "Creating additional index `fact_paths_path_trgm`"))
     (jdbc/do-commands
      "CREATE INDEX fact_paths_path_trgm ON fact_paths USING gist (path gist_trgm_ops)"))
   (when-not (sutils/index-exists? "fact_values_string_trgm")
-    (log/info "Creating additional index `fact_values_string_trgm`")
+    (log/info (trs "Creating additional index `fact_values_string_trgm`"))
     (jdbc/do-commands
      "CREATE INDEX fact_values_string_trgm ON fact_values USING gin (value_string gin_trgm_ops)")))

@@ -1339,9 +1339,8 @@
       (trgm-indexes!)
       (log/warn
        (str
-        "Missing PostgreSQL extension `pg_trgm`\n\n"
-        "We are unable to create the recommended pg_trgm indexes due to\n"
-        "the extension not being installed correctly. Run the command:\n\n"
-        "    CREATE EXTENSION pg_trgm;\n\n"
-        "as the database super user on the PuppetDB database to correct\n"
-        "this, then restart PuppetDB.\n")))))
+        (trs "Missing PostgreSQL extension `pg_trgm`")
+        "\n\n"
+        (trs "We are unable to create the recommended pg_trgm indexes due to\nthe extension not being installed correctly.")
+        " "
+        (trs " Run the command:\n\n    CREATE EXTENSION pg_trgm;\n\nas the database super user on the PuppetDB database to correct\nthis, then restart PuppetDB.\n"))))))


(TK-214) Use slingshot for schema errors

--- src/puppetlabs/ring_middleware/core.clj
+++ src/puppetlabs/ring_middleware/core.clj
@@ -111,9 +111,10 @@

 (defn schema-error?
   [e]
-  "Determine if the supplied error is for a schema mismatch"
-  (when (instance? ExceptionInfo e)
-    (re-find #"does not match schema" (.getMessage e))))
+  "Determine if the supplied slingshot error is for a schema mismatch"
+  (when (map? e)
+    (= (:type e)
+       :schema.core/error)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Middleware
@@ -259,7 +260,7 @@
    (let [code 500
          response (fn [e]
                     (let [msg (str "Something unexpected happened:"
-                                   (select-keys (.getData e) [:error :value :type]))]
+                                   (select-keys e [:error :value :type]))]
                       (log/error msg)
                       (case type
                         :json (json-response code
@@ -268,14 +269,9 @@
                                                :message msg}})
                         :plain (plain-response code msg))))]
      (fn [request]
-       ;; We cannot use slingshot.slingshot/try+ (as of 0.12.2) because
-       ;; it will unwrap an IExceptionInfo into a map to match against,
-       ;; while schema will raise a regular ExceptionInfo class to match.
-       (try (handler request)
-            (catch ExceptionInfo e
-              (if (schema-error? e)
-                (response e)
-                (throw e))))))))
+       (sling/try+ (handler request)
+            (catch schema-error? e
+              (response e)))))))

 (schema/defn ^:always-validate wrap-uncaught-errors :- IFn
   "A ring middleware that catches all otherwise uncaught errors and


`find-symbol-in-file`: improve nil handling

Some nil results could be returned; it's better not to include them.

--- src/refactor_nrepl/find/find_symbol.clj
+++ src/refactor_nrepl/find/find_symbol.clj
@@ -121,14 +121,13 @@
                               :line-end end-line
                               :col-beg column
                               :col-end end-column})))))
-        gather (fn [info]
-                 (merge info
-                        {:file (.getCanonicalPath file)
-                         :name fully-qualified-name
-                         :match (match file-content
-                                  (:line-beg info)
-                                  (:line-end  info))}))]
-    (map gather locs)))
+        gather (fn [{:keys [line-beg line-end] :as info}]
+                 (some-> info
+                         (merge
+                          {:file  (.getCanonicalPath file)
+                           :name  fully-qualified-name
+                           :match (match file-content line-beg line-end)})))]
+    (keep gather locs)))

 (defn- find-global-symbol [file ns var-name ignore-errors]
   (let [namespace (or ns (core/ns-from-string (slurp file)))
@@ -220,12 +219,11 @@
                                 first
                                 :name)
             local-occurrences
-            (map #(merge %
-                         {:name var-name
-                          :file (.getCanonicalPath (java.io.File. file))
-                          :match (match file-content
-                                   (:line-beg %)
-                                   (:line-end %))})
+            (map (fn [{:keys [line-beg line-end] :as m}]
+                   (merge m
+                          {:name  var-name
+                           :file  (.getCanonicalPath (java.io.File. file))
+                           :match (match file-content line-beg line-end)}))
                  (find-nodes var-name
                              [top-level-form-ast]
                              #(and (#{:local :binding} (:op %))


capitalization and punctuation

capitalization and punctuation

--- src/babel/italiano/demo.cljc
+++ src/babel/italiano/demo.cljc
@@ -3,6 +3,7 @@
    [babel.italiano :refer [generate]]
    [babel.italiano.morphology :refer [fo]]
    #?(:cljs [babel.logjs :as log])
+   [clojure.string :as string]
    #?(:clj [clojure.tools.logging :as log])))

 (declare run-demo-with)
@@ -40,8 +41,11 @@
                         (println)
                         (let [expressions (run-demo-with n spec)]
                           (count (pmap (fn [expression]
-                                         (do
-                                           (println (fo expression))))
+                                         (let [formatted (fo expression)]
+                                           (println
+                                            (str (string/capitalize (subs formatted 0 1))
+                                                 (subs formatted 1 (count formatted))
+                                                 "."))))
                                        expressions))))))
                 demo-specs))))


force inclusion of smb-fs and real-fs

force inclusion of smb-fs and real-fs

otherwise they are missing when running from the uberjar.

--- src/brainbot/nozzle/main.clj
+++ src/brainbot/nozzle/main.clj
@@ -1,6 +1,7 @@
 (ns brainbot.nozzle.main
   (:require [clojure.tools.logging :as logging])
   (:require [brainbot.nozzle
+             real-fs smb-fs   ;; we need these two for the uberjar
              [fsworker :as fsworker]
              [manage :as manage]
              [extract :as extract]


Remove redirect from oauth success handler

--- src/clj/five_three_one/controllers/google_auth.clj
+++ src/clj/five_three_one/controllers/google_auth.clj
@@ -1,8 +1,8 @@
 (ns five-three-one.controllers.google-auth
   (:require [compojure.core :refer [defroutes GET]]
             [ring.middleware.params :refer [wrap-params]]
-            [ring.util.response :refer [redirect]]
-            [environ.core :refer [env]]
+            [ring.util.response :refer [redirect response content-type]]
+            [environ.core :refer [env]]
             [clj-http.client :as client]
             [clojure.pprint :refer [pprint]]
             ring.util.codec
@@ -54,7 +54,7 @@
                                     :last-name family_name
                                     :email email}))
         session (assoc-in (:session request) [:user] (:uuid user))
-        response (assoc (redirect "/") :session session)]
+        response (assoc (content-type (response "") "text/html") :session session)]
     ;; add user data to session
     (println "from auth")
     (pprint response)


add links to docs to REPL error msg

add links to docs to REPL error msg

--- src/main/shadow/cljs/devtools/server/repl_impl.clj
+++ src/main/shadow/cljs/devtools/server/repl_impl.clj
@@ -145,7 +145,7 @@
                                  runtime-id))]

                        (if-not runtime-id
-                         (do (repl-stderr repl-state "No available JS runtime.\n")
+                         (do (repl-stderr repl-state "No available JS runtime.\nSee https://shadow-cljs.github.io/docs/UsersGuide.html#repl-troubleshooting")
                              (repl-result repl-state nil)
                              (repl-prompt repl-state)
                              (>!! read-lock 1)


[#10432] Fix adding watch-only acc in keycard multiacc

--- src/status_im/ui/screens/wallet/add_new/views.cljs
+++ src/status_im/ui/screens/wallet/add_new/views.cljs
@@ -153,7 +153,8 @@
      [add-account-topbar type]
      [react/scroll-view {:keyboard-should-persist-taps :handled
                          :style                        {:flex 1}}
-      (when-not keycard?
+      (when (or (not keycard?)
+                (= type :watch))
         [settings add-account entered-password])
       [common-settings account]]
      [toolbar/toolbar


added back comments on 3 functions that were removed from prior commit.

--- src/clinvar_submitter/ld.clj
+++ src/clinvar_submitter/ld.clj
@@ -52,11 +52,14 @@
             (when (= v (ld-> t m ks)) m))))

 (defn construct-symbol-table
+  "Construct a map that takes a flattened JSON-LD interpretation as input and associates
+  the IDs in the flattened interpretation with the nodes in the flattened interpretation"
   [coll]
   (let [graph (into [] (get coll "@graph"))]
     (reduce (fn [acc v] (assoc acc (.get v "id") v)) {} graph)))

 (defn flatten-interpretation
+  "Use JSONLD-API to read a JSON-LD interpretation using context-path to translate symbols into local properties"
   [interp-path context-path]
   (with-open [ir (io/reader interp-path)
               cxr (io/reader context-path)]
@@ -66,6 +69,9 @@
       (JsonLdProcessor/flatten i cx opts))))

 (defn generate-symbol-table
+  "Flatten JSON-LD document and return a symbol table returning IDs of nodes mapped to the nodes themselves"
   [interp-path context-path]
   (construct-symbol-table (flatten-interpretation interp-path context-path)))

+
+


add docstrings

add docstrings

--- src/clj/com/rpl/specter.cljc
+++ src/clj/com/rpl/specter.cljc
@@ -517,9 +517,13 @@
   [apath structure]
   (compiled-traverse (i/comp-paths* apath) structure))

-(def compiled-traverse-all i/compiled-traverse-all*)
-
-(defn traverse-all* [apath] (compiled-traverse-all (i/comp-paths* apath)))
+(def ^{:doc "Version of traverse-all that takes in a path precompiled with comp-paths"}
+  compiled-traverse-all i/compiled-traverse-all*)
+
+(defn traverse-all*
+  "Returns a transducer that traverses over each element with the given path."
+  [apath]
+  (compiled-traverse-all (i/comp-paths* apath)))

 ;; Transformation functions


Disable eager form validation for now

Disable eager form validation for now

--- src/cljs/geoforms/forms.cljs
+++ src/cljs/geoforms/forms.cljs
@@ -290,7 +290,7 @@
         [bind-fields
          form-template
          user-doc
-         (fn [k v _]
+         #_ (fn [k v _]
            (let [after (assoc-in @user-doc k v)
                  errors (validate-user after)]
              (assoc after :errors errors)))]


simplify expression

simplify expression

--- src/distillery/view/word.clj
+++ src/distillery/view/word.clj
@@ -57,7 +57,7 @@
               (fn [{:keys [matches] :as category}]
                 (any?
                  (fn [{:keys [word-scores] :as match}]
-                   (contains? (set (keys word-scores)) word-id))
+                   (contains? word-scores word-id))
                  (vals matches)))
               categories)
         items (map


add the correct message and error to the catch

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -183,7 +183,7 @@
                {:message "", :error fail-msg, :url *url*}
                (mark-completed problem code))
         :num-tests-passed (count passed)))
-    (catch Throwable t {:error (.getMessage t), :url *url*
+    (catch Throwable t {:message "" :error (.getMessage t), :url *url*
                         :num-tests-passed 0})))

 (defn static-run-code [id code]


Add ETag to Versions

Add ETag to Versions

--- src/lens/handler/version.clj
+++ src/lens/handler/version.clj
@@ -104,6 +104,8 @@
       (when-let [version (api/version db id)]
         {:version version}))

+    :etag (fn [{:keys [version]}] (-> version :version/id))
+
     :handle-ok
     (fnk [version] (render-version version))


Remove id field from user-info

Remove id field from user-info

--- src/madouc/services/user.clj
+++ src/madouc/services/user.clj
@@ -9,5 +9,11 @@
     (some-> user
             (assoc :authorized (not (nil? (:token user))))
             (dissoc :token)
-            (dissoc :password))))
+            (dissoc :password)
+            (dissoc :id))))

+(defn get-all-info
+  [username]
+  (let [user (db/find-user-by-username (db/main-db) {:username username})]
+    (some-> user
+            (assoc :authorized (not (nil? (:token user)))))))


test hook

test hook

--- src/main/cawala/api/read.clj
+++ src/main/cawala/api/read.clj
@@ -6,7 +6,7 @@
                      :person/relation :friend}
                  2  {:db/id 2 :person/name "Sally" :person/age 22
                      :person/relation :friend}
-                 3  {:db/id 3 :person/name "Allie" :person/age 58
+                 3  {:db/id 3 :person/name "Allie" :person/age 57
                      :person/relation :enemy}
                  4  {:db/id 4 :person/name "Zoe" :person/age 32
                      :person/relation :friend}


notify user when device adapter is reloading and finished reloading

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@10211 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/DeviceAdapterHelper/src/DeviceAdapterHelper/core.clj
+++ plugins/DeviceAdapterHelper/src/DeviceAdapterHelper/core.clj
@@ -1,8 +1,10 @@
 (ns org.micromanager.reloader
   (:use [clojure.java.io :only (file copy)]
         [clojure.data :only (diff)]
-        [org.micromanager.mm :only (load-mm mmc core)]
-        [clojure.pprint :only (pprint)]))
+        [org.micromanager.mm :only (edt load-mm mmc core gui)]
+        [clojure.pprint :only (pprint)])
+  (:import (javax.swing JLabel JWindow)
+           (java.awt Color)))

 (load-mm (org.micromanager.MMStudioMainFrame/getInstance))
@@ -77,15 +79,14 @@
   (apply-state-device-labels dev state-labels))

 (defn reload-device
-  "Reload a single given device."
+  "Reload a single device."
   [dev]
   (let [startup-settings (read-device-startup-settings dev)]
     (core unloadDevice dev)
     (startup-device dev startup-settings)))

 (defn reload-module-fn
-  "Unload all devices in a module. Run housekeeping function.
-   Then load and restart again with the original settings."
+  "Function version of reload-module macro."
   [module housekeeping-fn]
   (let [devs (doall (get (devices-in-each-module) module))
         dev-settings-map (zipmap devs
@@ -96,15 +97,16 @@
       (startup-device dev (dev-settings-map dev)))))

 (defmacro reload-module
+  "Unload all devices in a module. Run housekeeping code.
+   Then load and restart again with the original settings."
   [module & housekeeping]
   `(reload-module-fn ~module (fn [] ~@housekeeping)))

-(defn file-dates [path]
+(defn file-dates
+  "Maps each file in path to its last modification date."
+  [path]
   (let [files (.listFiles (file path))]
     (zipmap files (map #(.lastModified %) files))))
-
-(defn changed-file [path old-dates]
-  (diff old-dates (file-dates path)))

 (defn follow-dir-dates
   "Polls a directory and keeps an up-to-date
@@ -120,37 +122,87 @@
     #(reset! keep-following false)))

 (defn watch-dates
-  [date-atom handle-new-files-fn]
+  "Watches an atom that keeps an up-to-date map of files
+   to modification dates. Runs handle-new-files-fn on any
+   files that change."
+  [date-atom handle-new-file-fn]
   (add-watch date-atom "file-date"
              (fn [_ _ old-val new-val]
                (when-let [new-files (keys (second (diff old-val new-val)))]
-                 (println new-files)
-                 (handle-new-files-fn new-files)))))
-
-(defn module-for-dll [dll]
+                 (doseq [new-file new-files]
+                   (handle-new-file-fn new-file))))))
+
+(defn module-for-dll
+  "Finds the module name for a dll path."
+  [dll]
   (-> dll
       file .getName (.split "\\.")
       first (.replace "mmgr_dal_" "")))

-(defn reload-updated-module [new-dll-version]
+(defonce
+  status-frame
+  (let [l (JLabel.)
+        f (JWindow.)]
+    (edt (doto f
+           (.setAlwaysOnTop true)
+           (.setBounds 0 100 450 50))
+         (.add (.getContentPane f) l)
+         (doto l
+           (.setBackground Color/PINK)
+           (.setOpaque true))
+         )
+    {:label l :frame f}))
+
+(defn label-html
+  "Create the html for a label with 20-point font and internal padding."
+  [& txt]
+  (str "
" (apply str txt) ""))
+
+(defn notify-user-reloading-started
+  "Notify the user that reloading has started."
+  [module]
+  (let [{:keys [frame label]} status-frame]
+    (edt
+      (.setText label (label-html "Reloading " module " module..."))
+    (.show frame))))
+
+(defn notify-user-reloading-finished
+  "Notify the user that reloading has finished."
+  [module]
+  (let [{:keys [frame label]} status-frame]
+    (edt
+      (.setText label (label-html "Finished reloading " module "!"))
+      (.show frame))
+    (future (Thread/sleep 3000)
+            (edt (.hide frame)))))
+
+(defn reload-updated-module
+  "Unload a module, copy the new version to the Micro-Manager
+   directory (overwriting the old version), and then load the module again."
+  [new-dll-version]
   (let [dll (file new-dll-version)
         module (module-for-dll dll)
         loaded-modules (keys (devices-in-each-module))]
     (when (some #{module} loaded-modules)
-      (println "Reloading" module "module...")
-      (reload-module module
-        (copy dll
-              (file "." (.getName dll))))
-      (println "...done!"))))
-
-(defn reload-updated-modules [new-dll-versions]
-  (doseq [dll new-dll-versions]
-    (reload-updated-module dll)))
-
-(defn reload-modules-on-device-adapter-change [dll-dir-path]
+      (let [live-mode (.isLiveModeOn gui)]
+        (when live-mode
+          (.enableLiveMode gui false))
+        (notify-user-reloading-started module)
+        (reload-module module
+                       (copy dll
+                             (file "." (.getName dll))))
+        (notify-user-reloading-finished module)
+        (when live-mode
+          (.enableLiveMode gui true))))))
+
+(defn reload-modules-on-device-adapter-change
+  "Watch the directory where compiled DLLs are placed by Visual
+   Studio. If a device adapter changes, copy it to Micro-Manager
+   directory and reload it."
+  [dll-dir-path]
   (let [date-atom (atom nil)
         stop-fn (follow-dir-dates date-atom dll-dir-path)]
-    (watch-dates date-atom reload-updated-modules)
+    (watch-dates date-atom reload-updated-module)
     stop-fn))


add missing attribute for update

add missing attribute for update

--- test/clj_money/models/entities_test.clj
+++ test/clj_money/models/entities_test.clj
@@ -65,7 +65,8 @@
 (deftest update-an-entity
   (let [entity (entities/create storage-spec {:name "Entity X"
                                               :user-id (:id user)})
-        _ (entities/update-entity storage-spec {:name "Entity Y"})
+        _ (entities/update-entity storage-spec {:id (:id entity)
+                                                  :name "Entity Y"})
         retrieved (entities/find-by-id storage-spec (:id entity))]
     (is (= {:id (:id entity)
             :name "Entity Y"


Updating code to use new elasticsearch vm.

--- test/cmr/system_int_test/url_helper.clj
+++ test/cmr/system_int_test/url_helper.clj
@@ -2,7 +2,7 @@
   cmr.system-int-test.url-helper
   (:require [ring.util.codec :as codec]))

-(def elastic_root "http://localhost:9200")
+(def elastic_root "http://localhost:9210")

 (defn collection-ingest-url
   [provider-id native-id]


Use more concise dot notation instead of 'new' keyword

--- test/nhl_score_api/html_parser_test.clj
+++ test/nhl_score_api/html_parser_test.clj
@@ -5,8 +5,8 @@

 (def resource-path "test/nhl_score_api/resources/")

-(def html-with-games (new File (str resource-path "scores-2015-10-03.htm")))
-(def html-without-games (new File (str resource-path "scores-2015-10-06.htm")))
+(def html-with-games (File. (str resource-path "scores-2015-10-03.htm")))
+(def html-without-games (File. (str resource-path "scores-2015-10-06.htm")))

 (deftest game-score-html-parsing


[scamp] update 'forward-subscription-test

* Add envelope-id to 'core/forward-subscription call.
* Result is now deterministic, so will always be "stuffy-node".

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -33,12 +33,13 @@
             :messages-seen {}}}})))

 (deftest forward-subscription-test
-  (let [result (->> (core/forward-subscription #{"stuffy-node" "stuffier-node"}
-                                               "allergen-free-node")
-                    (map purge-envelope-id))]
-    (is (#{[[:message-envelope "stuffy-node" :forwarded-subscription "allergen-free-node"]]
-           [[:message-envelope "stuffier-node" :forwarded-subscription "allergen-free-node"]]}
-         result))))
+  (binding [scamp.core/*rand* testing-rand*]
+    (let [result (->> (core/forward-subscription #{"stuffy-node" "stuffier-node"}
+                                                 "allergen-free-node"
+                                                 "43")
+                      (map purge-envelope-id))]
+      (is (= result
+           [[:message-envelope "stuffy-node" :forwarded-subscription "allergen-free-node"]])))))

 (deftest do-comm-test
   (is (= (-> core/new-world


Restore analytics behavior to legacy pages

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -265,8 +265,7 @@

                               :shared {:comms comms
                                        :timer-atom (timer/initialize)
-                                       ;; NOMERGE Analytics
-                                       :track-event (constantly nil)
+                                       :track-event #(analytics/track (assoc % :current-state @legacy-state-atom))
                                        ;; Make the legacy-state-atom available to the legacy inputs system.
                                        :_app-state-do-not-use legacy-state-atom}}})]


[scamp] add 'world-with-subs helper fn

[scamp] add 'world-with-subs helper fn

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -54,6 +54,19 @@
         (is (= result
                [[:message-envelope "stuffier-node" :forwarded-subscription "allergen-free-node"]]))))))

+(defn world-with-subs [subscriptions-count]
+  (let [node-name #(str "node-id" %)
+        world (core/add-new-node core/new-world
+                                 (core/node-contact-address->node (node-name 0)))]
+    (loop [world world
+           n 0]
+      (if (>= n subscriptions-count)
+        world
+        (let [new-node-id-num (inc n)]
+          (recur (core/subscribe-new-node (core/do-all-comms world)
+                                          (node-name new-node-id-num)
+                                          (node-name n))
+                 new-node-id-num))))))

 (deftest do-comm-test
   (scamp-test


Bitbucket behind feature flag

Bitbucket behind feature flag

--- src-cljs/frontend/components/add_projects.cljs
+++ src-cljs/frontend/components/add_projects.cljs
@@ -7,6 +7,7 @@
             [frontend.components.forms :refer [managed-button]]
             [frontend.config :as config]
             [frontend.datetime :as datetime]
+            [frontend.models.feature :as feature]
             [frontend.models.organization :as organization]
             [frontend.models.repo :as repo-model]
             [frontend.models.user :as user-model]
@@ -25,6 +26,9 @@

 (def view "add-projects")

+(defn vcs-github? [item] (contains? #{"github" nil} (:vcs_type item)))
+(defn vcs-bitbucket? [item] (= "bitbucket" (:vcs_type item)))
+
 (defn missing-scopes-notice [current-scopes missing-scopes]
   [:div
    [:div.alert.alert-error
@@ -46,12 +50,12 @@
      [:div.orgname login]
      (cond
        ;; TODO remove the nil check after a migration adds vcs-type to all entities
-       (contains? #{"github" nil} vcs-type)
+       (vcs-github? org)
        [:a.visit-org {:href (str (gh-utils/http-endpoint) "/" login)
                       :target "_blank"}
         [:i.octicon.octicon-mark-github]]

-       (= "bitbucket" vcs-type)
+       (vcs-bitbucket? org)
        [:a.visit-org
         [:i.fa.fa-bitbucket]])]))

@@ -69,6 +73,45 @@
    "."])

 (defn organization-listing [data owner]
+  (reify
+    om/IDisplayName (display-name [_] "Organization Listing")
+    om/IDidMount
+    (did-mount [_]
+      (utils/tooltip "#collaborators-tooltip-hack" {:placement "right"}))
+    om/IRender
+    (render [_]
+      (let [{:keys [user settings repos]} data]
+        (html
+         [:div
+          [:div.overview
+           [:span.big-number "1"]
+           [:div.instruction "Choose a GitHub account that you are a member of or have access to."]]
+          [:div.organizations
+           [:h4 "Your accounts"]
+           [:ul.organizations
+            (map (fn [org] (organization org settings owner))
+                 ;; here we display you, then all of your organizations, then all of the owners of
+                 ;; repos that aren't organizations and aren't you. We do it this way because the
+                 ;; organizations route is much faster than the repos route. We show them
+                 ;; in this order (rather than e.g. putting the whole thing into a set)
+                 ;; so that new ones don't jump up in the middle as they're loaded.
+                 (filter vcs-github?
+                  (concat [user]
+                          (:organizations user)
+                          (let [org-names (->> user :organizations (cons user) (map :login) set)
+                                in-orgs? (comp org-names :login)]
+                            (->> repos (map :owner) (remove in-orgs?) (set))))))]
+           (when (:repos-loading user)
+             [:div.orgs-loading
+              [:div.loading-spinner common/spinner]])
+           (missing-org-info owner)]])))))
+
+(defn select-vcs-type [vcs-type item]
+  (case vcs-type
+    "bitbucket" (vcs-bitbucket? item)
+    "github"    (vcs-github?    item)))
+
+(defn organization-listing-with-bitbucket [data owner]
   (reify
     om/IDisplayName (display-name [_] "Organization Listing")
     om/IDidMount
@@ -108,17 +151,18 @@
                  ;; organizations route is much faster than the repos route. We show them
                  ;; in this order (rather than e.g. putting the whole thing into a set)
                  ;; so that new ones don't jump up in the middle as they're loaded.
-                 (filter #(= (:vcs_type %) vcs-type) (concat [user]
-                                     (:organizations user)
-                                     (let [org-names (->> user
-                                                          :organizations
-                                                          (cons user)
-                                                          (map :login)
-                                                          set)
-                                           in-orgs? (comp org-names :login)]
-                                       (->> repos (map :owner)
-                                            (remove in-orgs?)
-                                            (set))))))]
+                 (filter (partial select-vcs-type vcs-type)
+                         (concat [user]
+                                 (:organizations user)
+                                 (let [org-names (->> user
+                                                      :organizations
+                                                      (cons user)
+                                                      (map :login)
+                                                      set)
+                                       in-orgs? (comp org-names :login)]
+                                   (->> repos (map :owner)
+                                        (remove in-orgs?)
+                                        (set))))))]
            (when (:repos-loading user)
              [:div.orgs-loading
               [:div.loading-spinner common/spinner]])]])))))
@@ -427,9 +471,12 @@
          [:p "CircleCI helps you ship better code, faster. To kick things off, you'll need to pick some projects to build:"]
          [:hr]
          [:div.org-listing
-          (om/build organization-listing {:user user
-                                          :settings settings
-                                          :repos repos})]
+          (om/build (if (feature/enabled? :bitbucket)
+                      organization-listing-with-bitbucket
+                      organization-listing)
+                    {:user user
+                     :settings settings
+                     :repos repos})]
          [:hr]
          [:div#project-listing.project-listing
           [:div.overview


Nicer to let breseq create the output directories - easier to track

--- src/aerobio/htseq/wgseq.clj
+++ src/aerobio/htseq/wgseq.clj
@@ -128,7 +128,7 @@
                        (fs/join refbase (str (refxref ref) ".gbk"))
                        (fs/join outs samp)])
                     compvec)]
-     (apply cmn/ensure-dirs (cons outs (mapv last quads)))
+     (cmn/ensure-dirs outs)
      quads)))

 (defmethod cmn/get-comparison-files :wgseq


CMR-3044: Added logging for calls to AWS

--- message-queue-lib/src/cmr/message_queue/queue/sqs.clj
+++ message-queue-lib/src/cmr/message_queue/queue/sqs.clj
@@ -70,6 +70,7 @@
 (defn- -get-topic
   "Returns the Topic with the given display name."
   [sns-client exchange-name]
+  (debug "Calling SNS to get topic " exchange-name)
   (let [exchange-name (normalize-queue-name exchange-name)
         topics (into [] (.getTopics (.listTopics sns-client)))]
    (some (fn [topic]
@@ -199,6 +200,7 @@
 (defn- -get-queue-url
   "Returns the queue url for the given queue name."
   [sqs-client queue-name]
+  (debug "Calling SQS to get URL for queue " queue-name)
   (.getQueueUrl (.getQueueUrl sqs-client queue-name)))

 (def get-queue-url


Remove debugging function

Remove debugging function

--- src/braid/search/server.clj
+++ src/braid/search/server.clj
@@ -12,8 +12,6 @@
 (defn- identity-filter
   [_ results]
   results)
-
-(defn tee [x] (prn x) x)

 (defn search-as
   "Return the ids of all threads, visible to the user, in the given group,


loading ruby remoter

loading ruby remoter

--- src/celestial/workflows.clj
+++ src/celestial/workflows.clj
@@ -18,7 +18,8 @@
     [celestial.model :only (vconstruct pconstruct rconstruct)])
   (:require ; loading defmethods
     proxmox.provider aws.provider vc.provider
-    celestial.puppet_standalone remote.capistrano
+    celestial.puppet_standalone
+    remote.capistrano remote.ruby
     [celestial.persistency :as p]
     [clojure.tools.macro :as tm]
    )


faster implementation of seq-contains?

faster implementation of seq-contains?

--- src/chessground/common.cljs
+++ src/chessground/common.cljs
@@ -1,12 +1,8 @@
 (ns chessground.common
   "Shared utilities for the library")

-(enable-console-print!)
-
-(def debug true)
-
 (defn pp [& exprs]
-  (when debug (doseq [expr exprs] (.log js/console (clj->js expr))))
+  (doseq [expr exprs] (.log js/console (clj->js expr)))
   (first exprs))

 (defn file->pos [key]
@@ -35,7 +31,7 @@
               (or y x)))]
     (merge-with smart-merge a b)))

-(defn seq-contains? [coll target] (some #{target} coll))
+(defn seq-contains? [coll target] (some #(== target %) coll))

 (defn offset [element]
   (let [rect (.getBoundingClientRect element)]


CLJS-1066: Rhino REPL regression

CLJS-1066: Rhino REPL regression

Modernize Rhino REPL so the implementation style is in sync with the
other REPLs.

Fix regressions.

--- src/clj/cljs/repl/rhino.clj
+++ src/clj/cljs/repl/rhino.clj
@@ -7,9 +7,11 @@
 ;; You must not remove this notice, or any other, from this software.

 (ns cljs.repl.rhino
+  (:refer-clojure :exclude [load-file])
   (:require [clojure.string :as string]
             [clojure.java.io :as io]
             [cljs.compiler :as comp]
+            [cljs.closure :as closure]
             [cljs.analyzer :as ana]
             [cljs.repl :as repl]
             [cljs.util :as util])
@@ -18,10 +20,13 @@
                                    RhinoException Undefined]))

 (def ^String bootjs
-  (str "var global = this;"
-       "goog.require = function(rule){"
-       "Packages.clojure.lang.RT[\"var\"](\"cljs.repl.rhino\",\"goog-require\")"
-       ".invoke(___repl_env, __repl_opts, rule);}"))
+  (str "var global = this;\n"
+       "CLOSURE_IMPORT_SCRIPT = function(src) {\n"
+       "    var ns = \"cljs.repl.rhino\","
+       "        name = \"load-file\","
+       "        loadFile = Packages.clojure.lang.RT[\"var\"](ns,name);\n"
+       "    if(src) loadFile.invoke(___repl_env, __repl_opts, src);\n"
+       "};\n"))

 ;; =============================================================================
 ;; Protocols
@@ -36,7 +41,6 @@

   Reader
   (-eval [this {:keys [cx scope]} filename line]
-    (.setOptimizationLevel ^Context cx -1)
     (.evaluateReader cx scope this filename line nil)))

 ;; =============================================================================
@@ -75,38 +79,13 @@
        :value (.toString ex)
        :stacktrace (stacktrace ex)})))

-(defn goog-require [repl-env opts rule]
-  (let [path        (string/replace (comp/munge rule) \. File/separatorChar)
-        output-dir  (util/output-directory opts)
-        cljsc-path  (str output-dir File/separator (str path ".js"))
-        cljs-path   (str path ".cljs")
-        gpath       (-eval (str "goog.dependencies_.nameToPath['" rule "']")
-                      repl-env "<cljs repl>" 1)
-        js-path     (str "goog/" gpath)
-        js-out-path (io/file output-dir "goog"
-                      (string/replace gpath \/ File/separatorChar))]
-    (let [compiled (io/file cljsc-path)]
-      (if (.exists compiled)
-        ;; TODO: only take this path if analysis cache is available
-        ;; - David
-        (do
-          (with-open [reader (io/reader compiled)]
-            (-eval reader repl-env cljsc-path 1)))
-        (if-let [res (io/resource cljs-path)]
-          (binding [ana/*cljs-ns* 'cljs.user]
-            (repl/load-stream repl-env cljs-path res))
-          (if-let [res (io/resource js-path)]
-            (with-open [reader (io/reader res)]
-              (-eval reader repl-env js-path 1))
-            (if (.exists js-out-path)
-              (with-open [reader (io/reader js-out-path)]
-                (-eval reader repl-env js-path 1))
-              (throw
-               (Exception.
-                 (str "Cannot find "
-                   cljs-path " or "
-                   js-path " or "
-                   (.getName js-out-path) " in classpath"))))))))))
+(defn load-file
+  "Load a JavaScript. This is needed to load JavaScript files before the Rhino
+   environment is bootstrapped. After bootstrapping load-javascript will be
+   used."
+  [repl-env opts src]
+  (let [goog-path (io/file (util/output-directory opts) "goog" src)]
+    (rhino-eval repl-env (.getPath goog-path) 1 (slurp goog-path))))

 (defn load-javascript [repl-env ns url]
   (try
@@ -116,18 +95,56 @@
     (catch Throwable ex (println (.getMessage ex)))))

 (defn rhino-setup [repl-env opts]
-  (let [env   (ana/empty-env)
-        scope (:scope repl-env)]
+  (let [opts    (merge {:output-dir ".cljs_rhino_repl"} opts)
+        scope   (:scope repl-env)
+        env     (ana/empty-env)
+        core    (io/resource "cljs/core.cljs")
+        base-js (slurp (io/resource "goog/base.js"))
+        core-js (closure/compile core
+                  (assoc opts
+                    :output-file
+                    (closure/src-file->target-file core)))
+        deps    (closure/add-dependencies opts core-js)
+        output-dir (util/output-directory opts)
+        repl-deps (io/file output-dir "rhino_repl_deps.js")]
+    ;; emit core and deps
+    (apply closure/output-unoptimized
+      (assoc opts :output-to (.getPath repl-deps)) deps)
+
+    ;; setup back references & output stream
+    (ScriptableObject/putProperty scope
+      "___repl_env" (Context/javaToJS repl-env scope))
     (ScriptableObject/putProperty scope "__repl_opts"
       (Context/javaToJS opts scope))
-    (repl/load-file repl-env "cljs/core.cljs" opts)
     (ScriptableObject/putProperty scope
       "out" (Context/javaToJS *out* scope))
-    (binding [ana/*cljs-ns* 'cljs.core]
-      (repl/evaluate-form repl-env env "<cljs repl>"
-        '(do
-           (set! (.-isProvided_ js/goog) (fn [_] false))
-           (set! *print-fn* (fn [x] (.write js/out x))))))))
+
+    ;; define file loading, load goog.base, load repl deps
+    (rhino-eval repl-env "bootjs" 1 bootjs)
+    (rhino-eval repl-env "goog/base.js" 1 base-js)
+    (rhino-eval repl-env "rhino_repl_deps.js" 1 (slurp repl-deps))
+
+    ;; === Bootstrap ===
+    ;; load cljs.core, setup printing
+    (repl/evaluate-form repl-env env "<cljs repl>"
+      '(do
+         (.require js/goog "cljs.core")
+         (set! *print-fn* (fn [x] (.write js/out x)))))
+
+    ;; allow namespace reloading
+    (repl/evaluate-form repl-env env "<cljs repl>"
+      '(set! js/goog.isProvided_ (fn [x] false)))
+
+    ;; monkey-patch goog.require
+    (repl/evaluate-form repl-env env "<cljs repl>"
+      '(do
+         (set! *loaded-libs* #{"cljs.core"})
+         (set! (.-require js/goog)
+           (fn [name reload]
+             (when (or (not (contains? *loaded-libs* name)) reload)
+               (set! *loaded-libs* (conj (or *loaded-libs* #{}) name))
+               (js/CLOSURE_IMPORT_SCRIPT
+                 (aget (.. js/goog -dependencies_ -nameToPath) name)))))))))

 (defrecord RhinoEnv []
   repl/IReplEnvOptions
@@ -146,23 +163,13 @@
   "Returns a fresh JS environment, suitable for passing to repl.
   Hang on to return for use across repl calls."
   []
-  (let [cx (Context/enter)
-        scope (.initStandardObjects cx)
-        base (io/resource "goog/base.js")
-        deps (io/resource "goog/deps.js")
-        new-repl-env (merge (RhinoEnv.) {:cx cx :scope scope})]
-    (assert base "Can't find goog/base.js in classpath")
-    (assert deps "Can't find goog/deps.js in classpath")
-    (ScriptableObject/putProperty scope
-      "___repl_env" (Context/javaToJS new-repl-env scope))
-    (with-open [r (io/reader base)]
-      (-eval r new-repl-env "goog/base.js" 1))
-    (-eval bootjs new-repl-env "bootjs" 1)
-    ;; Load deps.js line-by-line to avoid 64K method limit
-    (with-open [reader (io/reader deps)]
-      (doseq [^String line (line-seq reader)]
-        (-eval line new-repl-env "goog/deps.js" 1)))
-    new-repl-env))
+  (let [cx (Context/enter)]
+    ;; just avoid the 64K method limit
+    ;; Rhino is slow even with optimizations enabled
+    (.setOptimizationLevel cx -1)
+    (merge (RhinoEnv.)
+      {:cx cx
+       :scope (.initStandardObjects cx)})))

 (comment

@@ -179,7 +186,7 @@
   (time (reduce + [1 2 3 4 5]))
   (even? :a)
   (throw (js/Error. "There was an error"))
-  (load-file "clojure/string.cljs")
+  (clojure.core/load-file "clojure/string.cljs")
   (clojure.string/triml "   hello")
   (clojure.string/reverse "   hello")


chore: clean up core requires

chore: clean up core requires

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -1,43 +1,39 @@
 (ns ^:no-doc datasplash.core
   (:require [clj-stacktrace.core :as st]
-            [jsonista.core :as json]
+            [clj-time.coerce :as timc]
+            [clj-time.format :as timf]
             [clojure.edn :as edn]
             [clojure.java.shell :refer [sh]]
             [clojure.math.combinatorics :as combo]
             [clojure.tools.logging :as log]
+            [jsonista.core :as json]
             [superstring.core :as str]
-            [clj-time.format :as timf]
-            [clj-time.coerce :as timc]
             ;; to make aot work
             [taoensso.nippy :as nippy])
   (:import (clojure.lang MapEntry ExceptionInfo)
+           (datasplash.fns
+            ClojureDoFn ClojureStatefulDoFn ClojureCombineFn ClojurePTransform ClojureCustomCoder)
+           (datasplash.pipelines PipelineWithOptions)
+           (java.io InputStream OutputStream DataInputStream DataOutputStream)
            (org.apache.beam.sdk Pipeline)
            (org.apache.beam.sdk.coders StringUtf8Coder KvCoder)
            (org.apache.beam.sdk.io TextIO FileIO TextIO Compression)
+           (org.apache.beam.sdk.io.fs EmptyMatchTreatment)
            (org.apache.beam.sdk.options PipelineOptionsFactory)
            (org.apache.beam.sdk.transforms
-            DoFn DoFn$ProcessContext ParDo Create PTransform
+            Contextful DoFn DoFn$ProcessContext ParDo Create PTransform
             Partition Partition$PartitionFn
             SerializableFunction WithKeys GroupByKey Distinct Count
             Flatten Combine$CombineFn Combine View View$AsSingleton Sample
             Watch$Growth)
            (org.apache.beam.sdk.transforms.join KeyedPCollectionTuple CoGroupByKey CoGbkResult)
+           (org.apache.beam.sdk.transforms.windowing
+            BoundedWindow Window FixedWindows SlidingWindows Sessions Trigger)
            (org.apache.beam.sdk.util UserCodeException)
-           (org.apache.beam.sdk.values KV PCollection TupleTag TupleTagList PBegin
-                                       PCollectionList PInput PCollectionTuple)
-           (org.apache.beam.sdk.io.fs EmptyMatchTreatment)
-           (org.apache.beam.sdk.transforms Contextful)
-           (org.joda.time DateTimeUtils DateTimeZone)
-           (org.joda.time.format DateTimeFormat)
-           (org.apache.beam.sdk.transforms.windowing BoundedWindow Window FixedWindows
-                                                     SlidingWindows Sessions Trigger)
-           (org.joda.time Duration Instant)
-           (datasplash.fns
-            ClojureDoFn ClojureStatefulDoFn ClojureCombineFn ClojurePTransform
-            ClojureCustomCoder)
-           (datasplash.pipelines PipelineWithOptions)
-           (datasplash.coder NippyCoder)
-           (java.io InputStream OutputStream DataInputStream DataOutputStream)))
+           (org.apache.beam.sdk.values
+            KV PCollection TupleTag TupleTagList PBegin PCollectionList PInput PCollectionTuple)
+           (org.joda.time DateTimeUtils DateTimeZone Duration Instant)
+           (org.joda.time.format DateTimeFormat)))

 (def required-ns (atom #{}))

@@ -129,7 +125,7 @@
            (locking clojure.lang.RT/REQUIRE_LOCK
              (let [already-required# (try-deref required-ns)]
                (let [nss# (unloaded-ns-from-ex e#)]
-                 (log/debugf "Catched Exception %s at runtime with message -> %s => already initialized : %s / candidates for init : %s"
+                 (log/debugf "Caught exception %s at runtime with message -> %s => already initialized : %s / candidates for init : %s"
                              (type e#) (.getMessage e#) (into #{} already-required#) (into [] nss#))
                  (if (empty? nss#)
                    (throw (ex-info "Runtime exception intercepted"


Update example

Update example

--- src/cljs/frontend/core.cljs
+++ src/cljs/frontend/core.cljs
@@ -6,14 +6,22 @@

 (js/foo)

-(defonce app-state (r/atom {:y 2015}))
+(defonce app-state (r/atom {:y 2016}))

 (defn main []
   [:div
    [:h1 (foo-cljc (:y @app-state))]
    [:div.btn-toolbar
-    [:button.btn.btn-danger {:type "button" :on-click #(swap! app-state update :y (partial + 5))} "+5"]
-    [:button.btn.btn-success {:type "button" :on-click #(swap! app-state update :y dec)} "-"]]])
+    [:button.btn.btn-danger
+     {:type "button"
+      :on-click #(swap! app-state update :y inc)} "+"]
+    [:button.btn.btn-success
+     {:type "button"
+      :on-click #(swap! app-state update :y dec)} "-"]
+    [:button.btn.btn-default
+     {:type "button"
+      :on-click #(js/console.log @app-state)}
+     "Console.log"]]])

 (defn start! []
   (js/console.log "Starting the app")


Simplified tiling when unit is selected

Simplified tiling when unit is selected

--- src/cljs/zetawar/views.cljs
+++ src/cljs/zetawar/views.cljs
@@ -80,21 +80,13 @@
                    @(subs/current-unit-at? conn q r)
                    (not @(subs/unit-can-act? conn q r)))

-              ;; Unit selected and tile is a valid attack or move target
-              ;; However, selected cannot repair others
+              ;; Unit selected and tile is a valid attack, repair, or move target
               (and @(subs/unit-selected? conn)
-                   (not @(subs/selected? conn q r))
-                   (not @(subs/selected-can-repair-other? conn))
-                   (not @(subs/enemy-in-range-of-selected? conn q r))
-                   (not @(subs/valid-destination-for-selected? conn q r)))
-
-              ;; Same as previous code block, but unit CAN repair others
-              (and @(subs/unit-selected? conn)
-                   @(subs/selected-can-repair-other? conn)
                    (not @(subs/selected? conn q r))
                    (not @(subs/enemy-in-range-of-selected? conn q r))
                    (not (and @(subs/friend-in-range-of-selected? conn q r)
-                             @(subs/can-be-repaired? conn q r)))
+                             @(subs/can-be-repaired? conn q r)
+                             @(subs/selected-can-repair-other? conn)))
                    (not @(subs/valid-destination-for-selected? conn q r))))]
     [:image {:visibility (if show "visible" "hidden")
              :x x :y y


Change the max # of db connections to 25 per pool, 25 for reads, 25 for writes

--- src/com/puppetlabs/jdbc.clj
+++ src/com/puppetlabs/jdbc.clj
@@ -262,7 +262,7 @@
            stats log-statements log-slow-statements
            conn-max-age conn-lifetime conn-keep-alive read-only?]
     :or   {partition-conn-min  1
-           partition-conn-max  50
+           partition-conn-max  25
            partition-count     1
            stats               true
            ;; setting this to a String value, because that's what it would


Remove unnecessary table head

Remove unnecessary table head

--- src/braid/uploads_page/views/uploads_page.cljs
+++ src/braid/uploads_page/views/uploads_page.cljs
@@ -81,8 +81,6 @@

         :else
         [:table.uploads
-         [:thead
-          [:tr [:th ""] [:th ""] [:th ""] [:th ""]]]
          [:tbody
           (doall
             (for [upload uploads]


add delete databases

add delete databases

--- tutorial/social_news.clj
+++ tutorial/social_news.clj
@@ -109,4 +109,6 @@
 ;; and then pull it during the :find.
 (def users-with-upvotes
   (d/q '[:find (pull ?e [:user/email {:user/upVotes [:story/url]}])
-         :where [?e :user/email]] (d/db conn)))+         :where [?e :user/email]] (d/db conn)))
+
+(repl/delete-scratch-dbs "config.edn")


show 0 in orthologue table if there are no go terms for a given branch

--- src/cljs/gointermod/orthologresults/views.cljs
+++ src/cljs/gointermod/orthologresults/views.cljs
@@ -46,9 +46,9 @@
               [:td.organism (utils/get-abbrev organism)]
               [:td (:original-id ortholog-details)]
               [:td (clj->js ortholog)]
-              [:td (:biological_process ortholog-details)]
-              [:td (:molecular_function ortholog-details)]
-              [:td (:cellular_component ortholog-details)]
+              [:td (get ortholog-details :biological_process 0)]
+              [:td (get ortholog-details :molecular_function 0)]
+              [:td (get ortholog-details :cellular_component 0)]
               [:td.dataset (:dataset ortholog-details)]
             ]) organism-details))
         ) @results))]))


changed next session date in russian

changed next session date in russian

--- src/cljs/work_sessions/components/headers.cljs
+++ src/cljs/work_sessions/components/headers.cljs
@@ -84,7 +84,7 @@
    [:p
     (unescapeEntities "Продолжительность сессии — 1 час, с 13.30 до 14.30 по Хельсинки и Москве.")]
    [:p
-    (unescapeEntities "Следующая сессия будет через неделю — 16 июня в это же время.")]
+    (unescapeEntities "Следующая сессия будет через неделю — 23 июня в это же время.")]
    [:p
     "Если ты присоединяешься к сессии при помощи компьютера. Открываешь в "
     [:a {:href "https://www.google.com/chrome/"


Ditto

Ditto

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -1,3 +1,12 @@
+;; Copyright (c) 2012-2014 Michael S. Klishin, Alex Petrov, and the ClojureWerkz Team
+;;
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
 (ns clojurewerkz.cassaforte.client
   "Provides fundamental functions for


Improve naming for deref

Improve naming for deref

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -95,8 +95,8 @@
     (conv/to-clj @fut))

   clojure.lang.IBlockingDeref
-  (deref [_ time-period time-unit]
-    (conv/to-clj (deref fut time-period time-unit)))
+  (deref [_ timeout-ms default-val]
+    (conv/to-clj (deref fut timeout-ms default-val)))

   Listenable
   (add-listener [_ runnable executor]


stay at :choose-recipient screen when address is invalid

--- src/status_im/ui/screens/wallet/choose_recipient/events.cljs
+++ src/status_im/ui/screens/wallet/choose_recipient/events.cljs
@@ -31,7 +31,6 @@
           ;; isAddress works with or without address with leading '0x'
           valid-address? (.isAddress web3 address)]
       (cond-> {:db db}
-        (= :choose-recipient view-id) (assoc :dispatch [:navigate-back])
         valid-address? (update :db #(choose-address-and-name % address name (:value m)))
         (not valid-address?) (assoc :show-error (i18n/label :t/wallet-invalid-address {:data data}))))))


Code tidy

Code tidy

--- src/cortex/impl/layers.cljc
+++ src/cortex/impl/layers.cljc
@@ -378,7 +378,7 @@
         (m/sqrt! sd)
         this))

-;; DENOISING AUTOENCODER
+;; AUTOENCODER
 (defn noise-fn ^double [^double x]
   (if (< 0.2 (util/rand-normal))
     (util/rand-gaussian)
@@ -386,7 +386,7 @@

 #?(:cljs (register-module cortex.impl.layers.Autoencoder))
 (defrecord Autoencoder
-  [up down input-tmp output-tmp ]
+  [up down input-tmp output-tmp]
   cp/PModule
     (cp/calc [m input]
       (let [up (cp/calc up input)]


Smaller 4k buf for netchan IO ops

Smaller 4k buf for netchan IO ops

--- src/engulf/comm/netchan.clj
+++ src/engulf/comm/netchan.clj
@@ -27,7 +27,7 @@
   [^bytes ba]
   (let [bais (ByteArrayInputStream. ba)
         gzis (GZIPInputStream. bais)
-        buf-size (* 100 1024)
+        buf-size 4096
         baos (ByteArrayOutputStream.)]
     (loop []
       (let [buf (byte-array buf-size)


Hierarchy seems to work.

Hierarchy seems to work.

--- src/exp/2d_manipulation.clj
+++ src/exp/2d_manipulation.clj
@@ -255,9 +255,10 @@
                               (primitive? [] false)
     env/ContextualAction      (precondition-context [s] (reach-context s))
     hierarchy/HighLevelAction (immediate-refinements- [s]
-                                (if (= dst-go (env/get-var s [:gripper-pos]))
+                                (if (= dst-go (env/get-var s [:gripper-offset]))
                                     [[]]
-                                  (for [dir dirs] [(make-gripper-dir s dir) this])))
+                                  (for [dir dirs :let [a (make-gripper-dir s dir)] :when a]
+                                    [a this])))
                               (cycle-level- [s] 1)))
 ; manhattan, SLD?  range?

@@ -270,11 +271,12 @@
   hierarchy/HighLevelAction (immediate-refinements- [s]
                              (let [base (env/get-var s [:base])
                                    opos (env/get-var s [:pos o])]
-                               (for [[dirname dir] dirs]
-                                 (let [gpos (sub-pos opos dir)
-                                       go   (sub-pos gpos base)]
-                                   [(make-reach-hla env go)
-                                    (make-pickup dirname base go o opos)]))))
+                               (for [[dirname dir] dirs
+                                     :let [gpos (sub-pos opos dir)
+                                           go   (sub-pos gpos base)
+                                           a    (make-reach-hla env go)]
+                                     :when a]
+                                 [a (make-pickup dirname base go o opos)])))
                             (cycle-level- [s] nil)))
 ;manhattan
 ;pess: SLD?
@@ -287,11 +289,12 @@
                               (conj (reach-context s) [:holding]))
   hierarchy/HighLevelAction (immediate-refinements- [s]
                              (let [base (env/get-var s [:base])]
-                               (for [[dirname dir] dirs]
-                                 (let [gpos (sub-pos dst dir)
-                                       go   (sub-pos gpos base)]
-                                   [(make-reach-hla env go)
-                                    (make-putdown dirname base go o dst)]))))
+                               (for [[dirname dir] dirs
+                                     :let [gpos (sub-pos dst dir)
+                                           go   (sub-pos gpos base)
+                                           a    (make-reach-hla env go)]
+                                     :when a]
+                                 [a (make-putdown dirname base go o dst)])))
                             (cycle-level- [s] nil)))
 ;manhattan
 ;pess: SLD?
@@ -308,7 +311,8 @@
   hierarchy/HighLevelAction (immediate-refinements- [s]
                              (if (= dst (env/get-var s [:base]))
                                [[]]
-                               (for [dir dirs] [(make-base-dir s dir) this])))
+                               (for [dir dirs :let [a (make-base-dir s dir)] :when a]
+                                 [a this])))
                             (cycle-level- [s] 1)))
 ; manhattan
 ; pess? SLD? (try direct line, if occ then -inf).
@@ -322,14 +326,19 @@
                              (let [base (env/get-var s [:base])]
                                (if (= base dst)
                                   [[]]
-                                 [[(ReachHLA env [0 0]) (make-unpark s)
-                                   (NavHLA dst) (make-park s)]])))
+                                 [[(make-reach-hla env [0 0]) (make-unpark s)
+                                   (make-nav-hla env dst) (make-park s)]])))
                             (cycle-level- [s] nil)))
 ; manhattan + park (if appl)
 ; pess? SLD?

+(defn move-to-front [x s]
+  (if (some #{x} s)
+      (cons x (remove #{x} s))
+    s))
+
 ;; TODO: check out state abstraction here
-
+;; Note: since we may not sample current position, have to special case.
 (defn make-go-grasp-hla [env o]
  (reify :as this
   env/Action                (action-name [] [:go-grasp o])
@@ -339,15 +348,18 @@
                                     [:pos o] [:at-goal? o] [:holding]))
   hierarchy/HighLevelAction (immediate-refinements- [s]
                              (let [const (env/get-var s :const)
+                                   base  (env/get-var s [:base])
                                    free  (get const [:freespace])
                                    opos  (env/get-var s [:pos o])]
                                (for [dst (->> (get const [:base-offsets])
                                               (map #(add-pos % opos))
                                               (filter free)
+                                              (move-to-front base)
                                               (take (get const [:n-base-samples])))]
                                  [(make-move-base-hla env dst) (make-grasp-hla env o)])))
                             (cycle-level- [s] nil)))

+;; Note: since we may not sample current position, have to special case.
 (defn make-go-drop-at-hla [env o o-dst]
  (reify :as this
   env/Action                (action-name [] [:go-drop-at o o-dst])
@@ -356,13 +368,16 @@
                               (conj (reach-context s o-dst) [:holding]))
   hierarchy/HighLevelAction (immediate-refinements- [s]
                              (let [const (env/get-var s :const)
+                                   base  (env/get-var s [:base])
                                    free  (get const [:freespace])]
                                (for [dst (->> (get const [:base-offsets])
                                               (map #(add-pos % o-dst))
                                               (filter free)
+                                              (move-to-front base)
                                               (take (get const [:n-base-samples])))]
                                  [(make-move-base-hla env dst) (make-drop-at-hla env o o-dst)])))
                             (cycle-level- [s] nil)))
+

 (defn make-go-drop-hla [env o]
  (reify :as this
@@ -403,7 +418,7 @@
                               (let [remaining (remove #(env/get-var s [:at-goal? %])
                                                (map first (get (env/get-var s :const) [:objects])))]
                                 (if (empty? remaining)
-                                    [[]]
+                                    [[(make-reach-hla env [0 0])]]
                                   (for [o remaining] [(make-move-to-goal-hla env o) this]))))
                             (cycle-level- [s] 2))))


bump ops

bump ops

--- src/funimage/imagej/ops.clj
+++ src/funimage/imagej/ops.clj
@@ -27,43 +27,44 @@

 (def valid-ops (into #{} (.ops (.op ij/ij))))

-
-(doall
-  (for [[op-name op-infos] (group-by #(.getName %)
-                                     (filter #(valid-ops (.getName %))
-                                             (filter #(not (infos-ignore (.getName %)))
-                                                     (.infos (.op ij/ij)))))
-        op-info op-infos]
-    (eval
-      (let [expr (with-out-str
-                   (let [op-expression "(.op ij/ij)"]
-                     ;(.println (System/err) (str "defn " (.getName op-info) op-info))
-                     ;(.println (System/err) (str "defn " (.getName op-info) " " (.getClassName (.cInfo op-info))))
-                     (let [parts (string/split (.getName op-info) #"\.")
-                           cinfo (.cInfo op-info)
-                           required-inputs (filter #(.isRequired %) (seq (.inputs cinfo)))
-                           optional-inputs (filter #(not (.isRequired %)) (seq (.inputs cinfo)))
-                           arg-list (string/join
-                                      " "
-                                      (map #(str (make-typehint (.getType %)) " " (.getName %))
-                                           required-inputs))
-                           args-to-pass (string/join
-                                          " "
-                                          (map #(.getName %)
-                                               required-inputs))
-                           op-name (str op-name (when (> (count op-infos) 1)
-                                                  (let [classname (.getClassName (.cInfo op-info))
-                                                        tail-part (last (string/split classname #"\."))
-                                                        extension (if (.contains tail-part "$")
-                                                                    (last (string/split tail-part #"\$"))
-                                                                    tail-part)]
-                                                    (str "." extension))))]
-                       #_(.println (System/err) (string/join " " (map #(.getType %) (seq (.inputs cinfo)))))
-                       (println "(defn" (string/replace op-name "." "-"))
-                       (println "\t\"" (.getTitle cinfo) "\"")
-                       (println "\t[" arg-list "]")
-                       (println (str "\t(." (second parts) " (." (first parts) " " op-expression ") " args-to-pass "))")))))]
-        ;(println expr)
-        (read-string expr)))))
+(def op-list
+  (doall
+    (for [[op-name op-infos] (group-by #(.getName %)
+                                       (filter #(valid-ops (.getName %))
+                                               (filter #(not (infos-ignore (.getName %)))
+                                                       (.infos (.op ij/ij)))))
+          op-info op-infos]
+      (eval
+        (let [expr (with-out-str
+                     (let [op-expression "(.op ij/ij)"]
+                       ;(.println (System/err) (str "defn " (.getName op-info) op-info))
+                       ;(.println (System/err) (str "defn " (.getName op-info) " " (.getClassName (.cInfo op-info))))
+                       (let [parts (string/split (.getName op-info) #"\.")
+                             cinfo (.cInfo op-info)
+                             required-inputs (filter #(.isRequired %) (seq (.inputs cinfo)))
+                             optional-inputs (filter #(not (.isRequired %)) (seq (.inputs cinfo)))
+                             arg-list (string/join
+                                        " "
+                                        (map #(str (make-typehint (.getType %)) " " (.getName %))
+                                             required-inputs))
+                             args-to-pass (string/join
+                                            " "
+                                            (map #(.getName %)
+                                                 required-inputs))
+                             op-name (str op-name (when (> (count op-infos) 1)
+                                                    (let [classname (.getClassName (.cInfo op-info))
+                                                          tail-part (last (string/split classname #"\."))
+                                                          extension (string/replace tail-part "$" "-")
+                                                                      #_(if (.contains tail-part "$")
+                                                                         (last (string/split tail-part #"\$"))
+                                                                         tail-part)]
+                                                      (str "." extension))))]
+                         #_(.println (System/err) (string/join " " (map #(.getType %) (seq (.inputs cinfo)))))
+                         (println "(defn" (string/replace op-name "." "-"))
+                         (println "\t\"" (.getTitle cinfo) "\"")
+                         (println "\t[" arg-list "]")
+                         (println (str "\t(." (second parts) " (." (first parts) " " op-expression ") " args-to-pass "))")))))]
+          ;(println expr)
+          (read-string expr))))))


added support for glyph-wise rectangles and rotation

--- src/mastersign/wordcloud.clj
+++ src/mastersign/wordcloud.clj
@@ -1,5 +1,4 @@
 (ns mastersign.wordcloud
-  (:import [java.lang Math])
   (:import [java.awt Graphics Graphics2D Color RenderingHints Font])
   (:import [java.awt.geom Area
             Rectangle2D Rectangle2D$Float
@@ -18,34 +17,33 @@
 (def base-font (Font. font-family font-style (float 100)))

 (def default-args
-  {:width 400
+  {:width 600
    :height 200
-   :precision 0.66
+   :precision 0.5
    :font base-font
-   :min-font-size 14
+   :min-font-size 13
    :max-font-size 60
-   :max-test-radius 250
-   :padding 4
+   :max-test-radius 350
+   :padding 2
+   :shape-mode :glyph-box ; :word-box, :glyph-box
+   :allow-rotation true
    })
-
-(defn- get-rect
-  [g font x]
-  (string-centered-rect g font (first x)))

 (defn- calc-font-size
   [{:keys [min-font-size max-font-size]} v]
   (float (+ min-font-size (* (- max-font-size min-font-size) v v))))

 (defn- get-font
-  [{:keys [font min-font-size max-font-size] :as args} x]
-  (.deriveFont font (calc-font-size args (second x))))
+  [{:keys [font] :as args} v]
+  (.deriveFont font (calc-font-size args v)))

 (defn- build-word-info
-  [g args w]
-  (let [text (first w)
-        font* (get-font args w)
-        rect (get-rect g font* w)]
-      {:text text :font font* :rect rect}))
+  [g args [text value]]
+  (let [font* (get-font args value)]
+    {:text text
+     :font font*
+     :word-bounds (string-centered-bounds g font* text)
+     :glyph-bounds (string-centered-glyphbounds g font* text)}))

 (defn- build-word-infos
   [word-stats & args]
@@ -74,25 +72,63 @@
     (map (partial polar-point r) (range 0.0 (* 2 Math/PI) step))))

 (defn- test-sequence
-  [{:keys [precision max-font-size max-test-radius] :as args}]
+  [{:keys [precision max-font-size max-test-radius] :as args} {:keys [text] :as word-info}]
   (let [imprecision (* (- 1.0 precision) (- 1.0 precision))
         radii (take-while
                   #(< % max-test-radius)
-                  (map #(* (+ 1 (* imprecision max-font-size)) %) (lazy-numbers 1)))
+                  (map #(* (+ 1 (* imprecision max-font-size 0.5)) %) (lazy-numbers 1)))
         rings (map #(test-ring % precision) radii)]
     (cons (point) (apply concat rings))))

+(defn- rotate-rect
+  [r c a]
+  (if (= a 0)
+    r
+    (let [x (.x r)
+          y (.y r)
+          w (.width r)
+          h (.height r)
+          cx (.x c)
+          cy (.y c)
+          dx (- x cx)
+          dy (- y cy)]
+      (case a
+        90 (rectangle (- cx dy h) (+ cy dx) h w)
+        180 (rectangle (- cx dx w) (- cy dy h) w h)
+        270 (rectangle (+ cx dy) (- cy dx w) h w)))))
+
+(defn- get-word-rects
+  [{:keys [shape-mode padding]} word-info pos rotation use-padding]
+  (let [rects (case shape-mode
+                :word-box [(translate-rect (:word-bounds word-info) pos)]
+                :glyph-box (map #(translate-rect % pos) (:glyph-bounds word-info)))
+        rects (if use-padding
+                (map #(grow-rect % padding) rects)
+                rects)
+        rects (map #(rotate-rect % pos rotation) rects)]
+    rects))
+
 (defn- check-position
-  [test-area boundaries {:keys [rect]} p]
-  (let [rect* (translate-rect rect p)]
-  (and
-   (.contains boundaries rect*)
-   (not (.intersects test-area rect*)))))
+  [args test-area boundaries word-info pos rotation]
+  (let [rects (get-word-rects args word-info pos rotation false)]
+    (if (and
+         (every? #(.contains boundaries %) rects)
+         (every? #(not (.intersects test-area %)) rects))
+      [pos rotation]
+      nil)))

 (defn- find-position
-  [test-area boundaries point-sequence {:keys [rect] :as word-info}]
-  (first (filter #(check-position test-area boundaries word-info %)
-              point-sequence)))
+  [{:keys [allow-rotation] :as args} test-area boundaries point-sequence {:keys [word-bounds] :as word-info}]
+  (let [cp (partial check-position args test-area boundaries word-info)
+        cp (if allow-rotation
+               (fn [pos] (or (cp pos 0) (cp pos 90) (cp pos 270)))
+               (fn [pos] (cp pos 0)))]
+    (first (filter #(not (nil? %)) (map cp point-sequence)))))
+
+(defn- add-word-to-area!
+  [args *area* word-info pos rotation]
+  (let [rects (get-word-rects args word-info pos rotation true)]
+    (.add *area* (apply area rects))))

 (defn generate-cloud
   [word-infos & args]
@@ -100,33 +136,37 @@
         {:keys [width height padding]} args
         boundaries (area (rectangle (- (/ width 2)) (- (/ height 2)) width height))
         *test-area* (area)
-        point-sequence (test-sequence args)
-        finder (fn [{:keys [text rect] :as word-info}]
+        finder (fn [{:keys [text word-bounds] :as word-info}]
                  ;(println (str "Placing " text " ..."))
-                 (let [hit (find-position *test-area* boundaries point-sequence word-info)]
+                 (let [point-sequence (test-sequence args word-info)
+                       [hit rotation] (find-position args *test-area* boundaries point-sequence word-info)]
                    (if (nil? hit)
                      nil
                      (do
-                       (.add *test-area* (area (grow-rect (translate-rect rect hit) padding)))
+                       (add-word-to-area! args *test-area* word-info hit rotation)
                        ;(println (str "Found place at " (.x hit) ", " (.y hit)))
-                       (assoc word-info :position hit)))))]
-    (doall (map finder word-infos))))
+                       (assoc word-info :position hit :rotation rotation)))))]
+    {:word-infos (doall (map finder word-infos))
+     :test-area *test-area*}))

 (defn- cloud-painter
-  [word-infos g w h]
-  (doto g
-    setup)
-
-  (doseq [{:keys [text font position]} (filter #(not (nil? %)) word-infos)]
-    (draw-string-centered g text
-                          (+ (/ w 2.0) (.x position))
-                          (+ (/ h 2.0) (.y position)) :font font)))
+  [{:keys [word-infos test-area]} g w h]
+  (let [c (point (/ w 2.0) (/ h 2.0))
+        bg (translate-area test-area c)]
+    (doto g
+      setup
+      ;(draw-rect (rectangle 0 0 (dec w) (dec h)))
+      ;(fill-shape bg)
+      ;(draw-shape bg)
+      )
+    (doseq [{:keys [text font position rotation]} (filter #(not (nil? %)) word-infos)]
+      (draw-string-centered g text (translate-point c position) :font font :rotation rotation))))

 (defn paint-cloud
-  [word-infos & args]
+  [cloud & args]
   (let [args (merge default-args)]
     (create-image (:width args) (:height args)
-                  (partial cloud-painter word-infos))))
+                  (partial cloud-painter cloud))))

 ; ########################

@@ -134,27 +174,34 @@
   [g w h]
   (let [font (.deriveFont base-font (float 30.0))
         text "MjgqAIkqQ$§|"
-        r1 (string-centered-rect g font text 100 30 )
-        r2 (string-centered-rect g font text 100 60)
+        p1 (point 100 30)
+        p2 (point 100 60)
+        pc (point 200 150)
+        r1 (string-centered-bounds g font text p1)
+        r2 (string-centered-bounds g font text p2)
         a1 (Area. r1)
+        c1 (rect-center r1)
         c2 (rect-center r2)]
     (doto g
       setup
       ;(draw-rect (rectangle 0 0 (dec w) (dec h)))
       ;(fill-rect r1)
       ;(draw-rect r1)
-      ;(draw-string-centered text 100 30 :font font)
-      ;(draw-string-centered text 100 60 :font font)
+      ;(fill-rect r2)
+      ;(draw-rect r2)
+      ;(draw-string-centered text p1 :font font)
+      ;(draw-string-centered text p2 :font font)
+      ;(draw-dot c1)
       ;(draw-dot c2)

-      ;(draw-dot (point 200 100))
-      ;(draw-dot-seq 200 100 (test-ring 50 0.2))
-      ;(draw-dot-seq 200 100 (test-ring 10 0.2))
-
-      (draw-dot-seq 200 100 (test-sequence default-args))
+      (draw-dot pc)
+      ;(draw-dots (test-ring 50 0.2) pc)
+      ;(draw-dots (test-ring 10 0.2) pc)
+
+      (draw-dots (test-sequence default-args {:text "Alpha"}) pc)
       )))

-(let [img (create-image 400 200 test-painter)]
+(let [img (create-image 400 300 test-painter)]
   (save-image img "D:/Temp/test.png"))

 ; ########################
@@ -164,7 +211,8 @@
    "Golf" "Hotel" "India" "Juliette" "Kilo" "Lima"
    "Mike" "November" "Oscar" "Papa" "Quebec" "Romeo"
    "Sierra" "Tango" "Uniform" "Victor" "Whiskey" "X-Ray"
-   "Yankee" "Zulu"])
+   "Yankee" "Zulu"
+   "Adventskalender" "Mittelpunktbestimmung" "Zentralfeuerwaffe"])

 (def stats (vec (map (fn [x] [x (/ (rand-int 101) 100.0)]) words)))


Add -main

Add -main

--- src/obb_rules_api/routes.clj
+++ src/obb_rules_api/routes.clj
@@ -13,3 +13,7 @@

 (def app
   (handler/site api-routes))
+
+(defn -main [& [port]]
+  (let [port (Integer. (or port (env :port) 5000))]
+    (jetty/run-jetty (site #'api-routes) {:port port :join? false})))