use the default timbre logger

use the default timbre logger

--- src/leiningen/new/onyx_app/src/onyx_app/launcher/launch_prod_peers.clj
+++ src/leiningen/new/onyx_app/src/onyx_app/launcher/launch_prod_peers.clj
@@ -13,24 +13,11 @@
             [{{app-name}}.lifecycles.sample-lifecycle])
   (:gen-class))

-{{#docker?}}
-(defn standard-out-logger
-  "Logger to output on std-out, for use with docker-compose"
-  [data]
-  (let [{:keys [output-fn]} data]
-    (println (output-fn data))))
-{{/docker?}}
-
 (defn -main [n & args]
   (let [n-peers (Integer/parseInt n)
         config (read-config (clojure.java.io/resource "config.edn") {:profile :default})
         peer-config (-> (:peer-config config)
-                        {{#docker?}}(assoc :onyx.log/config {:appenders
-                                                             {:standard-out
-                                                              {:enabled? true
-                                                               :async? false
-                                                               :output-fn t/default-output-fn
-                                                               :fn standard-out-logger}}}){{/docker?}})
+                        {{#docker?}}(assoc :onyx.log/config {:appenders {} :min-level :info}){{/docker?}})
         peer-group (onyx.api/start-peer-group peer-config)
         peers (onyx.api/start-peers n-peers peer-group)]
     (println "Attempting to connec to to Zookeeper: " (:zookeeper/address peer-config))


restart! for debugging

restart! for debugging

--- test/osmium/core_test.clj
+++ test/osmium/core_test.clj
@@ -106,11 +106,14 @@
       (taxi/quit driver))
     (o/stop!)))

+(defn restart! []
+  (swap! replay assoc :stop 0))
+
 (defn step! []
   (let [{:keys [actions step]} @replay
         next-action (nth actions step)]
     (eval! @replay-driver next-action)
     (if (< step (dec (count actions)))
       (swap! replay update :step inc)
-      (swap! replay assoc :step 0))
+      (restart!))
     next-action))


Revert "Peg FireCloud at an older Leo image version (#1465)" (#1499)

This reverts commit bf13cc33768e9582d4462fb098672e98fb20619a.

--- src/cljs/main/broadfcui/page/workspace/notebooks/create_cluster.cljs
+++ src/cljs/main/broadfcui/page/workspace/notebooks/create_cluster.cljs
@@ -40,10 +40,6 @@
                    "n1-highmem-32"
                    "n1-highmem-64"
                    "n1-highmem-96"])
-
-; TODO: FireCloud temporarily pegged at an older Jupyter image with Hail 0.1
-; See https://github.com/DataBiosphere/leonardo/issues/699
-(def jupyterDockerImage "us.gcr.io/broad-dsp-gcr-public/leonardo-notebooks:hail0.1")

 (react/defc ClusterCreator
   {:refresh
@@ -182,8 +178,7 @@
                :payload (merge payload
                                {:machineConfig machineConfig}
                                (when-not (string/blank? extensionURI) {:jupyterExtensionUri extensionURI})
-                               (when-not (string/blank? userScriptURI) {:jupyterUserScriptUri userScriptURI})
-                               {:jupyterDockerImage jupyterDockerImage})
+                               (when-not (string/blank? userScriptURI) {:jupyterUserScriptUri userScriptURI}))
                :headers ajax/content-type=json
                :on-done (fn [{:keys [success? get-parsed-response]}]
                           (swap! state dissoc :creating?)


Fix bugs with Elasticsearch native client

--- joplin.elasticsearch/src/joplin/elasticsearch/database.clj
+++ joplin.elasticsearch/src/joplin/elasticsearch/database.clj
@@ -88,7 +88,7 @@

 (defn migrate-data-native
   ([es-client es-native-client old-index mapping-type new-index]
-     (migrate-data es-client old-index mapping-type new-index identity))
+     (migrate-data-native es-client old-index mapping-type new-index identity))
   ([es-client es-native-client old-index mapping-type new-index trans-f]
      (dorun
       (->> (esnd/search es-native-client
@@ -113,10 +113,11 @@
 (defn client [{:keys [host port]}]
   (es/connect (str "http://" host ":" port)))

-(defn native-client [{:keys [host port cluster]}]
-  (if cluster
-    (esn/connect [[host port]] {"cluster.name" cluster})
-    (esn/connect [[host port]])))
+(defn native-client [{:keys [host port native-port cluster]}]
+  (let [es-port (or native-port port)]
+    (if cluster
+      (esn/connect [[host es-port]] {"cluster.name" cluster})
+      (esn/connect [[host es-port]]))))

 (defn wait-for-ready [es-native-client shards]
   (-> es-native-client
@@ -249,7 +250,7 @@
 ;; ============================================================================
 ;; Ragtime interface

-(defrecord ElasticSearchDatabase [host port index migration-index]
+(defrecord ElasticSearchDatabase [host port index migration-index cluster native-port]
   Migratable
   (add-migration-id [db id]
     (es-add-migration-id (client db) (get-migration-index db) id))
@@ -260,7 +261,7 @@

 (defn ->ESDatabase [target]
   (map->ElasticSearchDatabase (select-keys (merge target (:db target))
-                                           [:host :port :index :migration-index])))
+                                           [:host :port :index :migration-index :cluster :native-port])))

 ;; ============================================================================
 ;; Joplin interface


Fix handle problem

Fix handle problem

--- src/degasolv/resolver_core.clj
+++ src/degasolv/resolver_core.clj
@@ -620,11 +620,8 @@
        #(get % 1)
        clause-result))])))))))

-(defn handle [p]
-  (str (:id p) "@" (:version p)))
-
 (defn make-install-graph
-  [package-graph]
+  [package-graph handle]
   (as-> package-graph grph
     (map (fn [[k v]]
            [(handle k)
@@ -633,14 +630,6 @@
               (dissoc thing :id :version :location :requirements)
               (into thing {:dependees (map handle v)}))]) grph)
     (into {} grph)))
-
-(defn resolve-dependencies
-  [requirements
-   query & options]
-  (let [r (resolve-dependencies-deluxe requirements query options)]
-    (if (= (:result r) :successful)
-           [:successful (:packages r)]
-           [(:result r) r])))

 (defn resolve-dependencies-deluxe
   [requirements
@@ -705,12 +694,25 @@
                (second result)
                :list-strat :lazy
                :exclude (reduce (fn [c [k v]] (into c v))
-                                #{})
-                               present-packages))
+                                #{}
+                               present-packages)))
            (list-packages
              (second result)
              :list-strat list-strat))
          :install-graph
-         (make-install-graph (second result))
+         (make-install-graph
+           (second result)
+           (if (= conflict-strat :inclusive)
+             #(str (:id %) "@" (:version %))
+             :id))
          }
         (into {:result (first result)} (second result))))))
+
+(defn resolve-dependencies
+  [requirements
+   query & {:as options}]
+  (let [r (resolve-dependencies-deluxe requirements query options)]
+    (if (= (:result r) :successful)
+           [:successful (:packages r)]
+           [(:result r) r])))
+


Fix missing parentheses in generated code.

--- dev_src/afterglow/src_generator.clj
+++ dev_src/afterglow/src_generator.clj
@@ -17,13 +17,13 @@
     (spit src (str "(ns afterglow." lc-name "-messages
   (:require [flatland.protobuf.core :refer :all])
   (:import [" pkg " " (clojure.string/join " " (map #(str name "$" %) (concat messages enums))) "]
-           [flatland.protobuf PersistentProtocolBufferMap$Def$NamingStrategy])
+           [flatland.protobuf PersistentProtocolBufferMap$Def$NamingStrategy]))

 (def safe-strategy (reify PersistentProtocolBufferMap$Def$NamingStrategy
                           (protoName [this clojure-name]
                                      (name clojure-name))
                           (clojureName [this proto-name]
-                                       (keyword proto-name)))\n\n"
+                                       (keyword proto-name))))\n\n"
   (clojure.string/join "\n\n" (map #(str "(def " % " (protodef " name "$" % " {:naming-strategy safe-strategy}))") messages)) "\n"))))

 (defn generate []


fixed seq based config problems

fixed seq based config problems

should probably move to full schema check.

--- sidecar/src/figwheel_sidecar/config.clj
+++ sidecar/src/figwheel_sidecar/config.clj
@@ -1,7 +1,8 @@
 (ns figwheel-sidecar.config
   (:require
    [clojure.string :as string]
-   [clojure.java.io :as io]))
+   [clojure.java.io :as io]
+   [clojure.walk :as walk]))

 (defn optimizations-none?
   "returns true if a build has :optimizations set to :none"
@@ -99,16 +100,19 @@
     dir))

 (defn normalize-output-dir [opts]
-  (update-in opts [:output-dir] normalize-dir))
+  (update-in opts [(if (:build-options opts) :build-options :compiler)  :output-dir] normalize-dir))

 (defn normalize-output-dirs [builds]
   (mapv normalize-output-dir builds))

+(defn no-seqs [b]
+  (walk/postwalk #(if (seq? %) (vec %) %) b))
+
 (defn prep-builds [builds]
   (-> builds
-    map-to-vec-builds
-    normalize-output-dirs
-    vec))
+      map-to-vec-builds
+      normalize-output-dirs
+      no-seqs))

 (defn apply-to-key
   "applies a function to a key, if key is defined."
@@ -119,7 +123,9 @@
   "Normalize various configuration input."
   [opts]
   (->> opts
+       no-seqs
        (apply-to-key str :ring-handler)
-       (apply-to-key vec :css-dirs)
-       (apply-to-key vec :resource-paths)))
+       (apply-to-key str :http-server-root)
+       (apply-to-key str :open-file-command)
+       (apply-to-key str :server-logfile)))


CMR-1788: Fixing the translation test due to a difference in the content type that's being returned.

--- system-int-test/test/cmr/system_int_test/ingest/translation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/translation_test.clj
@@ -32,7 +32,7 @@
       (let [input-str (umm-spec/generate-metadata :collection input-format expected-conversion/example-record)
             expected (expected-conversion/convert expected-conversion/example-record input-format output-format)
             {:keys [status headers body]} (ingest/translate-metadata :collection input-format input-str output-format)
-            content-type (:content-type headers)]
+            content-type (first (mt/extract-mime-types (:content-type headers)))]
         (is (= 200 status))
         (is (= (mt/format->mime-type output-format) content-type))
         (is (= expected (umm-spec/parse-metadata :collection output-format body))))))


Remove unneeded require

Remove unneeded require

