Simplify shape functions

Simplify shape functions

--- minimal-3d-physics/desktop/src-common/minimal_3d_physics/core.clj
+++ minimal-3d-physics/desktop/src-common/minimal_3d_physics/core.clj
@@ -31,9 +31,9 @@
          (add-body! screen))))

 (defn create-sphere!
-  [screen mat attrs]
+  [screen]
   (-> (model-builder)
-      (model-builder! :create-sphere 4 4 4 24 24 mat attrs)
+      (model-builder! :create-sphere 4 4 4 24 24 (get-material) (get-attrs))
       model
       (assoc :body (create-sphere-body! screen))))

@@ -47,9 +47,9 @@
          (add-body! screen))))

 (defn create-box!
-  [screen mat attrs]
+  [screen]
   (-> (model-builder)
-      (model-builder! :create-box 4 4 2 mat attrs)
+      (model-builder! :create-box 4 4 2 (get-material) (get-attrs))
       model
       (assoc :body (create-box-body! screen))))

@@ -68,9 +68,9 @@
                                             :set-gravity (vector-3 0 -10 0))
                           :attributes env
                           :camera cam)]
-      [(doto (create-sphere! screen (get-material) (get-attrs))
+      [(doto (create-sphere! screen)
          (body-position! 0 5 5))
-       (doto (create-box! screen (get-material) (get-attrs))
+       (doto (create-box! screen)
          (body-position! 0 5 0))]))
   :on-render
   (fn [screen entities]
@@ -83,7 +83,7 @@
     (size! screen width height))
   :on-touch-down
   (fn [{:keys [x y] :as screen} entities]
-    (conj entities (create-box! screen (get-material) (get-attrs)))))
+    (conj entities (create-box! screen))))

 (defscreen text-screen
   :on-show


explicitly add quote-danger? to initial state in paren mode

--- lib/src/parinfer/paren_mode.cljc
+++ lib/src/parinfer/paren_mode.cljc
@@ -22,6 +22,7 @@
   {:lines []                           ;; final lines containing the inferenced closing delimiters.
    :line-no -1                         ;; current line number we are processing.
    :track-indent? false                ;; "true" when we are looking for the first char on a line to signify indentation.
+   :quote-danger? false                ;; odd number of quotes in comments are dangerous (track here)
    :delim-trail {:start nil :end nil}  ;; track EOL delims since we replace them wholesale with inferred delims.
    :insert {:line-dy nil :x-pos nil}   ;; the place to insert closing delimiters whenever we hit appropriate indentation.
    :stack []                           ;; the delimiter stack, maps of [:x-pos :ch :indent-delta]


azulenoids.clj: refactored (azul-syms) function

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -53,11 +53,8 @@
     dsym))

 (def azul-syms
-  (let [raw (for [ds octa-syms
-                  o2t boundary-mappings]
-              (-> (on-template ds o2t) minimal canonical))]
-    (for [ds (distinct raw)]
-      (-> ds dual canonical))))
+  (distinct (for [ds octa-syms, o2t boundary-mappings]
+              (-> (on-template ds o2t) minimal dual canonical))))

 ;; Main entry point when used as a script


fixing nil error messages

fixing nil error messages

--- sidecar/src/figwheel_sidecar/repl_api.clj
+++ sidecar/src/figwheel_sidecar/repl_api.clj
@@ -188,11 +188,12 @@
         (do (mapv println errors) false)))))

 (defn resolve-hook-fn [ky hook]
-  (if-let [hook-fn (and hook (utils/require-resolve-handler hook))]
-    (if (or (fn? hook-fn) (and (var? hook-fn) (fn? @hook-fn)))
-      hook-fn
-      (println "Figwheel: your" (pr-str ky) "function is not a function - " (pr-str hook)))
-    (println "Figwheel: unable to resolve your" (pr-str ky) "function - " (pr-str hook))))
+  (when hook
+    (if-let [hook-fn (utils/require-resolve-handler hook)]
+      (if (or (fn? hook-fn) (and (var? hook-fn) (fn? @hook-fn)))
+        hook-fn
+        (println "Figwheel: your" (pr-str ky) "function is not a function - " (pr-str hook)))
+      (println "Figwheel: unable to resolve your" (pr-str ky) "function - " (pr-str hook)))))

 (defn call-hook-fn [ky hook-fn]
   (do (println "Figwheel: calling your" (pr-str ky) "function - "(pr-str hook-fn))


test entity coercion

test entity coercion

--- test/clj_money/models/entities_test.clj
+++ test/clj_money/models/entities_test.clj
@@ -18,16 +18,21 @@
 (def other-user (users/create storage-spec (factory :user)))

 (deftest create-an-entity
-  (let [actual (entities/create storage-spec attributes)
-        expected {:name "Personal"
-                  :user-id (:id user)}]
-    (testing "The new entity is returned"
-      (is (= expected
-             (dissoc actual :id)) "The returned map should have the correct content."))
-    (testing "The name can be duplicated between two different users"
-      (let [other-entity (entities/create storage-spec
-                                          (assoc attributes :user-id (:id other-user)))]
-        (is (number? (:id other-entity)))))))
+  (testing "An entity can be created with valid attributes"
+    (let [actual (entities/create storage-spec attributes)
+          expected {:name "Personal"
+                    :user-id (:id user)}]
+      (testing "The new entity is returned"
+        (is (= expected
+               (dissoc actual :id)) "The returned map should have the correct content."))
+      (testing "The name can be duplicated between two different users"
+        (let [other-entity (entities/create storage-spec
+                                            (assoc attributes :user-id (:id other-user)))]
+          (is (number? (:id other-entity)))))))
+  (testing "Attributes are coerced into the correct types"
+    (let [result (entities/create storage-spec {:user-id (str (:id user))
+                                                :name "Coerced"})]
+      (is (number? (:id result))))))

 (deftest attempt-to-create-an-invalid-entity
   (testing "Name is required"


Show actual days left in trial.

Show actual days left in trial.

--- src-cljs/frontend/components/license.cljs
+++ src-cljs/frontend/components/license.cljs
@@ -1,5 +1,7 @@
 (ns frontend.components.license
-  (:require [om.core :as om :include-macros true])
+  (:require [om.core :as om :include-macros true]
+            [cljs-time.coerce :as t-coerce]
+            [cljs-time.core :as t])
   (:require-macros [frontend.utils :refer [html]]))

 (def show-banner?
@@ -10,10 +12,12 @@
     om/IDisplayName (display-name [_] "License Banner")
     om/IRender
     (render [_]
-      (html [:.license-banner
-             [:.indicator "Trial Account"]
-             [:.message "Welcome to CircleCI."]
-             [:.timing [:span.days "30"] " days left in trial"]
-             [:a.contact-sales
-              {:href "mailto:enterprise@circleci.com"}
-              "Contact Sales…"]]))))
+      (let [expiry-date (t-coerce/from-string (:expiry_date license))
+            days-until-expiry (t/in-days (t/interval (t/now) expiry-date))]
+        (html [:.license-banner
+               [:.indicator "Trial Account"]
+               [:.message "Welcome to CircleCI."]
+               [:.timing [:span.days days-until-expiry] " days left in trial"]
+               [:a.contact-sales
+                {:href "mailto:enterprise@circleci.com"}
+                "Contact Sales…"]])))))


Improvements to user mgmt form.

Improvements to user mgmt form.

--- src-cljs/kixi/hecuba/user_management.cljs
+++ src-cljs/kixi/hecuba/user_management.cljs
@@ -40,15 +40,15 @@
                            {:display "User" :role :kixi.hecuba.security/user :value "user"}
                            {:display "None" :role "none" :value "none"}])

-(defn dropdown [{:keys [default items]} owner {:keys [dropdown-chan id path]}]
+(defn dropdown [{:keys [default items]} owner {:keys [event-chan id path]}]
   (om/component
    (html
     [:select.form-control
      {:default-value default :id id
       :on-change (fn [e]
                    (let [v    (.-value (aget (.-options (.-target e)) (.-selectedIndex (.-options (.-target e)))))]
-                     (put! dropdown-chan {:path path
-                                          :value (if-not (= v "none") v nil)})))}
+                     (put! event-chan {:event :dropdown :value {:path path
+                                                                :value (if-not (= v "none") v nil)}})))}
      (for [item items]
        [:option {:value (:role item)} (:display item)])])))

