Fix race condition in global ordinal

Fix race condition in global ordinal

--- src/clj/runbld/process.clj
+++ src/clj/runbld/process.clj
@@ -6,6 +6,26 @@
             [runbld.util.date :as date]
             [runbld.util.io :as io]))

+(def empty-metrics
+  {:ordinal
+   {:global 0
+    :stdout 0
+    :stderr 0}
+   :bytes
+   {:global 0
+    :stdout 0
+    :stderr 0}})
+
+(s/defn capture-metrics
+  [stream :- s/Keyword
+   metrics :- clojure.lang.Ref]
+  (fn [line]
+    (let [line-bytes (inc (count (.getBytes line)))]
+      (alter metrics update-in [:ordinal :global] inc)
+      (alter metrics update-in [:ordinal stream] inc)
+      (alter metrics update-in [:bytes :global] + line-bytes)
+      (alter metrics update-in [:bytes stream] + line-bytes))))
+
 (s/defn capture-ordinal
   [ord :- clojure.lang.Atom]
   (fn [line]
@@ -24,26 +44,29 @@
       (flush))))

 (s/defn capture-to-es
-  ([opts           :- OptsElasticsearch
-    id             :- s/Str
-    type           :- s/Keyword
-    global-ordinal :- clojure.lang.Atom
-    stream-ordinal :- clojure.lang.Atom]
+  ([opts    :- OptsElasticsearch
+    id      :- s/Str
+    stream  :- s/Keyword
+    metrics :- clojure.lang.Ref]
    (fn [line]
      (let [doc {:build-id id
-                :stream (name type)
+                :stream (name stream)
                 :time (date/ms-to-iso)
                 :log line
-                :ordinal {:global @global-ordinal
-                          :stream @stream-ordinal}}]
+                :ordinal {:global (get-in @metrics [:ordinal :global])
+                          :stream (get-in @metrics [:ordinal stream])}}]
        (store/save-log! opts doc)))))

 (s/defn spit-stream :- s/Keyword
   [input        :- java.io.InputStream
    processors   :- [clojure.lang.IFn]]
   (doseq [line (line-seq (io/reader input))]
-    (doseq [processor processors]
-      (processor line)))
+    ;; dosync: in order for the global ordinal to order in accordance
+    ;; with time, metrics calculation can only happen one stream at a
+    ;; time
+    (dosync
+     (doseq [processor processors]
+       (processor line))))
   :done)

 (s/defn spit-process :- [java.util.concurrent.Future]
@@ -138,53 +161,45 @@
     es-opts    :- OptsElasticsearch
     env        :- {s/Str s/Str}]
    (let [dir (io/abspath-file cwd)
-         global-ordinal (atom 0)
+         metrics (ref empty-metrics)
          out-file (io/prepend-path dir stdout)
-         out-ordinal (atom 0)
-         out-bytes (atom 0)
          err-file (io/prepend-path dir stderr)
-         err-ordinal (atom 0)
-         err-bytes (atom 0)
          result
          (with-open [outw (java.io.PrintWriter. out-file)
                      errw (java.io.PrintWriter. err-file)]
            (let [processors
-                 {:out [(capture-ordinal global-ordinal)
-                        (capture-ordinal out-ordinal)
-                        (capture-bytes out-bytes)
+                 {:out [(capture-metrics :stdout metrics)
                         (capture-to-writer *out*)
                         (capture-to-writer outw)
                         (capture-to-es es-opts
                                        build-id
                                        :stdout
-                                       global-ordinal
-                                       out-ordinal)]
-                  :err [(capture-ordinal global-ordinal)
-                        (capture-ordinal err-ordinal)
-                        (capture-bytes err-bytes)
+                                       metrics)]
+                  :err [(capture-metrics :stderr metrics)
                         (capture-to-writer *err*)
                         (capture-to-writer errw)
                         (capture-to-es es-opts
                                        build-id
                                        :stderr
-                                       global-ordinal
-                                       err-ordinal)]}]
+                                       metrics)]}]
              (exec program args scriptfile cwd env processors)))
+         out-bytes (get-in @metrics [:bytes :stdout])
+         err-bytes (get-in @metrics [:bytes :stderr])
          out-file-bytes (count (slurp out-file))
          err-file-bytes (count (slurp err-file))]
      (store/after-log es-opts)
      (merge
       result
-      {:out-bytes @out-bytes
-       :err-bytes @err-bytes
+      {:out-bytes out-bytes
+       :err-bytes err-bytes
        :out-file (str out-file)
        :err-file (str err-file)
        :out-file-bytes out-file-bytes
        :err-file-bytes err-file-bytes
        :out-accuracy (data/scaled-percent
-                      out-file-bytes @out-bytes)
+                      out-file-bytes out-bytes)
        :err-accuracy (data/scaled-percent
-                      err-file-bytes @err-bytes)}))))
+                      err-file-bytes err-bytes)}))))

 (s/defn run :- {(s/required-key :opts) MainOpts
                 (s/required-key :process-result) ProcessResult}


Started to add some controls to the accordion

--- src/cljs/omnibar/core.cljs
+++ src/cljs/omnibar/core.cljs
@@ -210,6 +210,15 @@
             :on-mouse-up #(stop-chord! chord)
             :r "27" :stroke "black" :stroke-width "1" :fill "red"}] )

+(defn button [title [x y]]
+  [:g {:class "tile" :transform (str "translate(" x "," y ")")}
+   [:polygon {:transform "rotate(-30),scale(1.6,1.6)"
+              :fill "#57C2B2"
+              :stroke "#000"
+              :stroke-width "0.5"
+              :points hexagon-points}]
+   [:text {:y "0.4em" :font-size "70%" :fill "#fff" :text-anchor "middle"} title] ])
+
 (defn accordion-keyboard [shape note]
   (let [[x y] (:position note)
         title (:text note)
@@ -230,7 +239,7 @@

 (defn accordion-group [shape note-group]
   (let [{notes :notes heading :text row :row} note-group
-        y-start-pos 43
+        y-start-pos 93
         x-start-pos 33
         hy (+ x-start-pos (* row 27))
         hx (+ y-start-pos (* row 48))]
@@ -245,6 +254,13 @@
            :viewBox (str "0 0 100% " h)
    :style {:outline "2px solid black"
            :background-color "#eee"}}
+     (button "Hold" [295 34])
+     (button ":saw" [405 34])
+     (button ":square" [460 34])
+     (button ":sine" [515 34])
+     (button ":triangle" [570 34])
+
+
      (map #(accordion-group shape %) accord/stradella-bass) ])

 ;; -------------------------
@@ -266,8 +282,8 @@
    [:div
     [svg-piano-keyboard2 150 2000]

-    [svg-accordion [320 2000] "hexagon"]
-    [svg-accordion [320 1250] "circle"]
+    [svg-accordion [370 2000] "hexagon"]
+    ;;[svg-accordion [320 1250] "circle"]
     [svg-piano-keyboard 150 2000]
     ;;[svg-inkscape-hexagons 250 500]
     ]])


json-handler working like a proper mw, sort json responses

--- src/cljsbin/endpoints.cljs
+++ src/cljsbin/endpoints.cljs
@@ -1,62 +1,79 @@
 (ns cljsbin.endpoints
   (:require
    [clojure.string]
+   [clojure.walk :as walk]
    [bidi.bidi :as bidi]
    [macchiato.util.response :as r]
    [macchiato.util.request :refer [request-url body-string]]
+   [macchiato.http :refer [IHTTPResponseWriter]]
    [camel-snake-kebab.core :refer [->HTTP-Header-Case]]))

-;; TODO make json responses sorted dicts, like httpbin does
-;; TODO consider making this a proper middleware, i.e. give the handler req, res and raise
-;; wraping the response function instead calling it here
+;; TODO move this to a mw folder
+(defn deep-sort-map
+  "Recursively walk the structure converting maps in sorted maps."
+  [form]
+  (walk/postwalk (fn [val]
+                   (if (map? val) (into (sorted-map) val) val))
+                 form))
+
+;; TODO remove when enew version is published
+;; https://github.com/macchiato-framework/macchiato-core/pull/11
+(extend-protocol IHTTPResponseWriter
+  cljs.core/PersistentTreeMap
+
+  (-write-response [data node-server-response _]
+    (.write node-server-response (-> data clj->js js/JSON.stringify))
+    (.end node-server-response)))
+
 (defn json-handler
   "Wrap a handler to set json content type, default to a 200 status and call res."
   [handler]
   (fn [req res raise]
-    (let [result (handler req)
-          result (if (r/response? result) result (r/ok result))]
-      (-> result
-          (r/content-type "application/json")
-          (res)))))
+    (let [respond (fn [result]
+                    (-> (if (r/response? result) result (r/ok result))
+                        (update-in [:body] deep-sort-map)
+                        (r/content-type "application/json")
+                        (res)))]
+      (handler req respond raise))))

 (def ip
   "Returns Origin IP."
-  (json-handler (fn [req]
-                  {:origin (:remote-addr req)})))
+  (json-handler (fn [req res raise]
+                  (res {:origin (:remote-addr req)}))))

 (def user-agent
   "Returns user-agent."
-  (json-handler (fn [req]
-                  {:user-agent (get-in req [:headers "user-agent"])})))
+  (json-handler (fn [req res raise]
+                  (res {:user-agent (get-in req [:headers "user-agent"])}))))

 (defn clean-headers
   "Return a sorted map of headers with the proper casing."
   [req]
   (->> (:headers req)
        (map (fn [[k v]] [(->HTTP-Header-Case k) v]))
-       (into (sorted-map))))
+       (into {})))

 (def headers "Returns header dict."
-  (json-handler (fn [req]
-                  {:headers (clean-headers req)})))
+  (json-handler (fn [req res raise]
+                  (res {:headers (clean-headers req)}))))

 (def get_ "Returns GET data."
-  (json-handler (fn [req]
-                  {:args (:params req)
-                   :headers (clean-headers req)
-                   :origin (:remote-addr req)
-                   :url (request-url req)})))
+  (json-handler (fn [req res raise]
+                  (res {:args (:params req)
+                        :headers (clean-headers req)
+                        :origin (:remote-addr req)
+                        :url (request-url req)}))))

 (def body-data "Common handler for post, put, patch and delete routes."
-  (json-handler (fn [req]
-                  {:args (:query-params req)
-                   :data (:body req)
-                   :files {} ;; FIXME process files when present
-                   :form (:form-params req)
-                   :headers (clean-headers req)
-                   :json (:json req)
-                   :origin (:remote-addr req)
-                   :url (request-url req)})))
+  (json-handler (fn [req res raise]
+                  (res {:args (:query-params req)
+                        :data (:body req)
+                        :files {} ;; FIXME process files when present
+                        :form (:form-params req)
+                        :headers (clean-headers req)
+                        :json (:json req)
+                        :origin (:remote-addr req)
+                        :url (request-url req)}))))

 (def post "Returns POST data." body-data)
 (def put "Returns PUT data." body-data)
