whitespace cleanup

whitespace cleanup

--- src/overtone/core/sc.clj
+++ src/overtone/core/sc.clj
@@ -1,6 +1,6 @@
-(ns
+(ns
   #^{:doc "An interface to the SuperCollider synthesis server.
-          This is at heart an OSC client library for the SuperCollider
+          This is at heart an OSC client library for the SuperCollider
           scsynth DSP engine."
      :author "Jeff Rose"}
   overtone.core.sc
@@ -58,9 +58,9 @@

 ; We use bit sets to store the allocation state of resources on the audio server.
 ; These typically get allocated on usage by the client, and then freed either by
-; client request or automatically by receiving notifications from the server.
+; client request or automatically by receiving notifications from the server.
 ; (e.g. When an envelope trigger fires to free a synth.)
-(defonce allocator-bits
+(defonce allocator-bits
   {:node (BitSet. MAX-NODES)
    :audio-buffer (BitSet. MAX-BUFFERS)
    :audio-bus (BitSet. MAX-NODES)
@@ -72,7 +72,7 @@
    :audio-bus MAX-AUDIO-BUS
    :control-bus MAX-CONTROL-BUS})

-(defn alloc-id
+(defn alloc-id
   "Allocate a new ID for the type corresponding to key."
   [k]
   (let [bits (get allocator-bits k)
@@ -87,7 +87,7 @@

 (alloc-id :node) ; ID zero is the root group

-(defn free-id
+(defn free-id
   "Free the id of type key."
   [k id]
   (let [bits (get allocator-bits k)
@@ -95,7 +95,7 @@
     (locking bits
       (.clear bits id))))

-(defn all-ids
+(defn all-ids
   "Get all of the currently allocated ids for key."
   [k]
   (let [bits (get allocator-bits k)
@@ -148,8 +148,8 @@
 (defn snd-nr
   "Creates an OSC message and dont expect a reply back."
   [path & args]
-    (cond
-      (= ::external (type @server*)) (osc-send-msg @server*
+    (cond
+      (= ::external (type @server*)) (osc-send-msg @server*
                                                    (apply osc-msg path (osc-type-tag args) args))
       (= ::internal (type @server*)) (event ::send-osc-message (apply osc-msg path (osc-type-tag args) args))))

@@ -159,8 +159,8 @@
   "Creates an OSC message and either sends it to the server immediately
   or if a bundle is currently being formed it adds it to the list of messages."
   [path & args]
-  (cond
-    (= ::external (type @server*)) (osc-send-msg @server*
+  (cond
+    (= ::external (type @server*)) (osc-send-msg @server*
                                                  (apply osc-msg path (osc-type-tag args) args))
     (= ::internal (type @server*)) (event ::send-osc-message
                                           :msg (apply osc-msg path (osc-type-tag args) args))))
@@ -170,7 +170,7 @@
   [time-ms & body]
   `(in-osc-bundle @server* ~time-ms ~@body))

-(defn debug
+(defn debug
   "Control debug output from both the Overtone and the audio server."
   [& [on-off]]
   (if (or on-off (nil? on-off))
@@ -198,18 +198,18 @@
 ;   int - previous node ID, -1 if no previous node.
 ;   int - next node ID, -1 if no next node.
 ;   int - 1 if the node is a group, 0 if it is a synth
-;
+;
 ; The following two arguments are only sent if the node is a group:
 ;   int - the ID of the head node, -1 if there is no head node.
 ;   int - the ID of the tail node, -1 if there is no tail node.
-;
+;
 ;   /n_go   - a node was created
 ;   /n_end  - a node was destroyed
 ;   /n_on   - a node was turned on
 ;   /n_off  - a node was turned off
 ;   /n_move - a node was moved
 ;   /n_info - in reply to /n_query
-;
+;
 ; Trigger Notifications
 ;
 ; This command is the mechanism that synths can use to trigger events in
@@ -223,25 +223,25 @@
 ;   int - trigger ID
 ;   float - trigger value

-(defn notify
+(defn notify
   "Turn on notification messages from the audio server.  This lets us free
   synth IDs when they are automatically freed with envelope triggers.  It also lets
   us receive custom messages from various trigger ugens."
   [notify?]
   (snd "/notify" (if (false? notify?) 0 1)))

-(defn- node-destroyed
+(defn- node-destroyed
   "Frees up a synth node to keep in sync with the server."
   [id]
   (log/debug (format "node-destroyed: %d" id))
   (free-id :node id))

-(defn- node-created
+(defn- node-created
   "Called when a node is created on the synth."
   [id]
   (log/debug (format "node-created: %d" id)))

-(defn- register-notification-handlers
+(defn- register-notification-handlers
   "Setup the feedback handlers with the audio server."
   []
   (osc-handle @server* "/n_end" #(node-destroyed (first (:args %))))
@@ -261,7 +261,7 @@
   ;;(register-notification-handlers)
   )

-(defn- connect-thread-external
+(defn- connect-thread-external
   [host port]
   (log/debug "Connecting to external SuperCollider server: " host ":" port)
   (dosync (ref-set server* (with-meta
@@ -281,10 +281,10 @@
 ; TODO: setup an error-handler in the case that we can't connect to the server
 (defn connect
   "Connect to an external SC audio server on the specified host and port."
-  ([]
+  ([]
    (connect :internal))
-  ([which & [host port]]
-   (cond
+  ([which & [host port]]
+   (cond
      (= :internal which) (connect-internal)
      (= :external which) (.run (Thread. #(connect-thread-external host port))))))

@@ -292,7 +292,7 @@

 (def server-log* (ref []))

-(defn server-log
+(defn server-log
   "Print the server log."
   []
   (doseq [msg @server-log*]
@@ -309,11 +309,11 @@
 ;	float - peak percent CPU usage for signal processing
 ;	double - nominal sample rate
 ;	double - actual sample rate
-(defn status
+(defn status
   "Check the status of the audio server."
   []
   (if (= @status* :booted)
-    (do
+    (do
       (snd "/status")
       (let [sts (recv "status.reply" REPLY-TIMEOUT)]
         (log/debug "got status: " (:args sts))
@@ -387,7 +387,7 @@
        (connect :internal)
        :booting))))

-(defn- sc-log
+(defn- sc-log
   "Pull audio server log data from a pipe and store for later printing."
   [stream read-buf]
   (while (pos? (.available stream))
@@ -397,8 +397,8 @@
       (dosync (alter server-log* conj msg))
       (log/info (String. read-buf 0 n)))))

-(defn- external-booter
-  "Boot thread to start the external audio server process and hook up to
+(defn- external-booter
+  "Boot thread to start the external audio server process and hook up to
   STDOUT for log messages."
   [cmd]
   (reset! running?* true)
@@ -413,8 +413,8 @@
       (Thread/sleep 250))
     (.destroy proc)))

-(defn boot-external
-  "Boot the audio server in an external process and tell it to listen on a
+(defn boot-external
+  "Boot the audio server in an external process and tell it to listen on a
   specific port."
   ([host port]
    (if (not @running?*)
@@ -432,7 +432,7 @@
   "Boot either the internal or external audio server."
   ([] (boot (get @config* :server :internal) SERVER-HOST SERVER-PORT))
   ([which & [host port]]
-   (cond
+   (cond
      (= :internal which) (boot-internal)
      (= :external which) (boot-external host port))))

@@ -458,7 +458,7 @@
    :replace-node 4})

 ;; Sending a synth-id of -1 lets the server choose an ID
-(defn node
+(defn node
   "Instantiate a synth node on the audio server."
   [synth-name & args]
   (let [id (alloc-id :node)
@@ -561,7 +561,7 @@

 (def *data* nil)

-(defn- parse-synth-tree
+(defn- parse-synth-tree
   [ctls?]
   (let [sname (first *data*)]
     (if ctls?
@@ -644,7 +644,7 @@
 (defn buffer? [buf]
   (= (type buf) ::buffer))

-(defn buffer-free
+(defn buffer-free
   "Free an audio buffer and the memory it was consuming."
   [buf]
   (assert (buffer? buf))
@@ -652,7 +652,7 @@
   (snd "/b_free" (:id buf)))

 ; TODO: Test me...
-(defn buffer-read
+(defn buffer-read
   "Read a section of an audio buffer."
   [buf start len]
   (assert (buffer? buf))
@@ -676,7 +676,7 @@
           (recur (+ recvd blen)))))))

 ;; TODO: test me...
-(defn buffer-write
+(defn buffer-write
   "Write into a section of an audio buffer."
   [buf start len data]
   (assert (buffer? buf))
@@ -711,10 +711,10 @@
 ;; functions should work on samples.
 (derive ::sample ::buffer)

-(defn buffer-data
+(defn buffer-data
   "Get the floating point data for a buffer on the internal server."
   [buf]
-  (let [buf-id (cond
+  (let [buf-id (cond
                  (buffer? buf) (:id buf)
                  (sample? buf) (:id (:buf buf)))
         snd-buf (ScJnaCopySndBuf @world* buf-id)
@@ -754,7 +754,7 @@
   (apply node-free (all-ids :node))
   (clear-ids :node)
   (alloc-id :node) ; ID zero is the root group
-  (dosync (ref-set synths* (zipmap (keys @synths*)
+  (dosync (ref-set synths* (zipmap (keys @synths*)
                                    (repeat (count @synths*) (group :tail 0))))))

 ;  Maybe it's better to keep the server log around???
@@ -848,8 +848,8 @@
     :killed))

 (defn load-instruments []
-  (doseq [synth (filter #(synthdef? %1)
-                        (map #(var-get %1)
+  (doseq [synth (filter #(synthdef? %1)
+                        (map #(var-get %1)
                              (vals (ns-publics 'overtone.instrument))))]
     ;(println "loading synth: " (:name synth))
     (load-synthdef synth)))
@@ -878,7 +878,7 @@
       named)))

 (defn synth-player [sname arg-names]
-  (fn [& args]
+  (fn [& args]
     (let [sgroup (get @synths* sname)
           controller (partial node-control sgroup)
           player (partial node sname :target sgroup)


Teach group fn to ensure that the target node is active.

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -343,6 +343,7 @@

   ([name id position target]
      (ensure-connected!)
+     (ensure-node-active! target "using node as a target for a group")
      (when-not target
        (throw (IllegalArgumentException. (str "The target for this group must exist."))))
      (let [pos    (if (keyword? position) (get NODE-POSITION position) position)


CMR-1359: reverting previous change.

CMR-1359: reverting previous change.

--- ingest-app/src/cmr/ingest/services/ingest_service.clj
+++ ingest-app/src/cmr/ingest/services/ingest_service.clj
@@ -102,12 +102,12 @@
   Accepts an optional function for looking up the parent collection concept and UMM record as a tuple.
   This can be used to provide the collection through an alternative means like the API."
   ([context concept]
-   (validate-granule context concept get-granule-parent-collection-and-concept))
+   (validate-granule
+     context concept get-granule-parent-collection-and-concept))
   ([context concept fetch-parent-collection-concept-fn]
    (v/validate-concept-request concept)
    (v/validate-concept-xml concept)

-   ;; fetch-parent-collection-concept-fn defaults to get-granule-parent-collection-and-concept
    (let [granule (umm/parse-concept concept)
          [parent-collection-concept
           parent-collection] (fetch-parent-collection-concept-fn


Handle version lists

Handle version lists

--- frontend/utils/docs.cljs
+++ frontend/utils/docs.cljs
@@ -4,7 +4,8 @@
             [frontend.utils :as utils :include-macros true]
             [goog.string :as gstring]
             goog.string.format
-            [frontend.state :as state]))
+            [frontend.state :as state]
+            [om.core :as om :include-macros true]))

 (defn include-article [template-name]
   ((aget (aget js/window "HAML") template-name)))
@@ -14,13 +15,24 @@
          #js {"__html"  ((aget (aget js/window "HAML") template-name)
                          (clj->js (merge {"include_article" include-article} args)))}}])

+(defn code-list-filter [versions]
+  (let [component (fn [vs]
+                    (om/component
+                     (utils/html [:ul (for [v vs]
+                                        [:li [:code v]])])))]
+    (.renderComponentToString js/React (om/build component versions))))
+
 (defn replace-variables [html]
-  (let [re (js/RegExp. "{{\\s*([\\S]*)\\s*}}" "g")]
-    (.replace html re (fn [s match]
-                        (let [[name & path] (string/split match #"\.")
+  (let [re (js/RegExp. "{{\\s*([^\\s]*)\\s*(?:\\|\\s*([\\w-]*)\\s*)?}}" "g")]
+    (.replace html re (fn [s m1 m2]
+                        (let [[name & path] (string/split m1 #"\.")
                               var (case name
-                                        "versions" (.-Versions js/CI))]
-                          (apply aget var path))))))
+                                    "versions" (.-Versions js/CI))
+                              val (apply aget var path)
+                              filter (case m2
+                                       "code-list" code-list-filter
+                                       identity)]
+                          (filter val))))))

 (defn replace-asset-paths [html]
   (let [re (js/RegExp. "\"asset:/(.*?)\"" "g")]


Add some cache-control headers

Add some cache-control headers

--- src/kostlee/core.clj
+++ src/kostlee/core.clj
@@ -18,6 +18,43 @@
    (let [response (handler request)]
     (assoc-in response [:headers "Access-Control-Allow-Origin"] "*"))))

+(defmacro redef
+  "Redefine an existing value, keeping the metadata intact."
+  [name value]
+  `(let [m# (meta #'~name)
+         v# (def ~name ~value)]
+     (alter-meta! v# merge m#)
+     v#))
+
+(defmacro decorate
+  "Wrap a function in one or more decorators."
+  [func & decorators]
+  `(redef ~func (-> ~func ~@decorators)))
+
+(defmacro decorate-with
+  "Wrap multiple functions in a single decorator."
+  [decorator & funcs]
+  `(do ~@(for [f funcs]
+          `(redef ~f (~decorator ~f)))))
+
+(defn- with-header [handler header value]
+  (fn [request]
+    (when-let [response (handler request)]
+      (assoc-in response [:headers header] value))))
+
+(defroutes css-vendor-resource-routes
+  (route/resources "/css/vendor" { :root "public/css/vendor" }))
+
+(defroutes js-vendor-resource-routes
+  (route/resources "/js/vendor" { :root "public/js/vendor/" }))
+
+(defroutes gfx-resource-routes
+  (route/resources "/gfx" { :root "public/gfx/" }))
+
+(decorate gfx-resource-routes (with-header "Cache-Control" "max-age=31536000"))
+(decorate js-vendor-resource-routes (with-header "Cache-Control" "max-age=31536000"))
+(decorate css-vendor-resource-routes (with-header "Cache-Control" "max-age=31536000"))
+
 (defroutes api-routes
   (GET "/" [] (resp/resource-response "index.html" {:root "public"}))
   (GET "/status" [] {:status 200 :body "Yey Okay"})
@@ -28,6 +65,9 @@
       (GET    "/" [] (handlers/get-daymoney id))
       (PUT    "/" {body :body} (handlers/update-daymoney id body))
       (DELETE "/" [] (handlers/delete-daymoney id))))
+  gfx-resource-routes
+  js-vendor-resource-routes
+  css-vendor-resource-routes
   (route/resources "/")
   (route/not-found "Not Found"))


Fix Exception on Missing Workbook

Fix Exception on Missing Workbook

--- src/lens/handler.clj
+++ src/lens/handler.clj
@@ -67,7 +67,7 @@
       (when-let [workbook (api/workbook db id)]
         {:workbook workbook}))

-    :etag (fnk [workbook] (-> workbook :workbook/head :version/id))
+    :etag (fn [{:keys [workbook]}] (-> workbook :workbook/head :version/id))

     :handle-ok
     (fnk [workbook] (render-workbook path-for workbook))


Remove unused last-calues

Remove unused last-calues

~10% speed up in load time

--- src/mavlink/core.clj
+++ src/mavlink/core.clj
@@ -190,9 +190,6 @@
    :component-id component-id
    :link-id (atom (or link-id 0)) ; MAVLink 2.0, encoding only
    :sequence-id-atom (atom 0)
-   :last-values (apply merge (map #(let [{:keys [msg-key default-msg]} %]
-                                     {msg-key (ref default-msg)})
-                                  (vals (:messages-by-keyword mavlink))))
    :decode-sm (atom start-state)
    :decode-message-info (atom nil)      ; internal to decode state machine
    :input-buffer                        ; internal to decoding
@@ -745,7 +742,7 @@
    Whenever an error occurs, go back to the start state. As soon as a start byte is recognized,
    start the state machine and attempt to decode a message.
    Both MAVlink 1.0 and MAVlink 2.0 are supported."
-  [{:keys [statistics decode-sm last-values] :as channel} a-byte]
+  [{:keys [statistics decode-sm] :as channel} a-byte]
   {:pre [(instance? Byte a-byte)
          (fn? @decode-sm)]}
   (swap! statistics assoc :bytes-received (inc (:bytes-received @statistics)))


Set the file permissions on the right files

i.e. use the full path

--- src/mdr2/archive.clj
+++ src/mdr2/archive.clj
@@ -78,20 +78,26 @@
                                   (prod/multi-volume? production))
                          (str "_" volume))))))

-(defn- container-path
+(defn container-root-path
+  "Return the root container path for a given `production` and
+  `sektion`"
+  [production sektion]
+  (file spool-dir (container-id production sektion)))
+
+(defn container-path
   "Return the path to the archive spool directory for a given
   `production` and `sektion`"
   [production sektion]
-  (let [id (container-id production sektion)]
-    (.getPath (file spool-dir id "produkt"))))
-
-(defn- container-rdf-path
+  (let [root-path (container-root-path production sektion)]
+    (.getPath (file root-path "produkt"))))
+
+(defn container-rdf-path
   "Return the path to the rdf file in the archive spool for a given
   `production` and `sektion`"
   [production sektion]
-  (let [path (container-id production sektion)
+  (let [root-path (container-root-path production sektion)
         rdf-name (str (container-id production sektion) ".rdf")]
-    (.getPath (file spool-dir path rdf-name))))
+    (.getPath (file root-path rdf-name))))

 (defn- add-to-db
   "Insert a `production` into the archive db for the given `sektion`.
@@ -108,34 +114,34 @@

 (defn set-file-permissions
   "Set file permissions on `root` to g+w recursively"
-  [root]
-  (let [permissions (conj (set (nio/posix-file-permissions root))
+  [file-tree]
+  (let [permissions (conj (set (nio/posix-file-permissions file-tree))
                           (nio/posix-file-permission :group-write))
         visitor-fn (fn [f] (nio/set-posix-file-permissions! f permissions) nil)
         visitor (nio/naive-visitor
                  :pre-visit-directory visitor-fn
                  :visit-file visitor-fn)]
-    (nio/walk-file-tree root visitor)))
+    (nio/walk-file-tree file-tree visitor)))

 (defn- copy-files
   "Copy a `production` to the archive spool dir for the given
   `sektion`. For a production master copy the whole DTB including wav
   files. For a production distribution master copy the isos"
   [production sektion]
-  (let [archive-path (container-path production sektion)]
-    (if (fs/exists? archive-path)
-      (log/errorf "Archive path %s already exists" archive-path)
-      (case sektion
-        :master
-        (do (fs/copy-dir (path/recorded-path production) archive-path)
-            (set-file-permissions (file archive-path)))
-        :dist-master
-        (do
+  (let [archive-root-path (container-root-path production sektion)]
+    (if (fs/exists? archive-root-path)
+      (log/errorf "Archive root path %s already exists" archive-root-path)
+      (let [archive-path (container-path production sektion)]
+        (fs/mkdir archive-root-path)
+        (case sektion
+          :master
+          (fs/copy-dir (path/recorded-path production) archive-path)
+          :dist-master
           (doseq [volume (range 1 (inc (:volumes production)))]
             (let [iso-archive-name (str (container-id production sektion volume) ".iso")
                   iso-archive-path (.getPath (file archive-path iso-archive-name))]
-              (fs/copy+ (path/iso-name production volume) iso-archive-path)))
-          (set-file-permissions (file archive-path)))))))
+              (fs/copy+ (path/iso-name production volume) iso-archive-path))))
+        (set-file-permissions archive-root-path)))))

 (defn- create-rdf
   "Create an rdf file and place it in the appropriate archive spool


add hover notes for history buttons (close #131)

--- src/main/cljs_api_gen/write.clj
+++ src/main/cljs_api_gen/write.clj
@@ -258,20 +258,18 @@
   [item]
   (str *output-dir* "/" refs-dir "/" (encode/encode-fullname (:full-name item))))

-(defn history-change
-  [[change version]]
-  (let [change ({"+" "Added", "-" "Removed"} change)]
-    {:change change
-     :version version}))
-
 (defn history-change-shield
   [[change version]]
   (let [color ({"+" "lightgrey" "-" "red"} change)
-        change ({"+" "+", "-" "×"} change)]
+        change-symbol ({"+" "+", "-" "×"} change)
+        change-word ({"+" "Added", "-" "Removed"} change)
+        ]
     (str
       ""
-      ""
+      ""
       "")))

 (defn version-changes


Minor cleaning on tempfile namespace.

Minor cleaning on tempfile namespace.

--- src/uxbox/util/tempfile.clj
+++ src/uxbox/util/tempfile.clj
@@ -6,19 +6,12 @@

 (ns uxbox.util.tempfile
   "A temporal file abstractions."
-  (:require [storages.core :as st])
+  (:require [storages.core :as st]
+            [uxbox.util.paths :as paths])
   (:import java.nio.file.Files
            java.nio.file.Path
-           java.nio.file.Paths
-           java.nio.file.SimpleFileVisitor
-           java.nio.file.FileVisitResult
            java.nio.file.attribute.FileAttribute
            java.nio.file.attribute.PosixFilePermissions))
-
-(def ^:private default-fileattrs
-  (let [perms (PosixFilePermissions/fromString "rwxr-xr-x")
-        attr (PosixFilePermissions/asFileAttribute perms)]
-    (into-array FileAttribute [attr])))

 (defrecord CloseablePath [^Path path]
   java.lang.AutoCloseable
@@ -28,23 +21,10 @@
 (defn create
   "Create a temporal file."
   [& {:keys [suffix prefix wrap]}]
-  (let [file (Files/createTempFile prefix suffix default-fileattrs)]
+  (let [perms (PosixFilePermissions/fromString "rwxr-xr-x")
+        attr (PosixFilePermissions/asFileAttribute perms)
+        attrs (into-array FileAttribute [attr])
+        file (Files/createTempFile prefix suffix attrs)]
     (if wrap
       (CloseablePath. file)
       file)))
-
-(defn delete
-  [path]
-  (let [path (st/path path)]
-    (Files/deleteIfExists path)))
-
-(defn delete-tree
-  [path]
-  (let [^Path path (st/path path)]
-    (Files/walkFileTree path (proxy [SimpleFileVisitor] []
-                               (visitFile [file attrs]
-                                 (delete file)
-                                 (FileVisitResult/CONTINUE))
-                               (postVisitDirectory [dir exc]
-                                 (delete dir)
-                                 (FileVisitResult/CONTINUE))))))


Cleaning out cruft from debugging #79

Cleaning out cruft from debugging #79

--- src/polismath/poller.clj
+++ src/polismath/poller.clj
@@ -113,7 +113,6 @@
       ; Get and split new votes
       (let [new-votes (poll pg-spec @last-timestamp)
             zid-votes (group-by :zid new-votes)]
-        (println "XXXX - last:" (last new-votes) "max: " (apply max 0 @last-timestamp (map :created new-votes)))
         ; For each conv...
         (doseq [[zid votes] zid-votes]
           (let [lastVoteTimestamp (:created (last votes))


CLJS-1393: turn *target* into goog-define

--- src/main/cljs/cljs/core.cljs
+++ src/main/cljs/cljs/core.cljs
@@ -17,13 +17,12 @@

 (def *unchecked-if* false)

-(def
+(goog-define
   ^{:dynamic true
     :doc "Var bound to the name value of the compiler build :target option.
   For example, if the compiler build :target is :nodejs, *target* will be bound
   to \"nodejs\". *target* is a Google Closure define and can be set by compiler
-  :closure-defines option."
-    :jsdoc ["@define {string}"]}
+  :closure-defines option."}
   *target* "default")

 (def


Use the correct form of nested hydrate

Use the correct form of nested hydrate

--- src/metabase/api/meta/table.clj
+++ src/metabase/api/meta/table.clj
@@ -62,7 +62,7 @@
   {include_sensitive_fields String->Boolean}
   (->404 (sel :one Table :id id)
          read-check
-         (hydrate :db [:fields [:target] [:human_readable_name]] :field_values :human_readable_name)
+         (hydrate :db [:fields :target :human_readable_name] :field_values :human_readable_name)
          (update-in [:fields] (if include_sensitive_fields
                                 ;; If someone passes include_sensitive_fields return hydrated :fields as-is
                                 identity


68, 69

68, 69

--- src/sandbox/4clojure.clj
+++ src/sandbox/4clojure.clj
@@ -266,3 +266,13 @@
        (remove (fn [n] (some integer? (map #(/ n %) (range 2 n)))))
        (take k)))

+;;68 Recurring Theme
+[7 6 5 4 3]
+
+;;69 Merge with a Function
+(defn g [f & xs]
+  (->> (apply concat xs)
+       (group-by first)
+       (map (fn [[k v]] [k (reduce f (map second v))]))
+       (into {})))
+


Add a title prefix

Add a title prefix

--- benchmarks/caesium/bench_utils.clj
+++ benchmarks/caesium/bench_utils.clj
@@ -3,7 +3,7 @@
 (defn print-title
   [& title-parts]
   (println)
-  (apply println title-parts))
+  (apply println "~> " title-parts))

 (defn fmt-bytes
   [n]


Simple detect of & in a provided and an entry point for us to try something new!

--- src/midje/parsing/lexical_maps.clj
+++ src/midje/parsing/lexical_maps.clj
@@ -61,6 +61,13 @@

 ;;;                                             Fake Maps

+
+(defn- arg-matchers [arg-matchers]
+  (if (= (str (first arg-matchers)) "&")
+    `(map from-fake-maps/mkfn:arg-matcher ~(vec arg-matchers))
+    `(map from-fake-maps/mkfn:arg-matcher ~(vec arg-matchers))))
+
+
 ;; A fake map describes all or part of a temporary rebinding of a var with a function that
 ;; captures invocations and also returns canned values.

@@ -68,6 +75,7 @@
   (let [source-details `{:call-form '~call-form
                          :arrow '~arrow
                          :rhs '~(cons result overrides)}
+        arg-mappers (arg-matchers args)
         override-map `(hash-map-duplicates-ok ~@overrides)
         line (:line (meta call-form))
         result `(merge
@@ -76,7 +84,7 @@
                   :var ~(fnref/as-var-form fnref)
                   :value-at-time-of-faking (if (bound? ~(fnref/as-var-form fnref))
                                              ~(fnref/as-form-to-fetch-var-value fnref))
-                  :arg-matchers (map from-fake-maps/mkfn:arg-matcher ~(vec args))
+                  :arg-matchers ~arg-mappers
                   :result-supplier (from-fake-maps/mkfn:result-supplier ~arrow ~result)
                   :times :default  ; Default allows for a more attractive error in the most common case.


Adjust the deftemplates and defsnippets

Adjust the deftemplates and defsnippets

In bc87d96 I had made an adjustment to the HTML. Change the Enlive code
to take advantage of that. That means putting the login form into the
right column and the main text in the middle.

--- src/theatralia/welcome_page.clj
+++ src/theatralia/welcome_page.clj
@@ -12,13 +12,19 @@

 (html/defsnippet welcome-snippet
   welcome-html
-  [:body :> html/any-node]
+  [:#main]
+  [] identity)
+
+(html/defsnippet login-snippet
+  welcome-html
+  [:#login]
   [] identity)

 (html/deftemplate index main-html
   []
   [:title] (html/content "Welcome to Theatralia!")
-  [:#main-content] (html/content (welcome-snippet)))
+  [:#main-content] (html/content (welcome-snippet))
+  [:#global-tools] (html/content (login-snippet)))

 (def css-data [[:html {:font-family "sans-serif"}]
                [:#theatralia {:font-family "fancy"}]


spelling correction - s/max/mac

spelling correction - s/max/mac

--- src/overtone/helpers/system.clj
+++ src/overtone/helpers/system.clj
@@ -9,7 +9,7 @@
   (System/getProperty "user.name"))

 (defn get-os
-  "Return the OS as a keyword. One of :windows :linux :max"
+  "Return the OS as a keyword. One of :windows :linux :mac"
   []
   (let [os (System/getProperty "os.name")]
     (cond


DM + CW #11 - use objective8 schema name in raw SQL answer query

--- src/objective8/storage/storage.clj
+++ src/objective8/storage/storage.clj
@@ -97,10 +97,10 @@

 (defn pg-retrieve-answers-with-votes-for-question [question-id]
   (apply vector (map unmap-answer-with-votes
-                  (korma/exec-raw ["SELECT answers.*, up_votes, down_votes FROM answers
-LEFT JOIN (SELECT global_id, count(vote) as down_votes FROM up_down_votes WHERE vote < 0 GROUP BY global_id) AS agg
+                  (korma/exec-raw ["SELECT answers.*, up_votes, down_votes FROM objective8.answers AS answers
+LEFT JOIN (SELECT global_id, count(vote) as down_votes FROM objective8.up_down_votes WHERE vote < 0 GROUP BY global_id) AS agg
      ON agg.global_id = answers.global_id
-LEFT JOIN (SELECT global_id, count(vote) as up_votes FROM up_down_votes WHERE vote > 0 GROUP BY global_id) AS agg2
+LEFT JOIN (SELECT global_id, count(vote) as up_votes FROM objective8.up_down_votes WHERE vote > 0 GROUP BY global_id) AS agg2
      ON agg2.global_id = answers.global_id
 WHERE answers.question_id = ?
 ORDER BY answers._created_at ASC


Update the call for the paginated read, remove the limiting from the DB query since it's now donw after the sorting.

--- src/oc/storage/resources/entry.clj
+++ src/oc/storage/resources/entry.clj
@@ -394,9 +394,9 @@
                      [{:fn :contains :value allowed-boards :field :board-uuid}
                       {:fn :eq :field :must-see :value (boolean (#{true "true"} must-see))}]
                      )]
-    (db-common/read-resources-and-relations conn table-name
+    (db-common/read-all-resources-and-relations conn table-name
       :status-org-uuid [[:published org-uuid]]
-      "published-at" order start direction config/default-activity-limit
+      "published-at" order start direction
       filter-map
       :interactions common/interaction-table-name :uuid :resource-uuid
       ["uuid" "headline" "body" "reaction" "author"
@@ -412,9 +412,9 @@
   {:pre [(db-common/conn? conn)
           (#{:desc :asc} order)
           (#{:before :after} direction)]}
-  (db-common/read-resources-and-relations conn table-name
+  (db-common/read-all-resources-and-relations conn table-name
     :status-board-uuid [[:published board-uuid]]
-    "published-at" order start direction config/default-activity-limit
+    "published-at" order start direction
     :interactions common/interaction-table-name :uuid :resource-uuid
     ["uuid" "headline" "body" "reaction" "author"
      "published-at" "created-at" "updated-at"] {:count count}))


Fix bugs on scale and rotate opetation over matrix.

--- src/uxbox/util/geom/matrix.cljs
+++ src/uxbox/util/geom/matrix.cljs
@@ -62,25 +62,26 @@
          y (:y center)
          cos (mth/cos angle)
          sin (mth/sin angle)
-         nsin (mth/neg sin)
-         tx (+ (- x (* x cos)) (* y sin))
-         ty (- (- y (* x sin)) (* y cos))
+         nsin (- sin)
+         tx (- x (+ (* x cos)) (* y sin))
+         ty (- y (- (* x sin)) (* y cos))
          a (+ (* cos (:a m)) (* sin (:b m)))
          b (+ (* nsin (:a m)) (* cos (:b m)))
          c (+ (* cos (:c m)) (* sin (:d m)))
          d (+ (* nsin (:c m)) (* cos (:d m)))
-         tx' (+ (:tx m) (* tx (:a m)) (* tx (:b m)))
+         tx' (+ (:tx m) (* tx (:a m)) (* ty (:b m)))
          ty' (+ (:ty m) (* tx (:c m)) (* ty (:d m)))]
-     (Matrix. a b c d tx ty))))
+     (Matrix. a b c d tx' ty'))))

 (defn scale
   "Apply scale transformation to the matrix."
-  [m v]
-  (assoc m
-         :a (* (:a m) v)
-         :c (* (:c m) v)
-         :b (* (:b m) v)
-         :d (* (:d m) v)))
+  ([m v] (scale m v v))
+  ([m x y]
+   (assoc m
+          :a (* (:a m) x)
+          :c (* (:c m) x)
+          :b (* (:b m) y)
+          :d (* (:d m) y))))

 (defn translate
   "Apply translate transformation to the matrix."


can move balls in turns

can move balls in turns

--- src/nonaga/draw.cljs
+++ src/nonaga/draw.cljs
@@ -48,6 +48,10 @@
 (defn draw [shape coords]
   (map (comp shape hex->svg) coords))

+(def opposite
+  {:red :blue
+   :blue :red})
+
 (def light-colors
   {:red :pink
    :blue :lightblue})
@@ -60,7 +64,7 @@
 (defn move-marble [component color from to]
   (update-state component
                 #(-> % (n/move-ball color from to)
-                     (assoc :event [:marble-moved color]))))
+                     (assoc :event [:turn-began (opposite color)]))))

 (defn draw-valid-marble-moves [component state]
   (let [[type & event-data] (:event state)]


adding (running-states)

adding (running-states)

--- src/mount/core.cljc
+++ src/mount/core.cljc
@@ -181,6 +181,9 @@
           (with-ns ns name))
         v)))

+(defn running-states []
+  (keys @running))
+
 (defn- unvar-state [s]
   (->> s (drop 2) (apply str)))  ;; magic 2 is removing "#'" in state name


connection manager

connection manager

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -38,7 +38,6 @@
                           "hour" Calendar/HOUR "hours" Calendar/HOUR
                           "min" Calendar/MINUTE "mins" Calendar/MINUTE
                           "sec" Calendar/SECOND "secs" Calendar/SECOND})
-(def socket-timeout (Integer/parseInt (or (System/getenv "SOCK_TIMEOUT") "60000")))

 (defn- eval-date-exp [cal [num name]]
   (.add cal (date-fields name Calendar/DATE) num))
@@ -146,8 +145,7 @@
          (log/error e "failed coercing payload" payload)
          payload)))

-(def conn-mgr (delay (make-reusable-conn-manager
-                      {:insecure? true})))
+(def conn-mgr (delay (make-reusable-conn-manager {:insecure? true})))

 (defn mk-request [{:keys[test url verb headers params payload] :as  req}]
   (log/info "executing" test ": " verb " " url)
@@ -160,8 +158,7 @@
                          :body (if (string? payload) payload
                                    (and (seq payload) (json/generate-string payload)))
                          :insecure? true
-                         :connection-manager @conn-mgr
-                         :socket-timeout socket-timeout})
+                         :connection-manager @conn-mgr})
         (catch ExceptionInfo e
           (.getData e)))
       (#(update % :body coerce-payload (get-in % [:headers "Content-Type"])))))
@@ -234,7 +231,10 @@

 (defn prepare-test [{:keys[exp-headers exp-body options] :as test} opts]
   (try
-    (let [options (into #{} (for [opt (str/split options #"\s*,\s*")] (keyword (str/lower-case opt))))
+    (let [options (into {} (for [opt (str/split options #"\s*,\s*")
+                                 :let[[_ key _ _ value] (re-find #"\s*([^:=]+)((:|=)([^\s]+))?\s*" opt) ]
+                                 :when key]
+                             [(keyword (str/lower-case key)) (or value :true)]))
           exp-headers (str->map exp-headers #":")
           exp-body (if-not (str/blank? exp-body)
                      (coerce-payload (replace-opts exp-body opts) (or (get exp-headers "Content-Type") "")))]
@@ -267,17 +267,26 @@
 (defn exec-tests [tests opts]
   (let [opts (atom opts)
         skip-tag (:skip opts)
+        name-to-test (into {} (for [t tests] [(:test t) t]))
         p (promise)
         count-down (atom (count tests))
         test-agents (vec (map agent tests))
-        exec-test (fn[test]
+        exec-test (fn [test]
                     (if (:done test) test
-                        (let [deps (map #(nth test-agents %) (:deps test))]
+                        (let [{:keys [deps before after skip ignore]} test
+                              deps (map #(nth test-agents %) deps)]
                           (if (every? (comp :done deref) deps)
                             (assoc
                              (cond
-                               (and skip-tag (= skip-tag (-> test :options :skip))) (assoc test :skipped "skip requested")
-                               (every? (comp :success deref) deps) (exec-test-case test opts)
+                               (and skip-tag (= skip-tag skip)) (assoc test :skipped "skip requested")
+                               (true? ignore) (assoc test :skipped "ignored")
+                               (every? (comp :success deref) deps)
+                               (let [_ (if before (doseq [t (map name-to-test (str/split before #";"))]
+                                                    (if t (exec-test-case t opts))))
+                                     executed (exec-test-case test opts)
+                                     _ (if after (doseq [t (map name-to-test (str/split after #";"))]
+                                                 (if t (exec-test-case t opts))))]
+                                 executed)
                                :else (assoc test :skipped "dependents failed"))
                              :done true)
                             test))))]
@@ -344,24 +353,29 @@
                         nil)])])])
               out))))

-(defn -main
-  "Executes HTTP requests specified in the argument provided spreadsheet."
-  [& args]
-  (when-not (seq args)
-    (println "Usage: \njava -jar rester-0.1.0-beta2.jar <rest-test-cases.csv> [placeholder replacements as :placeholder-name value]
-or
-lein run -m rester.core <rest-test-cases.csv> [placeholder replacements as :placeholder-name value]")
-    (System/exit 1))
-
+(defn- to-opts [args]
+  (apply hash-map (map-indexed #(if (even? %1) (subs %2 1) %2) args)))
+
+(defn run-tests [args]
   (let [pool-size (Integer/parseInt (or (System/getProperty "thread-pool-size") "4"))]
     (log/info "thread pool size:" pool-size)
     (set-agent-send-executor! (Executors/newFixedThreadPool pool-size))
     (set-agent-send-off-executor! (Executors/newFixedThreadPool pool-size)))
   (try
-    (let [opts (apply hash-map (map-indexed #(if (even? %1) (subs %2 1) %2) (rest args)))
+    (let [opts (to-opts (rest args))
           tests-file (first args)
           results (-> tests-file (tests-from (opts "sheet")) (exec-tests opts) summarise-results)]
       ((juxt #(junit-report opts tests-file %) print-test-results) results)
       (System/exit (- (results :total 0) (results :success 0))))
     (finally
       (shutdown-agents))))
+
+(defn -main
+  "Executes HTTP requests specified in the argument provided spreadsheet."
+  [& args]
+  (when-not (seq args)
+    (println "Usage: \njava -jar rester-0.1.0-beta2.jar <command> <rest-test-cases.csv> [placeholder replacements as :placeholder-name value]
+or
+lein run -m rester.core <rest-test-cases.csv> [placeholder replacements as :placeholder-name value]")
+    (System/exit 1))
+  (run-tests args))


minor change.

minor change.

--- src/shuppet/ddb.clj
+++ src/shuppet/ddb.clj
@@ -140,7 +140,7 @@
           (cf/info (str "I've succesfully updated the dynamodb table "
                         (:TableName local)
                         " with :ProvisionedThroughput "
-                        (vec (:ProvisionedThroughput local)))))
+                        (:ProvisionedThroughput local))))
         (confirm-and-delete opts local remote)))))

 (defn- ensure-ddb


Add step* impls for s/every, s/map-of and s/every-kv

--- src/spectrace/trace.cljc
+++ src/spectrace/trace.cljc
@@ -73,13 +73,35 @@
                  :val (nth val segment))
           (update :in rest)))))

-(defmethod step* `s/coll-of [{:keys [val in] :as state} succ fail]
+(defn- step-for-every [{:keys [val in] :as state} succ fail]
   (with-cont succ fail
     (let [[key & in] in]
       (-> state
           (update :spec get-in [:args :spec])
           (assoc :val (nth val key))
           (assoc :in in)))))
+
+(defmethod step* `s/every [state succ fail]
+  (step-for-every state succ fail))
+
+(defmethod step* `s/coll-of [state succ fail]
+  (step-for-every state succ fail))
+
+(defn- step-for-every-kv [{:keys [path val in] :as state} succ fail]
+  (with-cont succ fail
+    (let [[segment & path] path
+          [key1 key2 & in] in]
+      (-> state
+          (update :spec get-in [:args (case segment 0 :kpred 1 :vpred)])
+          (assoc :path path
+                 :val (-> val (find key1) (nth key2))
+                 :in in)))))
+
+(defmethod step* `s/map-of [state succ fail]
+  (step-for-every-kv state succ fail))
+
+(defmethod step* `s/every-kv [state succ fail]
+  (step-for-every-kv state succ fail))

 (defmethod step* `s/cat [state succ fail]
   (step-by-key state succ fail :val-fn nth))


database: getting all rows in a table should return a set

--- src/subrosa/database.clj
+++ src/subrosa/database.clj
@@ -25,7 +25,7 @@

 (defn get*
   ([db table]
-     (vals (get-in db [table :data :id])))
+     (set (vals (get-in db [table :data :id]))))
   ([db table column value]
      (get-in db [table :data column value])))


Bugfix: `import-all-vars` needs to independently require

--- src/such/immigration.clj
+++ src/such/immigration.clj
@@ -12,9 +12,6 @@
             [such.symbols :as symbol]
             [such.vars :as var]
             [such.control-flow :as flow]))
-
-(ns/import-vars [potemkin.namespaces
-                 import-vars])

 (defmacro import-vars
   "Import named vars from the named namespaces and make them (1) public in this
@@ -45,9 +42,9 @@
 "
   [& ns-syms]
   (let [expand (fn [ns-sym]
+                 (require ns-sym)
                  (into (vector ns-sym) (keys (ns-publics ns-sym))))
         expanded (map #(list `import-vars (expand %)) ns-syms)]
-
     `(do ~@expanded)))

 (defmacro import-prefixed-vars


close connectin on socket exception

close connectin on socket exception

--- kafka-clj/src/kafka_clj/produce.clj
+++ kafka-clj/src/kafka_clj/produce.clj
@@ -232,10 +232,14 @@
   [{:keys [client]} conf]
   (let [buff (Unpooled/buffer)
         _ (do (with-size buff write-metadata-request conf))]
-    (tcp/write! client buff :flush true)))
-
-
-(defn metadata-request-producer
+    (try
+      (tcp/write! client buff :flush true)
+      (catch SocketException so (do
+                                  (tcp/close! client)
+                                  (throw so))))))
+
+(defn metadata-request
+  -producer
   "Returns a producer with a metadata-response-decoder set"
   [host port conf]
   (if (not host)


Clean up `db-client*` fn, add provider change fallback (joelittlejohn)

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -68,7 +68,9 @@
              ResourceInUseException
              ResourceNotFoundException]
             com.amazonaws.ClientConfiguration
+            com.amazonaws.auth.AWSCredentials
             com.amazonaws.auth.BasicAWSCredentials
+            com.amazonaws.auth.DefaultAWSCredentialsProviderChain
             com.amazonaws.services.dynamodbv2.AmazonDynamoDBClient
             java.nio.ByteBuffer))

@@ -79,20 +81,32 @@
 ;;;; Connections

 (def ^:private db-client*
-  "Returns a new AmazonDynamoDBClient instance for the supplied IAM credentials."
+  "Returns a new AmazonDynamoDBClient instance for the supplied client opts:
+    (db-client* {:access-key \"<AWS_DYNAMODB_ACCESS_KEY>\"
+                 :secret-key \"<AWS_DYNAMODB_SECRET_KEY>\"}),
+    (db-client* {:creds my-AWSCredentials-instance}),
+    etc."
   (memoize
-   (fn [{:keys [credentials access-key secret-key endpoint proxy-host proxy-port
-               conn-timeout max-conns max-error-retry socket-timeout] :as creds}]
-     (if (empty? creds) (AmazonDynamoDBClient.) ; Use credentials provider chain
-       (let [aws-creds     (or credentials ; Use explicit, pre-constructed creds
-                               (BasicAWSCredentials. access-key secret-key))
-             client-config (doto-cond [g (ClientConfiguration.)]
-                             proxy-host      (.setProxyHost         g)
-                             proxy-port      (.setProxyPort         g)
-                             conn-timeout    (.setConnectionTimeout g)
-                             max-conns       (.setMaxConnections    g)
-                             max-error-retry (.setMaxErrorRetry     g)
-                             socket-timeout  (.setSocketTimeout     g))]
+   (fn [{:keys [creds access-key secret-key endpoint proxy-host proxy-port
+               conn-timeout max-conns max-error-retry socket-timeout]
+        :as client-opts}]
+     (if (empty? client-opts) (AmazonDynamoDBClient.) ; Default client
+       (let [creds (or creds (:credentials client-opts)) ; Deprecated opt
+             _ (assert (or (nil? creds) (instance? AWSCredentials creds)))
+             aws-creds ; Actual AWSCredentials instance
+             (cond
+              creds      creds ; Given explicit AWSCredentials
+              access-key (BasicAWSCredentials. access-key secret-key)
+              :else      (DefaultAWSCredentialsProviderChain.))
+
+             client-config
+             (doto-cond [g (ClientConfiguration.)]
+               proxy-host      (.setProxyHost         g)
+               proxy-port      (.setProxyPort         g)
+               conn-timeout    (.setConnectionTimeout g)
+               max-conns       (.setMaxConnections    g)
+               max-error-retry (.setMaxErrorRetry     g)
+               socket-timeout  (.setSocketTimeout     g))]
          (doto-cond [g (AmazonDynamoDBClient. aws-creds client-config)]
            endpoint (.setEndpoint g)))))))


Detect interface parse errors and abort

Detect interface parse errors and abort

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/build/interface.clj
+++ src/obcc/build/interface.clj
@@ -20,6 +20,7 @@
             [clojure.set :as set]
             [clojure.walk :as walk]
             [clojure.zip :as zip]
+            [clojure.pprint :refer :all]
             [instaparse.core :as insta]
             [obcc.ast :as ast]
             [obcc.util :as util])
@@ -28,7 +29,12 @@
 (def grammar (insta/parser (io/resource "parsers/interface/grammar.bnf")
                            :auto-whitespace (insta/parser (io/resource "parsers/interface/skip.bnf"))))

-(defn parse [intf] (->> intf grammar zip/vector-zip))
+(defn parse [intf]
+  (let [result (grammar intf)]
+    (if (insta/failure? result)
+      (let [{:keys [line column text]} result]
+        (util/abort -1 (str "could not parse \"" text "\": line=" line " column=" column)))
+      (zip/vector-zip result))))

 ;;-----------------------------------------------------------------
 ;; retrieve all "provided" interfaces, adding the implicit


Add some missing update props to the update SQS trigger.

--- src/oc/storage/lib/email.clj
+++ src/oc/storage/lib/email.clj
@@ -11,7 +11,10 @@
    :note schema/Str
    :reply-to (schema/maybe schema/Str)
    :org-slug schema/Str
+   :org-name schema/Str
+   :logo-url (schema/maybe schema/Str)
    :origin-url schema/Str
+   :currency schema/Str
    :entries [common-res/UpdateEntry]})

 (defn ->trigger [org-slug update origin-url user]
@@ -21,6 +24,9 @@
    :reply-to (:email user)
    :org-slug org-slug
    :origin-url origin-url
+   :org-name (:org-name update)
+   :logo-url (:logo-url update)
+   :currency (:currency update)
    :entries (:entries update)})

 (defn send-trigger! [trigger]


BackoffIdleStrategy was moved into Agrona.

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -12,7 +12,7 @@
              [uk.co.real_logic.agrona CloseHelper]
              [uk.co.real_logic.aeron.driver MediaDriver]
              [uk.co.real_logic.aeron.common.concurrent.logbuffer DataHandler]
-             [uk.co.real_logic.aeron.common BackoffIdleStrategy]
+             [uk.co.real_logic.agrona.concurrent BackoffIdleStrategy]
              [java.util.function Consumer]
              [java.util.concurrent TimeUnit]))


use binary semaphore to isolate concurrent reinit half-open-retry-resolver (circuit breaker)

--- src/preflex/core.clj
+++ src/preflex/core.clj
@@ -336,7 +336,9 @@
                                             ))
           v-state (volatile! (init-fn))
           ^Semaphore
-          bi-sema (Semaphore. 1 false)  ; binary semaphore
+          reinit-lock (Semaphore. 1 false)  ; binary semaphore
+          ^Semaphore
+          retry-lock  (Semaphore. 1 false)  ; binary semaphore
           h-shift (fn [^long ts]
                     (vswap! v-state assoc
                       :open-elapsed? true
@@ -345,11 +347,15 @@
                     true)]
       (reify
         clojure.lang.IDeref (deref   [_] @v-state)
-        t/IReinitializable  (reinit! [_] (locking v-state
-                                           (vreset! v-state (init-fn))))
-        t/IRetryResolver    (retry?  [_] (if (.tryAcquire bi-sema)
+        t/IReinitializable  (reinit! [_] (when (.tryAcquire reinit-lock)  ; consider concurrent re-init idempotent
                                            (try
-                                             (locking v-state
+                                             (locking v-state  ; lock against retry-test (see `retry?`)
+                                               (vreset! v-state (init-fn)))
+                                             (finally
+                                               (.release reinit-lock)))))
+        t/IRetryResolver    (retry?  [_] (if (.tryAcquire retry-lock)  ; only one retry allowed, so serial test is OK
+                                           (try
+                                             (locking v-state  ; lock against re-init (see `reinit!`)
                                                (let [^RetryState state @v-state
                                                      ts (now-finder)]
                                                  (if (:open-elapsed? state)
@@ -368,7 +374,7 @@
                                                      (h-shift ts)  ; shift to half-open and return true
                                                      false))))
                                              (finally
-                                               (.release bi-sema)))
+                                               (.release retry-lock)))
                                            ;; could not obtain soft-lock, another thread may be working, so disengage
                                            false))))))


Added predicate to spec to check if user-id->rate vector contains unique user-ids.

--- src/time_tracker/invoices/spec.clj
+++ src/time_tracker/invoices/spec.clj
@@ -10,7 +10,15 @@
 (s/def ::rate ::core-spec/money-val)
 (s/def ::user-id ::users-spec/id)
 (s/def ::user-id->rate-map (s/keys :req-un [::user-id ::rate]))
-(s/def ::user-id->rate (s/coll-of ::user-id->rate-map))
+
+(defn- user-id->rate-pred
+  [user-id->rate]
+  (let [ids        (mapv :user-id user-id->rate)
+        unique-ids (set ids)]
+    (= (count ids) (count unique-ids))))
+
+(s/def ::user-id->rate (s/and (s/coll-of ::user-id->rate-map :min-count 1)
+                              user-id->rate-pred))

 (s/def ::user-hours-row
   (s/keys :req-un [::users-spec/id ::hours ::rate]))


Add error checking to ensure slide-direction is bounded

--- src/tile_game/board.cljc
+++ src/tile_game/board.cljc
@@ -61,10 +61,11 @@
       board)))

 (defn slide-direction [board direction]
-  (->> (dir-delta direction)
-       (coords/add (tile->coords board 0))
-       (coords->tile board)
-       (slide-tile board)))
+  (let [current-pos (tile->coords board 0)
+        new-pos (coords/add (dir-delta direction) current-pos)]
+    (if (bounded-coords? board new-pos)
+      (slide-tile board (coords->tile board new-pos))
+      board)))

 (defn slide [board arg]
   (if (contains? dir-delta arg)


Make multiple shader loading more idiomatic

--- src/petulant_life/shader.clj
+++ src/petulant_life/shader.clj
@@ -38,17 +38,11 @@

 ;; Attaching a bunch of shaders to a shader program if they exist.
 (defn attach-if-exists [shader-program shaders]
-  (if (get shaders :vert)
-    (GL20/glAttachShader shader-program (get shaders :vert))
-    nil)
-
-  (if (get shaders :frag)
-    (GL20/glAttachShader shader-program (get shaders :frag))
-    nil)
-
-  (if (get shaders :geom)
-    (GL20/glAttachShader shader-program (get shaders :geom))
-    nil))
+  (dorun
+   (map (fn [[key shader]]
+          (when shader
+            (GL20/glAttachShader shader-program shader)))
+        shaders)))

 ;; Loading a whole shader program.
 (defn load-shader-program-raw [src-path]


Fix conditional that throws exception

Fix conditional that throws exception

--- src/play_clj/g2d_physics.clj
+++ src/play_clj/g2d_physics.clj
@@ -184,7 +184,7 @@
 (defmacro circle-shape
   "Returns a [CircleShape](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/CircleShape.html)."
   [& options]
-  (when-not (keyword? (first options))
+  (when (some-> (first options) keyword? not)
     (throw (Exception. "Replace (circle-shape radius) with (circle-shape :set-radius radius :set-position (vector-2 radius radius))")))
   `(u/calls! ^CircleShape (circle-shape*) ~@options))


Add benchmarking of vt/parse

Add benchmarking of vt/parse

--- dev/cljs/asciinema/player/dev.cljs
+++ dev/cljs/asciinema/player/dev.cljs
@@ -142,9 +142,24 @@
           v1-url (str "/asciicasts/" asciicast-filename)]
       (def v1-json (<! (fetch-json v1-url)))))

+  ;; benchmark vt/feed
+
   (go
     (let [v1-frames (v1/build-v1-frames v1-json)]
       (time (last v1-frames))))
+
+  ;; benchmark vt/parse
+
+  (go
+    (let [data (apply str (->> (get v1-json :stdout) (map second)))
+          codes (mapv #(.codePointAt data %) (range (count data)))]
+      (time
+       (loop [state :ground
+              codes codes]
+         (if-let [input (first codes)]
+           (let [[new-state _] (vt/parse state (first codes))]
+             (recur new-state (rest codes)))
+           state)))))

 )


Remove debugging code that snuck in

Remove debugging code that snuck in

--- src/simple_check/generators.clj
+++ src/simple_check/generators.clj
@@ -314,10 +314,8 @@
       (gen/elements [:foo :bar :baz])
   "
   [coll]
-  (if (coll? coll)
-    (gen-bind (choose 0 (dec (count coll)))
-              #(gen-pure (rose-fmap (partial nth coll) %)))
-    (println coll)))
+  (gen-bind (choose 0 (dec (count coll)))
+            #(gen-pure (rose-fmap (partial nth coll) %))))

 (defn such-that
   "Create a generator that generates values from `gen` that satisfy predicate


Dot rendering (useful for visual debugging)

--- src/wireframes/renderer/bitmap.clj
+++ src/wireframes/renderer/bitmap.clj
@@ -4,23 +4,33 @@
             [wireframes.shape-loader :as sl]
             [wireframes.shapes.platonic-solids :as ps])
   (:import [java.awt.image BufferedImage]
-           [java.awt.geom AffineTransform GeneralPath]
+           [java.awt.geom AffineTransform GeneralPath Ellipse2D$Double]
            [java.awt Color Graphics2D RenderingHints BasicStroke GraphicsEnvironment]
            [javax.imageio ImageIO]))

+(defn- draw-dot [^Graphics2D g2d [^Double x ^Double y] size]
+  (.fill g2d (Ellipse2D$Double. (- x (/ size 2)) (- y (/ size 2)) size size)))
+
+(defn- draw-line [^GeneralPath path [^Double ax ^Double ay] [^Double bx ^Double by]]
+  (doto path
+    (.moveTo ax ay)
+    (.lineTo bx by)))
+
 (defn- draw-shape [^Graphics2D g2d focal-length transform shape]
-  (let [points (mapv
+  (let [path (GeneralPath.)
+        points (mapv
                  (comp
                    (t/perspective focal-length)
                    (partial t/transform-point transform))
-                 (:points shape))
-        path (GeneralPath.)]
-    (doseq [[idx1 idx2] (:lines shape)
-            :let [[ax ay] (points idx1)
-                  [bx by] (points idx2)]]
-      (doto path
-        (.moveTo ax ay)
-        (.lineTo bx by)))
+                 (:points shape))]
+
+;    (.setColor g2d Color/RED)
+;    (doseq [[idx1 idx2] (:lines shape)]
+;      (draw-dot g2d (points idx1) 0.008))
+
+    (.setColor g2d Color/BLACK)
+    (doseq [[idx1 idx2] (:lines shape)]
+      (draw-line path (points idx1) (points idx2)))
     (.draw g2d path)))

 (defn create-image [w h]
@@ -63,7 +73,7 @@
         (t/translate 0 -1 40))
       (sl/load-shape "resources/newell-teapot/teapot" 16)
       [600 600])
-    "teapot.png")
+    "doc/gallery/teapot.png")

   (write-png
     (->img


Fix spacing.

Fix spacing.

--- test/afterglow/effects_test.clj
+++ test/afterglow/effects_test.clj
@@ -74,7 +74,7 @@
       (is (util/float= 1.0 (:value (fade-assignment from nil 0.9 @test-show @test-snapshot))))
       (is (= :channel (:kind (fade-assignment from nil 0.9 @test-show @test-snapshot))))
       (is (util/float= 0.4 (:value (fade-assignment nil to 0.02 @test-show @test-snapshot))))
-      (is (= :channel(:kind (fade-assignment nil to 0.02 @test-show @test-snapshot)))))))
+      (is (= :channel (:kind (fade-assignment nil to 0.02 @test-show @test-snapshot)))))))

 (deftest test-fade-function
   (testing "Fading a function assigner scales the value only if active on both sides"
@@ -96,7 +96,7 @@
       (is (nil? (:value (fade-assignment from nil 0.9 @test-show @test-snapshot))))
       (is (= :function (:kind (fade-assignment from nil 0.9 @test-show @test-snapshot))))
       (is (nil? (:value (fade-assignment nil to 0.02 @test-show @test-snapshot))))
-      (is (= :function(:kind (fade-assignment nil to 0.02 @test-show @test-snapshot)))))))
+      (is (= :function (:kind (fade-assignment nil to 0.02 @test-show @test-snapshot)))))))

 (deftest test-fade-color
   (testing "Fading a color assigner blends the colors"
@@ -143,7 +143,7 @@
       (is (= :direction (:kind (fade-assignment from nil 0.9 @test-show @test-snapshot))))
       (is (= (Vector3d. 0.020407013973550377, 0.002759527209833684, -0.9997879469118747)
              (:value (fade-assignment nil to 0.02 @test-show @test-snapshot))))
-      (is (= :direction(:kind (fade-assignment nil to 0.02 @test-show @test-snapshot)))))))
+      (is (= :direction (:kind (fade-assignment nil to 0.02 @test-show @test-snapshot)))))))

 (deftest test-fade-aim
   (testing "Fading an aim assigner moves between the aim points"
@@ -169,4 +169,4 @@
       (is (= :aim (:kind (fade-assignment from nil 0.9 @test-show @test-snapshot))))
       (is (= (Point3d. 1.1152480000000002, 1.310865488969734, -1.0580843683682586)
              (:value (fade-assignment nil to 0.02 @test-show @test-snapshot))))
-      (is (= :aim(:kind (fade-assignment nil to 0.02 @test-show @test-snapshot)))))))
+      (is (= :aim (:kind (fade-assignment nil to 0.02 @test-show @test-snapshot)))))))


Improve comments.  And debug output

Improve comments.  And debug output

--- src/re_frame/middleware.cljs
+++ src/re_frame/middleware.cljs
@@ -32,11 +32,12 @@
       (if (nil? new-db)
         (warn "re-frame: your pure handler returned nil. It should return the new db.")
         (if-not (identical? orig-db new-db)
-           (reset! app-db new-db))))))
+          (reset! app-db new-db))))))

 (defn debug
-  "Middleware which dispays each event (to console) along with a diff on the db, before vs after"
+  "Middleware which logs (console) debug information for each event.
+  Includes a clojure.data/diff of the db, before vs after, showing changes."
   [handler]
   (fn new-handler
     [db v]
@@ -45,8 +46,8 @@
     (group "event: " v)
     (let [new-db  (handler db v)
           diff    (data/diff db new-db)]
-      (log  "before: " (first diff))
-      (log " after: " (second diff))
+      (log "only before: " (first diff))
+      (log " only after: " (second diff))
       (groupEnd)
       new-db)))

@@ -86,9 +87,10 @@

 (defn validate
-  "Middleware that applies a validation function to the db after the handler is finished.
-The validation function f, might assoc warnings and errors to the new state, created by the handler.
-By validation, I mean validation of what the user has entered, or the state they have taken the app too"
+  "Middleware factory which applies a given validation function \"f\" to db
+  after the handler is finished.
+  This validation function f, might further change db, by perhaps
+   assoc-ing warnings and errors into db. "
   [f]
   (fn middleware
     [handler]


add notes about additional tests

add notes about additional tests

--- test/clj_money/trading_test.clj
+++ test/clj_money/trading_test.clj
@@ -46,4 +46,8 @@
     (is (= "Purchase 100 shares of APPL at 10.000" (-> result :transaction :description)) "The transaction description describes the purchase")))

 ; Purchasing a commodity creates a price record
+; Purchasing a commodity creates a lot transaction record
 ; A new price causes the account value to change on the home page and in reports
+; Selling a commodity creates a price record
+; Selling a commodity updates a lot record (FILO updates the most recent, FIFO updates the oldest)
+; Selling a commodity creates a lot transaction record


experimenting with avoiding task name reuse

--- src/riak_mesos/scheduler.clj
+++ src/riak_mesos/scheduler.clj
@@ -33,10 +33,11 @@
                             (cond
                               (= (:task-state status) :task-staging) nil
                               (= (:task-state status) :task-starting) nil
-                              (= (:task-state status) :task-running)
-                              (swap! running conj (id-from-status status))
-                              true
-                              (swap! pending conj (id-from-status status)))))
+                              (= (:task-state status) :task-running) nil
+                              :else
+                              (do
+                                (swap! running disj (id-from-status status))
+                                (swap! pending conj (id-from-status status))))))
                         (catch Exception e
                           (.printStackTrace e)))))
       (resourceOffers [driver offers]
@@ -51,6 +52,7 @@
                                        (>= mem 200.0)
                                        (not (contains? @used-hosts (:hostname offer))))
                                 (do (swap! pending disj node)
+                                    (swap! running conj node)
                                     (swap! used-hosts conj (:hostname offer))
                                     (swap! slave-id->host+exec assoc (:slave-id offer) {:hostname (:hostname offer) :executor (str "riak-node-executor-" node)})
                                     (println "launching task for node" node "(offer)" offer)


Fix console output filtering fn on tests

--- test/reagenttest/utils.cljs
+++ test/reagenttest/utils.cljs
@@ -13,10 +13,10 @@
 (set! (.-error js/console)
       (fn [& [first-arg :as args]]
         (cond
-          (.startsWith first-arg "Warning: ReactDOM.render is no longer supported in React 18.")
+          (and (string? first-arg) (.startsWith first-arg "Warning: ReactDOM.render is no longer supported in React 18."))
           nil

-          (.startsWith first-arg "Warning: The current testing environment is not configured to support")
+          (and (string? first-arg) (.startsWith first-arg "Warning: The current testing environment is not configured to support"))
           nil

           :else


Fix atom logging in server handshake test (WIP)

The child fork! function gets a messaging io-handle, which has access to
a log atom, but not "the" log-state stored in the client state.

Switch to logging to that.

--- test/frereth_cp/server_test.clj
+++ test/frereth_cp/server_test.clj
@@ -70,55 +70,58 @@
 (defn handshake-client-child-spawner!
   "Spawn the client-child for the handshake test and initiate the fun"
   [ch
-   {log-state ::log/state
+   {log-state-atom ::log/state-atom
     logger ::log/logger
     :as io-handle}]
-  (let [log-state (log/debug log-state
-                             ::handshake-client-child-spawner!
-                             "Forking child process"
-                             {::now (System/currentTimeMillis)})
-        ;; Doing a req/rep sort of thing from server is honestly
-        ;; pretty boring. But it's easy to test.
-        ;; Assume the client reacts to server messages.
-        ;; Pull them off the network, shove them into this
-        ;; stream, and than have the handshake-client-cb
-        ;; cope with them.
-
-        log-state (if-not io-handle
-                    (log/warn log-state
-                              ::handshake-client-child-spawner!
-                              "Trying to spawn child with no io-handle")
-                    log-state)
-        log-state (log/flush-logs! logger log-state)]
-    (try
-      (strm/consume (partial handshake-client-cb
-                             (assoc io-handle
-                                    ::log/state
-                                    log-state))
-                    ch)
-      ;; Q: Worth converting this to something like an HTTP request
-      ;; that's too big to fit in a single packet?
-      ;; A: Well, I've really already done that in
-      ;; message-test/bigger-outbound
-      ;; All this *should* test would be whichever means I
-      ;; use on the server side to reassemble the bytes that
-      ;; were streamed in packets.
-      ;; Which is interesting from the standpoint of example
-      ;; usage, but not so much from this angle.
-
-      (let [helo (-> ::helo
-                     pr-str
-                     .getBytes)]
-        (msg/child->! io-handle helo))
-      (log/flush-logs! (log/debug log-state
-                                  ::handshake-client-child-spawner!
-                                  "Child HELO sent"
-                                  {::now (System/currentTimeMillis)}))
-      (catch Exception ex
-        (log/flush-logs! (log/exception log-state
-                                        ex
+  {:pre [io-handle]}
+  (when-not log-state-atom
+    (throw (ex-info "Missing log-state-atom"
+                    {::keys (keys io-handle)
+                     ::io-handle io-handle})))
+  (swap! log-state-atom #(log/debug %
+                                    ::handshake-client-child-spawner!
+                                    "Forking child process"
+                                    {::now (System/currentTimeMillis)}))
+  (swap! log-state-atom #(log/flush-logs! logger %))
+
+  ;; Doing a req/rep sort of thing from server is honestly
+  ;; pretty boring. But it's easy to test.
+  ;; Assume the client reacts to server messages.
+  ;; Pull them off the network, shove them into this
+  ;; stream, and than have the handshake-client-cb
+  ;; cope with them.
+  (try
+    (strm/consume (partial handshake-client-cb
+                           (assoc io-handle
+                                  ::log/state
+                                  @log-state-atom))
+                  ch)
+    ;; Q: Worth converting this to something like an HTTP request
+    ;; that's too big to fit in a single packet?
+    ;; A: Well, I've really already done that in
+    ;; message-test/bigger-outbound
+    ;; All this *should* test would be whichever means I
+    ;; use on the server side to reassemble the bytes that
+    ;; were streamed in packets.
+    ;; Which is interesting from the standpoint of example
+    ;; usage, but not so much from this angle.
+
+    (let [helo (-> ::helo
+                   pr-str
+                   .getBytes)]
+      (msg/child->! io-handle helo))
+    (swap! log-state-atom
+           #(log/flush-logs! (log/debug %
                                         ::handshake-client-child-spawner!
-                                        "Forking child failed"))))))
+                                        "Child HELO sent"
+                                        {::now (System/currentTimeMillis)})))
+    (catch Exception ex
+      (swap! log-state-atom
+             #(log/flush-logs! logger
+                               (log/exception %
+                                              ex
+                                              ::handshake-client-child-spawner!
+                                              "Forking child failed"))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Tests


add cert and dns for kibana

add cert and dns for kibana

--- src/terraboot/elasticsearch.clj
+++ src/terraboot/elasticsearch.clj
@@ -55,10 +55,14 @@
                                   :source_security_group_id (vpc-id-of "aws_security_group" "sends_gelf")}
                                  {:port 12201
                                   :protocol "udp"
-                                  :cidr_blocks ["52.29.162.148/32"
+                                  :cidr_blocks [(str (vpc-output-of "aws_eip" "public-a-nat" "public_ip") "/32")
+                                                (str (vpc-output-of "aws_eip" "public-b-nat" "public_ip") "/32")
+                                                "52.29.162.148/32"
                                                 "52.29.163.57/32"
                                                 "52.29.97.114/32"
-                                                "87.115.98.26/32"]}
+                                                "87.115.98.26/32"
+                                                "151.230.75.151/32" ; Tom Temp
+                                                ]}
                                  {:port 9200
                                   :protocol "tcp"
                                   :cidr_blocks [all-external]})
@@ -93,12 +97,16 @@
                                                     :target "HTTP:80/status"
                                                     :timeout 5
                                                     :interval 30}
+                                     :cert_name "112349508752725708607389286684892850272129-2016-06-13-kibana_mastodonc_net" ; This was obtained via Lets Encrypt
                                      :subnets (mapv #(id-of "aws_subnet" (stringify  vpc_name "-public-" %)) azs)
                                      :instances [(id-of "aws_instance" (vpc-unique "kibana"))]
                                      :sgs ["allow_outbound"
                                            "allow_external_http_https"
                                            (vpc-unique "elb-kibana")
                                            ]})
+
+             (route53_record "kibana" {:type "CNAME"
+                                       :records [(output-of "aws_elb" "kibana" "dns_name")]})

              (vpc-security-group "elb-kibana" {})
              (vpc-security-group "allow-elb-kibana" {}


CMR-2201: Temporary code to find source of errors in CI.

--- access-control-app/int_test/cmr/access_control/int_test/fixtures.clj
+++ access-control-app/int_test/cmr/access_control/int_test/fixtures.clj
@@ -51,35 +51,36 @@
    are running these fixtures won't do anything. If it isn't running these fixtures will start up the
    applications and the test will work."
   []
-  (let [queue-broker (queue-broker-wrapper/create-queue-broker-wrapper (create-memory-queue-broker))]
-    (ct/join-fixtures
-      [elastic-test-util/run-elastic-fixture
-       (common-client-test-util/run-app-fixture
-         conn-context
-         :access-control
-         (assoc (system/create-system) :queue-broker queue-broker)
-         system/start
-         system/stop)
-
-       ;; Create a side API that will allow waiting for the queue broker terminal states to be achieved.
-       (common-client-test-util/side-api-fixture
-         (fn [_]
-           (qb-side-api/build-routes queue-broker))
-         nil)
-
-       (common-client-test-util/run-app-fixture
-         conn-context
-         :echo-rest
-         (mock-echo-system/create-system)
-         mock-echo-system/start
-         mock-echo-system/stop)
-
-       (common-client-test-util/run-app-fixture
-         conn-context
-         :metadata-db
-         (assoc (create-mdb-system) :queue-broker queue-broker)
-         mdb-system/start
-         mdb-system/stop)])))
+  (fn [f] (println "I'm doing nothing except continuing") (f) )  )
+  ; (let [queue-broker (queue-broker-wrapper/create-queue-broker-wrapper (create-memory-queue-broker))]
+  ;   (ct/join-fixtures
+  ;     [elastic-test-util/run-elastic-fixture
+  ;      (common-client-test-util/run-app-fixture
+  ;        conn-context
+  ;        :access-control
+  ;        (assoc (system/create-system) :queue-broker queue-broker)
+  ;        system/start
+  ;        system/stop)
+  ;
+  ;      ;; Create a side API that will allow waiting for the queue broker terminal states to be achieved.
+  ;      (common-client-test-util/side-api-fixture
+  ;        (fn [_]
+  ;          (qb-side-api/build-routes queue-broker))
+  ;        nil)
+  ;
+  ;      (common-client-test-util/run-app-fixture
+  ;        conn-context
+  ;        :echo-rest
+  ;        (mock-echo-system/create-system)
+  ;        mock-echo-system/start
+  ;        mock-echo-system/stop)
+  ;
+  ;      (common-client-test-util/run-app-fixture
+  ;        conn-context
+  ;        :metadata-db
+  ;        (assoc (create-mdb-system) :queue-broker queue-broker)
+  ;        mdb-system/start
+  ;        mdb-system/stop)])))

 (defn reset-fixture
   "Test fixture that resets the application before each test and creates providers and users listed.


format timestamps with milliseconds

format timestamps with milliseconds

--- ingestion-api/src/ingestion_api/backend_kafka.clj
+++ ingestion-api/src/ingestion_api/backend_kafka.clj
@@ -20,6 +20,15 @@
    "producer.type"            "async"
    "message.send.max.retries" "5" })

+
+(defn- to-json
+  "Encodes `data` into json"
+  [data]
+  (json/generate-string
+   data
+   {:pretty false
+    :date-format "yyyy-MM-dd'T'HH:mm:ss.SSS'Z'"}))
+
 ;;
 ;;  Kafka backend sends the events into a Kafka topic as single
 ;;  json lines.
@@ -29,7 +38,9 @@

   (send [_ events]
     (->> events
-         (map (juxt (constantly topic) :sourceId  #(json/generate-string % {:pretty false})))
+         (map (juxt (constantly topic)
+                    :sourceId
+                    to-json))
          (map (fn [[topic key message]] (kp/message topic key message)))
          (kp/send-messages producer))))


Tweaked to start the web context

Tweaked to start the web context

--- integration-tests/apps/ring/noir-app/immutant.clj
+++ integration-tests/apps/ring/noir-app/immutant.clj
@@ -1,31 +1,6 @@
 (ns noir-app.init
-  ;(:use noir-app.core)
-  (:require [immutant.messaging :as messaging]
-            [immutant.web :as web]))
+  (:require [immutant.web :as web]
+            [noir.server :as server]))

-;; This file will be loaded when the application is deployed to Immutant, and
-;; can be used to start services your app needs. Examples:
-
-;; Web endpoints need a context-path and ring handler function. The context
-;; path given here is a sub-path to the global context-path for the app
-;; if any.
-
-; (web/start "/" my-ring-handler)
-; (web/start "/foo" a-different-ring-handler)
-
-;; Web endpoints can be stopped from anywhere in your code with:
-;; (web/stop "/")
-;; This is optional - any endpoints you leave up will be stopped when your
-;; app is undeployed.
-
-;; Messaging allows for starting (and stopping) destinations (queues & topics)
-;; and listening for messages on a destination.
-
-; (messaging/start "/queue/a-queue")
-; (messaging/listen "/queue/a-queue" #(println "received: " %))
-
-;; Destinations can be stopped with:
-;; (messaging/stop "/queue/a-queue")
-;; This is optional - any destinations you leave up will be stopped when your
-;; app is undeployed.
-
+(server/load-views (str (web/src-dir) "/noir_app/views"))
+(web/start "/" (server/gen-handler {:mode :dev :ns 'noir-app}))


sql-input-extend refined

sql-input-extend refined

--- configuration/sql-input-extent.clj
+++ configuration/sql-input-extent.clj
@@ -1,31 +1,14 @@
-(foreach [:accesspolicy]
-  (add-instance :AcessPolicy
-    (mapping-pk [:Id] :Id)))
-;ASSOC ACCESSPOLICY: ENDPOINT  (column "endpointId" :endpointId :notnull))
-
 (foreach [:activity]
   (add-isntance :Activity
     (mapping-pk [:Id] :ID)
     (mapping [:Name] :Name)
     (mapping [:CreationTime] :CreationTime)
-    (mapping [:Validity] :Validity)))
-;ASSOC ACTIIVITY: ENDPOINT  (column "endpointId" :endpointId)
-;ASSOC ACTIIVITY: USERDOMAIN (column "userDomainId" :userDomainId)
-;ASSOC ACTIIVITY: RESOURCE (column "resourceId" :resourceId))
-;ASSOC ACTIIVITY: SHARE (column "shareId" :shareId)
-;ASSOC ACTIIVITY: ACTIVITY (table "activityactivity" :activityactivity  (column "activityId2" :activityId2 :pk :notnull)  (column "activityId1" :activityId1 :pk :notnull))
-
-(foreach [:admindomain]
-  (add-instance :AdminDomain
-    (mapping-pk [:Id] :ID)
-    (mapping [:Distributed] :Distributed)
-    (mapping [:domain :Name] :Name)
-    (mapping [:domain :CreationTime] :CreationTime)
-    (mapping [:domain :Validity] :Validity)
-    (mapping [:domain :Description] :Description)))
-;ASSOC ADMINDOMAIN: ADMINDOMAIN   (column "adminDomainId" :adminDomainId)
-;ASSOC ADMINDOMAIN: LOCATION  (table "domain" :domain (column "locationId" :locationId))
-;ASSOC ADMINDOMAIN: CONTACT  (table "domaincontact" :domaincontact   (column "domainId" :domainId :pk :notnull)  (column "contactId" :contactId :pk :notnull))
+    (mapping [:Validity] :Validity))
+  (add-relation :activity_fk_EndpointId)
+  (add-relation :activity_fk_ResourceId)
+  (add-relation :activity_fk_ShareId)
+  (add-relation :activity_fk_UserDomainId))
+;TODO ASSOC ACTIIVITY: ACTIVITY (table "activityactivity" :activityactivity  (column "activityId2" :activityId2 :pk :notnull)  (column "activityId1" :activityId1 :pk :notnull))

 (foreach [:contact]
   (add-instance :Contact
@@ -54,8 +37,9 @@
     (mapping [:StartTime] :StartTime)
     (mapping [:IssuerCA] :IssuerCA)
     (mapping [:DowntimeAnnounce] :DowntimeAnnounce)
-    (mapping [:DowntimeInfo] :DowntimeInfo)))
-;ASSOC ENDPOINT: SERVICE   (column "serviceId" :serviceId :notnull)
+    (mapping [:DowntimeInfo] :DowntimeInfo))
+  (add-relation :endpoint_fk_ServiceId))
+

 (foreach [:location]
   (add-instance :Location
@@ -76,18 +60,21 @@
     (mapping [:CreationTime] :CreationTime)
     (mapping [:Validity] :Validity)
     (mapping [:ProductName] :ProductName)
-    (mapping [:ProductVersion] :ProductVersion)))
-;ASSOC MANAGER: SERVICE   (column "serviceId" :serviceId :notnull)
-;ASSOC MANAGER: MANAGER   (column "managerId" :managerId :notnull)
+    (mapping [:ProductVersion] :ProductVersion))
+  (add-relation [:managerId :Id]); ?????
+  (add-relation :manager_fk_ServiceId))
+;TODO ASSOC MANAGER: MANAGER   (column "managerId" :managerId :notnull) // IS IT NOT RELATION!?
+
+

 (foreach [:resource]
   (add-instance :Resource
     (mapping-pk [:Id] :ID)
     (mapping [:Name] :Name)
     (mapping [:CreationTime] :CreationTime)
-    (mapping [:Validity] :Validity)))
-;ASSOC RESOURCE: MANAGER   (column "managerId" :managerId :notnull)
-;ASSOC RESOURCE: SHARE (table "resourceshare" :resourceshare   (column "resourceId" :resourceId :pk :notnull) (column "shareId" :shareId :pk :notnull))
+    (mapping [:Validity] :Validity))
+  (add-relation :resource_fk_ManagerId))
+;TODO ASSOC RESOURCE: SHARE (table "resourceshare" :resourceshare   (column "resourceId" :resourceId :pk :notnull) (column "shareId" :shareId :pk :notnull))

 (foreach [:service]
   (add-instance :Service
@@ -97,11 +84,12 @@
     (mapping [:Validity] :Validity)
     (mapping [:Type] :Type)
     (mapping [:QualityLevel] :QualityLevel)
-    (mapping [:Complexity] :Complexity)))
-;ASSOC SERVICE: LOCATION   (column "locationId" :locationId)
-;ASSOC SERVICE: ADMINDOMAIN   (column "adminDomainId" :adminDomainId)
-;ASSOC SERVICE: CONTACT   (table "serviceservice" :serviceservice (column "serviceId2" :serviceId2 :pk :notnull) (column "contactId" :contactId :pk :notnull))
-;ASSOC SERVICE: SERVICE (table "serviceservice" :serviceservice (column "serviceId2" :serviceId2 :pk :notnull) (column "serviceId1" :serviceId1 :pk :notnull))
+    (mapping [:Complexity] :Complexity))
+  (add-relation :service_fk_LocationId)
+  (add-relation :service_fk_AdminDomainId))
+;TODO ASSOC SERVICE: CONTACT   (table "serviceservice" :serviceservice (column "serviceId2" :serviceId2 :pk :notnull) (column "contactId" :contactId :pk :notnull))
+;TODO ASSOC SERVICE: SERVICE (table "serviceservice" :serviceservice (column "serviceId2" :serviceId2 :pk :notnull) (column "serviceId1" :serviceId1 :pk :notnull))
+

 (foreach [:share]
   (add-instance :Share
@@ -109,41 +97,53 @@
     (mapping [:Name] :Name)
     (mapping [:CreationTime] :CreationTime)
     (mapping [:Validity] :Validity)
-    (mapping [:Description] :Description)))
-;ASSOC SHARE: SERVICE   (column "serviceId" :serviceId :notnull)
-;ASSOC SHARE: ENDPOINT (table "shareendpoint" :shareendpoint (column "shareId" :shareId :pk :notnull) (column "endpointId" :endpointId :pk :notnull))
+    (mapping [:Description] :Description))
+  (add-relation :share_fk_ServiceId))
+;TODO ASSOC SHARE: ENDPOINT (table "shareendpoint" :shareendpoint (column "shareId" :shareId :pk :notnull) (column "endpointId" :endpointId :pk :notnull))

