Initial conv layer implementation.  Will write max pool then test

--- src/cortex/impl/layers.clj
+++ src/cortex/impl/layers.clj
@@ -130,7 +130,7 @@

 (defn linear-backward!
-  "linear backward pass.  Returns input gradient"
+  "linear backward pass.  Returns a new input gradient."
   [input output-gradient weights bias weight-gradient bias-gradient]
   (let [bg output-gradient
         wg (m/outer-product output-gradient input)
@@ -317,40 +317,110 @@

 (defn get-padded-strided-dimension
-  "http://caffe.berkeleyvision.org/tutorial/layers.html"
+  "http://caffe.berkeleyvision.org/tutorial/layers.html.  Returns the dimensions
+of the output of a conv-net ignoring channels."
   ^long [^long input-dim ^long pad ^long kernel-size ^long stride]
   (long (+ (long (/ (- (+ input-dim (* 2 pad))  kernel-size)
                     stride))
            1)))

-
-
-
+(defn columnar-sum
+  "Sum the columns of the matrix so we produce in essence a new row
+which contains the columnar sums.  Produces a vector and leaves input unchanged"
+  [m]
+  (let [rows (m/rows m)
+        accumulator (m/clone (first rows))]
+    (reduce m/add! accumulator (rest rows))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Convolution layer forward pass utility functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defn create-padded-input-matrix
-  [input-vector-matrixes width height padx pady num-channels]
+  [interleaved-input-vector width height padx pady num-channels]
   (let [width (long width)
         height (long height)
         padx (long padx)
         pady (long pady)
         num-channels (long num-channels)
-        padded-input-matrix (m/zero-array :vectorz [(+ height (* 2 pady))
-                                                    (* (+ width (* 2 padx)) num-channels)])
-        input-mat-view (m/submatrix padded-input-matrix
-                                    [[pady height]
-                                     [(* padx num-channels) (* width num-channels)]])
-        input-vec-seq (map m/eseq input-vector-matrixes)
-        interleaved-data (apply interleave input-vec-seq)
-        data-rows (map-indexed vector (partition (* width num-channels) interleaved-data))]
-    (doseq [[idx data-row] data-rows]
-      (m/set-row! input-mat-view idx data-row))
-    padded-input-matrix))
+        has-padding (or (> padx 0) (> pady 0))]
+    (if has-padding
+      (let [padded-input-matrix (m/zero-array :vectorz [(+ height (* 2 pady))
+                                                        (* (+ width (* 2 padx)) num-channels)])
+            input-mat-view (m/submatrix padded-input-matrix
+                                        [[pady height]
+                                         [(* padx num-channels) (* width num-channels)]])
+            data-rows (map-indexed vector (partition (* width num-channels) interleaved-input-vector))]
+        (doseq [[idx data-row] data-rows]
+          (m/set-row! input-mat-view idx data-row))
+        padded-input-matrix)
+      (m/reshape interleaved-input-vector [height (* width num-channels)]))))
+

 (defn create-convolution-rows
-  "Given an image flattened into a matrix for each channel
+  "Given an image flattened into an interleaved vector
 create a matrix where each row is the input to the convolution filter row
 meaning the convolution is just a dotproduct across the rows.
-Should be width*height rows.  Padding is applied as zeros across channels"
-  [input-vector-matrixes width height k-width k-height padx pady stride-w stride-h]
+Should be output-width*output-height rows.  Padding is applied as zeros across channels.
+The rational for creating a matrix instead of a sequence of rows is to provide a hint to
+the underlying implementation to store the data contiguously as we will be accessing it
+in order repeatedly"
+  [interleaved-input-vector width height k-width k-height padx pady stride-w stride-h]
+  (let [width (long width)
+        height (long height)
+        num-items (long (first (m/shape interleaved-input-vector)))
+        num-channels (long (/ num-items (* width height)))
+        k-width (long k-width)
+        k-height (long k-height)
+        padx (long padx)
+        pady (long pady)
+        stride-w (long stride-w)
+        stride-h (long stride-h)
+        input-matrix (create-padded-input-matrix interleaved-input-vector
+                                                 width height
+                                                 padx pady
+                                                 num-channels)
+        output-width (get-padded-strided-dimension width padx k-width stride-w)
+        output-height (get-padded-strided-dimension height pady k-height stride-h)
+        input-mat-stride (* (+ width (* 2 padx)) num-channels)
+        kernel-stride (* k-width num-channels)]
+    ;;I go ahead and create a contiguous matrix here because we will iterate over this many times
+    (m/array :vectorz
+             (for [^long output-y (range output-height)
+                   ^long output-x (range output-width)]
+               (m/as-vector (m/submatrix input-matrix [[(* output-y stride-h) k-height]
+                                                       [(* output-x stride-w num-channels) kernel-stride]]))))))
+
+(defn convolution-forward
+  [weights bias input-convolved-rows]
+  (let [weights-t (m/transpose! weights)
+        result (m/inner-product input-convolved-rows weights-t)
+        _ (m/transpose! weights)]
+    (doseq [row (m/rows result)]
+      (m/add! row bias))
+    (m/as-vector result)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Convolution backward pass utility functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn gradient-vector-to-output-gradient
+  "Given the gradient vector coming from downstream reshape it
+such that we can use the linear layer's backprop step to produce
+the weight and bias gradient update and the upstream gradient
+information."
+  [gradient-vector ^long num-kernels]
+  (let [num-gradient-rows (/ (long (first (m/shape gradient-vector))) num-kernels)
+        gradient-matrix (m/reshape gradient-vector [num-gradient-rows num-kernels])]
+    (columnar-sum gradient-matrix)))
+
+
+(defn linear-input-gradient-to-input-image
+  "Given the results of the linear backward pass we have an input gradient that is
+a vector of k-width * k-height * num-channels.  We need to de-convolve this using opposite
+  operation as we did when we convolved the input."
+  [input-gradient width height k-width k-height padx pady stride-w stride-h]
   (let [width (long width)
         height (long height)
         k-width (long k-width)
@@ -359,37 +429,74 @@
         pady (long pady)
         stride-w (long stride-w)
         stride-h (long stride-h)
-        num-channels (long (count input-vector-matrixes))
-        input-matrix (create-padded-input-matrix input-vector-matrixes
-                                                 width height
-                                                 padx pady
-                                                 num-channels)
+        num-channels (long (/ (long (first (m/shape input-gradient)))
+                              (* k-width k-height)))
+        input-matrix (m/zero-array :vectorz [(+ height (* 2 pady))
+                                             (* (+ width (* 2 padx)) num-channels)])
+        input-mat-view (m/submatrix input-matrix
+                                    [[pady height]
+                                     [(* padx num-channels) (* width num-channels)]])
         output-width (get-padded-strided-dimension width padx k-width stride-w)
         output-height (get-padded-strided-dimension height pady k-height stride-h)
-        input-mat-stride (* (+ width (* 2 padx)) num-channels)
-        kernel-stride (* k-width num-channels)]
-    (for [^long output-y (range output-height)
-          ^long output-x (range output-width)]
-      (m/array :vectorz (m/eseq (m/submatrix input-matrix [[(* output-y stride-h) k-height]
-                                                           [(* output-x stride-w num-channels) kernel-stride]]))))))
-(defn calc-conv
-  "input: channels*w.h
-   weights: channels*kw*ky.n-kernels
-   bias: w.h.n-kernels
-  weight-gradient: (m/shape weights)
-  bias-gradient: (m/shape bias)
-  output: (m/shape bias)
-  returns output."
-  [input weights bias padx pady output]
-  (m/assign! output bias))
-
-
-;; (defrecord Convolutional [weights bias padx pady output weight-gradient bias-gradient]
-;;     cp/PModule
-;;     (cp/calc [m input]
-;;       (let [up (cp/calc up input)]
-;;         (DenoisingAutoencoder. up down input-tmp output-tmp)))
-
-;;     (cp/output [m]
-;;       (cp/output up))
-;;)
+        kernel-stride (* k-width num-channels)
+        input-gradient-mat (m/reshape input-gradient [k-height kernel-stride])]
+    (doseq [^long output-y (range output-height)
+            ^long output-x (range output-width)]
+      (m/add! (m/submatrix input-matrix [[(* output-y stride-h) k-height]
+                                          [(* output-x stride-w num-channels) kernel-stride]])
+              input-gradient-mat))
+    (m/array :vectorz (m/as-vector input-mat-view))))
+
+
+(defn convolution-backward!
+  [output-gradient backpass-input weights bias weight-gradient bias-gradient
+   width height k-width k-height padx pady stride-w stride-h]
+  (let [linear-output-gradient (gradient-vector-to-output-gradient output-gradient (m/row-count weights))
+        linear-input backpass-input
+        linear-input-gradient (linear-backward! linear-input linear-output-gradient weights
+                                                bias weight-gradient bias-gradient)]
+    (linear-input-gradient-to-input-image linear-input-gradient
+                                          width height k-width k-height padx pady stride-w stride-h)))
+
+
+
+(defrecord Convolutional [weights bias width height padx pady k-width k-height
+                          stride-w stride-h output weight-gradient bias-gradient]
+    cp/PModule
+    (cp/calc [this input]
+      (let [input-convolved-rows (create-convolution-rows input width height k-width k-height
+                                                          padx pady stride-w stride-h)
+            backpass-input (columnar-sum input-convolved-rows)
+            output (convolution-forward weights bias input-convolved-rows)]
+        [output backpass-input]))
+
+    (cp/output [m]
+      (:output m))
+
+    cp/PNeuralTraining
+    (forward [this input]
+      (let [[output backpass-input] (cp/calc this input)]
+        (assoc this :output output :backpass-input backpass-input)))
+
+    (backward [this input output-gradient]
+      (assoc this :input-gradient (convolution-backward! output-gradient (:backpass-gradient this)
+                                                         weights bias weight-gradient bias-gradient
+                                                         width height k-width k-height stride-w stride-h)))
+
+    (input-gradient [this]
+      (:input-gradient this))
+
+    cp/PParameters
+    (parameters [this]
+      (m/join (m/as-vector (:weights this)) (m/as-vector (:bias this))))
+
+    (update-parameters [this parameters]
+      (let [param-view (cp/parameters this)]
+        (m/assign! param-view parameters))
+      (let [gradient-view (cp/gradient this)]
+        (m/assign! gradient-view 0.0))
+      this)
+
+    cp/PGradient
+    (gradient [this]
+      (m/join (m/as-vector (:weight-gradient this)) (m/as-vector (:bias-gradient this)))))


Loss gradient for stacked modules

Loss gradient for stacked modules

--- src/cortex/impl/wiring.clj
+++ src/cortex/impl/wiring.clj
@@ -39,7 +39,7 @@
     (cp/output [m]
       (cp/output (last modules)))

-    cp/PNeuralTraining
+  cp/PNeuralTraining
     (forward [this input]
       (let [n (long (count modules))]
         (loop [i 0
@@ -71,10 +71,15 @@
     (input-gradient [this]
       (cp/input-gradient (nth modules 0)))

+  cp/PLossGradientFunction
+    (loss-gradient-fn [m]
+      (or
+        (:loss-gradient-fn m) ;; allow stack to provide an override
+        (cp/loss-gradient-fn (last modules))))
+
   cp/PGradient
     (gradient [this]
       (apply m/join (map cp/gradient modules)))
-

   cp/PParameters
     (parameters [this]


Remove overzealous arity catch.

Remove overzealous arity catch.

This was catching an artity problem deeper in the code and reporting
it as "wrong number of arguments to task". Thanks to Mark McGranahan
for noticing it.

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -75,10 +75,8 @@
         compile-path (:compile-path (first args))]
     (when compile-path (.mkdirs (File. compile-path)))
     (binding [*compile-path* compile-path]
-      (try
-       (apply (resolve-task task) args)
-       (catch IllegalArgumentException _
-         (abort (format "Wrong number of arguments to task %s."
-                        task)))))
+      ;; TODO: can we catch only task-level arity problems here?
+      ;; compare args and (:arglists (meta (resolve-task task)))?
+      (apply (resolve-task task) args))
     ;; In case tests or some other task started any:
     (shutdown-agents)))


changes the spec task to better handle lein2 failure

--- src/leiningen/spec.clj
+++ src/leiningen/spec.clj
@@ -35,9 +35,8 @@
 (defn- prepare [project]
   (try
     (require 'leiningen.core.eval)
-    ((ns-resolve 'leiningen.core.eval 'prep)
-       project)
-    (catch Exception e
+    ((ns-resolve 'leiningen.core.eval 'prep) project)
+    (catch java.io.FileNotFoundException e
       (require 'leiningen.classpath
                'leiningen.compile)
       ((ns-resolve 'leiningen.compile 'prep) project false))))


Update intro to clarify docs are online - close #2016

--- src/lt/objs/intro.cljs
+++ src/lt/objs/intro.cljs
@@ -23,7 +23,7 @@
                                     "dark") ".png"))

 (defui docs []
-  [:button "Light Table's docs"]
+  [:button "Light Table's online docs"]
   :click (fn []
            (cmd/exec! :show-docs)))


prevent font settings from being unnecessarily updated

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

--- src/lt/objs/style.cljs
+++ src/lt/objs/style.cljs
@@ -40,7 +40,7 @@
                 :init (fn [this]
                         [:div
                          [:style {:type "text/css"}
-                          (bound this ->css)
+                          (bound (subatom this :font-settings) ->css)
                           ]]))

 (def styles (object/create ::styles
@@ -72,7 +72,7 @@
                                                    (> line-height 0))
                                             (assoc final :line-height line-height)
                                             final)]