--- spectacles/src/spectacles/scheduler.clj
+++ spectacles/src/spectacles/scheduler.clj
@@ -2,7 +2,7 @@
   (:require [spectacles.present-logo]
             [spectacles.starfield]
             [spectacles.bet-you-miss]
-            [clojure.core.async :as async]))
+            ))

 (def sketches [{:setup  spectacles.present-logo/setup
                 :update spectacles.present-logo/update


Remove status  default value, it will be set in the entry resource.

--- src/oc/storage/api/boards.clj
+++ src/oc/storage/api/boards.clj
@@ -92,7 +92,7 @@

 (defn- valid-entry-with-board?
   [conn entry author]
-  (if-let* [status (or (:status entry) "published")
+  (if-let* [status (:status entry)
             entry-uuid (:uuid entry)
             found-entry (entry-res/get-entry conn entry-uuid)]
     (merge found-entry (assoc entry :status status))
@@ -183,7 +183,7 @@
         ;; Add any entries specified in the request
         (doseq [entry entries]
           (let [fixed-entry (-> entry
-                                (assoc :status (or (:status entry) "published"))
+                                (assoc :status (:status entry))
                                 (assoc :board-uuid board-uuid))
                 entry-action (if (entry-res/get-entry conn (:uuid entry))
                                :update


added remove-document, swaps out id on docs atom and fires :document-changed

--- src/app/cljs/one/sample/model.cljs
+++ src/app/cljs/one/sample/model.cljs
@@ -49,6 +49,10 @@
         :get  (let [[key] args]
                 (@doc-state key))))))

+(defn remove-document [id]
+  (swap! docs dissoc id)
+  (dispatch/fire :document-changed id))
+
 (dispatch/react-to #{:storage-updated}
                    (fn [_ _]
                      (.log js/console ":storage-updated")


Focus the first text input

Focus the first text input

--- src/cljs/cglossa/search_inputs/cwb.cljs
+++ src/cljs/cglossa/search_inputs/cwb.cljs
@@ -1,6 +1,7 @@
 (ns cglossa.search-inputs.cwb
   (:require [clojure.string :as str]
-            [reagent.core :as reagent]))
+            [reagent.core :as reagent]
+            [goog.dom :as dom]))

 (def ^:private headword-query-prefix "<headword>")
 (def ^:private headword-query-suffix-more-words "[]{0,}")
@@ -101,6 +102,9 @@
   [:select {:value selected-language}
    (for [language languages]
      [:option {:key (:value language) :value (:value language)} (:text language)])])
+
+(defn- focus-text-input [c]
+  (.focus (dom/findNode (reagent/dom-node c) #(= "text" (.-type %)))))

 (defn- single-input-view
   "HTML that is shared by the search views that only show a single text input,
@@ -180,64 +184,76 @@
   "Component that lets the user select a search view (simple, extended
   or CQP query view) and displays it."
   [{:keys [search-view search-queries]} {:keys [corpus]}]
-  (let [view          (case @search-view
-                        :extended extended
-                        :cqp cqp
-                        simple)
-        languages     (:langs @corpus)
-        multilingual? (> (count languages) 1)
-        set-view      (fn [view e] (reset! search-view view) (.preventDefault e))
-        query-get-set (fn
-                        ([k] (get-in @search-queries k))
-                        ([k v] (let [query (as-> (:query v) $
-                                                 (if (get-in @search-queries [k :headword-search])
-                                                   (->headword-query $)
-                                                   (->non-headword-query $))
-                                                 ;; Simplify the query (".*" is used in the
-                                                 ;; simplified search instead of [])
-                                                 (str/replace $
-                                                              #"\[\(?word=\"\.\*\"(?:\s+%c)?\)?\]"
-                                                              "[]")
-                                                 (str/replace $ #"^\s*\[\]\s*$" ""))]
-                                 (swap! search-queries assoc-in [(first k) :query] query)
-                                 ;; TODO: Handle state.maxHits and state.lastSelectedMaxHits
-                                 )))]
-    [:span
-     [:div.search-input-links
-      (if (= view simple)
-        [:b "Simple"]
-        [:a {:href     ""
-             :title    "Simple search box"
-             :on-click #(set-view :simple %)}
-         "Simple"])
-      " | "
-      (if (= view extended)
-        [:b "Extended"]
-        [:a {:href     ""
-             :title    "Search for grammatical categories etc."
-             :on-click #(set-view :extended %)}
-         "Extended"])
-      " | "
-      (if (= view cqp)
-        [:b "CQP query"]
-        [:a {:href     ""
-             :title    "CQP expressions"
-             :on-click #(set-view :cqp %)}
-         "CQP query"])
-      [search-button multilingual?]
-      (when multilingual? [add-language-button])]
-
-     ; Now create a cursor into the search-queries ratom for each search expression
-     ; and display a row of search inputs for each of them. The doall call is needed
-     ; because ratoms cannot be derefed inside lazy seqs.
-     (let [nqueries         (count @search-queries)
-           show-remove-btn? (> nqueries 1)
-           remove-query     (fn [i] (swap! search-queries
-                                           #(vec (concat (subvec % 0 i) (subvec % (inc i))))))]
-       (doall (for [index (range nqueries)]
-                (let [query-cursor         (reagent/cursor query-get-set [index])
-                      selected-language    (-> @query-cursor :query :lang)
-                      remove-query-handler (partial remove-query index)]
-                  (when multilingual? [language-select languages selected-language])
-                  ^{:key index} [view @corpus query-cursor show-remove-btn? remove-query-handler]))))
-     (when-not multilingual? [add-phrase-button])]))
+  (reagent/create-class
+    {:component-did-mount
+     focus-text-input
+
+     :component-did-update
+     focus-text-input
+
+     :reagent-render
+     (fn [{:keys [search-view search-queries]} {:keys [corpus]}]
+       (let [view          (case @search-view
+                             :extended extended
+                             :cqp cqp
+                             simple)
+             languages     (:langs @corpus)
+             multilingual? (> (count languages) 1)
+             set-view      (fn [view e] (reset! search-view view) (.preventDefault e))
+             query-get-set (fn
+                             ([k] (get-in @search-queries k))
+                             ([k v] (let [query (as-> (:query v) $
+                                                      (if (get-in @search-queries
+                                                                  [k :headword-search])
+                                                        (->headword-query $)
+                                                        (->non-headword-query $))
+                                                      ;; Simplify the query (".*" is used in the
+                                                      ;; simplified search instead of [])
+                                                      (str/replace $
+                                                                   #"\[\(?word=\"\.\*\"(?:\s+%c)?\)?\]"
+                                                                   "[]")
+                                                      (str/replace $ #"^\s*\[\]\s*$" ""))]
+                                      (swap! search-queries assoc-in [(first k) :query] query)
+                                      ;; TODO: Handle state.maxHits and state.lastSelectedMaxHits
+                                      )))]
+         [:span
+          [:div.search-input-links
+           (if (= view simple)
+             [:b "Simple"]
+             [:a {:href     ""
+                  :title    "Simple search box"
+                  :on-click #(set-view :simple %)}
+              "Simple"])
+           " | "
+           (if (= view extended)
+             [:b "Extended"]
+             [:a {:href     ""
+                  :title    "Search for grammatical categories etc."
+                  :on-click #(set-view :extended %)}
+              "Extended"])
+           " | "
+           (if (= view cqp)
+             [:b "CQP query"]
+             [:a {:href     ""
+                  :title    "CQP expressions"
+                  :on-click #(set-view :cqp %)}
+              "CQP query"])
+           [search-button multilingual?]
+           (when multilingual? [add-language-button])]
+
+          ; Now create a cursor into the search-queries ratom for each search expression
+          ; and display a row of search inputs for each of them. The doall call is needed
+          ; because ratoms cannot be derefed inside lazy seqs.
+          (let [nqueries         (count @search-queries)
+                show-remove-btn? (> nqueries 1)
+                remove-query     (fn [i] (swap! search-queries
+                                                #(vec (concat (subvec % 0 i)
+                                                              (subvec % (inc i))))))]
+            (doall (for [index (range nqueries)]
+                     (let [query-cursor         (reagent/cursor query-get-set [index])
+                           selected-language    (-> @query-cursor :query :lang)
+                           remove-query-handler (partial remove-query index)]
+                       (when multilingual? [language-select languages selected-language])
+                       ^{:key index} [view @corpus query-cursor show-remove-btn?
+                                      remove-query-handler]))))
+          (when-not multilingual? [add-phrase-button])]))}))


Added cartesian polygons to the spatial demo.

--- src/cmr/demos/visual_spatial_search.clj
+++ src/cmr/demos/visual_spatial_search.clj
@@ -86,9 +86,13 @@
     (ingest/reset)
     (ingest/create-provider "PROV1")

-    (let [coll (d/ingest "PROV1" (dc/collection {:spatial-coverage (dc/spatial :geodetic)}))]
+    (let [coll-geodetic (d/ingest "PROV1" (dc/collection {:spatial-coverage (dc/spatial :geodetic)}))
+          coll-cartesian (d/ingest "PROV1" (dc/collection {:spatial-coverage (dc/spatial :cartesian)}))]
       (doseq [shape shapes]
-        (d/ingest "PROV1" (dg/granule coll {:spatial-coverage (dg/spatial shape)}))))
+        (let [coll (if (= :cartesian (:coordinate-system shape))
+                     coll-cartesian
+                     coll-geodetic)]
+          (d/ingest "PROV1" (dg/granule coll {:spatial-coverage (dg/spatial shape)})))))
     (index/refresh-elastic-index)

     ;; Save the shapes for display
@@ -116,7 +120,6 @@
         search-area (polygon 0 0, 1 0, 1 1, 0 0)]
     (visual-interactive-search [polygon-with-holes] search-area))

-
   ;; all supported spatial types
   (let [touches-np (m/mbr 45 90 55 70)
         touches-sp (m/mbr -160 -70 -150 -90)
@@ -125,12 +128,12 @@
         normal-br2 (m/mbr -20 0 -10 -10)

         ;; Polygons
-        wide-north (polygon -70 20, 70 20, 70 30, -70 30, -70 20)
-        wide-south (polygon -70 -30, 70 -30, 70 -20, -70 -20, -70 -30)
-        across-am-poly (polygon 170 35, -175 35, -170 45, 175 45, 170 35)
-        on-np (polygon 45 85, 135 85, -135 85, -45 85, 45 85)
-        on-sp (polygon -45 -85, -135 -85, 135 -85, 45 -85, -45 -85)
-        normal-poly (polygon -20 -10, -10 -10, -10 10, -20 10, -20 -10)
+        wide-north (polygon :geodetic -70 20, 70 20, 70 30, -70 30, -70 20)
+        wide-south (polygon :geodetic -70 -30, 70 -30, 70 -20, -70 -20, -70 -30)
+        across-am-poly (polygon :geodetic 170 35, -175 35, -170 45, 175 45, 170 35)
+        on-np (polygon :geodetic 45 85, 135 85, -135 85, -45 85, 45 85)
+        on-sp (polygon :geodetic -45 -85, -135 -85, 135 -85, 45 -85, -45 -85)
+        normal-poly (polygon :geodetic -20 -10, -10 -10, -10 10, -20 10, -20 -10)

         ;; polygon with holes
         outer (rr/ords->ring :geodetic -5.26,-2.59, 11.56,-2.77, 10.47,8.71, -5.86,8.63, -5.26,-2.59)
@@ -138,18 +141,25 @@
         hole2 (rr/ords->ring :geodetic 5.18,6.92, -1.79,7.01, -2.65,5, 4.29,5.05, 5.18,6.92)
         polygon-with-holes (poly/polygon :geodetic [outer hole1 hole2])

+        ;; Cartesian Polygons
+        wide-north-cart (polygon :cartesian -70 20, 70 20, 70 30, -70 30, -70 20)
+        wide-south-cart (polygon :cartesian -70 -30, 70 -30, 70 -20, -70 -20, -70 -30)
+        very-wide-cart (polygon :cartesian -179 40, -179 35, 179 35, 179 40, -179 40)
+        very-tall-cart (polygon :cartesian -160 90, -160 -90, -150 -90, -150 90, -160 90)
+        ;very-tall-cart (polygon :cartesian -160 89, -160 -89, -150 -89, -150 89, -160 89)
+
         ;; points
         north-pole (p/point 90 0)
         south-pole (p/point -90 0)
         normal-point (p/point 10 22)
         am-point (p/point 180 22)

-        ; search-area (assoc (polygon -6.45,-3.74,12.34,-4.18,12,9.45,-6.69,9.2,-6.45,-3.74)
-        ;                    :options {:id "polygon"})
+        ;search-area (assoc (polygon :geodetic -6.45,-3.74,12.34,-4.18,12,9.45,-6.69,9.2,-6.45,-3.74)
+        ;                   :options {:id "polygon"})

-        ;search-area (assoc (m/mbr -23.43 5 25.54 -6.31) :options {:id "bounding_box"})
+        search-area (assoc (m/mbr -23.43 5 25.54 -6.31) :options {:id "bounding_box"})

-        search-area (assoc (p/point 0 0) :options {:id "point"})
+        ;search-area (assoc (p/point 0 0) :options {:id "point"})

         ]
     (visual-interactive-search [touches-sp
@@ -164,6 +174,10 @@
                                 on-sp
                                 normal-poly
                                 polygon-with-holes
+                                wide-north-cart
+                                wide-south-cart
+                                very-wide-cart
+                                very-tall-cart
                                 north-pole
                                 south-pole
                                 normal-point


Fixing failing tests due to spatial issue.

--- src/cmr/umm/test/generators/spatial.clj
+++ src/cmr/umm/test/generators/spatial.clj
@@ -3,6 +3,7 @@
             [clojure.test.check.generators :as gen]
             [cmr.common.test.test-check-ext :as ext-gen :refer [optional]]
             [cmr.spatial.polygon :as poly]
+            [cmr.spatial.line-string :as l]
             [cmr.umm.spatial :as umm-s]))

 (def generic-rings
@@ -14,10 +15,14 @@

 (def polygons
   "Generates polygons that are not valid but could be used for testing where validity is not important"
-  (gen/fmap (partial apply poly/polygon)
-            (gen/tuple (gen/vector generic-rings 1 4))))
+  (gen/fmap poly/polygon
+            (gen/vector generic-rings 1 4)))
+
+(def lines
+  (gen/fmap l/line-string
+            (gen/bind (gen/choose 2 6) sgen/non-antipodal-points)))

 (def geometries
   "A generator returning individual points, bounding rectangles, lines, and polygons.
   The spatial areas generated will not necessarily be valid."
-  (gen/one-of [sgen/points sgen/mbrs sgen/lines polygons]))+  (gen/one-of [sgen/points sgen/mbrs lines polygons]))


Implemented (completed untested) planar convolution and max pooling

--- src/cortex/impl/layers/convolution.cljc
+++ src/cortex/impl/layers/convolution.cljc
@@ -73,517 +73,162 @@
                      padx pady stride-w stride-h num-kernels
                      num-channels))

-
-
-(defn planar-input->convolution
+(defmacro convolution-outer-kernel
+  [config & body]
+  `(let [^ConvLayerConfig config# ~config
+         ~'output-width (output-width config#)
+         ~'output-height (output-height config#)
+         ~'num-channels (.num-channels config#)
+         ~'num-kernels (.num-kernels config#)
+         ~'input-planar-stride (* (.width config#) (.height config#))
+         ~'output-planar-stride (* output-width output-height ~'num-kernels)
+         ~'output-channel-stride (* (.k-width config#) (.k-height config#))
+         ~'output-column-stride (* ~'output-channel-stride ~'num-channels)
+         ~'width (.width config#)
+         ~'height (.height config#)
+         ~'k-width (.k-width config#)
+         ~'k-height (.k-height config#)
+         ~'stride-h (.stride-h config#)
+         ~'stride-w (.stride-w config#)
+         ~'padx (.padx config#)
+         ~'pady (.pady config#)]
+     (c-for
+      [~'chan 0 (< ~'chan ~'num-channels) (inc ~'chan)]
+      (let [~'chan-input-offset (* ~'chan ~'input-planar-stride)
+            ~'chan-output-offset (* ~'chan ~'output-planar-stride)]
+       (c-for
+        [~'out-y 0 (< ~'out-y ~'output-height) (inc ~'out-y)]
+        (let [~'input-rel-y (- (* ~'out-y ~'stride-h) ~'pady)]
+          (c-for
+           [~'out-x 0 (< ~'out-x ~'output-width) (inc ~'out-x)]
+           (let [~'input-rel-x (- (* ~'out-x ~'stride-w) ~'padx)]
+             ~@body))))))))
+
+
+(defmacro convolution-roll-unroll-inner-kernel
+  [& body]
+  `(let [~'chan-conv-offset (* ~'chan ~'output-channel-stride)]
+    (c-for
+     [~'k-y 0 (< ~'k-y ~'k-height) (inc ~'k-y)]
+     (c-for
+      [~'k-x 0 (< ~'k-x ~'k-width) (inc ~'k-x)]
+      (let [~'input-x (+ ~'input-rel-x ~'k-x)
+            ~'input-y (+ ~'input-rel-y ~'k-y)
+            ~'output-conv-addr (+ (* ~'out-y ~'out-x ~'output-column-stride)
+                                  ~'chan-conv-offset
+                                  (* ~'k-y ~'k-width)
+                                  ~'k-x)
+            ~'input-addr  (+ (* ~'input-y ~'width)
+                             ~'input-x
+                             ~'chan-input-offset)
+            ~'input-valid? (and (> ~'input-x 0)
+                                (<= ~'input-x ~'width)
+                                (> ~'input-y 0)
+                                (<= ~'input-y ~'height))]
+        ~@body)))))
+
+
+
+(defn planar-input->convolution!
   [input output ^ConvLayerConfig config]
   (let [^doubles input-ary (mp/as-double-array input)
-        ^doubles output-ary (mp/as-double-array output)
+        ^doubles output-ary (mp/as-double-array output)]
+    (convolution-outer-kernel
+     config
+     (convolution-roll-unroll-inner-kernel
+      (let [input-val (double (if input-valid?
+                                (aget input-ary input-addr)
+                                0.0))]
+        (aset output-ary output-conv-addr input-val)))))
+  output)
+
+
+(defn convolution->planar-output!
+  "Sum the convolution up to the planar input."
+  [conv-input-gradient input-gradient ^ConvLayerConfig config]
+  ;;I am using input to mean upstream or in this case destination so that
+  ;;this code can look as similar to the code above as possible
+  (let [^doubles input-ary (mp/as-double-array input-gradient)
+        ^doubles output-ary (mp/as-double-array conv-input-gradient)]
+    ;;Zero accumulator
+    (m/fill! input-gradient 0.0)
+    (convolution-outer-kernel
+     config
+     (convolution-roll-unroll-inner-kernel
+      (when input-valid?
+        (let [input-val (aget input-ary input-addr)
+              output-val (aget output-ary output-conv-addr)]
+          (aset input-ary input-addr (+ input-val output-val)))))))
+  input-gradient)
+
+
+(defn create-convolution-matrix
+  [^ConvLayerConfig config]
+  (let [output-width (output-width config)
+        output-height (output-height config)
+        kernel-stride (* (.k-width config) (.k-height config))
+        n-cols (* kernel-stride (.num-channels config))
+        n-rows (* output-width output-height)]
+    (b/new-array [n-rows n-cols])))
+
+
+(defn planar-convolution-forward!
+  [layer input]
+  (let [weights (:weights layer)
+        bias (:bias layer)
+        ^ConvLayerConfig config (:conv-config layer)
+        conv-matrix (or (:conv-matrix layer)
+                        (create-convolution-matrix config))
         output-width (output-width config)
         output-height (output-height config)
-        num-channels (.num-channels config)
-        input-planar-stride (* (.width config) (.height config))
-        output-channel-stride (* (.k-width config) (.k-height config))
-        output-column-stride (* output-channel-stride num-channels)
-        width (.width config)
-        height (.height config)
-        k-width (.k-width config)
-        k-height (.k-height config)
-        stride-h (.stride-h config)
-        stride-w (.stride-w config)
-        padx (.padx config)
-        pady (.pady config)]
-    (c-for
-     [out-h 0 (< out-h output-height) (inc out-h)]
-     (let [input-rel-y (- (* out-h stride-h) pady)]
-      (c-for
-       [out-w 0 (< out-w output-width) (inc out-w)]
-       (let [input-rel-x (- (* out-w stride-w) padx)]
-        (c-for
-         [chan 0 (< chan num-channels) (inc chan)]
-         (let [chan-input-offset (* chan input-planar-stride)
-               chan-output-offset (* chan output-channel-stride)]
-          (c-for
-           [k-y 0 (< k-y k-height) (inc k-y)]
-           (c-for
-            [k-x 0 (< k-x k-width) (inc k-x)]
-            (let [input-x (+ input-rel-x k-x)
-                  input-y (+ input-rel-y k-y)
-                  input-val (double (if (and (> input-x 0)
-                                             (<= input-x width)
-                                             (> input-y 0)
-                                             (<= input-y height))
-                                      (let [addr (+ (* input-y width)
-                                                    input-x
-                                                    chan-input-offset)]
-                                        (aget input-ary addr)
-                                        0.0)))
-                  output-addr (+ (* out-h out-w output-column-stride)
-                                 chan-output-offset
-                                 (* k-y k-width)
-                                 k-x)]
-              (aset output-ary output-addr input-val)))))))))))
-  output)
-
-(defn columnar-sum
-  "Sum the columns of the matrix so we produce in essence a new row
-which contains the columnar sums.  Produces a vector and leaves input unchanged"
-  [m]
-  (let [rows (m/rows m)
-        accumulator (m/clone (first rows))]
-    (reduce m/add! accumulator (rest rows))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Convolution layer forward pass utility functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn create-padded-matrix
-  "We need to force vectorz to create a dense matrix.  Hence the superfluous lines"
-  [{:keys [^long width ^long height ^long padx ^long pady
-           ^long num-channels] :as conv-layer-config}]
-  (m/array :vectorz (repeat (+ height (* 2 pady))
-                            (repeat (* (+ width (* 2 padx))
-                                       num-channels)
-                                    0.0))))
-
-
-(defn sub-vector-assignment!
-  [padx pady image-width num-channels backing-matrix input-vector]
-  (let [^long padx padx
-        ^long pady pady
-        ^long image-width image-width
-        ^long num-channels num-channels
-        input-row-stride (* image-width num-channels)
-        input-row-count (quot (long (first (m/shape input-vector))) input-row-stride)]
-    (loop [row 0]
-      (when (< row input-row-count)
-        (let [backing-row-idx (+ pady row)
-              backing-row (m/get-row backing-matrix backing-row-idx)
-              input-row (m/subvector input-vector (* row input-row-stride) input-row-stride)
-              backing-row (m/subvector backing-row (* padx num-channels) input-row-stride)]
-          (m/assign! backing-row input-row))
-        (recur (inc row))))))
-
-
-(defn create-padded-input-matrix
-  "Remove padding from the equation by creating an input vector that includes it
-and then copying the input data (if necessary) into the input vector.  Note this operation
-is done for every input *and* it is done for the max pooling layers.  If you want to avoid
-the perf hit of a copy then don't use padding."
-  [interleaved-input-vector {:keys [^long width ^long height ^long padx ^long pady
-                                    ^long num-channels] :as conv-layer-config}]
-  (let [has-padding (or (> padx 0) (> pady 0))]
-    (if has-padding
-      (let [padded-input-matrix (create-padded-matrix conv-layer-config)]
-        (sub-vector-assignment! padx pady width num-channels padded-input-matrix interleaved-input-vector)
-        padded-input-matrix)
-      (m/reshape interleaved-input-vector [height (* width num-channels)]))))
-
-
-(def convolution-operation-sequence
-  (memoize
-   (fn [{:keys [^long width ^long height
-                ^long k-width ^long k-height
-                ^long padx ^long pady
-                ^long stride-w ^long stride-h
-                ^long num-channels] :as conv-layer-config}]
-     (let [output-width (get-padded-strided-dimension width padx k-width stride-w)
-           output-height (get-padded-strided-dimension height pady k-height stride-w)
-           ;;A 'row' for each output pixel
-           num-rows (* output-width output-height)]
-       (flatten
-        (for [^long idx (range num-rows)]
-          (let [output-x (rem idx output-width)
-                output-y (quot idx output-width)
-                input-left (- (* output-x stride-w) padx)
-                input-top (- (* output-y stride-h) pady)]
-            (for [^long conv-y (range k-height)]
-              (let [input-y (+ input-top conv-y)
-                    input-x input-left]
-                {:input-x input-x :input-y input-y :conv-x 0 :conv-y conv-y
-                 :output-x output-x :output-y output-y})))))))))
-
-
-(def convolution-input-sequence
-  (memoize
-   (fn [{:keys [^long width ^long height
-                ^long k-width ^long k-height
-                ^long padx ^long pady
-                ^long stride-w ^long stride-h
-                ^long num-channels] :as conv-layer-config}]
-     ;;Trim out rows that are completely invalid w/r/t the input non-padded matrix
-     (let [valid-rows (filter #(let [{:keys [^long input-y ^long input-x]} %]
-                                 (and (>= input-y 0)
-                                      (< input-y height)
-                                      (>= (+ input-x k-width) 0)
-                                      (< input-x width)))
-                              (convolution-operation-sequence conv-layer-config))
-           output-width (get-padded-strided-dimension width padx k-width stride-w)
-           output-height (get-padded-strided-dimension height pady k-height stride-w)]
-       ;;Transform each entry such that the x-op stays in bounds.  Also, change output-x,output-y
-       ;;into an output-row-index that indicates which row in the convolution matrix this item corresponds to.
-       (map (fn [{:keys [^long input-x ^long input-y ^long conv-x ^long conv-y ^long output-x ^long output-y]
-                  :as conv-window}]
-              (let [input-offset-x (max input-x 0)
-                    conv-x (- input-offset-x input-x)
-                    k-width (- k-width conv-x)
-                    input-end (min width (+ input-offset-x k-width))
-                    write-len (- input-end input-offset-x)
-                    conv-row-index (+ (* output-y output-width) output-x)]
-                (assoc conv-window :conv-x conv-x :input-x input-offset-x
-                       :write-len write-len :conv-row-index conv-row-index)))
-            valid-rows)))))
-
-
-(defn convolution-to-input-vector!
-  [conv-matrix input-vector {:keys [^long width ^long height
-                                    ^long k-width ^long k-height
-                                    ^long padx ^long pady
-                                    ^long stride-w ^long stride-h
-                                    ^long num-channels] :as conv-layer-config}]
-  (let [kernel-stride (* k-width num-channels)
-        input-stride (* width num-channels)]
-    (doseq [input-item (convolution-input-sequence conv-layer-config)]
-      (let [{:keys [^long input-x ^long input-y
-                    ^long conv-x ^long conv-y
-                    ^long write-len ^long conv-row-index]} input-item
-            input-row (m/get-row conv-matrix conv-row-index)
-            write-idx 0
-            conv-offset (+ (* conv-y kernel-stride)
-                           (* (+ conv-x write-idx) num-channels))
-            input-offset (+ (* input-y input-stride)
-                            (* (+ input-x write-idx) num-channels))
-            write-num-elems (* write-len num-channels)]
-        (m/add! (m/subvector input-vector input-offset write-num-elems)
-                (m/subvector input-row conv-offset write-num-elems))))
-    input-vector))
-
-
-(defn input-vector-to-convolution!
-  [input-vector conv-matrix {:keys [^long width ^long height
-                                    ^long k-width ^long k-height
-                                    ^long padx ^long pady
-                                    ^long stride-w ^long stride-h
-                                    ^long num-channels] :as conv-layer-config}]
-  (let [kernel-stride (* k-width num-channels)
-        input-stride (* width num-channels)
-        num-rows (m/row-count conv-matrix)]
-    (doseq [input-item (convolution-input-sequence conv-layer-config)]
-      (let [{:keys [^long input-x ^long input-y
-                    ^long conv-x ^long conv-y
-                    ^long write-len ^long conv-row-index]} input-item
-            conv-row (m/get-row conv-matrix conv-row-index)
-            write-idx 0
-            conv-offset (+ (* conv-y kernel-stride)
-                           (* (+ conv-x write-idx) num-channels))
-            input-offset (+ (* input-y input-stride)
-                            (* (+ input-x write-idx) num-channels))
-            write-num-elems (* write-len num-channels)]
-        (m/assign! (m/subvector conv-row conv-offset write-num-elems)
-                   (m/subvector input-vector input-offset write-num-elems))))
-    conv-matrix))
-
-
-(defn convolution-sequence
-  "Produce a sequence of views that performs a convolution over an input matrix"
-  [input-matrix output-width output-height {:keys [^long k-width ^long k-height
-                                                   ^long stride-w ^long stride-h
-                                                   ^long num-channels]
-                                            :as conv-layer-config}]
-  (let [kernel-stride (* k-width num-channels)]
-    (for [^long output-y (range output-height)
-          ^long output-x (range output-width)]
-      (m/as-vector (m/submatrix input-matrix [[(* output-y stride-h) k-height]
-                                              [(* output-x stride-w num-channels) kernel-stride]])))))
-
-
-(defn create-convolution-rows
-  "Given an image flattened into an interleaved vector
-create a sequence where each item is the input to the convolution filter row
-meaning the convolution is just a dotproduct across the rows.
-Should be output-width*output-height rows.  Padding is applied as zeros across channels."
-  [interleaved-input-vector {:keys [^long width ^long height ^long k-width ^long k-height
-                                    ^long padx ^long pady ^long stride-w ^long stride-h
-                                    ^long num-channels] :as conv-layer-config }]
-  (let [input-matrix (create-padded-input-matrix interleaved-input-vector
-                                                 conv-layer-config)
-        output-width (get-padded-strided-dimension width padx k-width stride-w)
-        output-height (get-padded-strided-dimension height pady k-height stride-h)
-        input-mat-stride (* (+ width (* 2 padx)) num-channels)
-        kernel-stride (* k-width num-channels)]
-    ;;I go ahead and create a contiguous matrix here because we will iterate over this many times
-    (convolution-sequence input-matrix output-width output-height
-                          conv-layer-config)))
-
-(defn get-gradient-convolution-sequence
-  "returns [conv-sequence input-mat-view] for the backpass steps of nn layers
-using convolutional steps"
-  [{:keys [^long width ^long height ^long k-width ^long k-height
-           ^long padx ^long pady ^long stride-w ^long stride-h
-           ^long num-channels] :as conv-layer-config}]
-  (let [input-matrix (create-padded-matrix conv-layer-config)
-        input-mat-view (m/submatrix input-matrix
-                                    [[pady height]
-                                     [(* padx num-channels) (* width num-channels)]])
-        output-width (get-padded-strided-dimension width padx k-width stride-w)
-        output-height (get-padded-strided-dimension height pady k-height stride-h)
-        kernel-stride (* k-width num-channels)]
-    [(convolution-sequence input-matrix output-width output-height
-                           conv-layer-config)
-     input-mat-view
-     input-matrix]))
-
-
-(defn core-matrix-unroll-input!
-  [this input]
-  (let [conv-layer-config (:conv-layer-config this)
-        input-data (or (:input-data this)
-                       (let [[conv-rows input-view padded-backing-matrix]
-                             (get-gradient-convolution-sequence conv-layer-config)]
-                         [(into [] conv-rows) (m/as-vector input-view) padded-backing-matrix]))
-        [conv-rows input-view padded-backing-matrix] input-data
-
-        ;;If there is any padding, then we have to clear the backing matrix
-        _ (when-not (= (m/shape input) (m/shape (m/as-vector padded-backing-matrix)))
-            (m/scale! padded-backing-matrix 0.0))
-        _ (m/assign! input-view input)
-        packed-conv-matrix  (if-let [conv-matrix (:packed-conv-matrix this)]
-                              (let [packed-rows (vec (m/rows conv-matrix))
-                                    row-count (count packed-rows)]
-                                (loop [row-idx 0]
-                                  (when (< row-idx row-count)
-                                    (m/assign! (packed-rows row-idx) (conv-rows row-idx))
-                                    (recur (inc row-idx))))
-                                conv-matrix)
-                              (b/array (seq conv-rows)))]
-    (assoc this :input-data input-data
-           :packed-conv-matrix packed-conv-matrix)))
-
-#?(:cljs (defn unroll-input!
-           [this input]
-           (core-matrix-unroll-input! this input)))
-
-#?(:clj (defn unroll-input!
-          [this input]
-          (let [conv-layer-config (:conv-layer-config this)
-                input-data (or (:input-data this)
-                               (let [[conv-rows input-view padded-backing-matrix]
-                                     (get-gradient-convolution-sequence conv-layer-config)]
-                                 [(into [] conv-rows) (m/as-vector input-view)
-                                  padded-backing-matrix]))
-                [conv-rows input-view padded-backing-matrix] input-data
-
-                packed-conv-matrix (or (:packed-conv-matrix this)
-                                       (b/new-array [(count conv-rows)
-                                                     (m/ecount (first conv-rows))]))
-                {:keys [^long width ^long height
-                        ^long k-width ^long k-height
-                        ^long padx ^long pady
-                        ^long stride-w ^long stride-h
-                        ^long num-channels]} conv-layer-config
-                input-ary (mp/as-double-array input)
-                packed-ary (mp/as-double-array packed-conv-matrix)
-                this (assoc this
-                            :input-data input-data
-                            :packed-conv-matrix packed-conv-matrix)]
-            (if (and input-ary packed-ary)
-              (do
-               (ConvOps/unrollInput width height k-width k-height
-                                    padx pady stride-w stride-h
-                                    num-channels input-ary packed-ary)
-               this)
-              (core-matrix-unroll-input! this input)))))
-
-
-(defn convolution-forward!
-  [this weights bias packed-unrolled-input]
-  (if (and (blas/supports-blas? weights)
-           (blas/supports-blas? packed-unrolled-input))
-    (let [output (or (:output-mat this)
-                     (b/new-array [(m/row-count packed-unrolled-input)
-                                   (m/row-count weights)]))]
-      (m/assign! output bias)
-      (blas/gemm! output false true 1.0
-                  packed-unrolled-input weights
-                  1.0)
-      (assoc this :output-mat output
-             :output (m/as-vector output)))
-    (let [weights-t (m/transpose weights)
-          output (m/inner-product packed-unrolled-input weights-t)]
-      (m/add! output bias)
-      (assoc this :output (m/as-vector output)))))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Convolution backward pass utility functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defn convolution-copying-roll
-  [packed-gradient gradient-view-rows gradient-view]
-  (doall (map m/assign! gradient-view-rows packed-gradient))
-  (m/array :vectorz (m/as-vector gradient-view)))
-
-(defn non-blas-convolution-backward!
-  [weights bias input output-gradient {:keys [conv-layer-config] :as this}]
-  (let [packed-conv-matrix (:packed-conv-matrix this)
-        [conv-rows input-view padded-backing-matrix] (:input-data this)
-        input-gradient (or (:input-gradient this)
-                           (b/array (repeat (first (m/shape input)) 0.0)))
-        ;;Note that at this point packed-conv-matrix holds the input exploded into convolutions
-        ;;We are going to use the padded backing matrix as an accumulator
-        _ (m/scale! padded-backing-matrix 0.0)
-        ;;the backward pass is optimized to only minimally access conv-rows.
-        ;;This is because they
-        ;;are views of views (m/as-vector (m/submatrix ...)) which implies a significant
-        ;;performance hit at this time.
-        {:keys [^long width ^long height
-                ^long k-width ^long k-height
-                ^long padx ^long pady
-                ^long stride-w ^long stride-h
-                ^long num-channels]}  conv-layer-config
-        ;;We use an accumulator here because the input-gradient-conv-sequence
-        ;;could be a set of view-on-views or some other deep abstraction.
-        ;;Using an accumulator is a significant performance helper during the tight
-        ;;per-kernel gradient accumulation
-        ^long kernel-count (first (m/shape weights))
-        output-row-count (quot (long (first (m/shape output-gradient))) kernel-count)
-        accum (b/zero-array [(* k-width k-height num-channels)])
-        weight-gradient (or (:weight-gradient this)
+        output-stride (* output-width (.num-kernels config))
+        output (or (:output layer)
+                   (b/new-array [output-height output-stride]))]
+    (planar-input->convolution! input conv-matrix config)
+    (m/assign! output bias)
+    (if (blas/supports-blas? weights)
+      (blas/gemm! output false true 1.0 weights conv-matrix 1.0)
+      (m/add! output (m/inner-product weights (m/transpose conv-matrix))))
+    (assoc layer :conv-matrix conv-matrix :output output)))
+
+
+(defn planar-convolution-backward!
+  [layer input output-gradient]
+  (let [weights (:weights layer)
+        bias (:bias layer)
+        ^ConvLayerConfig config (:conv-config layer)
+        output-width (output-width config)
+        output-height (output-height config)
+        n-output (* output-width output-height)
+        n-kernels (.num-kernels config)
+        conv-matrix (:conv-matrix layer)
+        weight-gradient (or (:weight-gradient layer)
                             (b/new-array (m/shape weights)))
-        bias-gradient (or (:bias-gradient this)
-                          (b/new-array [kernel-count]))]
-    (loop [idx 0]
-      (when (< idx output-row-count)
-        (let [input-gradient-row (m/get-row conv-rows idx)
-              input-row (m/get-row packed-conv-matrix idx)]
-          (m/assign! accum input-gradient-row)
-          (loop [kern-idx 0]
-            (when (< kern-idx kernel-count)
-              (let [weight-row (m/get-row weights kern-idx)
-                    weight-gradient-row (m/get-row weight-gradient kern-idx)
-                    output-gradient-offset (+ (* idx kernel-count)
-                                              kern-idx)
-                    ^double gradient (m/mget output-gradient output-gradient-offset)
-                    ^double bias-gradient-val (m/mget bias-gradient kern-idx)]
-                (m/add-scaled! accum weight-row gradient)
-                (m/add-scaled! weight-gradient-row input-row gradient)
-                (m/mset! bias-gradient kern-idx (+ gradient bias-gradient-val)))
-              (recur (inc kern-idx))))
-          (m/assign! input-gradient-row accum))
-        (recur (inc idx))))
-    (m/assign! input-gradient (m/as-vector input-view))
-    (assoc this
-           :input-gradient input-gradient
+        bias-gradient (or (:bias-gradient layer)
+                          (b/new-array (m/shape bias)))
+        output-gradient-matrix (or (:output-gradient-matrix layer)
+                                   (b/new-array [n-kernels n-output]))
+        input-gradient (or (:input-gradient layer)
+                           (b/new-array (m/shape input)))]
+    (m/assign! (m/as-vector output-gradient-matrix) output-gradient)
+    (m/add! bias-gradient output-gradient)
+    ;;conv-matrix is assumed to hold the actual input
+    (if (blas/supports-blas? weights)
+      (do
+        (blas/gemm! weight-gradient false false 1.0 output-gradient-matrix conv-matrix 1.0)
+        (blas/gemm! conv-matrix true false 1.0 output-gradient-matrix weights 0.0))
+      (do
+        (m/add! weight-gradient (m/inner-product output-gradient-matrix conv-matrix))
+        (m/assign! conv-matrix (m/inner-product (m/transpose output-gradient-matrix) weights))))
+    (convolution->planar-output! conv-matrix input-gradient config)
+    (assoc layer
            :weight-gradient weight-gradient
-           :bias-gradient bias-gradient)))
-
-(defn core-matrix-roll-input-gradient!
-  [this input-gradient packed-conv-matrix]
-  (let [input-data (:input-data this)
-        [conv-rows input-view padded-backing-matrix] input-data]
-    ;;Summation into the input gradient.  This *cannot* be parallelized at all at the moment,
-    ;;probably some perf loss.  What you don't see is that conv rows are views into the padded
-    ;;backing matrix.  In essence we are rolling back up the unrolled input
-    (m/mset! padded-backing-matrix 0.0)
-    (let [row-count (m/row-count packed-conv-matrix)
-          packed-conv-matrix packed-conv-matrix]
-      (loop [row-idx 0]
-        (when (< row-idx row-count)
-          (let [input-row (m/get-row packed-conv-matrix row-idx)
-                output-row (conv-rows row-idx)]
-            (m/add! output-row input-row))
-          (recur (inc row-idx)))))
-    ;;This assignment is a nop in the case where input-gradient is input view
-    (m/assign! input-gradient input-view)
-    this))
-
-#?(:cljs (defn roll-input-gradient!
-           [this input-gradient packed-conv-matrix]
-           (core-matrix-roll-input-gradient! this input-gradient packed-conv-matrix)))
-
-#?(:clj (defn roll-input-gradient!
-          [this input-gradient packed-conv-matrix]
-          (let [gradient-ary (mp/as-double-array input-gradient)
-                packed-ary (mp/as-double-array packed-conv-matrix)
-                conv-layer-config (:conv-layer-config this)
-                {:keys [^long width ^long height
-                        ^long k-width ^long k-height
-                        ^long padx ^long pady
-                        ^long stride-w ^long stride-h
-                        ^long num-channels]} conv-layer-config]
-            (if (and gradient-ary packed-ary)
-              (do
-                (java.util.Arrays/fill ^doubles gradient-ary 0.0)
-                (ConvOps/rollInput width height k-width k-height padx pady
-                                   stride-w stride-h num-channels
-                                   gradient-ary packed-ary)
-                this)
-              (core-matrix-roll-input-gradient! this input-gradient packed-conv-matrix)))))
-
-
-(defn blas-convolution-backward!
-  [weights bias input output-gradient {:keys [conv-layer-config] :as this}]
-  (let [input-data (:input-data this)
-        [conv-rows input-view padded-backing-matrix] input-data
-        packed-input-matrix (:packed-conv-matrix this)
-        {:keys  [^long width ^long height ^long k-width ^long k-height
-                 ^long padx ^long pady ^long stride-w ^long stride-h
-                 ^long num-channels]} conv-layer-config
-        output-width (get-padded-strided-dimension width padx k-width stride-w)
-        output-height (get-padded-strided-dimension height pady k-height stride-w)
-        n-kernels (m/row-count weights)
-        n-output-pixels (* output-height output-width)
-
-        output-gradient-matrix (or (:output-gradient-matrix this)
-                                   (b/new-array [n-output-pixels n-kernels]))
-
-        input-stride (* k-width k-height num-channels)
-        ;;Note that in the non-padded case there is no need to have separate
-        ;;input-view and input-gradient objects.  The gradient we pass upstream
-        ;;does need to be dense, however.
-        input-gradient (or (:input-gradient this)
-                           (b/new-array (m/shape input)))
-        weight-gradient (or (:weight-gradient this)
-                            (b/new-array (m/shape weights)))
-        bias-gradient (or (:bias-gradient this)
-                          (b/new-array [n-kernels]))
-        vector-of-ones (or (:vector-of-ones this)
-                           (b/array (repeat n-output-pixels 1.0)))]
-    (m/assign! (m/as-vector output-gradient-matrix) output-gradient)
-
-    (blas/gemm! weight-gradient true false 1.0 output-gradient-matrix packed-input-matrix
-                1.0)
-    (blas/gemm! packed-input-matrix false false 1.0 output-gradient-matrix weights
-                0.0)
-    (blas/gemv! bias-gradient true 1.0 output-gradient-matrix vector-of-ones
-                1.0)
-
-    (assoc (roll-input-gradient! this input-gradient packed-input-matrix)
+           :bias-gradient bias-gradient
            :output-gradient-matrix output-gradient-matrix
-           :input-gradient input-gradient
-           :bias-gradient bias-gradient
-           :weight-gradient weight-gradient
-           :vector-of-ones vector-of-ones)))
-
-(defn convolution-backward!
-  ([this input output-gradient]
-   (let [weights (:weights this)
-         packed-conv-matrix (:packed-conv-matrix this)
-         bias (:bias this)]
-    (if (and (blas/supports-blas? (:packed-conv-matrix this))
-             (blas/supports-blas? weights)
-             (blas/supports-blas? bias))
-      (blas-convolution-backward! weights bias input output-gradient this)
-      (non-blas-convolution-backward! weights bias input output-gradient this)))))
-
-
-
-;; Explanation of the the conv-layer algorithm:
-;;
-;; Forward: Take the input which is expected to be a single interleaved vector of data
+           :input-gradient input-gradient)))
+
+
+;; Forward: Take the input which is expected to be a single vector of data
 ;; and create a matrix that contains a row for each convolution.  So for example if you have
 ;; 2x2 kernels and you have a 3x3 matrix of monotonically incrementing indexes we produce
 ;; a new matrix
@@ -605,14 +250,6 @@
 ;; uses so each convolution kernel has a row of weights and a bias entry in the bias
 ;; vector.
 ;;
-;; This means the convolution step is:
-;; (m/matrix-multiply convolved-rows (m/transpose weights))
-;; The result is an interleaved matrix that looks like:
-;; [[cr1k1 cr1k2 cr1k3 cr1k4] (repeats for num convolved rows...)].
-;; Note that simply calling as-vector means our output is in the exact same format
-;; as our input where each convolution kernel output plane is interleaved.  It also means
-;; we can use our linear layer with no changes directly after a convolution layer.
-;;

 #?(:cljs (register-module cortex.impl.layers.Convolutional))
@@ -620,22 +257,20 @@
                           conv-layer-config]
     cp/PModule
     (cp/calc [this input]
-      (let [this (unroll-input! this input)
-            packed-conv-matrix (:packed-conv-matrix this)]
-        (convolution-forward! this weights bias packed-conv-matrix)))
+      (planar-convolution-forward! this input))

     (cp/output [m]
-      (:output m))
+      (m/as-vector (:output m)))

     cp/PNeuralTraining
     (forward [this input]
       (cp/calc this input))

     (backward [this input output-gradient]
-      (convolution-backward! this input output-gradient))
+      (planar-convolution-backward! this input output-gradient))

     (input-gradient [this]
-      (:input-gradient this))
+      (m/as-vector (:input-gradient this)))

     cp/PParameters
     (parameters [this]
@@ -653,124 +288,71 @@
       (m/join (m/as-vector (:weight-gradient this)) (m/as-vector (:bias-gradient this)))))