-(table "domain" :domain
-  (column "Id" :Id :pk :notnull)
-  (column "Name" :Name)
-  (column "CreationTime" :CreationTime :notnull)
-  (column "Validity" :Validity)
-  (column "Description" :Description)
-  (column "locationId" :locationId))
-
-(table "userdomain" :userdomain
-  (column "Id" :Id :pk :notnull)
-  (column "Level" :Level)
-  (column "userDomainId" :userDomainId))
-
-(table "userdomainpolicy" :userdomainpolicy
-  (column "userDomainId" :userDomainId :pk :notnull)
-  (column "policyId" :policyId :pk :notnull))
+(foreach [:admindomain]
+  (add-instance :AdminDomain (mapping-pk [:Id] :ID)
+    (mapping [:domain :Description] :Description))
+  (add-relation :adminDomain_fk_AdminDomainId))
+;TODO ASSOC ADMINDOMAIN: ADMINDOMAIN   (column "adminDomainId" :adminDomainId)

+(foreach [:domain]
+  (add-instance :Domain
+    (mapping-pk [:Id] :ID)
+    (mapping [:Name] :Name)
+    (mapping [:CreationTime] :CreationTime)
+    (mapping [:Validity] :Validity)
+    (mapping [:Description] :Description))
+  (add-relation :domain_fk_LocationId))
+;TODO ASSOC DOMAIN: CONTACT  (table "domaincontact" :domaincontact   (column "domainId" :domainId :pk :notnull)  (column "contactId" :contactId :pk :notnull))

