Refactoring

Refactoring

--- src/grafter/tabular.clj
+++ src/grafter/tabular.clj
@@ -270,24 +270,67 @@

 (def _ "An alias for the identity function, used for providing positional arguments to mapc." identity)

-(defn mapc
-  "Takes an array or a hashmap of functions and maps each to the key
-  column for every row."
+(defn- normalise-mapping
+  "Given a dataset and a map/vector mapping ids or positions to
+  values.  Return a map with normalised keys that map to the
+  appropriate values.  A normalised mapping will contain identity
+  mappings for any ommitted columns."
   [dataset fs]
-  (let [fs-hash (if (vector? fs)
-                    (zipmap (column-names dataset) fs)
-                    fs)
+  (let [resolve-ids (fn [id] (resolve-column-id dataset id nil))
+        fs-hash (if (vector? fs)
+                  (zipmap (column-names dataset) fs)
+                  (map-keys resolve-ids fs))
         other-hash (zipmap (vec (clojure.set/difference (set (:column-names dataset))
                                                         (set (keys fs-hash))))
-                           (cycle [identity]))
+                           (repeat identity))
         functions (conj fs-hash other-hash)]
+
+    functions))
+
+(defn mapc
+  "Takes a vector or a hashmap of functions and maps each to the key
+  column for every row.  Each function should be from a cell to a
+  cell, where as with apply-columns it should be from a column to a
+  column i.e. its function from a collection of cells to a collection
+  of cells."
+  [dataset fs]
+  (let [functions (normalise-mapping dataset fs)
+        apply-functions (fn [row]
+                          (let [apply-column-f (fn [col-id]
+                                                 (let [f (functions col-id)
+                                                       fval (f (row col-id))]
+                                                   {col-id fval}))]
+                            (apply merge (map apply-column-f
+                                              (keys row)))))]

     (tabc/apply-rows dataset (fn [rows]
                                (->> rows
-                                    (map (fn [row]
-                                           (apply merge (map #(hash-map % ((functions %) (row %)))
-                                                             (keys row))))))))))
-
+                                    (map apply-functions))))))
+
+
+(defn apply-columns
+  "Like mapc in that you associate functions with particular columns,
+  though it differs in that the functions given to mapc should receive
+  and return values for individual cells.
+
+  With apply-columns, the function receives a collection of cell
+  values from the column and should return a collection of values for
+  the column."
+  [dataset fs]
+  (let [functions (normalise-mapping dataset fs)]
+
+    (tabc/apply-rows dataset (fn [rows]
+                               ;; TODO consider implementing this in
+                               ;; terms of either incanter.core/to-map
+                               ;; or zipmap
+                               (let [apply-to-cols (fn [[col f]]
+                                                     (->> rows
+                                                          (map (fn [r] (get r col)))
+                                                          f
+                                                          (map (fn [r] {col r}))))]
+                                 (->> functions
+                                      (map apply-to-cols)
+                                      (apply (partial map merge))))))))

 (defn swap
   "Takes an even numer of column names and swaps each column"


Add a short-string parsing helper

Add a short-string parsing helper

--- src/grimoire/things.clj
+++ src/grimoire/things.clj
@@ -436,6 +436,9 @@
               "Failed to parse URI. Path didn't round trip to expected type!")
       t)))

+(def short-string-pattern
+  #"(\w{3,6})::([^\s/:]+)(/([^:\s]+))?")
+
 (defn thing->short-string
   "Function from a Thing to a String representing a mostly unique naming string.

@@ -447,12 +450,32 @@
   org.clojure/clojure/1.6.0/clj/clojure.core/+ would give the short string
   clj::clojure.core/+."
   [t]
-  {:pre [(platformed? t)]}
+  {:pre  [(platformed? t)]
+   :post [(re-find short-string-pattern %)]}
   (match [t]
-    [([::namespace {:name nn :parent {:name pn}}] :seq)]
+    [([::namespace {:name nn
+                    :parent {:name pn}}]
+      :seq)]
     ,,(format "%s::%s" pn nn)
-    [([::def       {:name n :parent {:name nn :parent {:name pn}}}] :seq)]
+
+    [([::def {:name n
+              :parent {:name nn
+                       :parent {:name pn}}}]
+      :seq)]
     ,,(format "%s::%s/%s"
               pn nn n)))

 ;; short-string->thing to be defined in terms of a search for the latest version.
+(defn parse-short-string
+  "Function from a String as generated by thing->short-string to one
+  of either [:def <ns-name> <def-name>] or [:ns <ns-name>]. The
+  intention is that this function can be used to parse short-strings
+  into structures for which Things can be looked up out of a
+  datastore. Returns nil on failure to parse."
+  [s]
+  {:pre [(string? s)]}
+  (let [[_s platform ns _ ?def :as match] (re-find short-string-pattern s)]
+    (when match
+      (if ?def
+        [:def ns ?def]
+        [:ns ns]))))


removing variable that is not referenced

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/data/import_data.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/data/import_data.cljs
@@ -14,7 +14,7 @@

 (react/defc Page
   {:render
-   (fn [{:keys [state props refs this]}]
+   (fn [{:keys [state refs this]}]
      [:div {:style {:textAlign "center"}}
       (when (:loading? @state)
         [comps/Blocker {:banner "Uploading file..."}])


Changed format of API response for ragam resource. - Motivation: Apart from mirroring the separation of view concerns on the frontend, separating 'ragam', 'kritis', and 'parent-ragam' into separate keys allows the three entities to easily become separate URIs in the future, as part of a chattier fine-grained API.

--- src/kosha/app/ragam.clj
+++ src/kosha/app/ragam.clj
@@ -5,7 +5,8 @@
 (defn response-body
   "Join ragam data, its kritis and its parent ragam into a single map."
   [ragam kritis parent]
-  (-> ragam
+  (-> {}
+      (assoc :ragam ragam)
       (assoc :kritis kritis)
       (assoc :parent-ragam parent)))


separate get-item and get-clojure, better var names

--- src/lib/cljs/local.cljs
+++ src/lib/cljs/local.cljs
@@ -6,10 +6,13 @@

 (defn get-item [key]
   (if (local-storage?)
-    (reader/read-string (. js/localStorage (getItem (name key))))))
+    (. js/localStorage (getItem key))))

-(defn set-item [key item]
+(defn get-clojure [id]
+  (reader/read-string (get-item id)))
+
+(defn set-item [k v]
   (if (local-storage?)
-    (let [item (if (string? item) item (pr-str item))]
-      (. js/localStorage (setItem (name key) item)))))
+    (let [item (if (string? v) v (pr-str v))]
+      (. js/localStorage (setItem k item)))))


Display error message for invalid data from tags url - close #2026

Ideally we'd like to detect failure on the response code but fetch/xhr
doesn't give us access to the response object in the callback. Changing the
callback signature is a bigger change that would require planning with
downstream fetch users and some more use cases

--- src/lt/objs/deploy.cljs
+++ src/lt/objs/deploy.cljs
@@ -131,11 +131,15 @@
 (defn ->latest-version
   "Returns latest LT version for github api tags endpoint."
   [body]
-  (->> (js/JSON.parse body)
-       ;; Ensure only version tags
-       (keep #(when (re-find version-regex (.-name %)) (.-name %)))
-       sort
-       last))
+  (when-let [parsed-body
+             (try (js/JSON.parse body)
+               (catch :default e
+                 (console/error (str "Invalid JSON response from " tags-url ": " (pr-str body)))))]
+    (->> parsed-body
+         ;; Ensure only version tags
+         (keep #(when (re-find version-regex (.-name %)) (.-name %)))
+         sort
+         last)))

 (defn check-version [& [notify?]]
   (fetch/xhr tags-url {}


Fix decodable protocol.

Fix decodable protocol.

--- src/multihash/core.cljc
+++ src/multihash/core.cljc
@@ -193,8 +193,8 @@
                (str "Cannot read multihash from byte array: " encoded-size
                     " is less than the minimum of " min-size)
                {:type :multihash/bad-input}))))
-  (let [code (aget encoded 0)
-        length (aget encoded 1)
+  (let [code (bytes/get-byte encoded 0)
+        length (bytes/get-byte encoded 1)
         payload (- (alength encoded) 2)]
     (when-not (pos? length)
       (throw (ex-info
@@ -205,29 +205,30 @@
                (str "Encoded digest length " length " exceeds actual "
                     "remaining payload of " payload " bytes")
                {:type :multihash/bad-input})))
-    (let [digest (byte-array length)]
-      (System/arraycopy encoded 2 digest 0 length)
+    (let [digest (bytes/byte-array length)]
+      (bytes/copy encoded 2 digest 0 length)
       (create code digest))))

-(defn- read-stream-digest
-  "Reads a byte digest array from an input stream. First reads a byte giving
-  the length of the digest data to read. Throws an ex-info if the length is
-  invalid or there is an error reading from the stream."
-  ^bytes
-  [^InputStream input]
-  (let [length (.read input)]
-    (when-not (pos? length)
-      (throw (ex-info
-               (format "Byte %02x is not a valid digest length." length)
-               {:type :multihash/bad-input})))
-    (let [digest (byte-array length)]
-      (loop [offset 0
-             remaining length]
-        (let [n (.read input digest offset remaining)]
-          (if (< n remaining)
-            (recur (+ offset n) (- remaining n))
-            digest))))))
+#?(:clj
+   (defn- read-stream-digest
+     "Reads a byte digest array from an input stream. First reads a byte giving
+     the length of the digest data to read. Throws an ex-info if the length is
+     invalid or there is an error reading from the stream."
+     ^bytes
+     [^InputStream input]
+     (let [length (.read input)]
+       (when-not (pos? length)
+         (throw (ex-info
+                  (format "Byte %02x is not a valid digest length." length)
+                  {:type :multihash/bad-input})))
+       (let [digest (byte-array length)]
+         (loop [offset 0
+                remaining length]
+           (let [n (.read input digest offset remaining)]
+             (if (< n remaining)
+               (recur (+ offset n) (- remaining n))
+               digest)))))))

 (defprotocol Decodable
@@ -241,14 +242,16 @@

 (extend-protocol Decodable

-  (class (byte-array 0))
+  #?(:clj (class (byte-array 0))
+     :cljs js/Uint8Array)

   (decode
     [source]
     (decode-array source))

-  String
+  #?(:clj java.lang.String
+     :cljs js/String)

   (decode
     [source]
@@ -258,10 +261,11 @@
         (b58/decode source))))

-  InputStream
-
-  (decode
-    [source]
-    (let [code (.read source)
-          digest (read-stream-digest source)]
-      (create code digest))))
+  #?@(:clj
+      [InputStream
+
+       (decode
+         [source]
+         (let [code (.read source)
+               digest (read-stream-digest source)]
+           (create code digest)))]))


improved psi game prompt message

