restrict columsn on update

restrict columsn on update

--- src/er_cassandra/record.clj
+++ src/er_cassandra/record.clj
@@ -87,9 +87,11 @@
   ([table
     key
     record
-    {:keys [only-if if-exists using] :as opts}]
+    {:keys [only-if if-exists using set-columns] :as opts}]
    (let [key-clause (extract-key-equality-clause key record opts)
-         set-cols (apply dissoc record (make-sequential key))]
+         set-cols (if (not-empty set-columns)
+                    (select-keys record set-columns)
+                    (apply dissoc record (make-sequential key)))]
      (h/update table
                (h/set-columns set-cols)
                (h/where key-clause)


Silencing ns creation in ops

Silencing ns creation in ops

--- src/funimage/imagej/ops.clj
+++ src/funimage/imagej/ops.clj
@@ -86,7 +86,6 @@
                    (str "(fn " (string/join " " (vals arity-map)) ")"))]
         ; Test if the NS exists, if it doesn't then make it
         (when-not (try (ns-name op-namespace) (catch Exception e nil))
-          (println "Making ns:" op-namespace)
           (create-ns op-namespace)
           (swap! ops-namespaces conj op-namespace))
         ; Make the function and load it into the respective namespace


More exception handling

More exception handling

--- src/clinvar_submitter/form.clj
+++ src/clinvar_submitter/form.clj
@@ -28,6 +28,7 @@
   (defn interp-eval-date
   "Return the interpretation evaluation date."
   [t i]
+  (if(nil? (ld-> t i "contribution")) (log/debug (str "Exception in interp-eval-date: contribution not found")))
   (let [contribution (ld-> t i "contribution")]
     (if (nil? (get contribution "onDate")) ""
       (.format
@@ -102,6 +103,7 @@
      :alt - alternate seq"
   [t i]
   (let [v (ld1-> t i "variant" "relatedContextualAllele" (prop= t true "preferred"))]
+  (if (nil? v ) (log/debug (str "Exception in get-variant: relatedContextualAllele not found")))
     {:variantIdentifier (variant-identifier v),
      :altDesignations (variant-alt-designations v),
      :refseq (variant-refseq t v),
@@ -131,26 +133,33 @@
   May log warnings if available content does not conform to
   clinvar specifcations."
   [t c]
+  (if (not (nil? c))
   (let [name (get c "name")]
-    (csv-colval (if (nil? name) "" name))))
+    (csv-colval (if (nil? name) "" name)))
+  (log/debug (str "Exception in function condition-name: condition name not found"))))

 (defn condition-idtype
   ;TODO modify to deal with phenotypes and multi-values for satisfying clinvar specs.
   [t c]
+  (if (not (nil? c))
   (let [disease-coding (ld-> t c "disease" "coding")]
     (let [disease-code (get disease-coding "code")]
-      (csv-colval (get (re-find #"(.*)\_(.*)" disease-code) 1)))))
+      (csv-colval (if (nil? disease-code) "" (get (re-find #"(.*)\_(.*)" disease-code) 1)))))
+  (log/debug (str "Exception in function condition-idtype: condition idt type not found"))))

 (defn condition-idvals
    ;TODO modify to deal with phenotypes and multi-values for satisfying clinvar specs.
   [t c]
+  (if (not (nil? c))
   (let [disease-coding (ld-> t c "disease" "coding")]
     (let [disease-code (get disease-coding "code")]
-      (csv-colval (get (re-find #"(.*)\_(.*)" disease-code) 2)))))
+      (csv-colval (if (nil? disease-code) "" (get (re-find #"(.*)\_(.*)" disease-code) 2)))))
+  (log/debug (str "Exception in function condition-idvals: condition id not found"))))

 (defn condition-moi
   [t c]
-  (csv-colval (ld-> t c "modeOfInheritance" "display")))
+  (if (not (nil? c)) (csv-colval (if (nil? (ld-> t c "modeOfInheritance" "display")) "" (ld-> t c "modeOfInheritance" "display")))
+  (log/debug (str "Exception in function condition-moi: condition moi not found"))))

 (defn get-condition
   "Processes the condition element to derive the ClinVar sanctioned fields:
@@ -177,12 +186,12 @@
    warning will be reported 'Condition is missing for a clinically significant
    interpretation.'"
   [t i]
-  (if (nil? (ld-> t i "condition")) (log/debug (str "Exception in interp-significance: condition not found")))
   (let [c (ld-> t i "condition")]
-     {:name (condition-name t c),
-      :idtype (condition-idtype t c),
-      :idvalue (condition-idvals t c),
-      :moi (condition-moi t c)}))
+     (if (nil? c) (log/debug (str "Exception in function get-condition: condition not found")))
+     {:name (if (nil? c) "" (condition-name t c)),
+      :idtype (if (nil? c) "" (condition-idtype t c)),
+      :idvalue (if (nil? c) "" (condition-idvals t c)),
+      :moi (if (nil? c) "" (condition-moi t c))}))

   (defn evidence-rules
     "Returns the list of criterion rule names for the evidence provided"


Rewrite API call to dispatch a re-frame event

--- src/cljs/comic_reader/api.cljs
+++ src/cljs/comic_reader/api.cljs
@@ -1,10 +1,11 @@
 (ns comic-reader.api
-  (:require [ajax.core :refer [GET POST]]))
+  (:require [re-frame.core :refer [dispatch]]
+            [ajax.core :refer [GET POST]]))

 (defn error-handler [{:keys [status status-text]}]
   (.log js/console (str "something bad happened: " status " " status-text)))

-(defn get-sites [callback]
-  (GET "/api/v1/sites" {:handler callback
+(defn get-sites []
+  (GET "/api/v1/sites" {:handler #(dispatch [:site-list %])
                         :error-handler error-handler
                         :response-format :edn}))


PLD: no table, no container

PLD: no table, no container

--- src/hatti/views/photos.cljs
+++ src/hatti/views/photos.cljs
@@ -89,24 +89,20 @@
 (defn- build-photo-gallery
   "Build markup with actions for a photo gallery."
   [photos owner]
-  (map #(vector :tr %)
-       (partition-all
-        num-columns
-        (for [i (-> photos count range)
-              :let [{:keys [title] :as photo} (nth photos i)]]
-          [:td
-           [:figure {"itemProp" "associatedMedia"
-                     "itemScope" ""
-                     "itemType" "http://schema.org/ImageObject"}
-            [:a {:href (:src photo)
-                 "itemProp" "contentUrl"
-                 :data-size (format "%sx%s" width-px width-px)
-                 :on-click #(on-thumbnail-click % photos)}
-             [:img {:src (:thumb photo)
-                    "itemProp" "thumbnail"
-                    (keyword data-pswp-id) i
-                    :alt title}]]
-            [:figcaption {"itemProp" "caption description"} title]]]))))
+  (for [i (-> photos count range)
+        :let [{:keys [title] :as photo} (nth photos i)]]
+    [:figure {"itemProp" "associatedMedia"
+              "itemScope" ""
+              "itemType" "http://schema.org/ImageObject"}
+     [:a {:href (:src photo)
+          "itemProp" "contentUrl"
+          :data-size (format "%sx%s" width-px width-px)
+          :on-click #(on-thumbnail-click % photos)}
+      [:img {:src (:thumb photo)
+             "itemProp" "thumbnail"
+             (keyword data-pswp-id) i
+             :alt title}]]
+     [:figcaption {"itemProp" "caption description"} title]]))

 (defmethod photos-page :default
   [{:keys [data] {:keys [num_of_submissions]} :dataset-info} owner]
@@ -116,7 +112,7 @@
     (render [_]
       (let [photos (build-photos data)]
         (html
-         [:div.container
+         [:div.tab-content
           (cond
             (or (zero? num_of_submissions)
                 (and (seq data) (empty? photos)))


Protobuf takes a map, not a naming strategy.

As pointed out in #45.

--- src/flatland/protobuf/core.clj
+++ src/flatland/protobuf/core.clj
@@ -23,7 +23,7 @@
   ([def]
      (if (or (protodef? def) (nil? def))
        def
-       (protodef def PersistentProtocolBufferMap$Def/convertUnderscores)))
+       (protodef def {})))
   ([def opts]
      (when def
        (let [{:keys [^PersistentProtocolBufferMap$Def$NamingStrategy naming-strategy


TAP reporter: future facts and other cleanups

Fact counter is now reset.
* src/midje/emission/plugins/tap.clj:
Signed-off-by: giorgio-v <3a4d67eb2c7c1aeb8cfd15182af01f6f7ec0be3d@refactor.it>

--- src/midje/emission/plugins/tap.clj
+++ src/midje/emission/plugins/tap.clj
@@ -1,5 +1,5 @@
 (ns ^{:doc "TAP output. See http://testanything.org"}
-    midje.emission.plugins.tap
+  midje.emission.plugins.tap
   (:use midje.emission.util)
   (:require [midje.data.fact :as fact]
             [midje.emission.state :as state]
@@ -14,6 +14,14 @@
   (let [[_ _ & more] (lines/summarize failure-map)]
     (map #(str "# " %) (conj more (apply str (:position failure-map))))))

+(defn future-fact [description-list position]
+  (do
+    (swap! fact-counter inc)
+    (util/emit-one-line (str "not ok " @fact-counter
+                             " # TODO "
+                             (when-let [doc (util/format-nested-descriptions description-list)]
+                               (str (pr-str doc) " "))
+                             "at " (util/filename-lineno position)))))
 (defn fail [failure-map]
   (do
     (swap! fact-counter inc)
@@ -37,6 +45,7 @@
     (set-last-namespace-shown! namespace-symbol)))

 (defn starting-fact-stream []
+  (reset! fact-counter 0)
   (set-last-namespace-shown! nil))

 (defn starting-to-check-fact [fact]
@@ -50,16 +59,10 @@

 (defn finishing-fact-stream [midje-counters clojure-test-map]
   (let [passes-and-failures (+ (:midje-passes midje-counters) (:midje-failures midje-counters))]
-    (util/emit-one-line (str 1 ".." passes-and-failures
+    (util/emit-one-line (str 1 ".." @fact-counter
+                             " # midje count: " passes-and-failures
                              (when-not passes-and-failures
                                "# No facts were checked. Is that what you wanted?")))))
-
-(defn future-fact [description-list position]
-  (util/emit-one-line "")
-  (util/emit-one-line (str "WORK TO DO" " "
-                           (when-let [doc (util/format-nested-descriptions description-list)]
-                             (str (pr-str doc) " "))
-                           "at " (util/filename-lineno position))))

 (defn make-map [& keys]
   (zipmap keys


adding function documentation

adding function documentation

--- umm-spec-lib/src/cmr/umm_spec/validation/platform.clj
+++ umm-spec-lib/src/cmr/umm_spec/validation/platform.clj
@@ -54,5 +54,6 @@
                              (clojure.string/join ", " duplicate-names))]}))))

 (def platforms-validation
+  "Defines the list of validation functions for validating collection platforms"
   [(v/every platform-validations)
    (unique-platform-validator unique-fields)])


updated the log output values for results

--- src/lcmap/clownfish/server.clj
+++ src/lcmap/clownfish/server.clj
@@ -71,7 +71,7 @@
         (results/save change-result)
         (lb/ack event/amqp-channel (metadata :delivery-tag))
         (log/infof "result saved %s"
-                   (dissoc change-result :inputs_md5 :result_md5 :result))
+                   (select-keys change-result [:result_produced :algorithm :x :y]))
         (catch Exception ex
           (log/errorf "can't save result to db: %s"  ex)
           (log/errorf "discarding result: %s" change-result)


Removed a stray debug

Removed a stray debug

--- src/leiningen/new/electron.clj
+++ src/leiningen/new/electron.clj
@@ -10,8 +10,6 @@
 (defn binary [file-name]
   (let [f     (str/join "/" ["leiningen" "new" "electron" file-name])
         res   (io/resource f)]
-    (println f)
-    (println res)
     (io/input-stream res)))

 (defn electron


Need to render metrics and logging

Need to render metrics and logging

--- src/leiningen/new/onyx_app.clj
+++ src/leiningen/new/onyx_app.clj
@@ -23,6 +23,8 @@
            "src/onyx_app/catalogs/sample_catalog.clj"
            "src/onyx_app/functions/sample_functions.clj"
            "src/onyx_app/lifecycles/sample_lifecycle.clj"
+           "src/onyx_app/lifecycles/metrics.clj"
+           "src/onyx_app/lifecycles/logging.clj"
            "src/onyx_app/jobs/sample_submit_job.clj"
            "src/onyx_app/tasks/kafka.clj"
            "src/onyx_app/tasks/file_input.clj"


Revert "Warn when merging a file with a directory of the same name"

This reverts commit 9443143693dc196a1ac404f69f2061700c56605b.

--- boot/pod/src/boot/tmpdir.clj
+++ boot/pod/src/boot/tmpdir.clj
@@ -127,17 +127,15 @@

 (defn- apply-mergers!
   [mergers ^File old-file path ^File new-file ^File merged-file]
-  (if (some (memfn isDirectory) [old-file new-file])
-    (util/warn "Can't merge: entry is both file and directory: %s" path)
-    (when-let [merger (some (fn [[re v]] (when (re-find re path) v)) mergers)]
-      (util/dbug "Merging duplicate entry (%s)\n" path)
-      (let [out-file (File/createTempFile (.getName merged-file) nil
-                                          (.getParentFile merged-file))]
-        (with-open [curr-stream (io/input-stream old-file)
-                    new-stream  (io/input-stream new-file)
-                    out-stream  (io/output-stream out-file)]
-          (merger curr-stream new-stream out-stream))
-        (file/move out-file merged-file)))))
+  (when-let [merger (some (fn [[re v]] (when (re-find re path) v)) mergers)]
+    (util/dbug "Merging duplicate entry (%s)\n" path)
+    (let [out-file (File/createTempFile (.getName merged-file) nil
+                                        (.getParentFile merged-file))]
+      (with-open [curr-stream (io/input-stream old-file)
+                  new-stream  (io/input-stream new-file)
+                  out-stream  (io/output-stream out-file)]
+        (merger curr-stream new-stream out-stream))
+      (file/move out-file merged-file))))

 (defn- set-dir
   [tree dir]


fixed typo in comment

fixed typo in comment

--- possibledb/src/possibledb/core.cljs
+++ possibledb/src/possibledb/core.cljs
@@ -60,7 +60,7 @@
               JSON/stringify
               JSON/parse))

-        ;; used when the main-fn is reader_typesy to run
+        ;; used when the main-fn is ready to run
         (def ch-ready (chan))

         ;; owned by pub-main


Fix up global deps and plugins.

Fix up global deps and plugins.

--- lein/.lein/profiles.clj
+++ lein/.lein/profiles.clj
@@ -1,9 +1,17 @@
-{:user {
-          :dependencies [[cider/cider-nrepl "0.12.0-SNAPSHOT"] ; Emnacs
-                         [acyclic/squiggly-clojure "0.1.5"] ; Emacs
-                         ^:replace [org.clojure/tools.nrepl "0.2.12"] ; Emacs
-                         ]
-        :singing {:gpg-key "matthew.russell@wormbase.org"}}
+{:user {:plugin-repositories [["private-plugins" {:url "private repo url"}]]
+        :singing {:gpg-key "matthew.russell@wormbase.org"}
+        :dependencies [[clojure-ini "0.0.2"]
+                       [me.raynes/fs "1.4.6"]]
+        :plugins [[cider/cider-nrepl "0.8.2"]
+                  [refactor-nrepl "0.2.2"]
+                  [jonase/eastwood "0.2.3"]
+                  [lein-ancient "0.6.8"]
+                  [lein-bikeshed "0.3.0"]
+                  [lein-kibit "0.1.2"]
+                  [lein-ns-dep-graph "0.1.0-SNAPSHOT"]]}
+ :repl {:dependencies [[acyclic/squiggly-clojure "0.1.6"]
+                       [datomic-schema-grapher "0.0.1"]
+                       [org.clojure/tools.nrepl "0.2.12"]]}
  ;; VisualVM profiling opts
  :jvm-opts ["-Dcom.sun.management.jmxremote"
             "-Dcom.sun.management.jmxremote.ssl=false"


separate out request handling of params middleware

also make assoc-form-params public as its used in other middleware

--- ring-core/src/ring/middleware/params.clj
+++ ring-core/src/ring/middleware/params.clj
@@ -21,7 +21,7 @@
   (if-let [^String type (:content-type request)]
     (.startsWith type "application/x-www-form-urlencoded")))

-(defn- assoc-form-params
+(defn assoc-form-params
   "Parse and assoc parameters from the request body with the request."
   [request encoding]
   (merge-with merge request
@@ -29,6 +29,17 @@
       (let [params (parse-params (slurp body :encoding encoding) encoding)]
         {:form-params params, :params params})
       {:form-params {}, :params {}})))
+
+(defn params-request [request & [opts]]
+  (let [encoding (or (:encoding opts)
+                     (:character-encoding request)
+                     "UTF-8")
+        request  (if (:form-params request)
+                   request
+                   (assoc-form-params request encoding))]
+    (if (:query-params request)
+      request
+      (assoc-query-params request encoding))))

 (defn wrap-params
   "Middleware to parse urlencoded parameters from the query string and form
@@ -43,13 +54,6 @@
                 character encoding is set."
   [handler & [opts]]
   (fn [request]
-    (let [encoding (or (:encoding opts)
-                       (:character-encoding request)
-                       "UTF-8")
-          request  (if (:form-params request)
-                     request
-                     (assoc-form-params request encoding))
-          request  (if (:query-params request)
-                     request
-                     (assoc-query-params request encoding))]
-      (handler request))))
+    (-> request
+        (params-request opts)
+        handler)))


Escapes the Swagger 'type' keyword for Scala

--- src/swagger_gen/language/scala.clj
+++ src/swagger_gen/language/scala.clj
@@ -71,7 +71,9 @@
   (let [[property-name attributes] prop
         required (contains? required-properties (name property-name))]
     (format "%s: %s"
-            (camelize (name property-name))
+            (if (.equals (name property-name) "type")
+              (str "`type`")
+              (camelize (name property-name)))
             (scala-type definition-name required property-name attributes))))

 (defn render-case-class


slightly more cleaning of tabular code

slightly more cleaning of tabular code

--- src/midje/ideas/tabular.clj
+++ src/midje/ideas/tabular.clj
@@ -44,8 +44,7 @@
     `(do ~@expect-forms-with-binding-notes)))

 (defmethod validate "tabular" [[_tabular_ & form]]
-  (let [form-sans-leading-strings (drop-while string? form)]
-    (let [[fact-form & table] form-sans-leading-strings]
-      (if (empty? table)
-        (user-error-report-form form "There's no table. (Misparenthesized form?)")
-        [fact-form table] ))))+  (let [[fact-form & table] (drop-while string? form)]
+    (if (empty? table)
+      (user-error-report-form form "There's no table. (Misparenthesized form?)")
+      [fact-form table])))


Display chart feedback as an alert.

Display chart feedback as an alert.

--- src-cljs/kixi/hecuba/tabs/sensors.cljs
+++ src-cljs/kixi/hecuba/tabs/sensors.cljs
@@ -27,7 +27,16 @@

 (defn chart-feedback-box [cursor owner]
   (om/component
-   (dom/div nil cursor)))
+   (let [message (:message cursor)]
+     (html
+      [:div
+       [:div {:id "chart-feedback" :class "alert alert-danger " :style {:display (if (empty? message) "none" "block")}}
+        [:button.close {:type "button" :onClick (fn [e]
+                                                  (om/update! cursor :message "")
+                                                  (set! (.-display (.-style (.getElementById js/document "chart-feedback")))
+                                                        "none"))}
+         [:span {:class "fa fa-times"}]]
+        [:div message]]]))))

 (defn flatten-device [device]
   (let [device-keys   (->> device keys (remove #(= % :readings)))
@@ -155,7 +164,7 @@
 (defn update-sensor-selection [selected-sensors unit chart sensors history]
   (om/update! sensors :selected selected-sensors)
   (om/update! chart :sensor selected-sensors)
-  (om/update! chart :unit unit)
+  (om/update! chart :unit (if (seq selected-sensors) unit ""))
   (om/update! chart :message "")
   (history/update-token-ids! history :sensors (if (seq selected-sensors)
                                                 (string/join ";" selected-sensors)
@@ -319,7 +328,7 @@
             [:div {:id "chart-div" :class (if editing "hidden" "")}
              [:div {:id "date-picker"}
               (om/build dtpicker/date-picker data {:opts {:histkey :range}})]
-             (om/build chart-feedback-box (get-in data [:chart :message]))
+             (om/build chart-feedback-box (get-in data [:chart]))
              (om/build chart-summary (:chart data))
              [:div.col-md-12.well
               [:div#chart {:style {:width "100%" :height 600}}


todomvc: :blacklist ::token from persisting instead of thinking about middleware start order

--- examples/todomvc/src/app/spec.cljs
+++ examples/todomvc/src/app/spec.cljs
@@ -14,8 +14,8 @@
        :reconcile     reconcile}
       (schema/add model/Schema)

-      ; debugger deals with persistence itself, so we have to blacklist it here to get rid of loading conflicts
-      (persistence/add storage storage-key {:blacklist #{::devtools/debugger}})
+      ; Debugger deals with persistence itself, so we have to blacklist it here to get rid of loading conflicts.
+      ; Token is blacklisted because on start we want the app to read current token from the urlbar instead of storage.
+      (persistence/add storage storage-key {:blacklist #{::devtools/debugger ::h/token}})

-      ; routing goes after persistence layer so that on start the token is taken from the url bar instead of local storage
       (h/add history)))


RESTful affirmation.

RESTful affirmation.

--- src/ombs/handler/adminacts.clj
+++ src/ombs/handler/adminacts.clj
@@ -1,7 +1,12 @@
 (ns ombs.handler.adminacts
   (require
     [ombs.db.admin :as db]
-    )
-  )
+    [ombs.validate :as isvalid]
+    [cheshire.core :as ch]
+    ))

-(defn affirm [id] (db/affirm id))
+(defn affirm [id]
+  (println "affirm " id)
+  (if (isvalid/fee? id)
+    (db/affirm id)
+    (ch/generate-string {:error (isvalid/errors-string)})))


Downgrade back to cljs-ajax 0.3.11 to work around https://github.com/JulianBirch/cljs-ajax/issues/109

--- metlog-vault/project.clj
+++ metlog-vault/project.clj
@@ -21,7 +21,7 @@
                  [hiccup "1.0.5"]

                  [org.clojure/core.async "0.1.346.0-17112a-alpha"]
-                 [cljs-ajax "0.5.0"]
+                 [cljs-ajax "0.3.11"]
                  [reagent "0.5.1"]
                  [com.andrewmcveigh/cljs-time "0.3.14"]


[#1065] Refactor based on @iperdomo's review

--- Dashboard/app/cljs/src/org/akvo/flow/dashboard/components/grid.cljs
+++ Dashboard/app/cljs/src/org/akvo/flow/dashboard/components/grid.cljs
@@ -79,20 +79,20 @@
      (html
       [:div
        [:nav
-        [:ul.pager
-         [:li {:role "presentation"}
-          [:a {:on-click #(on-range (let [new-offset (- offset limit)]
-                                      (if (neg? new-offset) 0 new-offset))
-                                    limit)}
-           "« " (t> _previous)]]
-         [:li [:strong (str " " (inc offset) " - " (+ offset limit) " ")]]
-         [:li
-          [:a {:on-click #(on-range (let [new-offset (+ offset limit)]
-                                      (if (and total-count
-                                               (>= new-offset total-count))
-                                        offset new-offset))
-                                    limit)}
-             (t> _next) " »"]]]]]))))
+        (let [can-paginate-back? (>= (- offset limit) 0)
+              can-paginate-forward? (< (+ offset limit) total-count)]
+          [:ul.pager
+           [:li {:class (when-not can-paginate-back? "disabled")
+                 :role "presentation"}
+            [:a {:on-click #(when can-paginate-back?
+                              (on-range (- offset limit) limit))}
+             "« " (t> _previous)]]
+           [:li [:strong (str " " (inc offset) " - " (+ offset limit) " ")]]
+           [:li {:class (when-not can-paginate-forward? "disabled")
+                 :role "presentation"}
+            [:a {:on-click #(when can-paginate-forward?
+                              (on-range (+ offset limit) limit))}
+             (t> _next) " »"]]])]]))))

 (defn change-direction [dir]
   (if (= dir "ascending")


Make sure to list only users that are allowed for the entry under each one (limit private board entries).

--- src/oc/storage/api/orgs.clj
+++ src/oc/storage/api/orgs.clj
@@ -197,13 +197,24 @@
         entry-user-key (fn [entry-id user-id] (str entry-id "-" user-id))
         all-reads-map (into {} (map #(hash-map (entry-user-key (:item-id %) (:user-id %)) %) filtered-read-data))
         allowed-boards-map (zipmap (map :uuid allowed-boards) allowed-boards)
-        csv-users-for-entry (fn [entry]
-                              (map #(assoc % :read-at
-                                           (get-in all-reads-map [(entry-user-key (:uuid entry) (:user-id %)) :read-at]))
-                                   cleaned-users))
-        users-count (count active-users)
+        users-for-board-cache (atom {})
+        csv-users-for-entry (fn [board entry]
+                              (let [cached-users-list (get @users-for-board-cache (:uuid board))
+                                    users-list (if (sequential? cached-users-list)
+                                                 cached-users-list
+                                                 (if (= (:access board) "private")
+                                                   (filterv #(or ((set (:viewers board)) (:user-id %))
+                                                                ((set (:authors board)) (:user-id %)))
+                                                           cleaned-users)
+                                                   cleaned-users))]
+                                (when-not cached-users-list
+                                  (swap! users-for-board-cache assoc (:uuid board) users-list))
+                                (map #(assoc % :read-at
+                                            (get-in all-reads-map [(entry-user-key (:uuid entry) (:user-id %)) :read-at]))
+                                    users-list)))
         with-entries-data (map #(let [board (get allowed-boards-map (:board-uuid %))
-                                      csv-users (csv-users-for-entry %)
+                                      csv-users (csv-users-for-entry board %)
+                                      users-count (count csv-users)
                                       reads-count (count (filter :read-at csv-users))]
                                   {:entry (assoc %
                                                  :board-slug (:slug board)


Major sequencer simplification. Added controls to add/remove columns.

--- src/overtone/gui/sequencer.clj
+++ src/overtone/gui/sequencer.clj
@@ -4,12 +4,11 @@
         [overtone.gui.control :only [synth-controller]]
         [seesaw core]
         [seesaw.color :only [color]]
-        [seesaw.graphics :only [style update-style draw rounded-rect line]]
+        [seesaw.graphics :only [style update-style draw rect rounded-rect line]]
         [seesaw.mig :only [mig-panel]])
   (:require [seesaw.bind :as bind]))

-(defn- make-initial-state
-  [metro steps instruments init-vals]
+(defn- make-initial-state [metro steps instruments init-vals]
   {:playing?  false
    :metronome metro
    :steps     steps
@@ -19,93 +18,43 @@
                   (let [i-vals (or (get init-vals (:name i))
                                    (vec (repeat steps false)))]
                     {:inst  i
-                     :param (-> i :params first :name)
-                     :mute  false
-                     :solo  false
                      :value i-vals})))
    })

-(def ^{:private true} NEW_ENTRY {:on true})
-
-(defn- toggle-playing
-  [state]
+(defn- toggle-playing [state]
   (update-in state [:playing?] not))

-(defn- get-entry
-  [state row col]
+(defn- get-entry [state row col]
   (get-in state [:rows row :value col]))

-(defn- set-entry
-  [state row col v]
+(defn- set-entry [state row col v]
   (if (< row (count (:rows state)))
     (assoc-in state [:rows row :value col] v)
     state))

-(defn- update-entry
-  [state row col v]
-  (if (< row (count (:rows state)))
-    (update-in state [:rows row :value col] merge NEW_ENTRY v)
+(defn- toggle-entry [state row col]
+  (update-in state [:rows row :value col] not))
+
+(defn- add-column-to-row [row]
+  (update-in row [:value] #(conj % false)))
+
+(defn- add-column [state]
+  (-> state
+      (update-in [:rows] #(vec (map add-column-to-row %)))
+      (update-in [:steps] inc)))
+
+(defn- remove-column-from-row [row]
+  (update-in row [:value] pop))
+
+(defn- remove-column [state]
+  (if (> (:steps state) 2)
+    (-> state
+      (update-in [:rows] #(vec (map remove-column-from-row %)))
+      (update-in [:steps] dec))
     state))
-
-(defn- mute-entry
-  [state row col]
-  (update-in state [:rows row :value col]
-             (fn [v]
-               (if (associative? v)
-                 (assoc-in v [:on] false)
-                 v))))
-
-(defn- toggle-entry
-  [state row col]
-  (update-in state [:rows row :value col]
-             (fn [v]
-               (if (associative? v)
-                 (update-in v [:on] not)
-                 NEW_ENTRY))))
-
-(defn- delete-entry
-  [state row col]
-  (set-entry state row col false))
-
-(defn- toggle-row-mute
-  [state row]
-  (update-in state [:rows row :mute] not))
-
-(defn- toggle-row-solo
-  [state row]
-  (update-in state [:rows row :solo] not))
-
-(defn- get-row-solo
-  [state row]
-  (get-in state [:rows row :solo]))
-
-(defn- get-row-param
-  [state row]
-  (get-in state [:rows row :param]))
-
-(defn- set-row-param
-  [state row val]
-  (assoc-in state [:rows row :param] val))
-
-(defn- get-param-info
-  [state row]
-  (let [p-name (get-row-param state row)]
-    (first (filter #(= (:name %) p-name)
-                 (get-in state [:rows row :inst :params])))))

 (defn- clear-row [state row]
   (assoc-in state [:rows row :value] (vec (repeat (:steps state) false))))
-
-(defn- play-step
-  [row index]
-  (let [{:keys [inst value]} row
-        step-val (nth value index)]
-
-    (when (:on step-val)
-      (apply inst (-> step-val
-                      (dissoc :on)
-                      seq
-                      flatten)))))

 (defn- step-player
   [state-atom beat]
@@ -118,9 +67,9 @@

         (swap! state-atom assoc-in [:step] index)

-        (doseq [row (:rows state)]
-          (when-not (:mute row)
-            (at (metro beat) (play-step row index))))
+        (doseq [{:keys [inst value]} (:rows state)]
+          (when (value index)
+            (at (metro beat) (inst))))

         (apply-at (metro next-beat) #'step-player
                   [state-atom next-beat])))))
@@ -146,21 +95,7 @@
     :background (color 128 128 224 200)
     :foreground (color 0 150 0)))

-(defn- scaled-entry-style
-  [n]
-  (let [g (int (+ (* n 200) 55))
-        bg (color 0 g 0 200)]
-    (update-style enabled-entry-style :background bg)))
-
-(defn- get-param-factor
-  [p-info val]
-  (let [{:keys [max min name default]} p-info
-        p-val (or ((keyword name) val)
-                  default)]
-    (double (/ (- p-val min) (- max min)))))
-
-(defn- paint-grid
-  [state ^javax.swing.JComponent c g]
+(defn- paint-grid [state ^javax.swing.JComponent c g]
   (let [w    (width c)
         h    (height c)
         rows (count (:rows state))
@@ -172,30 +107,16 @@
       (let [x (* step dx)]
         (draw g (rounded-rect x 0 dx h) current-step-style)))
     (dotimes [r rows]
-      (let [y (* r dy)
-            p (get-param-info state r)]
+      (let [y (* r dy)]
         (draw g (line 0 y w y) grid-line-style)
         (dotimes [c cols]
           (let [x (* c dx)]
             (draw g (line x 0 x h) grid-line-style)
-            (when-let [val (get-entry state r c)]
-              (let [paint-cell
-                    #(draw g
-                           (rounded-rect (+ x 2) (+ y 2) (- dx 3) (- dy 3) 3 3)
-                           %)]
-                (if (:on val)
-                  (let [p-fact (get-param-factor p val)]
-                    (paint-cell (scaled-entry-style p-fact)))
-                  (paint-cell muted-entry-style))))))))))
-
-(defn- scaled-param-map
-  [state row val]
-  (let [{:keys [max min name]} (get-param-info state row)
-        p-name (keyword name)
-        p-val (-> val
-                (* (- max min))
-                (+ min))]
-    {p-name p-val}))
+            (when (get-entry state r c)
+              (draw g
+                    (rounded-rect (+ x 2) (+ y 2) (- dx 4) (- dy 4) 8 8)
+                    enabled-entry-style))))))
+    (draw g (rect 0 0 (dec w) (dec h)) grid-line-style)))

 (defn- parse-grid-click
   [state e]
@@ -207,61 +128,24 @@
         r-size (/ (height grid) n-rows)
         c-size (/ (width  grid) n-cols)
         r      (int (/ y r-size))
-        c      (int (/ x c-size))
-        r-top  (* r-size r)
-        r-btm  (+ r-top r-size)
-        y-val  (-> y (max r-top) (min r-btm) (- r-top))
-        y-val  (- 1 (double (/ y-val r-size)))
-        param  (scaled-param-map state r y-val)]
-    {:row r :col c :r-size r-size :c-size c-size :y-val y-val :param param}))
-
-(defn- on-grid-clicked
-  [state e]
-  (let [{:keys [row col param]} (parse-grid-click state e)
-        new-state (cond (.isControlDown e) (delete-entry state row col)
-                        (.isAltDown e)     (update-entry state row col param)
-                        :else (toggle-entry state row col))]
+        c      (int (/ x c-size))]
+    { :row r :col c }))
+
+(defn- on-grid-clicked [state e]
+  (let [{:keys [row col]} (parse-grid-click state e)
+        new-state (toggle-entry state row col)]

     ;;when they enable a cell, play the sample.
-    (when (not (:playing? new-state))
-      (let [row (get-in new-state [:rows row])]
-        (play-step row col)))
+    (when-not (:playing? new-state)
+      ((get-in new-state [:rows row :inst])))

     new-state))

-(defn- on-grid-drag
-  [state e]
-  (let [{:keys [row col r-size c-size y-val param]} (parse-grid-click state e)]
-    (cond (.isControlDown e) (delete-entry state row col)
-          (.isShiftDown e)   (mute-entry state row col)
-          (.isAltDown e)     (update-entry state row col param)
-          :else              (update-entry state row col {}))))
-
-(defn- inst->index
-  [rows inst]
-  (first (keep-indexed
-          (fn [index item]
-            (when (= inst (:inst item))
-              index))
-          rows)))
-
-(defn- on-param-selection
-  [state inst e]
-  (let [r (inst->index (:rows state) inst)]
-    (set-row-param state r (selection e))))
-
-(defn- on-mute-toggle
-  [state inst e]
-  (let [r (inst->index (:rows state) inst)]
-    (toggle-row-mute state r)))
-
-(defn- on-solo-toggle
-  [state inst e]
-  (let [r (inst->index (:rows state) inst)]
-    (toggle-row-solo state r)))
-
-(defn- step-grid
-  [state-atom]
+(defn- on-grid-drag [state e]
+  (let [{:keys [row col]} (parse-grid-click state e)]
+    (set-entry state row col (not (.isShiftDown e)))))
+
+(defn- step-grid [state-atom]
   (let [state @state-atom

         c (canvas :background :darkgrey
@@ -277,54 +161,25 @@
 (defn- inst-button
   [inst]
   (button :text (:name inst)
-          :listen [:action (fn [e] (synth-controller inst))]))
-
-(defn- inst-param
-  [inst]
-  (combobox :model (map :name (:params inst))
-            :class :param))
-
-(defn- inst-mute
-  [inst]
-  (toggle :text "Mute" :class :mute))
-
-(defn- inst-solo
-  [inst]
-  (toggle :text "Solo" :class :solo))
+          :listen [:action (fn [_] (synth-controller inst))]))

 (defn- inst-panel
   [state-atom inst]
-  (let [panel (mig-panel :constraints ["wrap 2"
-                                       "grow"]
-                         :items [[(inst-button inst) "span, growx"]
-                                 [(inst-param  inst) "span, growx"]
-                                 [(inst-mute   inst) "growx"]
-                                 [(inst-solo   inst) "growx"]])]
-    (listen (select panel [:.param])
-            :selection #(swap! state-atom on-param-selection inst %))
-    (listen (select panel [:.mute])
-            :selection #(swap! state-atom on-mute-toggle inst %))
-    (listen (select panel [:.solo])
-            :selection #(swap! state-atom on-solo-toggle inst %))
-
-    panel))
+  (inst-button inst))

 (defn step-sequencer
   [metro steps instruments & [init-vals]]
   (invoke-now
     (let [state-atom   (atom (make-initial-state metro steps instruments init-vals))
-          play-btn     (button :text "play")
+          play-btn     (button :text "Play")
           bpm-spinner  (spinner :model (spinner-model (metro :bpm) :from 1 :to 10000 :by 1)
                                 :maximum-size [60 :by 100])
-          controls-btn (button :text "controls")
+          controls-btn (button :text "Controls" :tip "Show controls for all insts")
+          plus-btn     (button :text "+" :tip "Add a column")
+          minus-btn    (button :text "-" :tip "Remove a column")
           control-pane (toolbar :floatable? false
-                                :items [play-btn
-                                        :separator
-                                        bpm-spinner
-                                        [:fill-h 5]
-                                        "bpm"
-                                        :separator
-                                        controls-btn])
+                                :items [play-btn    [:fill-h 5]
+                                        bpm-spinner [:fill-h 5] "bpm"])
           grid         (step-grid state-atom)
           inst-panels  (map (partial inst-panel state-atom)
                             instruments)
@@ -334,14 +189,13 @@
                                :north control-pane
                                :west (grid-panel :columns 1
                                                  :items inst-panels)
-                               :center grid)
+                               :center grid
+                               :south (toolbar :floatable? false
+                                        :items [controls-btn :fill-h plus-btn minus-btn]))
                    :on-close :dispose)]

       (bind/bind bpm-spinner (bind/b-do [v] (metro :bpm v)))
       (bind/bind state-atom (bind/b-do [v] (repaint! grid)))
-
-      (swap! state-atom assoc-in [:solo-bg]
-             (button-group :buttons (select f [:.solo])))

       (listen play-btn :action
               (fn [e]
@@ -349,7 +203,8 @@
                   (config! play-btn :text (if playing? "stop" "play"))
                   (if playing?
                     (step-player state-atom (metro))))))
-
+      (listen plus-btn :action (fn [_] (swap! state-atom add-column)))
+      (listen minus-btn :action (fn [_] (swap! state-atom remove-column)))
       (listen controls-btn :action
               (fn [e]
                 (apply synth-controller instruments)))
@@ -371,5 +226,4 @@
       (use 'overtone.gui.control)
       (use 'overtone.inst.drum)
       (def m (metronome 128))
-      (step-sequencer m 8 [kick closed-hat snare]))
-  )
+      (step-sequencer m 8 [kick closed-hat snare])))


say-hello api example working

say-hello api example working

--- src/photosure/server/core.cljs
+++ src/photosure/server/core.cljs
@@ -3,7 +3,7 @@
             [cljs.nodejs :as nodejs]))

 (defn say-hello [request response next]
-  (let [name request.params.name
+  (let [name (.-name (.-params request))
         response-body (cljs/clj->js {:name name})]
     (do
       (.send response response-body)


make clicking in the text area work

make clicking in the text area work

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -276,27 +276,34 @@
                                 :x (:layer/start-x layer)
                                 ;; TODO: defaults for each layer when we create them
                                 :y (- (:layer/start-y layer) (:layer/font-size layer 22))}
-                           (dom/form #js {:className "svg-text-form"
-                                          :onSubmit (fn [e]
-                                                      (cast! :text-layer-finished)
-                                                      false)}
-                                     ;; TODO: experiment with a contentEditable div
-                                     (dom/input #js {:type "text"
-                                                     :placeholder "Type something..."
-                                                     :value (or (:layer/text layer) "")
-                                                     ;; TODO: defaults for each layer when we create them
-                                                     :style (clj->js (merge text-style
-                                                                            {:width (+ 256 (om/get-state owner :input-min-width))}))
-                                                     :ref "input"
-                                                     :onChange #(cast! :text-layer-edited {:value (.. % -target -value)})})
-                                     (dom/div #js {:style (clj->js (merge {:visibility "hidden"
-                                                                           :position "fixed"
-                                                                           :top "-100px"
-                                                                           :left "0"
-                                                                           :display "inline-block"}
-                                                                          text-style))
-                                                   :ref "input-width-tester"}
-                                              (:layer/text layer))))))))
+          (dom/form #js {:className "svg-text-form"
+                         :onMouseDown #(.stopPropagation %)
+                         :onMouseUp #(.stopPropagation %)
+                         :onWheel #(.stopPropagation %)
+
+                         :onSubmit (fn [e]
+                                     (cast! :text-layer-finished)
+                                     false)
+                         :onKeyDown #(when (= "Enter" (.-key %))
+                                       (cast! :text-layer-finished)
+                                       false)}
+                    ;; TODO: experiment with a contentEditable div
+                    (dom/input #js {:type "text"
+                                    :placeholder "Type something..."
+                                    :value (or (:layer/text layer) "")
+                                    ;; TODO: defaults for each layer when we create them
+                                    :style (clj->js (merge text-style
+                                                           {:width (+ 256 (om/get-state owner :input-min-width))}))
+                                    :ref "input"
+                                    :onChange #(cast! :text-layer-edited {:value (.. % -target -value)})})
+                    (dom/div #js {:style (clj->js (merge {:visibility "hidden"
+                                                          :position "fixed"
+                                                          :top "-100px"
+                                                          :left "0"
+                                                          :display "inline-block"}
+                                                         text-style))
+                                  :ref "input-width-tester"}
+                      (:layer/text layer))))))))

 (defn subscriber-layers [{:keys [layers]} owner]
   (reify


fix sound icon and allow for muting icon


Use destructuring

Use destructuring

--- src/app/cljs/one/repmax/sets/view.cljs
+++ src/app/cljs/one/repmax/sets/view.cljs
@@ -53,11 +53,11 @@
 (defn- set-history-list-id-for [date]
     (str "set-history-for-" (iso-date-string date)))

-(defn- set-list-item [set]
+(defn- set-list-item [{:keys [weight reps number]}]
   (let [li (d/clone (:set-history-list-item snippets))]
-    (-> li (css/sel ".value.weight") (d/set-text! (:weight set)))
-    (-> li (css/sel ".value.reps") (d/set-text! (:reps set)))
-    (-> li (css/sel ".set-number .value") (d/set-text! (:number set)))
+    (-> li (css/sel ".value.weight") (d/set-text! weight))
+    (-> li (css/sel ".value.reps") (d/set-text! reps))
+    (-> li (css/sel ".set-number .value") (d/set-text! number))
     li))

 (defn- add-event-listener-for-persisting-set []


Change log level to info.

Change log level to info.

--- src/open_company/config.clj
+++ src/open_company/config.clj
@@ -77,7 +77,7 @@
   The `example-config` source code contains further settings and details.
   See also `set-config!`, `merge-config!`, `set-level!`."

-  {:level :trace  ; e/o #{:trace :debug :info :warn :error :fatal :report}
+  {:level :info  ; e/o #{:trace :debug :info :warn :error :fatal :report}

    ;; Control log filtering by namespaces/patterns. Useful for turning off
    ;; logging in noisy libraries, etc.:


Fix #566: Prevent loop when focused input value is updated

--- src/reagent/impl/input.cljs
+++ src/reagent/impl/input.cljs
@@ -15,12 +15,15 @@

 (declare input-component-set-value)

+(def ^:dynamic *force-set-dom-value* false)
+
 (defn input-node-set-value
   [node rendered-value dom-value ^clj component {:keys [on-write]}]
-  (if-not (and (identical? node (.-activeElement js/document))
-            (has-selection-api? (.-type node))
-            (string? rendered-value)
-            (string? dom-value))
+  (if (or (not (and (identical? node (.-activeElement js/document))
+                    (has-selection-api? (.-type node))
+                    (string? rendered-value)
+                    (string? dom-value)))
+          *force-set-dom-value*)
     ;; just set the value, no need to worry about a cursor
     (do
       (set! (.-cljsDOMValue component) rendered-value)
@@ -51,8 +54,14 @@
     ;; all the scenarios you have handle.
     (let [node-value (.-value node)]
       (if (not= node-value dom-value)
-        ;; IE has not notified us of the change yet, so check again later
-        (batch/do-after-render #(input-component-set-value component))
+        ;; IE has not notified us of the change yet, so check again later.
+        ;; Issue #566: Also setup force flag, so that cljsDOMValue will be set
+        ;; to dom elements current value, even if the input is activeElement.
+        ;; This fixes cases where input is focused from the code, before React
+        ;; render is called and input-component-set-value and
+        ;; input-node-set-value would be called infinitely.
+        (batch/do-after-render #(binding [*force-set-dom-value* true]
+                                  (input-component-set-value component)))
         (let [existing-offset-from-end (- (count node-value)
                                          (.-selectionStart node))
               new-cursor-offset        (- (count rendered-value)


restructure item query for single-threading async

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -270,33 +270,34 @@
       (map item-row @items)
       [:tr [:td {:colSpan 4} [:span.inline-status "Loading..."]]])]])

-(defn- query-ranges
-  [account]
-  (map #(vector % (t/last-day-of-the-month %))
-       (desc-periodic-seq (or (:earliest-transaction-date account)
-                              (t/local-date 2015 1 1)); TODO supply a better default (depends on earliest partition in the database)
-                          (or (:latest-transaction-date account)
-                              (t/first-day-of-the-month (t/today)))
-                          (t/months 3))))
+(defn- query-again?
+  [items]
+  (and (< (count items) 50)
+       (not= 0 (-> items last :index))))
+
+(defn- next-query-range
+  [[prev-start] {:keys [latest-transaction-date]}]
+  (let [start (if prev-start
+                (t/minus prev-start (t/months 3))
+                (t/first-day-of-the-month (or latest-transaction-date
+                                              (t/today))))]
+    [start (-> start (t/plus (t/months 2)) t/last-day-of-the-month)]))

 (defn- get-items
-  [account items]
-  (let [result-chan (chan)
-        err-chan (chan)]
-    (go
-      (transaction-items/search-a
-        {:account-id (:id account)}
-        {}
-        result-chan
-        err-chan))
-
-    (go (let [error (<! err-chan)]
-          (notify/danger error)))
-
-    (go-loop [item (<! result-chan)]
-             (when item
-               (swap! items (fnil conj []) item)
-               (recur (<! result-chan))))))
+  ([account items]
+   (get-items account items nil))
+  ([account items prev-date-range]
+   (let [[start end :as date-range] (next-query-range prev-date-range account)]
+     (transaction-items/search
+       {:account-id (:id account)
+        :transaction-date [:between start end]}
+       (fn [result]
+         (swap! items
+                (fnil concat [])
+                (map #(polarize-item % account) result))
+         (when (query-again? @items)
+           (get-items account items date-range)))
+       notify/danger))))

 (defn- show-account [id]
   (let [account (r/atom {})


refresh mixin to support data input

refresh mixin to support data input

--- src/cljs/swarmpit/component/mixin.cljs
+++ src/cljs/swarmpit/component/mixin.cljs
@@ -5,7 +5,7 @@
   [handler]
   {:did-mount    (fn [state]
                    (let [comp (:rum/react-component state)
-                         callback #(do (handler)
+                         callback #(do (handler (first (:rum/args state)))
                                        (rum/request-render comp))
                          interval (js/setInterval callback 2000)]
                      (assoc state ::interval interval)))


Api and performance improvements on the context management.

--- src/clojure/catacumba/impl/context.clj
+++ src/clojure/catacumba/impl/context.clj
@@ -31,14 +31,17 @@
            ratpack.handling.Context
            ratpack.handling.RequestOutcome
            ratpack.form.Form
+           ratpack.parse.Parse
            ratpack.http.Request
            ratpack.http.Response
            ratpack.http.Headers
+           ratpack.http.TypedData
            ratpack.http.MutableHeaders
            ratpack.http.ResponseMetaData
            ratpack.util.MultiValueMap
            ratpack.server.PublicAddress
-           ratpack.registry.Registry))
+           ratpack.registry.Registry
+           java.util.Optional))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Types
@@ -59,10 +62,16 @@
 (defn context
   "A catacumba context constructor."
   {:internal true :no-doc true}
+  [data]
+  (map->DefaultContext data))
+
+(defn get-context-params*
+  {:internal true :no-doc true}
   [^Context ctx]
-  (map->DefaultContext {:catacumba/context ctx
-                        :catacumba/request (.getRequest ctx)
-                        :catacumba/response (.getResponse ctx)}))
+  (let [^Optional odata (.maybeGet ctx ContextData)]
+    (if (.isPresent odata)
+      @(:payload (.get odata))
+      {})))

 (defn get-context-params
   "Get the current context params.
@@ -71,12 +80,7 @@
   handler using the `delegate` function. Is a simple
   way to communicate the handlers chain."
   [^DefaultContext context]
-  (let [^Context ctx (:catacumba/context context)]
-    (try
-      (let [cdata (.get ctx ContextData)]
-        (:payload cdata))
-      (catch ratpack.registry.NotInRegistryException e
-        {}))))
+  (get-context-params* (:catacumba/context context)))

 (defn delegate
   "Delegate handling to the next handler in line.
@@ -90,9 +94,13 @@
      (.next ctx)))
   ([^DefaultContext context data]
    (let [^Context ctx (:catacumba/context context)
-         previous (get-context-params context)
-         ^Registry reg (Registry/single (ContextData. (merge previous data)))]
-     (.next ctx reg))))
+         ^Optional odata (.maybeGet ctx ContextData)]
+     (if (.isPresent odata)
+       (do
+         (vswap! (:payload (.get odata)) merge data)
+         (.next ctx))
+       (let [^Registry reg (Registry/single (ContextData. (volatile! data)))]
+         (.next ctx reg))))))

 (defn public-address
   "Get the current public address as URI instance.
@@ -139,12 +147,12 @@
     (.setAccessible field true)
     (.get field form)))

-(defn get-query-params
+(defn get-query-params*
   "Parse query params from request and return a
   maybe multivalue map."
-  [^DefaultContext context]
-  (let [^Request request (:catacumba/request context)
-        ^MultiValueMap params (.getQueryParams request)]
+  {:internal :true :no-doc true}
+  [^Request request]
+  (let [^MultiValueMap params (.getQueryParams request)]
     (persistent!
      (reduce (fn [acc key]
                (let [values (.getAll params key)]
@@ -152,18 +160,28 @@
              (transient {})
              (.keySet params)))))

+(defn get-query-params
+  "Parse query params from context and return a
+  maybe multivalue map."
+  [^DefaultContext context]
+  (get-query-params* (:catacumba/request context)))
+
+(defn get-route-params*
+  "Return a hash-map with parameters extracted from
+  routing patterns."
+  [^Context ctx]
+  (into {} utils/keywordice-keys-t (.getPathTokens ctx)))
+
 (defn get-route-params
   "Return a hash-map with parameters extracted from
   routing patterns."
   [^DefaultContext context]
-  (let [^Context ctx (:catacumba/context context)]
-    (into {} utils/keywordice-keys-t (.getPathTokens ctx))))
-
-(defn get-headers
-  [^DefaultContext context]
-  (let [^Request request (:catacumba/request context)
-        ^Headers headers (.getHeaders request)
-          ^MultiValueMap headers (.asMultiValueMap headers)]
+  (get-route-params* (:catacumba/context context)))
+
+(defn get-headers*
+  [^Request request]
+  (let [^Headers headers (.getHeaders request)
+        ^MultiValueMap headers (.asMultiValueMap headers)]
     (persistent!
      (reduce (fn [acc ^String key]
                (let [values (.getAll headers key)
@@ -171,6 +189,10 @@
                  (reduce #(utils/assoc-conj! %1 key %2) acc values)))
              (transient {})
              (.keySet headers)))))
+
+(defn get-headers
+  [^DefaultContext context]
+  (get-headers* (:catacumba/request context)))

 (defn set-headers!
   [^DefaultContext context headers]
@@ -190,16 +212,21 @@
    :secure (.isSecure cookie)
    :max-age (.maxAge cookie)})

+(defn get-cookies*
+  "Get the incoming cookies."
+  {:internal true :no-doc true}
+  [^Request request]
+  (persistent!
+   (reduce (fn [acc cookie]
+             (let [name (keyword (.name cookie))]
+               (assoc! acc name (cookie->map cookie))))
+           (transient {})
+           (into [] (.getCookies request)))))
+
 (defn get-cookies
   "Get the incoming cookies."
   [^DefaultContext context]
-  (let [^Request request (:catacumba/request context)]
-    (persistent!
-     (reduce (fn [acc cookie]
-               (let [name (keyword (.name cookie))]
-                 (assoc! acc name (cookie->map cookie))))
-             (transient {})
-             (into [] (.getCookies request))))))
+  (get-cookies* (:catacumba/request context)))

 (defn set-status!
   "Set the response http status."
@@ -242,30 +269,24 @@
                 (into [] cookiedata))
           (recur (rest cookies)))))))

-(defprotocol IFormDataGetter
-  (get-formdata [_]
-    "Get form encoded or multipart request data and return
-    it as multivalue map."))
-
-(extend-protocol IFormDataGetter
-  DefaultContext
-  (get-formdata [^DefaultContext context]
-    (let [^Context ctx (:catacumba/context context)]
-      (get-formdata ctx)))
-
-  Context
-  (get-formdata [^Context ctx]
-    (let [^MultiValueMap form (.parse ctx Form)
-          ^MultiValueMap files (extract-files form)
-          result (transient {})]
-      (reduce (fn [acc key]
-                (let [values (.getAll files key)]
-                  (reduce #(utils/assoc-conj! %1 key %2) acc values)))
-              result
-              (.keySet files))
-      (reduce (fn [acc key]
-                (let [values (.getAll form key)]
-                  (reduce #(utils/assoc-conj! %1 key %2) acc values)))
-              result
-              (.keySet form))
-      (persistent! result))))
+(defn get-formdata*
+  [^Context ctx ^TypedData body]
+  (let [^Form form (.parse ctx body (Parse/of Form))
+        ^MultiValueMap files (.files form)
+        result (transient {})]
+    (reduce (fn [acc key]
+              (let [values (.getAll files key)]
+                (reduce #(utils/assoc-conj! %1 key %2) acc values)))
+            result
+            (.keySet files))
+    (reduce (fn [acc key]
+              (let [values (.getAll form key)]
+                (reduce #(utils/assoc-conj! %1 key %2) acc values)))
+            result
+            (.keySet form))
+      (persistent! result)))
+
+(defn get-formdata
+  [^DefaultContext context]
+  (get-formdata* (:catacumba/context context)
+                 (:body context)))


show the exception messages

show the exception messages

--- src/bzzz/core.clj
+++ src/bzzz/core.clj
@@ -1,6 +1,7 @@
 (ns bzzz.core
   (use ring.adapter.jetty)
   (use overtone.at-at)
+  (use clojure.stacktrace)
   (:require [clojure.data.json :as json])
   (:import (java.io StringReader File)
            (org.apache.lucene.analysis Analyzer TokenStream)
@@ -93,7 +94,7 @@
     (if (.isDirectory f)
       (get-search-manager (.getName f)))))

-(defn use-search-manager [name f]
+(defn use-searcher-from-search-manager [name f]
   (let [manager (get-search-manager name)
         searcher (.acquire manager)]
     (try
@@ -102,7 +103,7 @@

 (defn search [name query size]
-  (use-search-manager name (fn [searcher]
+  (use-searcher-from-search-manager name (fn [searcher]
                              (let [parser (QueryParser. *version* "_default_" *analyzer*)
                                    query (.parse parser query)
                                    hits (.search searcher query (int size))
@@ -118,9 +119,15 @@
     (search (:index input) (:query input) (:size input))))

 (defn handler [request]
-  {:status 200
-   :headers {"Content-Type" "application/json"}
-   :body (json/write-str (work (:request-method request) (json/read-str (slurp (:body request)) :key-fn keyword))) } )
+  (try
+    ({:status 200
+      :headers {"Content-Type" "application/json"}
+      :body (json/write-str (work (:request-method request) (json/read-str (slurp (:body request)) :key-fn keyword)))})
+    (catch Exception e
+      (print-cause-trace e)
+      {:status 500
+       :headers {"Content-Type" "text/plain"}
+       :body (str "exception:" (.getMessage e))})))

 (def tp (mk-pool))
 (defn main []


Defer fetch to runtime, not compile.

Defer fetch to runtime, not compile.

--- src/cavm/auth.clj
+++ src/cavm/auth.clj
@@ -20,7 +20,7 @@
 (def client-secret)

 (def google-openid-discovery-url "https://accounts.google.com/.well-known/openid-configuration")
-(def google-openid-discovery-document (:body (client/get google-openid-discovery-url {:as :json})))
+(def google-openid-discovery-document (delay (:body (client/get google-openid-discovery-url {:as :json}))))

 (defn valid-user-email? [user-email-whitelist email]
   (contains? user-email-whitelist email))
@@ -30,7 +30,7 @@

 (defn google-authentication-request [{:keys [uri params session] :as request} endpoint-url]
   (let [state (or (:state session) (crypto.random/base64 60))
-        location (str (:authorization_endpoint google-openid-discovery-document)
+        location (str (:authorization_endpoint @google-openid-discovery-document)
                       "?"
                       (client/generate-query-string
                        {"client_id" client-id
@@ -95,7 +95,7 @@
                                      endpoint-url]
   (if (crypto.equality/eq? (:state session) (get params "state"))
     (let [response (client/post
-                    (:token_endpoint google-openid-discovery-document)
+                    (:token_endpoint @google-openid-discovery-document)
                     {:form-params {:code (get params "code")
                                    :client_id client-id
                                    :client_secret client-secret


Split long lines.

Split long lines.

--- src/cbfg/npr.cljs
+++ src/cbfg/npr.cljs
@@ -36,20 +36,25 @@
              snapshot (server-take-snapshot server actx stream-request-in nil)
              num-snapshots 0]
             (cond
-             (nil? snapshot) (aput-close npr-server-session to-client-ch
-                                         (assoc stream-request :status :ok))
-             (snapshot-rollback? snapshot) (aput-close npr-server-session to-client-ch
-                                                       (stream-request-rollback-msg stream-request snapshot))
-             :else (when (aput npr-server-session to-client-ch
-                               (stream-request-snapshot-beg-msg stream-request snapshot))
-                     (doseq [item (snapshot-items snapshot)]
-                       (aput npr-server-session to-client-ch
-                             (stream-request-snapshot-item-msg stream-request snapshot item)))
-                     (when (aput npr-server-session to-client-ch
-                                 (stream-request-snapshot-end-msg stream-request snapshot))
-                       (recur stream-request
-                              (server-take-snapshot server actx stream-request snapshot)
-                              (inc num-snapshots)))))))
+             (nil? snapshot)
+             (aput-close npr-server-session to-client-ch
+                         (assoc stream-request :status :ok))
+
+             (snapshot-rollback? snapshot)
+             (aput-close npr-server-session to-client-ch
+                         (stream-request-rollback-msg stream-request snapshot))
+
+             :else
+             (when (aput npr-server-session to-client-ch
+                         (stream-request-snapshot-beg-msg stream-request snapshot))
+               (doseq [item (snapshot-items snapshot)]
+                 (aput npr-server-session to-client-ch
+                       (stream-request-snapshot-item-msg stream-request snapshot item)))
+               (when (aput npr-server-session to-client-ch
+                           (stream-request-snapshot-end-msg stream-request snapshot))
+                 (recur stream-request
+                        (server-take-snapshot server actx stream-request snapshot)
+                        (inc num-snapshots)))))))

 (defn npr-client-stream-loop [actx client stream-request snapshot-beg-in out from-server-ch]
   (act-loop npr-client-stream-loop actx
@@ -59,43 +64,56 @@
              num-snapshots 0
              num-items 0]
             (cond
-             (nil? r) (aput-close npr-client-stream-loop out {:status :closed})
-             (= (:status r) :ok) (aput-close npr-client-stream-loop out {:status :ok})
+             (nil? r)
+             (aput-close npr-client-stream-loop out {:status :closed})
+
+             (= (:status r) :ok)
+             (aput-close npr-client-stream-loop out {:status :ok})
+
              (and snapshot-beg
                   (= (:status r) :part)
-                  (= (:sub-status r) :snapshot-item)) (if-let [err (client-snapshot-item client
-                                                                                npr-client-stream-loop
-                                                                                stream-request
-                                                                                snapshot-beg r)]
-                                                        (aput-close npr-client-stream-loop out err)
-                                                        (recur stream-request snapshot-beg
-                                                               (atake npr-client-stream-loop from-server-ch)
-                                                               num-snapshots (inc num-items)))
+                  (= (:sub-status r) :snapshot-item))
+             (if-let [err (client-snapshot-item client
+                                                npr-client-stream-loop
+                                                stream-request
+                                                snapshot-beg r)]
+               (aput-close npr-client-stream-loop out err)
+               (recur stream-request snapshot-beg
+                      (atake npr-client-stream-loop from-server-ch)
+                      num-snapshots (inc num-items)))
+
              (and snapshot-beg
                   (= (:status r) :part)
-                  (= (:sub-status r) :snapshot-end)) (if-let [err (client-snapshot-end client
-                                                                                npr-client-stream-loop
-                                                                                stream-request
-                                                                                snapshot-beg r)]
-                                                       (aput-close npr-client-stream-loop out err)
-                                                       (recur stream-request nil
-                                                              (atake npr-client-stream-loop from-server-ch)
-                                                              (inc num-snapshots) num-items))
+                  (= (:sub-status r) :snapshot-end))
+             (if-let [err (client-snapshot-end client
+                                               npr-client-stream-loop
+                                               stream-request
+                                               snapshot-beg r)]
+               (aput-close npr-client-stream-loop out err)
+               (recur stream-request nil
+                      (atake npr-client-stream-loop from-server-ch)
+                      (inc num-snapshots) num-items))
+
              (and (nil? snapshot-beg)
                   (= (:status r) :part)
-                  (= (:sub-status r) :snapshot-beg)) (if-let [err (client-snapshot-beg client
-                                                                                npr-client-stream-loop
-                                                                                stream-request r)]
-                                                       (aput-close npr-client-stream-loop out err)
-                                                       (recur stream-request r
-                                                              (atake npr-client-stream-loop from-server-ch)
-                                                              num-snapshots num-items))
+                  (= (:sub-status r) :snapshot-beg))
+             (if-let [err (client-snapshot-beg client
+                                               npr-client-stream-loop
+                                               stream-request r)]
+               (aput-close npr-client-stream-loop out err)
+               (recur stream-request r
+                      (atake npr-client-stream-loop from-server-ch)
+                      num-snapshots num-items))
+
              (and (nil? snapshot-beg)
-                  (= (:status :rollback))) (aput-close npr-client-stream-loop out
-                                                       (client-rollback client
-                                                                        npr-client-stream-loop
-                                                                        stream-request r))
-             :else (aput-close npr-client-stream-loop out {:status :unexpected-msg}))))
+                  (= (:status :rollback)))
+             (aput-close npr-client-stream-loop out
+                         (client-rollback client
+                                          npr-client-stream-loop
+                                          stream-request r))
+
+             :else
+             (aput-close npr-client-stream-loop out {:status :unexpected-msg}))))

 (defn start-npr-client-stream [actx client token to-server-ch from-server-ch]
   (let [out (achan-buf actx 1)


Added :data-table format for many-valued contexts

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

--- src/conexp/io/many_valued_contexts.clj
+++ src/conexp/io/many_valued_contexts.clj
@@ -49,6 +49,53 @@

 ;; Format Data Table

+;; Note that all entries must be separated by ,. The MVC must have at
+;; least one object and at least two attributes. The first line is a
+;; comma separated line of all attributes. All subsequent lines comma
+;; separated line starting with the object name followed by the valued
+;; for the corresponding attributes.
+
+(add-mv-context-input-format :data-table
+                             (fn [rdr]
+                               (try
+                                (re-matches #"^[^,]+,[^,]+.*$" (.readLine rdr))
+                                (catch Exception _))))
+
+(defmethod write-mv-context :data-table [_ mv-context file]
+  (with-out-writer file
+    (when (> 2 (count (attributes mv-context)))
+      (illegal-argument "Cannot store many-valued contexts with less then 2 attributes in format :data-table."))
+    (when (= 0 (count (objects mv-context)))
+      (illegal-argument "Cannot store many-valued context without objects in format :data-table."))
+    (let [write-comma-line (fn [things]
+                             (cond
+                              (empty? things) nil,
+                              (= 1 (count things)) (prn (first things)),
+                              :else (do (pr (first things))
+                                        (print ",")
+                                        (recur (rest things)))))]
+      (write-comma-line (attributes mv-context))
+      (doseq [g (objects mv-context)]
+        (write-comma-line (cons g (map #((incidence mv-context) [g %]) (attributes mv-context))))))))
+
+(defmethod read-mv-context :data-table [file]
+  (with-in-reader file
+    (let [read-comma-line (fn []
+                            (let [line (get-line)]
+                              (read-string (str "(" line ")")))),
+          attributes      (read-comma-line),
+          lines           (doall
+                           (take-while #(not (empty? %))
+                                       (repeatedly read-comma-line))),
+          objects         (map first lines)
+          interpretation  (into {}
+                                (for [line lines
+                                      :let [g (first line),
+                                            values (rest line)],
+                                      [m w] (map vector attributes values)]
+                                  [[g m] w]))]
+      (make-mv-context objects attributes interpretation))))
+
 ;;;

 nil


Hotfix subtle router bug

Hotfix subtle router bug

--- frontend/src/faceboard/router.cljs
+++ frontend/src/faceboard/router.cljs
@@ -61,9 +61,10 @@
   (update-params! {:tab tab} (route :board-tab)))

 (defn switch-person [person]
+  ; TODO: do not hardcode people here
   (if person
-    (update-params! {:person person} (route :board-people-person))
-    (update-params! {} (route :board-tab))))
+    (update-params! {:tab "people" :person person} (route :board-people-person))
+    (update-params! {:tab "people"} (route :board-tab))))

 (defn define-normal-routes! []
   (defroute-with-info :home "/" [] (perform! :switch-view :welcome))


Use config in incise middleware.

Use config in incise middleware.

--- src/ring/middleware/incise.clj
+++ src/ring/middleware/incise.clj
@@ -1,7 +1,8 @@
 (ns ring.middleware.incise
   (:require [clojure.java.io :refer [file]]
             [ns-tracker.core :refer [ns-tracker]]
-            [incise.utils :refer [delete-recursively]]
+            (incise [utils :refer [delete-recursively]]
+                    [config :as conf])
             [incise.parsers.core :refer [parse]])
   (:import [java.io File]))

@@ -18,14 +19,14 @@

 (defn wrap-incise-parse
   "Call parse on each modified file in the given dir with each request."
-  [handler & {:keys [in out]}]
+  [handler]
   (let [orig-out *out*
         orig-err *err*]
-    (delete-recursively (file out))
+    (delete-recursively (file (conf/get :out-dir)))
     (fn [request]
       (binding [*out* orig-out
                 *err* orig-err]
-        (->> in
+        (->> (conf/get :in-dir)
              (file)
              (file-seq)
              (filter modified?)
@@ -49,6 +50,6 @@
       (handler request))))

 (defn wrap-incise
-  [handler & args]
-  (-> (apply wrap-incise-parse handler args)
+  [handler]
+  (-> (apply wrap-incise-parse handler)
       (wrap-reset-modified-files-with-source-change)))


Test auto start battle after deploy

Test auto start battle after deploy

--- test/obb_rules_api/deploy_test.clj
+++ test/obb_rules_api/deploy_test.clj
@@ -16,6 +16,18 @@
                       :actions [[:deploy 1 :kamikaze [8 8]]]})]
     (is (= :deploy (get-in result [:board :state])))))

+(deftest test-finish-deploy
+  (let [[result response]
+        (sim/turn-ok :p1
+                     {:game {:state "deploy"
+                             :stash {:p1 {:kamikaze 1}
+                                     :p2 {}}
+                             :width 8
+                             :height 8
+                             :elements {}}
+                      :actions [[:deploy 1 :kamikaze [8 8]]]})]
+    (is (not= :deploy (get-in result [:board :state])))))
+
 (deftest test-invalid-deploy
   (let [[result response]
         (sim/turn-fail :p2


updated modal copy

updated modal copy

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -256,13 +256,16 @@
         no-stream?
           (dom/p nil
             (str
-              "Cellf is an interactive experiment that puts a twist on the classic "
-              "sliding puzzle game. Click OK to prompt for camera access.")
+              "Cellf is an interactive experiment that reflects the player and their "
+              "surroundings as they play. Click OK to prompt for camera access.")
+            (dom/em nil (str
+              "There is no server or multiplayer component to this: "
+              "your image stays on your device."))
             (dom/button #js {:onClick get-camera!} "ok"))

         winner?
           (dom/p nil
-            "You win!"
+            "You win! For more of a challenge, drag the slider to create a bigger grid."
             (dom/button #js {:onClick #(set-grid-size! app grid-size)} "new game"))

         result-gif


Simulate typical injection rate

Simulate typical injection rate

--- src/test_utils/sandbox.cljs
+++ src/test_utils/sandbox.cljs
@@ -338,3 +338,35 @@
           (tuc/draw-normal mean sigma))
         (= units :F)
         (+ (* (typical-monitor-temperature :C) 1.8) 32)))
+
+(defn typical-surface-treating-pressure [units]
+  (cond (= units :psi)
+        (let [typical-min 5000
+              typical-max 9000
+              mean (/ (+ typical-min typical-max) 2)
+              sigma (/ mean 3)]
+          (tuc/draw-normal mean sigma))
+        (= units :kPa)
+        (* (typical-surface-treating-pressure :psi) 6.89476)
+        (= units :MPa)
+        (/ (typical-surface-treating-pressure :kPa) 1000)))
+
+(defn typical-injection-rate [units]
+  (cond (= units :bbl-per-min)
+        (let [typical-min 75
+              typical-max 100
+              mean (/ (+ typical-min typical-max) 2)
+              sigma (/ mean 3)]
+          (tuc/draw-normal mean sigma))
+        (= units :l-per-s)
+        (let [typical-min 198.75
+              typical-max 265
+              mean (/ (+ typical-min typical-max) 2)
+              sigma (/ mean 3)]
+          (tuc/draw-normal mean sigma))
+        (= units :cu-ft-per-s)
+        (let [typical-min 7.05
+              typical-max 9.4
+              mean (/ (+ typical-min typical-max) 2)
+              sigma (/ mean 3)]
+          (tuc/draw-normal mean sigma))))


Improving basic order of next closure

Improving basic order of next closure

if you demand it.

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

--- src/conexp/base.clj
+++ src/conexp/base.clj
@@ -52,6 +52,7 @@
   [n]
   (reduce * (range 2 (inc n))))

+
 ;;; Next Closure

 (defn subelts
@@ -102,11 +103,23 @@
 	    (oplus-A i)
 	    (recur (rest i-s))))))))

+(defn improve-basic-order
+  "Improves basic order on the sequence base, where the closure operator
+  clop operates on."
+  [base clop]
+  (let [base (seq base),
+	clop (memoize clop)]
+    (sort (fn [x y]
+	    (or (subset? (clop #{y}) (clop #{x}))
+		(and (not (subset? (clop #{x}) (clop #{y})))
+		     (lectic-< base (clop #{y}) (clop #{x})))))
+	  base)))
+
 (defn next-closed-set
   "Computes next closed set with the Next Closure Algorithm. The order of elements in G,
   interpreted as increasing, is taken to be the basic order of the elements."
   [G clop A]
-  ; is this fast enough?
+  ;; is this fast enough?
   (next-closed-set-in-family (constantly true) G clop A))

 (defn all-closed-sets


Using `subsets' from clojure.math.combinatorics

It's faster

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

--- src/conexp/base.clj
+++ src/conexp/base.clj
@@ -7,7 +7,8 @@
 ;; You must not remove this notice, or any other, from this software.

 (ns conexp.base
-  "Basic definitions for conexp-clj.")
+  "Basic definitions for conexp-clj."
+  (:require [clojure.math.combinatorics :as comb]))

 ;;; def macros, inspired and partially copied from clojure.contrib.def, 1.3.0-SNAPSHOT

@@ -764,6 +765,11 @@
    (seqable? thing) (set thing),
    :else            (illegal-argument "Cannot create set from " thing)))

+(defn subsets
+  "Returns all subsets of the given base-set."
+  [base-set]
+  (map set (comb/subsets (seq base-set))))
+

 ;;; Next Closure

@@ -879,11 +885,6 @@

 ;;; Common Math Algorithms
-
-(defn subsets
-  "Returns all subsets of set."
-  [set]
-  (all-closed-sets set identity))

 (defn transitive-closure
   "Computes transitive closure of a given set of pairs."


Made inherit-multimethod smarter (doc-string is no more growing when recompiling in slime)

--- src/conexp/util.clj
+++ src/conexp/util.clj
@@ -8,7 +8,8 @@

 (ns conexp.util
   (:use clojure.contrib.profile
-	[clojure.contrib.math :only (round)])
+    [clojure.contrib.math :only (round)]
+    [clojure.contrib.string :only (join)])
   (:import javax.swing.JOptionPane
 	   java.util.Calendar
 	   java.text.SimpleDateFormat))
@@ -320,28 +321,80 @@

 ;;; multimethod helpers

+(defn test-list-types-object
+  "Tests whether the second argument is of a child type of the elements of the
+  first argument, returns the first matching parent type. Returns nil if
+  the second argument is of none of the types in the list.
+
+  Parameters:
+    typelist   _list of types
+    object     _object to test for 'isa?' relation"
+  [typelist object]
+  (let [ is-child-type? (fn [x] (isa? (type object) x))
+         good-types (filter is-child-type? typelist) ]
+    (first good-types)))
+
+(defn insert-before-first-pred
+  "Takes a predicate, a seq and an element and returns a seq
+  that will have the element inserted right before the first
+  element that fulfills the predicate.
+
+  Parameters:
+         pred   _predicate function
+         coll   _sequence
+         item   _new item"
+  [pred coll item]
+  (loop [ construct identity
+          coll coll]
+    (if (empty? coll) (construct (seq (list item)))
+      (let [ head (first coll)
+             tail (rest coll) ]
+        (if (pred head) (construct (cons item coll))
+          (recur (fn [x] (construct (cons head x))) tail))))))
+
+
 (defmacro inherit-multimethod
   "Creates a new multimethod that dispatches by type hierarchy
    on the first parameter and sets the dispatcher to recognize
    all inherited types, then appends the given documentation."
   [name type-name doc-str]
   (let [name-str (str name)]
-  `(let [ old-meta# (meta ((ns-map *ns*) (quote ~name)))
-          old-doc# (when-not (nil? old-meta#) (:doc old-meta#))]
-    (defonce ~name (fn [& args#]
-                      (illegal-argument
-                        (str ~name-str
-                          " called, but there is no method defined for type "
-                          (when-not (empty? args#) (type (first args#)))
-                          "!"  ))))
-     (let [new-doc# (str ~type-name "\n******\n" ~doc-str "\n\n"
-                      old-doc#)
-            other-branch# ~name]
-       (defmulti ~name
-         (fn [x# & args#] (when (isa? (type x#) ~type-name) ~type-name)))
-       (defmethod ~name nil [& args#] (apply other-branch# args#))
-       (.setMeta (var ~name) (conj (meta (var ~name)) {:doc new-doc#}))))))
-
+    `(let [ old-meta# (meta ((ns-map *ns*) (quote ~name)))
+            old-doc-strings-val# (if (nil? old-meta#) {} (:doc-strings old-meta#))
+            old-doc-strings# (if (nil? old-doc-strings-val#) {} old-doc-strings-val#)
+            old-types# (if (nil? old-meta#) (list) (:type-list old-meta#))]
+       (defonce ~name nil)
+       (let [ old-func# ~name
+              doc-strings# (conj old-doc-strings#
+                             {~type-name (str ~type-name "\n=====\n" ~doc-str)})
+              is-new-type# (not (some #{~type-name} old-types#))
+              types#  (if is-new-type#
+                        (insert-before-first-pred (fn [x#] (isa? ~type-name x#))
+                          old-types# ~type-name)
+                        old-types#)
+              new-doc# (join "\n+++++\n\n"
+                         (cons (str "is a multimethod dispatched"
+                                 " on type of the first argument...")
+                           (map doc-strings# types#)))]
+         (when is-new-type#
+           (defmulti ~name (fn [x# & args#] (test-list-types-object types# x#)))
+           (defmethod ~name nil [& args#]
+             (illegal-argument (str ~name-str
+                                 " called, but there is no method declared for type "
+                                 (when-not (empty? args#) (type (first args#))) "!"  )))
+           (defmethod ~name ~type-name [& args#]
+             (illegal-argument (str ~name-str
+                                 " called, but there is a method declared but"
+                                 " not defined for type "
+                                 (when-not (empty? args#) (type (first args#))) "!"  )))
+           (doseq [t# old-types#]
+             (defmethod ~name t# [& args#] (apply old-func# args#))))
+         (.setMeta (var ~name) (conj (meta (var ~name))
+                                 {:doc new-doc#
+                                 :doc-strings doc-strings#
+                                 :type-list types#}))))))
+
+
 ;; synchronization helpers

 (defmacro dosync-wait


Much more aggressive page culling

Much more aggressive page culling

--- src/background/relevance/background.cljs
+++ src/background/relevance/background.cljs
@@ -143,8 +143,8 @@
           new-urls   (->
                        (:url-times migrated)
                        (data/clean-up-by-time (- t (* 7 ms-day)) 30)
-                       (data/clean-up-by-time (- t (* 14 ms-day)) 90)
-                       (data/clean-up-by-time (- t (* 30 ms-day)) 300)
+                       (data/clean-up-by-time (- t (* 14 ms-day)) 300)
+                       (data/clean-up-by-time (- t (* 30 ms-day)) 1800)
                        (data/clean-up-ignored ignore-set))
           site-data  (:site-times migrated)
           new-sites  (if (not= new-urls (:url-times migrated))


Poistetaan turhat middlewaret

Poistetaan turhat middlewaret

--- mtg-pairings-server/src/clj/mtg_pairings_server/server.clj
+++ mtg-pairings-server/src/clj/mtg_pairings_server/server.clj
@@ -22,20 +22,6 @@
                 (:status response))
       response)))

-(defn wrap-remove-content-length
-  [handler]
-  (fn [request]
-    (let [response (handler request)]
-      (update-in response [:headers] dissoc "Content-Length" "content-length"))))
-
-(defn wrap-resource-304
-  [handler root]
-  (-> handler
-    (wrap-resource root)
-    wrap-content-type
-    wrap-not-modified
-    wrap-remove-content-length))
-
 (defn wrap-allow-origin
   [handler]
   (fn [request]
@@ -53,6 +39,5 @@
     (-> handler
         wrap-json-with-padding
         wrap-request-log
-        (wrap-resource-304 "public")
         wrap-allow-origin)
     server-properties))


core: merge-with

core: merge-with

--- data/core.clj
+++ data/core.clj
@@ -1508,3 +1508,20 @@
   [& maps]
   (when (some identity maps)
     (reduce1 #(conj (or %1 {}) %2) maps)))
+
+(defn merge-with
+  "Returns a map that consists of the rest of the maps conj-ed onto
+  the first.  If a key occurs in more than one map, the mapping(s)
+  from the latter (left-to-right) will be combined with the mapping in
+  the result by calling (f val-in-result val-in-latter)."
+  {:added "1.0"}
+  [f & maps]
+  (when (some identity maps)
+    (let [merge-entry (fn [m e]
+                        (let [k (key e) v (val e)]
+                          (if (contains? m k)
+                            (assoc m k (f (get m k) v))
+                            (assoc m k v))))
+          merge2 (fn [m1 m2]
+                   (reduce1 merge-entry (or m1 {}) (seq m2)))]
+      (reduce1 merge2 maps))))


core: integer?

core: integer?

--- data/core.clj
+++ data/core.clj
@@ -908,3 +908,10 @@
   "Bitwise shift right, without sign-extension."
   {:added "1.0"}
   [x n] (unsigned-bit-shift-right* x n))
+
+(defn integer?
+  "Returns true if n is an integer"
+  {:static true}
+  [n]
+  (or (instance? Int n)
+      (instance? BigInt n)))


storage instantiation added

storage instantiation added

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -10,6 +10,7 @@
             Cluster Topologies SchedulerAssignment SchedulerAssignmentImpl DefaultScheduler ExecutorDetails])
   (:use [backtype.storm bootstrap util])
   (:use [backtype.storm.daemon common])
+  (:use [backtype.storm.nimbus storage])
   (:gen-class
     :methods [^{:static true} [launch [backtype.storm.scheduler.INimbus] void]]))

@@ -36,6 +37,7 @@
      :uploaders (file-cache-map conf)
      :uptime (uptime-computer)
      :validator (new-instance (conf NIMBUS-TOPOLOGY-VALIDATOR))
+     :storage (create-nimbus-storage conf)
      :timer (mk-timer :kill-fn (fn [t]
                                  (log-error t "Error when processing event")
                                  (halt-process! 20 "Error when processing an event")


write model resource bug

write model resource bug

--- src/clojure/zensols/model/classifier.clj
+++ src/clojure/zensols/model/classifier.clj
@@ -201,7 +201,7 @@
   [name model]
   (let [file (if (instance? File name)
                name
-               (model-read-resource name))
+               (model-write-resource name))
         to-make-dirs (.getParentFile file)]
     (if to-make-dirs (.mkdirs to-make-dirs))
     (with-open [out (io/output-stream file)]


Remove UMAD from gene-selection genetic operator (use in pipeline or separately if you want it)

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -819,21 +819,25 @@

 (defn gene-selection
   "Takes each gene from a selected parent, with re-selection for each gene with probability
-  gene-selection-rate. Then subjects the result to uniform-addition-and-deletion."
-  [initial-parent {:keys [gene-selection-rate population] :as argmap}]
-  (uniform-addition-and-deletion
-    (assoc initial-parent
-      :genome (loop [parent-genome (:genome initial-parent)
-                     index 0
-                     child-genome []]
-                (if (> (inc index) (count parent-genome))
-                  child-genome
-                  (recur (if (>= gene-selection-rate (lrand))
-                           (:genome (select population argmap))
-                           parent-genome)
-                         (inc index)
-                         (conj child-genome (nth parent-genome index))))))
-    argmap))
+  gene-selection-rate."
+  [initial-parent {:keys [gene-selection-rate population maintain-ancestors] :as argmap}]
+  (let [new-genome (loop [parent-genome (:genome initial-parent)
+                          index 0
+                          child-genome []]
+                     (if (> (inc index) (count parent-genome))
+                       child-genome
+                       (recur (if (>= gene-selection-rate (lrand))
+                                (:genome (select population argmap))
+                                parent-genome)
+                              (inc index)
+                              (conj child-genome (nth parent-genome index)))))]
+    (make-individual :genome new-genome
+                     :history (:history initial-parent)
+                     :age (inc (:age initial-parent))
+                     :grain-size (compute-grain-size new-genome initial-parent argmap)
+                     :ancestors (if maintain-ancestors
+                                  (cons (:genome initial-parent) (:ancestors initial-parent))
+                                  (:ancestors initial-parent)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; autoconstuction


More autoconstruction experimentation.

More autoconstruction experimentation.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -292,22 +292,19 @@
             c2c (produce-child-genome-by-autoconstruction c2 g true)]
         (if (express-same-programs? c1c c2c)
           false
-          (let [c1cc1 (produce-child-genome-by-autoconstruction c1c g true)
-                c1cc2 (produce-child-genome-by-autoconstruction c1c c1 true)]
-            (if (express-same-programs? c1cc1 c1cc2)
+          (let [c1cc (produce-child-genome-by-autoconstruction c1c g true)
+                c2cc (produce-child-genome-by-autoconstruction c2c g true)]
+            (if (express-same-programs? c1cc c2cc)
               false
-              (let [c2cc1 (produce-child-genome-by-autoconstruction c2c g true)
-                    c2cc2 (produce-child-genome-by-autoconstruction c2c c2 true)]
-                (if (express-same-programs? c2cc1 c2cc2)
-                  false
-                  (if (let [g-size (count g)
-                            descendant-sizes (map count [c1cc1 c1cc2 c2cc1 c2cc2])]
-                        (or (>= (apply min descendant-sizes)
-                                g-size)
-                            (<= (apply max descendant-sizes)
-                                g-size)))
-                    false
-                    true))))))))))
+              (if false
+                #_(let [g-size (count g)
+                       descendant-sizes (map count [c1cc1 c1cc2 c2cc1 c2cc2])]
+                   (or (>= (apply min descendant-sizes)
+                           g-size)
+                       (<= (apply max descendant-sizes)
+                           g-size)))
+                false
+                true))))))))

 (defn autoconstruction
   "Returns a genome for child produced by autoconstruction by executing parent1 with parent1,


marking dynamic fields and using slingshot

--- src/com/narkisr/couchfs/couch_access.clj
+++ src/com/narkisr/couchfs/couch_access.clj
@@ -2,6 +2,7 @@
   (:refer-clojure :exclude [contains?])
   (:require [clj-http.client :as client])
   (:use
+    [slingshot.slingshot :only [try+]]
     (com.narkisr fs-logic)
     [clojure.java.io :only [copy]]
     (couchdb
@@ -11,8 +12,8 @@
     (java.io ByteArrayOutputStream InputStream)
     (java.net URL)))

-(def *host* "http://127.0.0.1:5983/")
-(def *db* "playground")
+(def ^:dynamic *host* "http://127.0.0.1:5983/")
+(def ^:dynamic *db* "playground")

 (defn couch [fn & params]
   "Applies the binded couch configuration on the given fn, this cannot be a macro since the values are binded post the expansion stage"
@@ -62,8 +63,8 @@
   (fn [] (-> (URL. (couch str "/" doc "/" attachment)) (. openConnection) (. getInputStream) to-byte-array)))

 (defn db-exists? [host db]
-  (try (client/get (str host db))
-    (catch java.io.IOException e nil)))
+  (try+ (client/get (str host db))
+    (catch identity e nil)))

 (defn create-non-existing-db [name]
   (when-not (db-exists? *host* name)


Changed how the app starts

Changed how the app starts

--- src/dmgr/core.clj
+++ src/dmgr/core.clj
@@ -49,7 +49,8 @@
    ;;   :push-to-heroku (format "cd %s/repo && heroku git:remote -a %s && git push heroku master" app-name app-name app-name  heroku-repo-uri)
    :push-to-heroku (format "cd %s/repo && git remote add heroku git@heroku.com:%s.git &&  git config heroku.remote heroku && git push heroku master"
                            app-name app-name)
-   :remove-staging-dir (format "rm -rf %s" app-name)})
+   ;:remove-staging-dir (format "rm -rf %s" app-name)
+   })

 :push-to-heroku
 ;;   (run app-path (str "cd " app "/repo && bundle install --without=production && bundle exec jekyll build && git add . && git commit -am 'auto-build update' && git push -f " (env (str app "_HEROKU_REPO")) " master"))
@@ -74,7 +75,9 @@
                  (run app-path (:fetch-and-reset cmds)) ;"Starting repo update"
                  (run app-path (:clone cmds)))]
     (do (run app-path (:push-to-heroku cmds))
-        (run app-path (:remove-staging-dir cmds)))))
+;;        (run app-path (:remove-staging-dir cmds))
+        )))
+

 (defroutes main-routes
   (GET "/" [] "
Nothing to see here, move along
")


Removed no longer needed development code in core ns

--- resources/leiningen/new/retro_fever/core/src/core.cljs
+++ resources/leiningen/new/retro_fever/core/src/core.cljs
@@ -17,18 +17,9 @@
 (defn setup [] ; Function to setup initial game state
 <% if scene? %>  (swap! game-state :scene (scene/scene))
 <% endif %>)
-<% if weasel? %>
-(if-not (ws-repl/alive?)
-  (do (print "Open REPL")
-      (ws-repl/connect "ws://localhost:9001"
-                       :verbose true
-                       :print #{:repl :console}
-                       :on-error #(print "Error! " %))))
-<% endif %>
-(defn ^:export init [] ; The entry point into the game from the HTML page
-<% if figwheel? %>  (fw/start {:on-jsload (fn [] (print "reloaded"))})

-<% endif %>  (.log js/console "Launching game")
+(defn init! [] ; The entry point into the game from the HTML page
+  (.log js/console "Launching game")

   (core/init-canvas "game-canvas" 640 480) ; Initialize canvas on HTML page
   (input/init) ; Initialize input devices


Reset common peak in runtime

Reset common peak in runtime

--- src/clojure/com/flashlightdb/ceilingbounce/runtime.clj
+++ src/clojure/com/flashlightdb/ceilingbounce/runtime.clj
@@ -39,6 +39,7 @@
                :text (str lux)))

 (defn reset-peak [_evt]
+  (common/reset-peak)
   (swap! peak-lux min 0))

 (declare runtime-test)


removed a bunch of unnecessary functions and just have them implemented directly in specify-files

--- src/duffel/fs.clj
+++ src/duffel/fs.clj
@@ -79,17 +79,6 @@
       :dir-ls    dir-ls
       :is-dir?   true    }))

-(defn explode-files-in-list
-    "Take a list of filenames and turn them into file structs containing info
-    about their real name, extension, and host specifier"
-    [file-list]
-    (map explode-file file-list))
-
-(defn remove-empty-file-structs
-    "Looks through list of file structs and removes any with empty names"
-    [file-structs]
-    (remove #(empty? (% :base-name)) file-structs))
-
 (defn add-to-basename-group
     "Given a map and a file struct, creates a list with the file-struct
     as the only item for the index of the map corresponding to the file-
@@ -101,12 +90,6 @@
           new-seq (cons file-struct base-name-seq)]
         (assoc file-map base-name new-seq)))

-(defn group-by-basename
-    "Goes through file structs and groups them into a map by basename
-    { <base-name> <list of structs> }"
-    [file-structs]
-    (reduce add-to-basename-group {} file-structs))
-
 (defn narrow-group
     "Given a list of file-structs, returns the struct with the most specific
     specifier"
@@ -114,12 +97,6 @@
     (let [specifiers (map #(% :specifier) group-seq)]
         (when-let [i (index-of-specified-entry specifiers)]
             (nth group-seq i))))
-
-(defn narrow-groups
-    "Given a map of basename groups, returns a list of all the most specific
-    structs from each basename group"
-    [file-map]
-    (map #(narrow-group (val %)) file-map))

 (declare specify-files)
 (defn directory-consolidate
@@ -131,10 +108,6 @@
         (cons (dissoc file-struct :dir-ls) (specify-files (file-struct :dir-ls)))
         file-struct))

-(defn directory-recursion
-    [file-structs]
-    (map directory-consolidate file-structs))
-
 (defn specify-files
     "Given a list of file names (presumably all in the same folder) goes and performs
     all the steps needed to narrow down which files we want to actually use for this
@@ -142,11 +115,11 @@
     Returns a list of file-structs"
     [file-list]
     (->> file-list
-         (explode-files-in-list)
-         (remove-empty-file-structs)
-         (group-by-basename)
-         (narrow-groups)
-         (directory-recursion)))
+         (map explode-file)                 ; - Explode the files into their file-struct's
+         (remove #(empty? (% :base-name)))  ; - Remove ones with empty base-names (shouldn't really happen)
+         (reduce add-to-basename-group {})  ; - Reduce the structs by basename into a grouplist map
+         (map #(narrow-group (val %)))      ; - Take all the vals in the grouplist map and narrow them down to a single file-struct
+         (map directory-consolidate)))      ; - Call specify files on the file list of all directory structs

 (defn specify-tree
     "Since specify-files expects simply a list of files, not a '(dir & files)