@@ -148,7 +165,8 @@
   (into {} (map (fn [[k v]] [k (:value v)]) cookies)))

 (def cookies "Return cookie data."
-  (json-handler (fn [req] {:cookies (flatten-cookies (:cookies req))})))
+  (json-handler (fn [req res raise]
+                  (res {:cookies (flatten-cookies (:cookies req))}))))

 ;; FIXME should use json-handler once its adapted
 (defn set-cookies


add partition-by

add partition-by

--- src/clojure/flambo/api.clj
+++ src/clojure/flambo/api.clj
@@ -10,7 +10,7 @@
 ;; happily accepted!
 ;;
 (ns flambo.api
-  (:refer-clojure :exclude [fn map reduce first count take distinct filter group-by values])
+  (:refer-clojure :exclude [fn map reduce first count take distinct filter group-by values partition-by])
   (:require [serializable.fn :as sfn]
             [clojure.tools.logging :as log]
             [flambo.function :refer [flat-map-function
@@ -29,7 +29,8 @@
            [java.util Comparator ArrayList]
            [org.apache.spark.api.java JavaSparkContext StorageLevels
             JavaRDD JavaDoubleRDD]
-           [org.apache.spark.rdd PartitionwiseSampledRDD]))
+           [org.apache.spark.rdd PartitionwiseSampledRDD]
+           [org.apache.spark HashPartitioner Partitioner]))

 ;; flambo makes extensive use of kryo to serialize and deserialize clojure functions
 ;; and data structures. Here we ensure that these properties are set so they are inhereted
@@ -336,6 +337,20 @@
   ([rdd n shuffle?]
    (.coalesce rdd n shuffle?)))

+(defn hash-partitioner
+  ([n]
+   (HashPartitioner. n))
+  ([subkey-fn n]
+   (proxy [HashPartitioner] [n]
+     (getPartition [key]
+       (let [subkey (subkey-fn key)]
+         (mod (hash subkey) n))))))
+
+(defn partition-by
+  "Partition `rdd` by `partitioner`."
+  [rdd partitioner]
+  (.partitionBy rdd partitioner))
+
 (defn repartition
   "Returns a new `rdd` with exactly `n` partitions."
   [rdd n]


Hooks for plugins now take the frame as single argument

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

--- src/conexp/gui/plugins.clj
+++ src/conexp/gui/plugins.clj
@@ -15,7 +15,8 @@
     :load-hook fn-called-when-plugin-is-loaded
     :unload-hook fn-called-when-plugin-is-unloaded)

-  whereas the :unload-hook is optional."
+  whereas the :unload-hook is optional. All functions take the frame
+  the plugin-manager operates on as single argument"
   [name & hooks]
   (let [hooks (apply hash-map hooks)]
     (if (not (contains? hooks :load-hook))
@@ -60,7 +61,7 @@
     (illegal-argument "Plugin already be loaded."))
   (dosync
    (alter (loaded-plugins) conj plugin))
-  ((load-hook plugin)))
+  ((load-hook plugin) (base-frame plugin-manager)))

 (defn unload-plugin
   "Unloads a plugin from a plugin manager."
@@ -74,7 +75,7 @@
       (illegal-argument "Plugin didn't provide an unload-hook and can therefore not be unloaded."))
     (dosync
      (alter (loaded-plugins plugin-manager) disj plugin))
-    (unload-hook)))
+    (unload-hook (base-frame plugin-manager))))

 (defn unregister-plugin
   "Unregisters a plugin from a plugin manager."
@@ -84,4 +85,9 @@
   (dosync
    (alter (registered-plugins plugin-manager) disj plugin)))

+
+;; TODO:
+;; searching for plugins in files and directories
+;; graphical plugin-browser (extra namespace)
+
 nil


fcalib conversion functions for formal contexts

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

--- src/conexp/util/fcalib.clj
+++ src/conexp/util/fcalib.clj
@@ -8,32 +8,70 @@

 (ns conexp.util.fcalib
   (:use conexp.base
+        conexp.fca.contexts
         conexp.fca.implications)
-  (:import [de.tudresden.inf.tcs.fcaapi FCAImplication]
-           [de.tudresden.inf.tcs.fcalib Implication]
-           ;; for now, we use conexp-ng's implementation, until the corresponding code is
-           ;; available in fcalib
-           [fcatools.conexpng.model FormalContext]))
+  (:import [de.tudresden.inf.tcs.fcaapi FCAImplication FCAObject ObjectDescription]
+           [de.tudresden.inf.tcs.fcalib Implication FullObject FormalContext ImplicationSet]))
+
+(ns-doc "Functions to convert to and from fcalib")

 ;;

-(defn to-fcalib-context [conexp-clj-context]
-  (not-yet-implemented))
+(defn stringify-context
+  "Applies «str» to all objects and attributes of the given formal context «ctx» (in
+  conexp-clj format).  Note that if two objects or attributes receive the same string
+  representation this way, they are merged into one."
+  [context]
+  (-> context
+      (rename-attributes str)
+      (rename-objects str)))

