optimize pattern making and URI matching

--- src/calfpath/internal.clj
+++ src/calfpath/internal.clj
@@ -19,39 +19,44 @@
         (let [ch (.charAt route i)
               [jn s? r] (if s?
                           (if (= ^char marker-char ch)
-                            [(inc i) false (conj r (.substring route j i))]
+                            [(unchecked-inc i) false (conj r (.substring route j i))]
                             [j true r])
                           (if (= separator ch)
                             [i true  (conj r (keyword (.substring route j i)))]
                             [j false r]))]
-          (recur (inc i) (int jn) s? r))))))
+          (recur (unchecked-inc i) (int jn) s? r))))))

 (defn match-uri
   "Given a URI string and an array of pattern tokens (string or keyword only) return a map of keywords to string param
   values on a successful match, nil otherwise."
-  [^String uri pattern-tokens]
-  (let [n (.length uri)
-        separator (int \/)]
-    (loop [i (int 0) ; index into the URI
-           j (int 0) ; index into pattern-tokens
-           p {}      ; URI params
-           ]
-      (if (>= i n)
-        p
-        (let [t (get pattern-tokens j)
-              [r? in jn pn] (if (string? t)
-                              ;; match URI string from current index position
-                              (when (.startsWith uri ^String t i)
-                                [true (+ i (.length ^String t)) (inc j) p])
-                              ;; assume keyword, extract the URI param
-                              (let [stop (.indexOf uri separator i)
-                                    stop (if (>= stop 0)
-                                           stop
-                                           n)]
-                                [true stop (inc j) (assoc p t (.substring uri i stop))]))]
-          (when r?
-            (recur (int in) (int jn) pn)))))))
+  [^String uri ^java.util.List pattern-tokens]
+  (if (= 1 (.size pattern-tokens))
+    ;; if it's just one token, it must be a string
+    (when (.equals uri ^String (first pattern-tokens))
+      {})
+    (let [n (.length uri)
+          p (transient {}) ; URI params
+          separator (int \/)]
+      (loop [i (int 0) ; index into the URI
+             j (int 0) ; index into pattern-tokens
+             ]
+        (if (>= i n)
+          (persistent! p)
+          (let [t (get pattern-tokens j)
+                [r? in jn] (if (instance? String t)
+                             ;; match URI string from current index position
+                             (when (.startsWith uri ^String t i)
+                               [true (+ i (.length ^String t)) (unchecked-inc j)])
+                             ;; assume keyword, extract the URI param
+                             (let [stop (.indexOf uri separator i)
+                                   stop (if (>= stop 0)
+                                          stop
+                                          n)]
+                               (assoc! p t (.substring uri i stop))
+                               [true stop (unchecked-inc j)]))]
+            (when r?
+              (recur (int in) (int jn)))))))))

 (def valid-method-keys #{:get :head :options :put :post :delete})


Remove the upload form from the front page

--- src/catalog/web/views.clj
+++ src/catalog/web/views.clj
@@ -26,15 +26,6 @@
   (let [identity (friend/identity request)]
     (layout/common
      identity
-     [:div.row
-      (form/form-to
-      {:enctype "multipart/form-data"
-       :class "form-inline"}
-      [:post "/upload-confirm"]
-      (anti-forgery-field)
-      (form/file-upload #_{:title "Browse..." } "file")
-      " "
-      (form/submit-button {:class "btn btn-default"} "Upload"))]
      [:div.row
       [:div.col-md-4
        [:h2 "Neu im Sortiment"]


remove drag-start ctrl

remove drag-start ctrl

--- src/chessground/ctrl.cljs
+++ src/chessground/ctrl.cljs
@@ -30,10 +30,6 @@
           (move-start app key)))
       (data/cancel-premove app)))

-; (defn- drag-start [app orig]
-;   "A move has been started, by dragging a piece"
-;   (update-in app [:chess] chess/set-selected orig (-> app :movable :dests)))
-
 (defn- drop-off [app]
   (update-in
     (or (when (= "trash" (-> app :movable :drop-off))
@@ -51,6 +47,5 @@
   (fn [function data]
     (case function
       :select-square (swap! app-atom #(select-square % data))
-      ; :drag-start (swap! app-atom #(drag-start % data))
       :drop-off (swap! app-atom drop-off)
       :drop-on (swap! app-atom #(drop-on % data)))))


don't blow up if we don't have a locals map.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -347,7 +347,7 @@
         [locals params] (reduce (fn [[locals params] name]
                                   (let [param {:name name
                                                :tag (-> name meta :tag)
-                                               :shadow (locals name)}]
+                                               :shadow (when locals (locals name))}]
                                     [(assoc locals name param) (conj params param)]))
                                 [locals []] param-names)
         fixed-arity (count (if variadic (butlast params) params))
@@ -366,7 +366,7 @@
         ;;turn (fn [] ...) into (fn ([]...))
         meths (if (vector? (first meths)) (list meths) meths)
         locals (:locals env)
-        locals (if name (assoc locals name {:name name :shadow (locals name)}) locals)
+        locals (if (and locals name) (assoc locals name {:name name :shadow (locals name)}) locals)
         type (-> form meta ::type)
         fields (-> form meta ::fields)
         protocol-impl (-> form meta :protocol-impl)


Slight simplification of the dot reasoner

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -561,6 +561,7 @@

 (defmethod emit :dot
   [{:keys [target field method args env]}]
+  (.println System/out (str "emit " [field method]))
   (emit-wrap env
              (if field
                (print (str (emits target) "." field))
@@ -845,10 +846,9 @@
          children [enve]]
      (if (and (symbol? (first member+)) (nil? (next member+))) ;;(. target field)
        {:env env :op :dot :target targetexpr :field (munge (first member+)) :children children}
-       (let [[method args]
-             (if (symbol? (first member+))
-               [(first member+) (next member+)]
-               [(ffirst member+) (nfirst member+)])
+       (let [[method args] (cond
+                            (symbol?  (first member+)) [(first member+) (next member+)]
+                            :default [(ffirst member+) (nfirst member+)])
              argexprs (map #(analyze enve %) args)]
          {:env env :op :dot :target targetexpr :method (munge method) :args argexprs :children (into children argexprs)})))))


call dash-redirect instead of dashboard handler

--- src/clj/traveler/core.clj
+++ src/clj/traveler/core.clj
@@ -43,7 +43,7 @@
    ^{:name "Traveler"
      :id :traveler/root
      :main-menu true}
-   [:any "/" (:dashboard liberator-resources)]
+   [:any "/" dash-redirect]
    ^{:name "Dashboard" :id :traveler/dashboard}
    [:any "/dashboard" (:dashboard liberator-resources)]
    ^{:name "Manage Users" :id :traveler/users}


Clear Username and Password on Sign-In Cancel

--- src/cljs/lens/navbar.cljs
+++ src/cljs/lens/navbar.cljs
@@ -31,6 +31,9 @@

 ;; ---- Sign In/Out -----------------------------------------------------------

+(defn on-cancel [owner]
+  (om/update-state! owner #(assoc % :username "" :password "" :expanded false)))
+
 (defcomponent sign-in-form [_ owner]
   (init-state [_]
       {:username ""
@@ -63,7 +66,7 @@
         (d/button {:class "btn btn-primary" :type "button"
                    :on-click (h (bus/publish! owner :sign-in state))} "Go")
         (d/button {:class "btn btn-default" :type "button"
-                   :on-click (h (om/set-state! owner :expanded false))} "Cancel"))
+                   :on-click (h (on-cancel owner))} "Cancel"))

       (d/button {:class "btn btn-default navbar-btn navbar-right"
                  :on-click (h (om/set-state! owner :expanded true))


Cleanup.

Cleanup.

--- src/cljs/medusa/core.cljs
+++ src/cljs/medusa/core.cljs
@@ -319,12 +319,14 @@
     om/IRender
     (render [_]
       (let [format-detector (fn [{:keys [detector_name metrics_filter]}]
-                              [:div {:style {:overflow "hidden"}}
+                              [:div {:style {:overflow "hidden"
+                                             :white-space "nowrap"}}
                                [:div [:small "Detector: " [:em detector_name]]]
                                (when (seq metrics_filter)
                                  [:div [:small "Filter: " [:em metrics_filter]]])])
             format-metric (fn [{:keys [metric_name detector_name]}]
-                            [:div {:style {:overflow "hidden"}}
+                            [:div {:style {:overflow "hidden"
+                                           :white-space "nowrap"}}
                              [:div [:small "Detector: " [:em detector_name]]]
                              [:div [:small "Metric: " [:em metric_name]]]])
             detector-click (fn [detector]


slight API changes

slight API changes

--- src/clojure/yaw/world.clj
+++ src/clojure/yaw/world.clj
@@ -149,17 +149,20 @@

 (defn set-ambient-light!
   "Set the ambient light of the world"
-  [world & {:keys [r g b i]
-            :or {r 1 g 1 b 1 i 1}}]
-  (.setAmbient (lights world) (AmbientLight. r g b i)))
+  [world & {:keys [color i]
+            :or {color [1 1 1]
+                 i 0.3}}]
+  (let [[r g b] color]
+    (.setAmbient (lights world) (AmbientLight. r g b i))))

 (defn set-sun!
   "Set the sun of the world"
-  [world & {:keys [color direction]
-            :or {color [1 1 1 0.6]
+  [world & {:keys [color i direction]
+            :or {color [1 1 1]
+                 i 0.6
                  direction [-1 -1 -1]}}]
-  (let [[r g b i] color [dx dy dz] direction]
-  (.setSun (lights world) (DirectionalLight. r g b i dx dy dz))))
+  (let [[r g b] color [dx dy dz] direction]
+    (.setSun (lights world) (DirectionalLight. r g b i dx dy dz))))

 ;;COLLISIONS------------------------------------------------------


Add evaluation for until

Add evaluation for until

--- src/clojure_ruby/core.clj
+++ src/clojure_ruby/core.clj
@@ -157,6 +157,11 @@
     (while (evaluate predicate)
       (mapv evaluate body))))

+(defmethod evaluate-one :until [stmt]
+  (let [[_ predicate & body] stmt]
+    (while (not (evaluate predicate))
+      (mapv evaluate body))))
+
 (defmethod evaluate-one :case [stmt]
   (let [[_ predicate & whens] stmt
         predicate (evaluate predicate)]


Rearrange data declarations

Rearrange data declarations

--- src/clojurecraft/data.clj
+++ src/clojurecraft/data.clj
@@ -29,14 +29,6 @@
 ;   without modifying it).
 (defrecord Entity [eid loc despawned])

-; Chunk
-;
-; A single chunk in the world.
-;
-; blocks -> [block ...]
-;   A vector of the blocks in this chunk.
-(defrecord Chunk [blocks])
-
 ; Block
 ;
 ; A representation of a single block.
@@ -47,6 +39,30 @@
 ;
 ; kind -> TODO
 (defrecord Block [loc kind])
+
+; Chunk
+;
+; A single chunk in the world.
+;
+; blocks -> [block ...]
+;   A vector of the blocks in this chunk.
+(defrecord Chunk [blocks])
+
+; World
+;
+; A representation of a single world/server, shared by all bots connected to it.
+;
+; server -> {:name hostname :port port}
+;
+; entities -> (ref {eid (ref Entity) ...})
+;   A map of all the entities in the world.
+;
+; chunks -> (ref {[x y z] [(ref Chunk) ...] ...})
+;   A map of all the chunks in the world.
+;
+; time -> (ref integer)
+;   The current world time.
+(defrecord World [server entities chunks time])

 ; Bot
 ;
@@ -83,19 +99,3 @@
 (defrecord Bot [connection outqueue player world
                 packet-counts-in packet-counts-out])

-; World
-;
-; A representation of a single world/server, shared by all bots connected to it.
-;
-; server -> {:name hostname :port port}
-;
-; entities -> (ref {eid (ref Entity) ...})
-;   A map of all the entities in the world.
-;
-; chunks -> (ref {[x y z] [(ref Chunk) ...] ...})
-;   A map of all the chunks in the world.
-;
-; time -> (ref integer)
-;   The current world time.
-(defrecord World [server entities chunks time])
-


improves logging in handling of websocket requests (#1539)

--- waiter/src/waiter/websocket.clj
+++ waiter/src/waiter/websocket.clj
@@ -337,27 +337,34 @@
   "Helper function to stream data between two channels with support for timeout that recognizes backpressure."
   [src-name src-chan dest-name dest-chan streaming-timeout-ms reservation-status-promise stream-error-type
    request-close-chan stream-onto-upload-chan-timer stream-back-pressure-meter notify-bytes-read-fn]
-  (let [upload-chan (async/chan 5)] ;; use same magic 5 as resp-chan in stream-http-response
+  (let [upload-chan (async/chan 5) ;; use same magic 5 as resp-chan in stream-http-response
+        frame-counter (atom 0)
+        byte-streamed-counter (atom 0)
+        stream-info-fn (fn stream-info-fn []
+                         {:bytes @byte-streamed-counter
+                          :frames @frame-counter})]
     (async/pipe upload-chan dest-chan)
     (async/go
       (try
-        (loop [bytes-streamed 0]
+        (loop []
           (if-let [in-data (async/<! src-chan)]
             (let [[bytes-read send-data] (process-incoming-data in-data)]
-              (log/info "received" bytes-read "bytes from" src-name)
+              (log/info "frame" @frame-counter "received" bytes-read "bytes from" src-name)
+              (swap! frame-counter inc)
+              (swap! byte-streamed-counter + bytes-read)
               (notify-bytes-read-fn bytes-read)
               (if (timers/start-stop-time!
                     stream-onto-upload-chan-timer
                     (au/timed-offer! upload-chan send-data streaming-timeout-ms))
-                (recur (+ bytes-streamed bytes-read))
+                (recur)
                 (do
-                  (log/error "unable to stream to" dest-name {:cid (cid/get-correlation-id), :bytes-streamed bytes-streamed})
+                  (log/error "unable to stream to" dest-name (stream-info-fn))
                   (meters/mark! stream-back-pressure-meter)
                   (deliver reservation-status-promise stream-error-type)
                   (async/>! request-close-chan stream-error-type))))
-            (log/info src-name "input channel has been closed, bytes streamed:" bytes-streamed)))
+            (log/info src-name "input channel has been closed" (stream-info-fn))))
         (catch Exception e
-          (log/error e "error in streaming data from" src-name "to" dest-name)
+          (log/error e "error in streaming data from" src-name "to" dest-name (stream-info-fn))
           (deliver reservation-status-promise :generic-error)
           (async/>! request-close-chan :generic-error))))))


errors still not a solved problem

errors still not a solved problem

--- src/mediakeys/hotkeys.clj
+++ src/mediakeys/hotkeys.clj
@@ -55,7 +55,9 @@
             (let [keys (new-keys! key-change)
                   provider (new-provider!)
                   channel (register-keys provider keys old-keys)]
-                ; shouldn't get to save keys, BUT IT IS
+                ; hmmmm, this won't save correctly with errors,
+                ; the errors will just set and set the wrong thing.
+                ; hmmmmmmmmmmmmmm
                 (save-keys! keys)
                 channel)))


fix api/user/current

fix api/user/current

--- src/metabase/api/user.clj
+++ src/metabase/api/user.clj
@@ -15,10 +15,9 @@
        {:status 200
         :body {}}))

-(def user-current
-  (GET "/current" []
-       (or-404-> (*current-user*)
-                 (hydrate [:org_perms :organization]))))
+(defendpoint GET "/current" []
+  (or-404-> (*current-user*)
+    (hydrate [:org_perms :organization])))

 (def user-update
   (PUT "/:user-id" [user-id :as {body :body}]
@@ -33,12 +32,11 @@
         :body {}}))

-(defroutes routes
-           ;; TODO - this feels bleh.  is it better to put the actual route data here
-           ;;        and just have the endpoints be plain functions?
-           ;;        best way to automate building this list?
-           user-list
-           user-current
-           user-get
-           user-update
-           user-update-password)
+(define-routes
+  ;; TODO - this feels bleh.  is it better to put the actual route data here
+  ;;        and just have the endpoints be plain functions?
+  ;;        best way to automate building this list?
+  user-list
+  user-get
+  user-update
+  user-update-password)


Normalize keywords and flatten metadata

Normalize keywords and flatten metadata

--- src/single_track/core.clj
+++ src/single_track/core.clj
@@ -2,10 +2,12 @@
   (:require [clj-logging-config.jul :refer [set-logger-level!]]
             [clojure.java.io :as io]
             [clojure.pprint :refer [pprint]]
-            [clojure.set :refer [rename-keys]])
+            [clojure.set :refer [rename-keys]]
+            [clojure.string :refer [join lower-case]])
   (:import (java.io File)
            (java.util.logging Level)
-           (org.jaudiotagger.audio AudioFileIO))
+           (org.jaudiotagger.audio AudioFileIO)
+           (org.jaudiotagger.tag FieldKey))
   (:gen-class :main true))

 (set! *warn-on-reflection* false)
@@ -17,15 +19,32 @@
 (defn audio-header [audiofile]
   (rename-keys (select-keys (bean (.getAudioHeader audiofile))
                             [:trackLength :bitRateAsNumber :format])
-               {:bitRateAsNumber :bitRate}))
+               {:trackLength :track-length :bitRateAsNumber :bit-rate}))
+
+(defn norm-keyword [str]
+  (->> (re-seq #"[A-Z]?[a-z]+" str)
+       (join "-")
+       (lower-case)
+       (keyword)))
+
+(defn convert-longs [m & ks]
+  (apply assoc m (mapcat #(vector % (try (Long/parseLong (m %)) (catch Exception e nil))) ks)))
+
+(def tags
+  [FieldKey/ALBUM FieldKey/ARTIST FieldKey/TITLE FieldKey/TRACK FieldKey/ALBUM_ARTIST FieldKey/GENRE FieldKey/YEAR])

 (defn audio-tags [audiofile]
-  (bean (.getTag audiofile)))
+  (when-let [tag (.getTag audiofile)]
+    (convert-longs (into {} (map #(vector (norm-keyword (lower-case (.name %1))) (.getFirst tag %1)) tags))
+                   :year :track)))

 (defn metadata [file]
-  (merge {:name (.getName file) :path (.getPath file)}
+  (merge {:name (.getName file)
+          :path (.getPath file)
+          :size (.length file)}
          (when-let [af (audio-file file)]
-           {:header (audio-header af)})))
+           (merge (audio-header af)
+                  (audio-tags af)))))

 (defn visible-files [^File file]
   (not= \. (-> file .getName first)))


Tests for the 'three' function

Tests for the 'three' function

--- test/zg/utils_test.clj
+++ test/zg/utils_test.clj
@@ -126,3 +126,26 @@
             (catch Exception e
                 (is (nil? (get-exception-message e)))))))

+(deftest test-third-1
+    "Check the function emender-jenkins.utils/third."
+    (testing "the function emender-jenkins.utils/third."
+        (are [x y] (= x y)
+            3 (third [1 2 3])
+            3 (third [1 2 3 4 5])
+            3 (third '(1 2 3))
+            3 (third '(1 2 3 4 5)))))
+
+(deftest test-third-2
+    "Check the function emender-jenkins.utils/third."
+    (testing "the function emender-jenkins.utils/third."
+        (are [x y] (= x y)
+            nil (third [1 2])
+            nil (third '(1 2)))))
+
+(deftest test-third-not-NPE
+    "Check the function emender-jenkins.utils/third."
+    (testing "the function emender-jenkins.utils/third."
+        (are [x y] (= x y)
+            nil (third nil))))
+
+


added toast notifications for stop and clear buttons

--- src/clojure/org/turtle/geometry/TurtleGraphics.clj
+++ src/clojure/org/turtle/geometry/TurtleGraphics.clj
@@ -572,12 +572,18 @@
      button-stop
      (reify android.view.View$OnClickListener
        (onClick [this unused-button]
+         (.show (Toast/makeText activity
+                                "Stopping turtle"
+                                Toast/LENGTH_SHORT))
          (stop-turtle-thread activity))))

     (.setOnClickListener
      button-clear
      (reify android.view.View$OnClickListener
        (onClick [this unused-button]
+         (.show (Toast/makeText activity
+                                "Clearing"
+                                Toast/LENGTH_SHORT))
          (swap! (.state activity) assoc-in
                 [:turtle-state]
                 initial-turtle-state)


Make flicker more configurable

Make flicker more configurable

--- src/clojure/playasophy/wonderdome/mode/flicker.clj
+++ src/clojure/playasophy/wonderdome/mode/flicker.clj
@@ -1,18 +1,19 @@
 (ns playasophy.wonderdome.mode.flicker
   (:require
     [playasophy.wonderdome.mode.core :as mode]
-    [playasophy.wonderdome.util.color :as color]))
+    [playasophy.wonderdome.util.color :as color]
+    [playasophy.wonderdome.util.control :as control]))

 (def ^:const ^:private hue-range 0.137)
 (def ^:const ^:private hue-delta 0.05)

-(def ^:const ^:private brightness-rate 0.027)
+(def ^:const ^:private brightness-rate 0.05)

 ; TODO: 'speed' is more like 'delay'
-(def ^:const ^:private min-speed 10)
+(def ^:const ^:private min-speed 5)
 (def ^:const ^:private max-speed 3500)
-(def ^:const ^:private speed-rate 100)
+(def ^:const ^:private speed-rate -200)

 (defn- retarget-pixel
@@ -52,32 +53,22 @@
                   pixels)))

       [:axis/direction :x-axis]
-      (let [delta (* (or (:value event) 0)
-                     (or (:elapsed event) 0)
-                     speed-rate)
-            speed' (-> speed (+ delta) (min max-speed) (max 0))]
-        (assoc this :speed speed'))
+      (assoc this :speed (control/adjust speed event :rate speed-rate :min-val min-speed :max-val max-speed))

       [:axis/direction :y-axis]
-      (let [delta (* (or (:value event) 0)
-                     (or (:elapsed event) 0)
-                     brightness-rate)
-            max-brightness' (-> max-brightness (+ delta) (min 1.0) (max 0.0))]
-        (assoc this :max-brightness max-brightness'))
+      (assoc this :max-brightness (control/adjust max-brightness event :rate brightness-rate))
+
+      [:button/press :L]
+      (assoc this :speed max-speed)
+
+      [:button/press :R]
+      (assoc this :speed min-speed)

       [:button/press :A]
-      (assoc this :hue
-        (let [hue' (- hue hue-delta)]
-          (if (neg? hue')
-            (+ hue 1.0)
-            hue')))
+      (assoc this :hue (control/wrap [0.0 1.0] (- hue hue-delta)))

       [:button/press :B]
-      (assoc this :hue
-        (let [hue' (+ hue hue-delta)]
-          (if (> hue' 1.0)
-            (- hue' 1.0)
-            hue')))
+      (assoc this :hue (control/wrap [0.0 1.0] (+ hue hue-delta)))

       this))


Safer internal variable handling.

Safer internal variable handling.

--- src/dmohs/react/core.cljs
+++ src/dmohs/react/core.cljs
@@ -11,7 +11,7 @@

 (defn- props [instance]
-  (.. instance -props -cljs))
+  (aget (.. instance -props) "cljs"))

 (defn- maybe-report-state-change [instance new-state]
@@ -22,7 +22,7 @@

 (defn- atom-like-state-swap! [instance & swap-args]
-  (let [new-value (apply swap! (.. instance -cljsState) swap-args)]
+  (let [new-value (apply swap! (aget instance "cljsState") swap-args)]
     (.setState instance (if-not-optimized
                           #js{:cljs new-value :js (clj->js new-value)}
                           #js{:cljs new-value}))
@@ -34,7 +34,7 @@
   IDeref
   (-deref [this]
     (when-let [state (.. instance -state)]
-      (.. state -cljs)))
+      (aget state "cljs")))
   ISwap
   (-swap! [this f] (atom-like-state-swap! instance f))
   (-swap! [this f a] (atom-like-state-swap! instance f a))
@@ -42,7 +42,7 @@
   (-swap! [this f a b xs] (apply atom-like-state-swap! instance f a b xs))
   IReset
   (-reset! [this new-value]
-    (reset! (.. instance -cljsState) new-value)
+    (reset! (aget instance "cljsState") new-value)
     (.setState instance (if-not-optimized
                           #js{:cljs new-value :js (clj->js new-value)}
                           #js{:cljs new-value}))
@@ -65,7 +65,7 @@

 (defn- locals [instance]
-  (.-cljsLocals instance))
+  (aget instance "cljsLocals"))

 (defn create-element
@@ -90,12 +90,12 @@
         (let [js-props #js{}
               {:keys [ref key]} props
               default-props (aget (.-constructor (.-prototype type)) "defaultProps")
-              props (merge (when default-props (.-cljsDefault default-props))
+              props (merge (when default-props (aget default-props "cljsDefault"))
                            (dissoc props :ref :key))]
-          (set! (.. js-props -cljs) props)
-          (if-not-optimized (set! (.. js-props -js) (clj->js props)) nil)
-          (when ref (set! (.. js-props -ref) ref))
-          (when key (set! (.. js-props -key) key))
+          (aset js-props "cljs" props)
+          (if-not-optimized (aset js-props "js" (clj->js props)) nil)
+          (when ref (aset js-props "ref" ref))
+          (when key (aset js-props "key" key))
           (apply React.createElement type js-props children))))))

@@ -178,15 +178,15 @@
                                  (call-fn
                                   :get-initial-state get-initial-state (default-arg-map this)))
                          state (merge state (:initial-state-override (props this)))]
-                     (if (.. this -cljsState)
+                     (if (aget this "cljsState")
                        ;; State already exists. Component was probably hot-reloaded,
                        ;; so don't initialize.
                        (if-not-optimized
                          #js{:cljs state :js (clj->js state)}
                          #js{:cljs state})
                        (let [locals-atom (atom nil)]
-                         (set! (.-cljsLocals this) locals-atom)
-                         (set! (.. this -cljsState) (atom state))
+                         (aset  this "cljsLocals" locals-atom)
+                         (aset this "cljsState" (atom state))
                          (maybe-report-state-change this state)
                          (if-not-optimized
                            #js{:cljs state :js (clj->js state)}


CMR-7852: Remove inadvertently committed test file.

--- system-int-test/test/cmr/system_int_test/search/defershapetest.clj
+++ system-int-test/test/cmr/system_int_test/search/defershapetest.clj
@@ -1,92 +0,0 @@
-(ns cmr.system-int-test.search.defershapetest
-  (:require
-   [clojure.java.io :as io]
-   [clojure.test :refer :all]
-   [cmr.common-app.api.routes :as routes]
-   [cmr.common-app.test.side-api :as side]
-   [cmr.common.log :refer [debug]]
-   [cmr.common.mime-types :as mt]
-   [cmr.common.util :as util :refer [are3]]
-   [cmr.search.middleware.shapefile :as shapefile-middleware]
-   [cmr.search.services.parameters.converters.shapefile :as shapefile]
-   [cmr.spatial.line-string :as l]
-   [cmr.spatial.mbr :as m]
-   [cmr.spatial.point :as p]
-   [cmr.spatial.polygon :as poly]
-   [cmr.system-int-test.data2.core :as d]
-   [cmr.system-int-test.data2.granule :as dg]
-   [cmr.system-int-test.data2.umm-spec-collection :as data-umm-c]
-   [cmr.system-int-test.utils.index-util :as index]
-   [cmr.system-int-test.utils.ingest-util :as ingest]
-   [cmr.system-int-test.utils.search-util :as search]
-   [cmr.umm.umm-spatial :as umm-s]))
-
-(use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1"}))
-
-(defn- polygon
-  "Creates a single ring polygon with the given ordinates. Points must be in counter clockwise order.
-  The polygon will be closed automatically."
-  [& ords]
-  (poly/polygon [(apply umm-s/ords->ring ords)]))
-
-(def formats
-  "Shapfile formats to be tested"
-  {"GeoJSON" {:extension "geojson" :mime-type mt/geojson}})
-
-(deftest granule-shapefile-search-test
-  (side/eval-form `(shapefile/set-enable-shapefile-parameter-flag! true))
-  (let [geodetic-coll (d/ingest-umm-spec-collection "PROV1" (data-umm-c/collection {:SpatialExtent (data-umm-c/spatial {:gsr "GEODETIC"})
-                                                                                :EntryTitle "E1"
-                                                                                :ShortName "S1"
-                                                                                :Version "V1"}))
-        cartesian-coll (d/ingest-umm-spec-collection "PROV1" (data-umm-c/collection {:SpatialExtent (data-umm-c/spatial {:gsr "CARTESIAN"})
-                                                                                :EntryTitle "E2"
-                                                                                :ShortName "S2"
-                                                                                :Version "V2"}))
-        geodetic-coll-cid (get-in geodetic-coll [:concept-id])
-        cartesian-coll-cid (get-in cartesian-coll [:concept-id])
-        make-gran (fn [ur & shapes]
-                    (let [shapes (map (partial umm-s/set-coordinate-system :geodetic) shapes)]
-                      (d/ingest "PROV1" (dg/granule-with-umm-spec-collection geodetic-coll geodetic-coll-cid
-                                                    {:granule-ur ur
-                                                     :spatial-coverage (apply dg/spatial shapes)}))))
-        make-cart-gran (fn [ur & shapes]
-                         (let [shapes (map (partial umm-s/set-coordinate-system :cartesian) shapes)]
-                           (d/ingest "PROV1" (dg/granule-with-umm-spec-collection cartesian-coll cartesian-coll-cid
-                                                         {:granule-ur ur
-                                                          :spatial-coverage (apply dg/spatial shapes)}))))
-
-        ;; Bounding rectangles
-        whole-world (make-gran "whole-world" (m/mbr -180 90 180 -90))
-        almost-whole-world (make-gran "almost-whole-world" (m/mbr -179 89 179 -89))]
-    (index/wait-until-indexed)
-
-    (doseq [fmt (keys formats)
-            :let [{extension :extension mime-type :mime-type} (get formats fmt)]]
-      (testing (format "Search by %s shapefile" fmt)
-        (are3 [shapefile items]
-              (let [{:keys [hits headers] :as result1}
-                    (search/find-refs-with-multi-part-form-post
-                            :granule
-                            [{:name "shapefile"
-                              :content (io/file (io/resource (str "shapefiles/" shapefile "." extension)))
-                              :mime-type mime-type}
-                             {:name "provider"
-                              :content "PROV1"}
-                             {:name "scroll"
-                              :content "true"}
-                             {:name "page_size"
-                              :content "1"}])
-                    scroll-id (:CMR-Scroll-Id headers)
-                    result2 (search/find-refs
-                             :granule {:scroll true} {:headers {routes/SCROLL_ID_HEADER scroll-id}})]
-                ; (println "Result1" result1)
-                ; (println "HEADERS - Result1 headers" headers)
-                ; (println "THE SCROLL ID" scroll-id)
-                ; (println "Result2" result2)
-                ; (println "Items are" items)
-                (d/assert-refs-match [whole-world] result1)
-                (d/assert-refs-match [almost-whole-world] result2))
-
-          "Single Polygon box around VA and DC"
-          "box" [whole-world almost-whole-world])))))


CMR-2545 Updates migration to skip granules for now

--- metadata-db-app/src/migrations/036_fix_global_transaction_ids.clj
+++ metadata-db-app/src/migrations/036_fix_global_transaction_ids.clj
@@ -23,16 +23,10 @@
                     SET transaction_id = METADATA_DB.MIGRATION_TRANSACTION_ID_SEQ.NEXTVAL
                     WHERE id = %s"
                    table
-                   (:id row))))
-
-  ;; For granules, we will simply reset all existing transaction ids to 0
-  (doseq [granule-table (h/get-concept-tablenames :granule)]
-    (h/sql (format "UPDATE %s SET transaction_id=0 WHERE transaction_id <> 0"
-                   granule-table))))
+                   (:id row)))))

 (defn down
   "Migrates the database down from version 36."
   []
   (println "migrations.036-fix-global-transaction-ids down...")
-  (println "nothing to do: previous transaction-id values cannot be restored")
-  (h/sql "DROP SEQUENCE METADATA_DB.MIGRATION_TRANSACTION_ID_SEQ"))
+  (println "nothing to do: previous transaction-id values cannot be restored"))


one last dependency update

one last dependency update

--- riffle-hadoop/project.clj
+++ riffle-hadoop/project.clj
@@ -7,7 +7,7 @@
                  [byte-transforms "0.1.3"]
                  [byte-streams "0.2.0-alpha4"]
                  [org.clojure/tools.cli "0.3.1"]
-                 [factual/riffle "0.1.1"]
+                 [factual/riffle "0.1.2"]
                  [org.clojure/tools.logging "0.3.1"]]
   :profiles {:provided {:dependencies [[org.apache.hadoop/hadoop-client "2.2.0"]]}
              :uberjar {:aot [riffle.hadoop.cli]}}


Fix absolute path generation within golang compilation mechanism

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

--- src/obcc/build/golang.clj
+++ src/obcc/build/golang.clj
@@ -72,13 +72,14 @@
     (println (:stderr (protoc (str "--go_out=" path) (str "--proto_path=" path) (str proto) {:verbose true})))))

 (def cwd (System/getProperty "user.dir"))
-(defn fqpath [path] (.getAbsolutePath (io/file cwd path)))
+(defn fqpath [path] (.getAbsolutePath (io/file path)))

 (defn go [path env & args]
+  (println "[GO] go" (apply print-str args))
   (let [fqpath (fqpath path)
         gopath (str fqpath "/build/deps" ":" fqpath "/build" ":" fqpath ":" (System/getenv "GOPATH"))
         _args (vec (concat ["go"] args [:env (merge {"GOPATH" gopath} env)]))]
-    (apply println _args)
+    (println "\tUsing GOPATH" gopath)
     (let [result (apply sh/proc _args)]
       (sh/done result)
       (println (sh/stream-to-string result :err)))))


Basic column-query test on gene fields.

Basic column-query test on gene fields.

--- test/cavm/db_test.clj
+++ test/cavm/db_test.clj
@@ -802,3 +802,89 @@
         (try (f db) ; 'finally' ensures our teardown always runs
           (finally (cdb/close db)))))))

+;
+;
+;
+
+(defn db-in-memory-test-run
+  "Run an in-memory db test case."
+  [fields testfn]
+  (db-fixture
+    db
+    (cdb/write-matrix
+      db "foo"
+      [{:name "foo"
+        :time (org.joda.time.DateTime. 2014 1 1 0 0 0 0)
+        :hash "1234"}]
+      {} (fn [] fields) nil false)
+    (testfn db)))
+
+(defn gene-field [name rows]
+  {:field name
+   :valueType "genes"
+   :row-val identity
+   :rows rows})
+
+(defn category-field [name values]
+  {:rows (range (count values))
+   :field name
+   :valueType "category"
+   :feature {:state values
+             :order (zipmap values (range))}})
+
+(ct/deftest gene-test
+  (let [field0 (gene-field "genes"
+                           [["a"]
+                            ["a" "b"]
+                            ["c"]
+                            ["d" "e"]])
+
+        field1 (category-field "name"
+                               ["probe0"
+                                "probe1"
+                                "probe2"
+                                "probe3"])]
+    (db-in-memory-test-run
+      [field0 field1]
+      (fn [db]
+        (ct/is (= (cdb/column-query db
+                    {:select ["genes"]
+                     :from ["foo"]
+                     :where [:in :any "genes" ["a"]]})
+                  {"genes" [["a"] ["a" "b"]]}))
+        (ct/is (= (cdb/column-query db
+                    {:select ["genes"]
+                     :from ["foo"]
+                     :where [:in :any "genes" ["a" "z"]]})
+                  {"genes" [["a"] ["a" "b"]]}))
+        (ct/is (= (cdb/column-query db
+                    {:select ["name"]
+                     :from ["foo"]
+                     :where [:in :any "genes" ["z"]]})
+                  {"name" []}))))))
+
+;
+; Some experiments with generators for gene fields.
+;
+
+; Generate list of gene names.
+(def gen-genes
+  (gen/such-that not-empty (gen/vector (gen/not-empty gen/string-alpha-numeric))))
+
+; Generate list of genes, and list of rows of genes selected from it, e.g.
+; [["foxm1" "tp53" "her2"] [["foxm1"] ["tp53"] ["foxm1" "tp53"]]]
+(def gen-gene-rows
+  (gen/bind gen-genes
+            (fn [genes] (gen/tuple (gen/return genes)
+                                   (gen/vector (gen/vector (gen/one-of (map gen/return genes))))))))
+
+; Generate field name + rows of genes.
+(def gen-gene-field
+  (gen/fmap #(apply gene-field (% 1)) (gen/tuple gen/string-alpha-numeric gen-gene-rows)))
+
+;(def sql-prop
+;  (prop/for-all [field gen-gene-rows]
+;                (db-in-memory-test-run [field] (fn [db] (ct/is (= 1 1))))))
+
+;(tc/quick-check 100
+;                sql-prop)


CMR-1453 Addresses PR comments

CMR-1453 Addresses PR comments

--- common-app-lib/src/cmr/common_app/api_docs.clj
+++ common-app-lib/src/cmr/common_app/api_docs.clj
@@ -92,7 +92,7 @@
       (force-trailing-slash req ; Without a trailing slash, the relative URLs in index.html are wrong
                             {:status 200
                              :body (slurp (io/resource welcome-page-location))}))
-    ;; Static HTML resources, typically API documentation which needs endpoint URLs replaced
+    (route/resources "/")
     (context "/site" []
       (GET ["/:page", :page #".*\.html$"] {headers :headers, {page :page} :params}
         (when-let [resource (site-resource page)]
@@ -101,8 +101,7 @@
              :body (-> resource
                        slurp
                        (str/replace "%CMR-ENDPOINT%" cmr-root))})))
-      (route/resources "/" {:root resource-root})
-      (route/not-found (slurp (site-resource "404.html"))))))
+      (route/not-found (site-resource "404.html")))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Documentation Generation Vars


stdout disabled

stdout disabled

--- clj-timbre-auditlog/src/clj_timbre_auditlog/audit_log.clj
+++ clj-timbre-auditlog/src/clj_timbre_auditlog/audit_log.clj
@@ -13,14 +13,15 @@

 (defn create-audit-logger [service-name base-path ^ApplicationType application-type]
   (let [audit-log-config (assoc timbre/example-config
-                                :appenders {:file-appender   (assoc (rolling-appender
+                                :appenders {:standard-out     {:enabled? false}
+                                            :println          nil
+                                            :file-appender   (assoc (rolling-appender
                                                                      {:path    (str base-path
                                                                                "/audit_" service-name
                                                                                ;; Hostname will differentiate files in actual environments
                                                                                (when (:hostname env) (str "_" (:hostname env))))
                                                                       :pattern :daily})
-                                                                    :output-fn (fn [data] (force (:msg_ data))))
-                                            :stdout-appender nil}
+                                                                    :output-fn (fn [data] (force (:msg_ data))))}
                                 :timestamp-opts {:pattern  "yyyy-MM-dd'T'HH:mm:ss.SSSXXX"
                                                  :timezone (TimeZone/getTimeZone "Europe/Helsinki")})
         logger           (proxy [Logger] [] (log [s]


Add a less stupid example to the full-stack serialization test.

--- clj_record/test/serialization_test.clj
+++ clj_record/test/serialization_test.clj
@@ -31,4 +31,5 @@
         (do (manufacturer/update (assoc record :name _1)) _1)
         ((manufacturer/get-record (record :id)) :name))
         "some string"
-        23))))
+        23
+        [1 2 3]))))


Add comment in source code pointing to TNS-1

--- src/main/clojure/clojure/tools/namespace/parse.clj
+++ src/main/clojure/clojure/tools/namespace/parse.clj
@@ -30,7 +30,7 @@
   (comment ...) forms."
   [rdr]
   (try
-   (loop [] (let [form (doto (read rdr) str)]
+   (loop [] (let [form (doto (read rdr) str)]  ; str forces errors, see TNS-1
               (cond
                (ns-decl? form) form
                (comment? form) (recur)


Fix typeahead not taking external changes into account

Fixes #205

--- src/re_com/typeahead.cljs
+++ src/re_com/typeahead.cljs
@@ -159,6 +159,15 @@
       reset-typeahead
       (assoc :data-source data-source)))

+(defn- external-model-changed
+  "Update state when the external model value has changed."
+  [state new-value]
+  (-> state
+      (update-model new-value)
+      (display-suggestion new-value)
+      (assoc :external-model new-value)
+      clear-suggestions))
+
 ;; ------------------------------------------------------------------------------------
 ;; Functions with side-effects
 ;; ------------------------------------------------------------------------------------
@@ -254,11 +263,14 @@
                  ;; forwarded to wrapped `input-text`:
                  status status-icon? status-tooltip placeholder width height disabled? class style attr]}]
       {:pre [(validate-args-macro typeahead-args-desc args "typeahead")]}
-      (let [{:as state :keys [suggestions waiting? suggestion-active-index]} @state-atom
+      (let [{:as state :keys [suggestions waiting? suggestion-active-index external-model]} @state-atom
             last-data-source (:data-source state)
+            latest-external-model (deref-or-value model)
             width (or width "250px")]
         (when (not= last-data-source data-source)
           (swap! state-atom change-data-source data-source))
+        (when (not= latest-external-model external-model)
+          (swap! state-atom external-model-changed latest-external-model))
         [v-box
          :class    "rc-typeahead"
          :attr     attr


Print full file path

Print full file path

--- src/single_track/core.clj
+++ src/single_track/core.clj
@@ -23,7 +23,7 @@
   (let [name (.getName file)]
     (.substring name (inc (.lastIndexOf name ".")))))

-(def audio-ext #{"mp3" "wav"})
+(def audio-ext #{"mp3" "wav" "m4a"})
 (defn audio? [file] (audio-ext (file-ext file)))
 (defn file? [^File file] (not (.isDirectory file)))

@@ -33,6 +33,6 @@
   ([] (-main "."))
   ([dir]
    (doseq [^File f (filter (all? file? audio?) (visible-file-seq (io/file dir)))]
-     (println (.getName f)))))
+     (println (.getPath f)))))

 #_(-main)


Woops.. jumping ahead of myself here.

Woops.. jumping ahead of myself here.

--- src/strange_coop/core.clj
+++ src/strange_coop/core.clj
@@ -208,11 +208,6 @@
 (defn check [] (println "compiled!"))

-(defrecord NRepl [config]
-  component/Lifecycle
-  (start [component]
-
-
 (defn -main []
   (log "Initializing -main")
   (let [floor-btn (button :P8 11 :normally-off)


key-serializer-fn in message->producer-record

I'm pretty sure this is what was intended

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -238,7 +238,7 @@
 (defn- message->producer-record
   [key-serializer-fn serializer-fn topic kpartition m]
   (let [message (:message m)
-        k (some-> m :key serializer-fn)
+        k (some-> m :key key-serializer-fn)
         message-topic (get m :topic topic)
         message-partition (some-> m (get :partition kpartition) int)]
     (cond (not (contains? m :message))


Fix docstring for chat-data-structure

Fix docstring for chat-data-structure

--- src/yetibot/core/chat.clj
+++ src/yetibot/core/chat.clj
@@ -40,10 +40,11 @@
        (re-find #"\n" formatted)
        (contains-image-url-lines? formatted)))

-(defn chat-data-structure [d]
+(defn chat-data-structure
   "Formatters to send data structures to chat.
    If `d` is a nested data structure, it will attempt to recursively flatten
    or merge (if it's a map)."
+  [d]
   (when-not (:suppress (meta d))
     (let [[formatted flattened] (fmt/format-data-structure d)]
       (info "formatted is " formatted)


fixes.

fixes.

--- src/play_clj/entities.clj
+++ src/play_clj/entities.clj
@@ -24,19 +24,17 @@
                          scale-x scale-y angle origin-x origin-y something]}
                  _
                  batch]
-    (let [x (- (float (or x 0)) (* (float (or origin-x 0.0)) (float (or scale-x 1.0))))
-          y (float (or y 0))
+    (let [x (float (- (float (or x 0)) (or origin-x 0.0)))
+          y (float (- (float (or y 0)) (or origin-y 0.0)))
           width (float (or width (.getRegionWidth object)))
           height (float (or height (.getRegionHeight object)))]
-
-
       (if (or scale-x scale-y angle)
         (let [scale-x (float (or scale-x 1))
               scale-y (float (or scale-y 1))
               origin-x (float (or origin-x (/ width 2)))
               origin-y (float (or origin-y (/ height 2)))
               angle (float (or angle 0))]
-          (.draw ^Batch batch object x y (* origin-x scale-x) (* origin-y scale-y) width height
+          (.draw ^Batch batch object x y origin-x origin-y width height
             scale-x scale-y angle))
         (.draw ^Batch batch object x y width height)))))


remove unused REPL code

remove unused REPL code

--- src/main/shadow/cljs/devtools/server/repl_impl.clj
+++ src/main/shadow/cljs/devtools/server/repl_impl.clj
@@ -88,19 +88,6 @@

     (repl/read-one build-state rdr {})))

-(def repl-api-fns
-  ;; return value of these is ignored, print to *out* should work?
-  {})
-
-(defn do-repl-api-fn [app worker repl-state {:keys [form] :as read-result}]
-  (let [[special-fn & args]
-        form
-
-        handler
-        (get repl-api-fns special-fn)]
-
-    (apply handler app worker repl-state read-result args)))
-
 (defn repl-print-chan []
   (let [print-chan
         (async/chan)]
@@ -166,11 +153,6 @@

             (= :cljs/quit form)
             :quit
-
-            (and (list? form)
-                 (contains? repl-api-fns (first form)))
-            (do (do-repl-api-fn app worker build-state read-result)
-                (recur))

             :else
             (when-some [result (worker/repl-eval worker session-id runtime-id read-result)]


Tests controlling the parsetree

Tests controlling the parsetree

--- test/paredit/tests.clj
+++ test/paredit/tests.clj
@@ -199,6 +199,7 @@
              "(foo #()"
              "(foo #!)"
              "(foo \\)"
+             "#"
              ]]
     (is (= s (parsetree-to-string (parse s)))))
   (doseq [r ["paredit/compile.clj"
@@ -208,7 +209,17 @@
              "clojure/core.clj"
              ]]
     (let [s (slurp (.getResourceAsStream (clojure.lang.RT/baseLoader) r))]
-      (is (= s (parsetree-to-string (parse s)))))))
+      (is (= s (parsetree-to-string (parse s))))))
+  (are [text expected-tag] (= expected-tag (-?> text parse :content (get 0) :tag))
+       "#" :net.cgrand.parsley/unfinished
+       "f#" :symbol
+       "#'foo" :var
+       "#foo bar" :reader-literal
+       "#foo.bar baz" :reader-literal
+       "#foo.bar []" :reader-literal
+       "#foo 5" :reader-literal
+    )
+  )

 (defn pts []
   #_(normalized-selection-tests)


fixes the token syncer tests to handle for the new cluster metadata parameter (#586)

fixes the token syncer tests to handle for the new cluster metadata parameter


better show.dom coverage

better show.dom coverage

--- test/show/dom_test.clj
+++ test/show/dom_test.clj
@@ -6,6 +6,10 @@
 (defn args-eql [process-args-args expected]
   (is (= (apply dom/process-args process-args-args) expected)))

+(defn test-convert-to-js [args]
+  (with-meta args {:js true}))
+(intern 'show.dom 'convert-to-js test-convert-to-js)
+
 (deftest process-args-test
   (testing "no options in arglist"
     (args-eql '("Foo")
@@ -13,6 +17,9 @@
   (testing "nil options"
     (args-eql '(nil nil)
               [{} nil]))
+  (testing "calls 'convert-to-js on nested hashes"
+    (let [[{:keys [nested-hash]} _] (dom/process-args {:nested-hash {:b "string"}})]
+      (is (= (meta nested-hash) {:js true}))))
   (testing 'preproces-opts
     (testing "rewriting :class to :className"
       (args-eql '({:class "bar"})
@@ -28,6 +35,9 @@
 (intern 'show.dom 'element-creator test-creator)

 (deftest element-test
+  (testing "calls 'convert-to-js on opts & body"
+    (let [[_ arg1 arg2] (dom/element :noop {:foo :bar} "string")]
+      (every? #(true? (:js (meta %))) [arg1 arg2])) )
   (testing "Delegates to element-creator"
     (is (= (dom/element :h2 {:className "foo"} "Bar")
            ["h2" {:className "foo"} '("Bar")]))))


Added the y axis to the test

Added the y axis to the test


Exercise 2.2

Exercise 2.2

--- src/sicp/chapter2/1_2.clj
+++ src/sicp/chapter2/1_2.clj
@@ -1,5 +1,6 @@
 (ns sicp.chapter2.1-2
-  (:require [sicp.chapter1.2-5 :refer [gcd]]
+  (:require [sicp.chapter1.1-7 :refer [average]]
+            [sicp.chapter1.2-5 :refer [gcd]]
             [sicp.common.list :refer :all]))

 ;;;; 2.1  Introduction to Data Abstraction
@@ -18,7 +19,32 @@
     (/ (cdr x) g)))

 ;; Exercise 2.2
-;; TODO
+(defn make-point [x y]
+  (kons x y))
+(defn x-point [p]
+  (car p))
+(defn y-point [p]
+  (cdr p))
+
+(defn make-segment [start end]
+  (kons start end))
+(defn start-segment [s]
+  (car s))
+(defn end-segment [s]
+  (cdr s))
+
+(defn midpoint-segment [s]
+  (let [start (start-segment s)
+        start-x (x-point start)
+        start-y (y-point start)
+        end (end-segment s)
+        end-x (x-point end)
+        end-y (y-point end)]
+    (make-point (average start-x end-x)
+                (average start-y end-y))))
+
+(defn print-point [p]
+  (printf "(%s,%s)%n" (x-point p) (y-point p)))

 ;; Exercise 2.3
 ;; TODO


Formatting

Formatting

--- clj_record/validation.clj
+++ clj_record/validation.clj
@@ -30,8 +30,7 @@
   (dosync
     (let [validations (or (model-metadata-for model-name :validations) [])]
       (set-model-metadata-for model-name :validations
-        (conj validations
-          [attribute-name message function])))))
+        (conj validations [attribute-name message function])))))

 (defn expand-init-option
   "init-model macro-expansion delegate that generates a call to add-validation."


Update data.struct ns with constant key vars.

--- src/vault/data/struct.clj
+++ src/vault/data/struct.clj
@@ -9,25 +9,35 @@
   - `:data/values` a vector of values deserialized from the content")

+(def ^:const type-key
+  "Keyword in a blob record which stores the type of the contained data."
+  :data/type)
+
+
+(def ^:const values-key
+  "Keyword in a blob record which stores the type of the contained data."
+  :data/values)
+
+
 (defn data-attrs
   "Associates data attributes with the blob content."
   [blob data-type values & ks]
   (apply assoc blob
-    :data/type data-type
-    :data/values (vec values)
+    type-key data-type
+    values-key (vec values)
     ks))

 (defn data-type
   "Returns the type of data stored in the blob."
   [blob]
-  (:data/type blob))
+  (type-key blob))

 (defn data-value
   "Returns the first data value from the blob."
   [blob]
-  (first (:data/values blob)))
+  (first (values-key blob)))

 #_
@@ -36,8 +46,8 @@
   Returns an updated copy of the blob with a :data/type key set."
   [blob]
   ; If blob has a data type, assume it's already been processed.
-  (if (:data/type blob)
+  (if (type-key blob)
     blob
     (or (edn/parse-data blob)
         (key/parse-key blob)
-        (assoc blob :data/type :raw))))
+        (assoc blob type-key :raw))))


casing

casing

--- src/aws/provider.clj
+++ src/aws/provider.clj
@@ -123,7 +123,7 @@
   (dissoc-in* (assoc-in m to (get-in m from)) from))

 (defn aws-spec
-  "creates an ec2 spec"
+  "Creates an ec2 spec"
   [{:keys [aws machine] :as spec}]
   (let [spec' (merge-with merge (dissoc-in* spec [:aws :endpoint]) defaults)]
     (cond-> spec'


Make (char 0) the transparent character instead of space so that space with a special bg color will render

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -692,6 +692,10 @@
                   [col c]    (map-indexed vector line)]
             ;;(log/info "row" row "col" col "c" c)
             (let [chr        (or (get c :fx-character) (get c :character))
+                  chr        (if (and (= layer-id base-layer-id)
+                                      (= chr (char 0)))
+                                 \space
+                                 chr)
                   highlight  (= @cursor-xy [col (- rows row 1)])
                   [fg-r fg-g fg-b] (if highlight
                                      (or (get c :fx-bg-color)  (get c :bg-color))
@@ -708,10 +712,10 @@
                 (.position glyph-image-data i)
                 (.position fg-image-data i)
                 (.position bg-image-data i))
-              (assert (or (not (nil? x)) (not (nil? y))) (format "X/Y nil - glyph not found for character %s %s" (or (str chr) "nil") (or (format "%x" (int chr)) "nil")))
               (if (or (= layer-id base-layer-id)
-                      (not= chr \space))
+                      (not= chr (char 0)))
                 (do
+                  (assert (or (not (nil? x)) (not (nil? y))) (format "X/Y nil - glyph not found for character %s %s" (or (str chr) "nil") (or (format "%x" (int chr)) "nil")))
                   (.put glyph-image-data (unchecked-byte x))
                   (.put glyph-image-data (unchecked-byte y))
                   (.put glyph-image-data (unchecked-byte 0))
@@ -958,7 +962,7 @@
           font-texture       (with-gl-context gl-lock (texture-id font-texture-image))
           _                  (swap! font-textures update (font-key @normal-font) (fn [m] (assoc m :font-texture font-texture)))
           ;; create texture atlas
-          character-map-cleared (vec (repeat rows (vec (repeat columns (make-terminal-character \space default-fg-color default-bg-color #{})))))
+          character-map-cleared (vec (repeat rows (vec (repeat columns (make-terminal-character (char 0) default-fg-color default-bg-color #{})))))
           _                     (log/info "layer-order" layer-order)
           layers-character-map  (zipmap layer-order (repeatedly #(ref character-map-cleared)))
           cursor-xy             (atom nil)


larger area to test

larger area to test

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@9436 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/SlideExplorer2/src/slide_explorer/main.clj
+++ plugins/SlideExplorer2/src/slide_explorer/main.clj
@@ -165,7 +165,8 @@
                             {:nx nx :ny ny :nz (get-in image [:tags "SliceIndex"]) :nt 0
                              :nc (get-in image [:tags "Channel"])}
                             (image :proc))))
-
+
+

 (defn go []
   (core waitForDevice (core getXYStageDevice))
@@ -181,7 +182,7 @@
                                :nc (get-in image [:tags "Channel"])}
                               (image :proc)))
     (swap! ss assoc :channels (initial-lut-objects first-seq))
-    (doseq [nx (range -2 3) ny (range -2 3)]
+    (doseq [nx (range -4 5) ny (range -4 5)]
       (add-tiles-at available-tiles [nx ny] affine-stage-to-pixel))))


Add more improvements to quartz abstraction layer.

--- src/uxbox/util/quartz.clj
+++ src/uxbox/util/quartz.clj
@@ -33,18 +33,20 @@
     PersistentJobImpl []
   Job
   (execute [_ context]
-    (let [data (.. context getJobDetail getJobDataMap)
-          callable (.get ^JobDataMap data "callable")
-          state (.get ^JobDataMap data "state")
-          result (callable state)]
+    (let [^JobDataMap data (.. context getJobDetail getJobDataMap)
+          callable (.get data "callable")
+          state (.get data "state")
+          args (.get data "args")
+          result (apply callable state args)]
       (.put ^JobDataMap data "state" result))))

 (deftype JobImpl []
   Job
   (execute [_ context]
-    (let [data (.. context getJobDetail getJobDataMap)
-          callable (.get ^JobDataMap data "callable")]
-      (callable))))
+    (let [^JobDataMap data (.. context getJobDetail getJobDataMap)
+          args (.get data "args")
+          callable (.get data "callable")]
+      (apply callable args))))

 (defn- build-trigger
   [{:keys [cron group name repeat? interval]
@@ -65,14 +67,37 @@
     (.build builder)))

 (defn- build-job-detail
-  [f {:keys [group name state] :or {group "uxbox"} :as opts}]
-  (let [name (or name (str (gensym "uxbox-job")))
-        data (JobDataMap. {"callable" f "state" state})
+  [f {:keys [group name state args] :as opts}]
+  (let [data (JobDataMap. {"callable" f
+                           "state" state
+                           "args" args})
         builder (doto (JobBuilder/newJob (if state PersistentJobImpl JobImpl))
                   (.storeDurably true)
                   (.usingJobData data)
                   (.withIdentity name group))]
     (.build builder)))
+
+(defn- resolve-fn
+  [func opts]
+  (cond
+    (symbol? func)
+    (let [ns (symbol (namespace func))
+          _  (require ns)
+          var (resolve func)
+          opts (assoc (merge (meta var) opts)
+                      :name (name (or (:name opts) (gensym "uxbox")))
+                      :group (name (:group opts "uxbox")))]
+      [@var opts])
+
+    (fn? func)
+    (let [opts (assoc opts
+                      :name (name (:name opts) (gensym "uxbox"))
+                      :group (name (:group opts "uxbox")))]
+      [func opts])))
+
+(defn- next-name
+  []
+  (str (gensym "uxbox")))

 ;; --- Public Api

@@ -105,9 +130,8 @@

 (defn schedule!
   ([schd f] (schedule! schd f nil))
-  ([schd f {:keys [name group] :as opts}]
-   (let [name (or name (str (gensym "uxbox")))
-         opts (assoc opts :name name :group "uxbox")
+  ([schd f opts]
+   (let [[f opts] (resolve-fn f opts)
          job (build-job-detail f opts)
          trigger (build-trigger opts)]
      (.scheduleJob ^Scheduler schd job trigger))))


more simple benchmarking tools

more simple benchmarking tools

xrosslexior.bench=> (time (convenient-experiment 3 50))
"Elapsed time: 258140.711058 msecs"
{:old {:avrg 0.8494501573000002, :stdv 2.483122732354644}, :new {:avrg
4.281548738359999, :stdv 10.151301940796944}}
xrosslexior.bench=> (time (convenient-experiment 3 50))
"Elapsed time: 233648.8898 msecs"
{:old {:avrg 0.9826805831800003, :stdv 1.6025643821713615}, :new {:avrg
3.6901217727399995, :stdv 6.782018468566562}}
xrosslexior.bench=> (time (convenient-experiment 3 50))
"Elapsed time: 258403.75089 msecs"
{:old {:avrg 0.7159657852000001, :stdv 1.5485036215595984}, :new {:avrg
4.451975969680001, :stdv 7.979775996210098}}

--- src/xrosslexior/bench.clj
+++ src/xrosslexior/bench.clj
@@ -5,9 +5,39 @@
   `(let [start# (. System (nanoTime))
          evaluated# ~code
          stop# (. System (nanoTime))]
-     {:result evaluated#
+     {:output evaluated#
       :time (/ (- stop# start#) 1e9)}))

+(defn square-grid-seeded-with-word [word]
+  (write-row (empty-square-grid (count word)) 0 word))
+
 (defn benchmark-first-row-words [solver words]
-  (let [grids (map #(write-row (empty-square-grid (count %)) 0 %) words)]
+  (let [grids (map square-grid-seeded-with-word words)]
     (map #(benchmark (solver %)) grids)))
+
+(defn mean [data]
+  (/ (reduce + data) (count data)))
+
+(defn sample-variance [data]
+  (- (/ (reduce + (map #(Math/pow % 2) data))
+        (count data))
+     (Math/pow (mean data) 2)))
+
+(defn sample-standard-deviation [data]
+  (Math/sqrt (sample-variance data)))
+
+(defn summarize-benchmark [results]
+  (let [times (map #(% :time) results)]
+      {:avrg (mean times)
+       :stdv (sample-standard-deviation times)}))
+
+(defn convenient-experiment [n size]
+  (let [start (rand-int 300)
+        words (take size (drop start (n-dictionary n)))
+        results (into {}
+                      (for [[name solver] [[:old solve] [:new solve-it]]]
+                        [name (benchmark-first-row-words solver words)]))
+        summary (into {}
+                      (for [[solver-name result] results]
+                        [solver-name (summarize-benchmark result)]))]
+    summary))


Partial support for substituting in values when stepping expressions

--- cmma-clj/src/cmma/dev.clj
+++ cmma-clj/src/cmma/dev.clj
@@ -159,6 +159,10 @@
                            (zero? skip-elem) (recur skip-elem (first progress) (conj new-form token) (next progress))))]
     `(~@processed-form)))

+(defn- print-form [form]
+  (println "\nFinal form:" form)
+  form)
+
 (defn step-debug [form]
   "Step through an expression with a debug-repl.
   Empty list is next step/continue: ()
@@ -166,26 +170,33 @@
    * form - the whole form you're stepping through
    * current-form - the current form/token you're on
    * step - what the current-step evals to
+   * info - a string of all the step information
    * progress - an atom'd vector of all forms/tokens you've seen so far - CURRENTLY REMOVED
    * *locals* - a map of all locals in scope"
   (let [progress (atom [])]
     (eval
-      (walk/prewalk (fn [current-form]
-                      (when (not= current-form form)
-                        (swap! progress conj current-form)
-                        (try
-                          (let [step (eval current-form)
-                                sdbg `(~@(formize-progress @progress) (debug-repl nil {} {(symbol "form") ~form
+      (doto
+        (walk/prewalk (fn [current-form]
+                      (if (not= current-form form)
+                        (do (swap! progress conj current-form)
+                            (try
+                              (let [step (eval current-form)
+                                    info (str "\nform:" form
+                                              "\ncurrent-form:" current-form
+                                              "\nprogress:" (formize-progress @progress)
+                                              "\nstep:" step)
+                                    sdbg `(~@(formize-progress @progress) (debug-repl ~current-form
+                                                                                {}
+                                                                                {(symbol "form") ~form
                                                                                (symbol "current-form") ~current-form
                                                                                ;(symbol "progress") ~progress
-                                                                                (symbol "step") ~step}))]
-                            (println "\nform:" form
-                                     "\ncurrent-form:" current-form
-                                     "\nprogress:" (formize-progress @progress)
-                                     "\nstep:" step)
-                            (eval sdbg))
-                          (catch Throwable t
-                            nil)))
-                      current-form)
-                    form))))
-
+                                                                                (symbol "step") ~step
+                                                                                (symbol "info") ~info}))]
+                                (println info)
+                                (eval sdbg))
+                              (catch Throwable t
+                                current-form)))
+                        current-form))
+                    form)
+        print-form))))
+


Improved debug repl support

Improved debug repl support

--- cmma-clj/src/cmma/dev.clj
+++ cmma-clj/src/cmma/dev.clj
@@ -9,8 +9,8 @@

 (def ^:dynamic *locals*)
 (defn eval-with-locals
-  "Evals a form with given locals. The locals should be a map of symbols to
-  values."
+  "Evals a form with given locals.
+  The locals should be a map of symbols to values."
   [locals form]
   (binding [*locals* locals]
     (eval
@@ -24,7 +24,7 @@
       request-exit
       input)))

-(def ^:dynamic level 0)
+(def ^{:dynamic true :tag 'long} level (long 0))
 (def counter (atom 1000))
 (defn inc-counter []
   (swap! counter inc))
@@ -40,29 +40,41 @@
   (throw quit-dr-exception))

 (defn caught [exc]
-  (if (= (.getCause ^Throwable exc) quit-dr-exception)
+  (if (or (= exc quit-dr-exception)
+          (= (.getCause ^Throwable exc) quit-dr-exception))
     (throw quit-dr-exception)
     (clojure.main/repl-caught exc)))

 (defmacro debug-repl
   "Starts a REPL with the local bindings available."
   ([]
-   `(debug-repl nil))
-  ([form]
-   `(let [counter# (inc-counter)
-          eval-fn# (partial eval-with-locals (local-bindings))]
+   `(debug-repl nil ~(meta &form)))
+  ([retform]
+   `(debug-repl retform ~(meta &form)))
+  ([retform form-meta]
+   `(let [debug-meta# ~(assoc form-meta
+                              :ns *ns*
+                              :file *file*)
+          eval-fn# (fn [e-form#]
+                     (eval-with-locals (merge {(symbol "debug-meta") debug-meta#
+                                               (symbol "in-debug-ns") (fn [] (in-ns (ns-name (:ns debug-meta#))))}
+                                              (local-bindings)
+                                              {(symbol "quit-dr") ~quit-dr}) e-form#))]
       (try
-        (binding [level (inc level)]
+        (binding [level (unchecked-inc level)]
           (clojure.main/repl
-            :prompt #(print (str "dr-" level "-" counter# " => "))
+            :init (fn []
+                    (use 'clojure.core)
+                    (use 'clojure.repl))
+            :prompt #(print (str "dr-" level "-" (inc-counter) " [" *ns* "]=> "))
             :eval eval-fn#
             :read dr-read
             :caught caught))
         (catch Exception e#
           (if (= e# quit-dr-exception)
-            (if-let [new-form# (.nextElement quit-dr-exception)]
+            (if-let [new-form# (.nextElement ^java.util.Enumeration quit-dr-exception)]
               (eval-fn# new-form#)
-              (eval-fn# ~form))
+              (eval-fn# ~retform))
             (throw e#)))))))

 (defmacro assert-repl [assertion-form]
@@ -75,8 +87,9 @@
 (defmacro try-repl [body-form]
   `(try
      ~body-form
-     (catch Exception ex#
-       (debug-repl))))
+     (catch Throwable ex#
+       (let [~'debug-exception ex#]
+         (debug-repl)))))

 (defn make-error-handler
   "This takes a function that takes two args
@@ -87,7 +100,7 @@
     (uncaughtException [thread exception]
       (f thread exception))))

-(def debug-ex-handler (make-error-handler (fn [thread exception] (debug-repl))))
+(def debug-ex-handler (make-error-handler (fn [thread debug-exception] (debug-repl))))

 (defn debug-uncaught-exceptions! []
   (Thread/setDefaultUncaughtExceptionHandler debug-ex-handler))


Removing extra seq from bills list

Removing extra seq from bills list

--- src/billbo/bills.clj
+++ src/billbo/bills.clj
@@ -27,7 +27,7 @@
       (catch Exception e (throw (.getNextException e))))))

 (defn list-all-bills []
-  (seq (list-bills db-spec)))
+  (list-bills db-spec))

 (defn gen-bill-id []
   (str (fmt/unparse (fmt/formatter "yyyyMMddHHmmssSSS") (tim/now))


style fix

style fix

--- src/blind/reader.clj
+++ src/blind/reader.clj
@@ -18,7 +18,7 @@

 (deftype StringPushbackReader
     [^:unsynchronized-mutable ^String s ^:unsynchronized-mutable len
-     ^"[Ljava.lang.Object;" buf ^:unsynchronized-mutable pos]
+     ^objects buf ^:unsynchronized-mutable pos]
   PushbackReader
   (read-char [reader]
     (if (< pos (alength buf))


Add byte real32 and real64 type specs.

Add byte real32 and real64 type specs.

--- src/bytebuf/spec.clj
+++ src/bytebuf/spec.clj
@@ -122,16 +122,39 @@
      (read [_ buff pos]
        (let [readed (buffer/read-byte buff pos)]
          [1 (condp = readed
-              (byte 0) false
-              (byte 1) true
+              (clojure.core/byte 0) false
+              (clojure.core/byte 1) true
               nil)]))

      IWritableSpec
      (write [_ buff pos value]
        (let [value (condp = value
-                     true (byte 1)
-                     false (byte 0)
-                     (byte -1))]
+                     true (clojure.core/byte 1)
+                     false (clojure.core/byte 0)
+                     (clojure.core/byte -1))]
+         (buffer/write-byte buff pos value)
+         1))
+
+     IStaticSize
+     (size [_] 1))))
+
+
+(defn byte
+  "Create a boolean data type."
+  ([] (byte (clojure.core/byte 0)))
+  ([default]
+   (reify
+     ISpecType
+     (tag [_] :static)
+
+     IReadableSpec
+     (read [_ buff pos]
+       (let [readed (buffer/read-byte buff pos)]
+         [1 readed]))
+
+     IWritableSpec
+     (write [_ buff pos value]
+       (let [value (clojure.core/byte (or value default))]
          (buffer/write-byte buff pos value)
          1))

@@ -206,6 +229,52 @@
      IStaticSize
      (size [_]
        (Long/BYTES)))))
+
+(defn real32
+  "Create a real of 32bits type spec."
+  ([] (real32 0))
+  ([default]
+   (reify
+     ISpecType
+     (tag [_] :static)
+
+     IReadableSpec
+     (read [_ buff pos]
+       [(Float/BYTES)
+        (buffer/read-float buff pos)])
+
+     IWritableSpec
+     (write [_ buff pos value]
+       (let [value (or value default)]
+         (buffer/write-float buff pos value)
+         (Float/BYTES)))
+
+     IStaticSize
+     (size [_]
+       (Float/BYTES)))))
+
+(defn real64
+  "Create a real of 32bits type spec."
+  ([] (real64 0))
+  ([default]
+   (reify
+     ISpecType
+     (tag [_] :static)
+
+     IReadableSpec
+     (read [_ buff pos]
+       [(Double/BYTES)
+        (buffer/read-double buff pos)])
+
+     IWritableSpec
+     (write [_ buff pos value]
+       (let [value (or value default)]
+         (buffer/write-double buff pos value)
+         (Double/BYTES)))
+
+     IStaticSize
+     (size [_]
+       (Double/BYTES)))))

 (defn string
   "Fixed size string spec constructor."


[Add] fun reverse-sign

[Add] fun reverse-sign

--- src/clj_elm/core.clj
+++ src/clj_elm/core.clj
@@ -19,6 +19,12 @@
      (> x 0) 1
      (= x 0) 0
      :else -1)))
+
+(defn reverse-sign
+  ([x]
+   {:pre [(number? x)]
+    :post [(<= (Math/abs %) 1)]}
+   (- (sign x))))

 (defn make-weights
   "Make a d-dimension-random-feature vector. d is number of dimention of


Remove redundant conditional

Remove redundant conditional

--- src/cljam/io/bed.clj
+++ src/cljam/io/bed.clj
@@ -262,9 +262,7 @@
                        (if (fields-<= r1 y)
                          (cons r1 (subtract (next xs) ys))
                          (subtract (cons r1 (next xs)) (next ys)))
-                       (if (fields-<= x y)
-                         (subtract (next xs) ys)
-                         (subtract xs (next ys))))))
+                       (subtract (next xs) ys))))
                  xs)
                [])))]
     (subtract (sort-fields xs) (merge-fields ys))))


Use cigar.clj in pileup.clj

Use cigar.clj in pileup.clj

--- src/cljam/pileup.clj
+++ src/cljam/pileup.clj
@@ -1,6 +1,7 @@
 (ns cljam.pileup
   (:require [clojure.string :refer [join]]
-            (cljam [sorter :as sorter])))
+            [cljam [cigar :as cgr]
+                   [sorter :as sorter]]))

 (defn substantial-seq [aln]
   (let [{seq :seq, cigar :cigar} aln]
@@ -37,7 +38,7 @@
     (let [[aln & rst] alns2]
       (if (or (nil? aln) (not= rname (:rname aln)) (< pos (:pos aln)))
         val
-        (if (< pos (+ (:pos aln) (count (substantial-seq aln))))
+        (if (< pos (+ (:pos aln) (cgr/count-ref (:cigar aln))))
           (recur rst (inc val))
           (recur rst val))))))

@@ -62,7 +63,7 @@
              {:rname rname, :pos pos, :n val}
              (if-not (or (nil? rst) (= rname (:rname (first rst))))
                (pileup* rst (:rname (first rst)) (:pos (first rst)))
-               (if (< pos (+ (:pos aln) (count (substantial-seq aln))))
+               (if (< pos (+ (:pos aln) (cgr/count-ref (:cigar aln))))
                  (pileup* alns rname (inc pos))
                  (pileup* rst rname (inc pos)))))))))))


provides an event listener that logs all events at INFO level

--- src/ctia/logging.clj
+++ src/ctia/logging.clj
@@ -1,9 +1,9 @@
 (ns ctia.logging
   (:require [clojure.tools.logging :as log]
-            [clojure.core.async :as a :refer [go <! chan]]
+            [clojure.core.async :as a :refer [go <! chan tap]]
             [ctia.events :as e]
             [schema.core :as s])
-  (:import [clojure.core.asyc.impl.protocols Channel]))
+  (:import [clojure.core.async.impl.protocols Channel]))

 (s/defn log-channel :- Channel
   "Logging an event channel indefinitely. Returns the channel for a go loop that never ends."
@@ -11,5 +11,5 @@
   (let [events (chan)]
     (tap m events)
     (go (loop [ev (<! events)]
-          (log/info "event: " ev)
+          (log/info "event:" ev)
           (recur (<! events))))))


added pos to video.clj

added pos to video.clj

--- src/elliot/video.clj
+++ src/elliot/video.clj
@@ -95,3 +95,16 @@
         (is (= (into [] (:words (nth control rand-ind)))
                (nth blocked rand-ind))))))))

+
+(defn add-pos [video]
+  (map
+   #(assoc %1 :pos %2)
+   video
+   (blockify-list
+    (nlp-utils/tag-pos (de-blockify video :words))
+    video
+    :words)))
+
+(deftest test-add-pos
+  (let [vid (make "resources/subs/elliot_hulse/p2zvOJe1Iq4_0_en.srt")]
+    (println (add-pos vid))))


Account for 3rd param - :NA for wgseq

Account for 3rd param - :NA for wgseq

--- services/wgseq-phase2.clj
+++ services/wgseq-phase2.clj
@@ -5,14 +5,14 @@

  :graph {:dir  {:type "func"
                 :name "get-comparison-files"
-                :args ["#1", "#2"]} ; eid, comparison-file, rep?
+                :args ["#1", "#2" "#3"]} ; eid, comparison-file, :NA here
          :bseq {:type "func"
                 :name "breseq-runs"}
          :aggr {:type "func"
                 :name "aggregate"}
          :mail {:type "func"
                 :name "mailp2"
-                :args ["#3"        ; recipient
+                :args ["#4"        ; recipient
                        "Aerobio job status: wgseq phase-2"
                        "Finished"]}      ; subject, body intro
          :edges {:dir [:bseq]


Correct weirdness with error handling

Correct weirdness with error handling

--- src/exploud/http.clj
+++ src/exploud/http.clj
@@ -31,7 +31,7 @@
 ;; `ConnectException`.
 (with-handler! #'simple-get
   java.net.ConnectException
-  (fn [e url _]
+  (fn [e url & [_]]
     (throw (ex-info (.getMessage e) {:type ::connection-refused
                                      :class :http}))))

@@ -39,7 +39,7 @@
 ;; `ConnectTimeoutException`.
 (with-handler! #'simple-get
   org.apache.http.conn.ConnectTimeoutException
-  (fn [e url _]
+  (fn [e url & [_]]
     (throw (ex-info (.getMessage e) {:type ::connect-timeout
                                      :class :http}))))

@@ -47,7 +47,7 @@
 ;; `SocketTimeoutException`.
 (with-handler! #'simple-get
   java.net.SocketTimeoutException
-  (fn [e url _]
+  (fn [e url & [_]]
     (throw (ex-info (.getMessage e) {:type ::socket-timeout
                                      :class :http}))))

@@ -55,7 +55,7 @@
 ;; `UnknownHostException`.
 (with-handler! #'simple-get
   java.net.UnknownHostException
-  (fn [e url _]
+  (fn [e url & [_]]
     (throw (ex-info (.getMessage e) {:type ::unknown-host
                                      :class :http}))))

@@ -78,7 +78,7 @@
 ;; `ConnectException`.
 (with-handler! #'simple-post
   java.net.ConnectException
-  (fn [e url _]
+  (fn [e url & [_]]
     (throw (ex-info (.getMessage e) {:type ::connection-refused
                                      :class :http}))))

@@ -86,7 +86,7 @@
 ;; `ConnectTimeoutException`.
 (with-handler! #'simple-post
   org.apache.http.conn.ConnectTimeoutException
-  (fn [e url _]
+  (fn [e url & [_]]
     (throw (ex-info (.getMessage e) {:type ::connect-timeout
                                      :class :http}))))

@@ -94,7 +94,7 @@
 ;; `SocketTimeoutException`.
 (with-handler! #'simple-post
   java.net.SocketTimeoutException
-  (fn [e url _]
+  (fn [e url & [_]]
     (throw (ex-info (.getMessage e) {:type ::socket-timeout
                                      :class :http}))))

@@ -102,6 +102,6 @@
 ;; `UnknownHostException`.
 (with-handler! #'simple-post
   java.net.UnknownHostException
-  (fn [e url _]
+  (fn [e url & [_]]
     (throw (ex-info (.getMessage e) {:type ::unknown-host
                                      :class :http}))))


added a function which upper-cases all values

--- src/grid/render.cljs
+++ src/grid/render.cljs
@@ -23,11 +23,11 @@
                            (map (partial User (:header meta)) (:data data))))))

 (def my-data {:data [{:name "John Doe"
-                          :email "user@email.com"
-                          :country "USA" }
-                         {:name "Frank Bølviken"
-                          :email "frank.bolviken@gmail.com"
-                          :country "Norway"}]})
+                      :email "user@email.com"
+                      :country "USA" }
+                     {:name "Frank Bølviken"
+                      :email "frank.bolviken@gmail.com"
+                      :country "Norway"}]})

 (def my-meta {:header [{:key :email :title "Email"
                         :className "email"
@@ -37,3 +37,12 @@

 (q/render (Grid my-meta my-data)
           (.getElementById js/document "grid"))
+
+(defn remap
+  "returns a function which takes a map as argument
+   and applies f to each value in the map"
+  [f]
+  #(into {} (map (fn [[k v]] [k (f v)]) %)))
+
+(defn upper-case-data [data]
+  (update-in data [:data] #(map (remap clojure.string/upper-case) %)))


Notation

Notation

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -479,12 +479,12 @@
   Examples:
   > [:def :any :any :any :any \"clojure.core\" \"concat\"]

-  Will match all instances of the Def clojure.core/concat on all platforms in
-  all versions in all artifacts in all groups.
+  Will match all instances of Defs named \"clojure.core/concat\" on all
+  platforms in all versions in all artifacts in all groups.

   > [:ns :any \"clojure\" :any :any \"clojure.set\"]

-  Will match all instances of the Ns clojure.set in all artifacts named
+  Will match all instances of Nss named \"clojure.set\" in all artifacts named
   \"clojure\" in all versions, platforms and groups.

   > [:ns #\"org.*\" :any :any :any :any]


Add constant variables and a utility function

Signed-off-by: ivermac <cd640042a8f3b0ff08bacdf4feae34fdd495051d@gmail.com>

--- src/hatti/utils.cljs
+++ src/hatti/utils.cljs
@@ -58,3 +58,29 @@
                                          (render-static component)))
                                      components)]
     (join components-as-static-markup)))
+
+(def approved-text "Approved")
+(def approved-status "1")
+(def rejected-text "Rejected")
+(def rejected-status "2")
+(def pending-text "Pending")
+(def pending-status "3")
+
+(def review-status-map
+  "This hash-map contains the supported statuses that a form submission can be
+   assigned."
+  {approved-status approved-text
+   rejected-status rejected-text
+   pending-status pending-text})
+
+(def review-status-list
+  [{:review-status approved-status :review-text approved-text}
+   {:review-status rejected-status :review-text rejected-text}
+   {:review-status pending-status :review-text pending-text}])
+
+(defn get-submission-review-text
+  [row-map]
+  (get review-status-map
+       (if-let [r-status (get row-map "_review_status")]
+         r-status
+         pending-status)))


Ensure imagemagick is installed before using it.

--- test/clj/quil/snippet.clj
+++ test/clj/quil/snippet.clj
@@ -1,7 +1,6 @@
 (ns quil.snippet
   (:require [quil.core :as q]
             [quil.snippets.all-snippets :as as]
-            [clojure.edn :as edn]
             [clojure.java.io :as io]
             [clojure.test :as t]
             [clojure.java.shell :as sh]
@@ -28,6 +27,12 @@
                "save"
                "time-and-date"} snippet-name))

+(defn- imagemagick-installed? []
+  (try
+    (sh/sh "compare" "-version")
+    true
+    (catch java.io.IOException e false)))
+
 (defn- compare-images
   "Compares images at file paths `expected` and `actual` and produces another
   image at path `difference` which highlights any differences in the images.
@@ -39,7 +44,7 @@
   ;; see https://imagemagick.org/script/compare.php
   (let [{:keys [err]} (sh/sh "compare" "-metric" "mae" expected actual difference)
         result        (second (re-find #"\((.*)\)" err))]
-    (edn/read-string result)))
+    (Double/parseDouble result)))

 (defn- replace-suffix [file-name suffix]
   (string/replace file-name #"(\w+)\.(\w+)$" (str suffix ".$2")))
@@ -79,7 +84,9 @@
              (try
                (q/background 255)
                (body)
-               (assert-unchanged-snippet-output name)
+               (if (imagemagick-installed?)
+                 (assert-unchanged-snippet-output name)
+                 (println "Imagemagick not detected. Please install it for automated image comparison to work."))
                (catch Exception e
                  (println "Error" e)
                  (.printStackTrace e)


lein-release plugin: bumped version from 0.1.0 to 0.1.1-SNAPSHOT for next developemnt cycle

--- liverepl-server/project.clj
+++ liverepl-server/project.clj
@@ -1,4 +1,4 @@
-(defproject com.brightcove.liverepl/liverepl-server "0.1.0"
+(defproject com.brightcove.liverepl/liverepl-server "0.1.1-SNAPSHOT"
   :description "Brightcove local version of liverepl-server"
   :license {:name "Copyright (C) 2009 David J. Powell.  See GitHub for license."}
   :url "https://github.com/djpowell/liverepl"


support pretty-printing

support pretty-printing

--- src/jsx_fun/core.clj
+++ src/jsx_fun/core.clj
@@ -16,7 +16,9 @@
       :lang-in
       (case v
         :es5 (.setLanguageIn compiler-options
-               CompilerOptions$LanguageMode/ECMASCRIPT5))))
+               CompilerOptions$LanguageMode/ECMASCRIPT5))
+      :pretty-print
+      (set! (.prettyPrint compiler-options) v)))
   compiler-options)

 (defn jsx-engine []
@@ -40,7 +42,8 @@
 (defn transform-commonjs
   [filename src]
   (let [js      [(SourceFile/fromCode filename src)]
-        options (set-options {:lang-in :es5} (CompilerOptions.))
+        options (set-options {:lang-in :es5 :pretty-print true}
+                  (CompilerOptions.))
         comp    (doto (cl/make-closure-compiler)
                   (.init '() js options))
         root    (.parse comp (first js))]
@@ -65,10 +68,10 @@
 (comment
   (spit
     (io/file "resources/ScrollResponder.out.js")
-    (transform-jsx jsx-eng
-      (slurp (io/file "resources/ScrollResponder.js"))))
+    (transform-jsx (slurp (io/file "resources/ScrollResponder.js"))))

-  (transform-commonjs
-    "ScrollResponder.js"
-    (transform-jsx (slurp (io/file "resources/ScrollResponder.js"))))
+  (println
+    (transform-commonjs
+      "ScrollResponder.js"
+      (transform-jsx (slurp (io/file "resources/ScrollResponder.js")))))
   )


fixed typo in handler

fixed typo in handler

--- src/kata/handler.clj
+++ src/kata/handler.clj
@@ -9,7 +9,7 @@
             [taoensso.timbre.appenders.3rd-party.rotor :as rotor]
             [selmer.parser :as parser]
             [environ.core :refer [env]]
-            [kata.db.core :as db]))
+            [kata.db.core :as db]
             [kata.config :refer [defaults]]
             [mount.core :as mount]))


comment

comment

--- src/leech/parse.cljs
+++ src/leech/parse.cljs
@@ -54,6 +54,7 @@
 (def standard-re
   #"^(\d\d\d\d-\d\d-\d\dT\d\d:\d\d:\d\d[\-\+]\d\d:00) ([0-9\.]+) ([a-z0-7]+)\.([a-z]+) ([a-z\-\_]+)(\[(\d+)\])? - ([a-z4-6-]+)?\.(\d+)@([a-z.]+\.com) - (.*)$")

+; we hand-optimize this very hot code path.
 (defn parse-standard-line [l]
   (if-let [m (re-matches standard-re l)]
     (let [raw-obj (parse-message-attrs (get m 11))]


(SERVER-2565) Write files atomically in CA

--- src/clj/puppetlabs/puppetserver/certificate_authority.clj
+++ src/clj/puppetlabs/puppetserver/certificate_authority.clj
@@ -19,6 +19,7 @@
             [clj-time.coerce :as time-coerce]
             [slingshot.slingshot :as sling]
             [puppetlabs.kitchensink.core :as ks]
+            [puppetlabs.kitchensink.file :as ks-file]
             [puppetlabs.puppetserver.ringutils :as ringutils]
             [puppetlabs.ssl-utils.core :as utils]
             [clojure.set :as cset :refer [union]]
@@ -254,6 +255,10 @@
   "Posix permissions for all private keys on disk."
   "rw-r-----")

+(def public-key-perms
+  "Posix permissions for all public keys on disk."
+  "rw-r--r--")
+
 (def private-key-dir-perms
   "Posix permissions for the private key directory on disk."
   "rwxr-x---")
@@ -452,6 +457,9 @@
   [serial-number :- schema/Int]
   (format "%04X" serial-number))

+(def serial-file-permissions
+  "rw-r--r--")
+
 (schema/defn next-serial-number! :- schema/Int
   "Returns the next serial number to be used when signing a certificate request.
   Reads the serial number as a hex value from the given file and replaces the
@@ -460,27 +468,32 @@
   [serial-file :- schema/Str]
   (locking serial-file-lock
     (let [serial-number (get-serial-number! serial-file)]
-      (spit serial-file (format-serial-number (inc serial-number)))
+      (ks-file/atomic-write-string serial-file
+                                   (format-serial-number (inc serial-number))
+                                   serial-file-permissions)
       serial-number)))

 (schema/defn initialize-serial-file!
   "Initializes the serial number file on disk.  Serial numbers start at 1."
   [path :- schema/Str]
-  (fs/create (fs/file path))
-  (spit path (format-serial-number 1)))
+  (ks-file/atomic-write-string path
+                               (format-serial-number 1)
+                               serial-file-permissions))

 (schema/defn write-local-cacrl! :- (schema/maybe Exception)
-  "Spits the contents of 'cacrl' string to the 'localcacrl' file location if
-  the 'cacrl' string contains valid CRL pem data. On success, return nil.
-  On failure, return the Exception captured from the failed attempt to parse
-  the CRL pem data."
-  [localcacrl :- schema/Str
-   cacrl :- schema/Str]
-  (let [crl-reader (StringReader. cacrl)]
+  "Spits the contents of 'cacrl-contents' string to the 'localcacrl' file
+  location if the 'cacrl' string contains valid CRL pem data. On success, return
+  nil. On failure, return the Exception captured from the failed attempt to
+  parse the CRL pem data."
+  [localcacrl-path :- schema/Str
+   cacrl-contents :- schema/Str]
+  (let [crl-reader (StringReader. cacrl-contents)]
     (try
       (when (zero? (count (utils/pem->crls crl-reader)))
         (throw (CRLException. "No CRL data found")))
-      (spit localcacrl cacrl)
+      (ks-file/atomic-write-string localcacrl-path
+                                   cacrl-contents
+                                   public-key-perms)
       nil
       (catch IOException e
         e)
@@ -570,29 +583,37 @@
     [infra-file :- schema/Str]
     (line-seq (io/reader infra-file)))

+(defn- write-infra-serials-to-writer
+  [writer infra-nodes-path infra-node-serials-path signeddir]
+  (try
+    (let [infra-nodes (read-infra-nodes infra-nodes-path)]
+      (doseq [infra-node infra-nodes]
+        (try
+          (let [infra-serial (-> (path-to-cert signeddir infra-node)
+                                 (utils/pem->cert)
+                                 (utils/get-serial))]
+            (.write writer (str infra-serial))
+            (.newLine writer))
+          (catch java.io.FileNotFoundException ex
+            (log/warn
+             (i18n/trs
+              (str
+               "Failed to find/load certificate for Puppet Infrastructure Node:"
+               infra-node)))))))
+    (catch java.io.FileNotFoundException ex
+      (log/warn (i18n/trs (str infra-nodes-path " does not exist"))))))
+
 (schema/defn generate-infra-serials
   "Given a list of infra nodes it will create a file containing
    serial numbers of their certificates (listed on separate lines).
    It is expected have at least one entry (MoM)"
-   [{:keys [infra-nodes-path infra-node-serials-path signeddir]} :- CaSettings]
-   (with-open [wtr (io/writer infra-node-serials-path)]
-     (try
-       (let [infra-nodes (read-infra-nodes infra-nodes-path)]
-         (doseq [infra-node infra-nodes]
-           (try
-             (let [infra-serial (-> (path-to-cert signeddir infra-node)
-                                 (utils/pem->cert)
-                                 (utils/get-serial))]
-               (.write wtr (str infra-serial))
-               (.newLine wtr))
-            (catch java.io.FileNotFoundException ex
-               (log/warn
-                 (i18n/trs
-                   (str
-                     "Failed to find/load certificate for Puppet Infrastructure Node:"
-                     infra-node)))))))
-       (catch java.io.FileNotFoundException ex
-         (log/warn (i18n/trs (str infra-nodes-path " does not exist")))))))
+  [{:keys [infra-nodes-path infra-node-serials-path signeddir]} :- CaSettings]
+  (ks-file/atomic-write infra-node-serials-path
+                        #(write-infra-serials-to-writer %
+                                                        infra-nodes-path
+                                                        infra-node-serials-path
+                                                        signeddir)
+                        public-key-perms))

 (schema/defn generate-ssl-files!
   "Given the CA settings, generate and write to disk all of the necessary
@@ -617,27 +638,26 @@
                                           serial
                                           public-key)
         cacert      (utils/sign-certificate
-                      x500-name
-                      private-key
-                      serial
-                      (:not-before validity)
-                      (:not-after validity)
-                      x500-name
-                      public-key
-                      ca-exts)
+                     x500-name
+                     private-key
+                     serial
+                     (:not-before validity)
+                     (:not-after validity)
+                     x500-name
+                     public-key
+                     ca-exts)
         cacrl       (utils/generate-crl (.getIssuerX500Principal cacert)
                                         private-key
                                         public-key)
-        infra-crl-path   (utils/generate-crl (.getIssuerX500Principal cacert)
-                                        private-key
-                                        public-key)]
+        infra-crl (utils/generate-crl (.getIssuerX500Principal cacert)
+                                      private-key
+                                      public-key)]
     (write-cert-to-inventory! cacert (:cert-inventory ca-settings))
-    (utils/key->pem! public-key (:capub ca-settings))
-    (utils/key->pem! private-key
-      (create-file-with-perms (:cakey ca-settings) private-key-perms))
-    (utils/cert->pem! cacert (:cacert ca-settings))
-    (utils/crl->pem! cacrl (:cacrl ca-settings))
-    (utils/crl->pem! infra-crl-path (:infra-crl-path ca-settings))))
+    (ks-file/atomic-write (:capub ca-settings) (partial utils/key->pem! public-key) public-key-perms)
+    (ks-file/atomic-write (:cakey ca-settings) (partial utils/key->pem! private-key) private-key-perms)
+    (ks-file/atomic-write (:cacert ca-settings) (partial utils/cert->pem! cacert) public-key-perms)
+    (ks-file/atomic-write (:cacrl ca-settings) (partial utils/crl->pem! cacrl) public-key-perms)
+    (ks-file/atomic-write (:infra-crl-path ca-settings) (partial utils/crl->pem! infra-crl) public-key-perms)))

 (schema/defn split-hostnames :- (schema/maybe [schema/Str])
   "Given a comma-separated list of hostnames, return a list of the
@@ -787,10 +807,12 @@
   (let [keypair (utils/generate-key-pair keylength)
         public-key (utils/get-public-key keypair)
         private-key (utils/get-private-key keypair)]
-    (utils/key->pem! public-key hostpubkey)
-    (utils/key->pem! private-key
-                     (create-file-with-perms hostprivkey
-                                             private-key-perms))
+    (ks-file/atomic-write hostpubkey
+                          (partial utils/key->pem! public-key)
+                          public-key-perms)
+    (ks-file/atomic-write hostprivkey
+                          (partial utils/key->pem! private-key)
+                          private-key-perms)
     public-key))

 (schema/defn generate-master-ssl-keys! :- (schema/pred utils/public-key?)
@@ -856,9 +878,10 @@
                                                public-key
                                                extensions)]
     (write-cert-to-inventory! hostcert (:cert-inventory ca-settings))
-    (utils/cert->pem! hostcert (:hostcert settings))
-    (utils/cert->pem! hostcert
-                      (path-to-cert (:signeddir ca-settings) certname))))
+    (ks-file/atomic-write (:hostcert settings) (partial utils/cert->pem! hostcert) public-key-perms)
+    (ks-file/atomic-write (path-to-cert (:signeddir ca-settings) certname)
+                          (partial utils/cert->pem! hostcert)
+                          public-key-perms)))

 (schema/defn ^:always-validate initialize-master-ssl!
   "Given configuration settings, certname, and CA settings, ensure all
@@ -1146,7 +1169,9 @@
                                              (.getPublicKey cacert)))]
     (log/info (i18n/trs "Signed certificate request for {0}" subject))
     (write-cert-to-inventory! signed-cert cert-inventory)
-    (utils/cert->pem! signed-cert (path-to-cert signeddir subject))))
+    (ks-file/atomic-write (path-to-cert signeddir subject)
+                          (partial utils/cert->pem! signed-cert)
+                          public-key-perms)))

 (schema/defn ^:always-validate
   save-certificate-request!
@@ -1156,7 +1181,7 @@
    csrdir :- schema/Str]
   (let [csr-path (path-to-cert-request csrdir subject)]
     (log/debug (i18n/trs "Saving CSR to ''{0}''" csr-path))
-    (utils/obj->pem! csr csr-path)))
+    (ks-file/atomic-write csr-path (partial utils/obj->pem! csr) public-key-perms)))

 (schema/defn validate-duplicate-cert-policy!
   "Throw a slingshot exception if allow-duplicate-certs is false
@@ -1225,6 +1250,7 @@
                         (i18n/tru "CSR ''{0}'' contains subject alternative names ({1}), which are disallowed." subject (str/join ", " subject-alt-names))
                         (i18n/tru "To allow subject alternative names, set allow-subject-alt-names to true in your puppetserver.conf file.")
                         (i18n/tru "Then restart the puppetserver and try signing this certificate again."))})))))
+
 (schema/defn ^:always-validate process-csr-submission!
   "Given a CSR for a subject (typically from the HTTP endpoint),
    perform policy checks and sign or save the CSR (based on autosign).
@@ -1429,24 +1455,26 @@
                     (utils/pem->cert)
                     (utils/get-serial))
         [our-full-crl & rest-of-full-chain] (utils/pem->crls cacrl)
-         new-full-crl (utils/revoke our-full-crl
-                              (utils/pem->private-key cakey)
-                              (.getPublicKey (utils/pem->ca-cert cacert cakey))
-                              serial)]
-    (utils/objs->pem! (cons new-full-crl (vec rest-of-full-chain)) cacrl)
+        new-full-crl (utils/revoke our-full-crl
+                                   (utils/pem->private-key cakey)
+                                   (.getPublicKey (utils/pem->ca-cert cacert cakey))
+                                   serial)
+        new-full-chain (cons new-full-crl (vec rest-of-full-chain))]
+    (ks-file/atomic-write cacrl (partial utils/objs->pem! new-full-chain))
     (log/debug (i18n/trs "Revoked {0} certificate with serial {1}" subject serial))

     ;; Publish infra-crl if an infra node is getting revoked.
     (when (and enable-infra-crl
                (fs/exists? infra-node-serials-path)
                (seq-contains? (read-infra-nodes infra-node-serials-path) (str serial)))
-       (let [[our-infra-crl & rest-of-infra-chain] (utils/pem->crls infra-crl-path)
-             new-infra-crl (utils/revoke our-infra-crl
-                                         (utils/pem->private-key cakey)
-                                         (.getPublicKey (utils/pem->ca-cert cacert cakey))
-                                         serial)]
-         (utils/objs->pem! (cons new-infra-crl (vec rest-of-infra-chain)) infra-crl-path)
-         (log/info (i18n/trs "Infra node certificate being revoked; publishing updated infra CRL"))))))
+      (let [[our-infra-crl & rest-of-infra-chain] (utils/pem->crls infra-crl-path)
+            new-infra-crl (utils/revoke our-infra-crl
+                                        (utils/pem->private-key cakey)
+                                        (.getPublicKey (utils/pem->ca-cert cacert cakey))
+                                        serial)
+            full-infra-chain (cons new-infra-crl (vec rest-of-infra-chain))]
+        (ks-file/atomic-write infra-crl-path (partial utils/objs->pem! full-infra-chain))
+        (log/info (i18n/trs "Infra node certificate being revoked; publishing updated infra CRL"))))))

 (schema/defn ^:always-validate set-certificate-status!
   "Sign or revoke the certificate for the given subject."