-;????????????????????????????
-(table "mappingpolicy" :mappingpolicy
-  (column "Id" :Id :pk :notnull)
-  (column "Name" :Name)
-  (column "CreationTime" :CreationTime :notnull)
-  (column "Validity" :Validity)
-  (column "Scheme" :Scheme :notnull)
-  (column "shareId" :shareId :notnull))
+(foreach [:userdomain]
+  (add-instance :UserDomain
+    (mapping-pk [:Id] :ID)
+    (mapping [:Level] :Level))
+  (add-relation :userDomain_fk_UserDomainId))
+;TODO ASSOC USERDOMAIN: POLICY (table "userdomainpolicy" :userdomainpolicy (column "userDomainId" :userDomainId :pk :notnull) (column "policyId" :policyId :pk :notnull))

-(table "policy" :policy
-  (column "Id" :Id :pk :notnull)
-  (column "Name" :Name)
-  (column "CreationTime" :CreationTime :notnull)
-  (column "Validity" :Validity)
-  (column "Scheme" :Scheme :notnull))+(foreach [:policy]
+  (add-instance :Policy
+    (mapping-pk [:Id] :ID)
+    (mapping [:Name] :Name)
+    (mapping [:CreationTime] :CreationTime)
+    (mapping [:Validity] :Validity)
+    (mapping [:Scheme] :Scheme)))
+
+
+(foreach [:mappingpolicy]
+  (add-instance :MappingPolicy
+    (mapping-pk [:Id] :ID)
+    (mapping [:Name] :Name)
+    (mapping [:CreationTime] :CreationTime)
+    (mapping [:Validity] :Validity)
+    (mapping [:Scheme] :Scheme))
+  (add-relation :mappingPolicy_fk_ShareId))
+
+(foreach [:accesspolicy]
+  (add-instance :AcessPolicy
+    (mapping-pk [:Id] :Id))
+  (add-relation :accessPolicy_fk_EndpointId))