-(defn max-pooling-forward-default!
-  "The forward pass writes to two things; output and output-indexes.  The indexes
-record which item from the input row we actually looked at.  Returns
-[output output-indexes].  Note that this does not change the number of channels
-so it needs to remember the max per-channel."
-  [input output output-indexes
-   {:keys [^long height ^long width
-           ^long padx ^long pady
-           ^long k-width ^long k-height
-           ^long stride-w ^long stride-h
-           ^long num-channels] :as conv-layer-config}]
-  ;;Each input row has k-width*num-channels*k-height in it.
-  ;;Each output index gets num-channels written to it.
-  (let [conv-sequence (convolution-operation-sequence conv-layer-config)
-        height (long height)
-        width (long width)
-        padx (long padx)
-        pady (long pady)
-        k-width (long k-width)
-        k-height (long k-height)
-        stride-w (long stride-w)
-        stride-h (long stride-h)
-        num-channels (long num-channels)
-        output-width (get-padded-strided-dimension width padx k-width stride-w)]
-    (doseq [conv-item conv-sequence]
-      (let [{:keys [^long input-x ^long input-y ^long conv-x ^long conv-y
-                    ^long output-x ^long output-y]} conv-item
-            input-x (long input-x)
-            input-y (long input-y)
-            conv-x (long conv-x)
-            conv-y (long conv-y)
-            output-x (long output-x)
-            output-y (long output-y)
-            output-offset (* num-channels (+ (* output-y output-width) output-x))]
-        (loop [conv-x conv-x]
-          (when (< conv-x k-width)
-            (let [input-offset-x (+ input-x conv-x)
-                  valid-input? (and (>= input-y 0)
-                                    (< input-y height)
-                                    (>= input-offset-x 0)
-                                    (< input-offset-x width))
-                  kernel-index (+ (* conv-y k-width) conv-x)
-                  input-offset (* num-channels (+ (* input-y width) input-offset-x))]
-              (loop [chan 0]
-                (when (< chan num-channels)
-                  (let [input-val (double (if valid-input?
-                                            (m/mget input (+ input-offset chan))
-                                            0.0))
-                        output-offset (+ output-offset chan)
-                        existing-value (double (m/mget output output-offset))]
-                    (when (or (= kernel-index 0)
-                              (> input-val existing-value))
-                      (m/mset! output output-offset input-val)
-                      (m/mset! output-indexes output-offset kernel-index)))
-                  (recur (inc chan)))))
-            (recur (inc conv-x))))))
-    [output output-indexes]))
-
-
-#?(:cljs(defn max-pooling-forward!
-          [input output output-indexes conv-config]
-          (max-pooling-forward-default! input output output-indexes conv-config))
-
-   :clj(defn max-pooling-forward!
-         [input output output-indexes conv-config]
-         (let [input-ary (mp/as-double-array input)
-               output-ary (mp/as-double-array output)
-               output-indexes-ary (mp/as-double-array output-indexes)
-               {:keys [width height k-width k-height padx pady stride-w stride-h
-                       num-channels]} conv-config]
-           (if (and input-ary output-ary output-indexes-ary)
-             (ConvOps/maxPooling width height k-width k-height padx pady
-                                 stride-w stride-h num-channels
-                                 input-ary output-ary output-indexes-ary)
-             (max-pooling-forward-default! input output output-indexes conv-config)))))
-
-
-(defn max-pooling-backward!
+(defn planar-max-pooling-forward!
+  [layer input]
+  (let [^ConvLayerConfig config (:conv-config layer)
+        output-width (output-width config)
+        output-height (output-height config)
+        n-output (* output-width output-height (.num-channels config))
+        output (or (:output layer)
+                   (b/new-array [n-output]))
+        ^ints output-indexes (or (:output-indexes layer)
+                                 (int-array n-output))
+        ^doubles input-ary (mp/as-double-array input)
+        ^doubles output-ary (mp/as-double-array output)]
+    (convolution-outer-kernel
+     config
+     (convolution-roll-unroll-inner-kernel
+      (let [input-val (double (if input-valid?
+                                (aget input-ary input-addr)
+                                0.0))
+            output-addr (+ (* out-y output-width)
+                           out-x
+                           chan-output-offset)
+            k-idx (+ (* k-y k-width) k-x)
+            output-val (aget output-ary output-addr)]
+        (when (or (= 0 k-idx)
+                  (> input-val output-val))
+          (aset output-indexes output-addr k-idx)
+          (aset output-ary output-addr output-val)))))
+    (assoc layer
+           :output output
+           :output-indexes output-indexes)))
+
+
+(defn planar-max-pooling-backward!
   "Calculates the input gradient using the inverse of the convolution step
-combined with the output gradient and the output indexes which tell you which kernel
-index the output came from."
-  [output-gradient output-indexes input-gradient
-   {:keys [^long width ^long height
-           ^long k-width ^long k-height
-           ^long padx ^long pady
-           ^long stride-w ^long stride-h
-           ^long num-channels] :as conv-layer-config}]
-  (m/mset! input-gradient 0.0)
-  (let [output-width (get-padded-strided-dimension width padx k-width stride-w)
-        output-height (get-padded-strided-dimension height pady k-height stride-h)
-        num-pixels (* output-width output-height)]
-    (loop [pixel 0]
-      (when (< pixel num-pixels)
-        (let [output-offset (* pixel num-channels)
-              output-x (rem pixel output-width)
-              output-y (quot pixel output-width)]
-          (loop [chan 0]
-            (when (< chan num-channels)
-              (let [output-offset (+ output-offset chan)
-                    kernel-index (long (m/mget output-indexes output-offset))
-                    conv-x (rem kernel-index k-width)
-                    conv-y (quot kernel-index k-width)
-                    input-x (- (+ (* output-x stride-w) conv-x) padx)
-                    input-y (- (+ (* output-y stride-h) conv-y) pady)]
-                (when (and (>= input-y 0)
-                           (< input-y height)
-                           (>= input-x 0)
-                           (< input-x width))
-                  (let [^double output-gradient-value (m/mget output-gradient output-offset)
-                        input-offset (+ (* num-channels (+ (* input-y width)
-                                                           input-x))
-                                        chan)
-                        ^double input-gradient-value (m/mget input-gradient input-offset)]
-                    (m/mset! input-gradient input-offset (+ input-gradient-value
-                                                            output-gradient-value)))))
-              (recur (inc chan)))))
-        (recur (inc pixel))))))
-
+  combined with the output gradient and the output indexes which tell you which kernel
+  index the output came from."
+  [layer input output-gradient]
+  (let [^ConvLayerConfig config (:conv-config layer)
+        ^ints output-indexes (:output-indexes layer)
+        input-gradient (or (:input-gradient layer)
+                           (b/new-array (m/shape input)))
+        ^doubles input-ary (mp/as-double-array input-gradient)
+        ^doubles output-ary (mp/as-double-array output-gradient)]
+    ;;Zero accumulator
+    (m/fill! input-gradient 0.0)
+    (convolution-outer-kernel
+     config
+     (let [output-addr (+ (* out-y output-width)
+                          out-x
+                          chan-output-offset)
+           k-idx (aget output-indexes output-addr)
+           output-val (aget output-ary output-addr)
+           k-y (quot k-idx k-width)
+           k-x (rem k-idx k-width)
+           input-x (+ input-rel-x k-x)
+           input-y (+ input-rel-y k-y)
+           addr (+ (* input-y width)
+                   input-x
+                   chan-input-offset)]
+       (when (and (> input-x 0)
+                  (<= input-x width)
+                  (> input-y 0)
+                  (<= input-y height))
+         (aset input-ary addr output-val))))
+    (assoc layer :input-gradient input-gradient)))

 ;;Max pooling layer.  There are other pooling layer types (average,a sochiastic)
 ;;that may be implemented later but for now we only need max pooling.
