Only allow rollback button when there's a snapshot.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -21,7 +21,7 @@
 (def prog-base    (atom {}))  ; Stable parts of prog, even during time-travel.
 (def prog-curr    (atom {}))  ; The current prog-frame.
 (def prog-hover   (atom nil)) ; A past prog-frame while hovering over prog-history.
-(def prog-history (atom []))  ; Each event is [ts label prog-frame].
+(def prog-history (atom []))  ; Each event is [ts label prog-frame has-snapshot].
 (def prog-ss      (atom {}))  ; ts => agw-snapshot.

 (defn prog-init [world]
@@ -37,10 +37,10 @@
   (reset! prog-history []))

 (defn prog-event [world label prog-frame-fn]
-  (let [prog-next (swap! prog-curr #(prog-frame-fn (update-in % [:ts] inc)))]
-    (swap! prog-history #(conj % [(:ts prog-next) label prog-next]))
-    ; Only snapshot when quiescent.
-    (when (<= (.-length cljs.core.async.impl.dispatch/tasks) 0)
+  (let [prog-next (swap! prog-curr #(prog-frame-fn (update-in % [:ts] inc)))
+        need-snapshot (<= (.-length cljs.core.async.impl.dispatch/tasks) 0)]
+    (swap! prog-history #(conj % [(:ts prog-next) label prog-next need-snapshot]))
+    (when need-snapshot ; Only snapshot when quiescent.
       (swap! prog-ss #(assoc % (:ts prog-next) (ago-snapshot (actx-agw world)))))))

 ; -------------------------------------------------------------------
@@ -75,13 +75,15 @@

 (defn render-events [app owner]
   (apply dom/ul nil
-         (map (fn [[ts label prog-frame]]
+         (map (fn [[ts label prog-frame has-snapshot]]
                 (dom/li #js {:className (str "evt evt-" ts)
                              :onMouseEnter #(on-prog-frame-focus prog-frame)
                              :onMouseLeave #(on-prog-frame-blur)}
-                        (dom/button
-                         #js {:onClick #(on-prog-frame-restore ts prog-frame)}
-                         "rollback")
+                        (if has-snapshot
+                          (dom/button
+                           #js {:onClick #(on-prog-frame-restore ts prog-frame)}
+                           "rollback")
+                          "")
                         (str ts (apply str label))))
               app)))


(PDB-1852) Cleanup syntax in the `add-report!*` function

This commit cleans up whitespace in the add-report!* function and names
some variables which were either not named (inside nested function
calls) or named poorly.

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -1154,27 +1154,28 @@
                 report-hash (shash/report-identity-hash report)]
            (sql/transaction
              (let [certname-id (certname-id certname)
-                   {:keys [id]} (sql/insert-record :reports
-                                 (maybe-environment
-                                  (maybe-resources
-                                   {:hash                   (sutils/munge-hash-for-storage report-hash)
-                                     :transaction_uuid       (sutils/munge-uuid-for-storage transaction_uuid)
-                                     :metrics (sutils/munge-jsonb-for-storage metrics)
-                                     :logs (sutils/munge-jsonb-for-storage logs)
-                                     :resources (sutils/munge-jsonb-for-storage resources)
-                                     :noop                   noop
-                                     :puppet_version         puppet_version
-                                     :certname               certname
-                                     :report_format          report_format
-                                     :configuration_version  configuration_version
-                                     :producer_timestamp     producer_timestamp
-                                     :start_time             start_time
-                                     :end_time               end_time
-                                     :receive_time           (to-timestamp received-timestamp)
-                                     :environment_id         (ensure-environment environment)
-                                     :status_id              (ensure-status status)})))
+                   row-map {:hash (sutils/munge-hash-for-storage report-hash)
+                            :transaction_uuid (sutils/munge-uuid-for-storage transaction_uuid)
+                            :metrics (sutils/munge-jsonb-for-storage metrics)
+                            :logs (sutils/munge-jsonb-for-storage logs)
+                            :resources (sutils/munge-jsonb-for-storage resources)
+                            :noop noop
+                            :puppet_version puppet_version
+                            :certname certname
+                            :report_format report_format
+                            :configuration_version configuration_version
+                            :producer_timestamp producer_timestamp
+                            :start_time start_time
+                            :end_time end_time
+                            :receive_time (to-timestamp received-timestamp)
+                            :environment_id (ensure-environment environment)
+                            :status_id (ensure-status status)}
+                   {report-id :id} (->> row-map
+                                        maybe-environment
+                                        maybe-resources
+                                        (sql/insert-record :reports))
                    assoc-ids #(assoc %
-                                     :report_id id
+                                     :report_id report-id
                                      :certname_id certname-id)]
                (->> resource_events
                     (sp/transform [sp/ALL :containment_path] #(some-> % sutils/to-jdbc-varchar-array))


Longer cache 24h for event extra data.

Longer cache 24h for event extra data.

--- src/ruuvi_server/database/event_dao.clj
+++ src/ruuvi_server/database/event_dao.clj
@@ -124,8 +124,9 @@
                  (where {:id event_id})))
   )

-(def ^{:private true} cache-event-extra-data (cache/create-cache-region :event-extra-data 10000 (* 60 60 1000)))
-
+(def ^{:private true} cache-event-extension-type (cache/create-cache-region :event-extension-type 10000 (* 24 60 60 1000)))
+
+;; TODO cache access to event-extension-type
 (defn- get-event-extra-data [event-id]
     {:event_locations (select event-location
                               (where {:event_id event-id}))


format message

format message

--- src/ci3/agent/core.clj
+++ src/ci3/agent/core.clj
@@ -100,16 +100,16 @@
 (def base-url (or (environ/env :ci3-config-base-url) "http://cleo-ci.health-samurai.io/"))

 (defn notify [st build & text]
-  (telegram/notify (str st " build " (get-in build [:repository]) " \n "
-                        (get-in build [:commit :message]) " \n "
-                        "by " (or (get-in build [:commit :author :raw]) (get-in build [:commit :author :name])) " \n "
+  (telegram/notify (str st " build " (get-in build [:repository]) " \n"
+                        (get-in build [:commit :message]) " \n"
+                        "By: " (or (get-in build [:commit :author :raw]) (get-in build [:commit :author :name])) " \n"
                         base-url "builds/" (get-in build [:metadata :name])
                         (when text (str " \n ```" (str/join text) "```") ))))

 (defn error [build res]
   (println build)
   (when-not (:test build)
-    (notify "Fail" build))
+    (notify "Fail" build res))
   (update-status (assoc build :status "failed")))

 (defn success [build]


Start all the queue listeners in the twitter ns

--- src/myshelf/twitter.clj
+++ src/myshelf/twitter.clj
@@ -9,6 +9,7 @@
             [myshelf.models.user :as user]
             [myshelf.worker :refer [default-exchange
                                     connection-params
+                                    handle-message
                                     reply-queue
                                     worker-queue]]
             [twitter.oauth :as auth]
@@ -128,7 +129,9 @@
         screen-name "mindbat"
         creds (get-creds)
         check-interval (* 60 1000) #_"one minute"]
+    (lq/declare channel worker-queue {:auto-delete false})
     (lq/declare channel reply-queue {:auto-delete false})
+    (lcs/subscribe channel worker-queue handle-message {:auto-ack true})
     (lcs/subscribe channel reply-queue (partial handle-reply creds)
                    {:auto-ack true})
     (listen-for-tweets channel creds screen-name check-interval)))


views moved to a separate directory

views moved to a separate directory

--- src/notehub/handler.clj
+++ src/notehub/handler.clj
@@ -1,70 +1,16 @@
 (ns notehub.handler
   (:use compojure.core
+        [notehub.views]
         [notehub.settings]
         [clojure.string :rename {replace sreplace} :only [replace]]
-        [clojure.core.incubator :only [-?>]]
-        [hiccup.form]
-        [hiccup.core]
-        [hiccup.element]
-        [hiccup.util :only [escape-html]]
-        [hiccup.page :only [include-js html5]])
-  (:require [compojure.handler :as handler]
-            [compojure.route :as route]
-            [hiccup.util :as util]
-            [notehub.api :as api]
-            [notehub.storage :as storage]
-            [cheshire.core :refer :all]))
-
-; Creates the main html layout
-(defn layout
-  [title & content]
-  (html5
-   [:head
-    [:title (print-str (get-message :name) "—" title)]
-    [:meta {:charset "UTF-8"}]
-    [:meta {:name "viewport" :content "width=device-width, initial-scale=1.0"}]
-    [:link {:rel "stylesheet/less" :type "text/css" :href "/styles/main.less"}]
-    (html
-     (include-js "/js/less.js")
-     (include-js "/js/themes.js")
-     (include-js "/js/md5.js")
-     (include-js "/js/marked.js")
-     (include-js "/js/main.js"))
-    ; google analytics code should appear in prod mode only
-    (if-not (get-setting :dev-mode) (include-js "/js/google-analytics.js"))]
-   [:body {:onload "onLoad()"} content]))
-
-(defn md-node
-  "Returns an HTML element with a textarea inside
-  containing the markdown text (to keep all chars unescaped)"
-  ([cls input] (md-node cls {} input))
-  ([cls opts input]
-   [(keyword (str (name cls) ".markdown")) opts
-    [:textarea input]]))
-
-(defn sanitize
-  "Breakes all usages of <script> & <iframe>"
-  [input]
-  (sreplace input #"(</?(iframe|script).*?>|javascript:)" ""))
-
-; input form for the markdown text with a preview area
-(defn input-form [form-url command fields content passwd-msg]
-  (let [css-class (when (= :publish command) :hidden)]
-    (layout (get-message :new-note)
-            [:article#preview ""]
-            [:div#dashed-line {:class css-class}]
-            [:div.central-element.helvetica {:style "margin-bottom: 3em"}
-             (form-to {:autocomplete :off} [:post form-url]
-                      (hidden-field :action command)
-                      (hidden-field :version api/version)
-                      (hidden-field :password)
-                      fields
-                      (text-area {:class :max-width} :note content)
-                      [:fieldset#input-elems {:class css-class}
-                       (text-field {:class "ui-elem" :placeholder (get-message passwd-msg)}
-                                   :plain-password)
-                       (submit-button {:class "button ui-elem"
-                                       :id :publish-button} (get-message command))])])))
+        [clojure.core.incubator :only [-?>]])
+  (:require
+    [hiccup.util :as util]
+    [compojure.handler :as handler]
+    [compojure.route :as route]
+    [notehub.api :as api]
+    [notehub.storage :as storage]
+    [cheshire.core :refer :all]))

 ; TODO: make sure the status is really set to the response!!!!
 (defn- response
@@ -102,18 +48,7 @@
   (context "/api" []
            #(ring.util.response/content-type (api-routes %) "application/json"))

-  (GET "/" []
-       (layout (get-message :page-title)
-               [:div#hero
-                [:h1 (get-message :name)]
-                [:h2 (get-message :title)]
-                [:br]
-                [:a.landing-button {:href "/new" :style "color: white"} (get-message :new-page)]]
-               [:div#dashed-line]
-               (md-node :article.helvetica.bottom-space
-                        {:style "font-size: 1em"}
-                        (slurp "LANDING.md"))
-               (md-node :div.centered.helvetica (get-message :footer))))
+  (GET "/" [] landing-page)

   (GET "/:year/:month/:day/:title/export" [year month day title]
        (when-let [md-text (:note (api/get-note {:noteID (api/build-key year month day title)}))]
@@ -121,51 +56,15 @@

   (GET "/:year/:month/:day/:title/stats" [year month day title]
        (when-let [resp (api/get-note {:noteID (api/build-key year month day title)})]
-         (let [stats (:statistics resp)
-               statistics (get-message :statistics)]
-           (layout statistics
-                   [:h2.central-element (api/derive-title (:note resp))]
-                   [:h3.central-element.helvetica statistics]
-                   [:table#stats.helvetica.central-element
-                    (map
-                      #(when-let [v (% stats)]
-                         [:tr
-                          [:td (str (get-message %) ":")]
-                          [:td (if (or (= % :published) (= % :edited))
-                                 (str (java.util.Date. (Long/parseLong v))) v)]])
-                      [:published :edited :publisher :views])]))))
+         (statistics-page resp)))

   (GET "/:year/:month/:day/:title/edit" [year month day title]
-       (let [noteID (api/build-key year month day title)]
-         (input-form "/update-note" :update
-                     (html (hidden-field :noteID noteID))
-                     (:note (api/get-note {:noteID noteID})) :enter-passwd)))
+       (note-update-page year month day title))

-  (GET "/new" []
-       (input-form "/post-note" :publish
-                   (html (hidden-field :session (storage/sign (str (rand-int Integer/MAX_VALUE))))
-                         (hidden-field {:id :signature} :signature))
-                   (get-message :loading) :set-passwd))
+  (GET "/new" [] new-note-page)

   (GET "/:year/:month/:day/:title" [year month day title :as params]
-       (let [params (assoc (:query-params params)
-                      :year year :month month :day day :title title)
-             noteID (api/build-key year month day title)]
-         (when (storage/note-exists? noteID)
-           (let [note (api/get-note {:noteID noteID})
-                 sanitized-note (sanitize (:note note))]
-             (layout (:title note)
-                     (md-node :article.bottom-space sanitized-note)
-                     (let [urls {:short-url (api/url (storage/create-short-url noteID params))
-                                 :notehub "/"}
-                           links (map #(link-to
-                                        (if (urls %)
-                                          (urls %)
-                                          (str (:longURL note) "/" (name %)))
-                                        (get-message %))
-                                      [:notehub :stats :edit :export :short-url])
-                           links (interpose [:span.middot "·"] links)]
-                       [:div#links links]))))))
+       (note-page year month day title params))

   (GET "/:short-url" [short-url]
        (when-let [params (storage/resolve-url short-url)]


Remove let bindings.

Remove let bindings.

--- src/onyx/plugin/sql.clj
+++ src/onyx/plugin/sql.clj
@@ -114,10 +114,9 @@

 (defmethod p-ext/drained? [:input :sql]
   [{:keys [sql/pending-messages]}]
-  (let [y @pending-messages]
-    (let [x @pending-messages]
-      (and (= (count (keys x)) 1)
-           (= (first (map :message (vals x))) :done)))))
+  (let [x @pending-messages]
+    (and (= (count (keys x)) 1)
+         (= (first (map :message (vals x))) :done))))

 (defmethod l-ext/inject-lifecycle-resources :sql/read-rows
   [_ {:keys [onyx.core/task-map] :as event}]


use new allocator to allocate sequential busses

--- src/overtone/sc/bus.clj
+++ src/overtone/sc/bus.clj
@@ -25,7 +25,7 @@
   "Allocate one ore more control busses."
   ([] (control-bus 1))
   ([n-channels]
-   (let [id (alloc-id :control-bus)]
+   (let [id (alloc-id :control-bus n-channels)]
      (with-meta {:id id
                  :n-channels n-channels
                  :rate :control}
@@ -35,7 +35,7 @@
   "Allocate one ore more audio busses."
   ([] (audio-bus 1))
   ([n-channels]
-   (let [id (alloc-id :audio-bus)]
+   (let [id (alloc-id :audio-bus n-channels)]
      (with-meta {:id id
                  :n-channels n-channels
                  :rate :audio}
@@ -44,8 +44,8 @@
 (defn free-bus
   [b]
   (case (type b)
-    ::audio-bus   (free-id :audio-bus (:id b))
-    ::control-bus (free-id :control-bus (:id b))))
+    ::audio-bus   (free-id :audio-bus (:id b) (:n-channels b))
+    ::control-bus (free-id :control-bus (:id b) (:n-channels b))))

 ; Reserve the first 11 busses for audio I/O and mixer, forever.
 (dotimes [i 11]


write a migration for adding frontend ids, but don't run it yet

--- src/pc/datomic/migrations.clj
+++ src/pc/datomic/migrations.clj
@@ -52,6 +52,18 @@
                       :cust/name "prcrsr"
                       :cust/uuid (d/squuid)}]))

+(defn add-frontend-ids
+  "Adds frontend ids to entities that need one"
+  [conn]
+  ;; assuming that only entities with document-ids need one. May
+  ;; require another migration later if that's false.
+  (let [db (d/db conn)]
+    (dorun (pmap (fn [datoms]
+                   @(d/transact-async conn
+                                      (for [[doc-id datom-group] (group-by :v datoms)]
+                                        [:temporary/assign-frontend-id (map :e datom-group) doc-id])))
+                 (partition-all 100 (d/datoms db :aevt :document/id))))))
+
 (def migrations
   "Array-map of migrations, the migration version is the key in the map.
    Use an array-map to make it easier to resolve merge conflicts."


load games-scenarios.clj

load games-scenarios.clj

--- src/clj/test/cards.clj
+++ src/clj/test/cards.clj
@@ -9,4 +9,5 @@
 (load "cards-operations")
 (load "cards-programs")
 (load "cards-resources")
-(load "cards-upgrades")+(load "cards-upgrades")
+(load "games-scenarios")


fix reflection warning

fix reflection warning

--- src/clj_kafka/core.clj
+++ src/clj_kafka/core.clj
@@ -49,7 +49,7 @@
    Source: http://clj-me.cgrand.net/2010/04/02/pipe-dreams-are-not-necessarily-made-of-promises/"
   ([] (pipe 100))
   ([size]
-   (let [q (java.util.concurrent.LinkedBlockingQueue. size)
+   (let [q (java.util.concurrent.LinkedBlockingQueue. ^int size)
          EOQ (Object.)
          NIL (Object.)
          s (fn queue-seq [] (lazy-seq


CMR-3852: Removed unused test

CMR-3852: Removed unused test

--- metadata-db-app/test/cmr/metadata_db/test/data/oracle/concepts.clj
+++ metadata-db-app/test/cmr/metadata_db/test/data/oracle/concepts.clj
@@ -98,10 +98,6 @@
       (finally
         (lifecycle/stop db nil)))))

-(deftest ifail
-  (testing "failure"
-    (is (= 1 0))))
-
 (deftest concept->insert-args-test
   (testing "collection insert-args"
     (let [revision-time (t/date-time 1986 10 14 4 3 27 456)


Fixing the granule ingest test.

Fixing the granule ingest test.

--- test/cmr/system_int_test/ingest/granule_ingest_test.clj
+++ test/cmr/system_int_test/ingest/granule_ingest_test.clj
@@ -119,7 +119,7 @@
   (let [collection (old-ingest/collection-concept "PROV1" 5)
         _ (ingest/ingest-concept collection)
         granule {:concept-type :granule
-                 :native-id "Name%2FWith%2FSlashes"
+                 :native-id "Name/With/Slashes"
                  :provider-id "PROV1"
                  :metadata (old-ingest/granule-xml old-ingest/base-concept-attribs)
                  :format "application/echo10+xml"


Basic defn-ui-component now works in hosted CLJS!!!

Amazing!!!!

--- src/webapp/framework/client/macros.cljs
+++ src/webapp/framework/client/macros.cljs
@@ -8,8 +8,104 @@

-(defmacro ns-coils [nm]
-  `(webapp.framework.client.coreclient/ns-coils  ~nm))
+
+(defmacro defn-ui-component
+
+  ([fn-name  data-paramater-name  code ]
+   `(defn-ui-component  ~fn-name  ~data-paramater-name  {}  ~code))
+
+
+
+  ([fn-name data-paramater-name opts code ]
+    `(do
+
+       (defn ~fn-name [~(first data-paramater-name)  ~'owner]
+         (~'reify
+
+          ~'om.core/IInitState
+          (~'init-state ~'[_]
+                      {:debug-highlight false})
+
+
+           ~'om.core/IWillUnmount
+           (~'will-unmount ~'[_]
+             (~'let [
+                     ~'ui-component-name    ~(str `~fn-name)
+                     ~'path                 ~'(om.core/get-state owner :parent-path)
+             ]
+               nil
+                ;(~'.log ~'js/console (~'str "Unmount: " ~'path ))
+            ))
+
+
+          ~'om.core/IRender
+          (~'render [~'this]
+
+                    (~'let [
+                            ~'debug-id       (webapp.framework.client.coreclient/record-component-call
+                                              (~'ns-coils-debug)
+                                              ~(str `~fn-name)
+                                              ~(first data-paramater-name)
+                                              ~'(om.core/get-state owner :parent-path)
+                                              )
+
+
+                            ~'ui-component-name    ~(str `~fn-name)
+                            ~'path       ~'(om.core/get-state owner :parent-path)
+
+                            ~'ui-state   ~(first data-paramater-name)
+
+                            ~'parent-id  ~'debug-id
+
+                            ~'return-val (webapp.framework.client.coreclient/debug-react
+                                          ~(str `~fn-name)
+                                          ~'owner
+                                          ~(first data-paramater-name)
+                                          (~'fn [~(first data-paramater-name)]
+                                                ~code)
+                                          ~'path
+                                          ~'parent-id
+                                          )
+
+                            ~'removed-id     (~'webapp.framework.client.coreclient/remove-debug-event  ~'debug-id)
+                            ]
+
+                      ~'return-val)
+
+           )
+
+          ~'om.core/IDidMount
+          (~'did-mount
+           [~'this]
+           (~'let [
+                   ~'path           ~'(om.core/get-state owner :parent-path)
+
+                   ~'debug-id       (webapp.framework.client.coreclient/record-component-call
+                                     (~'ns-coils-debug)
+                                     ~(str `~fn-name)
+                                     ~(first data-paramater-name)
+                                     ~'(om.core/get-state owner :parent-path)
+                                     )
+
+                   ~'parent-id       ~'debug-id
+                   ]
+
+
+                  ~(get opts :on-mount )))))
+
+
+
+       )))
+
+
+
+
+
+
+
+(defmacro nscoils [namespace-name]
+  `(defn ~'ns-coils-debug  [] (str ~namespace-name)))
+

 (defmacro span [attributes & more]
   `(om.dom/span  (webapp.framework.client.coreclient/attrs ~attributes) ~@more))


cleanup

cleanup

--- src/ecregister/core.clj
+++ src/ecregister/core.clj
@@ -223,7 +223,9 @@

 (def f (make-frame (build-content)))
 (show! f)
-(config! f :content (build-content))
+;(config! f :content (build-content))
+
+

 ;; (defn -main [& args]


CMR-3154: Added additional test cases for acl search by group_permission

--- access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
@@ -172,23 +172,23 @@
         acl4 (ingest-acl token (provider-acl "AUDIT_REPORT"))
         acl5 (ingest-acl token (assoc (provider-acl "OPTION_DEFINITION")
                                       :group_permissions
-                                      [{:user_type "registered" :permissions ["create"]}]))
+                                      [{:user_type "registered" :permissions ["order"]}]))
         acl6 (ingest-acl token (assoc (provider-acl "OPTION_ASSIGNMENT")
                                       :group_permissions
-                                      [{:group_id "AG12345-PROV" :permissions ["create"]}]))
+                                      [{:group_id "AG12345-PROV" :permissions ["delete"]}]))

         acl7 (ingest-acl token (catalog-item-acl "All Collections"))
         acl8 (ingest-acl token (assoc (catalog-item-acl "All Granules")
                                       :group_permissions
-                                      [{:user_type "registered" :permissions ["create"]}
+                                      [{:user_type "registered" :permissions ["read"]}
                                        {:group_id "AG10000-PROV" :permissions ["create"]}]))

         guest-acls [acl1 acl4 acl7]
         registered-acls [acl2 acl5 acl8]
         AG12345-acls [acl3 acl6]
         AG10000-acls [acl8]
-        read-acls [acl2]
-        create-acls [acl1 acl3 acl4 acl5 acl6 acl7 acl8]
+        read-acls [acl2 acl8]
+        create-acls [acl1 acl3 acl4 acl7 acl8]
         all-acls (concat guest-acls registered-acls AG12345-acls)]
     (u/wait-until-indexed)

@@ -252,11 +252,14 @@
            "Registered read"
            ["registered" "read"] read-acls

-           "Registered create"
-           ["registered" "create"] [acl5 acl8]
-
            "Group create"
-           ["AG12345-PROV" "create"] AG12345-acls
+           ["AG10000-PROV" "create"] [acl8]
+
+           "Registered order"
+           ["registered" "order"] [acl5]
+
+           "Group create"
+           ["AG12345-PROV" "create"] [acl3]

            "Another group create"
            ["AG10000-PROV" "create"] AG10000-acls
@@ -264,15 +267,18 @@
            "Group read"
            ["AG12345-PROV" "read"] []

+           "Group delete"
+           ["AG12345-PROV" "delete"] [acl6]
+
            "Case-insensitive group create"
            ["AG10000-PROV" "CREATE"] AG10000-acls

            ;; CMR-3154 acceptance criterium 2
-           "Registered read or registered create"
-           ["registered" "read" "registered" "create"] registered-acls
-
-           "Registered read or group AG12345-PROV create"
-           ["registered" "read" "AG12345-PROV" "create"] (conj AG12345-acls acl2)))
+           "Registered read or registered order"
+           ["registered" "read" "registered" "order"] registered-acls
+
+           "Registered read or group AG12345-PROV delete"
+           ["registered" "read" "AG12345-PROV" "delete"] [acl2 acl6 acl8]))

     ;; CMR-3154 acceptance criterium 3
     (testing "Search ACLs by group permission just group or permission"


Added *resources* add-resource and find-resource

--- base/compojure.clj
+++ base/compojure.clj
@@ -1,6 +1,6 @@
 (in-ns 'compojure)
 (clojure/refer 'clojure)
-(import '(javax.servlet.http HttpServletResponse))
+(import '(javax.servlet.http HttpServletRequest HttpServletResponse))

 (defn includes?
   "Returns true if x is contained in coll, else false."
@@ -9,7 +9,7 @@

 (defn re-escape
   "Escape all special regex chars in a string s."
-  [#^String s]
+  [s]
   (let [chars  "\\.*+|?()[]{}$^"
         escape #(if (includes? % chars) [\\ %] [%])]
     (apply str (mapcat escape s))))
@@ -66,3 +66,27 @@
     (vector? change)
       (doseq c change
         (update-response! response c))))
+
+(def *resources* {})
+
+(defn add-resource
+  "Add a resource to the global *resources* map. A resource is a HTTP
+   method keyword, a route, and a body to be evaluated in order to generate
+   a response.
+   e.g. (add-resource :GET \"/welcome/:name\"
+          '(str \"Hello \" (path :name)))"
+  [method route & body]
+  (def *resources*
+    (assoc *resources* method
+      (cons [(parse-route route) body]
+        (*resources* method)))))
+
+(defn find-resource
+  "Find the first resource that matches the HttpServletRequest"
+  [#^HttpServletRequest request]
+  (let [method    (. request (getMethod))
+        path      (. request (getPathInfo))
+        resources (*resources* (keyword method))
+        matches?  (fn [[route body]]
+                    (if (match-route route path) body))]
+    (some matches? resources)))


Updated compojure.html to use defvar

Updated compojure.html to use defvar

--- src/compojure/html.clj
+++ src/compojure/html.clj
@@ -17,8 +17,8 @@

 (ns compojure.html
   (:use (compojure str-utils)
-        (clojure.contrib seq-utils))
-  (:import (clojure.lang Sequential)))
+        (clojure.contrib def
+                         seq-utils)))

 (defn- optional-attrs
   "Adds an optional attribute map to the supplied function's arguments."
@@ -110,17 +110,15 @@
         (expand-seqs (ensure-attrs tree)))
       (str tree))))

-(def #^{:private true
-        :doc "A set of HTML tags that should be rendered as blocks"}
-  html-block-tags
+(defvar- html-block-tags
   #{:blockquote :body :div :dl :fieldset :form :head :html :ol
-    :p :pre :table :tbody :tfoot :thead :tr :script :select :ul})
+    :p :pre :table :tbody :tfoot :thead :tr :script :select :ul}
+  "A set of HTML tags that should be rendered as blocks")

-(def #^{:private true
-        :doc "HTML tags that should be rendered on their own line"}
-  html-line-tags
+(defvar- html-line-tags
   #{:br :dd :dt :h1 :h2 :h3 :h4 :h5 :h6 :hr :li :link
-    :option :td :textarea :title})
+    :option :td :textarea :title}
+  "HTML tags that should be rendered on their own line")

 (defn- parse-css-tag
   "Pulls the id and class attributes from a tag name formatted in a CSS style.
@@ -155,4 +153,3 @@
   (if (and (seq? trees) (seq? (first trees)))
     (apply html (first trees))
     (map-xml html-formatter trees)))
-


Make parent dirs better

Make parent dirs better

--- src/grimoire/api/fs.clj
+++ src/grimoire/api/fs.clj
@@ -31,10 +31,9 @@
                       (util/munge (:name thing))
                       (:name thing))
         h           (io/file p (str n e))]
-    (.mkdirs p)
+    (.mkdirs (.getParentFile h))
     (when (= :examples which)
-      (when-not (.isDirectory h)
-        (.mkdir h)))
+      (.mkdirs h))
     h))

 (defn thing->notes-handle


Formatting

Formatting

--- test/forma/hadoop/jobs/cdm_test.clj
+++ test/forma/hadoop/jobs/cdm_test.clj
@@ -19,5 +19,3 @@
    (forma->cdm ?src ?zoom ?tres ?tres-out ?start ?thresh) => (produces ?row))
  ?src ?zoom ?tres ?tres-out ?start ?thresh ?row
  [["500" 28 8 0 0 [1 49 90]]] 16 "16" "32" "2005-12-31" 50 [[51253 30938 16 71]])
-
-


Turn down peer settings.

Turn down peer settings.

--- test/onyx/peer/single_peer_test.clj
+++ test/onyx/peer/single_peer_test.clj
@@ -3,11 +3,11 @@
             [onyx.peer.hornetq-util :as hq-util]
             [onyx.api]))

-(def n-messages 150000)
+(def n-messages 150)

-(def batch-size 3000)
+(def batch-size 25)

-(def timeout 1000)
+(def timeout 500)

 (def in-queue (str (java.util.UUID/randomUUID)))


More WIP on layout explanation

More WIP on layout explanation

--- src/re_demo/layout.cljs
+++ src/re_demo/layout.cljs
@@ -3,19 +3,18 @@
             [re-demo.utils :refer [panel-title component-title paragraphs]]))

-(defn left-column
+(defn top-left-column
   []
   [v-box
    :children [[title :level :level2 :label "Components"]
               [paragraphs
-               [:p "Re-com comes with a flexible set of layout components. In general, these
-                components are not themselves visible."]
-               [:p "Instead, their purpose is to arrange other components."]
-               [title :level :level2 :label "Two Boxes"]
-               [:p "The two key components are " [:span.bold "h-box"] " and " [:span.bold "v-box"] ", which lay out
+               [:p "Re-com comes with a flexible set of layout components. These
+                components are not themselves visible - their job is to arrange other components."]
+               ;[title :level :level2 :label "Two Boxes"]
+               [:p "The key components are " [:span.bold "h-box"] " and " [:span.bold "v-box"] ", which arrange
                their children horizontally and vertically respectively."]
-               [:p "They are mutually composable, and can be arbitrarily nested to create complex arrangements."]
-               [:p "Here's example code showing them nesting..."]]
+               [:p "They are mutually nestable, and can be used to create complex layouts."]
+               [:p "Example code:"]]
                [:pre
                 {:style {:width "460px"}}
 "[v-box
@@ -26,8 +25,7 @@
                         [box :size \"100%\" :child \"Content\"]]
             [box :child \"Footer\"]]]"]
                [gap :size "15px"]
-               [:p "the result looks like this..."]
-               ;[gap :size "10px"]
+               [:p "results in:"]

                [v-box
                 :gap      "1px"
@@ -37,17 +35,20 @@
                             :height "100px"
                             :children [[box :size "70px" :style {:background-color "lightgrey"} :child "Nav"]
                                        [box :size "100%" :style {:background-color "lightgrey"} :child "Content"]]]
-                           [box :style {:background-color "lightgrey"} :child "Footer"]]]]])
+                           [box :style {:background-color "lightgrey"} :child "Footer"]]]
+              [gap :size "15px"]
+              [:p "Other pages will show you more of h-box and v-box, but first ..."]
+              ]])

-(defn right-column
+(defn top-right-column
   []
   [v-box
    :children [[title :level :level2 :label "Flexbox"]
               [paragraphs
                [:p
                 "Re-com's layout model is a thin layer over " [:span.bold "CSS Flexbox"] "."]
-               [:p "While Re-com's components work in their own right, to understand them fully and use them
-               powerfully, you " [:span.bold "will"] " need to have a strong understanding of Flexbox. Do these tutorials very soon:"]
+               [:p "To fully understand Re-com's layout components and use them
+               powerfully, you " [:span.bold "will"] " need to have a strong understanding of Flexbox. You should do these tutorials very soon:"]
                [:ul
                 [:li
                  [hyperlink-href
@@ -60,70 +61,66 @@
                   :href "http://www.sketchingwithcss.com/samplechapter/cheatsheet.html"
                   :target "_blank"]]]

-               [:p "Flexbox works via the interplay of " [:span.bold "container"] " (parent) styles and " [:span.bold "item"] " (child)
-               styles. In any interesting layout, intermediate DOM elements play the role of both container and item."]
-               [:p "But, if block-level elements (divs?) are inserted, they
+               [title :level :level2 :label "Be All In"]
+               [:p "Flexbox works via the interplay of styles present on a " [:span.bold "container"] " (parent) and its " [:span.bold "items"] " (children).
+               In any interesting layout, many DOM elements sit in a tree, acting as both a container for the level below, and an item for the level above."]
+               [:p "If block-level elements (divs?) are present in this tree, they
                can break the flex style interplay up and down the DOM hierarchy, and cause a variety of layout issues."]
                [:p [:span.bold "As a result, we have found Flexbox use to be quite viral."] " Once you start using it, you
-               have to use it everywhere - right up and down the DOM tree."]
+               end up using it everywhere - right up and down the DOM tree."]
                [:p "So, we recommend you go 100% all-in on using h-box and v-box. If you do, everything should \"just work\"."]
-               [:p [:span.bold "Never use a naked [:div]"] " or you may spend alot of time playing layout whack-a-mole (unless
-                you adroitly apply the correct flexbox styles to that :div, which is ardulous and error prone.)"]
+               [:p "So, never mint your own container " [:span.bold "[:div]"] " or "  [:span.bold "[:span]"] " unless
+               you also  give them the correct flex styles, which is arduous and error prone."]

-               ;[gap :size "10px"]
-               [title :level :level2 :label "Non-Flex Leaf"]
-               [:p "When we first put bootstrap buttons into re-com, they were streched.
-               It turned out their block display didn't play well with flex containers like h-box."]
-               [:p "So we created the " [:span.bold "[box ...]"] "  component which allows you to wrap
-               non-flex leaf widgets for use in flex containers."]
                ]]])

 (defn size-table
   []
-  (let [col1 "50px"
+  (let [col1 "75px"
         col2 "130px"
         col3 "500px"]
     [v-box
-     :children [[title :level :level2 :label ":size"]
+     :children [[title :level :level2 :label "The :size Parameter (aka flex)"]
                 [paragraphs
-                 [:p "v-box and h-box have a parameter called :size. This mirrors the flex sytle. In the Flexbox world, there are two parties in any layout - " [:span.bold "containers"] " and their child " [:span.bold "items"] "."]
-                 [:p "While the tutorials walk you through the menagerie of flexbox related styles, we've found that one style more than any other is
-                 critical to getting what you want: the " [:span.bold "flex"] " style of the children."]
-                 [:p "When we're having a bad day with layouts, 90% of the time it is because we didn't get the flex style of a child right."]]
+                 [:p "Both " [:span.bold "v-box"] " and " [:span.bold "h-box"] " have a parameter called " [:span.bold ":size"] ".
+                 This parameter is the equivalent of the style " [:span.bold "flex"] " talked about to the left."]]
+                [gap :size "10px"]
+                [:p "Possible values:"]
                 [v-box
                  :class "rc-div-table"
                  :align-self :start
                  :children [[h-box
                              :class "rc-div-table-header"
-                             :children [[label :width col1 :label "Value"]
-                                        [label :width col2 :label "Meaning"]
+                             :children [[label :width col1 :label ":size"]
+                                        [label :width col2 :label "G S B"]
                                         [label :width col3 :label "Description"]]]
                             [h-box
                              :class "rc-div-table-row"
                              :children [[label :width col1 :label "initial"]
                                         [label :width col2 :label "0 1 auto"]
-                                        [:span {:style {:width col3}} "Use item's width/height for dimensions (or content dimensions if w/h not specifed). Never grow. Shrink (to min-size) if necessary.
-                                                                       Good for creating boxes with fixed maximum size, but that can shrink to a fixed smaller size (min-width/height) if space becomes tight.
-                                                                       NOTE: When using initial, you should also set a width/height value (depending on flex-direction) to specify it's default size
-                                                                             and an optional min-width/height value to specify the size it can shrink to."]]]
+                                        [:span {:style {:width col3}} "Use the item's length. Never grow. Shrink if necessary.
+                                                                       Good for creating items with a natural maximum size, which can
+                                                                       shrink to some smaller size, typically given by min-width/height, if space becomes tight. "]]]
                             [h-box
                              :class "rc-div-table-row"
                              :children [[label :width col1 :label "auto"]
                                         [label :width col2 :label "1 1 auto"]
-                                        [:span {:style {:width col3}} "Use item's width/height for dimensions. Grow if necessary. Shrink (to min-size) if necessary.
-                                                                       Good for creating really flexible boxes that will gobble as much available space as they are allowed or shrink as much as they are forced to."]]]
+                                        [:span {:style {:width col3}} "Use the item's length. Grow if necessary. Shrink (to min-size) if necessary.
+                                                                       Good for creating items that happily take as much
+                                                                       space as they are allowed, or can shrink as much as they are forced to.
+                                                                       If necessary, use min-width/height to provide limits."]]]
                             [h-box
                              :class "rc-div-table-row"
                              :children [[label :width col1 :label "none"]
                                         [label :width col2 :label "0 0 auto"]
-                                        [:span {:style {:width col3}} "Use item's width/height for dimensions (or content dimensions if not specifed). Never grow. Never shrink.
-                                                                      Good for creating rigid boxes that stick to their width/height if specified, otherwise their content size."]]]
+                                        [:span {:style {:width col3}} "Use the item's length. Never grow. Never shrink.
+                                                                      Good for creating rigid items that stick to their width/height if specified, otherwise their content size."]]]
                             [h-box
                              :class "rc-div-table-row"
                              :children [[label :width col1 :label "100px"]
                                         [label :width col2 :label "0 0 100px"]
-                                        [:span {:style {:width col3}} "Non flexible 100px size (in the flex direction) box.
+                                        [:span {:style {:width col3}} "Item is given a fixed 100px (in the flex direction).
                                                                       Good for fixed headers/footers and side bars of an exact size."]]]
                             [h-box
                              :class "rc-div-table-row"
@@ -140,7 +137,7 @@
                              :class "rc-div-table-row"
                              :children [[label :width col1 :label "g s b"]
                                         [label :width col2 :label "grow shrink basis"]
-                                        [:span {:style {:width col3}} "If none of the above common valaues above meet your needs, this gives you precise control."]]]]]]]))
+                                        [:span {:style {:width col3}} "If none of the common values above meet your needs, this gives you precise control."]]]]]]]))

 (defn the-key-style
@@ -148,55 +145,51 @@
   [v-box
    :children [[title :level :level2 :label "The Key Style"]
               [paragraphs
-               [:p "In the Flexbox world, there are two parties in any layout - " [:span.bold "containers"] " and their child " [:span.bold "items"] "."]
-               [:p "While the tutorials walk you through the menagerie of flexbox related styles, we've found that one style more than any other is
-                 critical to getting what you want: the " [:span.bold "flex"] " style of the children."]
-               [:p "When we're having a bad day with layouts, 90% of the time it is because we didn't get the flex style of a child right."]]
-              [title :level :level2 :label "flex=??"]
+               [:p "Flexbox is about styles on " [:span.bold "containers"] " and their child " [:span.bold "items"] "."]
+               [:p "While tutorials will walk you through the menagerie of flexbox related styles,
+               we've found that one, more than any other, is
+               critical to getting what you want: the " [:span.bold "flex"] " style of the items."]
+               [:p "Worth repeating: if you are having trouble with a layout, pay particular attention to the
+               " [:span.bold "flex"] " style you have given to the items of that layout."]]
+              [title :level :level2 :label "flex=GSB"]
               [paragraphs
-               [:p "The tutorials tell you that the " [:span.bold "flex"] " style can be single values like " [:span.bold "none"] "  and " [:span.bold "auto"] ".
-                 But realise that every single time, flex resolves to a triple of sub-values:"]
+               [:p "Tutorials might tell you that the " [:span.bold "flex"] " style can be single value like " [:span.bold "none"] "  or " [:span.bold "auto"] ".
+                 But those are shortcuts. Every flex style resolves to a triple of sub-values:"]
                [:ul
-                [:li [:span [:span.bold "grow"]   " - Integer which determines how an item grows in size if there is extra container space to distribute. 0 for no growing."]]
-                [:li [:span [:span.bold "shrink"] " - Integer which determines how an item shrinks in size if container space is reduced. 0 for no shrinking."]]
-                [:li [:span [:span.bold "basis"]  " - The default size of an item before any necessary growing or shrinking. Can be
-                  values like 60% or 100px. It can also be " [:span.bold "auto"] " which means to use the natural size of the item (or its further children)"]]]
+                [:li [:span [:span.bold "grow"]   " - Integer which determines how an item grows in size (proportionally to its siblngs) if there is
+                extra container space to distribute. 0 for no growing."]]
+                [:li [:span [:span.bold "shrink"] " - Integer which determines how an item shrinks in size (proportionally to its siblngs) if container
+                space is reduced. 0 for no shrinking."]]
+                [:li [:span [:span.bold "basis"]  " - The default size of an item before any necessary growing or
+                shrinking. Can be
+                  values like 60% or 100px. It can also be " [:span.bold "auto"] " which means to use the natural size
+                  of the item (or its further children)"]]]

-               [:p "So even if you provide a single value like " [:span.bold "flex=\"none\""]  ",
-                 what you are really providing is " [:span.bold "flex=\"0 0 auto\""] ". It always resolves to a triple. If you get this point, you are half way there."]
+               [:p "When you provide a shortcut value like " [:span.bold "flex=\"none\""]  ",
+                 what you are really providing is " [:span.bold "flex=\"0 0 auto\""] "."]

-               [:p "Confusion reigns a bit because you can do this " [:span.bold "flex=\"auto\""]  ",
-                 which resolves to " [:span.bold "flex=\"1 1 auto\""] ".  Eh?  My \"auto\" begates another \"auto\". Breeding like rabits."]
-               [:p "Determines the value for the 'flex' attribute (which has grow, shrink and basis), based on the :size parameter."]
-               [:p.bold "IMPORTANT: The term 'size' means width of the item in the case of flex-direction 'row' OR height of the item in the case of flex-direction 'column'."]
-               [:p "Flex property explanation:"]
-               ]
-              [:p "Supported values:"]
-
-              [gap :size "20px"]
-              [paragraphs
-               [:p "If number of words is not 1 or 3, an exception is thrown."]
-               [:p "Reference: http://www.w3.org/TR/css3-flexbox/#flexibility"]
-               [:p "Diagram:   http://www.w3.org/TR/css3-flexbox/#flex-container"]
-                 [:p "Regex101 testing: ^(initial|auto|none)|(\\d+)(px|%|em)|(\\d+)\\w(\\d+)\\w(.*) - remove double backslashes"]]]])
-
-
+               [:p "And, " [:span.bold "flex=\"auto\""]  ",
+                 resolves to " [:span.bold "flex=\"1 1 auto\""] ", which includes \"auto\" for the \"basis\"."]
+               [:p "In re-com, v-box and h-box components will be items (children of a higher v-box or h-box container).
+               When organising a layout, always pay attention to " [:span.bold "flex"] " style of these children."]]
+              [gap :size "10px"]]])

 (defn panel2
   []
   [v-box
-   :gap      "10px"
+   :style   {:font-size "15px"}
    :children [[panel-title "Layout"]
+              [gap :size "10px"]
               [h-box
                :gap      "100px"
-               :children [[left-column]
-                          [right-column]]]
+               :children [[top-left-column]
+                          [top-right-column]]]
               [line]
+              [gap :size "15px"]
               [h-box
                :gap      "100px"
                :children [[the-key-style]
-                          [size-table]]]
-              ]])
+                          [size-table]]]]])

 ;; core holds a reference to panel, so need one level of indirection to get figwheel updates
 (defn panel


still need to make array of arrays

still need to make array of arrays

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -221,6 +221,11 @@
                    (swap! result conj val)))
     @result))

+(defn array-to-arrays [src w acc]
+  (let [[h t] (split-at w src)]
+    (if (empty? t) h (array-to-arrays t w (assoc acc (count acc) h)))
+  ))
+
 (defn black-and-white [context canvas]
   (let [pixels (get-pixels context canvas)
         greyscale (fn[r g b alpha]
@@ -230,7 +235,7 @@
              (if (nil? a)
               result
               (recur rest-pixels (conj result (greyscale r g b a)))))]
-    (f pixels [])))
+    (array-to-arrays (f pixels []) (.-width canvas) [])))

 (defn on-image-load [event]
@@ -241,7 +246,8 @@
     (set! (.-height canvas) (.-height image))
     (.drawImage context image 0 0)
     (let [pixels (black-and-white context canvas)]
-      (print pixels))
+      (print pixels)
+      (print (alength pixels)))
     )
   )


resize of large images removed for now

resize of large images removed for now

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -280,20 +280,20 @@

 (defonce max-image-dimension 224)

+  ;w (.-width image)
+  ;h (.-height image)
+  ;ratio (if (> w max-image-dimension) (/ w max-image-dimension) 1)
+  ;new-w (/ w ratio)
+  ;new-h (* (/ h w) new-w)
+
 (defn on-image-load [event]
   (let [image (.-target event)
         canvas (dom/getElement "viewport")
         context (.getContext canvas "2d")
-        w (.-width image)
-        h (.-height image)
-        ratio (if (> w max-image-dimension) (/ w max-image-dimension) 1)
-        new-w (/ w ratio)
-        new-h (* (/ h w) new-w)]
-    (set! (.-width canvas) new-w)
-    (set! (.-height canvas) new-h)
-    (print (str "new width: " new-w ", was: " w))
-    (print (str "new height: " new-h ", was: " h))
-    (.drawImage context image 0 0 w h 0 0 new-w new-h)
+        ]
+    (set! (.-width canvas) (.-width image))
+    (set! (.-height canvas) (.-height image))
+    (.drawImage context image 0 0)
     (let [pixels (rescale-width (black-and-white context canvas))]
       (comment print pixels)
       (comment display-image-array pixels)


CMR-2631: Fixed indentation.

CMR-2631: Fixed indentation.

--- indexer-app/src/cmr/indexer/data/concepts/tag.clj
+++ indexer-app/src/cmr/indexer/data/concepts/tag.clj
@@ -7,8 +7,7 @@
 (defmethod es/parsed-concept->elastic-doc :tag
   [context concept parsed-concept]
   (let [{:keys [concept-id deleted]} concept
-        {:keys [tag-key description originator-id]}
-        parsed-concept]
+        {:keys [tag-key description originator-id]} parsed-concept]
     (if deleted
       ;; This is only called by re-indexing (bulk indexing)
       ;; Regular deleted tags would have gone through the index-service/delete-concept path.


Revert "When using websocket, make sure activity notifications are sent immediately"

This reverts commit 8c82c0379a58fa07118d6d4ae28940d8bc6d1c97.

--- web-app/src/cljs/potato/eventsource2.cljs
+++ web-app/src/cljs/potato/eventsource2.cljs
@@ -12,8 +12,7 @@
 (defonce active-config (atom {:callback-fn #()
                               :error-fn #()
                               :error-p false
-                              :is-active true
-                              :active-updated-fn #()}))
+                              :is-active true}))

 (defonce current-index (atom 0))

@@ -42,9 +41,7 @@
       ((:error-fn @active-config) error-p))))

 (defn set-is-active [active-p]
-  (swap! active-config #(conj % {:is-active active-p}))
-  (let [updated (:active-updated-fn @active-config)]
-    (updated)))
+  (swap! active-config #(conj % {:is-active active-p})))

 ;;; sec:poll

@@ -119,7 +116,6 @@
   (let [req (make-xhr-io-req)]
     (notify-fail false)
     (swap! poll-config #(conj % {:channel cid :event event}))
-    (swap! active-config #(conj % {:active-updated-fn (fn [_] nil)}))
     (run-polling-request-loop req)))

 ;;; sec:ws
@@ -157,12 +153,6 @@
                                           :last-refresh-send-time now
                                           :timer timer
                                           :next-ping-timer next-ping-timer}))))))
-
-(defn websocket-active-updated [ws]
-  (let [timer (:next-ping-timer @websocket-config)]
-    (when timer
-      (.clearTimeout js/window timer)))
-  (start-websocket-ping ws))

 (defn handle-websocket-message [ws msg]
   (case (:type msg)
@@ -215,8 +205,7 @@
                               (conj config {:refresh-reply-received false
                                             :channel cid
                                             :event initial-event
-                                            :connection ws})))
-    (swap! active-config #(conj % {:active-updated-fn (fn [] (websocket-active-updated ws))}))))
+                                            :connection ws})))))

 (defn set-callback-fn! [callback-fn]
   (swap! active-config #(conj % {:callback-fn callback-fn})))


fixed bad pairing parenthesis

fixed bad pairing parenthesis

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -722,7 +722,7 @@
   event arriving. Inserted events have current time. Stops inserting when
   expired. Uses local times."
   ([interval update & children]
-   (apply fill-in-last* interval (fn [e] (merge e update))) children))
+   (apply fill-in-last* interval (fn [e] (merge e update)) children)))

 (defn interpolate-constant
   "Emits a constant stream of events every interval seconds, starting when an


Expand streams/project documentation

Expand streams/project documentation

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -1951,9 +1951,15 @@

   (project [(service \"enqueues\")
             (service \"dequeues\")]
-    (fn [[enq deq]]
-      (prn (/ (:metric enq)
-              (:metric deq)))))"
+    (smap folds/quotient
+      (with :service \"enqueues per dequeue\"
+        ...)))
+
+  Here we've combined separate events--enqueues and dequeues--into a single
+  event, using the folds/quotient function, which divides the first event's
+  metric by the second. Then we assigned a new service name to that resulting
+  event, and could subsequently filter based on the metric, assign different
+  states, graph, alert, etc."
   [basis & children]
   (let [wrapped (mapv (fn [expr] `(where ~expr)) basis)]
     `(project* ~wrapped ~@children)))


basic spectrogram

basic spectrogram

--- src/main/clojure/mikera/spectral/core.clj
+++ src/main/clojure/mikera/spectral/core.clj
@@ -1,6 +1,10 @@
 (ns mikera.spectral.core
   (:use [overtone core])
-  (:require [clojure.core.matrix :as mat]))
+  (:require [clojure.core.matrix :as mat])
+  (:require [mikera.image.core :as img])
+  (:require [mikera.image.colours :as col])
+  (:import [mikera.matrixx Matrix AMatrix])
+  (:import [java.awt.image BufferedImage]))

 (defonce boot (boot-external-server))

@@ -9,6 +13,8 @@
 (defonce buf (buffer 44100)) ;; create a buffer to store the audio

 (def snare (sample (freesound-path 26903)))
+
+(def snare-buf (load-sample (freesound-path 26903)))

   ;; ============================================
   ;; buffer fun
@@ -24,4 +30,44 @@
   (Thread/sleep 1000)
   (stop))

-(take 10 (buffer-read buf))+(def arr (into-array Double/TYPE (buffer-read snare-buf)))
+
+(defn mag
+  (^double [^double a ^double b]
+    (Math/sqrt (+ (* a a) (* b b)))))
+
+(defn fft-matrix [^doubles arr]
+  (let [n (count arr)
+        length 1024
+        half-length (quot length 2)
+        fft (mikera.matrixx.algo.FFT. (int length))
+        tarr (double-array (* 2 length))
+        stride 50
+        ts (quot (- n length) stride)
+        result-array (double-array (* half-length ts))]
+    (dotimes [i ts]
+      (System/arraycopy arr (* i stride) tarr 0 length)
+      (.realForward fft tarr)
+      (dotimes [j half-length]
+        (aset result-array (+ i (* j ts))
+              (mag (aget tarr (* j 2)) (aget tarr (inc (* j 2)))))))
+    (Matrix/wrap half-length ts result-array)))
+
+(defn colour ^long [^double v]
+  (let [v (* (+ 1.0 (Math/log v)) 0.25)] (col/rgb v 0.0 v)))
+
+(defn render
+  "Renders a spectrogram matrix into a bufferedimage"
+  ([M]
+    (render M (img/new-image (mat/column-count M) (mat/row-count M) )))
+  ([^AMatrix M ^BufferedImage bi]
+    (let [w (.getWidth bi)
+          h (.getHeight bi)]
+      (dotimes [x w]
+        (dotimes [y h]
+          (.setRGB bi (int x) (- (dec h) (int y)) (unchecked-int (colour (.get M (int y) (int x)) ))))))
+    bi))
+
+(def M (fft-matrix arr))
+
+(img/show (render M))


fix accidentally always enabling :rename-prefix-namespace

should only be enabled when using multiple modules and is
not required for single module compiles.

--- src/main/shadow/build/targets/browser.clj
+++ src/main/shadow/build/targets/browser.clj
@@ -285,7 +285,9 @@
         (assoc ::build/config config) ;; so the merged defaults don't get lost
         (assoc-in [:compiler-options :output-wrapper] output-wrapper?)
         (cond->
+          ;; only turn this on with 2+ modules, not required for single file
           (and output-wrapper?
+               (not= 1 (count modules))
                (not (seq (get-in state [:compiler-options :rename-prefix-namespace]))))
           (assoc-in [:compiler-options :rename-prefix-namespace] "$APP")


catch no such file

catch no such file

--- src/latte_compiler/core.clj
+++ src/latte_compiler/core.clj
@@ -8,13 +8,20 @@
     [latte-compiler.compilation :as compilation]
     )
   (:gen-class)
-  )
+  (:import (java.io FileNotFoundException)))
+
+(defn- read-file
+  [filepath]
+  (try
+    (util/succ (slurp filepath))
+    (catch FileNotFoundException _ (util/err (str "file " filepath " not found")))
+    ))

 (defn- run
   [filepath]

   (m/domonad util/phase-m
-    [code (m-result (slurp filepath))
+    [code (read-file filepath)
      tree (grammar/parse code)
      aug-tree (analysis/analize tree)
      ]
@@ -33,4 +40,3 @@
                  (System/exit 1)
                  ))
   )
-


CMR-3639: Addressed review comments

CMR-3639: Addressed review comments

--- bootstrap-app/src/cmr/bootstrap/services/replication.clj
+++ bootstrap-app/src/cmr/bootstrap/services/replication.clj
@@ -91,10 +91,11 @@
   {:default #{} :type :edn})

 (defn fix-null-replicated-concepts-query-str
-  "Query to fix the NULL replicated concepts. Needs 4 parameters - replicated destination table,
-  source table, database link, revision date time."
+  "Query to fix the NULL replicated concepts. Takes the table name and revision date-time string."
   [table revision-datetime]
-  (format "update %s c1 set metadata = (select c2.metadata from %s@%s c2 where c2.id = c1.id) where c1.metadata is null and c1.deleted = 0 and c1.revision_date > to_timestamp ('%s', 'YYYY-MM-DD HH24:MI:SS.FF')"
+  (format (str "update %s c1 set metadata = (select c2.metadata from %s@%s c2 where c2.id = c1.id) "
+               "where c1.metadata is null and c1.deleted = 0 and c1.revision_date > to_timestamp "
+               "('%s', 'YYYY-MM-DD HH24:MI:SS.FF')")
           table
           table
           (source-database-link)
@@ -110,7 +111,8 @@
             stmt (fix-null-replicated-concepts-query-str table revision-datetime)]
         (debug "Fixing replicated BLOBs for:" table "starting with statement:" stmt)
         (j/db-do-commands db stmt)
-        (debug "Fixing replicated BLOBs for:" table "with revision-datetime" revision-datetime "took" (- (System/currentTimeMillis) curr-time)) "ms"))))
+        (debug "Fixing replicated BLOBs for:" table "with revision-datetime" revision-datetime
+               "took" (- (System/currentTimeMillis) curr-time)) "ms"))))

 (defn index-replicated-concepts
   "Indexes recently replicated concepts."


tweak :clj tests to make them pass

tweak :clj tests to make them pass

--- src/test/compassus/tests.cljc
+++ src/test/compassus/tests.cljc
@@ -6,8 +6,8 @@
                        [cljs.core.async :refer [<! close! chan take!]]]
                 :clj  [[clojure.test :refer [deftest testing is are use-fixtures]]
                        [clojure.core.async :refer [go <! close! chan <!!]]
-                       [cellophane.next :as om :refer [defui]]])
-            [om.next.protocols :as p]
+                       [cellophane.next :as om :refer [defui]]
+                       [cellophane.protocols :as p]])
             [compassus.core :as c]))

 (def test-utils #?(:cljs js/React.addons.TestUtils))
@@ -682,18 +682,20 @@
                                               {:foo {:bar 42 :baz 43}}))
                                :parser (om/parser {:read mixins-read})}})
           r (c/get-reconciler app)
-          p (-> r :config :parser)]
+          p (-> r :config :parser)
+          root (c/root-class app)]
       (is (= (om/params (c/root-class app))
              {:foo [:bar :baz]}))
-      (is (= (om/query (c/root-class app))
+      (is (= #?(:clj  ((-> root meta :query) root)
+                :cljs (om/query root))
              [::c/route
               {::c/route-data {:index [:home/title :home/content]}}
               {::c/mixin-data [{:foo '?foo}]}]))
-      (is (= (om/get-query (c/root-class app))
+      (is (= (om/get-query root)
              [::c/route
               {::c/route-data {:index [:home/title :home/content]}}
               {::c/mixin-data [{:foo [:bar :baz]}]}]))
-      (is (= (p (#'om/to-env r) (om/get-query (c/root-class app)))
+      (is (= (p (#'om/to-env r) (om/get-query root))
              {::c/route :index
               ::c/route-data (select-keys init-state (om/get-query Home))
               ::c/mixin-data (select-keys @r [:foo])})))))


format surface string

format surface string

--- src/babel/html.clj
+++ src/babel/html.clj
@@ -326,8 +326,6 @@
       (map? arg)

       (not (= :subcat (last path)))
-      (not (= :english (last path)))
-      (not (= :italiano (last path)))

       ;; display :extends properly (i.e. not a tree).
       ;; :extends will have features :a,:b,:c,..
@@ -429,46 +427,42 @@
        ""
        (map
         (fn [tr]
-          (str
-           "<tr"
-           (cond
-            ;; TODO: more general method to allow passage of css info from other parts of code:
-            (= (first tr) :paths)
-            " style='white-space:nowrap;'"
-            ;; use a custom CSS class for :comment.
-            (= (first tr) :comment)
-            " class='comment'"
-            ;; use a custom CSS class for :header (i.e. hide it with display:none)
-            (= (first tr) :header)
-            " class='hide' style='display:none'"
-            ;; ..handle other keywords that need a custom CSS class..
-            ;; default: no custom CSS class.
-            true "")
-           ">"
-           "   "
-           (str (first tr))
-           "   	"
-           (if (= (type (second tr)) clojure.lang.Ref)
-             (str
-              ""
-              "
"
-              (fs/path-to-ref-index serialized (concat path (list (first tr))) 0)
-              "
"
-              "	"
-              ""
-              )
-             " ")
-           (cond (= (first tr) :surface)
-                 "FOO"
-                 true
-                 (tablize (second tr)
-                          ;; set 'path' param for recursive call to tablize.
-                          ;; Path' = Path . current_feature
-                          (concat path (list (first tr)))
-                          serialized
-                          {:as-tree false}))
-           "   	"
-           "
"))
+          (let [feature (first tr)]
+            (str
+             "<tr"
+             (cond
+              ;; TODO: more general method to allow passage of css info from other parts of code:
+              (= (first tr) :paths)
+              " style='white-space:nowrap;'"
+              ;; use a custom CSS class for :comment.
+              (= (first tr) :comment)
+              " class='comment'"
+              ;; use a custom CSS class for :header (i.e. hide it with display:none)
+              (= (first tr) :header)
+              " class='hide' style='display:none'"
+              ;; ..handle other keywords that need a custom CSS class..
+              ;; default: no custom CSS class.
+              true "")
+             ">"
+             "" feature "	"
+             (if (= (type (second tr)) clojure.lang.Ref)
+               (str
+                ""
+                "
"
+                (fs/path-to-ref-index serialized (concat path (list (first tr))) 0)
+                "
"
+                "	"
+                ""
+                )
+               " ")
+             (tablize (second tr)
+                      ;; set 'path' param for recursive call to tablize.
+                      ;; Path' = Path . current_feature
+                      (concat path (list (first tr)))
+                      serialized
+                      {:as-tree false})
+             "   	"
+             "
")))
         ;; sorts the argument list in _arg__ by key name and remove uninteresting key-value pairs.
         (remove #(or (contains? hide-these-features
                                 (first %))
@@ -523,6 +517,10 @@
       "}")
      (= nil arg)
      (str "
nil
")
+
+     (= (last path) :rule)
+     (str "" arg "")
+
      (= (type arg)
         java.lang.String)
      (str "" arg "")


Use medium-datetime instead of full-datetime for the api token table

--- frontend/components/account.cljs
+++ frontend/components/account.cljs
@@ -166,7 +166,7 @@
                         [:tr
                          [:td {:data-bind "text: label"} (:label token)]
                          [:td [:span.code {:data-bind "text: token"} (:token token)]]
-                         [:td {:data-bind "text: time"} (datetime/full-datetime (js/Date.parse (:time token)))]
+                         [:td {:data-bind "text: time"} (datetime/medium-datetime (js/Date.parse (:time token)))]
                          [:td
                           [:span
                            {:data-bind "click: $root.current_user().delete_token"}


파일 읽기 부분 코드 정리.

파일 읽기 부분 코드 정리.

--- src/tweetbook/routes/home.clj
+++ src/tweetbook/routes/home.clj
@@ -1,15 +1,14 @@
 (ns tweetbook.routes.home
   (:require [compojure.core :refer :all]
-            [liberator.core :refer [defresource resource request-method-in]]
+            [liberator.core :refer [defresource resource]]
             [cheshire.core :refer [generate-string]]
-            [noir.io :as io]
             [noir.session :as session]
-            [clojure.java.io :refer [file]]
+            [clojure.java.io :as io]
             [tweetbook.models.config :as config]
             [tweetbook.models.tweet :refer [tweet]]
             [tweetbook.models.db :as db]))

-(def page-file (file "src/tweetbook/routes/tweet.html"))
+(def page-file (io/file (io/resource "tweetbook/routes/tweet.html")))

 (defn keywordify [m] (into {} (for [[k v] m] [(keyword k) v])))

@@ -22,7 +21,7 @@
   :exists? (fn [_] [(.getAbsolutePath page-file) {::file page-file}])
   :last-modified (fn [_] (.lastModified page-file))
   :authorized? (fn [_] (= (session/get :id) (config/user :id)))
-  :handle-ok (fn [_] (clojure.java.io/input-stream page-file))
+  :handle-ok (fn [_] (io/input-stream page-file))
   :handle-unauthorized redirect-to-login-page)

 (defresource add-message


Fix payoff calculation

Fix payoff calculation

--- src/baustellen.clj
+++ src/baustellen.clj
@@ -65,8 +65,26 @@
                     bundles))
              site-alloc))))

+(defn demand
+  "Return the demand for skill of the site with site-k given an allocation."
+  [allocation [site-k skill :as path] static-data]
+  {:post [(>= % 0)]}
+  (let [bundles (get-in allocation path)
+        n-allocated (apply + (vals bundles))
+        initial-capacity (get-in static-data [:sites site-k :skills skill])]
+    (- initial-capacity n-allocated)))
+
+(defn demand-met? [[site-k site-alloc] static-data]
+  (zero? (apply + (map #(demand {site-k site-alloc} [site-k %] static-data)
+                       (keys site-alloc)))))
+
+(defn indiv-alloc-brutto-payoff [[site-k site-alloc :as alloc] static-data]
+  (if (demand-met? alloc static-data)
+    (get-in static-data [:sites site-k :payoff])
+    0))
+
 (defn netto-payoff [allocation static-data]
-  (- (apply + (map #(get-in static-data [:sites % :payoff]) (keys allocation)))
+  (- (apply + (map #(indiv-alloc-brutto-payoff % static-data) allocation))
      (apply + (map #(indiv-alloc-cost % static-data) allocation))))

 ;;; Credits: http://stackoverflow.com/a/2763660
@@ -84,15 +102,6 @@
                                 (get-in static-data [:agents % :location]))
                              (keys non-exhausted))]
     (take n by-distance)))
-
-(defn demand
-  "Return the demand for skill of the site with site-k given an allocation."
-  [allocation [site-k skill :as path] static-data]
-  {:post [(>= % 0)]}
-  (let [bundles (get-in allocation path)
-        n-allocated (apply + (vals bundles))
-        initial-capacity (get-in static-data [:sites site-k :skills skill])]
-    (- initial-capacity n-allocated)))

 (defn allocate-max-bundle
   [{:keys [allocation reservoir]} [site-k skill :as path] agent-k static-data]


Add some commented code.

Add some commented code.

--- src/uxbox/data/workspace.cljs
+++ src/uxbox/data/workspace.cljs
@@ -244,6 +244,9 @@
       (-apply-update [_ state]
         (let [shape (get-in state [:shapes-by-id id])
               shapes (map #(get-in state [:shapes-by-id %]) (:items shape))
+              ;; shapes (->> (:items shape)
+              ;;             (map #(get-in state [:shapes-by-id %]))
+              ;;             (map (fn [v] (merge v (sh/container-rect v)))))
               x (apply min (map :x shapes))
               y (apply min (map :y shapes))
               shapes (map #(sh/translate-coords % x y) shapes)]
@@ -321,6 +324,7 @@
     (-apply-watch [_ state]
       (let [selected (get-in state [:workspace :selected])
             mevent (rs/swap-state #(assoc-in state [:workspace :selected] #{}))]
+        ;; (rx/just mevent)))))
         (->> (map #(get-in state [:shapes-by-id %]) selected)
              (rx/from-coll)
              (rx/filter :group)


Remove all db queries except ragam search.

--- src/kosha/db/search.clj
+++ src/kosha/db/search.clj
@@ -2,102 +2,18 @@
   (:require [clojure.java.jdbc :as j]
             [clojure.set :as set]
             [kosha.db.pool :as db-pool]
-            [kosha.db :as db]
             [pg-hstore.core :as hs]
             [medley.core :as m]))

 (defn ->hyphens [^String x]
   (keyword (.replace x \_ \-)))

-(defn read-ragam [ragam]
-  (-> ragam
-      (update :s-ragams db/read-array)
-      (update :k-ragams db/read-array)))
-
-(defn read-kriti [kriti]
-  (-> kriti
-      (update :lyrics hs/from-hstore)
-      (update-in [:lyrics :content] hs/from-hstore)))
-
-(defn renditions-in-ragam [ragam]
-  (let [q ["SELECT * FROM sangeethapriya_renditions sr
-            INNER JOIN sangeethapriya_tracks st
-            ON sr.concert_id = st.concert_id
-            AND sr.track = st.track_number
-            WHERE ragam = ?;"
-           ragam]]
-    (j/query db-pool/conn q
-             :identifiers ->hyphens)))
-
-(defn renditions [kriti]
-  (let [q ["SELECT * FROM (
-              SELECT *,
-                (10 * similarity (kriti, ?)) +
-                (10 - levenshtein (kriti, ?)) +
-                (10 * (difference (kriti, ?) /4 )) AS similarity_score
-              FROM sangeethapriya_renditions
-              ORDER BY similarity_score DESC
-              LIMIT 50) AS sr
-            INNER JOIN sangeethapriya_tracks st
-            ON sr.concert_id = st.concert_id
-            AND sr.track = st.track_number; "
-           kriti kriti kriti]]
-    (j/query db-pool/conn q :identifiers ->hyphens)))
-
-(defn kriti-details [kriti]
-  (let [q ["SELECT *,
-                (10 * similarity (kriti, ?)) +
-                (10 - levenshtein (kriti, ?)) +
-                (10 * (difference (kriti, ?) /4 )) AS similarity_score
-              FROM karnatik_data
-              ORDER BY similarity_score DESC
-              LIMIT 50;"
-           kriti kriti kriti]]
-    (->> (j/query db-pool/conn q :identifiers ->hyphens)
-         (map read-kriti))))
-
-(defn kritis [kriti]
-  (let [q ["SELECT distinct on (sang_kriti, similarity_score) sang_kriti, *,
-               (10 * similarity (sang_kriti, ?)) +
-               (10 - levenshtein (sang_kriti, ?)) +
-               (10 * (difference (sang_kriti, ?) /4 )) AS similarity_score
-            FROM adhoc_kritis
-            ORDER BY similarity_score DESC
-            LIMIT 50;"
-           kriti kriti kriti]]
-    (j/query db-pool/conn q :identifiers ->hyphens)))
-
-(defn ragam-metadata [ragam-name]
-  (let [q ["SELECT * FROM wikipedia_ragas WHERE raga_name = ?"
-           ragam-name]]
-    (->> (j/query db-pool/conn q :identifiers ->hyphens)
-         first)))
-
-(defn scales [rows]
-  (->> rows
-       (group-by :ragam-name)
-       (m/map-vals (fn [rs] (map #(select-keys % [:arohanam :avarohanam]) rs)))))
-
-(defn ragams [ragam n]
-  (let [q1 ["SELECT * FROM std_ragams
-             WHERE str_compare(?, ragam_name)
-             OR str_compare_ar(?, s_ragams::varchar[])
-             OR str_compare_ar(?, k_ragams::varchar[]);"
-            ragam ragam, ragam]
-        q2 ["SELECT *, similarity_score(ragam_name, ?) AS score
-             FROM std_ragams
+(defn ragams
+  "Retrieves n ragams from the db in order of similarity to the query."
+  [ragam n]
+  (let [q  ["SELECT *, similarity_score(name, ?) AS score
+             FROM tmp_ragams
              ORDER BY score
              DESC LIMIT ?; "
             ragam n]]
-    (->> (j/query db-pool/conn q1 :identifiers ->hyphens)
-         (concat (j/query db-pool/conn q2 :identifiers ->hyphens))
-         (map read-ragam)
-         (m/distinct-by (juxt :ragam-name :arohanam :avarohanam)))))
-
-(defn ragams-with-scales [ragam n]
-  (let [result-ragams (ragams ragam n)
-        ragam-scales (scales result-ragams)]
-    (for [r (m/distinct-by :ragam-name result-ragams)]
-      (assoc r
-             :scales (get ragam-scales (:ragam-name r))
-             :metadata (ragam-metadata (:ragam-name r))))))
+    (vec (j/query db-pool/conn q :identifiers ->hyphens))))


Fix setting options

Fix setting options

--- src/adzerk/boot_reload.clj
+++ src/adzerk/boot_reload.clj
@@ -107,7 +107,7 @@
     (fn [next-task]
       (fn [fileset]
         (pod/with-call-in @pod
-          (adzerk.boot-reload.server/set-options {:open-file open-file}))
+          (adzerk.boot-reload.server/set-options {:open-file ~open-file}))
         (doseq [f (relevant-cljs-edn @prev-pre fileset ids)]
           (let [path     (tmp-path f)
                 in-file  (tmp-file f)


Add better docs for `some-fn` and `every-pred`

--- src/such/better_doc.clj
+++ src/such/better_doc.clj
@@ -1,10 +1,11 @@
 (ns such.better-doc
   "Requiring this file will replace some `clojure.core` docstrings with
-   better versions."
+   better versions.
+
+   I'd be ecstatic if documentation like this, or derived from this, were
+   included in clojure.core. Note that the Unlicense allows anyone to do that."
   (:require [such.vars :as vars]))

-;;; I'd be ecstatic if documentation like this, or derived from this, were
-;;; included in clojure.core. Note that the Unlicense allows anyone to do that.

 ;; Interning copies in this namespace allows codox to find them.
 (defmacro ^:private local-copy [var doc-string]
@@ -110,3 +111,47 @@
    If you are working on a vector and want the result to be a vector, use `pop`.")

+(local-copy #'clojure.core/every-pred
+   "Take N predicates and produce a single predicate - call it `result`. `result`
+    will return `true` iff each of the original predicates returns a truthy
+    value. The predicates are evaluated in order, and the first one that produces
+    a falsey value stops any further checking.
+
+    See also `some-fn`.
+
+         ( (every-pred integer? even? pos?) \"hi\") => false
+         ( (every-pred integer? even? pos?) 4) => true
+")
+
+
+(local-copy #'clojure.core/every-pred
+   "Take N functions and produce a single predicate - call it `result`. `result`
+    will return `true` iff each of the original functions returns a truthy
+    value. `result` evaluates the functions in order, and the first one that produces
+    a falsey value stops any further checking. In that case, `false` is returned.
+
+    See also `some-fn`.
+
+         ( (every-pred integer? even? pos?) \"hi\") => false
+         ( (every-pred integer? even? pos?) 4) => true
+")
+
+
+(local-copy #'clojure.core/some-fn
+   "Take N functions and produce a single function - call it `result`. `result`
+    evaluates the N functions in order. When one returns a truthy result, `result`
+    skips the remaining functions and returns that result. If none of the functions
+    returns a truthy value, `result` returns a falsey value.
+
+    This function is called `some-fn` because it does not produce a pure (true/false)
+    result. See also `every-pred`.
+
+         ( (some-fn even? pos?) 3) => true
+         ( (some-fn even? pos?) -3) => false
+
+         ( (some-fn second first) [1 2 3]) => 2
+         ( (some-fn second first) [1]) => 1
+         ( (some-fn second first) []) => nil
+")
+
+


debugging

debugging

--- src/syncserver/core.clj
+++ src/syncserver/core.clj
@@ -50,6 +50,7 @@

 (defn- immutable [b]
+  (debug "called immutable on" b)
   (cond
    (or (instance? java.util.Map b)
        (map? b)) (into {} b)
@@ -59,6 +60,7 @@
    :otherwise b))

 (defn transform [[p e]]
+  (debug "transforming" e "@" p)
   (let [t (type e)]
     (fn [s]
       (cond


fixed next-sound bug

fixed next-sound bug

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -90,8 +90,9 @@
   (.emit socket "track-complete"))

 (defn play-track [track-id]
-  (println "TRACK ID! " track-id)
-  (println (:music-files @app-state))
+  (if-not (nil? (:current-sound @app-state))
+    (.destruct (:current-sound @app-state)))
+
   (let [reader (new js/FileReader)
         song-blob (get (:music-files @app-state) track-id)]
     (.readAsDataURL reader song-blob)


add stuff to lab

add stuff to lab

--- src/babel/italiano/lab.clj
+++ src/babel/italiano/lab.clj
@@ -9,3 +9,16 @@
                                                (catch Exception e (log/error (str "failed to generate."))))]
                  (if result
                    (println (fo result))))))
+
+(defn sleep []
+  (repeatedly #(println (fo (generate {:synsem {:cat :verb
+                                                             :essere false
+                                                :sem {:pred :sleep
+                                                      :tense :conditional}}}
+                                      :truncate false
+                                      :model medium)))))
+
+(defn nps []
+  (repeatedly #(println (fo (generate {:synsem {:cat :noun}}
+                                      :truncate false
+                                      :model medium)))))


Update sat4j-solve after changing generate-dimacs-clauses

--- src/logic/sat-solve.clj
+++ src/logic/sat-solve.clj
@@ -17,14 +17,11 @@
     (.setExpectedNumberOfClauses solver NBCLAUSES)

     (doall (map
-             #(.addClause solver (VecInt. (int-array (subvec % 0 (dec (count %))))))
+             #(.addClause solver (VecInt. (int-array %)))
              clauses))

-    (if (.isSatisfiable solver)
-      (do
-        (println "Satisfiable!")
-        (.decode reader (.model solver)))
-      (println "Unsatisfiable!"))))
+    (when (.isSatisfiable solver)
+      (.decode reader (.model solver)))))

 (defn sat-solve
   "Returns one result as vector. The vector is epmty if the formula is unsatisfiable."


Get rid of ugly hex print hack and use .getPublicKeyAsHex of ECKey

--- src/bitcoin/miniwallet.clj
+++ src/bitcoin/miniwallet.clj
@@ -7,9 +7,6 @@

 (defn private-to-address [k]
   (.toString (Address. (NetworkParameters/prodNet) (.getPubKeyHash k))))
-
-(defn private-to-pubkey-string [k]
-  (format (if (.isCompressed k) "%066x" "%0130x") (java.math.BigInteger. (.getPubKey k))))

 (defn gen-uncompressed-key []
   ;; hack to get the key uncompressed, because bitcoinj makes it compressed by default.
@@ -34,10 +31,10 @@
 (defn gen-miniwallet []
   (let [key-str (gen-minikey)
         key (minikey-to-private key-str)]
-    (println key-str (private-to-pubkey-string key) (private-to-address key))))
+    (println key-str (.getPublicKeyAsHex key) (private-to-address key))))

 (defn gen-bip38 [passphrase]
   (let [key (ECKey.)
         plain-key (.toString (.getPrivateKeyEncoded key (NetworkParameters/prodNet)))
         key-str (com.fruitcat.bitcoin.BIP38/encryptNoEC passphrase plain-key true)]
-    (println key-str (private-to-pubkey-string key) (private-to-address key) passphrase)))
+    (println key-str (.getPublicKeyAsHex key) (private-to-address key) passphrase)))


bring down max adjustment threshold

bring down max adjustment threshold

--- src/block_chain/target.clj
+++ src/block_chain/target.clj
@@ -19,8 +19,8 @@
        (avg)
        (abs))))

-(def max-increase 1.50)
-(def min-increase 0.50)
+(def max-increase 1.10)
+(def min-increase 0.90)
 (defn capped [ratio]
   (cond
     (> ratio max-increase) max-increase


edited comments

edited comments

--- src/brevis/math/matrix.clj
+++ src/brevis/math/matrix.clj
@@ -186,7 +186,7 @@
   (seq-to-matrix (matrix-height mat) (matrix-width mat) (map f (matrix-to-seq mat))))

 (defn matrix-pmap
-  "Map a function over a matrix."
+  "Map a function over a matrix in parallel."
   [f mat]
   (seq-to-matrix (matrix-height mat) (matrix-width mat) (pmap f (matrix-to-seq mat))))


Use post-filter for manufacturers.

Use post-filter for manufacturers.

This allows showing unselected manufacturer counts,
and therefore multi-selection of manufacturers.

--- src/haystack/query.clj
+++ src/haystack/query.clj
@@ -80,6 +80,7 @@
   [query-map response]
   (let [aggs (:aggregations response)
         cats (-> aggs :category-path :buckets)
+        cats (if cats cats (-> aggs :category-path :filter-cat-path :buckets))
         manuf (-> aggs :manufacturer-id :buckets)
         cat-path (:category-path query-map)
         cat-path-level (inc (slash-count cat-path))
@@ -116,15 +117,16 @@
 (def fields-to-search
   ["name" "description" "category-name^0.1" "manufacturer-name^0.1" "product-class^0.1" "upc" "manufacturer-part-number" "summit-part-number" "matnr"])

-(defn- transform-search-query
+(defn transform-search-query
   "discover must/should/filtered components of query-map"
   [{:keys [search service-center-id manufacturer-ids category-path] :as query-map}]
   {:pre [(validate-query-map query-map)]}
   (let [tokens      (when search (split search #"\s+"))
         upcs        (select-upcs tokens)
         category-id (when category-path (-> (split category-path #"/") last))]
-    (cond-> {:filtered [] :must [] :should []}
-      manufacturer-ids  (update-in [:filtered] conj {:terms {:manufacturer-id manufacturer-ids}})
+    (cond-> {:filtered [] :must [] :should [] :post-filter []}
+      ;; manufacturer-ids  (update-in [:post-filter] conj {:terms {:manufacturer-id manufacturer-ids}})
+      manufacturer-ids  (update-in [:post-filter] conj {:terms {:manufacturer-id manufacturer-ids}})
       service-center-id (update-in [:filtered] conj {:term {:service-center-ids service-center-id}})
       category-id       (update-in [:filtered] conj {:term {:category-ids category-id}})

@@ -137,14 +139,16 @@
       (not-empty upcs) (update-in [:should] conj {:query {:term {:upc (stringify-seq upcs)}}})
       ;; service-center-count -- boost? filter?
       )))
-;; (transform-search-query query-map)

 (defn build-search-query
   "build elasticsearch json query from query-map"
   [query-map]
   (let [q (transform-search-query query-map)
         paging (extract-paging query-map nil)
-        do-aggs (not (:total-hits-only query-map))]
+        do-aggs (not (:total-hits-only query-map))
+        post-filter? (not-empty (:post-filter q))]
+    (if do-aggs
+      (println "\n\npost-filter" (:post-filter q) "\n\n"))
     (cond->
         {:from (* (:num-per-page paging) (dec (:page-num paging)))
          :size (:num-per-page paging)
@@ -161,10 +165,16 @@
           :fields
           {:* {}}}
          }
+      ;; (and do-aggs (not-empty (:post-filter q))) (assoc :post-filter (first (:post_filter q)))
+      post-filter? (assoc :post_filter (first (:post-filter q)))
       do-aggs (assoc :aggregations
-                  {:category-path   {:terms {:field "category-path" :min_doc_count 1 :size 4000}}
-                   :manufacturer-id {:terms {:field "manufacturer-id" :min_doc_count 1 :size 100}}
-                   })
+                     (cond->
+                         {:manufacturer-id {:terms {:field "manufacturer-id" :min_doc_count 1 :size 100}}}
+                       post-filter? (assoc :category-path
+                                           {:filter (first (:post-filter q))
+                                            :aggs {:filter-cat-path {:terms {:field "category-path" :min_doc_count 1 :size 4000}}}})
+                       (not post-filter?) (assoc :category-path {:terms {:field "category-path" :min_doc_count 1 :size 4000}})
+                       ))
       )))
 ;; (build-search-query query-map)


fixing missing user silent error

fixing missing user silent error

--- src/celestial/security.clj
+++ src/celestial/security.clj
@@ -34,6 +34,6 @@
      :unauthenticated-handler
         #(assoc (workflows/http-basic-deny "celestial" %) :body {:message "login failed" } )
      :workflows [(workflows/http-basic
-                   :credential-fn #(creds/bcrypt-credential-fn p/get-user %)
+                   :credential-fn #(creds/bcrypt-credential-fn p/get-user! %)
                    :realm "celestial")]}))


Surface functions into API

Surface functions into API

--- src/tick/alpha/api.cljc
+++ src/tick/alpha/api.cljc
@@ -2,7 +2,7 @@

 (ns tick.alpha.api
   (:refer-clojure
-   :exclude [+ - * inc dec max min
+   :exclude [+ - * inc dec max min conj
              range time int long complement
              < <= > >= << >>
              extend
@@ -371,32 +371,13 @@

 ;; Interval sets

-(defn ordered-disjoint-intervals?
-  "An interval set is an ordered collection of disjoint
-  intervals. This predicate can be used to ensure a value conforms to
-  this definition, because some functions depend on this property
-  holding."
-  [s]
-  (interval/ordered-disjoint-intervals? s))
-
-(defn union [& colls]
-  "Return a set that is the union of the input interval sets"
-  {:pre [(s/assert (s/coll-of ordered-disjoint-intervals?) colls)]}
-  (apply interval/union colls))
-
-(defn intersection [& colls]
-  "Return a set that is the intersection of the input interval sets"
-  {:pre [(s/assert (s/coll-of ordered-disjoint-intervals?) colls)]}
-  (apply interval/intersection colls))
-
-(defn difference [& colls]
-  "Return a set that is the intersection of the input interval sets"
-  {:pre [(s/assert (s/coll-of ordered-disjoint-intervals?) colls)]}
-  (apply interval/difference colls))
-
-(defn complement [coll]
-  {:pre [(s/assert ordered-disjoint-intervals? coll)]}
-  (interval/complement coll))
-
-(defn group-by [ivals groups]
-  (interval/group-by ivals groups))
+(def ordered-disjoint-intervals? interval/ordered-disjoint-intervals?)
+(def unit interval/unite)
+(def normalize interval/normalize)
+(def union interval/union)
+(def conj interval/conj)
+(def intersection interval/intersection)
+(def intersects? interval/intersects?)
+(def difference interval/difference)
+(def complement interval/complement)
+(def group-by interval/group-by)


print of a todo-list works also with notes and subtodos

--- src/todos/todo_item.clj
+++ src/todos/todo_item.clj
@@ -31,6 +31,12 @@
                           :todos (vec (for [i @sub-todos]
                                    ((i :plain))))
                           })
+     :print       (fn [pre-string]
+                      (println (format "%s[ %s ] %s" pre-string (if @done "X" " ") @todo-name))
+                      (doseq [note @notes] (println (format "%s    | - %s" pre-string note)))
+                      (doseq [item @sub-todos] ((item :print) (str pre-string "    | ")))
+                      nil
+                      )
      }))

 ; (atom []) cant be saved! be aware to build a transformfunction


Create wrap-db middleware

Create wrap-db middleware

--- src/clj/cglossa/server.clj
+++ src/clj/cglossa/server.clj
@@ -25,10 +25,21 @@
   (GET "/request" [] handle-dump)
   (GET "/" req (page)))

+(defn wrap-db [handler]
+  (fn [req]
+    (if (:db req)
+      ; TODO: handle selection of alternative db version
+      (handler req)
+      (handler (assoc req :db (models/current-db))))))
+
 (def http-handler
-  (if is-dev?
-    (-> #'app-routes wrap-keyword-params wrap-params wrap-exceptions reload/wrap-reload)
-    (-> app-routes wrap-params)))
+  (let [r (routes (wrap-restful-format #'api-routes :format [:transit-json :json])
+                  #'app-routes)
+        r (if is-dev? (-> r reload/wrap-reload wrap-exceptions) r)]
+    (-> r
+        wrap-db
+        wrap-keyword-params
+        wrap-params)))

 (defn run [& [port]]
   (defonce ^:private server


:meta true adds to the result what the calculation is based on

--- src/clj/ephemeris/core.clj
+++ src/clj/ephemeris/core.clj
@@ -8,7 +8,8 @@
                :geo {:lat nil :lon nil}
                :bodies []
                :angles true
-               :houses "O"})
+               :houses "O"
+               :meta false})

 (defn- geo? [geo]
   (if (and
@@ -75,4 +76,7 @@
               {})
             (if (houses? (:houses want))
               {:houses (zipmap (range 1 13) (rest cusps))}
-              {})))))))
+              {}))))
+      (if (boolean (:meta want))
+        {:meta (conj (seq want) {:jd jd})}
+        {}))))


Refactors brain damage.

Refactors brain damage.

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -25,6 +25,13 @@
   {:label (str "Do " dmg " net damage")
    :msg (str "do " dmg " net damage")
    :effect (effect (damage :net dmg {:card card}))})
+
+(defn do-brain-damage
+  "Do specified amount of brain damage."
+  [dmg]
+  {:label (str "Do " dmg " brain damage")
+   :msg (str "do " dmg " brain damage")
+   :effect (effect (damage :brain dmg {:card card}))})

 (defn gain-credits
   "Gain specified amount of credits"
@@ -304,7 +311,7 @@
    "Enforcer 1.0"
    {:additional-cost [:forfeit]
     :abilities [trash-program
-                {:msg "do 1 brain damage" :effect (effect (damage :brain 1 {:card card}))}
+                (do-brain-damage 1)
                 {:label "Trash a console" :effect (effect (trash target))
                  :prompt "Choose a console to trash" :msg (msg "trash " (:title target))
                  :choices {:req #(has-subtype? % "Console")}}
@@ -327,7 +334,8 @@

    "Fenris"
    {:effect (effect (gain :bad-publicity 1) (system-msg "takes 1 bad publicity"))
-    :abilities [{:msg "do 1 brain damage" :effect (effect (damage :brain 1 {:card card}))} end-the-run]}
+    :abilities [(do-brain-damage 1)
+                end-the-run]}

    "Fire Wall"
    {:advanceable :always
@@ -389,10 +397,11 @@
    {:abilities [end-the-run]}

    "Heimdall 1.0"
-   {:abilities [{:msg "do 1 brain damage" :effect (effect (damage :brain 1 {:card card}))} end-the-run]}
+   {:abilities [(do-brain-damage 1)
+                end-the-run]}

    "Heimdall 2.0"
-   {:abilities [{:msg "do 1 brain damage" :effect (effect (damage :brain 1 {:card card}))}
+   {:abilities [(do-brain-damage 1)
                 {:msg "do 1 brain damage and end the run" :effect (effect (damage :brain 1 {:card card}) (end-run))}
                 end-the-run]}

@@ -476,7 +485,7 @@
                                                     (trash state side card)))]}

    "Janus 1.0"
-   {:abilities [{:msg "do 1 brain damage" :effect (effect (damage :brain 1 {:card card}))}]}
+   {:abilities [(do-brain-damage 1)]}

    "Kitsune"
    {:abilities [{:prompt "Choose a card in HQ to force access"
@@ -808,13 +817,17 @@
                  :trace {:base 4 :msg "end the run" :effect (effect (end-run))}}]}

    "Viktor 1.0"
-   {:abilities [{:msg "do 1 brain damage" :effect (effect (damage :brain 1 {:card card}))} end-the-run]}
+   {:abilities [(do-brain-damage 1)
+                end-the-run]}

    "Viktor 2.0"
-   {:abilities [{:msg "do 1 brain damage using 1 power counter" :counter-cost 1
+   {:abilities [{:msg "do 1 brain damage using 1 power counter"
+                 :counter-cost 1
                  :effect (effect (damage :brain 1 {:card card}))}
                 {:label "Trace 2 - Add 1 power counter"
-                 :trace {:base 2 :msg "add 1 power counter" :effect (effect (add-prop card :counter 1))}}
+                 :trace {:base 2
+                         :msg "add 1 power counter"
+                         :effect (effect (add-prop card :counter 1))}}
                 end-the-run]}

    "Viper"
@@ -887,4 +900,4 @@
                             :yes-ability {:effect (effect (move (first (:deck corp)) :deck))}}}]}

    "Zed 1.0"
-   {:abilities [{:msg "do 1 brain damage" :effect (effect (damage :brain 1 {:card card}))}]}})
+   {:abilities [(do-brain-damage 1)]}})


Only println in debug.

Only println in debug.

--- src/clj_ravendb/client.clj
+++ src/clj_ravendb/client.clj
@@ -4,21 +4,26 @@
             [clojure.core.async :refer [go chan close! timeout <!! >!! <! >!]]
             [clj-ravendb.responses :as res]))

+(def ^:dynamic *debug* false)
+(defmacro debug-do [& body]
+  (when *debug*
+    `(do ~@body)))
+
 (def not-nil? (complement nil?))

 (defn- post-req
   [{:keys [url body]}]
-  (println "Sending HTTP POST to" url "with JSON body " body)
+  (debug-do (println "Sending HTTP POST to" url "with JSON body " body))
   (client/post url {:body body :as :json-string-keys}))

 (defn- put-req
   [{:keys [url body]}]
-  (println "Sending HTTP PUT to" url "with JSON body " body)
+  (debug-do (println "Sending HTTP PUT to" url "with JSON body " body))
   (client/put url {:body body :as :json-string-keys}))

 (defn- get-req
   [{:keys [url]}]
-  (println "Sending HTTP GET to" url)
+  (debug-do (println "Sending HTTP GET to" url))
   (client/get url {:as :json-string-keys}))

 (defn- is-valid-client?
@@ -37,7 +42,7 @@
     (let [response (try
                      (handle (merge {:url (first urls)} request))
                      (catch java.net.ConnectException ce
-                       (println "Failed to execute request using " (first urls))))]
+                       (debug-do (println "Failed to execute request using " (first urls)))))]
       (if (not (nil? response))
         response
         (recur (rest urls))))))
@@ -59,7 +64,7 @@
    (let [fragments (list url "Databases" database)
          address (clojure.string/join "/" fragments)
          load-replications (fn []
-                             (println "Loading replication destinations from" address)
+                             (debug-do (println "Loading replication destinations from" address))
                              (:results (res/load-replications (get-req (req/load-replications address)))))
          replications (if replicated?
                         (load-replications)
@@ -190,7 +195,7 @@
                (= attempt max-attempts))
          result
          (do
-           (println "Index" (:index query) "is stale, waiting" wait "ms before trying again.")
+           (debug-do (println "Index" (:index query) "is stale, waiting" wait "ms before trying again."))
            (Thread/sleep wait)
            (recur (get-result) (inc attempt))))))))

@@ -201,7 +206,7 @@
                              :or {wait 500}}]
    (let [keep-watching? (atom true)
          f (future
-             (println "Watching" watch "for changes")
+             (debug-do (println "Watching" watch "for changes"))
              (loop [last-value {}]
                (let [latest (watch-fn)]
                  (if (and (not= last-value {})
@@ -209,12 +214,12 @@
                    (go (>! channel latest)))
                  (if @keep-watching?
                    (do
-                     (println "Waiting" wait "ms until next 'watch'")
+                     (debug-do (println "Waiting" wait "ms until next 'watch'"))
                      (Thread/sleep wait)
                      (recur latest))))))]
      {:channel channel
       :stop (fn []
-              (println "Closing channel" channel "and trying to end future" f)
+              (debug-do (println "Closing channel" channel "and trying to end future" f))
               (reset! keep-watching? false)
               (close! channel))})))

@@ -227,6 +232,8 @@
   :wait - milliseconds to wait between watch calls."
   ([client document-ids]
    (watch-documents client document-ids (chan)))
+  ([client document-ids channel]
+   (watch-documents client document-ids channel {}))
   ([client document-ids channel options]
    (watch client (fn []
                    (load-documents client document-ids)) channel options)))
@@ -240,6 +247,8 @@
   :wait - milliseconds to wait between watch calls."
   ([client query]
    (watch-index client query (chan)))
+  ([client query channel]
+   (watch-index client query channel {}))
   ([client query channel options]
    (watch client (fn []
-                   (query-index client query)) channel options)))+                   (query-index client query)) channel options)))