CMR-1239: Add timings for individual commands within database migration

--- metadata-db-app/src/config/mdb_migrate_helper.clj
+++ metadata-db-app/src/config/mdb_migrate_helper.clj
@@ -8,7 +8,11 @@
   "Applies the sql update"
   [stmt-str]
   (println "Applying update" stmt-str)
-  (j/db-do-commands (config/db) stmt-str))
+  (let [start-time (System/currentTimeMillis)]
+    (j/db-do-commands (config/db) stmt-str)
+    (println (format "Finished update %s in [%s] ms."
+                     stmt-str
+                     (- (System/currentTimeMillis) start-time)))))

 (defn get-provider-ids
   "Gets a list of the provider ids in the database. Primarily for enabling migrations of existing


Move spec def to top of the projects services ns.

--- src/uxbox/services/projects.clj
+++ src/uxbox/services/projects.clj
@@ -19,7 +19,7 @@
             [uxbox.util.blob :as blob]
             [uxbox.util.uuid :as uuid]))

-
+(s/def ::token string?)
 (s/def ::data string?)
 (s/def ::user uuid?)
 (s/def ::project uuid?)
@@ -115,8 +115,6 @@
       (let [pages (vec (pages/get-pages-for-project conn id))]
         (assoc project :pages pages)))))