@@ -57,9 +57,10 @@

 (defn post-form [data username selected]
   (let [{:keys [role programmes projects]} selected]
-    (let [existing-data (select-keys (-> @data :user) [:role :programmes :projects])
-          new-data      (assoc (into {} (filter #(seq (val %)) (select-keys selected [:programmes :projects])))
-                          :role (:role selected))
+    (let [existing-data (dissoc (-> @data :user) :class :username :data :fetching :typed)
+          selected-role (:role selected)
+          new-data      (-> (into {} (filter #(seq (val %)) (select-keys selected [:programmes :projects])))
+                            (cond-> (seq role) (assoc :role role)))
           data-to-post  (common/deep-merge existing-data new-data)
           parsed (-> data-to-post
                      (assoc :programmes (into {} (remove #(nil? (val %)) (:programmes data-to-post))))
@@ -102,64 +103,61 @@

 (defn load-user-data
   "Initialises drop down, programmes and projects with user data."
-  [data user]
-  (let [{:keys [programmes projects role]} (:data user)]
-    (om/update! data [:user :class] "has-success")
-    (om/update! data [:user :username] (:username user))
-    (om/update! data [:user :role] role)
-    (om/update! data [:user :programmes] programmes)
-    (om/update! data [:user :projects] projects)
-    (data/fetch-programmes data)
-    (fetch-projects data)))
+  [user found-user event-chan]
+  (let [{:keys [programmes projects role]} (:data found-user)]
+    (om/update! user :class "has-success")
+    (om/update! user :username (:username found-user))
+    (om/update! user :role role)
+    (om/update! user :programmes programmes)
+    (om/update! user :projects projects)
+    (put! event-chan {:event :fetch-data})))

 (defn find-username
   "Check if typed username exists and load user data if it does. Display error alert otherwise."
-  [data username]
-  (if username
-    (let [user (first (filter #(= (:username %) username) (-> @data :user :data)))]
-      (if user
-        (load-user-data data user)
-        (do
-          (om/update! data [:user :class] "has-error")
-          (om/update! data :alert {:status true
-                                   :class "alert alert-danger"
-                                   :text "Username not found."}))))))
-
-(defn clear-form
-  "Reset app-state when user deletes their selection."
-  [data]
-  (om/update! data [:user :role] {})
-  (om/update! data [:user :class] "")
-  (om/update! data [:user :username] nil)
-  (om/update! data [:user :projects] {})
-  (om/update! data [:user :programmes] {}))
-
-(defn username-selection-form [data]
-  (fn [cursor owner]
-    (reify
-      om/IRender
-      (render [_]
-        (html
-         (let [selected-username (-> cursor :username)
-               class             (-> cursor :class)]
-           [:div.form-inline {:role "form" :style {:width "100%"}}
-            [:div {:class (str "form-group " class)}
-             [:input {:type "text"
-                      :style {:width "100%"}
-                      :class "form-control"
-                      :default-value selected-username
-                      :on-change (fn [e] (om/set-state! owner :value (.-value (.-target e)))
-                                   (when (empty? (om/get-state owner :value))
-                                     (clear-form data)))
-                      :on-key-press (fn [e] (when (= (.-keyCode e) 13)
-                                              (find-username data (om/get-state owner :value))))}]]
-            [:button {:type "button" :class "btn btn-primary"
-                      :on-click (fn [e] (find-username data (om/get-state owner :value)))} "Find user"]]))))))
+  [user event-chan]
+  (let [username (-> @user :typed)]
+    (when username
+      (let [found-user (first (filter #(= (:username %) username) (-> @user :data)))]
+        (if found-user
+          (load-user-data user found-user event-chan)
+          (do
+            (om/update! user :class "has-error")
+            (put! event-chan {:event :clear-form})
+            (put! event-chan {:event :alert :value {:status true
+                                                    :class "alert alert-danger"
+                                                    :text "Username not found."}})))))))
+
+(defn username-selection-form [user owner]
+ (reify
+   om/IRenderState
+   (render-state [_ {:keys [event-chan]}]
+     (html
+      (let [typed-username (-> user :typed)
+            class          (-> user :class)]
+        [:div.form-inline {:role "form"}
+         [:div {:class (str "col-md-10 form-group " class)}
+          [:input {:type "text"
+                   :style {:width "100%"}
+                   :class "form-control"
+                   :value typed-username
+                   :on-click (fn [e]
+                               (put! event-chan {:event :alert :value {:status false}})
+                               (om/update! user :class ""))
+                   :on-change (fn [e] (om/update! user :typed (.-value (.-target e)))
+                                (when (empty? (-> @user :typed))
+                                  (put! event-chan {:event :alert :value {:status false}})
+                                  (om/update! user :class "")
+                                  (put! event-chan {:event :clear-form})))
+                   :on-key-press (fn [e] (when (= (.-keyCode e) 13)
+                                           (put! event-chan {:event :alert :value {:status false}})
+                                           (find-username user event-chan)))}]]
+         [:button {:type "button" :class "col-md-2 btn btn-primary"
+                   :on-click (fn [e] (find-username user event-chan))} "Find user"]])))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Projects

-(defn project-row [project owner {:keys [dropdown-chan]}]
+(defn project-row [project owner {:keys [event-chan]}]
   (reify
     om/IRender
     (render [_]
@@ -170,12 +168,12 @@
           [:td {:style {:width "40%"}}
            (om/build dropdown {:default role
                                :items projects-table-roles}
-                    {:opts {:dropdown-chan dropdown-chan
+                    {:opts {:event-chan event-chan
                             :id (str project_id "-role")
                             :path [:projects project_id]}})]])))))

-(defn projects-table [{:keys [projects existing-selections]} owner {:keys [dropdown-chan]}]
+(defn projects-table [{:keys [projects existing-selections]} owner {:keys [event-chan]}]
   (reify
     om/IRender
     (render [_]
@@ -189,12 +187,12 @@
            (om/build-all project-row (sort-by :project_id
                                               (mapv #(assoc % :role (get-in existing-selections [(:project_id %)] "none"))
                                                     projects))
-                         {:key :project_id :opts {:dropdown-chan dropdown-chan}})]]]]))))
+                         {:key :project_id :opts {:event-chan event-chan}})]]]]))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Programmes

-(defn programmes-row [programme owner {:keys [dropdown-chan]}]
+(defn programmes-row [programme owner {:keys [event-chan]}]
   (reify
     om/IRender
     (render [_]
@@ -205,11 +203,11 @@
           [:td {:style {:width "40%"}}
           (om/build dropdown {:default role
                               :items programmes-table-roles}
-                    {:opts {:dropdown-chan dropdown-chan
+                    {:opts {:event-chan event-chan
                             :id (str programme_id "-role")
                             :path [:programmes programme_id]}})]])))))

-(defn programmes-table [{:keys [programmes existing-selections]} owner {:keys [dropdown-chan]}]
+(defn programmes-table [{:keys [programmes existing-selections]} owner {:keys [event-chan]}]
   (reify
     om/IRender
     (render [_]
@@ -223,7 +221,7 @@
          [:tbody
           (om/build-all programmes-row
                         (sort-by :name (mapv #(assoc % :role (get-in existing-selections [(:programme_id %)] "none"))
-                                             programmes)) {:key :programme_id :opts {:dropdown-chan dropdown-chan}})]]]))))
+                                             programmes)) {:key :programme_id :opts {:event-chan event-chan}})]]]))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Entire view of the page
@@ -239,11 +237,27 @@
        [:label.control-label.col-md-2 {:for label} label]
        [:p {:class "form-control-static col-md-10"} data]]))))

+(defn fetch-data [data]
+  (data/fetch-programmes data)
+  (fetch-projects data))
+
+(defn clear-form
+  "Reset app-state when user deletes their selection."
+  [data]
+  (om/update! data [:programmes :data] [])
+  (om/update! data [:projects :data] [])
+  (om/update! data :selected nil)
+  (om/update! data [:user :role] nil)
+  (om/update! data [:user :class] "")
+  (om/update! data [:user :username] nil)
+  (om/update! data [:user :projects] {})
+  (om/update! data [:user :programmes] {}))
+
 (defn user-management-view [data owner]
   (reify
     om/IInitState
     (init-state [_]
-      {:dropdown-chan (chan)})
+      {:event-chan (chan)})
     om/IWillMount
     (will-mount [_]
       (data/fetch-usernames data)
@@ -255,12 +269,17 @@
             :response-format :json
             :keywords? true})
       (go-loop []
-        (let [{:keys [dropdown-chan]} (om/get-state owner)
-              {:keys [path value]}    (<! dropdown-chan)]
-          (om/update! data (into [:selected] path) (reader/read-string value))) ;; value from form is a string
+        (let [{:keys [event-chan]}  (om/get-state owner)
+              {:keys [event value]} (<! event-chan)]
+          (cond
+           (= event :dropdown) (let [{:keys [path value]} value]
+                                 (om/update! data (into [:selected] path) (reader/read-string value)))
+           (= event :alert) (om/update! data :alert value)
+           (= event :fetch-data) (fetch-data data)
+           (= event :clear-form) (clear-form data)))
         (recur)))
     om/IRenderState