improved psi game prompt message

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -160,7 +160,7 @@
   (swap! state assoc :psi {})
   (trigger-event state side :psi-game nil)
   (doseq [s [:corp :runner]]
-    (show-prompt state s card (str "Choose an amount to spend for the Psi game")
+    (show-prompt state s card (str "Choose an amount to spend for " (:title card))
                  (map #(str % " [Credits]") (range (min 3 (inc (get-in @state [s :credit])))))
                  #(resolve-psi state s card psi (js/parseInt %)))))


better dummy data

better dummy data

--- src/pc/models/layer.clj
+++ src/pc/models/layer.clj
@@ -23,13 +23,19 @@

 (comment
-  (d/transact (pcd/conn)
-              [{:db/id (d/tempid :db.part/user)
-                :layer/name "Test Layer 1"
-                :layer/fill "red"}
-               {:db/id (d/tempid :db.part/user)
-                :layer/name "Test Layer 2"
-                :layer/fill "blue"}
-               {:db/id (d/tempid :db.part/user)
-                :layer/name "Test Layer 3"
-                :layer/fill "green"}]))
+  (let [[doc-id & layer-ids] (pcd/generate-eids (pcd/conn) 4)]
+    (d/transact (pcd/conn)
+                [{:db/id doc-id
+                  :document/name "Test Document 1"}
+                 {:db/id (first layer-ids)
+                  :document/id doc-id
+                  :layer/name "Test Layer 1"
+                  :layer/fill "red"}
+                 {:db/id (second layer-ids)
+                  :document/id doc-id
+                  :layer/name "Test Layer 2"
+                  :layer/fill "blue"}
+                 {:db/id (last layer-ids)
+                  :document/id doc-id
+                  :layer/name "Test Layer 3"
+                  :layer/fill "green"}])))


Use redis-async 0.3.2

Use redis-async 0.3.2

--- Clojure/async-test/project.clj
+++ Clojure/async-test/project.clj
@@ -1,5 +1,5 @@
 (defproject async-test "0.1.0-SNAPSHOT"
   :dependencies [[org.clojure/clojure "1.7.0"]
-                 [redis-async "0.3.1"]]
+                 [redis-async "0.3.2"]]
   :main async-test.core
   :aot [async-test.core])


Reset collected traces after every callback has had them delivered

Previously only the first tracing callback would get them.

--- src/re_frame/trace.cljc
+++ src/re_frame/trace.cljc
@@ -53,14 +53,14 @@

 (def run-tracing-callbacks!
   (debounce
-    (fn []
+    (fn tracing-cb-debounced []
       (doseq [[k cb] @trace-cbs]
         (try (cb @traces)
              #?(:clj (catch Exception e
                        (console :error "Error thrown from trace cb" k "while storing" @traces e)))
              #?(:cljs (catch :default e
-                        (console :error "Error thrown from trace cb" k "while storing" @traces e))))
-        (reset! traces [])))
+                        (console :error "Error thrown from trace cb" k "while storing" @traces e)))))
+      (reset! traces []))
     50))