-(s/def ::token string?)
-
 (defmethod core/query :retrieve-project-by-share-token
   [{:keys [token]}]
   (s/assert ::token token)


Add the beginnings of a query window expression language... in this case, units only.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -9,7 +9,21 @@
             [cljs-time.coerce :as time-coerce]
             [metlog-client.tsplot :as tsplot]))

-(defonce query-window (reagent/atom (* 3600 24)))
+(defn parse-query-window [ text ]
+  (let [ text (.trim text) ]
+    (and (> (.-length text) 0)
+         (let [window-unit-char (.charAt text (- (.-length text) 1))
+               window-value (.substring text 0 (- (.-length text) 1))]
+           (case window-unit-char
+             "S" (js/parseInt window-value)
+             "m" (* 60 (js/parseInt window-value))
+             "h" (* 3600 (js/parseInt window-value))
+             "d" (* 86400 (js/parseInt window-value))
+             "w" (* 604800 (js/parseInt window-value))
+             false)))))
+
+
+(defonce query-window (reagent/atom "1d"))

 (def dashboard-state (reagent/atom {:series [] :text ""}))

@@ -51,7 +65,7 @@
     channel))

 (defn range-ending-at [ end-t ]
-  (let [begin-t (time/minus end-t (time/seconds @query-window))]
+  (let [begin-t (time/minus end-t (time/seconds (parse-query-window @query-window)))]
     {:begin-t (time-coerce/to-long begin-t)
      :end-t (time-coerce/to-long end-t)}))

@@ -113,7 +127,8 @@
      ^{ :key series } [series-pane series @query-window])])

 (defn end-edit [ text state ]
-  (reset! query-window (js/parseInt text)))
+  (when (parse-query-window text)
+    (reset! query-window text)))

 (defn input-field [ initial-text on-enter ]
   (let [ state (reagent/atom { :text initial-text }) ]


[#1077] Tweak windshaft point opacity and outline color

--- backend/src/akvo/lumen/lib/visualisation/map_config.clj
+++ backend/src/akvo/lumen/lib/visualisation/map_config.clj
@@ -27,9 +27,9 @@
 (defn cartocss [point-size point-color-column point-color-mapping]
   (format "#s {
               marker-allow-overlap: true;
-              marker-fill-opacity: 0.6;
+              marker-fill-opacity: 0.8;
               marker-fill: #6ca429;
-              marker-line-color: #888;
+              marker-line-color: #ddd;
               marker-width: %s;
             %s }"
           (marker-width point-size)


[#1142] Code style change first part of map_config WIP

--- backend/src/akvo/lumen/lib/visualisation/map_config.clj
+++ backend/src/akvo/lumen/lib/visualisation/map_config.clj
@@ -6,12 +6,11 @@
 (hugsql/def-db-fns "akvo/lumen/lib/dataset.sql")

 (defn layer-point-color [layer-index]
-    (get
-     {0 "#2ca409"
-      1 "#096ba4"
-      2 "#7a09a4"
-      3 "#a4092a"
-      4 "#fff721" } layer-index "#000000"))
+  ({0 "#2ca409"
+    1 "#096ba4"
+    2 "#7a09a4"
+    3 "#a4092a"
+    4 "#fff721"} layer-index "#000000"))

 (defn marker-width [point-size]
   (let [point-size (if (string? point-size)
@@ -33,69 +32,92 @@
                 value)
               (pr-str color)))))

-(defn point-cartocss [point-size point-color-column point-color-mapping layer-index]
-  (format "#s {
-              marker-allow-overlap: true;
-              marker-fill-opacity: 0.8;
-              marker-fill: %s;
-              marker-line-color: #fff;
-              marker-width: %s;
-              %s
-           }"
-          (layer-point-color layer-index)
-          (marker-width point-size)
-          (str/join " " (point-color-css point-color-column point-color-mapping))))
-
-(defn shape-cartocss [layer-index layer]
-  (cond-> (format "#s {
-              polygon-opacity: 0.8;
-              polygon-fill: transparent;
-              line-width: 2;
-              line-color: rgba(0,0,0,0.3);
-           }
-           "
-          (layer-point-color layer-index))
-          (get layer "shapeLabelColumn")
-          (str (format "#s::labels {
-            text-name: [%s];
-            text-face-name: 'DejaVu Sans Book';
-            text-size: 10;
-            text-fill: #000;
-          }"
-          (get layer "shapeLabelColumn"))))
-)
-
-(defn shape-aggregation-cartocss [layer-index layer]
-  (cond-> (format "#s {
-              polygon-opacity: 0.8;
-              polygon-fill: [shapefill];
-              line-width: 0.5;
-              line-color: rgba(0,0,0,0.3);
-           }
-           "
-          (layer-point-color layer-index))
-          (get layer "shapeLabelColumn")
-          (str (format "#s::labels {
-            text-name: [%s];
-            text-face-name: 'DejaVu Sans Book';
-            text-size: 10;
-            text-fill: #000;
-          }"
-          (get layer "shapeLabelColumn"))))
-)
-
-(defn cartocss [layer layer-index metadata-array]
+(defn point-cartocss
+  [point-size point-color-column point-color-mapping layer-index]
+  (let [s-template "
+#s {
+    marker-allow-overlap: true;
+    marker-fill-opacity: 0.8;
+    marker-fill: %s;
+    marker-line-color: #fff;
+    marker-width: %s;
+    %s
+}\n"]
+    (format s-template
+            (layer-point-color layer-index)
+            (marker-width point-size)
+            (str/join " "
+                      (point-color-css point-color-column point-color-mapping)))))
+
+(defn shape-cartocss [layer-index {:strs [shapeLabelColumn] :as layer}]
+  (let [s-template "
+#s {
+    polygon-opacity: 0.8;
+    polygon-fill: transparent;
+    line-width: 2;
+    line-color: rgba(0,0,0,0.3);
+}\n"
+        labels-template "
+#s::labels {
+    text-name: [%s];
+    text-face-name: 'DejaVu Sans Book';
+    text-size: 10;
+    text-fill: #000;
+}\n"]
+    (cond-> (format s-template (layer-point-color layer-index))
+      shapeLabelColumn (str (format labels-template shapeLabelColumn)))))
+
+(defn shape-aggregation-cartocss [layer-index {:strs [shapeLabelColumn]}]
+  (let [s-template "
+#s {
+    polygon-opacity: 0.8;
+    polygon-fill: [shapefill];
+    line-width: 0.5;
+    line-color: rgba(0,0,0,0.3);
+}\n"
+        labels-template "
+#s::labels {
+    text-name: [%s];
+    text-face-name: 'DejaVu Sans Book';
+    text-size: 10;
+    text-fill: #000;
+}\n"]
+    (cond-> (format s-template (layer-point-color layer-index))
+      shapeLabelColumn
+      (str (format labels-template shapeLabelColumn)))))
+
+#_(defn cartocss [layer layer-index metadata-array]
+    (cond
+      (and (get layer "aggregationDataset")
+           (get layer "aggregationColumn")
+           (get layer "aggregationGeomColumn"))
+      (shape-aggregation-cartocss layer-index layer)
+
+      (= (get layer "layerType") "geo-shape")
+      (shape-cartocss layer-index layer)
+
+      :else
+      (point-cartocss (get layer "pointSize")
+                      (get layer "pointColorColumn")
+                      (get (nth metadata-array layer-index) "pointColorMapping")
+                      layer-index)))
+
+(defn cartocss
+  [{:strs [aggregationColumn aggregationDataset aggregationGeomColumn
+           layerType pointColorColumn pointSize] :as layer}
+   layer-index metadata-array]
   (cond
-    (and (get layer "aggregationDataset")(get layer "aggregationColumn")(get layer "aggregationGeomColumn"))
-    (shape-aggregation-cartocss layer-index layer)
-
-    (= (get layer "layerType") "geo-shape")
-    (shape-cartocss layer-index layer)
-
-    :else
-    (point-cartocss (get layer "pointSize") (get layer "pointColorColumn") (get (nth metadata-array layer-index) "pointColorMapping") layer-index)
-  )
-)
+    (and aggregationColumn
+         aggregationDataset
+         aggregationGeomColumn) (shape-aggregation-cartocss layer-index layer)
+
+    (= layerType "geo-shape") (shape-cartocss layer-index layer)
+
+    :else (point-cartocss pointSize
+                          pointColorColumn
+                          (get (nth metadata-array layer-index)
+                               "pointColorMapping")
+                          layer-index)))

 (defn trim-css [s]
   (-> s
@@ -103,54 +125,43 @@
       (str/replace #"\n" " ")
       (str/replace #" +" " ")))

-; Should convert hex string to hue for hsl color. Use string matching as proof of concept for now
+;; Should convert hex string to hue for hsl color. Use string matching as proof of concept for now
 (defn color-to-hue [s]
-  (cond
-    (= s "#FF0000")
-    "0"
-
-    (= s "#00FF00")
-    "120"
-
-    (= s "#0000FF")
-    "240"
-  )
-)
+  (case s
+    "#FF0000" "0"
+    "#00FF00" "120"
+    "#0000FF" "240"))

 (defn shape-aggregagation-extra-cols-sql [popup table-name prefix postfix]
-  (if
-    (= (count popup) 0)
+  (if (= (count popup) 0)
     ""
-    (str prefix (clojure.string/join "," (map (fn [popupObj] (str table-name "." (get popupObj "column"))) popup)) postfix)
-  )
-)
+    (str prefix
+         (clojure.string/join "," (map (fn [{:strs [column]}]
+                                         (str table-name "." column))
+                                       popup))
+         postfix)))

 (defn popup-and-label-cols [popup-cols label-col]
   (cond
-    (and (boolean popup-cols) (boolean label-col))
-    (distinct (conj popup-cols {"column" label-col}))
-
-    (boolean popup-cols)
-    popup-cols
-
-    (boolean label-col)
-    [{"column" label-col}]
-
-    :else
-    []
-  )
-)
-
-(defn shape-aggregation-sql [columns table-name geom-column popup-columns point-color-column where-clause current-layer layer-index tenant-conn]
-  (let [
-    {:keys [table-name columns]} (dataset-by-id tenant-conn {:id (get current-layer "aggregationDataset")})
-    point-table-name table-name
-    point-columns columns
-    {:keys [table-name columns]} (dataset-by-id tenant-conn {:id (get current-layer "datasetId")})
-    shape-table-name table-name
-    shape-columns columns
-    aggregation-method (get current-layer "aggregationMethod" "avg")
-    date-column-set (reduce (fn [m c]
+    (and (boolean popup-cols)
+         (boolean label-col)) (distinct (conj popup-cols {"column" label-col}))
+
+    (boolean popup-cols) popup-cols
+
+    (boolean label-col) [{"column" label-col}]
+
+    :else []))
+
+(defn shape-aggregation-sql
+  [columns table-name geom-column popup-columns point-color-column where-clause current-layer layer-index tenant-conn]
+  (let [{:keys [table-name columns]} (dataset-by-id tenant-conn {:id (get current-layer "aggregationDataset")})
+        point-table-name table-name
+        point-columns columns
+        {:keys [table-name columns]} (dataset-by-id tenant-conn {:id (get current-layer "datasetId")})
+        shape-table-name table-name
+        shape-columns columns
+        aggregation-method (get current-layer "aggregationMethod" "avg")
+        date-column-set (reduce (fn [m c]
                                   (if (= "date" (get c "type"))
                                     (conj m (get c "columnName"))
                                     m)) #{} point-columns)
@@ -160,9 +171,9 @@
                                      (str c "::text")
                                      c)) popup-columns) geom-column)
                 point-color-column (conj point-color-column)))
-    hue (color-to-hue (clojure.string/upper-case (get current-layer "gradientColor" "#FF0000")))
-    extra-cols (popup-and-label-cols (get current-layer "popup") (get current-layer "shapeLabelColumn"))
-    ]
+        hue (color-to-hue (clojure.string/upper-case (get current-layer "gradientColor" "#FF0000")))
+        extra-cols (popup-and-label-cols (get current-layer "popup") (get current-layer "shapeLabelColumn"))
+        ]

     (format "with temp_table as
               (select


amend

amend

--- examples/examples/spreadsheet.cljs
+++ examples/examples/spreadsheet.cljs
@@ -4,6 +4,22 @@
             [om-tools.dom :as dom :include-macros true]
             [om.core :as om :include-macros true]
             [clojure.string :as string]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpers
+
+(defn- formula? [s]
+  (string? (first (re-matches #"^=.*" s))))
+
+(defn- write-formula [s state]
+  (let [formula (get-in state [:cells (:focus state) :formula])]
+    (str formula " " s)))
+
+(defn- cell-value [xy state]
+  (let [cell (get-in state [:cells xy])]
+    (if (:formula cell)
+      (read-formula (:formula cell) state)
+      (:value cell))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Formula interpreter
@@ -16,7 +32,7 @@
 (defn string->token [s env]
   (or (ops s)
       (let [n (js/parseInt s)]
-        (if (integer? n) n (resolve-var s env)))))
+        (if (integer? n) n (cell-value s env)))))

 (defn parse-formula [s env]
   (let [[_ a b c] (string/split s #" ")]
@@ -40,25 +56,10 @@
 (def source-mode  (cell-mode "source-mode"))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Helpers
-
-(defn- formula? [s]
-  (string? (first (re-matches #"^=.*" s))))
-
-(defn- write-formula [s state]
-  (let [formula (get-in state [:cells (:focus state) :formula])]
-    (str formula " " s)))
-
-(defn- cell-value [xy state]
-  (let [cell (get-in state [:cells xy])]
-    (if (:formula cell)
-      (read-formula (:formula cell) state)
-      (:value cell))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; The Brain

 (defn behavior [message state]
+  (println message state)
   (match message

     [[:display xy] :click _]
@@ -97,7 +98,7 @@
     [[:edit xy] :key-down 13]
     [[(display-mode xy)
       (display-mode (:source state))
-      [[:display xy] :value (get-in state [:cells (:focus state) :value])]]
+      [[:display xy] :value (cell-value (:focus state) state)]]
      (assoc state :mode :done)]

     :else [[] state]))


PLATFORM-2818: webp-supported? should call webp-compatible-mime-type?

--- src/vignette/media_types.clj
+++ src/vignette/media_types.clj
@@ -11,13 +11,14 @@
 (def archive-dir "archive")

 (def webp-mime-types #{"image/jpeg" "image/png"})
-(defn webp-supported?
-  [file]
-  (contains? webp-mime-types (mime-type-of (or file ""))))

 (defn webp-compatible-mime-type?
   [mime-type]
   (contains? (conj webp-mime-types "image/webp") mime-type))
+
+(defn webp-supported?
+  [file]
+  (webp-compatible-mime-type? (mime-type-of (or file ""))))

 (defmulti image-type->path-prefix (fn [object-map] (image-type object-map)))