@@ -778,20 +360,17 @@
 (defrecord Pooling [output output-indexes input-gradient conv-layer-config]
   cp/PModule
   (cp/calc [this input]
-    (max-pooling-forward! input output output-indexes conv-layer-config))
+    (planar-max-pooling-forward! this input))

   (cp/output [m]
     (:output m))

   cp/PNeuralTraining
   (forward [this input]
-    (cp/calc this input)
-    this)
+    (cp/calc this input))

   (backward [this input output-gradient]
-    (max-pooling-backward! output-gradient output-indexes
-                           input-gradient conv-layer-config)
-    this)
+    (planar-max-pooling-backward! this input output-gradient))

   (input-gradient [this]
     (:input-gradient this)))


Do not show empty events in history explorer

--- src/day8/re_frame_10x/view/history.cljs
+++ src/day8/re_frame_10x/view/history.cljs
@@ -52,7 +52,8 @@
     [rc/v-box
      :class "history-list"
      :height "20%"
-     :children [(for [[id event] all-events]
-                  ^{:key id}
-                  [history-item event id current-id])]]))
+     :children [(for [[id event] all-events
+                      :when (not-empty event)]
+                     ^{:key id}
+                     [history-item event id current-id])]]))


Update common.clj

Update common.clj

--- src/jarkeeper/views/common.clj
+++ src/jarkeeper/views/common.clj
@@ -34,7 +34,6 @@
     ga('send', 'pageview');
    "])