-    (render-state [_ {:keys [dropdown-chan]}]
+    (render-state [_ {:keys [event-chan]}]
       (let [role (-> data :user :role)
             {:keys [username projects programmes]} (-> data :user)
             selected   (-> data :selected)
@@ -270,38 +289,42 @@
          [:div.col-md-12 {:style {:padding-top "10px"}}
           (if editing
             [:div
+             ;; Alert
+             [:div.col-md-12 [:div {:style {:padding-top "10px"}} (om/build bs/alert (:alert data))]]
              ;; Username
              [:div
-              [:div.col-md-4
-               (om/build (username-selection-form data) (:user data))]
+              [:div.col-md-6
+               (om/build username-selection-form (:user data) {:init-state {:event-chan event-chan}})]
               (when (seq username)
-                [:button.btn.btn-primary {:on-click #(post-form data username @selected)} "Save"])]
-             ;; Alert
-             [:div {:style {:padding-top "10px"}} (om/build bs/alert (:alert data))]
+                [:button.btn.btn-success {:on-click #(post-form data username @selected)} "Save"])]
+
              ;; Admin Role - only visible to super admins
              (when (and (= "super-admin" (:role editor)) (not (nil? role)))
-               [:div.form-group.col-md-6
+               [:div.form-group.col-md-6 {:style {:padding-top "10px"}}
                 [:label.control-label.col-md-2 {:for "role-selection"} "Role:"]
                 [:div.col-md-6
                  [:div {:style {:width "100%"}}
                   (om/build dropdown {:default role
                                       :items user-roles}
-                            {:opts {:dropdown-chan dropdown-chan
+                            {:opts {:event-chan event-chan
                                     :id "role-selection"
                                     :path [:role]}})]]])
+             ;; Show which user is being edited
+             (when (seq username)
+               [:div.col-md-12 [:h4 "Editing: "] username])

              ;; Programmes
              [:div.col-md-12 {:style {:padding-top "15px"}}
               [:h4 "All Programmes"]
               (om/build programmes-table {:programmes (-> data :programmes :data)
                                           :existing-selections (-> data :user :programmes)}
-                        {:opts {:dropdown-chan dropdown-chan}})]
+                        {:opts {:event-chan event-chan}})]
              ;; Projects
              [:div.col-md-12
               [:h4 "All Projects"]
               (om/build projects-table {:projects (-> data :projects :data)
                                         :existing-selections (-> data :user :projects)}
-                        {:opts {:dropdown-chan dropdown-chan}})]]
+                        {:opts {:event-chan event-chan}})]]

             [:div.col-md-12
              [:div.col-md-12 [:div.alert.alert-success {:role "alert"} "User updated successfully."]


Remove unused function

Remove unused function

--- src/clj/back_channeling/endpoint/api.clj
+++ src/clj/back_channeling/endpoint/api.clj
@@ -452,13 +452,6 @@
    :handle-created (fn [ctx]
                      {:comment/content (str thread-id "/" (::filename ctx))})))

-(defn users-resource [{:keys [socketapp]} path]
-  (liberator/resource
-   :available-media-types ["application/edn" "application/json"]
-   :allowed-methods [:get]
-   :handle-ok (fn [_]
-                (vec (find-users socketapp)))))
-
 (defn find-article-by-name [datomic article-name]
   (d/query
    datomic


much faster with an array

much faster with an array

--- src/cljs/infinitelives/pixi/tilemap.cljs
+++ src/cljs/infinitelives/pixi/tilemap.cljs
@@ -25,16 +25,20 @@
                          tile-map
                          & {:keys [xoffset yoffset] :or {xoffset 0 yoffset 0}}
                          ]
-  (into
-   {}
-   (filter identity
-           (for [row (range (count tile-map))
-                 col (range (count (first tile-map)))]
-             (let [char (nth (tile-map row) col)]
-               (when char [[(+ xoffset col) (+ yoffset row)]
-                           (s/make-sprite (texture-map char)
-                                          :x (* tile-width (+ xoffset col)) :y (* tile-height (+ yoffset row))
-                                          :xhandle 0 :yhandle 0)]))))))
+  (let [tmarray (to-array-2d tile-map)]
+    (into
+     {}
+     (filter identity
+             (for [row (range (count tile-map))
+                   col (range (count (first tile-map)))]
+               (let [char
+                     (aget tmarray row col)
+                     ;(nth (tile-map row) col)
+                     ]
+                 (when char [[(+ xoffset col) (+ yoffset row)]
+                             (s/make-sprite (texture-map char)
+                                            :x (* tile-width (+ xoffset col)) :y (* tile-height (+ yoffset row))
+                                            :xhandle 0 :yhandle 0)])))))))

 (defn make-tile-map [tile-mapping tile-map-chars & {:keys [xoffset yoffset] :or {xoffset 0 yoffset 0}}]
   (let [orig


All genetic operator rates/deviations can now be collections.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -143,7 +143,8 @@
    mutated it will be replaced with a random instruction."
   [ind {:keys [uniform-mutation-rate maintain-ancestors atom-generators]
         :as argmap}]
-  (let [instruction-mutator (fn [token]
+  (let [uniform-mutation-rate (number uniform-mutation-rate)
+        instruction-mutator (fn [token]
                               (assoc token
                                 :instruction
                                 (:instruction (first (random-plush-genome 1 atom-generators argmap)))))
@@ -167,7 +168,13 @@
   [ind {:keys [uniform-mutation-constant-tweak-rate uniform-mutation-int-gaussian-standard-deviation
                maintain-ancestors atom-generators]
         :as argmap}]
-  (let [constant-mutator (fn [token]
+  (let [uniform-mutation-constant-tweak-rate
+        (number uniform-mutation-constant-tweak-rate)
+
+        uniform-mutation-int-gaussian-standard-deviation
+        (number uniform-mutation-int-gaussian-standard-deviation)
+
+        constant-mutator (fn [token]
                            (let [const (:instruction token)]
                              (if (integer? const)
                                (assoc token
@@ -192,10 +199,17 @@
 (defn uniform-float-mutation
   "Uniformly mutates individual. For each float in the genome, there is
    uniform-mutation-constant-tweak-rate probability of being mutated."
-  [ind {:keys [uniform-mutation-constant-tweak-rate uniform-mutation-float-gaussian-standard-deviation
+  [ind {:keys [uniform-mutation-constant-tweak-rate
+               uniform-mutation-float-gaussian-standard-deviation
                maintain-ancestors atom-generators]
         :as argmap}]
-  (let [constant-mutator (fn [token]
+  (let [uniform-mutation-constant-tweak-rate
+        (number uniform-mutation-constant-tweak-rate)
+
+        uniform-mutation-float-gaussian-standard-deviation
+        (number uniform-mutation-float-gaussian-standard-deviation)
+
+        constant-mutator (fn [token]
                            (let [const (:instruction token)]
                              (if (float? const)
                                (assoc token
@@ -223,10 +237,17 @@
   [ind {:keys [uniform-mutation-rate uniform-mutation-tag-gaussian-standard-deviation
                maintain-ancestors atom-generators]
         :as argmap}]
-  (let [constant-mutator (fn [token]
+  (let [uniform-mutation-rate
+        (number uniform-mutation-rate)
+
+        uniform-mutation-tag-gaussian-standard-deviation
+        (number uniform-mutation-tag-gaussian-standard-deviation)
+
+        constant-mutator (fn [token]
                            (let [const (:instruction token)]
                              (if (tag-instruction? const)
-                               (tag-gaussian-tweak token uniform-mutation-tag-gaussian-standard-deviation)
+                               (tag-gaussian-tweak token
+                                                   uniform-mutation-tag-gaussian-standard-deviation)
                                token)))
         token-mutator (fn [token]
                         (if (< (lrand) uniform-mutation-rate)
@@ -248,7 +269,13 @@
   [ind {:keys [uniform-mutation-rate uniform-mutation-string-char-change-rate
                maintain-ancestors atom-generators]
         :as argmap}]
-  (let [string-tweak (fn [st]
+  (let [uniform-mutation-rate
+        (number uniform-mutation-rate)
+
+        uniform-mutation-string-char-change-rate
+        (number uniform-mutation-string-char-change-rate)
+
+        string-tweak (fn [st]
                        (apply str (map (fn [c]
                                          (if (< (lrand) uniform-mutation-string-char-change-rate)
                                            (lrand-nth (concat ["\n" "\t"]
@@ -280,7 +307,8 @@
   [ind {:keys [uniform-mutation-constant-tweak-rate
                maintain-ancestors atom-generators]
         :as argmap}]
-  (let [constant-mutator (fn [token]
+  (let [uniform-mutation-constant-tweak-rate (number uniform-mutation-constant-tweak-rate)
+        constant-mutator (fn [token]
                            (let [const (:instruction token)]
                              (if (or (= const true) (= const false))
                                (assoc token :instruction (not const))
@@ -308,11 +336,13 @@
                epigenetic-markers maintain-ancestors]}]
   (if (not (some #{:close} epigenetic-markers))
     ind
-    (let [close-mutator (fn [instr-map]
+    (let [uniform-close-mutation-rate (number uniform-close-mutation-rate)
+          close-increment-rate (number close-increment-rate)
+          close-mutator (fn [instr-map]
                           (let [closes (get instr-map :close 0)]
                             (assoc instr-map :close
                               (if (< (lrand) uniform-close-mutation-rate)
-                                (if (< (lrand) close-increment-rate)
+                                (if (< (lrand) close-increment-rate)
                                   ;Rate at which to increase closes instead of decrease
                                   (inc closes)
                                   (if (<= closes 0)
@@ -336,7 +366,8 @@
                epigenetic-markers maintain-ancestors]}]
   (if (not (some #{:silent} epigenetic-markers))
     ind
-    (let [silent-mutator (fn [instr-map]
+    (let [uniform-silence-mutation-rate (number uniform-silence-mutation-rate)
+          silent-mutator (fn [instr-map]
                            (let [silent (get instr-map :silent false)]
                              (assoc instr-map :silent
                                     (if (< (lrand) uniform-silence-mutation-rate)
@@ -356,9 +387,7 @@
   "Returns the individual with each element of its genome possibly deleted, with probability
 given by uniform-deletion-rate."
   [ind {:keys [uniform-deletion-rate maintain-ancestors]}]
-  (let [rate (if (number? uniform-deletion-rate)
-               uniform-deletion-rate
-               (lrand-nth uniform-deletion-rate))
+  (let [rate (number uniform-deletion-rate)
         new-genome (vec (filter identity
                                 (map #(if (< (lrand) rate) nil %)
                                      (:genome ind))))]
@@ -375,9 +404,7 @@
   "Returns the individual with each element of its genome possibly preceded or followed by
   a new gene, with probability given by uniform-addition-rate."
   [ind {:keys [uniform-addition-rate maintain-ancestors atom-generators] :as argmap}]
-  (let [rate (if (number? uniform-addition-rate)
-               uniform-addition-rate
-               (lrand-nth uniform-addition-rate))
+  (let [rate (number uniform-addition-rate)
         new-genome (vec (apply concat
                                (map #(if (< (lrand) rate)
                                       (lshuffle [%
@@ -401,9 +428,7 @@
   uniform-addition-and-deletion-rate."
   [ind {:keys [uniform-addition-and-deletion-rate maintain-ancestors atom-generators]
         :as argmap}]
-  (let [addition-rate (if (number? uniform-addition-and-deletion-rate)
-                        uniform-addition-and-deletion-rate
-                        (lrand-nth uniform-addition-and-deletion-rate))
+  (let [addition-rate (number uniform-addition-and-deletion-rate)
         deletion-rate (/ 1 (+ (/ 1 addition-rate) 1))
         after-addition (vec (apply concat
                                    (map #(if (< (lrand) addition-rate)
@@ -433,9 +458,7 @@
   [parent1 parent2
    {:keys [uniform-combination-and-deletion-rate maintain-ancestors atom-generators]
     :as argmap}]
-  (let [combination-rate (if (number? uniform-combination-and-deletion-rate)
-                        uniform-combination-and-deletion-rate
-                        (lrand-nth uniform-combination-and-deletion-rate))
+  (let [combination-rate (number uniform-combination-and-deletion-rate)
         deletion-rate (/ 1 (+ (/ 1 combination-rate) 1))
         after-combination (vec
                             (apply concat
@@ -462,7 +485,9 @@
    used in ULTRA."
   [parent1 parent2 {:keys [alternation-rate alignment-deviation
                            max-points maintain-ancestors] :as argmap}]
-  (let [s1 (:genome parent1)
+  (let [alternation-rate (number alternation-rate)
+        alignment-deviation (number alignment-deviation)
+        s1 (:genome parent1)
         s2 (:genome parent2)
         new-genome (loop [i 0
                           use-s1 (lrand-nth [true false])


Refactored test.

Refactored test.

--- test/cmr/system_int_test/search/collection_search_format_test.clj
+++ test/cmr/system_int_test/search/collection_search_format_test.clj
@@ -44,7 +44,13 @@
                                                  :entry-title "ET4"
                                                  :long-name "ET4"})
                          :dif)
-        all-colls [c1-echo c2-echo c3-dif c4-dif]]
+        c5-iso (d/ingest "PROV1" (dc/collection {:short-name "S5"
+                                                :version-id "V5"})
+                        :iso)
+        c6-iso (d/ingest "PROV2" (dc/collection {:short-name "S6"
+                                                :version-id "V6"})
+                        :iso-mends)
+        all-colls [c1-echo c2-echo c3-dif c4-dif c5-iso c6-iso]]
     (index/refresh-elastic-index)

     (testing "Finding refs ingested in different formats"
@@ -53,7 +59,11 @@
            {} all-colls
            {:short-name "S4"} [c4-dif]
            {:entry-title "ET3"} [c3-dif]
-           {:version ["V3" "V2"]} [c2-echo c3-dif]))
+           {:version ["V3" "V2"]} [c2-echo c3-dif]
+           {:short-name "S5"} [c5-iso]
+           {:short-name "S6"} [c6-iso]
+           {:version "V5"} [c5-iso]
+           {:version ["V5" "V6"]} [c5-iso c6-iso]))

     (testing "Retrieving results in echo10"
       (d/assert-metadata-results-match
@@ -183,24 +193,6 @@
            [-180 90 180 -90] [g2]
            [0 90 180 -90] []
            [-180 90 0 -90] [g2]))))
-
-(deftest iso-ingest
-  (let [coll1 (d/ingest "PROV1" (dc/collection {:short-name "S1"
-                                                :version-id "V1"})
-                        :iso)
-        coll2 (d/ingest "PROV2" (dc/collection {:short-name "S2"
-                                                :version-id "V2"})
-                        :iso-mends)]
-    (index/refresh-elastic-index)
-
-    (testing "Finding refs ingested in different formats"
-      (are [search expected]
-           (d/refs-match? expected (search/find-refs :collection search))
-           {} [coll1 coll2]
-           {:short-name "S1"} [coll1]
-           {:short-name "S2"} [coll2]
-           {:version "V1"} [coll1]
-           {:version ["V1" "V2"]} [coll1 coll2]))))

 (deftest search-collection-atom-and-json
   (let [ru1 (dc/related-url "GET DATA" "http://example.com")


Build map of linkable grid controllers.

Build map of linkable grid controllers.

--- src/afterglow/web/routes/show_control.clj
+++ src/afterglow/web/routes/show_control.clj
@@ -12,7 +12,7 @@
             [ring.util.response :refer [response]]
             [ring.util.http-response :refer [ok]]
             [ring.middleware.anti-forgery :refer [*anti-forgery-token*]]
-            [taoensso.timbre :refer [info warn]]))
+            [taoensso.timbre :refer [info warn spy]]))

 (defn- current-cue-color
   "Given a show, the set of keys identifying effects that are
@@ -72,13 +72,40 @@
   [page-id grid left bottom width height]
   (swap! clients update-in [page-id] assoc :view [left bottom width height] :grid grid :when (now)))

-(defn show-page [id]
+(defn update-known-controllers
+  "Builds a list of the currently-registered physical grid controllers
+  associated with a page's show, assigning each a unique id number, so
+  they can be selected in the user interface for scrolling or linking
+  to."
+  [page-id]
+  (let [page-info (get @clients page-id)
+        show (:show page-info)
+        controller-info (loop [result (update-in (:controller-info page-info) [:known]
+                                                 select-keys @(:grid-controllers show))
+                               new-controllers (clojure.set/difference @(:grid-controllers show)
+                                                                       (set (keys (:known result))))
+                               counter (inc (:counter result 0))]
+                          (if-not (seq new-controllers)
+                            result
+                            (recur (-> result
+                                       (assoc-in [:known (first new-controllers)] counter)
+                                       (assoc-in [:counter] counter))
+                                   (rest new-controllers)
+                                   (inc counter))))]
+    (swap! clients assoc-in [page-id :controller-info]
+           (if (and (:selected controller-info) (not  (get (:known controller-info) (:selected controller-info))))
+             (dissoc controller-info :selected)
+             controller-info))))
+
+(defn show-page
   "Renders the web interface for interacting with the specified show."
-  (let [[show description] (get @show/shows (Integer/valueOf id))
+  [show-id]
+  (let [[show description] (get @show/shows (Integer/valueOf show-id))
         grid (cue-view show 0 0 8 8)
         page-id (:counter (swap! clients update-in [:counter] inc))]
     (swap! clients update-in [page-id] assoc :show show :id page-id)
     (record-page-grid page-id grid 0 0 8 8)
+    (update-known-controllers page-id)
     (layout/render "show.html" {:show show :title description :grid grid :page-id page-id
                                 :csrf-token *anti-forgery-token*})))

@@ -247,7 +274,7 @@
     (swap! clients update-in [page-id] dissoc :move-handler :linked-controller)))

 ;; TODO: Reload the window with the right number of rows and columns if the
-;; physical controller has a different number.
+;; physical controller has a different number?
 (defn link-controller
   "Tie the cue grid display to that of a physical grid controller, so
   that they scroll in tandem."


Make components for route and trip panels

--- src/cljs/gtfve/components/side_panel.cljs
+++ src/cljs/gtfve/components/side_panel.cljs
@@ -56,6 +56,26 @@
                      data))
           ])))))

+(defn route-panel [{:keys [panel data]} owner]
+  (reify
+    om/IDisplayName (display-name [_] "Routes Panel")
+    om/IRender
+    (render [_]
+      (let [tab (:tab panel)]
+        (html
+         [:div {:className (tab-class tab :routes)}
+          [:p "Routes Panel"]])))))
+
+(defn trip-panel [{:keys [panel data]} owner]
+  (reify
+    om/IDisplayName (display-name [_] "Trips Panel")
+    om/IRender
+    (render [_]
+      (let [tab (:tab panel)]
+        (html
+         [:div {:className (tab-class tab :trips)}
+          [:p "Trips Panel"]])))))
+
 (defn side-panel [{:keys [panel data]} owner]
   (reify
     om/IDisplayName (display-name [_] "Side Panel")
@@ -75,11 +95,8 @@
                                           :tab tab})]
                [:div.tab-content
                 ;; stops
-                [:div.tab-wrapper
-                 (om/build stop-panel {:panel panel :data (:stops data)})
-                 ;; routes
-                 [:div {:className (tab-class tab :routes)}
-                  [:p "Routes panel"]]
-                 ;; trips
-                 [:div {:className (tab-class tab :trips)}
-                  [:p "Trips panel"]]]]])))))
+                (om/build stop-panel {:panel panel :data (:stops data)})
+                ;; routes
+                (om/build route-panel {:panel panel :data (:routes data)})
+                ;; trips
+                (om/build trip-panel {:panel panel :data (:trips data)})]])))))


debugger: only scroll if scroll position is at the bottom

--- examples/_common/middleware/devtools.cljs
+++ examples/_common/middleware/devtools.cljs
@@ -437,15 +437,23 @@
                                                                          :handles "n, e, s, w, ne, se, sw, nw"})))}))

 (defn -autoscrollable-div
-  "Will scroll to bottom on any update."
+  "Will scroll to bottom on any update. Will not scroll if scroll position is not at the bottom."
   [_attrs & _body]
-  (letfn [(scroll [this]
-            (set! (.-scrollTop (r/dom-node this))
-                  (.-scrollHeight (r/dom-node this))))]
-    (r/create-class {:reagent-render       (fn [attrs & body]
-                                             (into [:div attrs] body))
-                     :component-did-mount  scroll
-                     :component-did-update scroll})))
+  (let [autoscroll? (atom true)
+        update-autoscroll (fn [this]
+                            (let [node (r/dom-node this)]
+                              ; expression value can be negative in Safari
+                              (reset! autoscroll? (<= (- (.-scrollHeight node)
+                                                         (+ (.-scrollTop node) (.-offsetHeight node)))
+                                                      0))))
+        scroll (fn [this]
+                 (when @autoscroll?
+                   (set! (.-scrollTop (r/dom-node this))
+                         (.-scrollHeight (r/dom-node this)))))]
+    (r/create-class {:reagent-render               (fn [attrs & body] (into [:div attrs] body))
+                     :component-will-receive-props update-autoscroll
+                     :component-did-mount          scroll
+                     :component-did-update         scroll})))

 (defn -overlay
   [& body]


Cosmetics.

Cosmetics.

--- src/midje/parsing/util/file_position.clj
+++ src/midje/parsing/util/file_position.clj
@@ -11,8 +11,10 @@

 (def ^:private fallback-line-number (atom (Integer. 0)))

+
 (defn set-fallback-line-number-from [form]
   (reset! fallback-line-number (or (:line (meta form)) (Integer. 0))))
+

 (defn arrow-line-number
   "Return the best guess for what line an arrow symbol is on."
@@ -35,24 +37,26 @@
       (reset! fallback-line-number lineish)
       (swap! fallback-line-number inc))))

+
 (defn arrow-line-number-from-form
   "Form is of the form [ <function-call> => .* ]"
   [form]
   (-> form zip/seq-zip zip/down zip/right arrow-line-number))

-
 (defn- basename [string]
   (last (str/split string #"/")))

-;; clojure.test sometimes runs with *file* bound to #"NO_SOURCE.*".
-;; This corrects that by looking up the stack. Note that it
-;; produces a reasonable result for the repl, because the stack
-;; frame it finds has NO_SOURCE_FILE as its "filename".
+
 (defn current-file-name []
+  ;; clojure.test sometimes runs with *file* bound to #"NO_SOURCE.*".
+  ;; This corrects that by looking up the stack. Note that it
+  ;; produces a reasonable result for the repl, because the stack
+  ;; frame it finds has NO_SOURCE_FILE as its "filename".
   (if-not (re-find #"NO_SOURCE" *file*)
     (basename *file*)
     (.getFileName (second (.getStackTrace (Throwable.))))))
+

 (defn form-position [form]
   (list (current-file-name)  (:line (meta form))))


Removed copy of lazy-xml

Removed copy of lazy-xml

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

--- src/main/clojure/conexp/util/lazy_xml.clj
+++ src/main/clojure/conexp/util/lazy_xml.clj
@@ -1,197 +0,0 @@
-;; Copyright (c) Chris Houser, Dec 2008. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-;; Functions to parse xml lazily and emit back to text.
-
-;; TODO: remove; only used in context io
-
-(ns
-    #^{:author "Chris Houser",
-       :doc "Functions to parse xml lazily and emit back to text."}
-  conexp.util.lazy-xml
-  (:use [clojure.xml :as xml :only []])
-  (:import (org.xml.sax Attributes InputSource)
-           (org.xml.sax.helpers DefaultHandler)
-           (javax.xml.parsers SAXParserFactory)
-           (java.util.concurrent LinkedBlockingQueue TimeUnit)
-           (java.lang.ref WeakReference)
-           (java.io Reader)))
-
-(defn fill-queue
-  "filler-func will be called in another thread with a single arg
-'fill'. filler-func may call fill repeatedly with one arg each
-time which will be pushed onto a queue, blocking if needed until
-this is possible. fill-queue will return a lazy seq of the values
-filler-func has pushed onto the queue, blocking if needed until each
-next element becomes available. filler-func's return value is ignored."
-  ([filler-func & optseq]
-     (let [opts (apply array-map optseq)
-           apoll (:alive-poll opts 1)
-           q (LinkedBlockingQueue. (:queue-size opts 1))
-           NIL (Object.) ;nil sentinel since LBQ doesn't support nils
-           weak-target (Object.)
-           alive? (WeakReference. weak-target)
-           fill (fn fill [x]
-                  (if (.get alive?)
-                    (if (.offer q (if (nil? x) NIL x) apoll TimeUnit/SECONDS)
-                      x
-                      (recur x))
-                    (throw (Exception. "abandoned"))))
-           f (future
-               (try
-                 (filler-func fill)
-                 (finally
-                  (.put q q))) ;q itself is eos sentinel
-               nil)] ; set future's value to nil
-       ((fn drain []
-          weak-target ; force closing over this object
-          (lazy-seq
-           (let [x (.take q)]
-             (if (identical? x q)
-               @f ;will be nil, touch just to propagate errors
-               (cons (if (identical? x NIL) nil x)
-                     (drain))))))))))
-
-(defstruct node :type :name :attrs :str)
-
-(defn startparse-sax [s ch]
-  (.. SAXParserFactory newInstance newSAXParser (parse s ch)))
-
-(defn parse-seq
-  "Parses the source s, which can be a File, InputStream or String
-naming a URI. Returns a lazy sequence of maps with two or more of
-the keys :type, :name, :attrs, and :str. Other SAX-compatible
-parsers can be supplied by passing startparse, a fn taking a source
-and a ContentHandler and returning a parser. If a parser is
-specified, it will be run in a separate thread and be allowed to get
-ahead by queue-size items, which defaults to maxint. If no parser
-is specified and org.xmlpull.v1.XmlPullParser is in the classpath,
-this superior pull parser will be used."
-  ([s] (parse-seq s startparse-sax))
-  ([s startparse] (parse-seq s startparse Integer/MAX_VALUE))
-  ([s startparse queue-size]
-     (let [s (if (instance? Reader s) (InputSource. s) s)
-           f (fn filler-func [fill]
-               (startparse s (proxy [DefaultHandler] []
-                               (startElement [uri local-name q-name #^Attributes atts]
-                                 ;;(prn :start-element q-name)(flush)
-                                 (let [attrs (into {} (for [i (range (.getLength atts))]
-                                                        [(keyword (.getQName atts i))
-                                                         (.getValue atts i)]))]
-                                   (fill (struct node :start-element (keyword q-name) attrs))))
-                               (endElement [uri local-name q-name]
-                                        ;(prn :end-element q-name)(flush)
-                                 (fill (struct node :end-element (keyword q-name))))
-                               (characters [ch start length]
-                                        ;(prn :characters)(flush)
-                                 (let [st (String. ch start length)]
-                                   (when (seq (.trim st))
-                                     (fill (struct node :characters nil nil st))))))))]
-       (fill-queue f :queue-size queue-size))))
-
-
-(defstruct element :tag :attrs :content)
-(declare mktree)
-
-(defn- siblings [coll]
-  (lazy-seq
-   (when-let [s (seq coll)]
-     (let [event (first s)]
-       (condp = (:type event)
-         :characters (cons (:str event) (siblings (rest s)))
-         :start-element (let [t (mktree s)]
-                          (cons (first t) (siblings (rest t))))
-         :end-element [(rest s)])))))
-
-(defn- mktree
-  [[elem & events]]
-  (lazy-seq
-   (let [sibs (siblings events)]
-     ;;(prn :elem elem)
-     (cons
-      (struct element (:name elem) (:attrs elem) (drop-last sibs))
-      (lazy-seq (last sibs))))))
-
-(defn parse-trim
-  "Parses the source s, which can be a File, InputStream or String
-naming a URI. Returns a lazy tree of the clojure.xml/element
-struct-map, which has the keys :tag, :attrs, and :content and
-accessor fns tag, attrs, and content, with the whitespace trimmed
-from around each content string. This format is compatible with what
-clojure.xml/parse produces, except :content is a lazy seq instead of
-a vector. Other SAX-compatible parsers can be supplied by passing
-startparse, a fn taking a source and a ContentHandler and returning
-a parser. If a parser is specified, it will be run in a separate
-thread and be allowed to get ahead by queue-size items, which
-defaults to maxing. If no parser is specified and
-org.xmlpull.v1.XmlPullParser is in the classpath, this superior pull
-parser will be used."
-  ([s] (first (mktree (parse-seq s))))
-  ([s startparse queue-size]
-     (first (mktree (parse-seq s startparse queue-size)))))
-
-(defn attributes [e]
-  (let [v (vec (:attrs e))]
-    (reify org.xml.sax.Attributes
-      (getLength [_] (count v))
-      (getURI [_ i] (namespace (key (v i))))
-      (getLocalName [_ i] (name (key (v i))))
-      (getQName [_ i] (name (key (v i))))
-      (getValue [_ uri name] (get (:attrs e) name))
-      (#^String getValue [_ #^int i] (val (v i)))
-      (#^String getType [_ #^int i] "CDATA"))))
-
-(defn- emit-element
-  "Recursively prints as XML text the element struct e. To have it
-print extra whitespace like clojure.xml/emit, use the :pad true
-option."
-  [e #^org.xml.sax.ContentHandler ch]
-  (if (instance? String e)
-    (.characters ch (.toCharArray #^String e) 0 (count e))
-    (let [nspace (namespace (:tag e))
-          qname (name (:tag e))]
-      (.startElement ch (or nspace "") qname qname (attributes e))
-      (doseq [c (:content e)]
-        (emit-element c ch))
-      (.endElement ch (or nspace "") qname qname))))
-
-(defn emit
-  [e & {:as opts}]
-  (let [content-handler (atom nil)
-        trans (-> (javax.xml.transform.TransformerFactory/newInstance)
-                  .newTransformer)]
-
-    (when (:indent opts)
-      (.setOutputProperty trans "indent" "yes")
-      (.setOutputProperty trans "{http://xml.apache.org/xslt}indent-amount"
-                          (str (:indent opts))))
-
-    (when (contains? opts :xml-declaration)
-      (.setOutputProperty trans "omit-xml-declaration"
-                          (if (:xml-declaration opts) "no" "yes")))
-
-    (when (:encoding opts)
-      (.setOutputProperty trans "encoding" (:encoding opts)))
-
-    (.transform
-     trans
-     (javax.xml.transform.sax.SAXSource.
-      (reify org.xml.sax.XMLReader
-        (getContentHandler [_] @content-handler)
-        (setDTDHandler [_ handler])
-        (setFeature [_ name value])
-        (setProperty [_ name value])
-        (setContentHandler [_ ch] (reset! content-handler ch))
-        (#^void parse [_ #^org.xml.sax.InputSource _]
-          (when @content-handler
-            (.startDocument @content-handler)
-            (emit-element e @content-handler)
-            (.endDocument @content-handler))))
-      (org.xml.sax.InputSource.))
-     (javax.xml.transform.stream.StreamResult. *out*))))
-


vncreatures

vncreatures

--- crawler/vncreatures.clj
+++ crawler/vncreatures.clj
@@ -22,17 +22,33 @@
                         (str/starts-with? vn-name "Bướm"))))
          (map (fn [[[id vn-name] [_ latin-name]]]
                 (let [[genus species] (str/split latin-name #"\s+")]
-                  [id vn-name (str/lower-case genus) (str/lower-case species)]))))))
-
-(def n (atom 0))
+                  [id vn-name genus species]))))))

 (defn save-data []
-  (doseq [[id vn-name genus species] (mapcat butterflies (range 1 7))]
-    (.mkdir (io/file (str "../data/" genus)))
-    (save-image (str base-url "/pictures/insect/" id "s.jpg") (str "../data/" genus "/" species "_vn_" (swap! n inc)))
-    (save-image (str base-url "/pictures/insect/" id "_1s.jpg") (str "../data/" genus "/" species "_vn_" (swap! n inc)))
-    (save-image (str base-url "/pictures/insect/" id "_2s.jpg") (str "../data/" genus "/" species "_vn_" (swap! n inc)))
-    (save-image (str base-url "/pictures/insect/" id "_3s.jpg") (str "../data/" genus "/" species "_vn_" (swap! n inc)))))
+  (doseq [[id _ genus species] (mapcat butterflies (range 1 7))]
+    (let [dir (str "../data-vncreatures/" genus "-" species)]
+      (println dir)
+      (.mkdir (io/file dir))
+      (try
+        (save-image
+         (str base-url "/pictures/insect/" id "s.jpg")
+         (str dir "/vncreatures_" id "s.jpg"))
+        (catch Exception _))
+      (try
+        (save-image
+         (str base-url "/pictures/insect/" id "_1s.jpg")
+         (str dir "/vncreatures_" id "_1s.jpg"))
+        (catch Exception _))
+      (try
+        (save-image
+         (str base-url "/pictures/insect/" id "_2s.jpg")
+         (str dir "/vncreatures_" id "_2s.jpg"))
+        (catch Exception _))
+      (try
+        (save-image
+         (str base-url "/pictures/insect/" id "_3s.jpg")
+         (str dir "/vncreatures_" id "_3s.jpg"))
+        (catch Exception _)))))

 (defn insert-db []
   (doseq [[id vn-name genus species] (mapcat butterflies (range 1 7))]


Fix typo.

Fix typo.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -149,7 +149,7 @@
         board-slug (:slug board)
         board-access (:access board)
         draft? (= :draft (keyword (:status entry)))
-        entry-with-comments (merge entry :interactions comments)
+        entry-with-comments (assoc entry :interactions comments)
         full-entry (merge {:board-slug board-slug
                            :board-access board-access
                            :board-name (:name board)


tolerate hills

tolerate hills

--- src-cljs/flatride/core.cljs
+++ src-cljs/flatride/core.cljs
@@ -28,7 +28,7 @@
   (filter #(> (count %) 1)
           (reductions
             (fn [current-seq next-elem]
-              (if (>= (:altitude next-elem) (:altitude (last current-seq)))
+              (if (>= (+ (:altitude next-elem) 10) (:altitude (last current-seq)))
                 (conj current-seq next-elem)
                 [next-elem]))
             [(first coll)]
@@ -58,7 +58,7 @@

 (defn start-compute-elevation-data [route idx display-elev-fn]
   (let [es (window/google.maps.ElevationService.)
-        path-req (js-obj "path" (.-overview_path route) "samples" 100)]
+        path-req (js-obj "path" (.-overview_path route) "samples" 300)]
     (.getElevationAlongPath es
                             path-req
                             (partial process-elevation-data display-elev-fn idx))))


Highlight specific ugen causing error in checking with ==> Fixes #181.

--- src/overtone/sc/machinery/ugen/specs.clj
+++ src/overtone/sc/machinery/ugen/specs.clj
@@ -145,9 +145,9 @@
                  (fun rate num-outs args ugen spec))]

     (when (string? result)
-      (let [error-message (str "Error in checker for ugen "
+      (let [error-message (str "Error in checker for ugen ==> "
                                (overtone-ugen-name (:name spec))
-                               ":\n"
+                               "\n"
                                result
                                "\n"
                                (ugen-arg-info spec ugen)


Fix bug in editing/deleting posts

Fix bug in editing/deleting posts

--- android/src/clojure/net/nightweb/dialogs.clj
+++ android/src/clojure/net/nightweb/dialogs.clj
@@ -260,7 +260,8 @@

 (defn show-edit-post-dialog
   [context content]
-  (let [pics (db/get-pic-data content (:time content) false)]
+  (let [post (:post content)
+        pics (db/get-pic-data post (:time post) false)]
     (show-dialog context
                  nil
                  (views-dialog/get-new-post-view context content)
@@ -270,7 +271,7 @@
                     (actions/new-post context
                                       dialog-view
                                       button-view
-                                      (:time content)
+                                      (:time post)
                                       (for [pic pics] (:pichash pic))
                                       1))
                   :neutral-name (r/get-string :delete)
@@ -279,7 +280,7 @@
                     (show-delete-post-dialog context
                                              dialog-view
                                              button-view
-                                             (:time content)))
+                                             (:time post)))
                   :negative-name (r/get-string :cancel)
                   :negative-func actions/cancel})))


Improve comments.

Improve comments.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -293,7 +293,6 @@
         board-pin-link (when-not draft?
                          (pin-link "board-pin" org-slug board-slug entry-uuid board-uuid))
         entry-author? (= user-id (:user-id (first (:author entry))))
-        entry-publisher? (= user-id (-> entry :publisher :user-id))
         links (cond-> []
                ;; secure UUID access
                secure-access?
@@ -316,15 +315,15 @@
                     member?)
                (concat [home-pin-link board-pin-link])
                ;; Edit/delete can be done by:
-               ;; - admin/authors if the post is published
-               ;; - only the author if he has still author access to the board
+               ;; - admins/contribs of the post's board if it's published
+               ;; - only the author if he's an author of the post's board if it's a draft
                ;; In case the user was removed from the board they can still see the draft and copy the content
                ;; no edit/publish/delete though
                (and (not secure-access?)
                     (or (and (not draft?)
                              (= role :admin))
                         (= access-level :author) ;; Author access is already filtered based on post state: draft only the real author, published all authors
-                        entry-author?))
+                        entry-author?)) ;; Entry author has always access (board access is enforced before so we don't need to check if he's got access)
                (concat [(partial-update-link org-slug board-slug entry-uuid)
                         (delete-link org-slug board-slug entry-uuid)
                         (revert-link org-slug board-slug entry-uuid)])


:nail_care:

--- test/com/wsscode/pathom/parser_test.clj
+++ test/com/wsscode/pathom/parser_test.clj
@@ -365,13 +365,3 @@
             {:com.wsscode.pathom.core/path       []
              :com.wsscode.pathom.trace/direction :com.wsscode.pathom.trace/leave
              :com.wsscode.pathom.trace/event     :com.wsscode.pathom.parser/parse-loop}]))))
-
-(comment
-  (doseq [n [[1 2] [3 4 5] nil [4 5]]
-          m n]
-    (println n m))
-
-  (time
-    (let [parser (p/parallel-parser {::p/env {::p/reader [p/map-reader
-                                                          preader]}})]
-      (async/<!! (parser {} [:a :b {:c [:a]} :z :y])))))


Script to grab standings for a date range in fig 5-8

--- src/vdquil/chapter5/ch5preprocessing.clj
+++ src/vdquil/chapter5/ch5preprocessing.clj
@@ -3,9 +3,12 @@
 ;; Converted from Processing to Clojure as an exercise by Dave Liepmann

 (ns vdquil.chapter5.preprocessing
-  (:use vdquil.chapter5.ch5data))
+  (:use vdquil.chapter5.ch5data)
+  (:require [clj-time.core :as time]))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Get logos from MLB site
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defn copy-image [uri file]
   (with-open [in (clojure.java.io/input-stream uri)
               out (clojure.java.io/output-stream file)]
@@ -13,8 +16,8 @@

 (defn grab-logos
   [folder url-prefix file-suffix]
-  (let [uris (map #(str url-prefix % file-suffix) (map first teams))
-        files (map #(str folder % file-suffix) (map first teams))]
+  (let [uris (map #(str url-prefix % file-suffix) (map first mlb-teams))
+        files (map #(str folder % file-suffix) (map first mlb-teams))]
     (map copy-image uris files)))

 (grab-logos "resources/ch5/small/" "http://mlb.mlb.com/mlb/images/team_logos/logo_" "_small.gif")
@@ -22,3 +25,40 @@
 (grab-logos "resources/ch5/79x76/" "http://mlb.mlb.com/mlb/images/team_logos/logo_" "_79x76.jpg")
 (grab-logos "resources/ch5/standings/" "http://mlb.mlb.com/mlb/images/team_logos/51x21/" "_standings_logo.gif")
 (grab-logos "resources/ch5/100x100/" "http://mlb.mlb.com/mlb/images/team_logos/100x100/" ".gif")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Get standings across a date range for figure 5-8:
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn get-standings [startyear startmonth startday endyear endmonth endday]
+  (let [start     (time/date-time startyear startmonth startday)
+        end       (time/date-time endyear endmonth endday)
+        num-days  (time/in-days (time/interval start end))]
+    (for [day (map #(time/plus start (time/days %)) (range num-days))]
+      (->> (map #(into [] %)
+                (partition 4
+                           (map #(nth % 2)
+                                (filter #(#{"code" "w" "l" "league_sensitive_team_name"} (second %))
+                                        (re-seq #"\s+([\w\d]+):\s'(.*)',?"
+                                                (apply str
+                                                       (pmap #(slurp (str "http://mlb.mlb.com/components/game/year_"
+                                                                          (time/year day)
+                                                                          "/month_"
+                                                                          (format "%02d" (time/month day))
+                                                                          "/day_"
+                                                                          (format "%02d" (time/day day))
+                                                                          "/standings_rs_" % ".js"))
+                                                             ["alc" "ale" "alw" "nlc" "nle" "nlw"])))))))
+           (interpose \newline)
+           (apply str)
+           (spit (str "data/ch5fig8-"
+                      (format "%04d" (time/year day)) "-"
+                      (format "%02d" (time/month day)) "-"
+                      (format "%02d" (time/day day))
+                      ".txt"))))))
+
+;; Some examples:
+(get-standings 2007 4 15 2007 4 20) ;; take a few seconds
+(get-standings 2007 5 7 2007 5 12)
+(get-standings 2007 4 7 2007 5 12) ;; takes on the order of 10 seconds
+(get-standings 2007 5 7 2008 5 12) ;; takes several minutes


Fix errors.

Fix errors.

--- test/onyx/coordinator/simulant_test.clj
+++ test/onyx/coordinator/simulant_test.clj
@@ -90,10 +90,10 @@
   (let [model (-> test :model/_tests first)
         limit (:test/duration test)
         peers (:model/peek-peers model)
-        births (map (partial create-birth executor)
-                    (range 0 (* peers 1000) 1000))
-        deaths (map (partial create-death executor)
-                    (range (- limit (* peers 1000)) limit 1000))]
+        births (mapcat (partial create-birth executor)
+                       (range 0 (* peers 1000) 1000))
+        deaths (mapcat (partial create-death executor)
+                       (range (- limit (* peers 1000)) limit 1000))]
     (concat births deaths)))

 (defmethod sim/create-test :model.type/linear-cluster
@@ -222,6 +222,13 @@
                    :sim/systemURI (str "datomic:mem://" (d/squuid))
                    :sim/processCount 1}))

+(def linear-cluster-sim
+  (sim/create-sim sim-conn
+                  linear-cluster-test
+                  {:db/id (d/tempid :sim)
+                   :sim/systemURI (str "datomic:mem://" (d/squuid))
+                   :sim/processCount 1}))
+
 (sim/create-fixed-clock sim-conn fixed-cluster-sim {:clock/multiplier 1})

 (sim/create-fixed-clock sim-conn linear-cluster-sim {:clock/multiplier 1})


(maint) Fix `illegal reflective access` warnings

There is still at least one warning, caused by the `encoded-content-equal?`
util function, since it is called with arguments of various types.

--- test/puppetlabs/ssl_utils/testutils.clj
+++ test/puppetlabs/ssl_utils/testutils.clj
@@ -1,7 +1,7 @@
 (ns puppetlabs.ssl-utils.testutils
   (:import (java.io ByteArrayOutputStream ByteArrayInputStream)
            (java.security.cert X509Certificate)
-           (java.security MessageDigest)
+           (java.security MessageDigest PublicKey)
            (javax.security.auth.x500 X500Principal)
            (org.bouncycastle.asn1.x500 X500Name)
            (org.bouncycastle.pkcs PKCS10CertificationRequest)
@@ -19,7 +19,8 @@
   {:pre [(public-key? pub-key)]
    :post [(vector? %)
           (every? integer? %)]}
-  (let [bytes   (-> pub-key
+  (let [bytes   (-> ^PublicKey
+                    pub-key
                     .getEncoded
                     SubjectPublicKeyInfo/getInstance
                     .getPublicKeyData
@@ -47,7 +48,7 @@

 (defmethod has-subject? [X509Certificate String]
   [cert x500-name]
-  (= x500-name (-> cert .getSubjectX500Principal .getName)))
+  (= x500-name (-> ^X509Certificate cert .getSubjectX500Principal .getName)))

 (defmethod has-subject? [X509Certificate X500Name]
   [cert x500-name]


Dependency upgrades

Dependency upgrades

--- kuona-api/project.clj
+++ kuona-api/project.clj
@@ -20,15 +20,15 @@
                  [clj-time "0.15.1"]
                  [clojurewerkz/quartzite "2.1.0"]
                  [com.jcabi/jcabi-log "0.18"]
-                 [commons-codec/commons-codec "1.11"]
+                 [commons-codec/commons-codec "1.12"]
                  [compojure "1.6.1"]
                  [io.forward/yaml "1.0.9"]
                  [kuona/parsers "0.2"]
                  [org.clojure/data.xml "0.0.8"]
                  [org.clojure/data.zip "0.1.2"]
-                 [org.gradle/gradle-core "5.0"]
-                 [org.gradle/gradle-tooling-api "5.0"]
-                 [org.slf4j/slf4j-log4j12 "1.7.25"]
+                 [org.gradle/gradle-core "5.2.1"]
+                 [org.gradle/gradle-tooling-api "5.2.1"]
+                 [org.slf4j/slf4j-log4j12 "1.7.26"]
                  [ring/ring-defaults "0.3.2"]
                  [ring/ring-jetty-adapter "1.7.1"]
                  [ring/ring-json "0.4.0"]
@@ -46,5 +46,5 @@
          :auto-refresh true}
   :profiles {:dev     {:dependencies [[javax.servlet/servlet-api "2.5"]
                                       [ring/ring-mock "0.3.2"]
-                                      [midje "1.9.4"]]}
+                                      [midje "1.9.6"]]}
              :uberjar {:aot :all}})


adjust tests for changes to routing logic

--- test/clj_money/web/transactions_test.clj
+++ test/clj_money/web/transactions_test.clj
@@ -47,15 +47,15 @@
         [checking
          salary] (:accounts context)
         entity-id (-> context :entities first :id)
-        _ (transactions/create {:entity-id entity-id
-                                :transaction-date "3/2/2016"
-                                :description "Paycheck"
-                                :account-id-0 (str (:id checking))
-                                :debit-amount-0 "1000"
-                                :credit-amount-0 ""
-                                :account-id-1 (str (:id salary))
-                                :debit-amount-1 ""
-                                :credit-amount-1 "1000"})
+        _ (transactions/create {:params {:entity-id entity-id
+                                         :transaction-date "3/2/2016"
+                                         :description "Paycheck"
+                                         :account-id-0 (str (:id checking))
+                                         :debit-amount-0 "1000"
+                                         :credit-amount-0 ""
+                                         :account-id-1 (str (:id salary))
+                                         :debit-amount-1 ""
+                                         :credit-amount-1 "1000"}})
         actual (map simplify-transaction
                     (transm/select-by-entity-id storage-spec entity-id))
         expected [{:transaction-date (t/local-date 2016 3 2)
@@ -90,25 +90,25 @@
          salary
          bonus] (:accounts context)
         [trans] (:transactions context)
-        _ (transactions/update {:id (str (:id trans))
-                                :transaction-date "2016-01-02"
-                                :description "Employer"
-                                :id-0 (-> trans :items first :id str)
-                                :account-id-0 (str (:id checking))
-                                :credit-amount-0 ""
-                                :debit-amount-0 "1001"
-                                :id-1 (-> trans :items second :id str)
-                                :account-id-1 (str (:id salary))
-                                :credit-amount-1 "901"
-                                :debit-amount-1 ""
-                                :id-2 ""
-                                :account-id-2 (str (:id bonus))
-                                :credit-amount-2 "100"
-                                :debit-amount-2 ""
-                                :id-3 ""
-                                :account-id-3 ""
-                                :credit-amount-3 ""
-                                :debit-amount-3 ""})
+        _ (transactions/update {:params {:id (str (:id trans))
+                                         :transaction-date "2016-01-02"
+                                         :description "Employer"
+                                         :id-0 (-> trans :items first :id str)
+                                         :account-id-0 (str (:id checking))
+                                         :credit-amount-0 ""
+                                         :debit-amount-0 "1001"
+                                         :id-1 (-> trans :items second :id str)
+                                         :account-id-1 (str (:id salary))
+                                         :credit-amount-1 "901"
+                                         :debit-amount-1 ""
+                                         :id-2 ""
+                                         :account-id-2 (str (:id bonus))
+                                         :credit-amount-2 "100"
+                                         :debit-amount-2 ""
+                                         :id-3 ""
+                                         :account-id-3 ""
+                                         :credit-amount-3 ""
+                                         :debit-amount-3 ""}})
         actual (simplify-transaction (transm/find-by-id storage-spec (:id trans)))
         expected {:transaction-date (t/local-date 2016 1 2)
             :description "Employer"


Converted test of tabular form to tabular form.

--- test/midje/midje_forms/t_translating.clj
+++ test/midje/midje_forms/t_translating.clj
@@ -252,24 +252,30 @@
     (lineno result 1) => (lineno line-number-source 1)
     (:meta (meta (nth result 1))) => :data))

-
-(fact "bindings can be added to an expect form for documentation"
-  (let [original '(do (midje.semi-sweet/expect (a) => b)
-                      (do (midje.semi-sweet/expect (inc a) => M)))
-        expected '(do (midje.semi-sweet/expect (a) => b :binding-note '{?a a})
-                      (do (midje.semi-sweet/expect (inc a) => M :binding-note '{?a a})))]
-    (with-one-binding-annotation original '{ ?a a }) => expected)
-
-  "fakes do not get insertions"
-  (let [original '(do (midje.semi-sweet/expect (a) => b
-                        (midje.semi-sweet/fake (x) => 3)))
-        expected '(do (midje.semi-sweet/expect (a) => b :binding-note '{?a a}
-                        (midje.semi-sweet/fake (x) => 3)))]
-    (with-one-binding-annotation original '{ ?a a }) => expected)
-
-  "other annotations are preserved"
-  (let [original '(do (midje.semi-sweet/expect (a) => b :line 33))
-        expected '(do (midje.semi-sweet/expect (a) => b :binding-note '{?a a} :line 33))]
-    (with-one-binding-annotation original '{ ?a a }) => expected))
-
-
+
+
+(tabular (fact ?comment
+           (let [line-no-free-original ?original
+                 line-no-free-expected ?expected]
+             (with-one-binding-annotation line-no-free-original '{ ?a a })
+             => line-no-free-expected))
+
+         ?comment ?original ?expected
+
+         "binding notes can be inserted"
+         '(do (midje.semi-sweet/expect (a) => b)
+              (do (midje.semi-sweet/expect (inc a) => M)))
+         '(do (midje.semi-sweet/expect (a) => b
+                                       :binding-note '{?a a})
+                      (do (midje.semi-sweet/expect (inc a) => M
+                                                   :binding-note '{?a a})))
+
+         "fakes do not get insertions"
+         '(do (midje.semi-sweet/expect (a) => b
+                                       (midje.semi-sweet/fake (x) => 3)))
+         '(do (midje.semi-sweet/expect (a) => b :binding-note '{?a a}
+                                       (midje.semi-sweet/fake (x) => 3)))
+
+         "other annotations are preserved"
+         '(do (midje.semi-sweet/expect (a) => b :line 33))
+         '(do (midje.semi-sweet/expect (a) => b :binding-note '{?a a} :line 33)))


Fix test indent

Fix test indent

--- test/pathfinder/analyze/clojure_test.clj
+++ test/pathfinder/analyze/clojure_test.clj
@@ -31,11 +31,9 @@
                                "(ns test (:require [foo.bar :as f])) (+ (f/baz 6) 7)" {}))
              => (contains (contains {:name "foo.bar/baz"})))
        (fact "should extract multiple usages"
-             (->> (analyze (->CljHeuristicAnalyzer)
-                           "(ns test (:require [foo :as f])) (f/bar 3) (f/bar 6)" {})
-                  :usages
-                  first
-                  :pos)
+             (-> (analyze (->CljHeuristicAnalyzer)
+                          "(ns test (:require [foo :as f])) (f/bar 3) (f/bar 6)" {})
+                 :usages first :pos)
              => (every-checker sequential? #(> (count %) 1)))
        (fact "should extract usages inside literal vectors"
              (:usages (analyze (->CljHeuristicAnalyzer)


Add route for /info

Add route for /info

--- src/beebster_clj/routes.clj
+++ src/beebster_clj/routes.clj
@@ -9,9 +9,10 @@
 (defroutes app-routes
   (route/resources "/")
   (GET "/" [] (index-page))
-  (GET "/about" [] (about-page))
+  (GET "/search" [] (about-page))
   (GET "/categories" [category] (category-page category))
-  (POST "/results" [searchvalue] (result-page searchvalue)))
+  (POST "/results" [searchvalue] (result-page searchvalue))
+  (GET "/info" [index] (info-page index)))

 (def app


Adding temporal acl sprint demo.

Adding temporal acl sprint demo.

--- system-int-test/src/cmr/system_int_test/utils/ingest_util.clj
+++ system-int-test/src/cmr/system_int_test/utils/ingest_util.clj
@@ -320,6 +320,13 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn create-provider
+  "Creates a provider along with ACLs to create and access the providers data.
+  Provider map should contain fields with details for an individual provider like what would be
+  taken on the ingest api.
+
+  Options:
+  * grant-all-search? - Indicates whether all search acls should be granted for a provider. Default true
+  * grant-all-ingest? - Indicates whether all ingest acls should be granted for a provider. Default true"
   ([provider-map]
    (create-provider provider-map {}))
   ([provider-map options]


good normalization

good normalization

--- src/bluebell/utils/core.clj
+++ src/bluebell/utils/core.clj
@@ -165,9 +165,17 @@
           [state (make-empty coll)]
           coll))

+(defn comparable? [x]
+  (instance? java.lang.Comparable x))
+
+(defn sort-if-possible [pairs]
+  (if (every? comparable? (map first pairs))
+    (sort-by first pairs)
+    pairs))
+
 (defn normalize-coll [coll]
   (cond
-    (map? coll) (vec (apply concat (vec coll)))
+    (map? coll) (vec (apply concat (sort-if-possible (vec coll))))
     (set? coll) (sort (vec coll))
     :default (vec coll)))


good so far

good so far

--- src/bluebell/utils/core.clj
+++ src/bluebell/utils/core.clj
@@ -426,3 +426,8 @@
     (first
      (traverse-postorder-cached
       {} expr (merge default-subexpr-cfg cfg))))))
+
+;; Force get
+(defn fget [x k]
+  (assert (contains? x k))
+  (get x k))


Simplify ebmd

Simplify ebmd

--- src/bluebell/utils/ebmd.clj
+++ src/bluebell/utils/ebmd.clj
@@ -178,10 +178,9 @@
   (check-io
    [:pre [(map? state)
           ::general-arg-spec arg-spec]]
-   (let [arg-spec (resolve-arg-spec arg-spec)]
-     (-> state
-         mark-dirty
-         (update :arg-specs conj [(arg-spec-key arg-spec) nil])))))
+   (-> state
+       mark-dirty
+       (update :arg-specs conj [(arg-spec-key arg-spec) nil]))))

 (defn- add-arg-specs [state arg-specs]
   (reduce add-arg-spec state arg-specs))


AEAD: error handling and other minor fixes

- Check the return code of the `*-decrypt` functions and throw an
  exception if it's non-zero

- Call the right functions in `*-keygen`

- Fix misplaced docstrings in `*-keygen`

--- src/caesium/crypto/aead.clj
+++ src/caesium/crypto/aead.clj
@@ -17,10 +17,11 @@
               xchacha20poly1305-ietf-abytes])

 (defn ^:private chacha20poly1305-ietf-keygen-to-buf! [k]
-  (b/call! chacha20poly1305-ietf-keybytes k))
-
-(defn chacha20poly1305-ietf-keygen []
+  (b/call! chacha20poly1305-ietf-keygen k))
+
+(defn chacha20poly1305-ietf-keygen
   "Generates a new random key."
+  []
   (let [k (bb/alloc chacha20poly1305-ietf-keybytes)]
     (chacha20poly1305-ietf-keygen-to-buf! k)
     k))
@@ -50,8 +51,10 @@

 (defn ^:private chacha20poly1305-ietf-decrypt-to-buf!
   [m nsec c ad npub k]
-  (b/call! chacha20poly1305-ietf-decrypt m nsec c ad npub k)
-  c)
+  (let [res (b/call! chacha20poly1305-ietf-decrypt m nsec c ad npub k)]
+    (if (zero? res)
+      c
+      (throw (RuntimeException. "Ciphertext verification failed")))))

 (defn chacha20poly1305-ietf-decrypt
   [c ad npub k]
@@ -87,8 +90,10 @@

 (defn ^:private chacha20poly1305-ietf-decrypt-detached-to-buf!
   [m nsec c mac ad npub k]
-  (b/call! chacha20poly1305-ietf-decrypt-detached m nsec c mac ad npub k)
-  c)
+  (let [res (b/call! chacha20poly1305-ietf-decrypt-detached m nsec c mac ad npub k)]
+    (if (zero? res)
+      c
+      (throw (RuntimeException. "Ciphertext verification failed")))))

 (defn chacha20poly1305-ietf-decrypt-detached
   [c mac ad npub k]
@@ -104,12 +109,13 @@
     (bb/->bytes m)))

 (defn ^:private chacha20poly1305-keygen-to-buf! [k]
-  (b/call! chacha20poly1305-keybytes k))
-
-(defn chacha20poly1305-keygen []
+  (b/call! chacha20poly1305-keygen k))
+
+(defn chacha20poly1305-keygen
   "Generates a new random key."
+  []
   (let [k (bb/alloc chacha20poly1305-keybytes)]
-    (chacha20poly1305-ietf-keygen-to-buf! k)
+    (chacha20poly1305-keygen-to-buf! k)
     k))

 (defn new-chacha20poly1305-nonce
@@ -137,8 +143,10 @@

 (defn ^:private chacha20poly1305-decrypt-to-buf!
   [m nsec c ad npub k]
-  (b/call! chacha20poly1305-decrypt m nsec c ad npub k)
-  c)
+  (let [res (b/call! chacha20poly1305-decrypt m nsec c ad npub k)]
+    (if (zero? res)
+      c
+      (throw (RuntimeException. "Ciphertext verification failed")))))

 (defn chacha20poly1305-decrypt
   [c ad npub k]
@@ -174,8 +182,10 @@

 (defn ^:private chacha20poly1305-decrypt-detached-to-buf!
   [m nsec c mac ad npub k]
-  (b/call! chacha20poly1305-decrypt-detached m nsec c mac ad npub k)
-  c)
+  (let [res (b/call! chacha20poly1305-decrypt-detached m nsec c mac ad npub k)]
+    (if (zero? res)
+      c
+      (throw (RuntimeException. "Ciphertext verification failed")))))

 (defn chacha20poly1305-decrypt-detached
   [c mac ad npub k]
@@ -191,12 +201,13 @@
     (bb/->bytes m)))

 (defn ^:private xchacha20poly1305-ietf-keygen-to-buf! [k]
-  (b/call! xchacha20poly1305-keybytes k))
-
-(defn xchacha20poly1305-ietf-keygen []
+  (b/call! xchacha20poly1305-ietf-keygen k))
+
+(defn xchacha20poly1305-ietf-keygen
   "Generates a new random key."
+  []
   (let [k (bb/alloc xchacha20poly1305-ietf-keybytes)]
-    (chacha20poly1305-keygen-to-buf! k)
+    (xchacha20poly1305-ietf-keygen-to-buf! k)
     k))

 (defn new-xchacha20poly1305-ietf-nonce
@@ -224,8 +235,10 @@

 (defn ^:private xchacha20poly1305-ietf-decrypt-to-buf!
   [m nsec c ad npub k]
-  (b/call! xchacha20poly1305-ietf-decrypt m nsec c ad npub k)
-  c)
+  (let [res (b/call! xchacha20poly1305-ietf-decrypt m nsec c ad npub k)]
+    (if (zero? res)
+      c
+      (throw (RuntimeException. "Ciphertext verification failed")))))

 (defn xchacha20poly1305-ietf-decrypt
   [c ad npub k]
@@ -261,8 +274,10 @@

 (defn ^:private xchacha20poly1305-ietf-decrypt-detached-to-buf!
   [m nsec c mac ad npub k]
-  (b/call! xchacha20poly1305-ietf-decrypt-detached m nsec c mac ad npub k)
-  c)
+  (let [res (b/call! xchacha20poly1305-ietf-decrypt-detached m nsec c mac ad npub k)]
+    (if (zero? res)
+      c
+      (throw (RuntimeException. "Ciphertext verification failed")))))

 (defn xchacha20poly1305-ietf-decrypt-detached
   [c mac ad npub k]


added default names

added default names

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -3,6 +3,7 @@
             [cognitect.transit :as transit])
   (:import [datasplash.fns ClojureDoFn]
            [java.io InputStream OutputStream]
+           [java.util UUID]
            [com.google.cloud.dataflow.sdk.options PipelineOptionsFactory]
            [com.google.cloud.dataflow.sdk Pipeline]
            [com.google.cloud.dataflow.sdk.io TextIO$Read TextIO$Write]
@@ -12,6 +13,8 @@
            [datasplash.vals ClojureVal]
            [datasplash.coders ClojureCoder])
   (:gen-class))
+
+(def ops-counter (atom 0))

 (defn dofn
   [f & {:keys [start-bundle finish-bundle] :as opts}]
@@ -54,38 +57,46 @@

 (defmacro with-opts
   [schema opts & body]
-  `(let [transform# (do ~@body)]
-     (reduce
-      (fn [f# [k# apply#]]
-        (if-let [v# (get ~opts k#)]
-          (apply# f# v#)
-          f#))
-      transform# ~schema)))
+  (println opts)
+  (let [full-name (name
+                   (or (:name opts)
+                       (do
+                         (swap! ops-counter inc)
+                         (str (name (get opts :label "cljfn")) "_" @ops-counter))))]
+    `(let [transform# (do ~@body)]
+       (reduce
+        (fn [f# [k# apply#]]
+          (if-let [v# (get (assoc ~opts :name ~full-name) k#)]
+            (apply# f# v#)
+            f#))
+        transform# ~schema))))

 (def base-schema
   {:name (fn [transform n] (.withName transform n))})

 (defn map-op
-  ([transform coder]
+  ([transform label coder]
    (fn
-     [f opts ^PCollection pcoll]
-     (-> pcoll
-         (.apply (with-opts base-schema opts
-                   (ParDo/of (dofn (transform f)))))
-         (.setCoder (or (:coder opts) coder)))))
-  ([transform]
-   (map-op transform (make-transit-coder))))
+     [f options ^PCollection pcoll]
+     (let [opts (assoc options :label label)]
+       (-> pcoll
+           (.apply (with-opts base-schema opts
+                     (ParDo/of (dofn (transform f)))))
+           (.setCoder (or (:coder opts) coder))))))
+  ([transform label]
+   (map-op transform label (make-transit-coder))))

-(def dmap (map-op map-fn))
-(def dmapcat (map-op mapcat-fn))
-(def dfilter (map-op filter-fn))
+(def dmap (map-op map-fn :map))
+(def dmapcat (map-op mapcat-fn :mapcat))
+(def dfilter (map-op filter-fn :filter))

 (defn generate-input
-  [coll opts ^Pipeline p]
-  (-> p
-      (.apply (with-opts base-schema opts
-                (Create/of (seq coll))))
-      (.setCoder (or (:coder opts) (make-transit-coder)))))
+  [coll options ^Pipeline p]
+  (let [opts (assoc options :label :generate-input)]
+    (-> p
+        (.apply (with-opts base-schema opts
+                  (Create/of (seq coll))))
+        (.setCoder (or (:coder opts) (make-transit-coder))))))

 (defn- to-edn*
   [^DoFn$Context c]
@@ -93,7 +104,7 @@
         result (pr-str elt)]
     (.output c result)))

-(def to-edn (partial (map-op identity (StringUtf8Coder/of)) to-edn*))
+(def to-edn (partial (map-op identity :to-edn (StringUtf8Coder/of)) to-edn*))

 (defn make-pipeline
   [str-args]
@@ -103,17 +114,19 @@
     (Pipeline/create options)))

 (defn load-text-file
-  [from opts ^Pipeline p]
-  (-> p
-      (.apply (with-opts base-schema opts
-                (TextIO$Read/from from)))
-      (.setCoder (StringUtf8Coder/of))))
+  [from options ^Pipeline p]
+  (let [opts (assoc options :label :load-text-file)]
+    (-> p
+        (.apply (with-opts base-schema opts
+                  (TextIO$Read/from from)))
+        (.setCoder (StringUtf8Coder/of)))))

 (defn write-text-file
-  ([to opts ^PCollection pcoll]
-   (-> pcoll
-       (.apply (with-opts base-schema opts
-                 (TextIO$Write/to to)))))
+  ([to options ^PCollection pcoll]
+   (let [opts (assoc options :label :write-text-file)]
+     (-> pcoll
+         (.apply (with-opts base-schema opts
+                   (TextIO$Write/to to))))))
   ([to pcoll] (write-text-file to {} pcoll)))

 (comment
@@ -123,10 +136,10 @@
   [& args]
   (let [p (make-pipeline args)
         final (->> p
-                   (generate-input (range 10000) {:named "gengen"})
-                   (dmap inc {:named "map"})
-                   (dfilter even? {:named "filter"})
-                   (to-edn {:named "edn"})
+                   (generate-input (range 10000) {:name "gengen"})
+                   (dmap inc {:name "map"})
+                   (dfilter even? {:name "filter"})
+                   (to-edn {:name "edn"})
                    (write-text-file "tee"))]

     (.run p)))


added cogroup-by

added cogroup-by

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -218,18 +218,33 @@
                                  (let [k (.getKey elt)
                                        raw-values (.getValue elt)
                                        values (for [tag ordered-tags]
-                                                (seq (.getAll raw-values tag)))]
-                                   (conj values k))) opts rel)]
+                                                (into [] (first (.getAll raw-values tag))))]
+                                   (into [] (conj values k)))) opts rel)]
            final-rel))))))

-(defn raw-cogroup
+(defn cogroup
   [options pcolls]
-  (let [opts (assoc options :label :raw-cogroup)
+  (let [opts (assoc options :label :cogroup)
         pcolltuple (make-keyed-pcollection-tuple pcolls)]
     (-> pcolltuple
         (.apply (with-opts base-schema opts
                   (cogroup-transform opts))))))

+(defn cogroup-by
+  [options specs]
+  (let [operations (for [[pcoll f type] specs]
+                     [(dgroup-by f options pcoll) type])
+        required-idx (remove nil? (map-indexed (fn [idx [_ b]] (when b idx)) operations))
+        pcolls (map first operations)
+        grouped-coll (cogroup options pcolls)]
+    (if (empty? required-idx)
+      grouped-coll
+      (dfilter (fn [[_ all-vals]]
+                 (let [idx-vals (into [] all-vals)]
+                   (every? #(not (empty? (get idx-vals %))) required-idx)))
+               options
+               grouped-coll))))
+
 (comment
   (compile 'datasplash.core))

@@ -237,13 +252,19 @@
   [& args]
   (let [p (make-pipeline args)
         first-in (->> p
-                      (generate-input [{:key :a :foo 12} {:key :b :foo 5} {:key :a :foo 42}] {:name "gengen1"})
-                      (dgroup-by :key {:name :group-by-fi}))
+                      (generate-input [{:key :a :foo 12} {:key :b :foo 5} {:key :a :foo 42} {:key :c :val "never"}] {:name "gengen1"}))
         second-in (->> p
-                       (generate-input [{:key :a :val 10} {:key :b :val 5} {:key :a :val 42}] {:name "gengen"})
-                       (dgroup-by :key {:name :group-by}))
-        final (->> (raw-cogroup {:name :join} [first-in second-in])
-                   (write-edn-file "gs://oscaro-test-dataflow/results/group-by.edn" {:name :output-edn}))
+                       (generate-input [{:key :a :val 10} {:key :b :val 5} {:key :a :val 42}] {:name "gengen"}))
+        final (->> (cogroup-by {:name :join} [[first-in :key] [second-in :key ]])
+                   (write-edn-file "tessst.edn" {:name :output-edn}))
+        ;; first-in (->> p
+        ;;               (generate-input [{:key :a :foo 12} {:key :b :foo 5} {:key :a :foo 42}] {:name "gengen1"})
+        ;;               (dgroup-by :key {:name :group-by-fi}))
+        ;; second-in (->> p
+        ;;                (generate-input [{:key :a :val 10} {:key :b :val 5} {:key :a :val 42}] {:name "gengen"})
+        ;;                (dgroup-by :key {:name :group-by}))
+        ;; final (->> (cogroup {:name :join} [first-in second-in])
+        ;;            (write-edn-file "gs://oscaro-test-dataflow/results/group-by.edn" {:name :output-edn}))
         ;; final (->> p
         ;;            (generate-input [{:key :a :val 10} {:key :b :val 5} {:key :a :val 42}] {:name "gengen"})
         ;;            (dgroup-by :key {:name :group-by})


Changed map to for macro, inside reproject.

--- src/clj/forma/reproject.clj
+++ src/clj/forma/reproject.clj
@@ -265,6 +265,7 @@
         numpix (sqr edge)
         indexer (partial wgs84-index m-res ll-res mod-h mod-v)]
     (for [chunk (range (/ numpix chunk-size))]
-      [chunk
-       (map #(apply indexer (tile-position m-res chunk-size chunk %))
-            (range chunk-size))])))+      (vector chunk
+              (for [pixel (range chunk-size)]
+                (apply indexer
+                       (tile-position m-res chunk-size chunk pixel)))))))


Refactor net.core extracting all logic not related to netty into a separate handler.

--- src/clj/picard/net/core.clj
+++ src/clj/picard/net/core.clj
@@ -107,26 +107,32 @@
 ;; ==== Handlers

 (defrecord State
-    [ch
-     upstream
+    [upstream
+     downstream
      aborting?
      writable?
-     last-write
      event-lock
      state-queue
      message-queue])

-(defn- initial-state
-  [ch]
+(defrecord NettyState
+    [ch
+     last-write])
+
+(defn- mk-initial-state
+  [dn]
   (State.
-   ch              ;; ch
    nil             ;; upstream
+   dn              ;; downstream
    false           ;; aborting?
    true            ;; writable?
-   nil             ;; last-write
    (atom true)     ;; event-lock
    (LinkedList.)   ;; state-queue
    (LinkedList.))) ;; message-queue
+
+(defn- mk-initial-netty-state
+  []
+  (NettyState. nil nil))

 (declare handle-err)

@@ -170,9 +176,11 @@
 (defn- poll-queue*
   [current-state]
   (or (.. current-state state-queue poll)
-      (and (or (.. current-state ch isReadable)
-               (not (.. current-state ch isOpen)))
-           (.. current-state message-queue poll))))
+      (.. current-state message-queue poll)
+      ;; (and (or (.. current-state ch isReadable)
+      ;;          (not (.. current-state ch isOpen)))
+      ;;      (.. current-state message-queue poll))
+      ))

 (defn- poll-queue
   [current-state]
@@ -190,13 +198,14 @@
       (reset! event-lock true))))

 (defn- handle-interest-ops
-  [state upstream]
+  [state evt upstream]
   (let [current-state @state
-        writable?     (.writable? current-state)
-        ch            (.ch current-state)]
-    (when (not= writable? (.isWritable ch))
-      (swap! state #(assoc % :writable? (not writable?)))
-      (upstream (if writable? :pause :resume) nil))))
+        was-writable? (.writable? current-state)
+        now-writable? (= :resume evt)]
+
+    (when (not= was-writable? now-writable?)
+      (swap! state #(assoc % :writable? now-writable?))
+      (upstream evt nil))))

 ;; Handles sending messages upstream in a sane and thread-safe way.
 ;;
@@ -212,8 +221,8 @@
         (loop []
           (when-let [[evt val] (poll-queue current-state)]
             (cond
-             (= :interest-ops evt)
-             (handle-interest-ops state upstream)
+             (#{:pause :resume} evt)
+             (handle-interest-ops state evt upstream)

              (= :schedule evt)
              (val)
@@ -229,14 +238,15 @@
   ([state err current-state]
      (handle-err state err current-state false))
   ([state err current-state locked?]
-     (when (and current-state
-                (not (.aborting? current-state)))
-       (let [upstream  (.upstream current-state)]
+     (when (not (.aborting? current-state))
+       (let [upstream (.upstream current-state)]
          (swap-then!
           state
           #(assoc % :aborting? true)
           (fn [^State current-state]
-            (close-channel current-state)
+            (try
+              ((.downstream current-state) :close nil)
+              (catch Exception _))
             (when upstream
               (try
                 (if locked?
@@ -244,13 +254,48 @@
                   (send-upstream state :abort err current-state))
                 (catch Exception _)))))))))

-(defn- mk-downstream-fn
+(defn- mk-downstream
+  [next-dn state]
+  (fn [evt val]
+    (let [current-state @state]
+      (when-not (.upstream current-state)
+        (throw (Exception. "Not callbable yet")))
+
+      (cond
+       (= :schedule evt)
+       (send-upstream state :schedule val current-state)
+
+       (= :abort evt)
+       (handle-err state val current-state)
+
+       :else
+       (next-dn evt val)))))
+
+(defn handler
+  [app opts]
+  (fn [dn]
+    (let [state    (atom (mk-initial-state dn))
+          upstream (app (mk-downstream dn state))]
+      ;; Save off the upstream
+      (swap! state #(assoc % :upstream upstream))
+      ;; And now the upstream
+      (fn [evt val]
+        (try
+          (let [current-state @state]
+            (if (= :abort evt)
+              (when-not (.aborting? current-state)
+                (swap-then!
+                 state
+                 #(assoc % :aborting? true)
+                 #(send-upstream state evt val %)))
+              (send-upstream state evt val current-state)))
+          (catch Exception err
+            (handle-err state err @state)))))))
+
+(defn- mk-netty-downstream-fn
   [state]
   (fn [evt val]
-    (let [current-state ^State @state]
-      (when-not (.upstream current-state)
-        (throw (Exception. "Not callbable yet")))
-
+    (let [current-state @state]
       (cond
        (= :message evt)
        (let [ch (.ch current-state)]
@@ -264,59 +309,52 @@
        (close-channel current-state)

        (= :pause evt)
-       (when (.upstream current-state)
-         (.setReadable (.ch current-state) false))
+       (.setReadable (.ch current-state) false)

        (= :resume evt)
-       (when (.upstream current-state)
-         (.setReadable (.ch current-state) true))
-
-       (= :schedule evt)
-       (send-upstream state evt val current-state)
-
-       (= :abort evt)
-       (handle-err state val current-state)
+       (.setReadable (.ch current-state) true)

        :else
        (throw (Exception. (str "Unexpected event: " evt)))))))

 (defn mk-upstream-handler
   [^ChannelGroup channel-group app opts]
-  (let [state (atom nil)]
+  (let [state    (atom (mk-initial-netty-state))
+        app      (handler app opts)
+        upstream (app (mk-netty-downstream-fn state))]
+
+    ;; The actual Netty upstream handler.
     (reify ChannelUpstreamHandler
       (^void handleUpstream [_ ^ChannelHandlerContext ctx ^ChannelEvent evt]
         (let [current-state ^State @state]
-          (try
-            (cond
-             ;; Handle message events
-             (message-event? evt)
-             (let [[evt val] (decode (.getMessage ^MessageEvent evt))]
-               (send-upstream state evt val current-state))
-
-             (interest-changed-event? evt)
-             (send-upstream state :interest-ops nil current-state)
-
-             ;; The bind function is invoked on channel open, ideally
-             ;; this would always get invoked. However, there is a
-             ;; possibility that opening the socket channel
-             ;; fails. That case isn't handled right now.
-             (channel-open-event? evt)
-             (let [ch (.getChannel evt)]
-               ;; First, track the channel in the channel group
-               (.add channel-group ch)
-               ;; Now, initialize the state with the channel
-               (reset! state (initial-state ch))
-               (let [upstream (app (mk-downstream-fn state))]
-                 (swap! state #(assoc % :upstream upstream))))
-
-             (channel-connected-event? evt)
-             (let [ch-info (-> current-state .ch channel-info)]
-               (send-upstream state :open ch-info current-state))
-
-             (channel-disconnected-event? evt)
-             (send-upstream state :close nil current-state)
-
-             (exception-event? evt)
-             (handle-err state (.getCause evt) current-state))
-            (catch Exception err
-              (handle-err state err @state))))))))
+          (cond
+           ;; Handle message events
+           (message-event? evt)
+           (let [[evt val] (decode (.getMessage ^MessageEvent evt))]
+             (upstream evt val))
+
+           (interest-changed-event? evt)
+           (if (.isWritable (.getChannel evt))
+             (upstream :resume nil)
+             (upstream :pause nil))
+
+           ;; The bind function is invoked on channel open, ideally
+           ;; this would always get invoked. However, there is a
+           ;; possibility that opening the socket channel
+           ;; fails. That case isn't handled right now.
+           (channel-open-event? evt)
+           (let [ch (.getChannel evt)]
+             ;; First, track the channel in the channel group
+             (.add channel-group ch)
+             ;; Now, initialize the state with the channel
+             (swap! state #(assoc % :ch ch)))
+
+           (channel-connected-event? evt)
+           (let [ch-info (-> current-state .ch channel-info)]
+             (upstream :open ch-info))
+
+           (channel-disconnected-event? evt)
+           (upstream :close nil)
+
+           (exception-event? evt)
+           (upstream :abort (.getCause evt))))))))