-                                (object/merge! styles final))))
+                                (object/merge! styles {:font-settings final}))))

 ;;**********************************************************
 ;; Skins


Changed the loop/recur to a reduce.

Changed the loop/recur to a reduce.

--- src/mazes_clj/core.clj
+++ src/mazes_clj/core.clj
@@ -74,14 +74,12 @@

 (defn maze-binary-tree [grid]
-  (loop [grid grid
-         [cell & cells] (:cells grid)]
-    (let [neighbors (filter identity (map cell [:north :east]))
-          neighbor (when-not (empty? neighbors)
-                     (rand-nth neighbors))
-          new-grid (if (nil? neighbor)
-                     grid
-                     (link-cells grid cell neighbor))]
-      (if (empty? cells)
-        new-grid
-        (recur new-grid cells)))))+  (let [process-cell
+        (fn [grid cell]
+          (let [neighbors (filter identity (map cell [:north :east]))
+                neighbor (when-not (empty? neighbors)
+                           (rand-nth neighbors))]
+            (if (nil? neighbor)
+              grid
+              (link-cells grid cell neighbor))))]
+    (reduce process-cell grid (grid-cells grid))))


Cleaned up the binary tree loop/recur a bit.

--- src/mazes_clj/core.clj
+++ src/mazes_clj/core.clj
@@ -74,14 +74,14 @@

 (defn maze-binary-tree [grid]
-  (loop [g grid
+  (loop [grid grid
          [cell & cells] (:cells grid)]
     (let [neighbors (filter identity (map cell [:north :east]))
           neighbor (when-not (empty? neighbors)
                      (rand-nth neighbors))
           new-grid (if (nil? neighbor)
-                     g
-                     (link-cells g cell neighbor))]
+                     grid
+                     (link-cells grid cell neighbor))]
       (if (empty? cells)
         new-grid
         (recur new-grid cells)))))


CMR-2118 Adds note about CMR-2153.

CMR-2118 Adds note about CMR-2153.

--- system-int-test/test/cmr/system_int_test/ingest/collection_ingest_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/collection_ingest_test.clj
@@ -505,7 +505,7 @@
     (is (mdb/concept-exists-in-mdb? (:concept-id response) 1))
     (is (= 1 (:revision-id response)))

-    ;; The UMM-JSON concept should NOT be searchable.
+    ;; The UMM-JSON concept should NOT be searchable until CMR-2153 is implemented.
     (is (empty? (:refs (search/find-refs :collection {"entry-title" "The entry title V5"}))))

     (testing "Updating a UMM-JSON collection"


some minor cleanup

some minor cleanup

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -116,7 +116,7 @@
         (dom/div #js {:id "uploads-queue"}
           (om/build-all upload-view (:uploads data)))))))

-(defn center-left-area [data owner]
+(defn chat-view [data owner]
   (reify
     om/IRenderState
     (render-state [_ state]
@@ -129,19 +129,19 @@
   (reify
     om/IDidMount
     (did-mount [_]
-      (om/set-state! owner :handle-resize #(let [window-width (.-innerWidth js/window)
-                                                 left-width (if (< window-width 850)
-                                                              (* 0.50 window-width)
-                                                              (* 0.35 window-width))
-                                                 right-width (if (< window-width 850)
-                                                               (* 0.50 window-width)
-                                                               (* 0.65 window-width))]
-                                             (om/set-state! owner
-                                                            :left-width
-                                                            (str left-width "px"))
-                                             (om/set-state! owner
-                                                            :right-width
-                                                            (str right-width "px"))))
+      (om/set-state! owner
+                     :handle-resize
+                     #(let [window-width (.-innerWidth js/window)
+                            left-width (if (< window-width 850)
+                                         (* 0.50 window-width)
+                                         (* 0.35 window-width))
+                            right-width (if (< window-width 850)
+                                          (* 0.50 window-width)
+                                          (* 0.65 window-width))]
+                        (om/set-state! owner
+                                       :dimensions
+                                       {:chat-width (str left-width "px")
+                                        :track-queue-width (str right-width "px")}))))
       ((om/get-state owner :handle-resize))
       (dommy/listen! js/window :resize (om/get-state owner :handle-resize)))
     om/IWillUnmount
@@ -151,8 +151,9 @@
     (render-state [_ state]
       (dom/div #js {:id "center-area"}
         (list
-          (om/build center-left-area data {:state {:width (:left-width state)}})
-          (om/build track-queue-view data {:state {:width (:right-width state)}}))))))
+          (let [dimensions {:dimensions state}]
+            (om/build chat-view data {:state {:width (:chat-width dimensions)}})
+            (om/build track-queue-view data {:state {:width (:track-queue-width dimensions)}}))))))

 (defn volume-control [data owner]
   (reify


don't leak data about docs

don't leak data about docs

--- src/pc/http/routes.clj
+++ src/pc/http/routes.clj
@@ -108,13 +108,16 @@
         (redirect "/"))))

 (defn doc-resp [doc req & {:keys [view-data]}]
-  (content/app (merge (common-view-data req)
-                      {:initial-document-id (:db/id doc)
-                       :meta-image (urls/png-from-doc doc)
-                       :meta-url (urls/from-doc doc)
-                       :meta-title (:document/name doc)
-                       :initial-entities [(doc-model/read-api doc)]}
-                      view-data)))
+  (let [read-access? (auth/has-document-permission? (pcd/default-db) doc (-> req :auth) :read)]
+    (content/app (merge (common-view-data req)
+                        {:initial-document-id (:db/id doc)
+                         :meta-image (urls/png-from-doc doc)
+                         :meta-url (urls/from-doc doc)
+                         :meta-title (when read-access? (:document/name doc))
+                         :initial-entities (if read-access?
+                                             [(doc-model/read-api doc)]
+                                             [{:db/id (:db/id doc)}])}
+                        view-data))))

 (defn parse-doc-id [doc-id-param]
   (Long/parseLong (re-find #"[0-9]+$" doc-id-param)))


Remove unnecessary code

Remove unnecessary code

--- src/photon/streams.clj
+++ src/photon/streams.clj
@@ -25,15 +25,6 @@

 (defprotocol StreamManager
   (streams [this]))
-
-(defn parse-old-date [date-string]
-  (cc/to-long
-    (clj-time.format/parse
-      (clj-time.format/formatter
-        "EEE MMM dd yyyy HH:mm:ss zZ '(GMT)'")
-      (clojure.string/replace date-string #"BST|UTC" "GMT"))))
-
-

 (defmulti stream (fn [_ params]
                    (log/info (pr-str params))


Fix fress cljs test.

Fix fress cljs test.

--- test/incognito/fressian_test.cljs
+++ test/incognito/fressian_test.cljs
@@ -18,7 +18,7 @@
                 (fress.api/write-object w bar)
                 (fress.api/read buffer :handlers (incognito-read-handlers (atom {}))))]
       (is (= {:c "donkey", :b {:c "Fooos"}, :a [1 2 3]} (:value r)))
-      (is (= 'incognito.fressian-test/Bar (:tag r)))
+      (is (= 'incognito.fressian-test.Bar (:tag r)))
       (is (= incognito.base/IncognitoTaggedLiteral (type r))))))

 (deftest double-roundtrip-test


Fix connecting to Mongo in integration tests

--- test/integration/handler_test.clj
+++ test/integration/handler_test.clj
@@ -5,7 +5,9 @@
             [cfpb.qu.data :as data]
             [monger.core :as mongo]))

-(with-state-changes [(before :facts (data/ensure-mongo-connection))]
+(with-state-changes [(before :facts (data/connect-mongo))
+                     (after :facts (data/disconnect-mongo))]
+
   (fact "the index URL redirects to /data"
         (app (request :get "/"))
         => (contains {:status 302


Server: log misc exceptions correctly.

Server: log misc exceptions correctly.

--- src/reimann/server.clj
+++ src/reimann/server.clj
@@ -46,7 +46,7 @@
             (log :warn (str "invalid message, closing " client-info))
             (close channel))
           (catch Exception e
-            (log :warn (str "Exception " e))
+            (log :warn "Exception " e)
             (close channel))))))))

 (defn tcp-server


add verbose logging to ns-side-effects, missing callback if all side-effects were suppressed

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -178,20 +178,32 @@
   ([bound-vars ana-env ast opts cb]
     (ns-side-effects false bound-vars ana-env ast opts cb))
   ([load bound-vars ana-env {:keys [op] :as ast} opts cb]
+   (when (:verbose opts)
+     (debug-prn "Namespace side effects for" (:name ast)))
    (if (= :ns op)
      (let [{:keys [deps uses requires require-macros use-macros reload reloads]} ast
            env (:*compiler* bound-vars)]
        (letfn [(check-uses-and-load-macros []
                  (when (and (:*analyze-deps* bound-vars) (seq uses))
+                   (when (:verbose opts)
+                     (debug-prn "Checking uses"))
                    (ana/check-uses uses env))
-                 (when (:*load-macros* bound-vars)
-                   (load-macros bound-vars :use-macros use-macros reload reloads opts
-                     (fn []
-                       (load-macros bound-vars :require-macros require-macros reloads reloads opts
-                         (fn []
-                           (when (seq use-macros)
-                             (ana/check-use-macros use-macros env))
-                           (cb ast)))))))]
+                 (if (:*load-macros* bound-vars)
+                   (do
+                     (when (:verobse opts)
+                       (debug-prn "Loading :use-macros"))
+                     (load-macros bound-vars :use-macros use-macros reload reloads opts
+                       (fn []
+                         (when (:verobse opts)
+                           (debug-prn "Loading :require-macros"))
+                         (load-macros bound-vars :require-macros require-macros reloads reloads opts
+                           (fn []
+                             (when (seq use-macros)
+                               (when (:verobse opts)
+                                 (debug-prn "Checking :use-macros"))
+                               (ana/check-use-macros use-macros env))
+                             (cb ast))))))
+                   (cb ast)))]
          (cond
            (and load (seq deps))
            (load-deps bound-vars name deps (dissoc opts :macros-ns)


Fix bug introduced while renaming the multi-test :if node to :cond

--- src/skylark/parser.clj
+++ src/skylark/parser.clj
@@ -231,7 +231,7 @@
 (def &test-nocond (&or &or-test &lambdef-nocond))
 (def &test
   (&or (&mod-expr &or-test (&vector (&do (&type :if) &or-test) (&do (&type :else) &test))
-                  #(do [:cond (list [(first %2) %]) (second %2)]))
+                  #(do [:cond [[(first %2) %]] (second %2)]))
        &lambdef))

 (def &exprlist (&tuple-or-singleton (&or &expr &star-expr)))
@@ -316,9 +316,10 @@
          (if (empty? (rest l)) (first l) (with-source-info (into [:suite] l) info&))))

 (def &if-statement
-  (&prefixed-vector :cond
-                    (&non-empty-separated-list (&vector &test &colon-suite) (&type :elif))
-                    (&optional (&do (&type :else) &colon-suite))))
+  (&let [_ (&type :if)
+         clauses (&non-empty-separated-list (&vector &test &colon-suite) (&type :elif))
+         else (&optional (&do (&type :else) &colon-suite))]
+        (vector :cond (vec clauses) else)))

 (def &while-statement
   (&prefixed-vector :while &test &colon-suite (&optional (&do (&type :else) &colon-suite))))


Remove commented code from project.clj

Remove commented code from project.clj

--- frontend/project.clj
+++ frontend/project.clj
@@ -10,7 +10,6 @@
   :profiles {:dev {:source-paths ["dev"]}}

   :dependencies [[org.clojure/clojure "1.9.0-alpha14" :scope "provided"]
-                 ;; [org.clojure/clojurescript "1.9.456" :scope "provided"]
                  [org.clojure/clojurescript "1.9.293" :scope "provided"]

                  ;; Build


Add rendering and gameplay

Add rendering and gameplay

--- src/tictactoe/core.clj
+++ src/tictactoe/core.clj
@@ -91,21 +91,35 @@
     #(best-case current-player %1 board true 0)
     (valid-moves board)))

-; step ->
-;   render()
-;   if game.finished? ->
-;     die()
-;   else ->
-;     ask()
-;     play_cpu()
-;     step()
-
 (defn player-move
-  []
-  (read-line))
+  [board]
+  (Integer. (read-line)))

 (defn step
   [board]
-  (game-board board (player-move) (cpu-move (game-board board (player-move) "0") "X")) "X")
-;
-; (defn -main "Play the Game" [] (game-board))
+  (println (render board))
+  (if (= (game-progress board) "not-over")
+    (let [new-board (game-board board (player-move) "X")]
+      (step (game-board new-board (cpu-move new-board "O") "O")))
+    (print "game over")))
+
+(defn step
+  [board current-player-piece opponent-piece current-player-move opponent-move]
+  (println (render board))
+  (if (= (game-progress board) "not-over")
+    (step
+      (game-board board (current-player-move board) current-player-piece)
+      opponent-piece
+      current-player-piece
+      opponent-move
+      current-player-move)
+    (println "game over")))
+
+(defn -main "Play the Game"
+  []
+  (step
+    (game-board)
+    "X"
+    "O"
+    #(player-move %1)
+    #(cpu-move %1 "O")))


Mark all done using insert unconditional

--- src/todomvc/rules.cljs
+++ src/todomvc/rules.cljs
@@ -1,6 +1,7 @@
 (ns todomvc.rules
   (:require-macros [clara.macros :refer [defrule defquery defsession]])
-  (:require [clara.rules :refer [insert insert! insert-all! retract! query fire-rules]]
+  (:require [clara.rules :refer [insert insert! insert-all! insert-all-unconditional!
+                                 retract! query fire-rules]]
             [clara.rules.accumulators :as acc]))

@@ -42,7 +43,7 @@
   (prn "inserting" (map #(update % :done not) ?todos))
   (retract! ?toggle)
   (apply retract! ?todos)
-  (insert-all! (map #(update % :done not) ?todos)))
+  (insert-all-unconditional! (map #(update % :done not) ?todos)))

 (defquery find-showing
   []


Extract the copying of obi projects

Extract the copying of obi projects

--- src/mdr2/abacus/import.clj
+++ src/mdr2/abacus/import.clj
@@ -194,6 +194,14 @@
           (copy-struct-file!)
           (convert-struct-file!)))))

+(defn copy-obi-project! [production]
+  (spit move-script
+        (format "mv %s %s\n"
+                (obi-project-path production)
+                (path/recording-path production))
+        :append true)
+  production)
+
 (defn create-recording-productions-with-obi!
   "Create all productions with state \"recording\" with wav files that
   contain an obi project. Add to the db and create the directories.
@@ -203,12 +211,14 @@
   (doseq [p (filter recording-with-obi? productions)]
     (-> p
         prod/create!
-        prod/set-state-structured!)
-    (spit move-script
-          (format "mv %s %s\n" (obi-project-path p) (path/recording-path p))
-          :append true)
+        prod/set-state-structured!
+        copy-obi-project!))
     (comment
-      (create-obi-config-file!))))
+      (create-obi-config-file!)))
+
+(defn copy-sigtuna-project! [production]
+  ;; FIXME: do we actually copy theses projects or do we do this manually?
+  production)

 (defn create-recording-productions-without-obi!
   "Create all productions with state \"recording\" with wav files that
@@ -218,8 +228,7 @@
     (-> p
         prod/create!
         prod/set-state-structured!
-        (comment
-          (copy-sigtuna-project!)))))
+        copy-sigtuna-project!)))

 (defn print-stats
   "Print a summary of all the productions that are about to be migrated"


Give buffers names

Give buffers names

--- src/overtone/sc/buffer.clj
+++ src/overtone/sc/buffer.clj
@@ -77,13 +77,14 @@
         :rate-scale rate-scale
         :duration duration}))))