-
 (defn header []
   [:header.header.row
    [:div


Refactor: simplified fn => #

Refactor: simplified fn => #

--- src/layzee/adapters/twitter/replies.clj
+++ src/layzee/adapters/twitter/replies.clj
@@ -10,4 +10,4 @@
   (let [url (format "https://twitter.com/%s/status/%s.html" (:screen-name tweet) (:id tweet))]
     (let [reply (:body (http/get url {:headers {"User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2228.0 Safari/537.36"} }))]
       (filter #(not (= (:id tweet) %))
-        (map (fn[match] (let [[_ id] match] id)) (re-seq #".+-tweet-id=\"(.+)\"" reply))))))+        (map #(let [[_ id] %] id) (re-seq #".+-tweet-id=\"(.+)\"" reply))))))


Fix css injection-eval filename escaping.

--- src/lt/objs/clients/local.cljs
+++ src/lt/objs/clients/local.cljs
@@ -42,7 +42,7 @@
           (object/raise clients/clients :message [cb :editor.eval.js.exception {:ex e :meta (:meta data)}])))))

 (defmethod on-message :editor.eval.css [_ data cb]
-  (let [name (string/replace (str "local-" (:name data)) #"\." "-")
+  (let [name (str "local-" (string/replace (:name data) #"[^a-zA-Z0-9]+" "-"))
         cur ($ (str "#" name))]
     (when cur
       (remove cur))


improve get-string's handling of  underspecified morphology


Use bonecp-config.xml for configuration

Use bonecp-config.xml for configuration

--- src/ruuvi_server/database/pool.clj
+++ src/ruuvi_server/database/pool.clj
@@ -9,13 +9,7 @@
   (let [jdbc-url (str "jdbc:" (:subprotocol dbh) ":" (:subname dbh))
         connection-pool (doto (BoneCPDataSource.)
                           (.setDriverClass (dbh :classname))
-                          (.setJdbcUrl jdbc-url)
-                          (.setPartitionCount 3)
-                          (.setMaxConnectionsPerPartition 26)
-                          (.setStatementsCacheSize 100)
-                          (.setStatementReleaseHelperThreads 3)
-                          (.setReleaseHelperThreads 3)
-                          )]
+                          (.setJdbcUrl jdbc-url))]
     (when (:user dbh) (.setUsername connection-pool (:user dbh)))
     (when (:password dbh) (.setPassword connection-pool (:password dbh)))
     connection-pool)


Add some downloads s3-key multimethod tests.

--- test/kixi/hecuba/api/templates_test.clj
+++ test/kixi/hecuba/api/templates_test.clj
@@ -7,7 +7,7 @@
             [qbits.hayt :as hayt]
             [clojure.walk :refer (prewalk)]
             [ring.mock.request :refer (request content-type)]
-            ))
+            [kixipipe.storage.s3 :refer (s3-key-from item-from-s3-key)]))

 (defn- multipart-request [method params]
     {:request {:request-method method
@@ -21,6 +21,7 @@
             (.deleteOnExit))]
     (spit f contents)
     f))
+

 (defrecord MockStore [state results-index results]
   hecuba/Cassandra
@@ -179,3 +180,15 @@
            (get-in result [:response :body])))
     )
   )
+
+(deftest s3-key-from-test
+  (is (= (s3-key-from {:src-name "downloads" :entity_id 1234})
+         "downloads/1234/data")
+      (= (s3-key-from {:src-name "downloads" :entity_id 1234 :suffix "status"})
+         "downloads/1234/status")))
+
+(deftest item-from-s3-key-test
+  (is (= {:src-name "downloads" :entity_id "1234"}
+         (item-from-s3-key "downloads/1234"))
+      (= nil
+         (item-from-s3-key "downloads/1234/123/123"))))


(PDB-3732) storage: move package-related code out of facts section

[rlb@puppet.com: split commit; add message]

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -838,6 +838,114 @@
     :packages
     ["not exists (select * from certname_packages cp where cp.package_id = packages.id)"])))