-(defn from-fcalib-context [^FormalContext fcalib-context]
-  (not-yet-implemented))
+(defn ^FormalContext to-fcalib-context
+  "Converts formal contexts as they are used by conexp-clj to formal contexts as used by fcalib.

-(defn to-fcalib-implication [conexp-clj-implication]
+  Note that currently, due to implementation-specific restrictions, only formal contexts
+  having objects and attributes as strings are allowed."
+  [conexp-clj-context]
+  (let [^FormalContext fcalib-context (fcatools.conexpng.model.FormalContext.)]
+    (doseq [m (attributes conexp-clj-context)]
+      (.addAttribute fcalib-context m))
+    (doseq [g (objects conexp-clj-context)]
+      (let [^FCAobject fcalib-g (FullObject. g (oprime conexp-clj-context #{g}))]
+        (.addObject fcalib-context fcalib-g)))
+    fcalib-context))
+
+(defn from-fcalib-context
+  "Converts formal contexts as they are used by fcalib to formal contexts as used by conexp.clj."
+  [^FormalContext fcalib-context]
+  (let [full-objects        (set (.getObjects fcalib-context)),
+        attributes          (set (.getAttributes fcalib-context)),
+        object-descriptions (reduce! (fn [map, ^FCAObject full-object]
+                                       (assoc! map
+                                         (.getIdentifier full-object)
+                                         (.getDescription full-object)))
+                                     {}
+                                     full-objects),
+        objects             (set (keys object-descriptions))]
+    (make-context-nc objects
+                     attributes
+                     (set-of [g m] [g objects
+                                    m attributes
+                                    :when (.containsAttribute ^ObjectDescription (get object-descriptions g)
+                                                              m)]))))
+
+(defn ^FCAImplication to-fcalib-implication
   "Convert implications as used in conexp-clj to implications as used by fcalib."
+  [conexp-clj-implication]
   (Implication. (premise conexp-clj-implication)
                 (conclusion conexp-clj-implication)))

-(defn from-fcalib-implication [^FCAImplication fcalib-implication]
+(defn from-fcalib-implication
   "Convert implications as used in fcalib to implications as used in conexp-clj."
+  [^FCAImplication fcalib-implication]
   (make-implication (.getPremise fcalib-implication)
                     (.getConclusion fcalib-implication)))

-(defn to-fcalib-implication-set [conexp-clj-set-of-implications]
+(defn ^ImplicationSet to-fcalib-implication-set [conexp-clj-context conexp-clj-set-of-implications]
   (not-yet-implemented))

 ;;


Conversion to and from fcalib implications

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

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

 (ns conexp.util.fcalib
-  (:use conexp.base)
+  (:use conexp.base
+        conexp.fca.implications)
   (:import [de.tudresden.inf.tcs.fcaapi FCAImplication]
            [de.tudresden.inf.tcs.fcalib Implication]
            ;; for now, we use conexp-ng's implementation, until the corresponding code is
@@ -16,19 +17,23 @@

 ;;

-(defn fcalib-to-context [conexp-clj-context]
+(defn to-fcalib-context [conexp-clj-context]
   (not-yet-implemented))

-(defn fcalib-from-context [^FormalContext fcalib-context]
+(defn from-fcalib-context [^FormalContext fcalib-context]
   (not-yet-implemented))

-(defn fcalib-to-implication [conexp-clj-implication]
-  (not-yet-implemented))
+(defn to-fcalib-implication [conexp-clj-implication]
+  "Convert implications as used in conexp-clj to implications as used by fcalib."
+  (Implication. (premise conexp-clj-implication)
+                (conclusion conexp-clj-implication)))

-(defn fcalib-from-implication [^FCAImplication fcalib-implication]
-  (not-yet-implemented))
+(defn from-fcalib-implication [^FCAImplication fcalib-implication]
+  "Convert implications as used in fcalib to implications as used in conexp-clj."
+  (make-implication (.getPremise fcalib-implication)
+                    (.getConclusion fcalib-implication)))

-(defn fcalib-to-implication-set [conexp-clj-set-of-implications]
+(defn to-fcalib-implication-set [conexp-clj-set-of-implications]
   (not-yet-implemented))

 ;;


Remove unneeded fields clause

Remove unneeded fields clause

--- src/core/clj/virt/core.clj
+++ src/core/clj/virt/core.clj
@@ -71,7 +71,6 @@

 (defn get-messages [thread-id]
   (korma/select messages
-    (korma/fields :message)
     (korma/where {:thread_id thread-id})))

 (defn chat-messages-handler [request]


Infer file type from suffix on filename

Infer file type from suffix on filename

--- src/dot_utility/radial.clj
+++ src/dot_utility/radial.clj
@@ -170,13 +170,18 @@
       (.show))
     radar))

+(defn type-from-file
+  [filename]
+  (or (second (first (re-seq #".*\.([^\.]*)$" filename))) "png"))
+
 (defn write-radar-display-to-file
   [ds filename & options]
   (let [{:keys [width height]} (into default-frame-options (apply hash-map options))
-        image (BufferedImage. width height BufferedImage/TYPE_INT_RGB)]
+        image (BufferedImage. width height BufferedImage/TYPE_INT_RGB)
+        image-type (type-from-file filename)]
     (with-antialiasing (.createGraphics image)
       (draw-radar ds width height))
-    (ImageIO/write image "jpeg" (File. filename))))
+    (ImageIO/write image image-type (File. filename))))

 (def test-data
      '[("Performance" 1 10)


cleaned up a bit

cleaned up a bit

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -247,11 +247,11 @@
       (apply dom/span nil
         (om/build-all track-view (:track-order data))))))

-(defn render-track-bar [data root-id display-bar-id progress-bar-id progress-ball-id ball-position]
+(defn render-track-bar [root-id display-bar-id progress-bar-id progress-ball-id ball-position]
   (let [height 20]
     (dom/div nil
       (let [top (/ height 2)
-            width (+ (.height (js/$ "#display-bar-id")))
+            width (+ (.height (js/$ (str "#" display-bar-id))))
             display-style #js {:height (str height "px")
                        :top (str top "px")
                        :borderRadius (str (/ height 2) "px")}]
@@ -265,7 +265,7 @@
         (dom/div #js {:id progress-bar-id
                       :className "track-bar"
                       :style bar-style}
-          (let [percent-completed (ball-position)
+          (let [percent-completed ball-position
                 style #js {:left (str percent-completed "%")}]
               (dom/div #js {:id progress-ball-id
                             :className "bar-tracker"
@@ -279,7 +279,7 @@
                   (dom/div #js {:className "track-ball-display"
                                 :style track-ball-display-style})))))))))

-(defn track-bar-did-mount [data owner ball-id containment start stop]
+(defn track-bar-did-mount [owner ball-id containment start stop]
   (.addEventListener js/window "resize" #(om/refresh! owner))
   (.draggable (js/$ ball-id) #js {:axis "x"
                                   :containment containment
@@ -291,23 +291,23 @@
   (reify
     om/IRender
     (render [this]
-      (render-track-bar data "#progress-track"
-                             "progress-track-bar-display"
-                             "progress-track-bar"
-                             "progress-track-ball"
-                             #(if (nil? (:current-sound data))
-                                  0
-                                  (* 100 (/ (:current-sound-position data)
-                                            (.-duration (:current-sound data)))))))
+      (render-track-bar "#progress-track"
+                        "progress-track-bar-display"
+                        "progress-track-bar"
+                        "progress-track-ball"
+                        (if (nil? (:current-sound data))
+                            0
+                            (* 100 (/ (:current-sound-position data)
+                                      (.-duration (:current-sound data)))))))

     om/IDidMount
     (did-mount [this]
-     (track-bar-did-mount data owner "#progress-track-ball"
-                                     "#progress-track-bar"
-                                     #(swap! player/app-state assoc
-                                             :ball-being-dragged?
-                                             true)
-                                     core/on-drag-stop))))
+     (track-bar-did-mount owner "#progress-track-ball"
+                                "#progress-track-bar"
+                                #(swap! player/app-state assoc
+                                        :ball-being-dragged?
+                                        true)
+                                core/on-drag-stop))))

 (defn play-pause-button [data owner]
   (reify
@@ -404,19 +404,19 @@
   (reify
     om/IRender
     (render [this]
-      (render-track-bar data "#volume"
-                             "volume-bar-display"
-                             "volume-bar"
-                             "volume-ball"
-                             #(:volume data)))
+      (render-track-bar "#volume"
+                        "volume-bar-display"
+                        "volume-bar"
+                        "volume-ball"
+                        (:volume data)))

     om/IDidMount
     (did-mount [this]
-      (track-bar-did-mount data owner "#volume-ball"
-                                      "#volume-bar"
-                                      nil
-                                      core/on-volume-drag-stop))))
+      (track-bar-did-mount owner "#volume-ball"
+                                 "#volume-bar"
+                                 nil
+                                 core/on-volume-drag-stop))))

 (om/root volume player/app-state {:target (. js/document (getElementById "volume"))})


Remove dependency on mysql views.

Remove dependency on mysql views.

--- src/haystack/ecommerce.clj
+++ src/haystack/ecommerce.clj
@@ -85,7 +85,6 @@

-
 (def product-query-sql
 "SELECT
 now() AS 'updated-at',
@@ -95,9 +94,9 @@
 `products`.`product_class_id` AS `product-class-id`,
 `categories_products`.`category_id` AS `category-id`,
 `categories`.`parent_id` AS `category-parent-id`,
-`solr_categories`.`category_ids` AS `category-ids`,
-`solr_categories`.`category_path` AS `category-path`,
-`solr_service_centers`.`service_center_ids` AS `service-center-ids`,
+`search_categories`.`category_ids` AS `category-ids`,
+`search_categories`.`category_path` AS `category-path`,
+`search_service_centers`.`service_center_ids` AS `service-center-ids`,
 IFNULL(`products`.`step_title`,`products`.`name`) AS `name`,
 IFNULL(`products`.`step_description`,`products`.`long_description`) AS `description`,
 `products`.`upc` AS `upc`,
@@ -114,12 +113,21 @@
   ON (`products`.`id` = `external_files`.`product_id` and `external_files`.`type` = 'image')
 LEFT JOIN `categories_products`
 ON (`products`.`id` = `categories_products`.`product_id`)
-LEFT JOIN `solr_categories`
-ON (`categories_products`.`category_id` = `solr_categories`.`category_id`)
+LEFT JOIN
+(
+ SELECT `solr_category_ancestors`.`descendant_id` AS `category_id`,group_concat(`categories`.`id` order by `solr_category_ancestors`.`generations` DESC separator ',') AS `category_ids`,concat('/',group_concat(`categories`.`id` order by `solr_category_ancestors`.`generations` DESC separator '/')) AS `category_path`
+ FROM ((`category_hierarchies` `solr_category_ancestors` join `category_hierarchies` `solr_category_descendants` on((`solr_category_ancestors`.`descendant_id` = `solr_category_descendants`.`ancestor_id`))) join `categories` on((`solr_category_ancestors`.`ancestor_id` = `categories`.`id`))) where (`solr_category_descendants`.`generations` = 0) group by `solr_category_descendants`.`descendant_id`
+) AS `search_categories`
+ON (`categories_products`.`category_id` = `search_categories`.`category_id`)
 LEFT JOIN `product_classes`
 ON (`products`.`product_class_id` = `product_classes`.`id`)
-LEFT JOIN `solr_service_centers`
-ON (`products`.`id` = `solr_service_centers`.`product_id`)
+LEFT JOIN
+(
+ SELECT `stock_statuses`.`product_id` AS `product_id`,group_concat(`stock_statuses`.`service_center_id` separator ',') AS `service_center_ids`
+ FROM `stock_statuses` where (`stock_statuses`.`eod_qty` > 0) group by `stock_statuses`.`product_id`
+) AS `search_service_centers`
+ON (`products`.`id` = `search_service_centers`.`product_id`)
+
 LEFT JOIN `manufacturers`
 ON (`products`.`manufacturer_id` = `manufacturers`.`id`)
 LEFT JOIN `categories`
@@ -130,19 +138,19 @@
  FROM `category_hierarchies`
  GROUP BY 1
  HAVING MAX(`category_hierarchies`.`generations`) = 0
- )
-AS `leaves`
+ ) AS `leaves`
 ON (`categories`.`id` = `leaves`.`ancestor_id`)
 INNER JOIN
 (
- SELECT MAX(`stock_statuses`.`product_id`) as `product_id`, SUM(`stock_statuses`.`eod_qty`) as `eod_qty`
+ SELECT `stock_statuses`.`product_id` as `product_id`, SUM(`stock_statuses`.`eod_qty`) as `eod_qty`
  FROM `stock_statuses`
  GROUP BY `stock_statuses`.`product_id`
- )
-AS `ss`
+ ) AS `ss`
 ON (`products`.`id` = `ss`.`product_id`)
 ;
 ")
+
+;; (println "\n\n" product-query-sql)

 (defn clean-product-plus [m]
   (cond-> m


Only define the compiler state once to avoid recompilation.

--- src/klangmeister/eval.cljs
+++ src/klangmeister/eval.cljs
@@ -17,10 +17,12 @@
 (defn loader [{:keys [name]} callback]
   (callback {:lang :clj :source (get dependencies name "")}))

+(defonce state (cljs/empty-state))
+
 (defn uate
   [expr-str]
   (cljs/eval-str
-    (cljs/empty-state)
+    state
     expr-str
     nil
     {:eval cljs/js-eval


apply compile because, as it turns out, a lazy seq isn't a file.

--- src/leiningen/protobuf.clj
+++ src/leiningen/protobuf.clj
@@ -150,7 +150,7 @@
 (defn compile
   "Compile protocol buffer files located in proto dir."
   ([project]
-     (compile project (proto-files (io/file (or (:proto-path project) "proto")))))
+     (apply compile project (proto-files (io/file (or (:proto-path project) "proto")))))
   ([project & files]
      (install project)
      (when (= "protobuf" (:name project))


The result of -compile must always be in dependency order

--- src/lib/clj/one/reload.clj
+++ src/lib/clj/one/reload.clj
@@ -12,7 +12,7 @@

   Reloading/Compilation or shared Clojure and ClojureScript files is
   also supported."
-  (:use [cljs.closure :only (build -compile Compilable)]
+  (:use [cljs.closure :only (build -compile dependency-order Compilable)]
         [cljs.compiler :only (to-target-file)])
   (:require [clojure.java.io :as io]))

@@ -112,7 +112,7 @@
     (all-descendants-ending-with dirs ".cljs"))
   Compilable
   (-compile [_ opts]
-    (flatten (map #(-compile % opts) dirs))))
+    (dependency-order (flatten (map #(-compile % opts) dirs)))))

 (defn rename-to-js
   "Rename any Clojure-based file to a JavaScript file."
@@ -148,10 +148,11 @@
     (filter-descendants dir pred))
   Compilable
   (-compile [this opts]
-    (let [fs (files this)]
-      (let [d (io/file dir)]
-        (flatten (map #(-compile % (assoc opts :output-file (js-file-name d %)))
-                      fs))))))
+    (dependency-order
+     (let [fs (files this)]
+       (let [d (io/file dir)]
+         (flatten (map #(-compile % (assoc opts :output-file (js-file-name d %)))
+                       fs)))))))

 ;; Provided IReloadable Implementations
 ;; ====================================
@@ -237,7 +238,7 @@
     (flatten (map files sources)))
   Compilable
   (-compile [_ opts]
-    (flatten (map #(-compile % opts) sources))))
+    (dependency-order (flatten (map #(-compile % opts) sources)))))

 ;; Create an IReloadabel which can trigger the reload of other
 ;; reloadables.


disallow mailto, increase socket conn just a little more for blog article

--- src/link_checker/check.clj
+++ src/link_checker/check.clj
@@ -26,7 +26,7 @@
   {:max-redirects 5
    :throw-exceptions false
    :conn-timeout 3000
-   :socket-timeout 3000})
+   :socket-timeout 4000})

 (defn client-get [url]
   (log/info :msg (format "Thread %s: GET %s" (.. Thread currentThread getId) url))
@@ -69,7 +69,7 @@
 (defn- invalid-link?
   [link]
   (or (contains? #{nil "" "#"} link)
-      (re-find #"^(javascript:|irc:)" link)))
+      (re-find #"^(javascript:|irc:|mailto:)" link)))

 ;;; thanks to alida's util.cl
 (defn- expand-relative-links


CLJS-1357: In cljs.js/eval-str accept a :context option in support of REPLs
CLJS-1358: In cljs.js/eval-str accept an option to turn on :def-emits-var

typos

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -152,7 +152,9 @@
                  r/*data-readers* (:*data-readers* bound-vars)]
          (let [form (r/read {:eof eof :read-cond :allow :features #{:cljs}} rdr)]
            (if-not (identical? eof form)
-             (let [aenv (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
+             (let [aenv (cond-> (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
+                          (:context opts) (assoc :context (:context opts))
+                          (:def-emits-var opts) (assoc :def-emits-var true))
                    ast  (ana/analyze aenv form)]
                (if (= :ns (:op ast))
                  (ns-side-effects bound-vars aenv ast opts
@@ -247,16 +249,16 @@
                    (ana/check-uses uses env))
                  (if (:*load-macros* bound-vars)
                    (do
-                     (when (:verobse opts)
+                     (when (:verbose opts)
                        (debug-prn "Loading :use-macros"))
                      (load-macros bound-vars :use-macros use-macros reload reloads opts
                        (fn []
-                         (when (:verobse opts)
+                         (when (:verbose 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)
+                               (when (:verbose opts)
                                  (debug-prn "Checking :use-macros"))
                                (ana/check-use-macros use-macros env))
                              (cb ast))))))
@@ -323,18 +325,22 @@
 ;; -----------------------------------------------------------------------------
 ;; Eval

+;; TODO: ns form handling, source mapping
+
 (defn eval* [bound-vars form opts cb]
   (binding [env/*compiler*   (:*compiler* bound-vars)
             *eval-fn*        (:*eval-fn* bound-vars)
             ana/*cljs-ns*    (:*cljs-ns* bound-vars)
             *ns*             (:*ns* bound-vars)
             r/*data-readers* (:*data-readers* bound-vars)]
-    (let [ana-env (assoc (ana/empty-env)
-                    :ns (ana/get-namespace ana/*cljs-ns*))]
+    (let [aenv (ana/empty-env)
+          aenv (cond-> (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
+                 (:context opts) (assoc :context (:context opts))
+                 (:def-emits-var opts) (assoc :def-emits-var true))]
       (cb (*eval-fn*
             {:lang   :clj
              :source (with-out-str
-                       (comp/emit (ana/analyze ana-env form nil opts)))})))))
+                       (comp/emit (ana/analyze aenv form nil opts)))})))))

 (defn eval
   "Evaluate a single ClojureScript form. The parameters:
@@ -382,7 +388,9 @@
                  comp/*source-map-data* (:*sm-data* bound-vars)]
          (let [form (r/read {:eof eof :read-cond :allow :features #{:cljs}} rdr)]
            (if-not (identical? eof form)
-             (let [aenv (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
+             (let [aenv (cond-> (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
+                          (:context opts) (assoc :context (:context opts))
+                          (:def-emits-var opts) (assoc :def-emits-var true))
                    ast  (ana/analyze aenv form)]
                (.append sb (with-out-str (comp/emit ast)))
                (if (= :ns (:op ast))
@@ -464,7 +472,9 @@
                  comp/*source-map-data* (:*sm-data* bound-vars)]
          (let [form (r/read {:eof eof :read-cond :allow :features #{:cljs}} rdr)]
            (if-not (identical? eof form)
-             (let [aenv (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
+             (let [aenv (cond-> (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
+                          (:context opts) (assoc :context (:context opts))
+                          (:def-emits-var opts) (assoc :def-emits-var true))
                    ast  (ana/analyze aenv form)]
                (if (= :ns (:op ast))
                  (do


make *eval-fn* *load-fn* more consistent, use out of bound-vars which survives async loads

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -75,7 +75,8 @@
        :*cljs-ns*      'cljs.user
        :*ns*           (create-ns 'cljs.user)
        :*data-readers* tags/*cljs-data-readers*
-       :*eval-fn*      (or (:js-eval opts) js/eval)}
+       :*load-fn*      (or (:load-fn opts) *load-fn*)
+       :*eval-fn*      (or (:eval-fn opts) *eval-fn*)}
       name opts cb))
   ([bound-vars name opts cb]
    (require bound-vars name nil opts cb))
@@ -86,7 +87,7 @@
      (reset! *loaded* #{}))
    (when-not (contains? @*loaded* name)
      (let [env (:*env* bound-vars)]
-       (*load-fn* (ns->relpath name)
+       ((:*load-fn* bound-vars) (ns->relpath name)
          (fn [resolved]
            (assert (or (map? resolved) (nil? resolved))
              "*load-fn* may only return a map or nil")
@@ -96,7 +97,7 @@
                  :clj (eval-str* bound-vars source opts
                         (fn [ret] (cb true)))
                  :js  (do
-                        (*eval-fn* source)
+                        ((:*eval-fn* bound-vars) source)
                         (cb true))
                  (throw
                    (js/Error.
@@ -161,7 +162,7 @@
            (-> (:*cljs-dep-set* bound-vars) meta :dep-path)))
        (if (seq deps)
          (let [dep (first deps)]
-           (*load-fn* (ns->relpath dep)
+           ((:*load-fn* bound-vars) (ns->relpath dep)
              (fn [resolved]
                (assert (or (map? resolved) (nil? resolved))
                  "*load-fn* may only return a map or nil")
@@ -287,7 +288,8 @@
       :*cljs-ns*      'cljs.user
       :*ns*           (create-ns 'cljs.user)
       :*data-readers* tags/*cljs-data-readers*
-      :*eval-fn*      (or (:js-eval opts) js/eval)}
+      :*load-fn*      (or (:load-fn opts) *load-fn*)
+      :*eval-fn*      (or (:eval-fn opts) *eval-fn*)}
      form opts cb)))

 ;; -----------------------------------------------------------------------------
@@ -326,7 +328,8 @@
        :*data-readers* tags/*cljs-data-readers*
        :*analyze-deps* (or (:analyze-deps opts) true)
        :*load-macros*  (or (:load-macros opts) true)
-       :*eval-fn*      (or (:js-eval opts) js/eval)}
+       :*load-fn*      (or (:load-fn opts) *load-fn*)
+       :*eval-fn*      (or (:eval-fn opts) *eval-fn*)}
       source opts cb)))

 ;; -----------------------------------------------------------------------------
@@ -372,5 +375,6 @@
       :*data-readers* tags/*cljs-data-readers*
       :*analyze-deps* (or (:analyze-deps opts) true)
       :*load-macros*  (or (:load-macros opts) true)
-      :*eval-fn*      (or (:js-eval opts) js/eval)}
+      :*load-fn*      (or (:load-fn opts) *load-fn*)
+      :*eval-fn*      (or (:eval-fn opts) *eval-fn*)}
      source opts cb)))


Generate a script to mv obi projects

Generate a script to mv obi projects

--- src/mdr2/abacus/import.clj
+++ src/mdr2/abacus/import.clj
@@ -9,14 +9,21 @@
             [clojure.string :as string]
             [clojure.set :refer [rename-keys]]
             [clojure.java.jdbc :as jdbc]
+            [org.tobereplaced.nio.file :as nio]
             [environ.core :refer [env]]
             [mdr2.production :as prod]
             [mdr2.dtbook :as dtbook]
+            [mdr2.production.path :as path]
             [immutant.transactions.jdbc :refer [factory]]))

 (def ^:private db {:factory factory :name "java:jboss/datasources/productions"})
 (def ^:private old-db {:factory factory :name "java:jboss/datasources/old-productions"})
 (def ^:private archive-db {:factory factory :name "java:jboss/datasources/archive"})
+
+(def abacus-csv "/home/eglic/src/mdr2/samples/ABACUS_export_Books_27032015.csv")
+(def file-dump "/home/eglic/src/mdr2/samples/miloun_files.txt")
+(def move-script "/home/eglic/src/mdr2/samples/move-productions.sh")
+(def old-production-root "/path/to/old/productions")

 (defn parse-int [s] (Integer/parseInt s))
 (defn production-id? [id] (let [match (re-matches #"DAM (\d+)$" id)] (when match (parse-int (second match)))))
@@ -62,7 +69,7 @@

 (defn extract-id
   [line]
-  (second (re-find #"^\./dam(\d+)" line)))
+  (parse-int (or (second (re-find #"^\./dam(\d+)" line)) "0")))

 (defn files-by-id
   [f]
@@ -73,9 +80,7 @@
 (defn struct-file? [f] (re-matches #".*/struct.html$" f))
 (defn obi-project? [f] (re-matches #".*/project.obi$" f))

-(def abacus-csv "/home/eglic/src/mdr2/samples/ABACUS_export_Books_27032015.csv")
 (def all-productions (-> abacus-csv io/file productions))
-(def file-dump "/home/eglic/src/mdr2/samples/miloun_files.txt")
 (def all-files-by-id (-> file-dump io/file files-by-id))

 (defn to-millis
@@ -152,6 +157,13 @@
                                                    (some wav-file? (get-all-files production))
                                                    (not-any? obi-project? (get-all-files production))))

+(defn obi-project-path [production]
+  (->> (some obi-project? (get-all-files production))
+      io/file
+      nio/parent
+      (nio/resolve-path old-production-root)
+      nio/normalize))
+
 (defn create-ready-productions!
   "Create all productions with state \"ready\""
   [productions]
@@ -190,10 +202,12 @@
   (doseq [p (filter recording-with-obi? productions)]
     (-> p
         prod/create!
-        prod/set-state-structured!
-        (comment
-          (copy-obi-project!)
-          (create-obi-config-file!)))))
+        prod/set-state-structured!)
+    (spit move-script
+          (format "mv %s %s\n" (obi-project-path p) (path/recording-path p))
+          :append true)
+    (comment
+      (create-obi-config-file!))))

 (defn create-recording-productions-without-obi!
   "Create all productions with state \"recording\" with wav files that
@@ -242,7 +256,7 @@
   (println "Ignoring the rest")
   (println (dissoc (frequencies (map :state all-productions)) "archived" "recording" "ready"))
   (doseq [state ["repairing" "finishing" "recorded" "pre_ready"]]
-    (println (str (string/capitalize state) ": ") (string/join ", " (map :id (filter #(= (:state %) state) all-productions)))))
+    (println (str (string/capitalize state) ":") (string/join ", " (map :id (filter #(= (:state %) state) all-productions)))))
   (println )
   (println "Importing commercial audio books")
   (println "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")


update setup to reflect collections (#4306)

--- src/metabase/api/setup.clj
+++ src/metabase/api/setup.clj
@@ -101,7 +101,7 @@
   (let [has-dbs?           (db/exists? Database, :is_sample false)
         has-dashboards?    (db/exists? 'Dashboard)
         has-pulses?        (db/exists? 'Pulse)
-        has-labels?        (db/exists? 'Label)
+        has-collections?   (db/exists? 'Collection)
         has-hidden-tables? (db/exists? 'Table, :visibility_type [:not= nil])
         has-metrics?       (db/exists? 'Metric)
         has-segments?      (db/exists? 'Segment)
@@ -142,9 +142,9 @@
       :triggered   (>= num-tables 20)}
      {:title       "Organize questions"
       :group       "Curate your data"
-      :description "Have a lot of saved questions in Metabase? Create labels to help manage them and add context."
-      :link        "/questions/all"
-      :completed   has-labels?
+      :description "Have a lot of saved questions in Metabase? Create collections to help manage them and add context."
+      :link        "/questions/"
+      :completed   has-collections?
       :triggered   (>= num-cards 30)}
      {:title       "Create metrics"
       :group       "Curate your data"


getting back to the scope

getting back to the scope

--- src/overtone/gui/scope.clj
+++ src/overtone/gui/scope.clj
@@ -100,12 +100,6 @@
 ;(def audio (load-sample "samples/strings/STRNGD5.WAV"))
 ;(def abuf (:buf audio))

-;(defn test-scope []
- ; (try
-    ;(load-scope)
-    ;(scope (scope-dataset))
-    ;(scope (sample-dataset (buffer-read abuf 0 8000)))))
-
 ; Envelope arrays are structured like this:
   ; * initial level
   ; * n-segments
@@ -143,4 +137,3 @@

 ; This is the line that does it!
 ;(update-dataset ds (.getFloatArray (.data (buffer-copy 0)) 0 (:n-frames (sample-info boom)))))
-


FIXME for locate-defs performance

FIXME for locate-defs performance

--- src/oxcart/passes/defs.clj
+++ src/oxcart/passes/defs.clj
@@ -85,6 +85,12 @@
          (assoc module :dynamic))))

+;; FIXME
+;;   This pass is T(n) = 5*n, which is quite likely going to be a
+;;   problem if iterated def location becomes an analysis
+;;   priority. Squashing all the locate-*-9n-module operations into a
+;;   single efficient pass over a single module would be slick.
+
 (defn locate-defs
   "λ AST → options → AST


Renamed inner-results to group-results in select-rep-comments for improved clarity

--- src/polismath/clusters.clj
+++ src/polismath/clusters.clj
@@ -411,27 +411,28 @@
     (reduce
       (fn [result [tid comment-stats]]
         ; Inner reduce folds data into result for each group in comment stats
+        ; XXX - could this be an assoc-in?
         (reduce
-          (fn [inner-result [gid comment-conv-stats]]
-            ; Heplper functions for building our result; ir = inner-result
-            (letfn [(ir-get   [ir & ks]
-                      (get-in ir (into [gid] ks)))
-                    (ir-assoc [ir & ks-and-val]
-                      (assoc-in ir (into [gid] (butlast ks-and-val)) (last ks-and-val)))]
-              (as-> inner-result ir
+          (fn [group-result [gid comment-conv-stats]]
+            ; Heplper functions for building our result; abbrv. gr = group-result
+            (letfn [(gr-get   [gr & ks]
+                      (get-in gr (into [gid] ks)))
+                    (gr-assoc [gr & ks-and-val]
+                      (assoc-in gr (into [gid] (butlast ks-and-val)) (last ks-and-val)))]
+              (as-> group-result gr
                 ; First check to see if the comment data passes, and add if it does
                 (if (passes-by-test? comment-conv-stats)
                   (->> comment-conv-stats
                        (finalize-cmt-stats tid)
-                       (conj (ir-get ir :sufficient))
-                       (ir-assoc ir :sufficient))
-                  ir)
+                       (conj (gr-get gr :sufficient))
+                       (gr-assoc gr :sufficient))
+                  gr)
                 ; Keep track of what the best comment so far is, even if it doesn't pass, so we always have at
                 ; least one comment
-                (if (and (empty? (ir-get ir :sufficient))
-                         (beats-best-by-test? comment-conv-stats (ir-get ir :test)))
-                  (ir-assoc ir :best (finalize-cmt-stats tid comment-conv-stats))
-                  ir))))
+                (if (and (empty? (gr-get gr :sufficient))
+                         (beats-best-by-test? comment-conv-stats (gr-get gr :test)))
+                  (gr-assoc gr :best (finalize-cmt-stats tid comment-conv-stats))
+                  gr))))
           result
           (zip ids comment-stats)))
       ; initialize result hash


Don't use app-relative lazily [IMMUTANT-614]

Otherwise, it will still print a deprecation warning when it is realized
outside of the binding scope.

--- wildfly/src/immutant/wildfly/repl.clj
+++ wildfly/src/immutant/wildfly/repl.clj
@@ -25,7 +25,7 @@
       [file]
       (binding [iu/*warn-on-deprecation* false]
         (when (u/app-root)
-          (map u/app-relative
+          (mapv u/app-relative
             (if file
               [file]
               [".nrepl-port" "target/repl-port"])))))))


spreadsheet example: use ops instead of whitespaces in formula interpreter

spreadsheet example: infix to prefix converter in formula interpreter

spreadsheet example: sharpen handling focus message

--- examples/examples/spreadsheet.cljs
+++ examples/examples/spreadsheet.cljs
@@ -5,46 +5,41 @@
             [om.core :as om :include-macros true]
             [clojure.string :as string]))

+(declare read-formula)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Helpers

-(declare read-formula)
-
-(defn- formula? [s]
+(defn formula? [s]
   (string? (first (re-matches #"^=.*" s))))

-(defn- write-formula [s state]
-  (let [formula (get-in state [(:focus state) :formula])]
-    (str formula " " s)))
+(defn number [x]
+  (let [n (js/parseInt x)]
+    (when (integer? n) n)))

-(defn- cell-value [xy state]
+(defn cell-value [xy state]
   (let [cell (state xy)]
     (if (:formula cell)
       (read-formula (:formula cell) state)
-      (:value cell))))
+      ((some-fn number identity) (:value cell)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Formula interpreter

-(def ops {"/" / "*" * "+" + "-" -})
+(defn- tokenize-formula [s]
+  (rest (rest (string/split s #"(=|/|\*|\+|\-)"))))

-(defn resolve-var [xy env]
-  (get-in env [xy :value]))
+(defn- parse-formula [s env]
+  (for [x (tokenize-formula s)]
+    (or ({"/" / "*" * "+" + "-" -} x)
+        (number x)
+        (cell-value x env))))

-(defn string->token [s env]
-  (or (ops s)
-      (let [n (js/parseInt s)]
-        (if (integer? n) n (cell-value s env)))))
-
-(defn parse-formula [s env]
-  (let [[_ a b c] (string/split s #" ")]
-    (map #(string->token % env) (list b a c))))
-
-(defn eval-formula [tokens]
-  (apply (first tokens) (rest tokens)))
+(defn- infix [x & xs]
+  (reduce (fn [res [op y]] (op res y)) x (partition 2 xs)))

 (defn read-formula [s env]
-  (eval-formula (parse-formula s env)))
+  (apply infix (parse-formula s env)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Look and feel
@@ -58,17 +53,16 @@
 (def source-mode  (cell-mode "source-mode"))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; The Brain
+;; Logic

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

     [[:display xy] :click _]
     (case (:mode state)

       :formula
-      (let [formula (write-formula xy state)]
+      (let [formula (str (get-in state [(:focus state) :formula]) xy)]
         [[(source-mode xy)
           (display-mode (:source state))
           [[:edit (:focus state)] :value formula]]
@@ -88,23 +82,21 @@

       [[(display-mode xy)
         [[:display xy] :value (cell-value (:focus state) state)]]
-       (assoc state :mode :done)])
+       (dissoc state :mode)])

     [[:edit xy] :value v]
     (if (formula? v)
       [[(formula-mode xy)] (assoc state :mode :formula xy {:formula v})]
-      [[]                  (assoc state :mode :value   xy {:value   v})])
+      [[] (assoc state :mode :value xy {:value v})])

     [[:edit xy] :key-down 13]
-    [[(display-mode xy)
-      (display-mode (:source state))
-      [[:display xy] :value (cell-value (:focus state) state)]]
-     (assoc state :mode :done)]
+    [[(display-mode xy) (display-mode (:source state))]
+     (dissoc state :mode :edit :source)]

     :else [[] state]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; The Spec
+;; Spec

 (defn cell [x y]
   (let [xy (str x y)]


fixed a little bug in the efs-prepper

fixed a little bug in the efs-prepper

--- src/flow_labeller/core.clj
+++ src/flow_labeller/core.clj
@@ -91,7 +91,8 @@
     (let [processed-flows
           (map (fn [x y] (conj x y))
                (map (fn [x] (subvec x proto-index)) the-flows)
-               (map (fn [x] (min (bigint (the-flows p1)) (bigint (the-flows p2))))))]
+               (map (fn [x] (min (bigint (x p1))
+                                (bigint (x p2)))) the-flows)) ]
       (doseq [pf processed-flows]
         (println (apply str (interpose "," pf)))))))


Temporarily softened validation of module.properties, to facilitate testing

--- src/leiningen/amp/impl.clj
+++ src/leiningen/amp/impl.clj
@@ -46,7 +46,8 @@
     (println "#### STEP 3: Populate AMP directory structure...")
     (if (.exists ^java.io.File module-properties)
       (io/copy module-properties (io/file amp (.getName ^java.io.File module-properties)))
-      (throw (RuntimeException. "Module doesn't have a module.properties file.")))    ;####TODO: Make this more pleasant
+      (println "#### RUH ROH RAGGY : no module.properties!!!!1"))
+;      (throw (RuntimeException. "Module doesn't have a module.properties file, so it's invalid.")))    ;####TODO: Make this more pleasant

     (if (.exists ^java.io.File file-mappings)
       (io/copy file-mappings (io/file amp (.getName ^java.io.File file-mappings))))


ns form and error handlign for eval

ns form and error handlign for eval

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -410,22 +410,39 @@
 ;; -----------------------------------------------------------------------------
 ;; Eval

-;; TODO: ns form handling, source mapping
-
 (defn eval* [bound-vars form opts cb]
-  (binding [env/*compiler*   (:*compiler* bound-vars)
-            *eval-fn*        (:*eval-fn* bound-vars)
-            ana/*cljs-ns*    (:*cljs-ns* bound-vars)
-            *ns*             (:*ns* bound-vars)
-            r/*data-readers* (:*data-readers* bound-vars)]
-    (let [aenv (ana/empty-env)
-          aenv (cond-> (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
-                 (:context opts) (assoc :context (:context opts))
-                 (:def-emits-var opts) (assoc :def-emits-var true))]
-      (cb (*eval-fn*
-            {:lang   :clj
-             :source (with-out-str
-                       (comp/emit (ana/analyze aenv form nil opts)))})))))
+  (let [bound-vars (cond-> (merge bound-vars
+                             {:*cljs-ns* 'cljs.user
+                              :*ns* (create-ns ana/*cljs-ns*)})
+                     (:source-map opts) (assoc :*sm-data* (sm-data)))]
+    (binding [env/*compiler*         (:*compiler* bound-vars)
+              *eval-fn*              (:*eval-fn* bound-vars)
+              ana/*cljs-ns*          (:*cljs-ns* bound-vars)
+              *ns*                   (:*ns* bound-vars)
+              r/*data-readers*       (:*data-readers* bound-vars)
+              comp/*source-map-data* (:*sm-data* bound-vars)]
+      (let [aenv (ana/empty-env)
+            aenv (cond-> (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
+                   (:context opts) (assoc :context (:context opts))
+                   (:def-emits-var opts) (assoc :def-emits-var true))
+            res  (try
+                   {:value (ana/analyze aenv form nil opts)}
+                   (catch :default cause
+                     (wrap-error
+                       (ana/error aenv
+                         (str "Could not eval " form) cause))))]
+        (if (:error res)
+          (cb res)
+          (let [ast (:value res)]
+            (if (= :ns (:op ast))
+              (ns-side-effects true bound-vars aenv ast opts
+                (fn [res]
+                  (if (:error res)
+                    (cb res)
+                    (let [src (str "goog.provide(\"" (munge (:name ast)) "\")")]
+                      (cb (*eval-fn* {:lang :clj :source src}))))))
+              (let [src (with-out-str (comp/emit ast))]
+                (cb (*eval-fn* {:lang :clj :source src}))))))))))

 (defn eval
   "Evaluate a single ClojureScript form. The parameters:
@@ -443,7 +460,10 @@
      :load - library resolution function, see *load-fn*

    cb (function)
-     callback, will be invoked with the evalution result."
+     callback, will be invoked with a map. If successful the map will contain
+     a :value key with the result of evalution. If unsuccessful the map wil
+     contain a :error key with an ex-info instance describing the cause of
+     failure."
   ([state form cb]
    (eval state form nil cb))
   ([state form opts cb]
@@ -452,6 +472,8 @@
       :*cljs-ns*      'cljs.user
       :*ns*           (create-ns 'cljs.user)
       :*data-readers* tags/*cljs-data-readers*
+      :*analyze-deps* (or (:analyze-deps opts) true)
+      :*load-macros*  (or (:load-macros opts) true)
       :*load-fn*      (or (:load opts) *load-fn*)
       :*eval-fn*      (or (:eval opts) *eval-fn*)}
      form opts cb)))


Fix last minute issue with project wizard

--- ccw.leiningen/src/clj/ccw/leiningen/util.clj
+++ ccw.leiningen/src/clj/ccw/leiningen/util.clj
@@ -63,7 +63,9 @@
   "Returns a classlojure environment for project, creating one if none exists yet,
    or if recreate? is true."
   [project & recreate?]
-  (let [pname (-> project e/project .getName)]
+  (let [pname (if (= :project-less project)
+                project
+                (-> project e/project .getName))]
     (dosync
       (commute projects-envs
                #(if (or recreate? (not (% pname)))


Refactored out select on its own

Refactored out select on its own

Refactored out select on its own

--- src/webapp/framework/client/coreclient.clj
+++ src/webapp/framework/client/coreclient.clj
@@ -777,7 +777,7 @@

-(defmacro select [& select-args]
+(defmacro sql-parser [& select-args]
   (let [
         list-of-sql        (map (fn[x]
                                   (if (.startsWith (str x)
@@ -811,3 +811,8 @@
          (~'div {}
            ~om-code
            ))))
+
+
+
+(defmacro select [& select-args]
+  `(sql-parser  ~@select-args))


Fixed main navigation dropdown menu display on mobile.

--- lambda-blog/src/lambda_blog/templates/page.clj
+++ lambda-blog/src/lambda_blog/templates/page.clj
@@ -67,8 +67,8 @@
                  (t/img {:src (pathcat path-to-root brand-logo)}))
                brand)]
     (t/nav {:class [:navbar :navbar-default :navbar-fixed-top]}
-           (t/div {:class [:container :navbar-inner]}
-                  (t/div (:class :navbar-header)
+           (t/div {:class :container}
+                  (t/div {:class :navbar-header}
                          (t/button {:class [:navbar-toggle :navbar-brand :pull-left]
                                     :type :button
                                     :data-toggle :collapse


Make datomic database tests more robust about cleaning up

--- test/clj/comic_reader/database_test.clj
+++ test/clj/comic_reader/database_test.clj
@@ -2,7 +2,25 @@
   (:require [clojure.test :refer :all]
             [com.stuartsierra.component :as component]
             [comic-reader.database :as sut]
+            [comic-reader.database.test-util :as test-util]
             [datomic.api :as d]))
+
+(defn test-system [norms-dir]
+  (component/system-map
+   :config {:database-uri "datomic:mem://comics-test"
+            :norms-dir norms-dir}
+   :database (component/using
+              (sut/new-database)
+              [:config])
+   :db-cleaner (component/using
+                (test-util/new-database-cleaner)
+                [:database])))
+
+(defn wrap-cleanup-datomic [f]
+  (f)
+  (d/shutdown false))
+
+(use-fixtures :each wrap-cleanup-datomic)

 (deftest test-database-component
   (let [db (sut/new-database)]
@@ -13,25 +31,27 @@
     (testing "with no config, no connection is started"
       (is (nil? (:conn (component/start db)))))

-    (let [config {:database-uri "datomic:mem://comics-test"
-                  :norms-dir nil}
-          db (assoc db :config config)]
+    (let [system (test-system nil)]
       (testing "connection is nil before start"
-        (is (nil? (:conn db))))
+        (is (nil? (:conn (:database system)))))

       (testing "connection is non-nil after successful start"
-        (let [started-db (component/start db)]
-          (is (not (nil? (:conn started-db)))))))
+
+        (let [started-system (component/start system)]
+          (try
+            (is (not (nil? (:conn (:database started-system)))))
+            (finally
+              (component/stop started-system))))))

     (testing "norms conformation happens on startup"
-      (let [config {:database-uri "datomic:mem://comics-test"
-                    :norms-dir "database/test-norms"}
-            db (-> db
-                   (assoc :config config)
-                   component/start)]
-        (is (= 1
-               (count
-                (d/q '[:find ?e
-                       :in $
-                       :where [?e :db/ident :test.enum/one]]
-                     (d/db (:conn db))))))))))
+      (let [system (component/start (test-system "database/test-norms"))
+            db (:database system)]
+        (try
+          (is (= 1
+                 (count
+                  (d/q '[:find ?e
+                         :in $
+                         :where [?e :db/ident :test.enum/one]]
+                       (d/db (:conn db))))))
+          (finally
+            (component/stop system)))))))


make zoom out effect work

make zoom out effect work

--- frontend/components/landing-b.cljs
+++ frontend/components/landing-b.cljs
@@ -23,18 +23,19 @@
             controls-ch (om/get-shared owner [:comms :controls])]
         (html [:div.home.page
                [:section.home-intro
+                [:a.intro-action-btn "Sign Up Free"]
+                [:div.intro-action-overlay]
                 [:nav.outer-navigation
                  [:a.latest-link "What is Continuous Integration?"]
                  [:a.login-link "Log In"]]
                 [:div.intro-brand
                  (common/ico :logo)]
                 [:div.intro-slogan
-                 [:h1 "Your team needs a hero."]
-                 [:h3 "Testing is hard. Let your org focus on product, let us handle your "]
+                 [:h1 "Your org needs a hero."]
+                 [:h3 "Testing is hard. Help your team focus on product, we'll handle your "]
                  [:h3 "Continuous Integration & Deployment."]]
-                [:div.intro-action
-                 [:div.intro-action-btn ;; "Sign Up Free"
-                  [:div.signup-view]]]
+                ; [:a.intro-action-btn "Sign Up Free"]
+                ; [:div.intro-action-overlay]
                 [:div.intro-learn
                  [:a "Learn more"]]]
                [:section.home-why]


Add size change event for shape.

Add size change event for shape.

--- frontend/uxbox/data/workspace.cljs
+++ frontend/uxbox/data/workspace.cljs
@@ -23,6 +23,11 @@
    :width [v/integer]
    :height [v/integer]
    :type [v/required sc/shape-type]})
+
+(def ^:static +shape-update-size-schema+
+  {:width [v/integer]
+   :height [v/integer]
+   :lock [v/boolean]})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Events
@@ -169,3 +174,19 @@
     (-apply-update [_ state]
       (let [shape (get-in state [:shapes-by-id sid])]
         (update-in state [:shapes-by-id sid] shapes/-move {:dx dx :dy dy})))))
+
+;; TODO: implement locked resize
+
+(defn update-shape-size
+  [sid {:keys [width height lock] :as opts}]
+  (sc/validate! +shape-update-size-schema+ opts)
+  (reify
+    rs/UpdateEvent
+    (-apply-update [_ state]
+      (let [shape (get-in state [:shapes-by-id sid])
+            size (select-keys shape [:width :height])
+            size (merge size
+                        (when width {:width width})
+                        (when height {:height height}))]
+        (update-in state [:shapes-by-id sid]
+                   shapes/-resize size)))))


callout language selection dropdown to make it more prominent

--- src/cljs/ninety_nine_issues/views.cljs
+++ src/cljs/ninety_nine_issues/views.cljs
@@ -8,26 +8,27 @@
 (defn select-language-page []
   [:div
    [:div.row
-    [:div.medium-8.large-8.columns
+    [:div.medium-6.large-6.columns
      [:h1 "99 Issues"]]]
    [:div.row
-    [:div.medium-8.large-8.columns
+    [:div.medium-6.large-6.columns
      [:img {:src "img/jayz-tagline.jpg"}]]]

    [:div.row {:style {:margin-top "2em"}}
-    [:div.medium-8.large-8.columns.text-center
-     [:form
-      [:label
-       [:select {:on-change (fn [e]
-                              (re-frame/dispatch [:user-select-language
-                                                  (let [select-element (.-target e)
-                                                        index (.. select-element -selectedIndex)]
-                                                    (.. select-element -options (item index) -label))]))
-                 :defaultValue ""}
-        [:option {:value "" :disabled true } "Select your language"]
-        (for [[k v] languages]
-          ^{:key (str "select-" (name k))}
-          [:option {:value k} v])]]]]]])
+    [:div.medium-6.large-6.columns.text-center
+     [:div.callout.primary
+      [:form
+       [:label
+        [:select {:on-change (fn [e]
+                               (re-frame/dispatch [:user-select-language
+                                                   (let [select-element (.-target e)
+                                                         index (.. select-element -selectedIndex)]
+                                                     (.. select-element -options (item index) -label))]))
+                  :defaultValue ""}
+         [:option {:value "" :disabled true } "Select your language"]
+         (for [[k v] languages]
+           ^{:key (str "select-" (name k))}
+           [:option {:value k} v])]]]]]]])

 (defn issue-page []
   (let [language (re-frame/subscribe [:language])
@@ -59,7 +60,7 @@
               [:h3 (:title @issue)]]]
             [:div.row
              [:div.columns
-              [:pre {:style {:white-space "pre-wrap"}}
+              [:pre {:style {:white-space "pre-wrap"}}
                     (:body @issue)]]]]

            ;; if there are no more issues in the queue for user


first test with vm only

first test with vm only

--- src/dda/pallet/dda_managed_ide/app.clj
+++ src/dda/pallet/dda_managed_ide/app.clj
@@ -33,9 +33,9 @@

 (def DdaIdeAppConfig
   {:group-specific-config
-   {s/Keyword (merge InfraResult
-                     git/InfraResult
-                     serverspec/InfraResult
+   {s/Keyword (merge ;InfraResult
+                     ;git/InfraResult
+                     ;serverspec/InfraResult
                      managed-vm/InfraResult)}})

 (s/defn ^:always-validate load-domain :- domain/DdaIdeDomainConfig
@@ -52,10 +52,10 @@
   [domain-config & {:keys [group-key] :or {group-key :dda-ide-group}}]
   (s/validate domain/DdaIdeDomainConfig domain-config)
   (mu/deep-merge
-   (managed-vm/app-configuration (domain/dda-vm-domain-configuration domain-config) :group-key group-key)
-   (git/app-configuration (domain/ide-git-config domain-config) :group-key group-key)
-   (serverspec/app-configuration (domain/ide-serverspec-config domain-config) :group-key group-key)
-   (create-app-configuration (domain/infra-configuration domain-config) group-key)))
+   (managed-vm/app-configuration (domain/dda-vm-domain-configuration domain-config) :group-key group-key)))
+   ;(git/app-configuration (domain/ide-git-config domain-config) :group-key group-key)
+   ;(serverspec/app-configuration (domain/ide-serverspec-config domain-config) :group-key group-key)
+   ;(create-app-configuration (domain/infra-configuration domain-config) group-key)))

 (s/defn ^:always-validate dda-ide-group-spec
   [app-config :- DdaIdeAppConfig]


change html/ul to wrap text with span

change html/ul to wrap text with span

--- src/html.clj
+++ src/html.clj
@@ -24,7 +24,7 @@
 (defn ul
   ([ls] (ul identity ls))
   ([f ls]
-   [:ul (for [x ls] [:li (f x)])]))
+   [:ul (for [x ls] [:li [:span (f x)]])]))

 (defn dl


Implement gamepad repeat-events function.

--- src/org/playasophy/wonderdome/input/gamepad.clj
+++ src/org/playasophy/wonderdome/input/gamepad.clj
@@ -20,8 +20,7 @@

 (defn- button-events
-  "Determines button press and release events from old and new state maps.
-  Returns a seq of button events."
+  "Calculates button press and release events. Returns a seq of events."
   [buttons old-state new-state]
   (for [button buttons]
     (let [old-val (get old-state button)
@@ -35,12 +34,17 @@

 (defn- repeat-events
-  "Builds a function which will repeatedly fire events every period ms if their
-  value differs from the default given."
-  [defaults period]
-  ; TODO: implement repeat events function
-  ; probably store 'last repeat time' in an atom
-  (constantly nil))
+  "Calculates repeated button 'hold' events, where the value differs from some
+  default value. Sends an event with the button and the elapsed ms it has been
+  pressed for."
+  [defaults state elapsed]
+  (for [[button default] defaults]
+    (let [value (get state button)]
+      (when (and (some? value) (not= value default))
+        {:type :gamepad/repeat
+         :button button
+         :value value
+         :elapsed elapsed}))))

@@ -94,12 +98,12 @@

 (defn- snes-state-events
   [old-state new-state elapsed]
-  (when (not= old-state new-state)
-    (prn elapsed "ms:" new-state))
-  (let [buttons (remove #{:x-axis :y-axis} (keys new-state))
-        events (button-events buttons old-state new-state)]
-    (dorun (map prn events))
-    events))
+  (let [axes {:x-axis 0.0, :y-axis 0.0}
+        buttons (remove (keys axes) (keys new-state))]
+    (remove nil?
+      (concat
+        (repeat-events axes old-state elapsed)
+        (button-events buttons old-state new-state)))))

 (defn snes


Use base64 with starting uppper case

Use base64 with starting uppper case

--- src/re_natal_esp32control_app/android/core.cljs
+++ src/re_natal_esp32control_app/android/core.cljs
@@ -7,7 +7,7 @@

 (def ReactNative (js/require "react-native"))
 (def BleManager (js/require "react-native-ble-manager"))
-(def base64 (js/require "base64-js"))
+(def Base64 (js/require "base64-js"))

 (def app-registry (.-AppRegistry ReactNative))
 (def text (reagent/adapt-react-class (.-Text ReactNative)))
@@ -77,7 +77,7 @@
 (defn ble-send [device & {:keys [lf lb rf rb]}]
   (let [device (or device @(subscribe [:get-current-device]))]
     (.write BleManager (:id device) service-id characteristic-id
-            (.fromByteArray base64 (clj->js [lf lb rf rb])))))
+            (.fromByteArray Base64 (clj->js [lf lb rf rb])))))

 (defn ble-control-page []
   (let [current-device (subscribe [:get-current-device])


fix parser topic-id and lesson sorting

fix parser topic-id and lesson sorting

--- src/server/daveconservatoire/server/parser.cljs
+++ src/server/daveconservatoire/server/parser.cljs
@@ -85,7 +85,7 @@
           :fields {:db/id              "id"
                    :url/slug           "urltitle"
                    :youtube/id         "youtubeid"
-                   :lesson/topic-id    "lessonno"
+                   :lesson/topic-id    "topicno"
                    :lesson/course-id   "seriesno"
                    :lesson/title       "title"
                    :lesson/description "description"
@@ -169,10 +169,10 @@
     foreign-table))

 (defmethod row-vattribute [:course :course/topics] [env] (has-many env :topic :topic/course-id {:sort ["sortorder"]}))
-(defmethod row-vattribute [:course :course/lessons] [env] (has-many env :lesson :lesson/course-id))
+(defmethod row-vattribute [:course :course/lessons] [env] (has-many env :lesson :lesson/course-id {:sort ["lessonno"]}))

 (defmethod row-vattribute [:topic :topic/course] [env] (has-one env :course :topic/course-id))
-(defmethod row-vattribute [:topic :topic/lessons] [env] (has-many env :lesson :lesson/topic-id))
+(defmethod row-vattribute [:topic :topic/lessons] [env] (has-many env :lesson :lesson/topic-id {:sort ["lessonno"]}))

 (defmethod row-vattribute [:lesson :lesson/course] [env] (has-one env :course :lesson/course-id))
 (defmethod row-vattribute [:lesson :lesson/topic] [env] (has-one env :topic :lesson/topic-id))


Fix a doc string typo

Fix a doc string typo

--- src/mdr2/abacus/import.clj
+++ src/mdr2/abacus/import.clj
@@ -1,5 +1,5 @@
 (ns mdr2.abacus.import
-  "Funtionality for the initial import of the production data from
+  "Functionality for the initial import of the production data from
   ABACUS to Madras2.

   This is meant to be used only once when importing the productions


implement /api/query/:id/results endpoint

--- src/metabase/api/query.clj
+++ src/metabase/api/query.clj
@@ -1,5 +1,5 @@
 (ns metabase.api.query
-  (:require [korma.core :refer [where subselect fields]]
+  (:require [korma.core :refer [where subselect fields order limit]]
             [compojure.core :refer [defroutes GET PUT POST DELETE]]
             [clojure.data.json :as json]
             [medley.core :refer :all]
@@ -7,6 +7,7 @@
             [metabase.db :refer :all]
             (metabase.models [hydrate :refer :all]
                              [query :refer [Query]]
+                             [query-execution :refer [QueryExecution]]
                              [database :refer [Database databases-for-org]]
                              [org :refer [Org]]
                              [common :as common])
@@ -64,7 +65,6 @@

 (defendpoint GET "/:id" [id]
-  ;; TODO - permissions check
   (let-404 [{:keys [can_read] :as query} (sel :one Query :id id)]
     (check-403 @can_read)
     (hydrate query :creator :database :can_read :can_write)))
@@ -87,7 +87,6 @@

 (defendpoint DELETE "/:id" [id]
-  ;; TODO - permissions check
   (let-404 [{:keys [can_write] :as query} (sel :one [Query :id :creator_id :public_perms] :id id)]
     (check-403 @can_write)
     (del Query :id id)))
@@ -98,4 +97,16 @@
   {:TODO "TODO"})

+(defendpoint GET "/:id/results" [id]
+  ;; TODO - implementation (list recent results of a query)
+  (let-404 [{:keys [can_read] :as query} (sel :one Query :id id)]
+    (check-403 @can_read)
+    (sel :many QueryExecution :query_id id (order :finished_at :DESC) (limit 10))))
+
+
+(defendpoint POST "/:id/csv" [id]
+  ;; TODO - this should return a CSV file instead of JSON
+  {:TODO "TODO"})
+
+
 (define-routes)


stylistic fixes stuff

stylistic fixes stuff

--- src/latte_compiler/static_analysis.clj
+++ src/latte_compiler/static_analysis.clj
@@ -204,12 +204,11 @@
                :condelse (match/match code
                                       [_ [:expr [:elittrue]] b1 _] (recur b1)
                                       [_ [:expr [:elitfalse]] _ b2] (recur b2)
-                                      :else false
-                                      )
+                                      :else false)
                :while (match/match code
                                    [_ [:expr [:elittrue]] _] true
-                                   [_ _ b] (recur b)
-                                   )
+                                   [_ [:expr [:elitfalse]] _] false
+                                   [_ _ b] (recur b))
                :else false
                ))

@@ -226,7 +225,7 @@
 (defn analyze-fun
   [glob-state funexpr]
   (match/match funexpr [_ [type] [_ name] args block]
-               (if (and (not (= type :void)) (not (terminated block)))
+               (if (not (or (= type :void) (terminated block)))
                  (util/err (str "return not found in function " name "\n" (util/ip-meta funexpr)))
                  (check-type glob-state funexpr)
                  )


util/s3.clj: restore variadic get-object-meta

--- src/org/altlaw/util/s3.clj
+++ src/org/altlaw/util/s3.clj
@@ -64,12 +64,14 @@
 (defn get-object [bucket-name object-key]
   (.getObject (get-s3) (get-bucket bucket-name) object-key))

-(defn get-object-meta [bucket-name object-key]
-  (catch-s3-errors
-   (into {} (.getMetadataMap
-             (.getObjectDetails (get-s3) (get-bucket bucket-name)
-                                object-key)))))
-
+(defn get-object-meta
+  ([object]
+     (catch-s3-errors (into {} (.getMetadataMap object))))
+  ([bucket-name object-key]
+     (catch-s3-errors
+      (into {} (.getMetadataMap
+                (.getObjectDetails (get-s3) (get-bucket bucket-name)
+                                   object-key))))))
 (defn get-object-stream
   ([object]
      (catch-s3-errors


add :args to sample meta data in load-sample*

--- src/overtone/sc/sample.clj
+++ src/overtone/sc/sample.clj
@@ -54,6 +54,7 @@
             sample (with-meta {:allocated-on-server (atom true)
                                :id id
                                :path path
+                               :args args
                                :name f-name
                                :size (:size info)
                                :rate (:rate info)


Avoid an error when run is partly loaded

--- src-cljs/frontend/components/pages/run.cljs
+++ src-cljs/frontend/components/pages/run.cljs
@@ -187,7 +187,11 @@
                   route-params (:app/route-params (om-next/props this))]
               (html
                [:div
-                (when-not (empty? run)
+                ;; We get the :run/id for free in the route params, so even
+                ;; before the run has loaded, we'll have the :run/id here. So
+                ;; dissoc that and see if we have anything else; when we do, we
+                ;; should have enough to render it.
+                (when-not (empty? (dissoc run :run/id))
                   (workflow-page/run-row run))
                 [:.jobs
                  [:div.jobs-header


add comment

add comment

--- support/src/figwheel/client/file_reloading.cljs
+++ support/src/figwheel/client/file_reloading.cljs
@@ -18,6 +18,8 @@
 (defn on-jsload-custom-event [url]
   (utils/dispatch-custom-event "figwheel.js-reload" url))

+;; you can listen to this event easily like so:
+;; document.body.addEventListener("figwheel.before-js-reload", function (e) { console.log(e.detail);} );
 (defn before-jsload-custom-event [files]
   (utils/dispatch-custom-event "figwheel.before-js-reload" files))


GAWB-2325: Remove call caching docker image digest message from create method modal

--- src/cljs/main/broadfcui/page/method_repo/create_method.cljs
+++ src/cljs/main/broadfcui/page/method_repo/create_method.cljs
@@ -121,9 +121,6 @@
                                       (self :add-listener "change"
                                        #(swap! state assoc :undo-history
                                                (js->clj (self :call-method "historySize")))))}]
-           [:div {:style {:marginTop "0.8em" :fontSize "88%"}}
-            "WDL must use Docker image digests to allow call caching "
-            (links/create-external {:href (config/call-caching-guide-url)} "Learn about call caching")]

            (when (:edit-mode? info)
              [:div {:style {:margin "1rem 0 -1rem"}}


Fixing name

Fixing name

--- src/cljs/wombats_web_client/components/countdown_timer.cljs
+++ src/cljs/wombats_web_client/components/countdown_timer.cljs
@@ -42,7 +42,7 @@
 (defn remaining-time [total larger-total multiplier]
   (- total (* larger-total multiplier)))

-(defn format-time2 [time]
+(defn format-time [time]
  (if (time-left? time)
    (let [total-seconds (seconds-until time)
          total-minutes (total-time total-seconds 60)
@@ -81,4 +81,4 @@
         (:update @cmpnt-state)

         [:span {:class-name "countdown-timer"}
-         (format-time2 start-time)])})))
+         (format-time start-time)])})))


Check that each keyword arg has a supplied value

--- boot/core/src/boot/cli.clj
+++ boot/core/src/boot/cli.clj
@@ -167,6 +167,8 @@
     (cond
       (nil? arg) split
       (not (keyword? arg)) (recur (update-in split [:cli] (fnil conj []) arg) more)
+      (empty? more) (update-in split [:errors] (fnil conj [])
+                               (str "no value supplied for option " arg))
       :else (recur (update-in split [:kw] assoc arg (first more)) (rest more)))))

 (defmacro ^:private assert
@@ -227,13 +229,13 @@
           clj-doc  (format "%s\n\nKeyword Args:\n%s\n" doc (clj-summary argspecs))
           varmeta  {:doc clj-doc :arglists arglists :argspec cli-args}]
       `(-> (fn [& args#]
-             (let [{kws# :kw clis# :cli} (#'split-args args#)
-                   [opts# args#] (#'separate-cli-opts clis# ~cli-args)
+             (let [split# (#'split-args args#)
+                   [opts# args#] (#'separate-cli-opts (:cli split#) ~cli-args)
                    parsed#   (cli/parse-opts opts# ~cli-args)
-                   ~bindings (merge kws# (:options parsed#))
+                   ~bindings (merge (:kw split#) (:options parsed#))
                    ~'*args*  args#
                    ~'*usage* #(print ~cli-doc)]
-               (when-let [e# (seq (:errors parsed#))]
+               (when-let [e# (seq (mapcat :errors [split# parsed#]))]
                  (throw (IllegalArgumentException. (string/join "\n" e#))))
                ~@(mapv (partial apply argspec->assert) argspecs)
                ~@(mapv (partial apply argspec->deprecation-warning) argspecs)