-(defrecord Buffer [id size n-channels rate status]
+(defrecord Buffer [id size n-channels rate status name]
   to-sc-id*
   (to-sc-id [this] (:id this)))

 (defmethod print-method Buffer [b w]
-  (.write w (format "#<buffer[%s]: %fs %s %d>"
+  (.write w (format "#<buffer[%s]: %s %fs %s %d>"
                     (name @(:status b))
+                    (:name b)
                     (:duration b)
                     (cond
                      (= 1 (:n-channels b)) "mono"
@@ -95,8 +96,11 @@
   "Synchronously allocate a new zero filled buffer for storing audio
   data with the specified size and num-channels. Size will be
   automatically floored and converted to a Long - i.e. 2.7 -> 2"
-  ([size] (buffer size 1))
-  ([size num-channels]
+  ([size] (buffer size 1 ""))
+  ([size num-channels-or-name] (if (string? num-channels-or-name)
+                                 (buffer 1 num-channels-or-name)
+                                 (buffer num-channels-or-name "")))
+  ([size num-channels name]
      (let [size (long size)
            id   (with-server-self-sync
                   (fn [uid]
@@ -109,6 +113,7 @@

        (map->Buffer
         (assoc info
+          :name name
           :status (atom :live))))))

 (defrecord BufferFile [id size n-channels rate status path]


add print-method for PlayableSample

add print-method for PlayableSample

--- src/overtone/sc/sample.clj
+++ src/overtone/sc/sample.clj
@@ -185,6 +185,17 @@
   to-sc-id*
   (to-sc-id [this] (:id this)))

+(defmethod print-method PlayableSample [b w]
+  (.write w (format "#<buffer[%s]: %s %fs %s %d>"
+                    (name @(:status b))
+                    (:name b)
+                    (:duration b)
+                    (cond
+                     (= 1 (:n-channels b)) "mono"
+                     (= 2 (:n-channels b)) "stereo"
+                     :else (str (:n-channels b) " channels"))
+                    (:id b))))
+
 (defn sample
   "Loads a .wav or .aiff file into a memory buffer. Returns a function
    capable of playing that sample. Memoizes result and returns same


routes

routes

--- backend/src/lambdaui/core.clj
+++ backend/src/lambdaui/core.clj
@@ -39,14 +39,14 @@

 (defn pipeline-routes [pipeline]
   (ring-json/wrap-json-response
-    (routes (context "/lambdaui/api" [] (new-api/api-routes pipeline))
+    (routes
+            (route/resources "/" {:root "public"})
+            (GET "/" [] (ring.util.response/redirect "/index.html"))
+            (GET "/config.js" [] (create-config pipeline))
+            (context "/lambdaui/api" [] (new-api/api-routes pipeline))
             (POST "/lambdaui/api/triggerNew" [] (do (runner/trigger-new-build pipeline) {}))
             (context "/api" [] (old-api/rest-api pipeline))
             (GET "/old" [] (old-ui/ui-page pipeline))
-            (route/resources "/" {:root "public"})
-            (GET "/" [] (ring.util.response/redirect "ui/index.html"))
-            (GET "/ui/config.js" [] (create-config pipeline))
-            (route/resources "/ui" {:root "public"})
             )))


Fixed upload issues of profile data to mongo

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -134,11 +134,9 @@
 (defn mongo-insert-results
   "Perform insert to mongo collection by zid"
   [collection-name object]
-  (mc/update
+  (mc/insert
     (db/mongo-db (env/env :mongolab-uri))
     collection-name
-    {:zid (or (:zid object)
-              (get object "zid"))}
     object))


Exclude title from check to show download links.


Remove :aot from project.clj file

Remove :aot from project.clj file

--- clojure-lang/project.clj
+++ clojure-lang/project.clj
@@ -6,5 +6,4 @@
   :dependencies [[org.clojure/clojure "1.8.0"]
                  [com.taoensso/carmine "2.18.1"]
                  [cheshire "5.8.0"]
-                 [clj-time "0.14.4"]]
-  :aot :all)
+                 [clj-time "0.14.4"]])


truncate false

truncate false

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -14,7 +14,7 @@
 (def ^:const branch? #(let [result (= 0 (rand-int (+ % branching-factor)))]
                         (log/debug (str "branch at: " % "? => " result))
                         result))
-(def ^:const truncate? true)
+(def ^:const truncate? false)
 (def ^:const println? false)
 (def ^:const use-spec-cache? true)
 (declare gen)


throw exception if a complement cannot be generated

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -34,6 +34,10 @@
 (declare show-bolt)
 (declare truncate)
 (declare truncate-expressions)
+
+;; {:synsem {:cat :noun,
+;;           :pronoun true,
+;;           :sem {:pred :cat}}

 (defn generate [spec language-model
                 & {:keys [max-total-depth truncate-children]
@@ -155,10 +159,30 @@
                         phrasal-complements (if (and (> max-total-depth total-depth)
                                                      (= true (get-in spec [:phrasal] true)))
                                               (generate-all spec language-model (+ depth total-depth)
-                                                            :max-total-depth max-total-depth))]
-                    (if (lexemes-before-phrases total-depth)
-                      (lazy-cat (lazy-shuffle filtered-lexical-complements) phrasal-complements)
-                      (lazy-cat phrasal-complements (lazy-shuffle filtered-lexical-complements))))))))
+                                                            :max-total-depth max-total-depth))
+                        lexemes-before-phrases (lexemes-before-phrases total-depth)]
+                    (cond (and lexemes-before-phrases
+                               (empty? filtered-lexical-complements)
+                               (= false (get-in spec [:phrasal] true)))
+                          (exception (str "failed to generate any lexical complements with spec: "
+                                          (strip-refs spec)))
+
+                          (and lexemes-before-phrases
+                               (= true (get-in spec [:phrasal] false))
+                               (empty? phrasal-complements))
+                          (exception (str "failed to generate any phrasal complements with spec: "
+                                          (strip-refs spec)))
+
+                          (and (empty? filtered-lexical-complements)
+                               (empty? phrasal-complements))
+                          (exception (str "failed to generate either phrasal or lexical complements with spec: "
+                                          (strip-refs spec)))
+
+                          lexemes-before-phrases
+                          (lazy-cat (lazy-shuffle filtered-lexical-complements) phrasal-complements)
+
+                          true
+                          (lazy-cat phrasal-complements (lazy-shuffle filtered-lexical-complements))))))))

 (defn lightning-bolts [language-model spec depth total-depth
                        & {:keys [max-total-depth]


+(declare do-defaults)

+(declare do-defaults)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -27,6 +27,7 @@
 (declare any-possible-complement?)
 (declare bolt-depth)
 (declare candidate-parents)
+(declare do-defaults)
 (declare exception)
 (declare find-comp-paths-in)
 (declare lazy-mapcat)


make keys and vals structure more explicit

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -69,11 +69,13 @@
      (mapcat (fn [{bolt :bolt comps :comps}]
                (let [each-bolt-and-comps
                      (merge {[] [bolt]}
-                            comps)]
+                            comps)
+                     keys (keys each-bolt-and-comps)
+                     vals (vals each-bolt-and-comps)]
                  ;; TODO: further flatten this into the overall ->> pipeline
                  (map (fn [each-path-through-trellis]
-                        (zipmap (keys each-bolt-and-comps) each-path-through-trellis))
-                      (apply combo/cartesian-product (vals each-bolt-and-comps))))))
+                        (zipmap keys each-path-through-trellis))
+                      (apply combo/cartesian-product vals)))))

      (map (fn [bolt-and-comps]
             {:bolt (get bolt-and-comps [])


make it more clear that bolt is in a vector

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -57,7 +57,7 @@
      ;; For each bolt, create a map of complement positions
      ;; within the bolt to possible complements for that position
      (map (fn [bolt]
-            {:bolt (list bolt)
+            {:bolt bolt
              :comps (comp-paths-to-complements bolt model depth max-depth)}))

      ;; For each such map:complement-position -> complements, find all
@@ -68,7 +68,7 @@
      ;; each complement position.
      (mapcat (fn [{bolt :bolt comps :comps}]
                (let [each-bolt-and-comps
-                     (merge {[] bolt}
+                     (merge {[] [bolt]}
                             comps)]
                  ;; TODO: further flatten this into the overall ->> pipeline
                  (map (fn [each-path-through-trellis]


s/shuffle/lazy-shuffle/

s/shuffle/lazy-shuffle/

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -145,7 +145,7 @@
       (log/debug (str "lightning-bolt(depth=" depth "; total-depth=" total-depth "; cat=" (get-in spec [:synsem :cat]) "; spec=" (strip-refs spec) ")"))
       (let [morph (if morph morph (fn [input] (get-in input [:rule] :default-morph-no-rule)))
             depth (if depth depth 0)
-            parents (shuffle (filter #(not (fail? %)) (mapfn (fn [rule] (unifyc spec rule)) grammar)))]
+            parents (lazy-shuffle (filter #(not (fail? %)) (mapfn (fn [rule] (unifyc spec rule)) grammar)))]
         (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
               (mapcat (fn [parent]
                         (if (= false (get-in parent [:head :phrasal] false))


working on replacing generate with generate2

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -166,7 +166,11 @@
                                   top-bolt))))))))
 (defn generate2
   "Return all expressions matching spec _spec_ given the model _model_."
-  [spec model]
+  [spec model
+   & {:keys [max-total-depth truncate-children lexicon]
+      :or {max-total-depth max-total-depth
+           lexicon nil
+           truncate-children true}}]
   (log/debug (str "generate2: spec: " spec))
   (let [depth 0
         max-depth max-total-depth]


comments and variable renaming

comments and variable renaming

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -92,7 +92,7 @@
                :paths paths
                :comps (map #(comp-path-to-complements bolt % model depth max-depth) paths)})))

-     ;; 4. Create the cartesian product of all the possibile complements at all paths within each bolt.
+     ;; 4. Create the cartesian product of all the possible complements at all paths within each bolt.
      (mapcat (fn [{bolt :bolt comps :comps paths :paths}]
                ;; TODO: further flatten this into the overall ->> pipeline
                (map (fn [each-path-through-trellis]
@@ -101,12 +101,12 @@
                        :trellis each-path-through-trellis})
                     (lazy-seq (apply combo/cartesian-product comps)))))

-     ;; 5. TODO: explain what this step is doing.
+     ;; 5. For each bold, create tree parts for each path-complement pair of the bolt.
      (map (fn [{bolt :bolt paths :paths trellis :trellis}]
             (cons bolt
                   ;; TODO: further flatten this into the overall ->> pipeline
-                  (map (fn [[path trellis]]
-                         (assoc-in {} path trellis))
+                  (map (fn [[path complement]]
+                         (assoc-in {} path complement))
                        (zipmap paths trellis)))))

      ;; 6. Combine each set of tree parts into a tree.


spec test for regex problem

spec test for regex problem

--- src/xl/regex_recursion.clj
+++ src/xl/regex_recursion.clj
@@ -1,15 +1,20 @@
-(ns xl.regex-recursion)
+(ns xl.regex-recursion
+  (:require [clojure.spec :as s]
+            [clojure.spec.gen :as g]
+            [clojure.test.check :as tc]
+            [clojure.test.check.generators :as tcg]
+            [clojure.test.check.generators :as gen]
+            [clojure.set]))

 (defn mat [pat ii ss jj]
   (let [pat-len (count pat)
         ss-len (count ss)]
     (cond
       (= ii pat-len) (= jj ss-len)
-      (= jj ss-len) false
       :else (let [pat-ch (nth pat ii)
             with-star (and (< ii (dec pat-len)) (= \* (nth pat (inc ii))))
-            ss-ch (nth ss jj)
-            match-first (or (= pat-ch ss-ch) (= pat-ch \.))
+            ss-ch (if (>= jj ss-len) nil (nth ss jj))
+            match-first (and (some? ss-ch) (or (= pat-ch ss-ch) (= pat-ch \.)))
             ]
           (if with-star
             (let [case-zero (mat pat (+ ii 2) ss jj)
@@ -36,17 +41,58 @@
     )
   )

-(doseq [ss-pat [
-                ["a" "aa"]
-                ["aa" "aa"]
-                ["aaa" "aa"]
-                ["aa" "a*"]
-                ["aa" ".*"]
-                ["ab" ".*"]
-                ["aab" "c*a*b"]
-                ]]
-  (let [[ss pat] ss-pat]
-    (println "pat:" pat ", ss:" ss)
-    (println "matched: " (match pat ss))
+(defn run-samples []
+  (doseq [ss-pat [
+                  ["a" "aa"]
+                  ["aa" "aa"]
+                  ["aaa" "aa"]
+                  ["aa" "a*"]
+                  ["aa" ".*"]
+                  ["ab" ".*"]
+                  ["aab" "c*a*b"]
+                  ]]
+    (let [[ss pat] ss-pat]
+      (println "pat:" pat ", ss:" ss)
+      (println "matched: " (match pat ss))
+      )
     )
   )
+
+(match ".*T" "")
+
+(defn xnor [a b]
+  (or (and a b) (and (not a) (not b)))
+  )
+
+(def letters
+  (let [get-chars #(set (map (fn [ii] (str (char ii))) (range (int %1) (inc (int %2)))))]
+    (clojure.set/union (get-chars \a \z) (get-chars \A \Z))
+    )
+  )
+
+(def letters-or-dot
+  (clojure.set/union letters #{"."})
+  )
+
+(def pat0
+  (g/fmap (fn [x] (apply str x)) (g/tuple (s/gen letters-or-dot) (s/gen #{"" "*"})))
+  )
+
+(def pat
+  #(g/fmap (fn [x] (apply str x)) (g/vector pat0))
+  )
+
+(s/def ::pat
+  (s/with-gen
+    string?
+    pat
+    ))
+
+(s/fdef match
+        :args (s/cat :pat ::pat :str string?)
+        :ret boolean?
+        :fn (s/and
+              #(xnor
+                 (:ret %)
+                 (re-find (re-pattern (str "^" (-> % :args :pat) "$")) (-> % :args :str))
+                 )))


Simplify app starting

Simplify app starting

Using delay, the task is run only once even if starting the app fails.

--- src/clj/saapas/boot.clj
+++ src/clj/saapas/boot.clj
@@ -7,12 +7,6 @@
     [clojure.java.io :as io]
     [saapas.main :refer :all]))

-(deftask start-app
-  "Start the ring app"
-  []
-  (let [done (atom false)]
-    (with-post-wrap fileset
-      (when-not @done
-        (go)
-        (reset! done true))
-      fileset)))
+(deftask start-app []
+  (let [f (delay (go))]
+    (with-post-wrap fileset @f fileset)))


Moved the points on the chart plotted to be generated on top of the grid

--- src/cljs/aved/core.cljs
+++ src/cljs/aved/core.cljs
@@ -56,6 +56,169 @@
   (.arc ctx x y size 0 (* 2 Math/PI))
   (.fill ctx)
   )
+
+(defn fill-rect [x y w h color]
+  (set! (.-fillStyle ctx) color)
+  (.fillRect ctx x y w h))
+
+;; fill rect for 1 pixel size
+(defn fill-rect1 [x y w h color]
+  (fill-rect x y w h color))
+
+(defn fill-rect2 [x y w h color]
+  (fill-rect x y w h color))
+
+
+(def color (.map sine-wave
+                 (fn [{:keys [sin]}]
+                   (if (< sin 0)
+                     "red"
+                     "blue"))))
+
+(def violet (.map ttime (fn [_] "violet")))
+(def indigo (.map ttime (fn [_] "indigo")))
+(def blue (.map ttime (fn [_] "blue")))
+(def green (.map ttime (fn [_] "green")))
+(def yellow (.map ttime (fn [_] "yellow")))
+(def orange (.map ttime (fn [_] "orange")))
+(def red (.map ttime (fn [_] "red")))
+
+(def tconcat js/Rx.Observable.concat)
+(def defer js/Rx.Observable.defer)
+(def from-event js/Rx.Observable.fromEvent)
+
+(def mouse-click (from-event canvas "click"))
+
+(def mouse-over (from-event canvas "over"))
+
+(defn write-text [text x y]
+  (set! (.-font ctx) "20px Arial")
+  (set! (.-fillStyle ctx) "white")
+  (.fillText ctx text x y))
+
+(defn write-text-s1 [text x y]
+  (set! (.-font ctx) "13px Arial")
+  (set! (.-fillStyle ctx) "white")
+  (.fillText ctx text x y))
+
+(defn write-text-s1-black [text x y]
+  (set! (.-font ctx) "13px Arial")
+  (set! (.-fillStyle ctx) "black")
+  (.fillText ctx text x y))
+
+(write-text "Drugs" 780 710)
+(def right-col-legends {:DE "Death"
+                        :LT "Life Threatening"
+                        :HO "Hospitalization"
+                        :DS "Disability"
+                        :CA "Congenetial Anomaly"
+                        :RI "Required Intervention"
+                        :OT "Other"})
+
+(defn serialize [m sep] (str (clojure.string/join sep (map (fn [[k v]] (str (name k) " " v)) m)) "\n"))
+(.log js/console (str "name = " (serialize right-col-legends " | ")))
+(def right-col-legend-str (serialize right-col-legends " | "))
+
+(write-text-s1 right-col-legend-str 730 780)
+
+;; Rotate Text on CANVAS
+;;context.save();
+;;context.translate(newx, newy);
+;;context.rotate(-Math.PI/2);
+;;context.textAlign = "center";
+;;context.fillText("Your Label Here", labelXposition, 0);
+;;context.restore();
+
+(defn write-rotated-text []
+  (.save ctx)
+  (.translate ctx 500 500)
+  (.rotate ctx (/ (* -1 Math/PI) 2))
+  (set! (.-textAlign ctx) "center")
+  (set! (.-font ctx) "20px Arial")
+  (set! (.-fillStyle ctx) "white")
+  (.fillText ctx "Reactions" 100, -470)
+  (.restore ctx))
+
+(defn write-coordinate-labels []
+  ())
+
+(write-rotated-text)
+
+(.log js/console "test new line ")
+(.log js/console (str "Math.PI value:" Math/PI))
+
+;;     context.beginPath();
+;;      context.moveTo(100, 150);
+;;      context.lineTo(450, 50);
+;;      context.stroke();
+(defn draw-line [x1 y1 x2 y2]
+  (.beginPath ctx)
+  (.moveTo ctx x1 y1)
+  (.lineTo ctx x2 y2)
+  (set! (.-strokeStyle ctx) "#3E3E3E")
+  (.stroke ctx))
+
+(def horizontal-grid-lines [{:x1 1400 :y1 600 :x2 150 :y2 600}])
+(def vertical-grid-lines [{:x1 200 :y1 650 :x2 200 :y2 50 }])
+(def horizontal-lines 6)
+(def vertical-lines 13)
+
+(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} horizontal-grid-lines]
+  (do
+    (.log js/console (str "x1=" x1 " y1=" y1 " x2=" x2 " y2=" y2))
+    (draw-line x1 y1 x2 y2)))
+
+;;
+;; draw the horizontal grid lines
+;;
+(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} horizontal-grid-lines]
+  (dotimes [n horizontal-lines] (.log js/console "Index: " n)
+           (draw-line x1 (- y1 (* n 100)) x2 (- y2 (* n 100)))))
+
+;;
+;; draw the vertical grid lines
+;;
+(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} vertical-grid-lines]
+  (dotimes [n vertical-lines] (.log js/console "Index: " n)
+           (draw-line (+ x1 (* n 100)) y1 (+ x2 (* n 100)) y2)))
+
+
+(fill-rect 1440 20 40 100 "red")
+(fill-rect 1440 120 40 100 "orange")
+(fill-rect 1440 220 40 100 "#F5D282")
+(fill-rect 1440 320 40 100 "#F5F38C")
+(fill-rect 1440 420 40 100 "#B1D8FA")
+(fill-rect 1440 520 40 100 "#3874A8")
+(fill-rect 1440 620 40 100 "#7D4BBF")
+
+
+(write-text-s1-black "DE" 1450 74)
+(write-text-s1-black "LT" 1450 174)
+(write-text-s1-black "HO" 1450 274)
+(write-text-s1-black "DS" 1450 374)
+(write-text-s1-black "CA" 1450 474)
+(write-text-s1-black "RI" 1450 574)
+(write-text-s1-black "OT" 1450 674)
+
+(write-text-s1 "AVANDIA" 175 670)
+(write-text-s1 "ACTOS" 275 670)
+(write-text-s1 "BONIVA" 375 670)
+(write-text-s1 "PRADAXA" 475 670)
+(write-text-s1 "SEROQUEL" 575 670)
+
+(write-text-s1 "Myocordial Infarction" 40 600)
+(write-text-s1 "Bladder Cancer" 40 500)
+(write-text-s1 "Cardiac Failure" 40 430)
+(write-text-s1 "Gastrointestinal" 40 380)
+(write-text-s1 "Hemorrihage" 40 393)
+(write-text-s1 "Cerebuvascular Accident" 40 300)
+(write-text-s1 "Death" 40 250)
+(write-text-s1 "Coronary Artery Disease" 40 210)
+(write-text-s1 "Femur Fracture" 40 180)
+(write-text-s1 "Haematuria" 40 160)
+(write-text-s1 "Pancreatitis" 40 140)
+(write-text-s1 "Type 2" 40 100)
+(write-text-s1 "Diabetes Meilitus" 40 120)

 (fill-circle 300 300 "red" 20)
 (fill-circle 300 300 "yellow" 10)
@@ -72,166 +235,3 @@
 (fill-circle 900 500 "red" 5)
 (fill-circle 1000 100 "red" 5)
 (fill-circle 600 200 "yellow" 3)
-
-(defn fill-rect [x y w h color]
-  (set! (.-fillStyle ctx) color)
-  (.fillRect ctx x y w h))
-
-;; fill rect for 1 pixel size
-(defn fill-rect1 [x y w h color]
-  (fill-rect x y w h color))
-
-(defn fill-rect2 [x y w h color]
-  (fill-rect x y w h color))
-
-
-(def color (.map sine-wave
-                 (fn [{:keys [sin]}]
-                   (if (< sin 0)
-                     "red"
-                     "blue"))))
-
-(def violet (.map ttime (fn [_] "violet")))
-(def indigo (.map ttime (fn [_] "indigo")))
-(def blue (.map ttime (fn [_] "blue")))
-(def green (.map ttime (fn [_] "green")))
-(def yellow (.map ttime (fn [_] "yellow")))
-(def orange (.map ttime (fn [_] "orange")))
-(def red (.map ttime (fn [_] "red")))
-
-(def tconcat js/Rx.Observable.concat)
-(def defer js/Rx.Observable.defer)
-(def from-event js/Rx.Observable.fromEvent)
-
-(def mouse-click (from-event canvas "click"))
-
-(def mouse-over (from-event canvas "over"))
-
-(defn write-text [text x y]
-  (set! (.-font ctx) "20px Arial")
-  (set! (.-fillStyle ctx) "white")
-  (.fillText ctx text x y))
-
-(defn write-text-s1 [text x y]
-  (set! (.-font ctx) "13px Arial")
-  (set! (.-fillStyle ctx) "white")
-  (.fillText ctx text x y))
-
-(defn write-text-s1-black [text x y]
-  (set! (.-font ctx) "13px Arial")
-  (set! (.-fillStyle ctx) "black")
-  (.fillText ctx text x y))
-
-(write-text "Drugs" 780 710)
-(def right-col-legends {:DE "Death"
-                        :LT "Life Threatening"
-                        :HO "Hospitalization"
-                        :DS "Disability"
-                        :CA "Congenetial Anomaly"
-                        :RI "Required Intervention"
-                        :OT "Other"})
-
-(defn serialize [m sep] (str (clojure.string/join sep (map (fn [[k v]] (str (name k) " " v)) m)) "\n"))
-(.log js/console (str "name = " (serialize right-col-legends " | ")))
-(def right-col-legend-str (serialize right-col-legends " | "))
-
-(write-text-s1 right-col-legend-str 730 780)
-
-;; Rotate Text on CANVAS
-;;context.save();
-;;context.translate(newx, newy);
-;;context.rotate(-Math.PI/2);
-;;context.textAlign = "center";
-;;context.fillText("Your Label Here", labelXposition, 0);
-;;context.restore();
-
-(defn write-rotated-text []
-  (.save ctx)
-  (.translate ctx 500 500)
-  (.rotate ctx (/ (* -1 Math/PI) 2))
-  (set! (.-textAlign ctx) "center")
-  (set! (.-font ctx) "20px Arial")
-  (set! (.-fillStyle ctx) "white")
-  (.fillText ctx "Reactions" 100, -470)
-  (.restore ctx))
-
-(defn write-coordinate-labels []
-  ())
-
-(write-rotated-text)
-
-(.log js/console "test new line ")
-(.log js/console (str "Math.PI value:" Math/PI))
-
-;;     context.beginPath();
-;;      context.moveTo(100, 150);
-;;      context.lineTo(450, 50);
-;;      context.stroke();
-(defn draw-line [x1 y1 x2 y2]
-  (.beginPath ctx)
-  (.moveTo ctx x1 y1)
-  (.lineTo ctx x2 y2)
-  (set! (.-strokeStyle ctx) "#3E3E3E")
-  (.stroke ctx))
-
-(def horizontal-grid-lines [{:x1 1400 :y1 600 :x2 150 :y2 600}])
-(def vertical-grid-lines [{:x1 200 :y1 650 :x2 200 :y2 50 }])
-(def horizontal-lines 6)
-(def vertical-lines 13)
-
-(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} horizontal-grid-lines]
-  (do
-    (.log js/console (str "x1=" x1 " y1=" y1 " x2=" x2 " y2=" y2))
-    (draw-line x1 y1 x2 y2)))
-
-;;
-;; draw the horizontal grid lines
-;;
-(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} horizontal-grid-lines]
-  (dotimes [n horizontal-lines] (.log js/console "Index: " n)
-           (draw-line x1 (- y1 (* n 100)) x2 (- y2 (* n 100)))))
-
-;;
-;; draw the vertical grid lines
-;;
-(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} vertical-grid-lines]
-  (dotimes [n vertical-lines] (.log js/console "Index: " n)
-           (draw-line (+ x1 (* n 100)) y1 (+ x2 (* n 100)) y2)))
-
-
-(fill-rect 1440 20 40 100 "red")
-(fill-rect 1440 120 40 100 "orange")
-(fill-rect 1440 220 40 100 "#F5D282")
-(fill-rect 1440 320 40 100 "#F5F38C")
-(fill-rect 1440 420 40 100 "#B1D8FA")
-(fill-rect 1440 520 40 100 "#3874A8")
-(fill-rect 1440 620 40 100 "#7D4BBF")
-
-
-(write-text-s1-black "DE" 1450 74)
-(write-text-s1-black "LT" 1450 174)
-(write-text-s1-black "HO" 1450 274)
-(write-text-s1-black "DS" 1450 374)
-(write-text-s1-black "CA" 1450 474)
-(write-text-s1-black "RI" 1450 574)
-(write-text-s1-black "OT" 1450 674)
-
-(write-text-s1 "AVANDIA" 175 670)
-(write-text-s1 "ACTOS" 275 670)
-(write-text-s1 "BONIVA" 375 670)
-(write-text-s1 "PRADAXA" 475 670)
-(write-text-s1 "SEROQUEL" 575 670)
-
-(write-text-s1 "Myocordial Infarction" 40 600)
-(write-text-s1 "Bladder Cancer" 40 500)
-(write-text-s1 "Cardiac Failure" 40 430)
-(write-text-s1 "Gastrointestinal" 40 380)
-(write-text-s1 "Hemorrihage" 40 393)
-(write-text-s1 "Cerebuvascular Accident" 40 300)
-(write-text-s1 "Death" 40 250)
-(write-text-s1 "Coronary Artery Disease" 40 210)
-(write-text-s1 "Femur Fracture" 40 180)
-(write-text-s1 "Haematuria" 40 160)
-(write-text-s1 "Pancreatitis" 40 140)
-(write-text-s1 "Type 2" 40 100)
-(write-text-s1 "Diabetes Meilitus" 40 120)


add iterable protocol so collections have hookable way to return high performance iterators

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -391,6 +391,9 @@
 (defprotocol ISwap
   (-swap! [o f] [o f a] [o f a b] [o f a b xs]))

+(defprotocol IIterable
+  (-iterator [coll]))
+
 ;; Printing support

 (deftype StringBufferWriter [sb]
@@ -604,6 +607,9 @@
 ;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;;

 (declare array-seq prim-seq IndexedSeq)
+
+(defn iterable? [x]
+  (satisfies? IIterable x))

 (defn clone [value]
   (-clone value))
@@ -2942,7 +2948,9 @@
     (nil? coll) (nil-iter)
     (string? coll) (string-iter coll)
     (array? coll) (array-iter coll)
-    :else (seq-iter coll)))
+    (iterable? coll) (-iterator coll)
+    (seqable? coll) (seq-iter coll)
+    :else (throw (js/Error. (str "Cannot create iterator from " coll)))))

 (declare LazyTransformer)


another tweak for CLJS-890

another tweak for CLJS-890

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -2135,7 +2135,7 @@
   ([] "")
   ([x] (if (nil? x)
          ""
-         (cljs.core/js-str x)))
+         (gstring/buildString x)))
   ([x & ys]
     (loop [sb (StringBuffer. (str x)) more ys]
       (if more


Remove commented code from cats.core ns.

--- src/cljx/cats/core.cljx
+++ src/cljx/cats/core.cljx
@@ -25,9 +25,9 @@

 (ns cats.core
   "Category Theory abstractions for Clojure"
-  (:require [cats.protocols :as p])
   #+cljs
   (:require-macros [cats.core :refer (with-monad mlet)])
+  (:require [cats.protocols :as p])
   (:refer-clojure :exclude [when unless filter sequence]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -202,25 +202,6 @@
                                 (fn [~(gensym)] ~acc))
                    `(bind ~r (fn [~l] ~acc))))
                `(do ~@body))))
-
-;; Same as the following but with :let []
-;; (defmacro errlet
-;;   [bindings & body]
-;;   (let [pairs (reverse (partition 2 bindings))]
-;;     (reduce (fn [acc [l r]]
-;;               (condp = l
-;;                 :let  `(let ~r ~acc)
-;;                 `(let [c# (atom 0)
-;;                        ~l (bind ~r (fn [v#]
-;;                                      (swap! c# inc)
-;;                                      (return v#)))]
-;;                    (if (= @c# 0)
-;;                      ~l
-;;                      (with-monad (get-current-context-or ~l)
-;;                        (let [~l (p/get-value ~l)]
-;;                          ~acc))))))
-;;             `(do ~@body)
-;;             pairs)))

 (defmacro errlet
   [bindings & body]


Make supported sockets map public.

Make supported sockets map public.

--- src/clojure/nanomsg.clj
+++ src/clojure/nanomsg.clj
@@ -6,15 +6,9 @@
            (nanomsg.bus BusSocket)
            (nanomsg Socket Constants)))

-(def ^:private supported-sockets {:pub PubSocket :sub SubSocket
-                                  :req ReqSocket :rep RepSocket
-                                  :bus BusSocket :pair PairSocket})
-(defn socket
-  "Create a new socket."
-  [^clojure.lang.Keyword socktype]
-  {:pre [(contains? supported-sockets socktype)]}
-  (let [cls (-> socktype supported-sockets)]
-    (.newInstance cls)))
+(def ^:static supported-sockets {:pub PubSocket :sub SubSocket
+                                 :req ReqSocket :rep RepSocket
+                                 :bus BusSocket :pair PairSocket})

 (defn bind
   "Bind socket."


install "default" file to correct location

... as referred to in initscript and where it belongs to by convention,
on redhat based systems.

--- tasks/leiningen/fatrpm.clj
+++ tasks/leiningen/fatrpm.clj
@@ -130,11 +130,11 @@
                            "riemann.config")]}

         ; Default file
-        {:directory "/etc/default"
+        {:directory "/etc/sysconfig"
          :filemode "644"
          :configuration true
          :sources [(source (file (:root project) "pkg" "riemann-default")
-                           "riemann-default")]}
+                           "riemann")]}

         ; Init script
         {:directory "/etc/init.d"


Don't throw conch errors.

Don't throw conch errors.

--- src/defragment/feed.clj
+++ src/defragment/feed.clj
@@ -57,7 +57,8 @@
 (defn get-duration
   [full-path]
   (log/debug "getting duration for" full-path)
-  (try
+  (binding [sh/*throw* false]
+    (try
     (->> full-path
          ogginfo
          string/split-lines
@@ -68,7 +69,8 @@
          m:s->h:m:s)
     (catch Exception e
       (log/error e)
-      "04:00:00")))
+      "04:00:00"))))
+

 (defn read-header
   [f]
@@ -100,6 +102,7 @@
 (defn process-dir
   [link dirpath]
   (for [f (file/file-names dirpath  #".*?\.ogg")]
+    ;; TODO: if the file is already in the db, don't process it.
     (process-file link dirpath f)))

 (defn get-files
@@ -233,5 +236,4 @@
          (urepl/massive-spew "/tmp/foo.edn")))

-
     )


Add take-when

Add take-when

--- src/detritus/update.clj
+++ src/detritus/update.clj
@@ -95,3 +95,15 @@
     (if (pred x)
       (apply f x args)
       x)))
+
+(defn take-when
+  "Helper useful for parsing regular function argument seqeunces. If a predicate
+  is satisfied, returns a pair [(first col), (rest col)] otherwise returns the pair
+  [empty, col].
+
+  Ex. (let [[?docstring args] (take-when string? \"\" args)
+            [?attr-map  args] (take-when map? {} args)]
+        ..)"
+  [f empty col]
+  (let [[x & rest] col]
+    (if (f x) [x rest] [empty col])))


oops-debug

oops-debug

--- src/ontrail/summary.clj
+++ src/ontrail/summary.clj
@@ -9,13 +9,12 @@
 (def #^{:private true} logger (org.slf4j.LoggerFactory/getLogger (str *ns*)))

 (defn avghr [db-retmap]
-  (.debug logger (str "avghr" db-retmap))
   (let [hrcount (:hrcount db-retmap)]
     (if (and (not (nil? hrcount)) (> hrcount 0))
       (/ (:tavghr db-retmap) hrcount)
       0)))

-;; fix these pointings
+;; Fix these map acceses to be idiomatic clojure, when you see them!
 (defn to-summary [db-object sport]
   (let [db-retmap (first (get db-object :retval))
         count (int (get db-object :count))


refactor existing http request metrics

refactor existing http request metrics

--- src/prometheus/core.clj
+++ src/prometheus/core.clj
@@ -9,24 +9,7 @@
     (io.prometheus.client Counter Histogram Counter$Child Histogram$Child CollectorRegistry Gauge Gauge$Child)))

 ; more useful set of buckets for microservice APIs than the defaults provided by the Histogram class
-(def histogram-buckets (atom [0.001, 0.005, 0.010, 0.020, 0.050, 0.100, 0.200, 0.300, 0.500, 0.750, 1, 5]))
-
-(defn- ^Counter make-request-counter [app-name registry]
-  (-> (Counter/build)
-      (.namespace app-name)
-      (.name "http_requests_total")
-      (.labelNames (into-array String ["method" "status" "statusClass" "path"]))
-      (.help "A counter of the total number of HTTP requests processed.")
-      (.register registry)))
-
-(defn- ^Histogram make-request-histogram [app-name registry]
-  (-> (Histogram/build)
-      (.buckets (double-array @histogram-buckets))
-      (.namespace app-name)
-      (.name "http_request_latency_seconds")
-      (.labelNames (into-array String ["method" "status" "statusClass" "path"]))
-      (.help "A histogram of the response latency for HTTP requests in seconds.")
-      (.register registry)))
+(def request-latency-histogram-buckets (atom [0.001, 0.005, 0.010, 0.020, 0.050, 0.100, 0.200, 0.300, 0.500, 0.750, 1, 5]))

 (defn- ^Counter$Child counter-with-labels [^Counter counter label-array] (.labels counter (into-array String label-array)))

@@ -110,18 +93,28 @@
       response)
     response))

-(defn- record-request-metric [counter histogram request-method response-status request-time response-path]
+(defn- record-request-metric [metrics-store app-name request-method response-status request-time response-path]
   (let [status-class (str (int (/ response-status 100)) "XX")
         method-label (string/upper-case (name request-method))
         labels [method-label (str response-status) status-class response-path]]
-    (-> (histogram-with-labels histogram labels) (.observe request-time))
-    (-> (counter-with-labels counter labels) (.inc))))
+    (track-observation metrics-store app-name "http_request_latency_seconds" request-time labels)
+    (increase-counter metrics-store app-name "http_requests_total")))

 (defn instrument-handler
   "Ring middleware to record request metrics"
   [handler ^String app-name ^CollectorRegistry registry]
-  (let [counter (make-request-counter app-name registry)
-        histogram (make-request-histogram app-name registry)]
+  (let [metrics-store {:registry registry}
+        metrics-store (register-counter metrics-store
+                                        app-name
+                                        "http_requests_total"
+                                        "A counter of the total number of HTTP requests processed."
+                                        ["method" "status" "statusClass" "path"])
+        metrics-store (register-histogram metrics-store
+                                          app-name
+                                          "http_request_latency_seconds"
+                                          "A histogram of the response latency for HTTP requests in seconds."
+                                          ["method" "status" "statusClass" "path"]
+                                          @request-latency-histogram-buckets)]
     (fn [request]
       (let [request-method (:request-method request)
             start-time (System/currentTimeMillis)
@@ -130,7 +123,7 @@
             response-status (get response :status 404)
             response-path (get (meta response) :path "unspecified")
             request-time (/ (double (- finish-time start-time)) 1000.0)]
-        (record-request-metric counter histogram request-method response-status request-time response-path)
+        (record-request-metric metrics-store app-name request-method response-status request-time response-path)
         response))))

 (defn dump-metrics


Small fix

Small fix

--- src/radiomitre/core.clj
+++ src/radiomitre/core.clj
@@ -103,7 +103,7 @@
      fjs.parentNode.insertBefore(js, fjs);
    }(document, 'script', 'facebook-jssdk'));"]
     [:style
-     ".title {-webkit-text-stroke: 1px black;text-align:center;position:absolute;top:5px;z-index:100;font-size:23px;color:white;font-weight:bold}
+     ".title {width:100%;-webkit-text-stroke: 1px black;text-align:center;position:absolute;top:5px;z-index:100;font-size:23px;color:white;font-weight:bold}
       .date {position:absolute;right:3px;bottom:30px;color:#DDD;font-size:13px}
       .screen {position:absolute;border-radius:7px;top:0;bottom:0;left:0;width:100%;background-color:rgba(0,0,0,0.3)}
       .article {position:relative;border:1px solid #AAA;border-radius:8px;margin:15px 0;height:300px;background-size:cover}


Threadpool executor service: better queue depth estimate.

Now ignores tasks actively executing.

--- src/riemann/service.clj
+++ src/riemann/service.clj
@@ -203,8 +203,11 @@

                                            :dtime      (- time (:time stats))
                                            :time       time})))
-            queue-size (- tasks-accepted tasks-completed)
-            queue-used (/ queue-size queue-capacity)
+            threads-active  (.getActiveCount executor)
+            queue-size      (max 0 (- tasks-accepted
+                                      tasks-completed
+                                      threads-active))
+            queue-used      (/ queue-size queue-capacity)
             queue-used-state (condp < queue-used
                                3/4 "critical"
                                1/2 "warning"
@@ -235,7 +238,7 @@
           :state   queue-used-state
           :time    time}
          {:service (s "threads active")
-          :metric  (.getActiveCount executor)
+          :metric  threads-active
           :state   "ok"
           :time    time}
          {:service (s "threads alive")


improve throttle docstring

improve throttle docstring

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -1058,7 +1058,9 @@
            bottom-stream))))

 (defn throttle
-  "Passes on n events every dt seconds. Drops events when necessary."
+  "Passes on at most n events every dt seconds. If more than n events arrive in
+  a dt-second fixed window, drops remaining events. Imposes no additional
+  latency; events are either passed on immediately or dropped."
   [n dt & children]
   (part-time-simple
     dt


Cosmetic improvements on mzero function implementation.

--- src/cats/core.cljc
+++ src/cats/core.cljc
@@ -132,8 +132,7 @@

 (defn mzero
   ([]
-   (let [ctx (get-current-context)]
-     (p/mzero ctx)))
+   (p/mzero (get-current-context)))
   ([ctx]
    (p/mzero ctx)))


Added profiles for development and production

--- resources/leiningen/new/retro_fever/core/project.clj
+++ resources/leiningen/new/retro_fever/core/project.clj
@@ -16,15 +16,20 @@
   :plugins [[lein-cljsbuild "1.0.4"]<% if plugins %>
             <<plugins>><% endif %>]

-  :cljsbuild {
-    :builds [{
-      :source-paths ["src"]
-        :compiler {
-          :output-to "resources/public/game/<<name>>.js"
-          :output-dir "resources/public/game/out"
-          :optimizations :none
-          :pretty-print true}}]}
-<% if any dev-dependencies dev-plugins%>
+  :cljsbuild {:builds
+              {:game {:source-paths ["src"]
+                      :compiler {:output-to "resources/public/game/<<sanitized>>.js"
+                                 :output-dir "resources/public/game/out"
+                                 :optimizations :none
+                                 :pretty-print true}}}}
+
+  :clean-targets ^{:protect false} ["resources/public/game/"]
+
   :profiles
-  {:dev {:dependencies [<<dev-dependencies>>]
-         :plugins [<<dev-plugins>>]}})<% endif %>
+  {:dev  {<% if any dev-dependencies dev-plugins%>:dependencies [<<dev-dependencies>>]
+          :plugins [<<dev-plugins>>]
+          <% endif %>:cljsbuild {:builds {:game {:source-paths ["env/dev"]}}}}
+   :prod {:cljsbuild {:builds
+                      {:game {:source-paths ["env/prod"]
+                              :compiler {:optimizations :advanced}}}}}}
+)


Clean up tests and handle bugfix in last commit.

--- test/monocle/test/core.clj
+++ test/monocle/test/core.clj
@@ -1,16 +1,17 @@
 (ns monocle.test.core
   (:use clojure.test)
   (:use monocle.core :reload-all)
-  (:require [clojure.java.io :as io])
+  (:require [clojure.java.io :as jio]
+            [monocle.io :as io])
   (:import (java.io File)))

-(def tmp nil)
+(def ofile nil)

 (use-fixtures :each
   (fn [t]
-    (with-redefs [tmp (File/createTempFile "__monocle-" ".offset")]
+    (with-redefs [ofile (File/createTempFile "__monocle-" ".offset")]
       (t)
-      (.delete tmp))))
+      (.delete ofile))))

 (deftest args
   (testing "testing opts"
@@ -24,44 +25,56 @@
            (seq (amqp-opts "amqp://localhost/test|test.exchange|foo"))))))

 (deftest offset
-  (testing "should publish offset after reading"
+  (testing "should NOT publish offset after reading"
     (let [out (with-out-str
-                (main {:file (.getPath (io/resource "log.txt"))
-                       :offset-file (str tmp)
+                (main {:file (.getPath (jio/resource "log.txt"))
+                       :offset-file ofile
                        :interface "stdout"
                        :batch 3
                        :reset true}))]
+      (is (= 0 (io/slurp-offset ofile)))
       (is (.startsWith out "{\"time"))
       (is (= 3 (count (re-seq #"-- \n" out))))))
   (testing "should publish offset after reading"
     (let [out (with-out-str
-                (main {:file (.getPath (io/resource "log.txt"))
-                       :offset-file (str tmp)
+                (main {:file (.getPath (jio/resource "log.txt"))
+                       :offset-file ofile
+                       :interface "stdout"
+                       :batch 3
+                       :reset false}))]
+      (is (= (.length (jio/file (jio/resource "log.txt")))
+             (io/slurp-offset ofile)))
+      (is (.startsWith out "{\"time"))
+      (is (= 3 (count (re-seq #"-- \n" out))))))
+  (testing "should not do anything since last read was to the end of file"
+    (let [out (with-out-str
+                (main {:file (.getPath (jio/resource "log.txt"))
+                       :offset-file ofile
+                       :interface "stdout"
+                       :batch 3
+                       :reset false}))]
+      (is (empty? out))))
+  (testing "should reset offset when it extends past file length"
+    (io/spit-offset ofile (inc (.length (jio/file (jio/resource "log.txt")))))
+    (let [out (with-out-str
+                (main {:file (.getPath (jio/resource "log.txt"))
+                       :offset-file ofile
                        :interface "stdout"
                        :batch 3
                        :reset false}))]
       (is (.startsWith out "{\"time"))
-      (is (= 3 (count (re-seq #"-- \n" out))))))
-  (testing "should publish offset after reading"
-    (let [out (with-out-str
-                (main {:file (.getPath (io/resource "log.txt"))
-                       :offset-file (str tmp)
-                       :interface "stdout"
-                       :batch 3
-                       :reset false}))]
-      (is (not (.startsWith out "{\"time")))
-      (is (= 0 (count (re-seq #"-- \n" out)))))))
+      (is (= 3 (count (re-seq #"-- \n" out)))))))

 (deftest bulk
   (testing "should add bulk format"
     (let [out (with-out-str
-                (main {:file (.getPath (io/resource "bulk.txt"))
-                       :offset-file (str tmp)
+                (main {:file (.getPath (jio/resource "bulk.txt"))
+                       :offset-file ofile
                        :interface "stdout"
                        :batch 1
                        :reset false
                        :index "foo"
                        :type "t"}))
-          ans (slurp (io/resource "bulk-answer.txt"))]
+          ans (slurp (jio/resource "bulk-answer.txt"))]
       (is (= out ans))
       (is (= 2 (count (re-seq #"-- \n" out)))))))


use test fixture to set up datomic

use test fixture to set up datomic

--- test/shelver/user_test.clj
+++ test/shelver/user_test.clj
@@ -7,11 +7,20 @@
             [datomic.api :as d :refer [db q]]
             [com.stuartsierra.component :as component]))

+(def datomic nil)
+
+;"datomic:dev://datomic-db:4334/shelver"
+(defn datomic-test-fixture [test-fn]
+  (let [datomic-component (-> (new-datomic "datomic:mem://shelver" "migrations/schema.edn")
+                              component/start)]
+    (with-redefs [datomic datomic-component]
+      (test-fn))
+    (component/stop datomic-component)))
+
+(use-fixtures :once datomic-test-fixture)
+
 (deftest test-create-user
-  (let [datomic-uri (or "datomic:dev://datomic-db:4334/shelver" "datomic:mem://shelver")
-        datomic (-> (new-datomic datomic-uri "migrations/schema.edn")
-                    component/start)
-        crypto-client (crypto/->DefaultCryptoClient 4321 64 32)]
+  (let [crypto-client (crypto/->DefaultCryptoClient 4321 64 32)]
     (testing "testing create and find a user"
       (let [email (-> (java.util.UUID/randomUUID)
                       str
@@ -39,10 +48,7 @@
       (is (nil? (user/find-user (db (:conn datomic)) (str (java.util.UUID/randomUUID))))))))

 (deftest test-oauth-token
-  (let [datomic-uri (or "datomic:dev://datomic-db:4334/shelver" "datomic:mem://shelver")
-        datomic (-> (new-datomic datomic-uri "migrations/schema.edn")
-                    component/start)
-        crypto-client (crypto/->DefaultCryptoClient 4321 64 32)]
+  (let [crypto-client (crypto/->DefaultCryptoClient 4321 64 32)]
     (testing "testing find an oauth token attached to a user"
       (let [email (-> (java.util.UUID/randomUUID)
                       str


add comment

add comment

--- src/dalap/html.clj
+++ src/dalap/html.clj
@@ -68,6 +68,7 @@
      (apply escape-html (flatten (dalap.walk/walk [x] visitor-fn)))))

 ;;; helpers
+;;; maybe these should be in a different module
 (def doctype
   {:html4
    (safe "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" "


Ah, parens, you are my enemy

Ah, parens, you are my enemy

--- src/fatty/core.clj
+++ src/fatty/core.clj
@@ -107,13 +107,14 @@
     (execute-step step (.getPath (if (= (soft :source) nil)
                                    (file-str fatty-build-dir)
                                    (if (= (soft :build-subdir) nil)
-                                     (file-str fatty-build-dir "/" (soft :source)
-                                     (file-str fatty-build-dir "/" (soft :source) "/" (soft :build-subdir)))))))))
+                                     (file-str fatty-build-dir "/" (soft :source))
+                                     (file-str fatty-build-dir "/" (soft :source) "/" (soft :build-subdir))))))))

 (defn build
   "Build a software package - runs prep for you"
   [soft]
-  (clean soft)
-  (prep soft)
-  (run-steps soft))
+  (do
+    (clean soft)
+    (prep soft)
+    (run-steps soft)))


Fix ant calls.

Fix ant calls.

--- tasks.clj
+++ tasks.clj
@@ -25,10 +25,12 @@
         bakejar (bakejar)]
     (ant Jar {:dest-file bakejar}
          (add-fileset {:dir "dev"})
-         (add-dev-jars))
+         add-dev-jars
+         execute)
     (ant Jar {:dest-file jarfile :update true}
          (add-fileset {:file bakejar})
-         (add-dev-jars))))
+         add-dev-jars
+         execute)))

 (deftask gem
   "Build standalone gem package."
@@ -36,14 +38,19 @@
     (if (snapshot? version)
       (println "refusing to make gem since this is a snapshot version:" version)
       (do (invoke uberjar)
-          (ant Copy {:file (uberjarfile) :tofile (file "gem/lib/cake.jar")})
-          (ant Copy {:file (bakejar)     :tofile (file "gem/lib/bake.jar")})
+          (ant Copy {:file (uberjarfile) :tofile (file "gem/lib/cake.jar")}
+               execute)
+          (ant Copy {:file (bakejar)     :tofile (file "gem/lib/bake.jar")}
+               execute)
           (ant Copy {:tofile (file "gem/lib/clojure.jar")}
-               (add-fileset {:dir "lib" :includes (clojure-jar)}))
-          (ant Copy {:file (file "bin/cake") :tofile (file "gem/bin/cake")})
+               (add-fileset {:dir "lib" :includes (clojure-jar)})
+               execute)
+          (ant Copy {:file (file "bin/cake") :tofile (file "gem/bin/cake")}
+               execute)
           (ant ExecTask {:executable "gem" :dir (file "gem")}
                (env {"CAKE_VERSION" version})
-               (args ["build" "cake.gemspec"]))))))
+               (args ["build" "cake.gemspec"])
+               execute)))))

 (undeftask release)
 (deftask release #{uberjar gem tag}
@@ -54,10 +61,12 @@
         jar       (format "jars/cake-%s.jar" version)]
     (with-root (file "releases")
       (git "pull"))
-    (ant Copy {:file (uberjarfile) :tofile (file "releases" jar)})
+    (ant Copy {:file (uberjarfile) :tofile (file "releases" jar)}
+         execute)
     (spit (file "releases/current") version)
     (when-not snapshot?
-      (ant Copy {:file (file "bin" "cake") :tofile (file "releases" "cake")})
+      (ant Copy {:file (file "bin" "cake") :tofile (file "releases" "cake")}
+           execute)
       (spit (file "releases/stable") version))
     (with-root (file "releases")
       (git "add" jar "cake" "current" "stable")
@@ -67,4 +76,5 @@
       (let [gem (str "cake-" version ".gem")]
         (log "Releasing gem:" gem)
         (ant ExecTask {:executable "gem" :dir (file "gem")}
-             (args ["push" gem]))))))
+             (args ["push" gem])
+             execute)))))


introduces metrics for measuring delay in obtaining synchronizat… (#980)

--- waiter/src/waiter/core.clj
+++ waiter/src/waiter/core.clj
@@ -25,6 +25,7 @@
             [full.async :refer (<?? <? go-try)]
             [metrics.core]
             [metrics.counters :as counters]
+            [metrics.meters :as meters]
             [metrics.timers :as timers]
             [plumbing.core :as pc]
             [qbits.jet.client.http :as http]
@@ -764,11 +765,19 @@
                             curator]
                      (fn synchronize-fn [path f]
                        (let [lock-path (str base-path "/" path)]
+                         (meters/mark! (metrics/waiter-meter "core" "synchronize" "invocation-rate"))
                          (timers/start-stop-time!
                            (metrics/waiter-timer "core" "synchronize" "all")
                            (timers/start-stop-time!
-                             (metrics/waiter-timer "core" "synchronize" (str "cs-" path))
-                             (curator/synchronize curator lock-path mutex-timeout-ms f))))))})
+                             (metrics/waiter-timer "core" "synchronize" (str "all-" path))
+                             (curator/synchronize
+                               curator lock-path mutex-timeout-ms
+                               (fn []
+                                 (timers/start-stop-time!
+                                   (metrics/waiter-timer "core" "synchronize" "cs")
+                                   (timers/start-stop-time!
+                                     (metrics/waiter-timer "core" "synchronize" (str "cs-" path))
+                                     (f))))))))))})

 (def scheduler
   {:scheduler (pc/fnk [[:settings scheduler-config scheduler-syncer-interval-secs]


Use Domina as a source dependency in sample app

--- sample-app/project.clj
+++ sample-app/project.clj
@@ -4,8 +4,7 @@
                  [org.clojure/clojurescript "0.0-993"]
                  [ring "1.0.0-RC1"]
                  [compojure "0.6.4"]
-                 [enlive "1.0.0"]
-                 [domina "1.0.0-beta1"]]
+                 [enlive "1.0.0"]]
   :repl-init one.sample.repl
   :source-path "src/app/clj"
   :extra-classpath-dirs ["src/app/cljs"
@@ -13,4 +12,5 @@
                          "src/lib/clj"
                          "src/lib/cljs"
                          "templates"
-                         "../src"])
+                         "../src"
+                         "../domina/src/cljs"])


Доработка

Доработка


[CS] initialize is a superset of run-migrations

--- resources/leiningen/new/kraken/core.clj
+++ resources/leiningen/new/kraken/core.clj
@@ -7,10 +7,8 @@
               [immutant.util :as immutant]))

 (defn -main [& args]
-  (when (config :datomic :intitialize)
-    (db/initialize))
-  (when (config :datomic :run-migrations)
-    (db/run-migrations))
+  (cond (config :datomic :intitialize) (db/initialize)
+        (config :datomic :run-migrations) (db/run-migrations))
   (let [rabbit-resources (queue/initialize)]
     (immutant/at-exit (fn []
                         (queue/close-all! rabbit-resources)


do not slurp whole file in clj script (consumes too much memory)

--- scripts/draw_tiles.clj
+++ scripts/draw_tiles.clj
@@ -11,7 +11,7 @@
 (defn read-polys []
   (map
   	#(.split % " ")
-  	(remove #(.isEmpty %) (.split (slurp* (first *command-line-args*)) "\n"))))
+  	(remove #(.isEmpty %) (read-lines (first *command-line-args*)))))

 (defn polys-grouped-by-tile []
   (reduce


reverse direction of info so it mimics old behaviour.

--- src-cljs/defpi/ws.cljs
+++ src-cljs/defpi/ws.cljs
@@ -1,24 +1,65 @@
 (ns defpi.ws
-  (:require [defpi.dom :refer [by-id by-class set-html! get-html]]
-            [goog.events :as events]
-            [goog.events.EventType]
-            [cljs.reader :as reader]
-            [defpi.canvas :as c]))
+  (:require  [defpi.dom :refer [by-id by-class
+                                set-html!
+                                get-html
+                                append-child!
+                                insert-before!]]
+             [cljs.reader :as reader]
+             [defpi.canvas :as c]
+              [dommy.utils :as utils]
+              [dommy.core :as dommy])
+
+  (:use-macros
+   [dommy.macros :only [sel sel1]]))
+
+(def err-cnt (atom 0))

 (def ws (js/WebSocket. (str "ws://" (.-host (.-location js/window)))))

 (defn show-msg
   [val]
-  (let [msgs    (by-id "msgs")
-        content (str val "<br />" (get-html msgs))]
-    (js/console.log (str "show: " content))
-    ;(set-html! msgs content)
-    ))
+  (let [msgs     (by-id "msgs")
+        p        (.createElement js/document "p")
+        val-node (.createTextNode js/document val)]

-(defn show-sketch
+    (js/console.log (str "show: " val))
+    (append-child! p val-node)
+
+    (if-let [c (.-firstElementChild msgs)]
+      (.insertBefore msgs p c)
+      (append-child! msgs p))))
+
+(defn show-err
   [msg]
-  (c/draw-circle msg))
+  (let [cnt       (swap! err-cnt inc)
+        val       (:val msg)
+        backtrace (:backtrace msg)
+        msgs      (by-id "msgs")
+        div       (.createElement js/document "div")
+        err       (.createElement js/document "p")
+        stack     (.createElement js/document "p")
+        val-node  (.createTextNode js/document val)
+        bt-node   (.createTextNode js/document backtrace)
+        id        (str "spi-error-" cnt)]

+    (.setAttribute div "class" "expandable")
+    (.setAttribute stack "class" "hidden-content")
+    (.setAttribute div "id" id)
+
+    (set! (.-scrollTop div) 0)
+
+    (set! (.-display (.-style stack)) "none")
+
+    (append-child! err val-node)
+    (append-child! stack bt-node)
+    (append-child! div err)
+    (append-child! div stack)
+
+
+    (if-let [c (.-firstElementChild msgs)]
+      (.insertBefore msgs div c)
+      (append-child! msgs div))
+))

 (defmulti handle-message :type)

@@ -29,6 +70,14 @@
 (defmethod handle-message :sketch
   [msg]
   (show-sketch (:opts msg)))
+
+(defmethod handle-message :error
+  [msg]
+  (show-err msg))
+
+(defmethod handle-message js/Object
+  [m]
+  (js/console.log "can't handle: " (:type m)))

 (defn add-ws-handlers
   []


Fix values join in fmt-namelist

Fix values join in fmt-namelist

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -29,7 +29,7 @@
   (fmt-sh m #(str "\"$(echo $" % " | tr [:upper:] [:lower:])\"")))

 (defn- fmt-namelist [m]
-  (let [f0 (fn [[dataref values]] (str "  " dataref "=" values "\n"))
+  (let [f0 (fn [[dataref values]] (str "  " dataref "=" (string/join "," values) "\n"))
         f1 (fn [[name nv_sequence]] (str "&" name "\n" (strmap f0 (sort nv_sequence)) "/\n"))]
     (strmap f1 (sort m))))


work on add support

work on add support

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -33,18 +33,26 @@
 (defn nml-name [x]
   (nml-str (second x)))

-(defn nml-add [tree parent child match]
+(defn nml-add [tree parent child match proxy]
+;; (println tree)
+;; (println parent child match proxy)
   (let [missing? (fn [children] (not-any? #(= (nml-name %) match) children))
-        f (fn [& children] (into [parent (if (missing? children) (parse (str match "=0") :start child))] children))]
+        f (fn [& children] (if (missing? children)
+                             (into [parent (parse proxy :start child)] children)
+                             (into [parent] children)))]
+;;   (println (insta/transform {parent f} tree))
+;;   (println "###")
     (insta/transform {parent f} tree)))

 (defn nml-set [tree nml key val & sub]
   (let [child  (if sub :nvsubseq :stmt)
         match  (if sub key nml)
         parent (if sub :nvseq :s)
+        proxy  (if sub (str match "=0") (str "&" match " /"))
         vnew   (if sub (fn [tree] (parse val :start :values)) #(nml-set % nml key val true))
-        f      (fn [k v] [child k (if (= (nml-str k) match) (vnew v) v)])]
-    (insta/transform {child f} (if sub (nml-add tree parent child match) tree))))
+;;       f      (fn ([k v] (println (str "### k " k)) (println (str "### v " v)) [child k (if (= (nml-str k) match) (vnew v) v)]))]
+        f      (fn ([k v] [child k (if (= (nml-str k) match) (vnew v) v)]))]
+    (insta/transform {child f} (nml-add tree parent child match proxy))))

 (defn nml-sets [tree sets]
   (loop [t tree s sets]
@@ -135,7 +143,7 @@
         sets (:set options)
         tree (nml-tree (first arguments))]
     (if (and gets sets) (fail "Do not mix get and set operations."))
-;;(println tree)
+;;   (println tree)
     (cond gets (nml-gets tree gets)
           sets (println (nml-str (nml-sets tree sets)))
           :else (println (nml-str tree)))))


Revert "See if dev env isn't fully up before tests start."

This reverts commit f7b5b05191b83ea29816c472ba5648f416c1263e.

--- src/onyx/api.clj
+++ src/onyx/api.clj
@@ -237,9 +237,7 @@
   "Starts a development environment using an in-memory implementation ZooKeeper."
   [env-config]
   (validator/validate-env-config env-config)
-  (let [env (component/start (system/onyx-development-env env-config))]
-    (Thread/sleep 2000)
-    env))
+  (component/start (system/onyx-development-env env-config)))

 (defn ^{:added "0.6.0"} shutdown-env
   "Shuts down the given development environment."


Call .end on deflater when we're done

Call .end on deflater when we're done

Otherwise it'll hold on to the data and might leak memory if GC is not
called fast enough. See https://docs.oracle.com/javase/7/docs/api/java/util/zip/Deflater.html#end()

License: Apache License 2.0
Signed-off-by: Victor Bjelkholm <46f1a0bd5592a2f9244ca321b129902a06b53e03@victor.earth>

--- src-clj/zlib_tiny/core.clj
+++ src-clj/zlib_tiny/core.clj
@@ -80,9 +80,11 @@
    (when b
      (IOUtils/toByteArray (DeflaterInputStream. (ByteArrayInputStream. b)))))
   ([b level]
-   (let [deflater (Deflater. level)]
-     (IOUtils/toByteArray (DeflaterInputStream. (ByteArrayInputStream. b)
-                                                deflater)))))
+   (let [deflater (Deflater. level)
+         ba (IOUtils/toByteArray (DeflaterInputStream. (ByteArrayInputStream. b)
+                                                       deflater))]
+     (.end deflater)
+     ba)))

 (comment "ZLib Example"
          (bytes->str (force-byte-array (inflate (deflate (str->bytes "test it!"))))))


Updated conexp.contrib.todo

Updated conexp.contrib.todo

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

--- src/conexp/contrib/todo.clj
+++ src/conexp/contrib/todo.clj
@@ -6,7 +6,8 @@
 ;; the terms of this license.
 ;; You must not remove this notice, or any other, from this software.

-(ns #^{:doc "Provides information on all tasks planned for conexp-clj."}
+(ns
+    #^{:doc "Provides information on all tasks planned for conexp-clj."}
   conexp.contrib.todo
   (:use clojure.contrib.def)
   (:use [clojure.contrib.string :only (split)])
@@ -15,34 +16,25 @@
 ;;;

 (defvar- *conexp-todo-list*
-  { "conexp" { "layout" { "util"     [ "Implement function for inf-irr-addivite layout." ],
-			  "force"    [ "Implement force layout as described by C. Zschalig." ],
-			  "zschalig" [ "Implement initial positioning and force distribution layout as described by C. Zschalig."] },
-
+  { "conexp" { "layout" { "force"    [ "Implement force layout with derivations?" ],
+			  "zschalig" [ "Implement initial positioning as described by C. Zschalig."] },
 	       "fca"    { "rules"    [ "Think about and write some code." ],
 			  "association-rules" [ "More?" ],
 			  "exploration" [ "Add background knowledge (implications or clauses)." ],
 			  "contexts" [ "Better implementation for context-for-clop." ] },
-
-	       "graphics" { "draw"   [ "Implement full lattice editor" ],
-			    "base"   [ "Get current lattice layout from a GScene." ] },
-
 	       "gui"    { "plugins"  { "contexteditor" [ "Design and implement." ],
 				       "latticeeditor" [ "Design and implement." ],
 				       "codeeditor"    [ "Design and implement." ],
 				       "browser"       [ "Design and implement graphical plugin browser." ] } },
-
 	       "contrib" { "fuzzy"   [ "Design and implement something for FuzzyFCA (Cynthia)." ],
 			   "rough"   [ "Design and implement something for RoughSets (Christian)." ],
-			   "algorithms" { "bitwise" [ "Add In-Close and fast Calculations for Luxenburger Bases.",
-						      "Add preconditioned NextClosure." ],
-					  "parallel" [ "Implement ParallelNextClosure and Krajca-Outrata-Vychodil." ] } },
-
+			   "algorithms" { "concepts"
+					  [ "Check In-Close and add fast Calculations for Luxenburger Bases.",
+					    "Add preconditioned NextClosure.",
+					    "Implement ParallelNextClosure and Krajca-Outrata-Vychodil." ] } },
 	       "tests"  ["Add tests for everything.",
-			 { "util"     [ "Add more tests." ],
-			   "base"     [ "Check whether everything has been tested." ],
-			   "fca"      { "contexts" [ "Finish tests." ],
-					"implications" [ "Finish tests." ] }, } ] },
+			 { "fca"  { "contexts" [ "Finish tests." ],
+				    "implications" [ "Finish tests." ] } } ] },
     "doc"    [ "Add docstrings for namespaces.",
 	       "Add docstrings for all functions.",
 	       "Extend LaTeX-Documentation." ] })


Rename option s/disabled-hud/disable-hud/

--- src/adzerk/boot_reload.clj
+++ src/adzerk/boot_reload.clj
@@ -98,7 +98,7 @@
    _ asset-host HOST   str "The asset-host where to load files from. Defaults to host of opened page. (optional)"
    a asset-path PATH   str "The asset-path. This is removed from the start of reloaded urls. (optional)"
    o open-file COMMAND str "The command to run when warning or exception is clicked on HUD. Passed to format. (optional)"
-   v disabled-hud      bool "Toggle to disable HUD. Defaults to false (visible)."]
+   v disable-hud      bool "Toggle to disable HUD. Defaults to false (visible)."]

   (let [pod  (make-pod)
         src  (tmp-dir!)
@@ -124,7 +124,7 @@
               fileset (try
                         (next-task fileset)
                         (catch Exception e
-                          (if (and (= :boot-cljs (:from (ex-data e))) (not disabled-hud))
+                          (if (and (= :boot-cljs (:from (ex-data e))) (not disable-hud))
                             (send-visual! @pod {:exception (merge {:message (.getMessage e)}
                                                                   (ex-data e))}))
                           (throw e)))]
@@ -134,7 +134,7 @@
                                   (map b/tmp-path)
                                   (map(fn [x] (clojure.string/replace x #"\.cljs\.edn$" ".js")))
                                   set)]
-            (if-not disabled-hud
+            (if-not disable-hud
               (send-visual! @pod {:warnings warnings}))
             ; Only send changed files when there are no warnings
             ; As prev is updated only when changes are sent, changes are queued untill they can be sent


Use unprepared queries

Use unprepared queries

--- src/org/spootnik/cyanite/store.clj
+++ src/org/spootnik/cyanite/store.clj
@@ -48,7 +48,11 @@
     "UPDATE metric USING TTL ? SET data = data + ? "
     "WHERE tenant = ? AND rollup = ? AND period = ? AND path = ? AND time = ?;")))

-(defn fetchq
+(def ^:const fetchq (str "SELECT data,time FROM metric WHERE "
+                         "path = ? AND tenant = ? AND rollup = ? AND period = ? "
+                         "AND time >= ? AND time <= ?;"))
+
+(defn fetchqp
   "Yields a cassandra prepared statement of 7 arguments:

 * `paths`: list of paths
@@ -61,10 +65,7 @@
   [session]
   (alia/prepare
    session
-   (str
-    "SELECT data,time FROM metric WHERE "
-    "path = ? AND tenant = ? AND rollup = ? AND period = ? "
-    "AND time >= ? AND time <= ?;")))
+   fetchq))

 (defn useq
@@ -121,7 +122,8 @@
                          (let [points (object-array asize)
                                agg-fn (agg-fn-by-path %)
                                rows (->> (alia/execute
-                                          session fetch!
+                                          session
+                                          fetch!
                                           {:values [% tenant (int rollup)
                                                     (int period)
                                                     from to]
@@ -162,7 +164,7 @@
                                                                                :remote 8192}}})
                     (alia/connect keyspace))
         insert! (insertq session)
-        fetch!  (fetchq session)]
+        fetch!  (fetchqp session)]
     (reify
       Metricstore
       (channel-for [this]
@@ -199,7 +201,7 @@
         (let [min-point  (align-time from rollup)
               max-point  (align-time (apply min [to (now)]) rollup)]
           (if-let [series (and (seq paths)
-                               (par-fetch session fetch! paths tenant rollup
+                               (par-fetch session fetchq paths tenant rollup
                                           period min-point max-point))]
             (format "{\"from\":%s,\"to\":%s,\"step\":%s,\"series\":%s}"
                     min-point max-point rollup series)


Normalize parameters to deflayout and defpartial.

--- src/incise/layouts/html.clj
+++ src/incise/layouts/html.clj
@@ -4,6 +4,13 @@

 (declare ^:dynamic *site-options*)
 (declare ^:dynamic *parse*)
+
+(defmacro with-normalized-params [& body]
+  `(let [[~'doc-string ~'destructuring ~'body]
+         (if (string? ~'doc-string?)
+           [~'doc-string? ~'destructuring ~'body]
+           ["" ~'doc-string? (conj ~'body ~'destructuring)])]
+     ~@body))

 (defmacro deflayout
   "This is a helper macro for defining html layout functions. An html layout
@@ -18,10 +25,7 @@
   macro and binind the functions arguments to *site-options* and *parse* so
   partials can easily access them."
   [sym-name doc-string? destructuring & body]
-  (let [[doc-string destructuring]
-        (if (string? doc-string?)
-          [doc-string? destructuring]
-          ["" doc-string?])]
+  (with-normalized-params
     `(defn ~sym-name
        ~doc-string
        [site-options# ^incise.parsers.parse.Parse parse#]
@@ -31,13 +35,9 @@
            (with-scope ~@body))))))

 (defmacro defpartial
-  "Defines a 'partial' which is baically some hiccup markup. An arguments vector
-  is required and can be used to destructure the dynamic vars set by a layout."
+  "Defines a 'partial' which is basically a function with some default context."
   [sym-name doc-string? destructuring & body]
-  (let [[doc-string destructuring body]
-        (if (string? doc-string?)
-          [doc-string? destructuring body]
-          ["" doc-string? (conj body destructuring)])]
+  (with-normalized-params
     `(defn ~sym-name
        ~doc-string
        [& args#]