+
+;;; Packages
+
+(defn find-certname-id-and-hash [certname]
+  (first (jdbc/query-to-vec [(format "SELECT id, %s as package_hash FROM certnames WHERE certname=?"
+                                     (sutils/sql-hash-as-str "package_hash"))
+                             certname])))
+
+(defn create-package-map [certname-id]
+  (jdbc/call-with-query-rows ["SELECT id, name, version, provider FROM package_inventory WHERE certname_id=?"
+                              certname-id]
+                             (fn [rows]
+                               (->> rows
+                                    (map (fn [{id :id package_name :name version :version provider :provider}]
+                                           [[package_name version provider] id]))
+                                    (into {})))))
+
+(defn find-package-hashes [package-hashes]
+  (jdbc/call-with-query-rows [(format "SELECT id, %s as package_hash FROM packages WHERE hash = ANY(?)"
+                                      (sutils/sql-hash-as-str "hash"))
+                              (sutils/array-to-param "bytea" PGobject
+                                                     (map sutils/munge-hash-for-storage package-hashes))]
+                             (fn [rows]
+                               (reduce (fn [acc {:keys [id package_hash]}]
+                                         (assoc acc package_hash id))
+                                       {} rows))))
+
+(defn package-id-set-for-certname [certname-id]
+  (jdbc/call-with-query-rows ["SELECT package_id FROM certname_packages WHERE certname_id=?"
+                              certname-id]
+                             (fn [rows]
+                               (set (map :package_id rows)))))
+
+(defn insert-missing-packages [existing-hashes-map new-hashed-package-tuples]
+  (let [packages-to-create (remove (fn [hashed-package-tuple]
+                                     (get existing-hashes-map (pkg-util/package-tuple-hash hashed-package-tuple)))
+                                   new-hashed-package-tuples)
+        results (jdbc/insert-multi! :packages
+                                    (map (fn [[package_name version provider package-hash]]
+                                           {:name package_name
+                                            :version version
+                                            :provider provider
+                                            :hash (sutils/munge-hash-for-storage package-hash)})
+                                         packages-to-create))]
+    (merge existing-hashes-map
+           (zipmap (map pkg-util/package-tuple-hash packages-to-create)
+                   (map :id results)))))
+
+(s/defn update-packages
+  "Compares `inventory` to the stored package inventory for
+  `certname`. Differences will result in updates to the database"
+  [certname_id :- s/Int
+   package_hash :- (s/maybe s/Str)
+   inventory :- [pkg-util/package-tuple]]
+  (let [hashed-package-tuples (map shash/package-identity-hash inventory)
+        new-package-hash (shash/package-similarity-hash hashed-package-tuples)]
+
+    (when-not (= new-package-hash package_hash)
+      (let [just-hashes (map pkg-util/package-tuple-hash hashed-package-tuples)
+            existing-package-hashes (find-package-hashes just-hashes)
+            full-hashes-map (insert-missing-packages existing-package-hashes hashed-package-tuples)
+            new-package-id-set (set (vals full-hashes-map))
+            [new-package-ids old-package-ids _] (clojure.data/diff new-package-id-set
+                                                                   (package-id-set-for-certname certname_id))]
+        (jdbc/update! :certnames
+                      {:package_hash (when (seq inventory)
+                                       (sutils/munge-hash-for-storage new-package-hash))}
+                      ["id=?" certname_id])
+
+        (when (seq new-package-ids)
+          (jdbc/insert-multi! :certname_packages
+                              ["certname_id" "package_id"]
+                              (map #(vector certname_id %) new-package-ids)))
+
+        (when (seq old-package-ids)
+
+          (let [old-package-id-sql-param (sutils/array-to-param "bigint" Long
+                                                                (map long old-package-ids))]
+            (jdbc/delete! :certname_packages
+                          ["certname_id = ? and package_id = ANY(?)"
+                           certname_id
+                           old-package-id-sql-param])
+
+            (jdbc/delete! :packages
+                          [(str "id = any(?) "
+                                "and not exists "
+                                "(select 1 from certname_packages where package_id=id)")
+                           old-package-id-sql-param])))))))
+
+(defn insert-packages [certname inventory]
+  (let [certname-id (:id (find-certname-id-and-hash certname))
+        hashed-package-tuples (map shash/package-identity-hash inventory)
+        new-packageset-hash (shash/package-similarity-hash hashed-package-tuples)
+        just-hashes (map pkg-util/package-tuple-hash hashed-package-tuples)
+        existing-package-hashes (find-package-hashes just-hashes)
+        ;; a map of package hash to id in the packages table
+        full-hashes-map (insert-missing-packages existing-package-hashes hashed-package-tuples)
+        new-package-ids (vals full-hashes-map)]
+
+    (jdbc/update! :certnames
+                  {:package_hash (sutils/munge-hash-for-storage new-packageset-hash)}
+                  ["id=?" certname-id])
+
+    (jdbc/insert-multi! :certname_packages
+                        ["certname_id" "package_id"]
+                        (map (fn [package-id] [certname-id package-id])
+                             (vals full-hashes-map)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Facts

@@ -1062,111 +1170,6 @@
                  (realize-fact-values! )
                  (map #(vector (:value_hash %) (:id %))))))
     {}))
-
-(defn find-certname-id-and-hash [certname]
-  (first (jdbc/query-to-vec [(format "SELECT id, %s as package_hash FROM certnames WHERE certname=?"
-                                     (sutils/sql-hash-as-str "package_hash"))
-                             certname])))
-
-(defn create-package-map [certname-id]
-  (jdbc/call-with-query-rows ["SELECT id, name, version, provider FROM package_inventory WHERE certname_id=?"
-                              certname-id]
-                             (fn [rows]
-                               (->> rows
-                                    (map (fn [{id :id package_name :name version :version provider :provider}]
-                                           [[package_name version provider] id]))
-                                    (into {})))))
-
-(defn find-package-hashes [package-hashes]
-  (jdbc/call-with-query-rows [(format "SELECT id, %s as package_hash FROM packages WHERE hash = ANY(?)"
-                                      (sutils/sql-hash-as-str "hash"))
-                              (sutils/array-to-param "bytea" PGobject
-                                                     (map sutils/munge-hash-for-storage package-hashes))]
-                             (fn [rows]
-                               (reduce (fn [acc {:keys [id package_hash]}]
-                                         (assoc acc package_hash id))
-                                       {} rows))))
-
-(defn package-id-set-for-certname [certname-id]
-  (jdbc/call-with-query-rows ["SELECT package_id FROM certname_packages WHERE certname_id=?"
-                              certname-id]
-                             (fn [rows]
-                               (set (map :package_id rows)))))
-
-(defn insert-missing-packages [existing-hashes-map new-hashed-package-tuples]
-  (let [packages-to-create (remove (fn [hashed-package-tuple]
-                                     (get existing-hashes-map (pkg-util/package-tuple-hash hashed-package-tuple)))
-                                   new-hashed-package-tuples)
-        results (jdbc/insert-multi! :packages
-                                    (map (fn [[package_name version provider package-hash]]
-                                           {:name package_name
-                                            :version version
-                                            :provider provider
-                                            :hash (sutils/munge-hash-for-storage package-hash)})
-                                         packages-to-create))]
-    (merge existing-hashes-map
-           (zipmap (map pkg-util/package-tuple-hash packages-to-create)
-                   (map :id results)))))
-
-(s/defn update-packages
-  "Compares `inventory` to the stored package inventory for
-  `certname`. Differences will result in updates to the database"
-  [certname_id :- s/Int
-   package_hash :- (s/maybe s/Str)
-   inventory :- [pkg-util/package-tuple]]
-  (let [hashed-package-tuples (map shash/package-identity-hash inventory)
-        new-package-hash (shash/package-similarity-hash hashed-package-tuples)]
-
-    (when-not (= new-package-hash package_hash)
-      (let [just-hashes (map pkg-util/package-tuple-hash hashed-package-tuples)
-            existing-package-hashes (find-package-hashes just-hashes)
-            full-hashes-map (insert-missing-packages existing-package-hashes hashed-package-tuples)
-            new-package-id-set (set (vals full-hashes-map))
-            [new-package-ids old-package-ids _] (clojure.data/diff new-package-id-set
-                                                                   (package-id-set-for-certname certname_id))]
-        (jdbc/update! :certnames
-                      {:package_hash (when (seq inventory)
-                                       (sutils/munge-hash-for-storage new-package-hash))}
-                      ["id=?" certname_id])
-
-        (when (seq new-package-ids)
-          (jdbc/insert-multi! :certname_packages
-                              ["certname_id" "package_id"]
-                              (map #(vector certname_id %) new-package-ids)))
-
-        (when (seq old-package-ids)
-
-          (let [old-package-id-sql-param (sutils/array-to-param "bigint" Long
-                                                                (map long old-package-ids))]
-            (jdbc/delete! :certname_packages
-                          ["certname_id = ? and package_id = ANY(?)"
-                           certname_id
-                           old-package-id-sql-param])
-
-            (jdbc/delete! :packages
-                          [(str "id = any(?) "
-                                "and not exists "
-                                "(select 1 from certname_packages where package_id=id)")
-                           old-package-id-sql-param])))))))
-
-(defn insert-packages [certname inventory]
-  (let [certname-id (:id (find-certname-id-and-hash certname))
-        hashed-package-tuples (map shash/package-identity-hash inventory)
-        new-packageset-hash (shash/package-similarity-hash hashed-package-tuples)
-        just-hashes (map pkg-util/package-tuple-hash hashed-package-tuples)
-        existing-package-hashes (find-package-hashes just-hashes)
-        ;; a map of package hash to id in the packages table
-        full-hashes-map (insert-missing-packages existing-package-hashes hashed-package-tuples)
-        new-package-ids (vals full-hashes-map)]
-
-    (jdbc/update! :certnames
-                  {:package_hash (sutils/munge-hash-for-storage new-packageset-hash)}
-                  ["id=?" certname-id])
-
-    (jdbc/insert-multi! :certname_packages
-                        ["certname_id" "package_id"]
-                        (map (fn [package-id] [certname-id package-id])
-                             (vals full-hashes-map)))))

 (pls/defn-validated add-facts!
   "Given a certname and a map of fact names to values, store records for those


Misc interceptor cleanups

Misc interceptor cleanups

--- src/re_frame/interceptor.cljc
+++ src/re_frame/interceptor.cljc
@@ -291,10 +291,9 @@

 ;; -- Interceptor Factories - PART 1 ---------------------------------------------------------------
 ;;
-;; These factories wrap handlers.
-
-;; XXX add names to annonomous `fn`
+;; These factories wrap the 3 kinds of handlers.
 ;;
+
 (defn db-handler->interceptor
   "Returns an interceptor which wraps the kind of event handler given to `reg-event-db`.

@@ -333,14 +332,24 @@
   [handler-fn]
   (->interceptor
     :name   :fx-handler
-
-    :before (fn [context]
+    :before (fn fx-handler-before
+              [context]
               (let [{:keys [event] :as coeffects} (:coeffects context)]
                 (->> (handler-fn coeffects event)
                      (assoc context :effects))))))

 (defn ctx-handler->interceptor
+  "Returns an interceptor which wraps the kind of event handler given to `reg-event-ctx`.
+  These advanced handlers take one argument: `context` and they return a modified `context`.
+  Example:
+     (fn [context]
+        (enqueue context [more interceptors]))"
+  [handler-fn]
+  (->interceptor
+    :name   :ctx-handler
+    :before handler-fn))
+

 ;; -- Interceptors Factories -  PART 2 ------------------------------------------------------------
 ;;
@@ -362,30 +371,30 @@
   Implementation:
     - in :before, store the original db in within `context`
     - ib :after, re-establish original db with modification
-    - remember, there's a chance that path may be used twice in the one interceptor chain.
-
-  XXX what if path is used twice XXX  Adjust implementation to allow for it.
+    - remember: path may be used twice within the one interceptor chain.
   "
   [& args]
   (let [path   (flatten args)
-        hidden-conext-path [:re-frame-internal :path-original-db]]   ;; this is where, within context, we hide the original db
+       db-store-key :re-frame-path/original-dbs]    ;; this is where, within `context`, we store the original db
     (when (empty? path)
       (console :error "re-frame: \"path\" interceptor given no params."))
-
     (->interceptor
       :name    :path
-
-      :before  (fn [context]
+      :before  (fn
+                 [context]
                  (let [original-db (get-coeffect context :db)]
                    (-> context
-                       (assoc-in  hidden-conext-path original-db)
+                       (update db-store-key conj original-db)
                        (assoc-coeffect :db (get-in original-db path)))))
-
       :after   (fn [context]
-                 (let [original-db (get-in context hidden-conext-path)]
-                   (->> (get-effect context :db)
-                        (assoc-in original-db path)
-                        (assoc-effect context :db)))))))
+                 (let [db-store    (db-store-key context)
+                       original-db (peek db-store)
+                       new-store   (pop db-store)
+                       full-db      (->> (get-effect context :db)
+                                        (assoc-in original-db path))]
+                   (-> context
+                        (assoc db-store-key new-store)
+                        (assoc-effect :db full-db)))))))


forgot to add test file

forgot to add test file

--- src/refactor_nrepl/client.clj
+++ src/refactor_nrepl/client.clj
@@ -208,10 +208,6 @@
                                     :column column})
         unbound (:unbound (first response))
         error (:error (first response))]
-    (when error
-      (println "something bad happened: " error))
-    (if-not (str/blank? unbound)
-      (->> (str/split unbound #" ")
-           (map symbol)
-           set)
-      #{})))
+    (if error
+      (println "something bad happened: " error)
+      (set (map symbol unbound )))))


[#2085] Hide data approval permission on users tab if not enabled

--- Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/role_details.cljs
+++ Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/role_details.cljs
@@ -1,4 +1,4 @@
-;; Copyright (C) 2014 Stichting Akvo (Akvo Foundation)
+;; Copyright (C) 2014, 2017 Stichting Akvo (Akvo Foundation)
 ;;
 ;; This file is part of Akvo FLOW.
 ;;
@@ -23,22 +23,29 @@
             [sablono.core :as html :refer-macros (html)])
   (:require-macros [org.akvo.flow.dashboard.t :refer (t>)]))

+(def required-permissions
+   {"PROJECT_FOLDER_CREATE" (t> _create_folders)
+    "PROJECT_FOLDER_READ" (t> _access_folders)
+    "PROJECT_FOLDER_UPDATE" (t> _edit_folders)
+    "PROJECT_FOLDER_DELETE" (t> _delete_folders)
+    "FORM_CREATE" (t> _create_forms)
+    "FORM_READ" (t> _access_forms)
+    "FORM_UPDATE" (t> _edit_forms)
+    "FORM_DELETE" (t> _delete_forms)
+    "DATA_CLEANING" (t> _data_cleaning)
+    "DATA_READ" (t> _read_data)
+    "DATA_UPDATE" (t> _edit_data)
+    "DATA_DELETE" (t> _delete_data)
+    "DEVICE_MANAGE" (t> _device_assignment_manage)
+    "CASCADE_MANAGE" (t> _cascade_manage)})
+
+(def data-approval-enabled
+  (aget js/window "parent" "FLOW" "Env" "enableDataApproval"))
+
 (def all-permissions
-  {"PROJECT_FOLDER_CREATE" (t> _create_folders)
-   "PROJECT_FOLDER_READ" (t> _access_folders)
-   "PROJECT_FOLDER_UPDATE" (t> _edit_folders)
-   "PROJECT_FOLDER_DELETE" (t> _delete_folders)
-   "FORM_CREATE" (t> _create_forms)
-   "FORM_READ" (t> _access_forms)
-   "FORM_UPDATE" (t> _edit_forms)
-   "FORM_DELETE" (t> _delete_forms)
-   "DATA_APPROVE_MANAGE" (t> _data_approval_manage)
-   "DATA_CLEANING" (t> _data_cleaning)
-   "DATA_READ" (t> _read_data)
-   "DATA_UPDATE" (t> _edit_data)
-   "DATA_DELETE" (t> _delete_data)
-   "DEVICE_MANAGE" (t> _device_assignment_manage)
-   "CASCADE_MANAGE" (t> _cascade_manage)})
+  (if data-approval-enabled
+    (assoc required-permissions "DATA_APPROVE_MANAGE" (t> _data_approval_manage))
+    required-permissions))

 (defn header-section [{:keys [role on-close]} owner]
   (om/component


Revert last two commits, should have used a branch

--- src/rill/event_store/psql.clj
+++ src/rill/event_store/psql.clj
@@ -66,13 +66,9 @@
                                events))
            true
            (catch org.postgresql.util.PSQLException e
-             (log/error e "append-events")
-             (log/error (.getNextException e) "append-events getNextException")
-             (throw e))
+             nil)
            (catch java.sql.BatchUpdateException e
-             (log/error e "append-events")
-             (log/error (.getNextException e) "append-events getNextException")
-             (throw e))))))
+             nil)))))

 (defn psql-event-store [spec & [{:keys [page-size] :or {page-size 20}}]]
   {:pre [(integer? page-size)]}


Use not resizable selection component for shape component.

When no edition mode is activated.

--- src/uxbox/main/ui/shapes/selection.cljs
+++ src/uxbox/main/ui/shapes/selection.cljs
@@ -187,9 +187,10 @@

       :else
       (cond
-        (and (= :path (:type shape))
-             (= @edition-ref (:id shape)))
-        (path-edition-selection-handlers shape)
+        (= :path (:type shape))
+        (if (= @edition-ref (:id shape))
+          (path-edition-selection-handlers shape)
+          (single-not-editable-selection-handlers shape))

         :else
         (single-selection-handlers (first shapes))))))