streams/changed: docstring update for pairs?

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -1482,12 +1482,12 @@
   ; Assume states *were* ok the first time we see them.
   (changed :state {:init \"ok\"} prn)

-  ; Receive the previous event, in addition to the current event
-  (changed :state
-           (fn [prev-evt evt]
-             (prn \"changed from\" (:state prev-evt) \"to\" (:state evt))))
-
-  Note that f can be an arbitrary function:
+  ; Receive the previous event, in addition to the current event, as a vector.
+  (changed :state {:pairs? true}
+           (fn [[event event']]
+             (prn \"changed from\" (:state event) \"to\" (:state event'))))
+
+  ; Note that f can be an arbitrary function:

   (changed (fn [e] (> (:metric e) 2)) ...)"
   [pred & children]


fix: add integration link to footer nav

fix: add integration link to footer nav

--- src/site/navigation.clj
+++ src/site/navigation.clj
@@ -91,7 +91,8 @@
      [(footer-title "services" :development)
       [:ul.list-unstyled
        (for [x (data :services)]
-         [:li [:a {:href (url "services" {:# (:id x)})} (i x :title)]])]]
+         [:li [:a {:href (url "services" {:# (:id x)})} (i x :title)]])
+       [:li [:a {:href (url "integration" )} "Integration"]]]]

      [(footer-title "trainings" :education)
       [:ul.list-unstyled


debugger: rf views

debugger: rf views

--- examples/_common/middleware/devtools.cljs
+++ examples/_common/middleware/devtools.cljs
@@ -314,47 +314,55 @@
    [-menu-button (if persist? {} {:color "grey"}) (str "Persist" (if persist? "✓")) #(dispatch ::on-toggle-persist) "Persist debug session into local storage?"]
    [-menu-button {} "Hide" #(dispatch ::on-toggle-visibility) (str "Hides debugger view (" toggle-visibility-shortcut ")")]])

+(defn -actions-view
+  [action-events signal-id dispatch]
+  [:div
+   (for [{:keys [id enabled? action]} (filter #(= (:signal-id %) signal-id)
+                                              action-events)]
+     ^{:key id}
+     [:div {:style    {:display     "flex"
+                       :margin-left 20
+                       :margin-top  1
+                       :color       (if enabled? "inherit" "grey")
+                       :cursor      "pointer"}
+            :on-click #(dispatch [::on-toggle-action id])}
+      [:div {:title "Click to enable/disable this action"}
+       (if (coll? action)
+         [:div (pr-str (first action)) " " (clojure.string/join " " (map pr-str (rest action)))]
+         [:div (pr-str action)])]
+
+      (when enabled?
+        [:div {:style    {:display          "flex"
+                          :margin-left      "5px"
+                          :border-radius    "3px"
+                          :cursor           "pointer"
+                          :align-items      "center"
+                          :background-color "rgb(60, 70, 80)"}
+               :on-click #(do (.stopPropagation %) (dispatch [::on-log-action-result id]))
+               :title    "Print model state after this action"}
+         "model"])])])
+
+(defn -signal-view
+  [signal-id signal dispatch]
+  [:div {:style    {:margin-top       8
+                    :padding-left     4
+                    :cursor           "pointer"
+                    :background-color "rgb(60, 70, 80)"}
+         :title    "Click to enable/disable all actions dispatched from this signal"
+         :on-click #(dispatch [::on-toggle-signal signal-id])}
+   (if (coll? signal)
+     [:span (pr-str (first signal)) " " (clojure.string/join " " (map pr-str (rest signal)))]
+     (pr-str signal))])
+
 (defn -signals-view
   [signal-events action-events dispatch]
   [:div
    (doall
      (for [[signal-id signal] signal-events]
        ^{:key signal-id}
-       [:div {:title "Signal"}
-        [:div {:style    {:padding-left     4
-                          :margin-top       8
-                          :cursor           "pointer"
-                          :background-color "rgb(60, 70, 80)"}
-               :on-click #(dispatch [::on-toggle-signal signal-id])
-               :title    "Click to enable/disable all actions dispatched from this signal"}
-         (if (coll? signal)
-           [:span (pr-str (first signal)) " " (clojure.string/join " " (map pr-str (rest signal)))]
-           (pr-str signal))]
-
-        (for [{:keys [id enabled? action]} (filter #(= (:signal-id %) signal-id)
-                                                   action-events)]
-          ^{:key id}
-          [:div {:style    {:display     "flex"
-                            :margin-left 20
-                            :margin-top  1
-                            :color       (if enabled? "inherit" "grey")
-                            :cursor      "pointer"}
-                 :on-click #(dispatch [::on-toggle-action id])}
-           [:div {:title "Click to enable/disable this action"}
-            (if (coll? action)
-              [:div (pr-str (first action)) " " (clojure.string/join " " (map pr-str (rest action)))]
-              [:div (pr-str action)])]
-
-           (when enabled?
-             [:div {:style    {:display          "flex"
-                               :margin-left      "5px"
-                               :border-radius    "3px"
-                               :cursor           "pointer"
-                               :align-items      "center"
-                               :background-color "rgb(60, 70, 80)"}
-                    :on-click #(do (.stopPropagation %) (dispatch [::on-log-action-result id]))
-                    :title    "Print model state after this action"}
-              "model"])])]))])
+       [:div
+        [-signal-view signal-id signal dispatch]
+        [-actions-view action-events signal-id dispatch]]))])

 (defn -initial-model-view
   [initial-model]


small typos

small typos

--- frontend/components/language_landing.cljs
+++ frontend/components/language_landing.cljs
@@ -25,7 +25,7 @@
                         :features [{:feature "CircleCI provides support for a wide variety of Ruby versions and gems, including Ruby on Rails. It is trivial to add any packages or frameworks that are not installed on our machines by default, allowing you to effortlessly customize your test enviroment.  CircleCI also supports Test::Unit, RSpec, Cucumber, Spinach, Jasmine, Konacha, and just about any other testing framework you use for your Ruby project."
                                     :title "Built For Ruby"
                                     :icon "/img/outer/languages/gear-icon.svg"}
-                                   {:feature "Circle manages all your database requirements for you, such as running your rake commands for creating, loading, and migrating your database. We have pre-installed more than a dozen databases and queues, including PostgreSQL, MySQL, and MongoDB as well as frameworks such as DataMapper, Mongoid, ActiveRecord. You can also add custom database commands via your circle.yml."
+                                   {:feature "Circle manages all your database requirements for you, such as running your rake commands for creating, loading, and migrating your database. We have pre-installed more than a dozen databases and queues, including PostgreSQL, MySQL, and MongoDB as well as frameworks such as DataMapper, Mongoid, and ActiveRecord. You can also add custom database commands via your circle.yml."
                                     :title "Database Management"
                                     :icon "/img/outer/languages/file-icon.svg"}
                                    {:feature "For the majority of Ruby projects no configuration is required; you just run your builds on CircleCI and it works! CircleCI will automatically infer your test commands if you're using Test::Unit, RSpec, Cucumber, Spinach, Jasmine, or Konacha. Parallel builds can also be set up automatically for your Ruby projects to keep build times down."


delaney.clj: fixed connectedness test in (invariant)

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -146,7 +146,7 @@
   ([ds D]
     (let [idcs (indices ds), t (traversal ds idcs [D])]
       (do
-        (assert (= (size ds) (count (into #{} (map (fn [[_ _ D]] D) t))))
+        (assert (>= 1 (count (for [[_ i _] t :when (= :root i)] true)))
                 "Symbol must be connected")
         (protocol ds idcs t))))
   ([ds]


useless use of join

useless use of join

--- src-cljs/core.cljs
+++ src-cljs/core.cljs
@@ -83,7 +83,7 @@

 (defn xhr-search [term]
   (let [channel (chan)]
-    (.send XhrIo (string/join "?" ["/tracks.json" ])
+    (.send XhrIo "/tracks.json"
            (fn [e]
              (let [xhr (.-target e)
                    code (.getStatus xhr)


interceptors, wip

interceptors, wip

--- modules/reitit-core/src/reitit/interceptor.cljc
+++ modules/reitit-core/src/reitit/interceptor.cljc
@@ -116,21 +116,22 @@
                :interceptors))
     {::router router}))

-(defn execute [r {{:keys [uri]} :request :as ctx}]
-  (if-let [interceptors (-> (r/match-by-path r uri)
-                            :result
-                            :interceptors)]
-    (as-> ctx $
-          (reduce #(%2 %1) $ (keep :enter interceptors))
-          (reduce #(%2 %1) $ (keep :leave interceptors)))))
+(comment
+  (defn execute [r {{:keys [uri]} :request :as ctx}]
+    (if-let [interceptors (-> (r/match-by-path r uri)
+                              :result
+                              :interceptors)]
+      (as-> ctx $
+            (reduce #(%2 %1) $ (keep :enter interceptors))
+            (reduce #(%2 %1) $ (keep :leave interceptors)))))

-(def r
-  (router
-    ["/api" {:interceptors [{:name ::add
-                             :enter (fn [ctx]
-                                      (assoc ctx :enter true))
-                             :leave (fn [ctx]
-                                      (assoc ctx :leave true))}]}
-     ["/ping" (fn [ctx] (assoc ctx :response "ok"))]]))
+  (def r
+    (router
+      ["/api" {:interceptors [{:name ::add
+                               :enter (fn [ctx]
+                                        (assoc ctx :enter true))
+                               :leave (fn [ctx]
+                                        (assoc ctx :leave true))}]}
+       ["/ping" (fn [ctx] (assoc ctx :response "ok"))]]))

-(execute r {:request {:uri "/api/ping"}})
+  (execute r {:request {:uri "/api/ping"}}))


CMR-3357: Divide collection_validation_test.clj into 5 tests.

--- system-int-test/test/cmr/system_int_test/ingest/collection_validation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/collection_validation_test.clj
@@ -1,712 +0,0 @@
-(ns cmr.system-int-test.ingest.collection-validation-test
-  "CMR Ingest validation integration tests"
-  (:require
-    [clojure.test :refer :all]
-    [cmr.system-int-test.utils.ingest-util :as ingest]
-    [cmr.system-int-test.data2.collection :as dc]
-    [cmr.system-int-test.data2.granule :as dg]
-    [cmr.system-int-test.data2.core :as d]
-    [cmr.common.mime-types :as mt]
-    [cmr.umm.umm-collection :as c]
-    [cmr.umm.umm-spatial :as umm-s]
-    [cmr.common.util :refer [are2]]
-    [cmr.common.util :as u :refer [are3]]
-    [cmr.common-app.test.side-api :as side]
-    [cmr.spatial.polygon :as poly]
-    [cmr.spatial.point :as p]
-    [cmr.spatial.line-string :as l]
-    [cmr.spatial.mbr :as m]
-    [cmr.ingest.config :as icfg]
-    [cmr.ingest.services.messages :as msg]
-    [cmr.common.mime-types :as mime-types]
-    [cmr.system-int-test.utils.index-util :as index]
-    [cmr.system-int-test.utils.search-util :as search]
-    [clojure.java.io :as io]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; The following tests are included in this file:
-;; 1. Spatial coordinate reference type must be supplied.
-;; 2. Validation end point tests:
-;;    a)successful case
-;;    b)invalid collection xml fails validation with appropriate message
-;;    (Do we want to test invalid umm-json fails validation here?)
-;; 3. successful validation requests do not get an xml or json response body
-;; 4. failed validations with no accept or content-type header return xml
-;; 5. Collection Keyword validation
-;;    a) keyword validation using validation end points.
-;;    b) Project keyword validation
-;;    c) Platform keyword validation
-;;    d) Instrument keyword validation
-;;    e) Science Keyword validation
-;; 6. collection-umm-spec-validation-test
-;;    a)UMM-C JSON-Schema validation through config settings
-;;    b)UMM-C JSON-Schema validation through Cmr-Validate-Umm-C header
-;;    c)UMM-SPEC validation through Cmr-Validation-Umm-C header
-;;    d)Additional Attribute validation
-;;    e)Nested Path Validation
-;;    f)Spatial validation
-;; 7. duplicate-entry-title-test
-;; 8. revision-id-validations
-;; 9. revision-conflict-tests
-;;10. Collections with nil versions are rejected
-;;11. Conversion from dif9 to echo10 is successful
-;;    (Do we want to move other conversions here or leave it in the unit tests?
-;;     do we want to add the conversion through translate end point also?)
-;;12. umm-spec-validation-warnings for all formats
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; helper function section
-;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn polygon
-  "Creates a single ring polygon with the given ordinates. Points must be in counter clockwise order."
-  [& ords]
-  (poly/polygon [(apply umm-s/ords->ring ords)]))
-
-(defn assert-invalid
-  ([coll-attributes field-path errors]
-   (assert-invalid coll-attributes field-path errors nil))
-  ([coll-attributes field-path errors options]
-   (let [response (d/ingest "PROV1" (dc/collection coll-attributes)
-                            (merge {:allow-failure? true} options))]
-     (is (= {:status 422
-             :errors [{:path field-path
-                       :errors errors}]}
-            (select-keys response [:status :errors]))))))
-
-(defn assert-valid
-  ([coll-attributes]
-   (assert-valid coll-attributes nil))
-  ([coll-attributes options]
-   (let [collection (assoc (dc/collection coll-attributes) :native-id (:native-id coll-attributes))
-         provider-id (get coll-attributes :provider-id "PROV1")
-         response (d/ingest provider-id collection options)]
-     (is (#{{:status 200} {:status 201}} (select-keys response [:status :errors]))))))
-
-(defn assert-invalid-keywords
-  [coll-attributes field-path errors]
-  (assert-invalid coll-attributes field-path errors {:validate-keywords true}))
-
-(defn assert-valid-keywords
-  [coll-attributes]
-  (assert-valid coll-attributes {:validate-keywords true}))
-
-(defn assert-invalid-spatial
-  ([coord-sys shapes field-path errors]
-   (assert-invalid-spatial coord-sys shapes field-path errors nil))
-  ([coord-sys shapes field-path errors options]
-   (let [shapes (map (partial umm-s/set-coordinate-system coord-sys) shapes)]
-     (assert-invalid {:spatial-coverage (dc/spatial {:gsr coord-sys
-                                                     :sr coord-sys
-                                                     :geometries shapes})}
-                     field-path
-                     errors
-                     options))))
-
-(defn assert-valid-spatial
-  [coord-sys shapes]
-  (let [shapes (map (partial umm-s/set-coordinate-system coord-sys) shapes)]
-    (assert-valid {:spatial-coverage (dc/spatial {:gsr coord-sys
-                                                  :sr coord-sys
-                                                  :geometries shapes})})))
-
-(defn assert-conflict
-  [coll-attributes errors]
-  (let [collection (assoc (dc/collection coll-attributes) :native-id (:native-id coll-attributes))
-        response (d/ingest "PROV1" collection {:allow-failure? true})]
-    (is (= {:status 409
-            :errors errors}
-           (select-keys response [:status :errors])))))
-
-(defn- assert-revision-conflict
-  [concept-id format-str response]
-  (is (= {:status 409
-          :errors [(format format-str concept-id)]}
-         response)))
-
-;;;;;;;;;;;;;;;;;;;;
-;; Testing section
-;;;;;;;;;;;;;;;;;;;;
-(use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2"}))
-
-(deftest spatial-with-no-representation
-  ;; ISO19115 allows you to ingest metadata with no spatial coordinate reference but have spatial
-  ;; points. We should reject it because UMM requires a spatial coordinate reference.
-  (testing "A collection with spatial data but no representation should fail ingest validation"
-    (let [bad-metadata (slurp (io/resource
-                                "iso-samples/iso-spatial-data-missing-coordinate-system.iso19115"))
-          {:keys [status errors]}
-          (ingest/ingest-concept (ingest/concept :collection "PROV1" "foo" :iso19115 bad-metadata))]
-
-      (is (= 422 status))
-      (is (= [{:errors ["Spatial coordinate reference type must be supplied."]
-               :path ["SpatialCoverage"]}]
-             errors)))))
-
-(deftest validation-endpoint-test
-  (testing "successful validation of collection"
-    (let [concept (dc/collection-concept {})
-          {:keys [status errors]} (ingest/validate-concept concept)]
-      (is (= [200 nil] [status errors]))))
-  (testing "invalid collection xml fails validation with appropriate message"
-    (let [concept (dc/collection-concept {})
-          {:keys [status errors]}
-          (ingest/validate-concept (assoc concept
-                                          :metadata "<Collection>invalid xml</Collection>"))]
-      (is (= [400 ["Line 1 - cvc-complex-type.2.3: Element 'Collection' cannot have character [children], because the type's content type is element-only."
-                   "Line 1 - cvc-complex-type.2.4.b: The content of element 'Collection' is not complete. One of '{ShortName}' is expected."]]
-             [status errors])))))
-
-(deftest successful-validation-with-accept-header-test
-  (testing "successful validation requests do not get an xml or json response body"
-    (are [accept]
-         (let [collection (dc/collection-dif10 {:processing-level-id "Level 1"})
-               concept (dc/collection-concept collection :dif10)
-               response-map (select-keys (ingest/validate-concept concept {:accept-format accept :raw? true})
-                                         [:status :body])]
-           (= {:status 200 :body ""} response-map))
-         :json :xml)))
-
-(deftest failed-validation-without-headers-returns-xml
-  (testing "failed validations with no accept or content-type header return xml"
-    (let [concept (assoc (dc/collection-concept {}) :metadata "<Collection>invalid xml</Collection>")
-          {:keys [status body]} (ingest/validate-concept concept {:raw? true})]
-      (is (= [400 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><errors><error>Line 1 - cvc-complex-type.2.3: Element 'Collection' cannot have character [children], because the type's content type is element-only.</error><error>Line 1 - cvc-complex-type.2.4.b: The content of element 'Collection' is not complete. One of '{ShortName}' is expected.</error></errors>"]
-             [status body])))))
-
-(deftest collection-keyword-validation-test
-  ;; For a list of the valid keywords during testing see dev-system/resources/kms_examples
-  (testing "Keyword validation using validation endpoint"
-    (let [concept (dc/collection-concept {:platforms [(dc/platform {:short-name "foo"
-                                                                    :long-name "Airbus A340-600"})]})
-          response (ingest/validate-concept concept {:validate-keywords true})]
-      (is (= {:status 422
-              :errors [{:path ["Platforms" 0]
-                        :errors [(str "Platform short name [foo] and long name [Airbus A340-600] "
-                                      "was not a valid keyword combination.")]}]}
-             response))))
-
-  (testing "Project keyword validation"
-    (are2 [short-name long-name]
-          (assert-invalid-keywords
-            {:projects [(assoc (dc/project short-name "") :long-name long-name)]}
-            ["Projects" 0]
-            [(format (str "Project short name [%s] and long name [%s]"
-                          " was not a valid keyword combination.")
-                     short-name long-name)])
-
-          "Invalid short name"
-          "foo" "European Digital Archive of Soil Maps"
-
-          "Invalid with nil long name"
-          "foo" nil
-
-          "Invalid long name"
-          "EUDASM" "foo"
-
-          "Long name was nil in KMS"
-          "EUCREX-94" "foo"
-
-          "Invalid combination"
-          "SEDAC/GISS CROP-CLIM DBQ" "European Digital Archive of Soil Maps")
-
-    (are2 [short-name long-name]
-          (assert-valid-keywords
-            {:projects [(assoc (dc/project short-name "") :long-name long-name)]})
-          "Exact match"
-          "EUDASM" "European Digital Archive of Soil Maps"
-
-          "Nil long name in project and in KMS"
-          "EUCREX-94" nil
-
-          "Case Insensitive"
-          "EUDaSM" "European DIgItal ArchIve of SoIl MAps"))
-
-  (testing "Platform keyword validation"
-    (are2 [short-name long-name]
-          (assert-invalid-keywords
-            {:platforms [(dc/platform {:short-name short-name :long-name long-name})]}
-            ["Platforms" 0]
-            [(format (str "Platform short name [%s] and long name [%s]"
-                          " was not a valid keyword combination.")
-                     short-name long-name)])
-
-          "Invalid short name"
-          "foo" "Airbus A340-600"
-
-          "Long name is nil in KMS"
-          "AIRCRAFT" "Airbus A340-600"
-
-          "Invalid long name"
-          "DMSP 5B/F3" "foo"
-
-          "Invalid combination"
-          "DMSP 5B/F3" "Airbus A340-600")
-
-    (are2 [short-name long-name]
-          (assert-valid-keywords
-            {:platforms [(dc/platform {:short-name short-name :long-name long-name})]})
-          "Exact match"
-          "A340-600" "Airbus A340-600"
-
-          "Case Insensitive"
-          "a340-600" "aiRBus A340-600"))
-
-  (testing "Instrument keyword validation"
-    (are2 [short-name long-name]
-          (assert-invalid-keywords
-            {:platforms
-             [(dc/platform
-                {:short-name "A340-600"
-                 :long-name "Airbus A340-600"
-                 :instruments [(dc/instrument {:short-name short-name
-                                               :long-name long-name})]})]}
-            ["Platforms" 0 "Instruments" 0]
-            [(format (str "Instrument short name [%s] and long name [%s]"
-                          " was not a valid keyword combination.")
-                     short-name long-name)])
-          "Invalid short name"
-          "foo" "Airborne Topographic Mapper"
-
-          "Long name is nil in KMS"
-          "ACOUSTIC SOUNDERS" "foo"
-
-          "Invalid long name"
-          "ATM" "foo"
-
-          "Invalid combination"
-          "ATM" "Land, Vegetation, and Ice Sensor")
-
-    (are2 [short-name long-name]
-          (assert-valid-keywords
-            {:platforms
-             [(dc/platform
-                {:short-name "A340-600"
-                 :long-name "Airbus A340-600"
-                 :instruments [(dc/instrument {:short-name short-name
-                                               :long-name long-name})]})]})
-          "Exact match"
-          "ATM" "Airborne Topographic Mapper"
-
-          "Nil long name in project and in KMS"
-          "ACOUSTIC SOUNDERS" nil
-
-          "Case Insensitive"
-          "Atm" "aIRBORNE Topographic Mapper"))
-
-  (testing "Science Keyword validation"
-    (are [attribs]
-         (let [sk (dc/science-keyword attribs)]
-           (assert-invalid-keywords
-             {:science-keywords [sk]}
-             ["ScienceKeywords" 0]
-             [(msg/science-keyword-not-matches-kms-keywords sk)]))
-
-         {:category "foo"
-          :topic "DATA ANALYSIS AND VISUALIZATION"
-          :term "GEOGRAPHIC INFORMATION SYSTEMS"}
-
-         {:category "EARTH SCIENCE SERVICES"
-          :topic "foo"
-          :term "GEOGRAPHIC INFORMATION SYSTEMS"}
-
-         {:category "EARTH SCIENCE SERVICES"
-          :topic "DATA ANALYSIS AND VISUALIZATION"
-          :term "foo"}
-
-         {:category "EARTH SCIENCE SERVICES"
-          :topic "DATA ANALYSIS AND VISUALIZATION"
-          :term "GEOGRAPHIC INFORMATION SYSTEMS"
-          :variable-level-1 "foo"}
-
-         {:category "EARTH SCIENCE"
-          :topic "ATMOSPHERE"
-          :term "AEROSOLS"
-          :variable-level-1 "AEROSOL OPTICAL DEPTH/THICKNESS"
-          :variable-level-2 "foo"}
-
-         {:category "EARTH SCIENCE"
-          :topic "ATMOSPHERE"
-          :term "ATMOSPHERIC TEMPERATURE"
-          :variable-level-1 "SURFACE TEMPERATURE"
-          :variable-level-2 "MAXIMUM/MINIMUM TEMPERATURE"
-          :variable-level-3 "foo"}
-
-         ;; Invalid combination. Topic is valid but not with these other terms
-         {:category "EARTH SCIENCE SERVICES"
-          :topic "ATMOSPHERE"
-          :term "GEOGRAPHIC INFORMATION SYSTEMS"})
-
-    (are [attribs]
-         (assert-valid-keywords {:science-keywords [(dc/science-keyword attribs)]})
-
-         {:category "EARTH SCIENCE SERVICES"
-          :topic "DATA ANALYSIS AND VISUALIZATION"
-          :term "GEOGRAPHIC INFORMATION SYSTEMS"}
-
-         {:category "EARTH SCIENCE SERVICES"
-          :topic "DATA ANALYSIS AND VISUALIZATION"
-          :term "GEOGRAPHIC INFORMATION SYSTEMS"
-          :variable-level-1 "MOBILE GEOGRAPHIC INFORMATION SYSTEMS"}
-
-         {:category "EARTH SCIENCE"
-          :topic "ATMOSPHERE"
-          :term "AEROSOLS"
-          :variable-level-1 "AEROSOL OPTICAL DEPTH/THICKNESS"
-          :variable-level-2 "ANGSTROM EXPONENT"}
-
-         {:category "EARTH SCIENCE"
-          :topic "ATMOSPHERE"
-          :term "ATMOSPHERIC TEMPERATURE"
-          :variable-level-1 "SURFACE TEMPERATURE"
-          :variable-level-2 "MAXIMUM/MINIMUM TEMPERATURE"
-          :variable-level-3 "24 HOUR MAXIMUM TEMPERATURE"
-          :detailed-variable-level "This is ignored"}
-
-         {:category "EARTH SCiENCE"
-          :topic "ATMOsPHERE"
-          :term "ATMOSpHERIC TEMPERATURE"
-          :variable-level-1 "SuRFACE TEMPERATURE"
-          :variable-level-2 "MAXiMUM/MiNiMUM TEMPERATURE"
-          :variable-level-3 "24 HOUR MAXiMUM TEMPERATURE"})))
-
-(deftest collection-umm-spec-validation-test
-  (testing "UMM-C JSON-Schema validation through config settings"
-    (testing "schema validation errors returned"
-      (side/eval-form `(icfg/set-return-umm-json-validation-errors! true))
-      (let [response (d/ingest "PROV1"
-                               (dc/collection {:product-specific-attributes
-                                               [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                (dc/psa {:name "bool2" :data-type :boolean :value true})]})
-                               {:allow-failure? true})]
-        (is (= {:status 422
-                :errors ["object has missing required properties ([\"DataCenters\",\"Platforms\",\"ProcessingLevel\",\"RelatedUrls\",\"ScienceKeywords\",\"SpatialExtent\",\"TemporalExtents\"])"]}
-               (select-keys response [:status :errors])))))
-
-    (testing "schema validation errors not returned"
-      (side/eval-form `(icfg/set-return-umm-json-validation-errors! false))
-      (assert-valid {:product-specific-attributes [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                   (dc/psa {:name "bool2" :data-type :boolean :value true})]})))
-
-  (testing "UMM-C JSON-Schema validation through Cmr-Validate-Umm-C header"
-    (testing "schema validation errors returned when Cmr-Validate-Umm-C header is true"
-      (let [response (d/ingest "PROV1" (dc/collection {:product-specific-attributes
-                                                       [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                        (dc/psa {:name "bool2" :data-type :boolean :value true})]})
-                               {:allow-failure? true :validate-umm-c true})]
-        (is (= {:status 422
-                :errors ["object has missing required properties ([\"DataCenters\",\"Platforms\",\"ProcessingLevel\",\"RelatedUrls\",\"ScienceKeywords\",\"SpatialExtent\",\"TemporalExtents\"])"]}
-               (select-keys response [:status :errors])))))
-
-    (testing "schema validation error returns is controlled by config setting when Cmr-Validate-Umm-C header is NOT true"
-      (let [coll-attr {:product-specific-attributes
-                       [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                        (dc/psa {:name "bool2" :data-type :boolean :value true})]}]
-        (side/eval-form `(icfg/set-return-umm-json-validation-errors! false))
-        (are3 [coll-attributes options]
-              (assert-valid coll-attributes options)
-
-              "Set Cmr-Validate-Umm-C header to false - schema validation error is not returned"
-              coll-attr
-              {:allow-failure? true :validate-umm-c false}
-
-              "Do not set Cmr-Validate-Umm-C header - schema validation error is not returned"
-              coll-attr
-              {:allow-failure? true}))))
-
-  (testing "UMM-SPEC validation through Cmr-Validation-Umm-C header"
-    (let [coll-attr {:processing-level-id "1"
-                     :science-keywords [(dc/science-keyword {:category "upcase"
-                                                             :topic "Cool"
-                                                             :term "Mild"})]
-                     :spatial-coverage (dc/spatial {:gsr :cartesian})
-                     :related-urls [(dc/related-url {:type "type" :url "http://www.foo.com"})]
-                     :organizations [{:type :archive-center :org-name "Larc"}]
-                     :platforms [{:short-name "plat"
-                                  :long-name "plat"
-                                  :type "Aircraft"
-                                  :instruments [{:short-name "inst"}]}]
-                     :beginning-date-time "1965-12-12T07:00:00.000-05:00"
-                     :ending-date-time "1967-12-12T07:00:00.000-05:00"
-                     :product-specific-attributes
-                     [(dc/psa {:name "bool" :data-type :boolean :value true})
-                      (dc/psa {:name "bool" :data-type :boolean :value true})]}]
-      (side/eval-form `(icfg/set-return-umm-json-validation-errors! false))
-      (side/eval-form `(icfg/set-return-umm-spec-validation-errors! false))
-      (are3 [coll-attributes field-path error options]
-            (assert-invalid coll-attributes field-path error options)
-
-            "Set Cmr-Validate-Umm-C header to true - schema validation passed, umm-spec validation error is returned"
-            coll-attr
-            ["AdditionalAttributes"]
-            ["Additional Attributes must be unique. This contains duplicates named [bool]."]
-            {:validate-umm-c true}
-
-            "Set Cmr-Validate-Umm-C header to false - schema validation passed, umm-spec validation error is not returned"
-            coll-attr
-            ["ProductSpecificAttributes"]
-            ["Product Specific Attributes must be unique. This contains duplicates named [bool]."]
-            {:validate-umm-c false}
-
-            "Do not set Cmr-Validate-Umm-C header - schema validation passed, umm-spec validation error is not returned"
-            coll-attr
-            ["ProductSpecificAttributes"]
-            ["Product Specific Attributes must be unique. This contains duplicates named [bool]."]
-            nil)))
-
-  (side/eval-form `(icfg/set-return-umm-spec-validation-errors! true))
-
-  (testing "Additional Attribute validation"
-    (assert-invalid
-      {:product-specific-attributes
-       [(dc/psa {:name "bool" :data-type :boolean :value true})
-        (dc/psa {:name "bool" :data-type :boolean :value true})]}
-      ["AdditionalAttributes"]
-      ["Additional Attributes must be unique. This contains duplicates named [bool]."]))
-
-  (testing "Nested Path Validation"
-    (assert-invalid
-      {:platforms [(dc/platform {:instruments [(dc/instrument {:short-name "I1"})
-                                               (dc/instrument {:short-name "I1"})]})]}
-      ["Platforms" 0 "Instruments"]
-      ["Instruments must be unique. This contains duplicates named [I1]."]))
-
-  (testing "Spatial validation"
-    (testing "geodetic polygon"
-      ;; Invalid points are caught in the schema validation
-      (assert-invalid-spatial
-        :geodetic
-        [(polygon 180 90, -180 90, -180 -90, 180 -90, 180 90)]
-        ["SpatialExtent" "HorizontalSpatialDomain" "Geometry" "GPolygons" 0]
-        ["Spatial validation error: The shape contained duplicate points. Points 1 [lon=180 lat=90] and 2 [lon=-180 lat=90] were considered equivalent or very close."
-         "Spatial validation error: The shape contained duplicate points. Points 3 [lon=-180 lat=-90] and 4 [lon=180 lat=-90] were considered equivalent or very close."
-         "Spatial validation error: The shape contained consecutive antipodal points. Points 2 [lon=-180 lat=90] and 3 [lon=-180 lat=-90] are antipodal."
-         "Spatial validation error: The shape contained consecutive antipodal points. Points 4 [lon=180 lat=-90] and 5 [lon=180 lat=90] are antipodal."]))
-
-    (testing "geodetic polygon with holes"
-      ;; Hole validation is not supported yet. See CMR-1173.
-      ;; Holes are ignored during validation for now.
-      (assert-valid-spatial
-        :geodetic
-        [(poly/polygon [(umm-s/ords->ring 1 1, -1 1, -1 -1, 1 -1, 1 1)
-                        (umm-s/ords->ring 0,0, 0.00004,0, 0.00006,0.00005, 0.00002,0.00005, 0,0)])]))
-    (testing "cartesian polygon"
-      ;; The same shape from geodetic is valid as a cartesian.
-      ;; Cartesian validation is not supported yet. See CMR-1172
-      (assert-valid-spatial :cartesian
-                            [(polygon 180 90, -180 90, -180 -90, 180 -90, 180 90)]))
-
-    (testing "geodetic line"
-      (assert-invalid-spatial
-        :geodetic
-        [(l/ords->line-string :geodetic [0,0,1,1,2,2,1,1])]
-        ["SpatialExtent" "HorizontalSpatialDomain" "Geometry" "Lines" 0]
-        ["Spatial validation error: The shape contained duplicate points. Points 2 [lon=1 lat=1] and 4 [lon=1 lat=1] were considered equivalent or very close."]))
-
-    (testing "cartesian line"
-      ;; Cartesian line validation isn't supported yet. See CMR-1172
-      (assert-valid-spatial
-        :cartesian
-        [(l/ords->line-string :cartesian [180 0, -180 0])]))
-
-    (testing "bounding box"
-      (assert-invalid-spatial
-        :geodetic
-        [(m/mbr -180 45 180 46)]
-        ["SpatialExtent" "HorizontalSpatialDomain" "Geometry" "BoundingRectangles" 0]
-        ["Spatial validation error: The bounding rectangle north value [45] was less than the south value [46]"])))
-  (side/eval-form `(icfg/set-return-umm-spec-validation-errors! false)))
-
-(deftest duplicate-entry-title-test
-  (testing "same entry-title and native-id across providers is valid"
-    (assert-valid
-      {:entry-title "ET-1" :concept-id "C1-PROV1" :native-id "Native1"})
-    (assert-valid
-      {:entry-title "ET-1" :concept-id "C1-PROV2" :native-id "Native1" :provider-id "PROV2"}))
-
-  (testing "entry-title must be unique for a provider"
-    (assert-conflict
-      {:entry-title "ET-1" :concept-id "C2-PROV1" :native-id "Native2"}
-      ["The Entry Title [ET-1] must be unique. The following concepts with the same entry title were found: [C1-PROV1]."])))
-
-(deftest revision-id-validations
-  (testing "ingesting a concept with the same concept-id and revision-id fails"
-    (let [concept-id "C1-PROV1"
-          existing-concept (dc/collection-concept {:revision-id 1 :concept-id concept-id})
-          _ (ingest/ingest-concept existing-concept)
-          response (ingest/ingest-concept existing-concept)]
-      (is (= {:status 409
-              :errors [(format "Expected revision-id of [2] got [1] for [%s]" concept-id)]}
-             response))))
-
-  (testing "attempting to ingest using an non-integer revision id returns an error"
-    (let [response (ingest/ingest-concept (dc/collection-concept {:concept-id "C2-PROV1"
-                                                                  :revision-id "NaN"}))]
-      (is (= {:status 422
-              :errors [(msg/invalid-revision-id "NaN")]}
-             response))))
-
-  (testing "attempting to ingest using a negative revision id returns an error"
-    (let [response (ingest/ingest-concept (dc/collection-concept {:concept-id "C2-PROV1"
-                                                                  :revision-id "-1"}))]
-      (is (= {:status 422
-              :errors [(msg/invalid-revision-id "-1")]}
-             response))))
-
-  (testing "ingesting a concept with just the revision-id succeeds"
-    (let [response (ingest/ingest-concept (dc/collection-concept {:revision-id "2"}))]
-      (is (and (= 200 (:status response)) (= 2 (:revision-id response))))))
-
-  (testing "ingesting a concept while skipping revision-ids succeeds,
-            but fails if revision id is smaller than the maximum revision id"
-    (let [concept-id "C3-PROV1"
-          coll (dc/collection-concept {:concept-id concept-id})
-          _ (ingest/ingest-concept (assoc coll :revision-id "2"))
-          response1 (ingest/ingest-concept (assoc coll :revision-id "6"))
-          response2 (ingest/ingest-concept (assoc coll :revision-id "4"))]
-      (is (and (= 200 (:status response1)) (= 6 (:revision-id response1))))
-      (is (= {:status 409
-              :errors [(format "Expected revision-id of [7] got [4] for [%s]" concept-id)]}
-             response2)))))
-
-;; Added to test out of order processing of ingest and delete requests with revision-ids in their
-;; header. The proper handling of incorrectly ordered requests is important for Virtual Product
-;; Service which picks events off the queue and sends them to ingest service. It cannot be
-;; guaranteed that the ingest events are processed by Virtual Product Service in the same order
-;; that the events are placed on the queue.
-(deftest revision-conflict-tests
-  (testing "Update with lower revision id should be rejected
-            if it comes after an concept with a higher revision id"
-    (let [concept (dc/collection-concept {:revision-id 4})
-          concept-id (:concept-id (ingest/ingest-concept concept))
-          response (ingest/ingest-concept (assoc concept :revision-id 2))]
-      (assert-revision-conflict concept-id "Expected revision-id of [5] got [2] for [%s]" response)))
-
-  (testing "Delete with lower revision id than latest concept should be rejected"
-    (let [concept (dc/collection-concept {:revision-id 4})
-          concept-id (:concept-id (ingest/ingest-concept concept))
-          response (ingest/delete-concept concept {:revision-id 2})]
-      (assert-revision-conflict concept-id "Expected revision-id of [5] got [2] for [%s]" response)))
-
-  (testing "Ingest with lower revision id than latest tombstone should be rejected"
-    (let [concept (dc/collection-concept {})
-          concept-id (:concept-id (ingest/ingest-concept concept))
-          _ (ingest/delete-concept concept {:revision-id 5})
-          response (ingest/ingest-concept (assoc concept :revision-id 3))]
-      (assert-revision-conflict concept-id "Expected revision-id of [6] got [3] for [%s]" response)))
-
-  (testing "Delete with lower revision id than latest tombstone results in a 404"
-    (let [concept (dc/collection-concept {})
-          concept-id (:concept-id (ingest/ingest-concept concept))
-          _ (ingest/delete-concept concept {:revision-id 5})
-          {:keys [status errors]} (ingest/delete-concept concept {:revision-id 3})]
-      (is (= status 404))
-      (is (= errors [(format "Concept with native-id [%s] and concept-id [%s] is already deleted."
-                             (:native-id concept) concept-id)]))))
-
-  (testing "Deleting non-existent collection should be rejected"
-    (let [concept (dc/collection-concept {})
-          response (ingest/delete-concept concept {:revision-id 2})
-          {:keys [status errors]} response]
-      (is (= status 404))
-      (is (re-find #"Collection .* does not exist" (first errors))))))
-
-(deftest nil-version-test
-  (testing "Collections with nil versions are rejected"
-    (let [concept (dc/collection-concept {:version-id nil} :iso19115)
-          response (ingest/ingest-concept concept)]
-      (is (= {:status 422
-              :errors ["Version is required."]}
-             response)))))
-
-(deftest dif-to-echo10-conversion
-  (testing "Conversion from dif9 to echo10 is successful"
-    (let [coll (d/ingest "PROV1"
-                         (dc/collection-dif
-                           {:short-name "S1"
-                            :version-id "V1"
-                            :entry-title "ET1"
-                            :long-name "L4"
-                            :summary (name :dif)
-                            ;; The following fields are needed for DIF to pass xml validation
-                            :science-keywords [(dc/science-keyword {:category "upcase"
-                                                                    :topic "Cool"
-                                                                    :term "Mild"})]
-                            :organizations [(dc/org :distribution-center "Larc")]
-                            ;; The following fields are needed for DIF10 to pass xml validation
-                            :beginning-date-time "1965-12-12T12:00:00Z"
-                            :ending-date-time "1967-12-12T12:00:00Z"
-                            :product-specific-attributes
-                             [(c/map->ProductSpecificAttribute {:name "moo" :data-type :string})]})
-                         {:format :dif})
-          response (search/retrieve-concept (:concept-id coll) nil {:accept mt/echo10})
-          concept-map {:metadata (:body response)
-                       :format mt/echo10
-                       :concept-type :collection
-                       :provider-id "PROV1"
-                       :native-id "new collection"}
-          {:keys [status body]} (ingest/validate-concept concept-map {:raw? true})]
-      (is (= 200 status)))))
-
-(deftest umm-spec-validation-warnings
-  ;; By default the config return-umm-spec-validation-errors is false, so warnings are returned with the collection.
-  (testing "Ingest and Ingest Validation with warning messages for all formats"
-    (are3 [format collection warning-message]
-          (do
-            (let [response (d/ingest "PROV1" collection {:format format})]
-              (is (#{200 201} (:status response)))
-              (is (= warning-message (:warnings response))))
-            (let [response (ingest/validate-concept (dc/collection-concept collection format))]
-              (is (= 200 (:status response)))
-              (is (= warning-message (:warnings response)))))
-
-          "ECHO10 Ingest and Ingest Validation"
-          :echo10 (dc/collection {}) "After translating item to UMM-C the metadata had the following issue: object has missing required properties ([\"DataCenters\",\"Platforms\",\"ProcessingLevel\",\"RelatedUrls\",\"ScienceKeywords\",\"SpatialExtent\",\"TemporalExtents\"])"
-
-          "DIF10 Ingest and Ingest Validation"
-          :dif10 (dc/collection-dif10 {}) "After translating item to UMM-C the metadata had the following issue: object has missing required properties ([\"ProcessingLevel\"])"
-
-          "DIF9 Ingest and Ingest Validation"
-          :dif (dc/collection-dif {}) "After translating item to UMM-C the metadata had the following issue: object has missing required properties ([\"Platforms\",\"ProcessingLevel\",\"RelatedUrls\",\"SpatialExtent\",\"TemporalExtents\"])"
-
-          "ISO19115 Ingest and Ingest Validation"
-          :iso19115 (dc/collection {}) "After translating item to UMM-C the metadata had the following issue: object has missing required properties ([\"DataCenters\",\"Platforms\",\"ProcessingLevel\",\"RelatedUrls\",\"ScienceKeywords\",\"SpatialExtent\",\"TemporalExtents\"])"
-
-          "ISO SMAP Ingest and Ingest Validation"
-          :iso-smap (dc/collection-smap {}) "After translating item to UMM-C the metadata had the following issue: object has missing required properties ([\"DataCenters\",\"Platforms\",\"ProcessingLevel\",\"RelatedUrls\",\"ScienceKeywords\",\"SpatialExtent\",\"TemporalExtents\"])"
-
-          "DIF9 with no version - has warnings, but passes ingest"
-          :dif (assoc-in (dc/collection-dif {}) [:product :version-id] nil)
-          "After translating item to UMM-C the metadata had the following issue: object has missing required properties ([\"Platforms\",\"ProcessingLevel\",\"RelatedUrls\",\"SpatialExtent\",\"TemporalExtents\",\"Version\"])")))
-
-(deftest field-exceeding-maxlength-warnings
-  (testing "Multiple warnings returned for the fields exceeding maxlength allowed"
-    (let [collection (dc/collection-dif10
-                       {:platforms [(dc/platform {:short-name (apply str (repeat 81 "x"))})]
-                        :purpose (apply str (repeat 12000 "y"))
-                        :product (dc/product {:processing-level-id "1"})})
-          ingest-response (d/ingest "PROV1" collection {:format :dif10})
-          validation-response (ingest/validate-concept (dc/collection-concept collection :dif10))]
-      (is (some? (re-find #"/Platforms/0/ShortName string.*is too long \(length: 81, maximum allowed: 80\)" (:warnings ingest-response))))
-      (is (some? (re-find #"/Platforms/0/ShortName string.*is too long \(length: 81, maximum allowed: 80\)" (:warnings validation-response))))
-      (is (some? (re-find #"/Purpose string.*is too long \(length: 12000, maximum allowed: 10000\)" (:warnings ingest-response))))
-      (is (some? (re-find #"/Purpose string.*is too long \(length: 12000, maximum allowed: 10000\)" (:warnings validation-response)))))))
-
-(comment
-  (ingest/delete-provider "PROV1")
-  ;; Attempt to create race conditions by ingesting the same concept-id simultaneously. We expect
-  ;; some requests to succeed while others return a 409.
-  ;; If the race condition is reproduced you will see a message like:
-  ;; 409 returned, Errors: [Conflict with existing concept-id [C1-PROV1] and revision-id [23]]
-  (do
-    (cmr.system-int-test.utils.dev-system-util/reset)
-    (ingest/create-provider {:provider-guid "provguid1" :provider-id "PROV1"})
-
-    (doseq [_ (range 150)]
-      (future (do (let [response (ingest/ingest-concept
-                                   (dc/collection-concept {:concept-id "C1-PROV1"
-                                                           :native-id "Same Native ID"}))]
-                    (when (= 409 (:status response))
-                      (println "409 returned, Errors:" (:errors response)))))))))


Support for parsing large numbers

Support for parsing large numbers

--- server/src/spira/core/util.clj
+++ server/src/spira/core/util.clj
@@ -20,8 +20,9 @@
   (str (java.util.UUID/randomUUID)))

 (defn parse-uint [s]
-  "a2uint"
-  (Integer. (re-find  #"\d+" s )))
+  "a2uint (nil if not a number)"
+  (if (re-find #"^\d+$" s)
+    (read-string s)))

 (defn find-first [f coll]
   "Get first item in a seq matching a predicate."


bumping utils version

bumping utils version

--- core/project.clj
+++ core/project.clj
@@ -11,7 +11,7 @@
                  [org.apache.samza/samza-api        "0.9.0"]
                  [org.apache.samza/samza-kafka_2.10 "0.9.0"]
                  [samsara/moebius "0.1.0"]
-                 [samsara/samsara-utils "0.2.0"]
+                 [samsara/samsara-utils "0.3.0"]
                  [samsara/trackit "0.2.0"]
                  [com.taoensso/timbre "3.4.0"]
                  [org.clojure/tools.cli "0.3.1"]


Replace deftypes with ordinary maps

Replace deftypes with ordinary maps

--- lazytest.clj
+++ lazytest.clj
@@ -1,232 +1,91 @@
-;;; TEST2: a new testing framework for Clojure
+;; I want to use deftype, but literal deftype'd objects cannot be
+;; 9embedded in generated code.

-;; by Stuart Sierra, http://stuartsierra.com/
-;; February 19, 2010
+(defn TestCase [contexts locals children]
+  (with-meta {:contexts contexts
+              :locals locals
+              :children children}
+    {:type ::TestCase}))

-;; Copyright (C) 2010 Stuart Sierra.
+(defn Context [before after]
+  (with-meta {:before before
+              :after after}
+    {:type ::Context}))

-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0
-;; <http://opensource.org/licenses/eclipse-1.0.php>.  By using this
-;; software in any fashion, you are agreeing to be bound by the terms
-;; of this license.  You must not remove this notice, or any other,
-;; from this software.
+(defprotocol TestSuccess
+  (success? [r] "Returns true if r is a 100% successful result."))

+(deftype TestResult [source children]
+  TestSuccess (success? [] (every? success? children)))

-;; Second draft: Lazy results
+(deftype AssertionPassed [source]
+  TestSuccess (success? [] true))

+(deftype AssertionFailed [source]
+  TestSuccess (success? [] false))

-(ns clojure.test2)
+(deftype AssertionThrown [source error]
+  TestSuccess (success? [] false))

-(defprotocol Successful
-  (success? [r] "Returns true if the TestResult or
-  SuiteResult was 100% successful."))
+(defn format-assertion [a]
+  `(try (if ~a
+          (AssertionPassed '~a)
+          (AssertionFailed '~a))
+        (catch Throwable t#
+          (AssertionThrown '~a t#))))

-(defprotocol TestRunnable
-  (run-tests [x actives]
-   "Executes the Test or Suite with a map of active contexts."))
+(defn format-tests [t]
+  (let [active (gensym "active")]
+    `(fn [~active ~@(:locals t) & states#]
+       (lazy-seq
+        ~(loop [r nil
+                children (reverse (:children t))]
+           (if (seq children)
+             (let [c (first children)]
+               (recur (if (= ::TestCase (type c))
+                        `(cons (run-tests '~c ~active) ~r)
+                        `(cons ~(format-assertion c) ~r))
+                      (next children)))
+             r))))))

-(deftype Test [locals contexts assertions])
+(defn compile-tests [t]
+  (eval (format-tests t)))

-(deftype Context [before after])
-
-(deftype Suite [contexts children])
-
-(deftype AssertionSuccess [form]
-  Successful (success? [] true))
-
-(deftype AssertionFailure [form]
-  Successful (success? [] false))
-
-(deftype AssertionThrown [form throwable]
-  Successful (success? [] false))
-
-(deftype TestResult [test child-results]
-  Successful (success? [] (every? success? child-results)))
-
-(deftype SuiteResult [suite child-results]
-  Successful (success? [] (every? success? child-results)))
-
-(defmulti report-start type)
-
-(defmulti report-done type)
-
-(defmethod report-start TestResult [tr]
-  (println "Starting test" (:name (meta (:test tr)))))
-
-(defmethod report-done TestResult [tr]
-  (println "Finished test" (:name (meta (:test tr)))))
-
-(defn context?
-  "Returns true if x is a Context."
-  [x]
-  (= ::Context (type x)))
-
-(defn test?
-  "Returns true if x is a Test."
-  [x]
-  (= ::Test (type x)))
-
-(defn suite?
-  "Returns true if x is a Suite."
-  [x]
-  (= ::Suite (type x)))
-
-(defn- format-assertion [expr]
-  `(try (if ~expr
-          (AssertionSuccess '~expr)
-          (AssertionFailure '~expr))
-        (catch Throwable t#
-          (AssertionThrown '~expr t#))))
-
-(defn- format-test [t]
-  {:pre [(test? t)
-         (vector? (:locals t))
-         (every? symbol? (:locals t))]}
-  `(fn ~(:locals t)
-     (lazy-seq
-      ~(loop [r nil, as (reverse (:assertions t))]
-         (if (seq as)
-           (recur (list 'cons (format-assertion (first as)) r)
-                  (next as))
-           r)))))
-
-(defn- compile-test
-  "Compile a Test to a function of its locals."
-  [t]
-  (or (::compiled (meta t))
-      (eval (format-test t))))
-
-(defn- open-context
-  "Calls Context c's :before function, returns result."
-  [actives c]
-  (or (actives c)
-      (when-let [f (:before c)]
-        (f))))
-
-(defn- close-context
-  "Calls Context c's :after function on state."
-  [actives c state]
-  (when-not (contains? actives c)
-    (when-let [f (:after c)]
-      (f state))))
-
-(defn- unchunked-map
-  "Purely lazy map that processes chunked sequences one at a time."
-  [f coll]
+(defn unchunked-map [f coll]
   (lazy-seq
    (when (seq coll)
      (cons (f (first coll))
            (unchunked-map f (next coll))))))

-(extend-protocol TestRunnable
-  ::Test
-  (run-tests [t actives]
-    (let [f (compile-test t)]
-      (if (some :after (:contexts t))
-        ;; strict (non-lazy)
-        (let [states (doall (map (partial open-context actives) (:contexts t)))
-              result (doall (apply f states))]
-          (doall (map (partial close-context actives)
-                      (reverse (:contexts t)) (reverse states)))
-          (TestResult t result))
-        ;; lazy
-        (let [states (map (partial open-context actives) (:contexts t))]
-          (TestResult t (apply f states))))))
-  ::Suite
-  (run-tests [s actives]
-    (if (some :after (:contexts s))
-      ;; strict (non-lazy)
-      (let [states (doall (map (partial open-context actives) (:contexts s)))
-            new-actives (merge actives (zipmap (:contexts s) states))
-            result (doall (map #(run-tests % new-actives) (:children s)))]
-        (doall (map (partial close-context actives)
-                    (reverse (:contexts s)) (reverse states)))
-        (SuiteResult s result))
-      ;; lazy
-      (let [states (map (partial open-context actives) (:contexts s))
-            new-actives (merge actives (zipmap (:contexts s) states))]
-        (SuiteResult s (unchunked-map #(run-tests % new-actives) (:children s)))))))
+(defn run-tests [t active]
+  (let [contexts (:contexts t)
+        states (map (fn [c] (or (active c) ((:before c)))) contexts)
+        ;;_ (prn "States are " states)
+        merged (merge active (zipmap contexts states))
+        ;;_ (prn "Merged is " merged)
+        results (apply (compile-tests t) merged states)
+        closed (map (fn [c state]
+                      (when-not (contains? active c) ((:after c))))
+                    (reverse contexts) (reverse states))]
+    (TestResult t results)))

+(defn doall-results [tr]
+  (doall (tree-seq :children :children tr)))

-(defn run "Executes the Test or Suite."
-  [x] (run-tests x {}))
+(def c1 (Context (fn [] (prn "Opening lazy context c1.") 1) nil))

-(derive ::TestResult ::CollectedResult)
-(derive ::SuiteResult ::CollectedResult)
+(def c2 (Context (fn [] (prn "Opening lazy context c2.") 2.5) nil))

-(defn doall-results
-  "Forces all lazy test results to be evaluated."
-  [x]
-  (cond (isa? (type x) ::CollectedResult)
-          (dorun (map doall-results (:child-results x)))
-        (seq? x)
-          (dorun x)
-        :else x)
-  x)
+(def t1 (TestCase [c1 c2] '[a b]
+                  '[(do (prn "Evaluating test t1-a") (integer? a))
+                    (do (prn "Evaluating test t1-b") (integer? b))]))

-;;; RAW API USAGE:
+(def t2 (TestCase [c1 c2] '[a b]
+                  '[(do (prn "Evaluating test t2-a") (integer? a))
+                    (do (prn "Evaluating test t2-b") (integer? b))]))

-(def c1 (Context (fn [] (prn "Opening context c1.") 1)
-                 (fn [_] (prn "Closing context c1."))))
+(def s1 (TestCase [] [] [t1 t2]))

-(def c2 (Context (fn [] (prn "Opening context c2.") 2.5)
-                 (fn [_] (prn "Closing context c2."))))
+(def s2 (TestCase [c1 c2] [] [t1 t2]))

-(def c3 (Context (fn [] (prn "Opening lazy context c3.") 3)
-                 nil))
-
-(def c4 (Context (fn [] (prn "Opening lazy context c4.") 4.5)
-                 nil))
-
-(def c5 (Context (fn [] (prn "Opening lazy context c5.") 3)
-                 nil))
-
-(def c6 (Context (fn [] (prn "Opening lazy context c6.") 4.5)
-                 nil))
-
-(def t1 (Test '[a b] [c1 c2]
-              '[(do (prn "Evaluating test t1-a.") (integer? a))
-                (do (prn "Evaluating test t1-b.") (integer? b))]))
-
-(def t2 (Test '[a b] [c1 c2]
-              '[(do (prn "Evaluating test t2-a.") (integer? a))
-                (do (prn "Evaluating test t2-b.") (integer? b))]))
-
-(def t3 (Test '[a b] [c3 c4]
-              '[(do (prn "Evaluating test t3-a.") (integer? a))
-                (do (prn "Evaluating test t3-b.") (integer? b))]))
-
-(def t4 (Test '[a b] [c3 c4]
-              '[(do (prn "Evaluating test t4-a.") (integer? a))
-                (do (prn "Evaluating test t4-b.") (integer? b))]))
-
-(def t5 (Test '[a b] [c5 c6]
-              '[(do (prn "Evaluating test t5-a.") (integer? a))
-                (do (prn "Evaluating test t5-b.") (integer? b))]))
-
-(def s1 (Suite [] [t1 t2]))
-
-;; Attaching a Context to a Suite ensures that Context is evaluated
-;; only once for the entire Suite.
-(def s2 (Suite [c1] [t1 t2]))
-
-(def s3 (Suite [c1 c2] [t1 t2]))
-
-;; Tests and Suites are evaluated lazily if and only if none of their
-;; Contexts has an :after function.
-(def s4 (Suite [] [t3 t4]))
-
-(def s5 (Suite [c3 c4] [t3 t4]))
-
-(def s6 (Suite [c3 c4] [t4 t5]))
-
-;; Suites may be nested.
-(def s7 (Suite [] [s3 s5]))
-
-(def s8 (Suite [c1 c2 c3 c4] [s3 s5]))
-
-;; user=> (run s2)
-;; ...
-;; user=> (success? *1)
-;; true
+(def s3 (TestCase [] [] [t1 t2 t1 t2 t1 t2]))


Add history navigation to optimise.descent/interactive

Type 'back' or 'back <steps>' to go back one or the given number of
steps. Also, the function no longer aborts on non-numeric input if the
input begins with 'force' or 'back'.

--- cortex/src/cortex/optimise/descent.clj
+++ cortex/src/cortex/optimise/descent.clj
@@ -52,7 +52,7 @@
            params-history [initial-params]
            value-history [(cp/output function)]
            gradient-history [(cp/gradient function)]]
-      (if-let [{:keys [lrate force?]}
+      (if-let [{:keys [lrate force? back]}
                (loop []
                  (print (util/sformat prompt
                                       (peek value-history)
@@ -60,38 +60,58 @@
                  (flush)
                  (let [input (read-line)
                        _ (when *emacs* (println input))
-                       input (str/trim input)
-                       force? (.startsWith input "force")
-                       input (-> input
-                               (str/replace-first #"^force" "")
-                               (str/trim))]
-                   (if (seq input)
-                     (try
-                       {:lrate (util/parse-double input)
-                        :force? force?}
-                       (catch NumberFormatException _))
-                     (if-let [last-lrate (peek lrate-history)]
-                       {:lrate last-lrate
-                        :force? force?}
-                       (recur)))))]
-        (let [step (* (if normalize?
-                        (m/normalise (peek gradient-history))
-                        (peek gradient-history))
-                      (- lrate))
-              params (+ (peek params-history)
-                        step)
-              function (cp/update-parameters function params)
-              value (cp/output function)]
-          (if (or (< value (peek value-history))
-                  force?)
-            (recur (conj lrate-history lrate)
-                   (conj params-history params)
-                   (conj value-history value)
-                   (conj gradient-history (cp/gradient function)))
-            (recur (conj lrate-history lrate)
-                   (conj params-history (peek params-history))
-                   (conj value-history (peek value-history))
-                   (conj gradient-history (peek gradient-history)))))
+                       input (str/trim input)]
+                   (if (.startsWith input "back")
+                     (let [input (-> input
+                                   (str/replace-first #"^back" "")
+                                   (str/trim))]
+                       (or (try
+                             {:back (if (seq input)
+                                      (let [back (util/parse-long input)]
+                                        (if (neg? back)
+                                          (throw (NumberFormatException.))
+                                          back))
+                                      1)}
+                             (catch NumberFormatException _))
+                           (recur)))
+                     (let [force? (.startsWith input "force")
+                           input (-> input
+                                   (str/replace-first #"^force" "")
+                                   (str/trim))]
+                       (if (seq input)
+                         (or (try
+                               {:lrate (util/parse-double input)
+                                :force? force?}
+                               (catch NumberFormatException _))
+                             (when force? (recur)))
+                         (if-let [last-lrate (peek lrate-history)]
+                           {:lrate last-lrate
+                            :force? force?}
+                           (recur)))))))]
+        (if back
+          (let [length (max 1 (- (count params-history) back))]
+            (recur (m/subvector lrate-history 0 (dec length))
+                   (m/subvector params-history 0 length)
+                   (m/subvector value-history 0 length)
+                   (m/subvector gradient-history 0 length)))
+          (let [step (* (if normalize?
+                          (m/normalise (peek gradient-history))
+                          (peek gradient-history))
+                        (- lrate))
+                params (+ (peek params-history)
+                          step)
+                function (cp/update-parameters function params)
+                value (cp/output function)]
+            (if (or (< value (peek value-history))
+                    force?)
+              (recur (conj lrate-history lrate)
+                     (conj params-history params)
+                     (conj value-history value)
+                     (conj gradient-history (cp/gradient function)))
+              (recur (conj lrate-history lrate)
+                     (conj params-history (peek params-history))
+                     (conj value-history (peek value-history))
+                     (conj gradient-history (peek gradient-history))))))
         (peek params-history)))))

 ;;;; Instrumented gradient descent


Add tests for new cortex.util functions

Add tests for new cortex.util functions

--- cortex/test/cljc/cortex/util_test.cljc
+++ cortex/test/cljc/cortex/util_test.cljc
@@ -3,7 +3,172 @@
     #?(:cljs [cljs.test :refer-macros [deftest is testing]]
        :clj [clojure.test :refer [deftest is testing]])
     [clojure.core.matrix :as m]
+    [clojure.string :as str]
     [cortex.util :refer :all]))
+
+;;;; Mathematics
+
+(deftest clamp-test
+  (is (= (clamp 1 0 3) 1.0))
+  (is (= (clamp 1 2 3) 2.0))
+  (is (= (clamp 1 4 3) 3.0)))
+
+(deftest relative-error-test
+  (is (= (relative-error 10 10) 0.0))
+  (is (= (relative-error 9 10) 0.1))
+  (is (= (relative-error 10 9) 0.1)))
+
+;;;; Sequences
+
+(deftest seq-like?-test
+  (is (false? (seq-like? nil)))
+  (is (false? (seq-like? "Hello")))
+  (is (false? (seq-like? 5)))
+  (is (true? (seq-like? (range 5))))
+  (is (true? (seq-like? [:a :b :c])))
+  (is (true? (seq-like? {:a 1 :b 2})))
+  (is (true? (seq-like? (m/array :vectorz [1 2 3]))))
+  (is (true? (seq-like? (m/array :vectorz [[1 2] [3 4]])))))
+
+(deftest interleave-all-test
+  (is (= (interleave-all) []))
+  (is (= (interleave-all (range 5)) (range 5)))
+  (is (= (interleave-all [:a :b :c] [:d :e] [:f :g :h :i])
+         [:a :d :f :b :e :g :c :h :i])))
+
+;;;; Collections
+
+(deftest map-keys-test
+  (is (= (map-keys name {:a 1 :b 2})
+         {"a" 1 "b" 2}))
+  (is (= (map-keys inc {1 2 3 4})
+         {2 2 4 4}))
+  (is (= (map-keys #(error "key fn should not be called") {})
+         {})))
+
+(deftest map-vals-test
+  (is (= (map-vals dec {:a 1 :b 2})
+         {:a 0 :b 1}))
+  (is (= (map-vals #(cons 0 %) {[1 2] [3 4] [5 6] [7 8]})
+         {[1 2] [0 3 4] [5 6] [0 7 8]})))
+
+(deftest map-entry-test
+  (is (= (key (map-entry :a :b)) :a))
+  (is (= (val (map-entry :a :b)) :b))
+  (is (= (vec (map-entry nil nil)) [nil nil])))
+
+;;;; Lazy maps
+
+(defn make-lazy-map
+  []
+  (->lazy-map
+    {:a (delay (error "value :a should not be realized"))
+     :b 50
+     :c (delay (error "value :c should not be realized"))}))
+
+(deftest lazy-map-test
+  (testing "lazy maps are lazy"
+    (is (= (:b (make-lazy-map))
+           50))
+    (is (= (with-out-str
+             (:c (->lazy-map
+                   {:a (delay (error "value :a should not be realized"))
+                    :b 50
+                    :c (delay (print "value :c was realized"))})))
+           "value :c was realized")))
+  (testing "lazy maps can be called as fns"
+    (is (= (let [m (->lazy-map
+                     {:a 1
+                      :b 2})]
+             (m :b))
+           2)))
+  (testing "keys and vals work on lazy maps"
+    (is (= (set
+             (keys (make-lazy-map)))
+           #{:a :b :c}))
+    (is (= (->> (->lazy-map
+                  {:a (delay (println "value :a was realized"))
+                   :b (delay (println "value :b was realized"))
+                   :c (delay (println "value :c was realized"))})
+             (vals)
+             (take 2)
+             (dorun)
+             (with-out-str)
+             (re-seq #"value :[a-c] was realized")
+             (count))
+           2)))
+  (testing "assoc and dissoc work with lazy maps"
+    (is (= (-> (make-lazy-map)
+             (assoc :d (delay (error "value :d should not be realized")))
+             (keys)
+             (set))
+           #{:a :b :c :d}))
+    (is (= (-> (make-lazy-map)
+             (dissoc :a :b)
+             (keys)
+             (set)
+             #{:c}))))
+  (testing "lazy maps support default value for lookup"
+    (is (= (:d (make-lazy-map) :default)
+           :default))
+    (is (= (get (make-lazy-map) :d :default)
+           :default)))
+  (testing "seqs for lazy maps do not contain delays"
+    (is (= (set (->lazy-map
+                  {:a 1
+                   :b (delay 2)}))
+           #{[:a 1] [:b 2]})))
+  (testing "equality for lazy maps"
+    (is (= (->lazy-map
+             {:a 1
+              :b (delay 2)})
+           {:a 1
+            :b 2})))
+  (testing "reduce and kv-reduce for lazy maps"
+    (is (= (reduce (fn [m [k v]]
+                     (assoc m k v))
+                   {}
+                   (->lazy-map
+                     {:a 1
+                      :b (delay 2)}))
+           {:a 1 :b 2}))
+    (is (= (reduce-kv (fn [m k v]
+                        (assoc m k v))
+                      {}
+                      (->lazy-map
+                        {:a 1
+                         :b (delay 2)}))
+           {:a 1 :b 2})))
+  (testing "string representation of lazy maps"
+    (is (= (pr-str (->lazy-map {:a 1}))
+           "{:a 1}"))
+    (is (= (pr-str (->lazy-map {:a (delay 1)}))
+           "{:a <unrealized>}")))
+  (testing "string representation of lazy map entries"
+    (is (= (pr-str (lazy-map-entry :a 1))
+           "[:a 1]"))
+    (is (= (pr-str (lazy-map-entry :a (delay 1)))
+           "[:a <unrealized>]")))
+  (testing "lazy-map macro"
+    (is (= (with-out-str
+             (let [m (lazy-map
+                       {:a (println "value :a was realized")
+                        :b (println "value :b was realized")
+                        :c (println "value :c was realized")})]
+               (doseq [k [:b :c]]
+                 (k m))))
+           "value :b was realized\nvalue :c was realized\n")))
+  (testing "forcing a lazy map"
+    (is (= (->> (lazy-map
+                  {:a (println "value :a was realized")
+                   :b (println "value :b was realized")})
+             (force-map)
+             (with-out-str)
+             (re-seq #"value :[ab] was realized")
+             (set))
+           #{"value :a was realized" "value :b was realized"}))))
+
+;;;; Confusion matrices

 (deftest confusion-test
   (let [cf (confusion-matrix ["cat" "dog" "rabbit"])
@@ -31,3 +196,52 @@

 (deftest test-mse-gradient
   (is (m/equals [-2 0 2] (mse-gradient-fn [10 11 12] [11 11 11]))))
+
+;;;; Formatting
+
+(deftest parse-long-test
+  (is (= (parse-long "5") 5))
+  (is (= (parse-long "-47") -47)))
+
+(deftest parse-double-test
+  (is (= (parse-double "5") 5.0))
+  (is (= (parse-double "-7.77e-7") -7.77e-7)))
+
+(deftest fmt-string-regex-test
+  (is (= (rest (re-matches fmt-string-regex "%3$2s"))
+         ["3" "2s"]))
+  (is (= (rest (re-matches fmt-string-regex "%(,.2f"))
+         [nil "(,.2f"]))
+  (is (= (map rest (re-seq fmt-string-regex "%1$tm %1$te,%1$tY"))
+         [["1" "tm"]
+          ["1" "te"]
+          ["1" "tY"]]))
+  (is (= (map rest (re-seq fmt-string-regex "Format %1$s as %1$.2f using the %%.2f formatter%n."))
+         [["1" "s"]
+          ["1" ".2f"]
+          [nil "%"]
+          [nil "n"]])))
+
+(deftest sformat-test
+  (testing "basic formatting"
+    (is (= (sformat "Hello, %s!" "world")
+           "Hello, world!")))
+  (testing "numeric formatting and %% specifier"
+    (is (= (sformat "Sales tax of %d%% on $%.2f item" 37 1.25)
+           "Sales tax of 37% on $1.25 item")))
+  (testing "autocasting"
+    (is (= (sformat "Long as double %.2f and double as long %d" 3141 2.718)
+           "Long as double 3141.00 and double as long 2")))
+  (testing "positional arguments"
+    (is (= (sformat "%s %% %1$s %s %3$s %3$s %% %s %2$s %s" 1 2 3 4)
+           "1 % 1 2 3 3 % 3 2 4")))
+  (testing "map format specifier over collections"
+    (is (= (sformat "%1$.2f %1$.4f" [Math/PI Math/E 5])
+           "[3.14 2.72 5.00] [3.1416 2.7183 5.0000]")))
+  (testing "formatting core.matrix arrays as nested collections"
+    (is (= (sformat "%.1f" (m/identity-matrix :vectorz 2))
+           "[[1.0 0.0] [0.0 1.0]]"))))
+
+(deftest sprintf-test
+  (is (= (with-out-str (sprintf "%(d%n" [[1 -3 5] [-7 3]]))
+         "[[1 (3) 5] [(7) 3]]\n")))


vp-pronoun: aux=false

vp-pronoun: aux=false

--- src/babel/english/grammar.clj
+++ src/babel/english/grammar.clj
@@ -335,7 +335,8 @@
                                    :synsem {:cat :noun
                                             :pronoun true}}
                             :rule "vp-pronoun"
-                            :synsem {:cat :verb}})
+                            :synsem {:aux false
+                                     :cat :verb}})

                    (unifyc h10
                            {:head {:phrasal false


Work in progress on track-editor for delete.

--- sonic-jam/src/sonic_jam/core.cljs
+++ sonic-jam/src/sonic_jam/core.cljs
@@ -33,37 +33,26 @@

 (declare grid-view)

-(defn track-view [{:keys [cursor id]} owner]
-  (reify
-    om/IInitState
-    (init-state [_]
-      {:track-expanded true})
-    om/IWillMount
-    (will-mount [_]
-      (when (= "grid" (get cursor "type"))
-        (go (>! (om/get-state owner :get-state-ch) (get cursor "id")))))
-    om/IRenderState
-    (render-state [_ state]
-      (if-not (:track-expanded state)
-        (dom/tr nil (dom/td #js {:onClick #(om/set-state! owner :track-expanded true)
-                                 :style #js {:color "#999"}} ">"))
-        (dom/tr nil
-                (dom/td #js {:onClick #(om/set-state! owner :track-expanded false)
-                             :style #js {:color "#999"}} "<")
-                (dom/td nil
-                 (dom/table nil
-                  (apply dom/tr nil
-                         (let [cursors (map #(hash-map :cursor %1 :id %2)
-                                            (get cursor "beats")
-                                            (repeat id))]
-                           (om/build-all cell-view cursors {:state state})))))
-                (dom/td #js {:style #js {:color "#999" :paddingRight "10px"}} "{~}")
-                (dom/td nil
-                        (when (= "grid" (get cursor "type"))
-                          (let [id (get cursor "id")
-                                sub-state {:set-state-ch (:set-state-ch state)
-                                           :get-state-ch (:get-state-ch state)}]
-                            (om/build grid-view id {:state sub-state})))))))))
+(defn track-editor [{:keys [cursor id index set-state-ch]} owner]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:state :init})
+    om/IRenderState
+    (render-state [_ state]
+      (let [delete #(let [grid (get (om/observe owner (grids)) id)]
+                      (om/transact! (get grid "tracks")
+                                    (fn [s]
+                                      (print index)
+                                      (vec (concat (subvec s 0 index)
+                                                   (subvec s (+ 1 index) (count s)))))))]
+        (condp = (:state state)
+          :init (dom/p #js {:style #js {:color "#999"}}
+                       (dom/span #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :open})))} "{~}"))
+          :open (dom/p #js {:style #js {:color "#999"}}
+                       (dom/span #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :init})))} "{-")
+                       (dom/span #js {:onClick delete} " delete? ")
+                       (dom/span nil "}")))))))

 (defn track-builder [{:keys [cursor id set-state-ch]} owner]
   (reify
@@ -142,6 +131,39 @@
                      (dom/span #js {:onClick commit} " commit? ")
                      (dom/span nil "}")))))))

+(defn track-view [{:keys [cursor id index]} owner]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:track-expanded true})
+    om/IWillMount
+    (will-mount [_]
+      (when (= "grid" (get cursor "type"))
+        (go (>! (om/get-state owner :get-state-ch) (get cursor "id")))))
+    om/IRenderState
+    (render-state [_ state]
+      (if-not (:track-expanded state)
+        (dom/tr nil (dom/td #js {:onClick #(om/set-state! owner :track-expanded true)
+                                 :style #js {:color "#999"}} ">"))
+        (dom/tr nil
+                (dom/td #js {:onClick #(om/set-state! owner :track-expanded false)
+                             :style #js {:color "#999"}} "<")
+                (dom/td nil
+                 (dom/table nil
+                  (apply dom/tr nil
+                         (let [cursors (map #(hash-map :cursor %1 :id %2)
+                                            (get cursor "beats")
+                                            (repeat id))]
+                           (om/build-all cell-view cursors {:state state})))))
+                (dom/td #js {:style #js {:color "#999" :paddingRight "10px"}}
+                        (om/build track-editor {:id id :index index}))
+                (dom/td nil
+                        (when (= "grid" (get cursor "type"))
+                          (let [id (get cursor "id")
+                                sub-state {:set-state-ch (:set-state-ch state)
+                                           :get-state-ch (:get-state-ch state)}]
+                            (om/build grid-view id {:state sub-state})))))))))
+
 (defn grid-view [id owner]
   (reify
     om/IInitState
@@ -162,9 +184,10 @@
                                         :style #js {:color "#999"}}
                                    (str "[-] " id " (" (get cursor "bpc") ")"))
                             (apply dom/table nil
-                                   (let [cursors (map #(hash-map :cursor %1 :id %2)
+                                   (let [cursors (map #(hash-map :cursor %1 :id %2 :index %3)
                                                       (get cursor "tracks")
-                                                      (repeat id))]
+                                                      (repeat id)
+                                                      (range))]
                                      (om/build-all track-view cursors {:state state})))
                             (om/build track-builder {:cursor (get cursor "tracks")
                                                      :id id


Implement Tenma Line.

Implement Tenma Line.

--- src/clj/game/cards-assets.clj
+++ src/clj/game/cards-assets.clj
@@ -442,6 +442,33 @@
    {:events {:runner-spent-click {:req (req (not (= (:server run) (:zone card)))) :once :per-turn
                                   :msg "gain 2 [Credits]" :effect (effect (gain :corp :credit 2))}}}

+   "Tenma Line"
+   (let [ice-index (fn [state i] (first (keep-indexed #(when (= (:cid %2) (:cid i)) %1)
+                                                      (get-in @state (cons :corp (:zone i))))))]
+     {:abilities [{:label "Swap 2 pieces of installed ICE"
+                   :cost [:click 1]
+                   :prompt "Select two pieces of ICE to swap positions"
+                   :choices {:req #(and (= (first (:zone %)) :servers) (= (:type %) "ICE")) :max 2}
+                   :effect (req (if (= (count targets) 2)
+                                  (let [fndx (ice-index state (first targets))
+                                        sndx (ice-index state (second targets))
+                                        fnew (assoc (first targets) :zone (:zone (second targets)))
+                                        snew (assoc (second targets) :zone (:zone (first targets)))]
+                                    (swap! state update-in (cons :corp (:zone (first targets)))
+                                           #(assoc % fndx snew))
+                                    (swap! state update-in (cons :corp (:zone (second targets)))
+                                           #(assoc % sndx fnew))
+                                    (doseq [newcard [fnew snew]]
+                                      (doseq [h (:hosted newcard)]
+                                        (let [newh (-> h (assoc-in [:zone] '(:onhost))
+                                                       (assoc-in [:host :zone] (:zone newcard)))]
+                                          (update! state side newh)
+                                          (unregister-events state side h)
+                                          (register-events state side (:events (card-def newh)) newh))))
+                                    (update-ice-strength state side fnew)
+                                    (update-ice-strength state side snew))))
+                   :msg "swap the positions of two ICE"}]})
+
    "Team Sponsorship"
    {:events {:agenda-scored
              {:prompt "Install a card from Archives or HQ?" :choices ["Archives" "HQ"]


cached scan

cached scan

--- src/clj/hdfs_cleaner/hdfs.clj
+++ src/clj/hdfs_cleaner/hdfs.clj
@@ -1,10 +1,11 @@
 (ns hdfs-cleaner.hdfs
   (:require [cluster-connector.utils.for-debug :refer [$ spy]]
+            [cluster-connector.native-cache.core :refer [defcache]]
             [taoensso.timbre :as log])
   (:import (com.factual.hdfs_cleaner HDFS)
            (org.apache.hadoop.fs Path FileStatus)))

-(defn scan* [^Path path]
+(defn scan** [^Path path]
   (map
     (fn [^FileStatus file]
       (merge {:name (-> file (.getPath) (.getName))
@@ -13,7 +14,7 @@
               :last-modified (.getModificationTime file)
               :replication (.getReplication file)}
              (try
-               (let [sub-files (when (.isDirectory file) (scan* (.getPath  file)))]
+               (let [sub-files (when (.isDirectory file) (scan** (.getPath  file)))]
                  {:sub-files sub-files
                   :size (if sub-files
                           (reduce + (map :size sub-files))
@@ -23,8 +24,12 @@
                  {:has-error true}))))
     (.listStatus HDFS/dfs path)))

-(defn scan [^String path]
+(defn scan* [^String path]
   (let [start-time (System/currentTimeMillis)]
-    {:result (scan* (Path. path))
+    {:result (scan** (Path. path))
      :start-time start-time
-     :end-time (System/currentTimeMillis)}))+     :end-time (System/currentTimeMillis)}))
+
+(defcache
+  scan {:expire-after-write-secs (* 5 1000)}
+  (fn [path] (future (scan* path))))


process evidence type

process evidence type

--- src/clj/salava/badge/main.clj
+++ src/clj/salava/badge/main.clj
@@ -4,7 +4,7 @@
             [clojure.tools.logging :as log]
             [clojure.java.jdbc :as jdbc]
             [clojure.set :refer [rename-keys]]
-            [clojure.string :refer [blank? split upper-case lower-case capitalize includes? join]]
+            [clojure.string :refer [blank? split upper-case lower-case capitalize includes? join starts-with?]]
             [slingshot.slingshot :refer :all]
             [clojure.data.json :as json]
             [salava.core.time :refer [unix-time date-from-unix-time]]
@@ -16,7 +16,8 @@
             [salava.core.util :as u]
             [salava.core.http :as http]
             [salava.badge.assertion :refer [fetch-json-data]]
-            [salava.core.i18n :refer [t]]))
+            [salava.core.i18n :refer [t]]
+            [pantomime.mime :refer [mime-type-of]]))

 (defqueries "sql/badge/main.sql")

@@ -146,8 +147,17 @@
     (catch Object _
       (log/error "parse-assertion-json: " _))))

+(defn evidence-type [ctx url]
+  (let [site-url (u/get-site-url ctx)]
+    (cond
+      (and (starts-with? url site-url) (includes? url "/page/view/")) {:type "page"}
+      (and (starts-with? url site-url) (includes? url "/file/")) {:type "file" :mime_type (mime-type-of (java.net.URL. url))}
+      :else {:type "url"})))
+
 (defn badge-evidences "get user-badge evidences" [ctx badge-id]
-  (select-user-badge-evidence {:user_badge_id badge-id} (u/get-db ctx)))
+  (->> (select-user-badge-evidence {:user_badge_id badge-id} (u/get-db ctx))
+       (reduce (fn [r evidence]
+                 (conj r (assoc evidence :evidence_type (evidence-type ctx (:url evidence)))))[] )))

 (defn fetch-badge [ctx badge-id]


Fixed typo in header.

Fixed typo in header.

--- src/cljs/bookmarx/header.cljs
+++ src/cljs/bookmarx/header.cljs
@@ -10,7 +10,7 @@
   [:span
    [:nav.header-nav
     [:div.container-fluid
-     [:a.header-navbar {:href (str (:prefex env) "/")} "Bookmarx" [:span.header-star]]
+     [:a.header-navbar {:href (str (:prefix env) "/")} "Bookmarx" [:span.header-star]]
      (when full?
       [:form.navbar-form {:role "search"}
         [:span.navbar-right


updated about page

updated about page

--- src/cljs/netrunner/about.cljs
+++ src/cljs/netrunner/about.cljs
@@ -17,19 +17,13 @@

      [:h3 "Development"]

-     [:p "The card browser and deck builder are ready for use. The gameplay functionnalities are currently under development."]
+     [:p "The card browser and deck builder are ready for use. The gameplay functionnalities are currently under development. " [:a {:href "https://www.dropbox.com/s/rpkhxafgile5spp/Cards%20status.xlsx"} "Card implementation status"]]

-     [:p "Bug reports and feature suggestions can be filled on "
-      [:a {:href "https://github.com/mtgred/netrunner/issues"} "Github"] "."]
+     [:p "The code is open source and available on "
+      [:a {:href "https://github.com/mtgred/netrunner"} "Github"] "."]

-     [:p "Jinteki is built using Clojurescript, React, Socket.io, Node.js. If you are proficient with some of these technologies and would like to contribute to the development, feel free to get in touch."]
-
-     [:h3 "Credits"]
-     [:p "The card data and images are provided by "
-      [:a {:href "http://netrunnerdb.com"} "netrunnerdb.com"]
-      ". Big thanks to "
-      [:a {:href "http://twitter.com/alsciende"} "@alsciende"]
-      " for creating and maintaining such a great website."]
+     [:p "Bug reports and feature suggestions can be submitted "
+      [:a {:href "https://github.com/mtgred/netrunner/issues"} "here"] "."]

      [:h3 "Disclaimer"]
      [:p "Netrunner and Android are trademarks of Fantasy Flight Publishing, Inc. and/or Wizards of the Coast LLC."]


Add missing import.

Add missing import.

--- src/clojure/buddy/hashers.clj
+++ src/clojure/buddy/hashers.clj
@@ -23,6 +23,7 @@
            org.bouncycastle.crypto.digests.SHA256Digest
            org.bouncycastle.crypto.digests.SHA3Digest
            org.bouncycastle.crypto.generators.PKCS5S2ParametersGenerator
+           java.security.Security
            buddy.impl.bcrypt.BCrypt))

 (when (nil? (Security/getProvider "BC"))