Fix bug introduced in previous commit.

Fix bug introduced in previous commit.

That causes crash draw tools after first draw op.

--- src/uxbox/main/ui/workspace/canvas.cljs
+++ src/uxbox/main/ui/workspace/canvas.cljs
@@ -139,16 +139,16 @@
     (letfn [(on-mouse-down [event]
               (dom/stop-propagation event)

-              (when (seq (:selected workspace))
-                (rs/emit! (uds/deselect-all)))
-
               (let [opts {:shift? (kbd/shift? event)
                           :ctrl? (kbd/ctrl? event)}]
                 (rx/push! wb/events-b [:mouse/down opts]))

               (if (:drawing workspace)
                 (rlocks/acquire! :ui/draw)
-                (rlocks/acquire! :ui/selrect)))
+                (do
+                  (when (seq (:selected workspace))
+                    (rlocks/release! :shape/edition))
+                  (rlocks/acquire! :ui/selrect))))
             (on-context-menu [event]
               (dom/prevent-default event)
               (dom/stop-propagation event)


[WIP] --list command to list known tests

--- src/main/shadow/test/node.cljs
+++ src/main/shadow/test/node.cljs
@@ -25,6 +25,9 @@
       (cond
         (= "--help" arg)
         (assoc opts :help true)
+
+        (= "--list" arg)
+        (assoc opts :list true)

         (str/starts-with? arg "--test=")
         (let [test-arg (subs arg 7)
@@ -54,7 +57,7 @@
                          (contains? test-var-syms (symbol ns name))))))
          )))

-(defn execute-cli [{:keys [test-syms help] :as opts}]
+(defn execute-cli [{:keys [test-syms help list] :as opts}]
   (let [test-env
         (-> (ct/empty-env)
             ;; can't think of a proper way to let CLI specify custom reporter?
@@ -66,7 +69,19 @@

     (cond
       help
-      (println "Usage:\n\t--test=<ns-to-test>,<fqn-symbol-to-test>")
+      (do (println "Usage:")
+          (println "  --list (list known test names)")
+          (println "  --test=<ns-to-test>,<fqn-symbol-to-test> (run test for namespace or single var, separated by comma)"))
+
+      list
+      (doseq [[ns ns-info]
+              (->> (env/get-tests)
+                   (sort-by first))]
+        (println "Namespace:" ns)
+        (doseq [var (:vars ns-info)
+                :let [m (meta var)]]
+          (println (str "  " (:ns m) "/" (:name m))))
+        (println "---------------------------------"))

       (seq test-syms)
       (let [test-vars (find-matching-test-vars test-syms)]