adding license and initial translate vconstruct implementation

--- src/freenas/provider.clj
+++ src/freenas/provider.clj
@@ -1,20 +1,35 @@
+(comment
+   Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+   Licensed under the Apache License,
+   Version 2.0  (the "License") you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.)
+
 (ns freenas.provider
   "Freenas jails provider"
   (:require
-    [freenas.remote]
+    [celestial.provider :refer (wait-for-ssh mappings wait-for)]
+    [freenas.remote :refer [call]]
+    [freenas.validations :refer [validate-provider jail-mappings]]
     [slingshot.slingshot :refer  [throw+]]
     [celestial.persistency.systems :as s]
     [celestial.common :refer (import-logging)]
     [celestial.provider :refer (wait-for wait-for-ssh)]
+    [org.httpkit.client :as client]
     [celestial.core :refer (Vm)]
     [celestial.model :refer (hypervisor translate vconstruct)])
  )

 (import-logging)

-(defrecord Instance [spec]
+(defrecord Jail [spec]
   Vm
   (create [this]
+    (call client/post "jails/jails" spec)
     )

   (start [this]
@@ -28,3 +43,13 @@

   (status [this]
      ))
+
+
+(defmethod translate :freenas [{:keys [machine freenas system-id] :as spec}]
+    "Convert the general model into a freenas jail"
+    (-> (merge machine freenas {:system-id system-id}) (mappings jail-mappings)))
+
+(defn validate [spec] (validate-provider spec))
+
+(defmethod vconstruct :freenas [{:keys [proxmox] :as spec}]
+  (apply ->Jail (validate (translate spec))))


Adds simple links to each of the generators if page is not found

--- src/hphelper/handler.clj
+++ src/hphelper/handler.clj
@@ -8,6 +8,7 @@
             [hphelper.scengen.scenform :as sform]
             [hphelper.scengen.generator :as sgen]
             [hphelper.scengen.print :as sprint]
+            [hiccup.core :refer :all]
             )
   (:gen-class))

@@ -20,7 +21,13 @@
             (sform/from-select-to-scenmap)
             (sgen/create-scenario)
             (sprint/html-print-scenario)))
-  (route/not-found "Not Found"))
+  (route/not-found
+   (html [:html
+          [:body
+           [:a {:href "./scen/"} "Scenario Generator"][:br]
+           [:a {:href "./char/"} "Character Generator"][:br]
+           ]]))
+  )

 (def app
   (-> app-routes


Allow reloading with var indirection

Allow reloading with var indirection

--- src/xhr_redirect_demo/server.clj
+++ src/xhr_redirect_demo/server.clj
@@ -44,43 +44,48 @@
     (swap! calls update-in [id] (fnil conj []) entry)
     (println "Called" id "with" entry)))

+(defn xhr-app
+  [req which]
+  (record-call which req)
+  (let [resp-json (json/generate-string [which (get @calls (:uri req))])
+        hdr-base {"Content-Type" "application/json;charset=utf-8"
+                  "Access-Control-Allow-Origin" "*"
+                  "Access-Control-Allow-Methods" "GET"
+                  "Access-Control-Allow-Headers" "Xhr-Demo-Request"
+                  "Access-Control-Expose-Headers" "Xhr-Demo-Response"}]
+    (case (:request-method req)
+      :options
+      {:status 200
+       :headers hdr-base
+       :body resp-json}
+
+      :get
+      (case which
+        :first
+        {:status 303
+         :headers (merge hdr-base
+                         {"Location" (str "http://" host ":9202"
+                                          (:uri req))})
+         :body resp-json}
+
+        :second
+        {:status 200
+         :headers hdr-base
+         :body resp-json}))))
+
 (defn make-xhr-app
   "Given :first or :second, yield an app for the appropriate XHR responder."
   [which]
-  (fn xhr-app
+  (fn closed-xhr-app
     [req]
-    (record-call which req)
-    (let [resp-json (json/generate-string [which (get @calls (:uri req))])
-          hdr-base {"Content-Type" "application/json;charset=utf-8"
-                    "Access-Control-Allow-Origin" "*"
-                    "Access-Control-Allow-Methods" "GET,OPTIONS"
-                    "Access-Control-Allow-Headers" "Xhr-Demo-Request"
-                    "Access-Control-Expose-Headers" "Xhr-Demo-Response"}]
-      (case (:request-method req)
-        :options
-        {:status 200
-         :headers hdr-base
-         :body resp-json}
-
-        :get
-        (case which
-          :first
-          {:status 303
-           :headers (merge hdr-base
-                           {"Location" (str "http://" host ":9202"
-                                            (:uri req))})
-           :body resp-json}
-
-          :second
-          {:status 200
-           :headers hdr-base
-           :body resp-json})))))
-
+    ;; Allow reloading with var indirection
+    (#'xhr-app req which)))

 (defn main
   "Start servers."
   [& args]
   (s/run-server (make-xhr-app :first) {:port 9201})
   (s/run-server (make-xhr-app :second) {:port 9202})
-  (s/run-server ui-app {:port 9200})
+  ;; Allow reloading with var indirection
+  (s/run-server #'ui-app {:port 9200})
   (println (str "Visit http://" host ":9200/")))


Add provisional spinner for image uploading in workspace.

--- src/uxbox/main/ui/workspace/images.cljs
+++ src/uxbox/main/ui/workspace/images.cljs
@@ -20,6 +20,13 @@
             [uxbox.main.ui.icons :as i]
             [uxbox.main.ui.lightbox :as lbx]))

+
+;; --- Refs
+
+(def ^:private dashboard-ref
+  (-> (l/in [:dashboard :images])
+      (l/derive st/state)))
+
 (def ^:private collections-ref
   (-> (l/key :image-colls-by-id)
       (l/derive st/state)))
@@ -28,8 +35,14 @@
   (-> (l/key :images-by-id)
       (l/derive st/state)))

+(def ^:private uploading?-ref
+  (-> (l/key :uploading)
+      (l/derive dashboard-ref)))
+
+;; --- Components
+
 (mx/defcs import-image-lightbox
-  {:mixins [mx/static]}
+  {:mixins [mx/static mx/reactive]}
   [own]
   (letfn [(on-upload-click [event]
             (let [input (mx/ref-node own "input")]
@@ -52,23 +65,26 @@
           (on-close [event]
             (dom/prevent-default event)
             (udl/close!))]
-    [:div.lightbox-body
-     [:h3 "New image"]
-     [:div.row-flex
-      [:div.lightbox-big-btn
-       {:on-click on-select-from-library}
-       [:span.big-svg i/image]
-       [:span.text "Select from library"]]
-      [:div.lightbox-big-btn
-       {:on-click on-upload-click}
-       [:span.big-svg.upload i/exit]
-       [:span.text "Upload file"]
-       [:input.upload-image-input
-        {:style {:display "none"}
-         :type "file"
-         :ref "input"
-         :on-change on-files-selected}]]]
-     [:a.close {:href "#" :on-click on-close} i/close]]))
+    (let [uploading? (mx/react uploading?-ref)]
+      [:div.lightbox-body
+       [:h3 "New image"]
+       [:div.row-flex
+        [:div.lightbox-big-btn
+         {:on-click on-select-from-library}
+         [:span.big-svg i/image]
+         [:span.text "Select from library"]]
+        [:div.lightbox-big-btn
+         {:on-click on-upload-click}
+         (if uploading?
+           [:span.big-svg.upload i/loader-pencil]
+           [:span.big-svg.upload i/exit])
+         [:span.text "Upload file"]
+         [:input.upload-image-input
+          {:style {:display "none"}
+           :type "file"
+           :ref "input"
+           :on-change on-files-selected}]]]
+       [:a.close {:on-click on-close} i/close]])))

 (mx/defc image-item
   {:mixins [mx/static]}


Print an error message when plugin uninstall fails.

Windows is strict when it comes to file locking
and so doesn't let leiningen delete its own plugin jar files.
Print an error message when uninstallation fails.

--- src/leiningen/plugin.clj
+++ src/leiningen/plugin.clj
@@ -1,6 +1,7 @@
 (ns leiningen.plugin
   (:use [leiningen.core :only (home-dir
-                               read-project)]
+                               read-project
+                               abort)]
         [leiningen.uberjar :only (write-components)]
         [leiningen.deps :only (deps)]
         [leiningen.jar :only (local-repo-path
@@ -51,9 +52,15 @@
   "Delete the plugin jarfile
 Syntax: lein plugin uninstall [GROUP/]ARTIFACT-ID VERSION"
   [project-name version]
-  (let [[name group] (extract-name-and-group project-name)]
-    (.delete (file plugins-path
-                   (plugin-standalone-filename group name version)))))
+  (let [[name group] (extract-name-and-group project-name)
+        jarfile (file plugins-path
+                      (plugin-standalone-filename group name version))]
+    (if (.exists jarfile)
+      (if (.delete jarfile)
+        (println (format "Successfully uninstalled %s %s." project-name version))
+        (abort (format "Failed to delete \"%s\"." (.getAbsolutePath jarfile))))
+      (abort (format "Plugin \"%s %s\" doesn't appear to be installed."
+                       project-name version)))))

 (defn ^{:doc "Manage user-level plugins."
         :help-arglists '([subtask project-name version])


Removing things that are not required for this

--- clojure/project.clj
+++ clojure/project.clj
@@ -1,6 +1,2 @@
 (defproject clj-lang "0.1.0-SNAPSHOT"
-  :description "FIXME: write description"
-  :url "http://example.com/FIXME"
-  :license {:name "Eclipse Public License"
-            :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.6.0"]])


Updated to use Clojure 1.10

Updated to use Clojure 1.10

--- clojure/project.clj
+++ clojure/project.clj
@@ -1,9 +1,9 @@
-(defproject ucdump "0.1.0-SNAPSHOT"
+(defproject ucdump "0.2.0-SNAPSHOT"
   :description "Unicode character dump for UTF-8 encoded files"
   :url "https://github.com/jerekapyaho/ucdump"
   :license {:name "MIT License"
             :url "http://opensource.org/licenses/MIT"}
-  :dependencies [[org.clojure/clojure "1.6.0"]]
+  :dependencies [[org.clojure/clojure "1.10.0"]]
   :main ^:skip-aot com.coniferproductions.ucdump
   :target-path "target/%s"
   :profiles {:uberjar {:aot :all}})


fix bug with status-bar rename

fix bug with status-bar rename

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/notifos.cljs
+++ src/lt/objs/notifos.cljs
@@ -24,7 +24,7 @@
   (let [m (if (string? m)
             m
             (pr-str m))]
-    (object/merge! status-bar/status-bar-loader (merge {:message m :class ""} opts))))
+    (object/merge! status-bar/status-loader (merge {:message m :class ""} opts))))

 (defn set-msg!
   ([msg]


Rename var.

Rename var.

--- test/dsbdp/test/processing_fn_utils.clj
+++ test/dsbdp/test/processing_fn_utils.clj
@@ -42,18 +42,18 @@

 (deftest simple-combine-proc-fns-1st-test
   (let [proc-fns (create-proc-fn-vec-from-template '(fn [i _] (+ i :_idx_ 1)) '(fn [_ o] (+ o :_idx_ 1)) 6)
-        mapped-proc-fn (combine-proc-fns proc-fns 0 3)]
+        combined-proc-fn (combine-proc-fns proc-fns 0 3)]
     (is (= 1 ((proc-fns 0) 0 nil)))
     (is (= 2 ((proc-fns 1) nil 0)))
     (is (= 6 ((proc-fns 5) nil 0)))
-    (is (= 6 (mapped-proc-fn 0 nil)))
-    (is (= 10 (mapped-proc-fn 4 nil)))))
+    (is (= 6 (combined-proc-fn 0 nil)))
+    (is (= 10 (combined-proc-fn 4 nil)))))

 (deftest simple-combine-proc-fns-nth-test
   (let [proc-fns (create-proc-fn-vec-from-template '(fn [i _] (+ i :_idx_ 1)) '(fn [_ o] (+ o :_idx_ 1)) 6)
-        mapped-proc-fn (combine-proc-fns proc-fns 3 5)]
+        combined-proc-fn (combine-proc-fns proc-fns 3 5)]
     (is (= 4 ((proc-fns 3) nil 0)))
     (is (= 5 ((proc-fns 4) nil 0)))
-    (is (= 9 (mapped-proc-fn nil 0)))
-    (is (= 15 (mapped-proc-fn nil 6)))))
+    (is (= 9 (combined-proc-fn nil 0)))
+    (is (= 15 (combined-proc-fn nil 6)))))


Be more defensive about fin/growth data, filtering out strings instead of just nil, before the numeric assertion in sparkline generation.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -123,7 +123,7 @@
                             (take (count (utils/contiguous (map :period periods) (keyword interval))) periods))
         prior-contiguous? (>= (count contiguous-periods) 2)
         sparkline? (>= (count contiguous-periods) 3) ; sparklines are possible at 3 or more
-        spark-periods (when sparkline? (reverse (take 4 contiguous-periods))) ; 3-4 periods for potential sparklines
+        spark-periods (when sparkline? (reverse (take-while #(number? (:value %)) (take 4 contiguous-periods)))) ; 3-4 periods for potential sparklines
         ;; Info on prior period
         prior-metric (when prior-contiguous? (second contiguous-periods))
         prior-period (when (and interval prior-metric) (utils/parse-period interval (:period prior-metric)))
@@ -190,7 +190,7 @@
         revenue-delta (when (and revenue? prior-revenue) (- revenue prior-revenue))
         revenue-delta-percent (when revenue-delta (* 100 (float (/ revenue-delta prior-revenue))))
         formatted-revenue-delta (when revenue-delta-percent (format-delta revenue-delta-percent prior-date))
-        spark-revenue-periods (when spark-periods (reverse (take-while #(not (nil? (:revenue %))) spark-periods)))
+        spark-revenue-periods (when spark-periods (reverse (take-while #(number? (:revenue %)) spark-periods)))
         spark-revenue (when (>= (count spark-revenue-periods) 3)
                         (sl/sparkline-html (map :revenue spark-revenue-periods) :green))
         ;; Info on costs/expenses
@@ -201,7 +201,7 @@
         costs-delta (when (and costs? prior-costs) (- costs prior-costs))
         costs-delta-percent (when costs-delta (* 100 (float (/ costs-delta prior-costs))))
         formatted-costs-delta (when costs-delta-percent (format-delta costs-delta-percent prior-date))
-        spark-costs-periods (when spark-periods (reverse (take-while #(not (nil? (:costs %))) spark-periods)))
+        spark-costs-periods (when spark-periods (reverse (take-while #(number? (:costs %)) spark-periods)))
         spark-costs (when (>= (count spark-costs-periods) 3) (sl/sparkline-html (map :costs spark-costs-periods) :red))
         cost-label (if revenue? "Expenses" "Burn")
         ;; Info on runway (calculated)


update

update

--- src/unifn.clj
+++ src/unifn.clj
@@ -2,7 +2,7 @@
   (:require [clojure.spec :as s]
             [clojure.stacktrace :as stacktrace]))

-(defn- deep-merge [& maps]
+(defn deep-merge [& maps]
   (if (every? map? maps)
     (apply merge-with deep-merge maps)
     (last maps)))
@@ -19,6 +19,7 @@
    :unifn/message (str "Could not resolve " (:unifn/fn arg))})

 (declare *apply)
+
 (defn *apply-impl [{f-name :unifn/fn tracers :unifn/tracers :as arg}]
   (when tracers
     (let [trace-ev {:unifn/fn f-name :unifn/phase :enter}]


fix editor recorder to record focus event so the first delay is accurately recorded

--- src/parinfer/editor.cljs
+++ src/parinfer/editor.cljs
@@ -176,7 +176,8 @@
        ;; and stop any animation.
        (.on cm "focus" (fn [e]
                          (swap! controls-state assoc :target-key key-)
-                         (stop-playing! key-))))
+                         (stop-playing! key-)
+                         (on-cursor-activity cm))))

      (when-not (get @state key-)
        (swap! frame-updates assoc key- {}))


fix script

fix script

--- src/pc/views/content.clj
+++ src/pc/views/content.clj
@@ -145,7 +145,7 @@
    [:script {:type "text/javascript"}
     (format "rasterize = {}; rasterize.api_key = '%s';"
             (pc.profile/rasterize-key))]
-   "<script async src=\"https://rasterize.io/rasterize.js\" />"))
+   "<script async src=\"https://rasterize.io/rasterize.js\"></script>"))

 (defn app [view-data]
   (h/html (app* view-data)))


Rename image functions

Rename image functions

--- src/play_clj/core_2d.clj
+++ src/play_clj/core_2d.clj
@@ -43,7 +43,7 @@

 ; textures

-(defn create-image*
+(defn image*
   [img]
   (cond
     (string? img)
@@ -51,11 +51,11 @@
     :else
     (TextureRegion. ^TextureRegion img)))

-(defmacro create-image
+(defmacro image
   [img & options]
-  `(utils/calls! ^TextureRegion (create-image* ~img) ~@options))
+  `(utils/calls! ^TextureRegion (image* ~img) ~@options))

-(defmacro image
+(defmacro image!
   [img k & options]
   `(utils/call! ^TextureRegion ~img ~k ~@options))


Functionize SLP code

Functionize SLP code

--- src/quark/slp_runner.clj
+++ src/quark/slp_runner.clj
@@ -19,31 +19,40 @@
 (time-mins (do

 ;(def train-set (java.io.File. (expand-home "~/opt/src/SLP-Core")))
-(def train-set (java.io.File. (expand-home "~/atom-finder/src/java")))
-(def test-set train-set)
+(def train-set (java.io.File. (expand-home )))

-(doto-class LexerRunner
-            (setLexer (JavaLexer.))
-            (setPerLine false)
-            (addSentenceMarkers true)
-            (useExtension "java"))
+(defn ngram-java
+  ([train-path] (ngram-java train-path train-path))
+  ([train-path test-path]
+   (let [train-set (java.io.File. (expand-home train-path))
+         test-set (java.io.File. (expand-home test-path))]

-(def model (JMModel. (GigaCounter.)))
+     (doto-class LexerRunner
+                 (setLexer (JavaLexer.))
+                 (setPerLine false)
+                 (addSentenceMarkers true)
+                 (useExtension "java"))

-(doto-class ModelRunner
-            (perLine false)
-            (selfTesting (.equals train-set test-set))
-            (setNGramOrder 6)
-            (learn model train-set))
+     (let [jm-giga-model (JMModel. (GigaCounter.))]

-(def model (NestedModel. test-set model))
-(def model (InverseMixModel. model (CacheModel.)))
-(.setDynamic model true)
+     (doto-class ModelRunner
+                 (perLine false)
+                 (selfTesting (.equals train-set test-set))
+                 (setNGramOrder 6)
+                 (learn jm-giga-model train-set))

-(def modeledFiles (->> (ModelRunner/model model test-set)
-                       .iterator iterator-seq (map pair->vec) (into {})))
+     (let [nested-model (NestedModel. test-set jm-giga-model)
+           mix-model (doto (InverseMixModel. nested-model (CacheModel.))
+                           (.setDynamic true))]

-(def statistics (ModelRunner/getStats modeledFiles))
+       (let [modeled-files (->> (ModelRunner/model mix-model test-set)
+                            .iterator iterator-seq (map pair->vec) (into {}))]
+
+       {:model model :modeled-files modeled-files}))))))
+
+(def ngram-res (ngram-java "~/atom-finder/src/java"))
+
+(def statistics (->> ngram-res :modeled-files ModelRunner/getStats))

 (printf "Modeled %d tokens, average entropy:\t%.4f\n" (.getCount statistics) (.getAverage statistics))
 ))


Use 0s when millis are less than a second

--- src/runbld/util/date.clj
+++ src/runbld/util/date.clj
@@ -61,4 +61,4 @@
                    (when (> days 0) (str days "d"))
                    (when (> hours 0) (str hours "h"))
                    (when (> minutes 0) (str minutes "m"))
-                   (when (> seconds 0) (str seconds "s")))))))
+                   (str seconds "s"))))))


Update schema

Update schema

--- src/salvador/handler.clj
+++ src/salvador/handler.clj
@@ -30,7 +30,7 @@
        aws-gateway-options
        {:responses {200 {:schema s/Any :description "Default response"}
                     302 {:schema s/Any :description "Redirect to `continue` location"}
-                    500 {:schema {:code String} :description "Horror"}}
+                    500 {:schema s/Any :description "Horror"}}
         :parameters {:query-params {:template String}}
         :summary "Render template with request map"
         :handler (fn [request]


Clean up the custom configurer.

Clean up the custom configurer.

--- src/shale/configurer.clj
+++ src/shale/configurer.clj
@@ -5,11 +5,11 @@
               [clojure.java.io :as io]))

 (def config
-  (configurer
-    (concat
-      (map io/as-url
-           (filter identity
-                   (flatten
-                     [(if-let [env-var (env :config-file)]
-                        (str "file://" env-var))
-                      (resources "config.clj")]))))))
+  (->> [(some->> (env :config-file)
+                 (str "file://"))
+        (resources "config.clj")]
+       flatten
+       (filter identity)
+       (map io/as-url)
+       concat
+       configurer))


Rewrite tracer based on new spec

Rewrite tracer based on new spec

--- src/spectrace/trace.cljc
+++ src/spectrace/trace.cljc
@@ -1,26 +1,23 @@
 (ns spectrace.trace
-  (:require [clojure.spec :as s]))
+  (:require [clojure.spec :as s]
+            [spectrace.specs :as specs]))

-(defmulti step (fn [op conformed path] op))
-(defmethod step :default [_ _ _] nil)
+(defmulti step (fn [conformed path] (:s conformed)))
+(defmethod step :default [_ _] nil)

-(defmethod step `s/keys [_ conformed [segment & path]]
+(defmethod step `s/keys [_ [segment & path]]
   [segment path])

-(defmethod step `s/cat [_ conformed [segment & path]]
-  [(:pred (some #(and (= (:key %) segment) %) conformed))
+(defmethod step `s/cat [{:keys [args]} [segment & path]]
+  [(:pred (some #(and (= (:key %) segment) %) args))
    path])

-(defmethod step `s/alt [_ conformed [segment & path]]
-  [(:pred (some #(and (= (:key %) segment) %) conformed))
+(defmethod step `s/alt [{:keys [args]} [segment & path]]
+  [(:pred (some #(and (= (:key %) segment) %) args))
    path])

-(defmethod step `s/* [_ conformed path]
-  [(:pred-form conformed) path])
-
-(defn conform-macro-form [[op & args]]
-  (let [var (resolve op)]
-    (s/conform (:args (s/get-spec var)) args)))
+(defmethod step `s/* [{:keys [args]} path]
+  [(:pred-form args) path])

 (defn trace [{:keys [path] :as problem}]
   (let [form (s/form (s/get-spec (first (:via problem))))]
@@ -29,9 +26,7 @@
       ;(prn :form form)
       (if (empty? path)
         ret
-        (let [[form' path'] (step (first form)
-                                  (conform-macro-form form)
-                                  path)]
+        (let [[form' path'] (step (s/conform ::specs/spec form) path)]
           (recur path'
                  (if (keyword? form') (s/form (s/get-spec form')) form')
                  (conj ret {:form form})))))))


Relax state spec

Relax state spec

--- src/spectrace/trace.cljc
+++ src/spectrace/trace.cljc
@@ -2,9 +2,8 @@
   (:require [clojure.spec :as s]
             [spectrace.specs :as specs]))

-(s/def ::s symbol?)
-(s/def ::spec (s/keys :req-un [::s]))
-(s/def ::path (s/coll-of keyword?))
+(s/def ::spec any?)
+(s/def ::path (s/coll-of (s/or :keyword keyword? :int integer?)))
 (s/def ::val any?)
 (s/def ::in (s/coll-of (s/or :keyword keyword? :int integer?)))
 (s/def ::spec-name keyword?)


CMR-1213: Fixed spatial validation 500 error.

--- umm-lib/src/cmr/umm/validation/core.clj
+++ umm-lib/src/cmr/umm/validation/core.clj
@@ -6,6 +6,7 @@
             [cmr.umm.validation.granule :as vg]
             [cmr.umm.validation.parent-weaver :as pw]
             [cmr.umm.validation.utils :as vu]
+            [cmr.spatial.ring-validations]
             [cmr.common.services.errors :as e]
             [clojure.string :as str]))


Fix encoding

Fix encoding

--- src/superstring/core.clj
+++ src/superstring/core.clj
@@ -1,635 +1,635 @@
-(ns superstring.core
-  (:require clojure.string)
-  (:refer-clojure :exclude [reverse replace contains?])
-  (:import java.text.Normalizer))
-
-(declare slice)
-
-;; Taken from [jackknife "0.1.6"]
-(defmacro ^:private defalias
-  "Defines an alias for a var: a new var with the same root binding (if
-  any) and similar metadata. The metadata of the alias is its initial
-  metadata (as provided by def) merged into the metadata of the original."
-  ([name orig]
-   `(do
-      (alter-meta!
-       (if (.hasRoot (var ~orig))
-         (def ~name (.getRawRoot (var ~orig)))
-         (def ~name))
-       ;; When copying metadata, disregard {:macro false}.
-       ;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273
-       #(conj (dissoc % :macro :added)
-              (apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %)))))
-      (var ~name)))
-  ([name orig doc]
-   (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig)))
-
-(defmacro ^:private alias-ns
-  "Create an alias for all public vars in ns in this ns."
-  [namespace]
-  `(do ~@(map
-          (fn [n] `(defalias ~(.sym n) ~(symbol (str (.ns n)) (str (.sym n)))))
-          (vals (ns-publics namespace)))))
-
-(alias-ns clojure.string)
-(def substring clojure.core/subs)
-
-(defn ^Long length
-  "Return the length of s."
-  [^String s]
-  {:pre [(string? s)]
-   :post [(integer? %)]}
-  (.length s))
-
-(defn ^Long index-of
-  "Return the starting position of the first occurrence of needle in s.
-
-  If start is provided, start the search at that position in s."
-  ([^String s needle]
-   {:pre [(string? s) (string? needle)]
-    :post [(integer? %)]}
-   (.indexOf s needle))
-  ([^String s needle ^Long start]
-   {:pre [(string? s) (string? needle) (integer? start)]
-    :post [(integer? %)]}
-   (.indexOf s needle start)))
-
-(defn ^Long last-index-of
-  "Return the starting position of the last occurrence of needle in s.
-
-  If start is provided, start the search at that position in s."
-  ([^String s needle]
-   {:pre [(string? s) (string? needle)]
-    :post [(integer? %)]}
-   (.lastIndexOf s needle))
-  ([^String s needle ^Long start]
-   {:pre [(string? s) (string? needle) (integer? start)]
-    :post [(integer? %)]}
-   (.lastIndexOf s needle start)))
-
-(defn- ^String slice-relative-to-end
-  [s index length]
-  (if (neg? (+ (superstring.core/length s) index))
-    nil ; slice outside beg of s
-    (slice s (+ (superstring.core/length s) index) length)))
-
-(defn ^String slice
-  "Return a slice of s beginning at index and of the given length.
-
-  If index is negative the starting index is relative to the end of the string.
-
-  The default length of the slice is 1.
-
-  If the requested slice ends outside the string boundaries, we return
-  the substring of s starting at index.
-
-  Returns nil if index falls outside the string boundaries or if
-  length is negative."
-  ([^String s index]
-   (slice s index 1))
-  ([^String s ^long index length]
-   (cond
-     (neg? length) nil
-     (neg? (+ (superstring.core/length s) index))
-     nil ; slice relative to end falls outside s
-     (neg? index) (slice-relative-to-end s index length)
-     (>= index (superstring.core/length s)) nil
-     (> (- length index) (superstring.core/length (substring s index)))
-     (substring s index)
-     :else (let [end (+ index length)]
-             (substring s index end)))))
-
-(defn ^String ends-with?
-  "Return s if s ends with suffix."
-  ([^String s ^String suffix]
-   (when (.endsWith s suffix)
-     s))
-  ([^String s ^String suffix ignore-case]
-   (if-not ignore-case
-     (ends-with? s suffix)
-     (let [end (substring s (max 0 (- (length s) (length suffix))))]
-       (when (.equalsIgnoreCase end suffix)
-         s)))))
-
-(defn ^String starts-with?
-  "Return s if s starts with with prefix.
-
-  If a third argument is provided the string comparison is insensitive to case."
-  ([^String s ^String prefix]
-   (when (.startsWith s prefix)
-     s))
-  ([^String s ^String prefix ignore-case]
-   (if-not ignore-case
-     (starts-with? s prefix)
-     (let [beg (substring s 0 (length prefix))]
-       (when (.equalsIgnoreCase beg prefix)
-         s)))))
-
-(defn ^String chop
-  "Return a new string with the last character removed.
-
-  If the string ends with \\r\\n, both characters are removed.
-
-  Applying chop to an empty string is a no-op."
-  [^String s]
-  (if (.endsWith s "\r\n")
-    (substring s 0 (- (length s) 2))
-    (substring s 0 (max 0 (dec (length s))))))
-
-(defn ^String chomp
-  "Return a new string with the given record separator removed from
-  the end (if present).
-
-  If separator is not provided chomp will remove \\n, \\r or \\r\\n from
-  the end of s."
-  ([^String s]
-   (cond
-     (.endsWith s "\r\n") (substring s 0 (- (length s) 2))
-     (.endsWith s "\r") (substring s 0 (dec (length s)))
-     (.endsWith s "\n") (substring s 0 (dec (length s)))
-     :else s))
-  ([^String s ^String separator]
-   (if (.endsWith s separator)
-     (substring s 0 (- (length s) (length separator)))
-     s)))
-
-(defn ^String capitalize
-  "Return a new string where the first character is in upper case and
-  all others in lower case."
-  [^String s]
-  (case (length s)
-    0 ""
-    1 (upper-case s)
-    (str (upper-case (substring s 0 1)) (lower-case (substring s 1)))) )
-
-(defn ^String swap-case
-  "Change lower case characters to upper case and vice versa."
-  [^String s]
-  (let [invert-case (fn [c]
-                      (cond
-                        (Character/isLowerCase c) (Character/toUpperCase c)
-                        (Character/isUpperCase c) (Character/toLowerCase c)
-                        :else c))]
-    (->> s (map invert-case) (apply str))))
-
-(defn- ^String gen-padding
-  "Generate the necessary padding to fill s upto width."
-  [^String s ^String padding width]
-  (let [missing (- width (length s))
-        full-lengths (Math/floor (/ missing (length padding)))
-        remaining (if (zero? full-lengths) (- width (length s))
-                      (rem missing (* full-lengths (length padding))))]
-    (str (apply str (repeat full-lengths padding))
-         (substring padding 0 remaining))))
-
-
-(defn ^String pad-right
-  "Pad the end of s with padding, or spaces, until the length of s matches
-  width."
-  ([^String s width]
-   (pad-right s width " "))
-  ([^String s width ^String padding]
-   {:pre [(not-empty padding)
-          (not (nil? s))]
-    :post [(= (length %) width)]}
-   (if (<= width (length s))
-     s
-     (str s (gen-padding s padding width)))))
-
-(defn ^String pad-left
-  "Pad the beginning of s with padding, or spaces, until the length of
-  s matches width."
-  ([^String s width]
-   (pad-left s width " "))
-  ([^String s width ^String padding]
-   {:pre [(not-empty padding)
-          (not (nil? s))]
-    :post [(= (length %) width)]}
-   (if (<= width (length s))
-     s
-     (str (gen-padding s padding width) s))))
-
-(defn ^String center
-  "Pad both ends of s with padding, or spaces, until the length of s
-  matches width."
-  ([^String s width]
-   (center s width " "))
-  ([^String s width ^String padding]
-   {:pre [(not-empty padding)
-          (not (nil? s))]
-    :post [(= (length %) width)]}
-   (if (<= width (length s))
-     s
-     (let [missing (- width (length s))
-           full-lengths (Math/ceil (/ missing (length padding)))
-           p (gen-padding s padding width)
-           lengths-before (Math/floor (/ full-lengths 2))]
-       (str (substring p 0 (* (length padding) lengths-before))
-            s
-            (substring p (* (length padding) lengths-before)))))))
-
-(defn ^String chop-suffix
-  "If s ends with suffix return a new string without the suffix.
-
-  Otherwise return s."
-  ([^String s ^String suffix]
-   (chop-suffix s suffix false))
-  ([^String s ^String suffix ignore-case]
-   {:pre [(not (nil? s))
-          (not (nil? suffix))]
-    :post [(not (nil? %))]}
-   (if (and (>= (length s) (length suffix))
-            (ends-with? s suffix ignore-case))
-     (substring s 0 (- (length s) (length suffix)))
-     s)))
-
-(defn ^String chop-prefix
-  "If s starts with with prefix return a new string without the prefix.
-
-  Otherwise return s."
-  ([^String s ^String prefix]
-   (chop-prefix s prefix false))
-  ([^String s ^String prefix ignore-case]
-   {:pre [(not (nil? s))
-          (not (nil? prefix))]
-    :post [(not (nil? %))]}
-   (if (and (>= (length s) (length prefix))
-            (starts-with? s prefix ignore-case))
-     (substring s (length prefix))
-     s)))
-
-(defn- case-sensitive-contains
-  [s needle]
-  (if (= needle "")
-    s
-    (when (.contains s needle)
-      s)))
-
-(defn- case-insensitive-contains
-  [s needle]
-  (if (= needle "")
-    s
-    (let [p (java.util.regex.Pattern/compile
-             (java.util.regex.Pattern/quote needle)
-             (bit-or java.util.regex.Pattern/CASE_INSENSITIVE
-                     java.util.regex.Pattern/UNICODE_CASE))]
-      (when (re-find p s)
-        s))))
-
-(defn ^String contains?
-  "Return s if s contains needle."
-  ([^String s ^String needle]
-   (case-sensitive-contains s needle))
-  ([^String s ^String needle ignore-case]
-   (if ignore-case
-     (case-insensitive-contains s needle)
-     (case-sensitive-contains s needle))))
-
-(defn ^String contains-all?
-  "Return s if s contains all needles."
-  ([^String s needles]
-   (when (every? (partial case-sensitive-contains s) needles)
-     s))
-  ([^String s needles ignore-case]
-   (if ignore-case
-     (when (every? (partial case-insensitive-contains s) needles)
-       s)
-     (contains-all? s needles))))
-
-(defn ^String contains-any?
-  "Return s if s contains any of the needles."
-  ([^String s needles]
-   (some (partial case-sensitive-contains s) needles))
-  ([^String s needles ignore-case]
-   (if ignore-case
-     (some (partial case-insensitive-contains s) needles)
-     (contains-any? s needles))))
-
-(defn ^String truncate
-  "If s is longer than len-3, cut it down to len-3 and append '...'."
-  [^String s len]
-  {:pre [(not (nil? s)) (>= len 3)]}
-  (if (> (length s) (max 3 (- len 3)))
-    (str (substring s 0 (- len 3)) "...")
-    s))
-
-(defn- char-equal-ignore-case
-  [^Character c1 ^Character c2]
-  (when (or (= c1 c2)
-            (= (Character/toUpperCase c1) c2)
-            (= (Character/toLowerCase c1) c2))
-    c1))
-
-(defn ^String common-prefix
-  "Return the longest common prefix of s1 and s2."
-  ([^String s1 ^String s2]
-   {:pre [(string? s1) (string? s2)]
-    :post [(string? %)]}
-   (->> s1
-        (map #(when (= %1 %2) %1) s2)
-        (take-while (complement nil?))
-        (apply str)))
-  ([^String s1 ^String s2 ignore-case]
-   {:pre [(string? s1) (string? s2)]
-    :post [(string? %)]}
-   (if-not ignore-case
-     (common-prefix s1 s2)
-     (->> s1
-          (map #(when (or (= %1 %2)
-                          (= (Character/toUpperCase %1) %2)
-                          (= (Character/toLowerCase %1) %2))
-                  %1)
-               s2)
-          (take-while (complement nil?))
-          (apply str)))))
-
-(defn ^String common-suffix
-  "Return the longest common suffix of s1 and s2."
-  ([^String s1 ^String s2]
-   {:pre [(string? s1) (string? s2)]
-    :post [(string? %)]}
-   (->> s1
-        reverse
-        (map #(when (= %1 %2) %1) (reverse s2))
-        (take-while (complement nil?))
-        (apply str)
-        reverse))
-  ([^String s1 ^String s2 ignore-case]
-   {:pre [(string? s1) (string? s2)]
-    :post [(string? %)]}
-   (if-not ignore-case
-     (common-suffix s1 s2)
-     (->> s1
-          reverse
-          (map char-equal-ignore-case (reverse s2))
-          (take-while (complement nil?))
-          (apply str)
-          reverse))))
-
-(defn- upper-exists?
-  "Does c exist in an upper case version?"
-  [^Character c]
-  (or (Character/isUpperCase c) (not= c (Character/toUpperCase c))))
-
-(defn ^String title-case
-  "Capitalize the first character of s and lower case the rest."
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (let [first-char (first s)
-        start (if (upper-exists? first-char) (upper-case first-char) first-char)]
-    (str start (lower-case (substring s 1)))))
-
-(defn ^String upper-case?
-  "Return s if s is all upper case.
-
-  Characters without case, e.g. numbers, are considered to be trivially
-  upper case."
-  [^String s]
-  {:pre [(string? s)]
-   :post [(or (nil? %) (string? %))]}
-  (when (reduce
-         (fn [acc ^Character c]
-           (and acc (or (Character/isUpperCase c) (= c (Character/toUpperCase c)))))
-         true s)
-    s))
-
-(defn ^String lower-case?
-  "Return s if s is all lower case.
-
-  Characters without case, e.g. numbers, are considered to be trivially
-  lower case."
-  [^String s]
-  {:pre [(string? s)]
-   :post [(or (nil? %) (string? %))]}
-  (when (reduce
-         (fn [acc ^Character c]
-           (and acc (or (Character/isLowerCase c) (= c (Character/toLowerCase c)))))
-         true s)
-    s))
-
-(defn- split-words [^String s]
-  (remove empty?
-          (-> s
-              (replace #"_|-" " ")
-              (replace #"(\p{javaUpperCase})((\p{javaUpperCase})[(\p{javaLowerCase})0-9])"
-                       "$1 $2")
-              (replace
-               #"(\p{javaLowerCase})(\p{javaUpperCase})" "$1 $2")
-              (split
-               #"[^\w0-9]+"))))
-
-(defn wrap-words
-  "Insert newlines in s so the length of each line doesn't exceed width."
-  [^String s width]
-  (->> (split s #"\n|\t|\n| ")
-       (remove empty?)
-       (reduce
-        (fn [{:keys [len res]} ^String word]
-          (if (< (+ len (length word)) width)
-            {:len (+ len (length word) 1) :res (conj res " " word)}
-            {:len (length word) :res (conj res "\n" word)}))
-        {:len 0 :res []})
-       :res
-       rest ; drop leading " "
-       (apply str)))
-
-(defn ^String lisp-case
-  "Lower case s and separate words with dashes.
-
-  foo bar => foo-bar
-  camelCase => camel-case
-
-  This is also referred to as kebab-case in some circles."
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (join "-" (map lower-case (split-words s))))
-
-(defn ^String camel-case
-  "Lower case first char in s and use capitalization to separate words.
-
-  foo bar => fooBar
-  camelCase => camelCase
-  PascalCase => pascalCase"
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (let [words (split-words s)]
-    (join ""  (conj (map capitalize (rest words)) (lower-case (first words))))))
-
-(defn ^String pascal-case
-  "Lower case first char in s and use capitalization to separate words.
-
-  foo bar => FooBar
-  camelCase => CamelCase
-  PascalCase => PascalCase"
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (join ""  (map capitalize (split-words s))))
-
-(defn ^String snake-case
-  "Lower case s and use underscores to separate words.
-
-  foo bar => foo_bar
-  camelCase => camel_case
-  PascalCase => pascal_case"
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (join "_"  (map lower-case (split-words s))))
-
-(defn ^String screaming-snake-case
-  "Upper case s and use underscores to separate words.
-
-  foo bar => FOO_BAR
-  camelCase => CAMEL_CASE
-  PascalCase => PASCAL_CASE"
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (join "_"  (map upper-case (split-words s))))
-
-(defn ^String strip-accents
-  "Strip all accents (diacritical marks) from s.
-
-  Et ça sera sa moitié => Et ca sera sa moitie"
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (-> s
-      (Normalizer/normalize java.text.Normalizer$Form/NFD)
-      (.replaceAll  "\\p{InCombiningDiacriticalMarks}+" "")))
-
-(defn ^String ascii?
-  "Return s if s only contains ASCII characters."
-  [^String s]
-  {:pre [(string? s)]
-   :post [(or (nil? %) (string? %))]}
-  ;; The ASCII character set is encoded as the integers from 0 to 127.
-  (when (reduce (fn [acc c] (and acc (< (int c) 128))) true s)
-    s))
-
-(defn ^String slug
-  "Transform s so it's suitable for use in URLs.
-
-  The following transformations are applied:
-
-  * Diacritical marks are removed from all characters.
-  * Any character which isn't alphanumeric or in #{_-.~} is removed.
-  * Lower case
-  * Whitespace is collapsed and replaced by a single dash."
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (-> s
-      (.replaceAll "\\s+" "-")
-      strip-accents
-      (.replaceAll "[^A-Za-z0-9_.~-]" "")
-      (.replaceAll "-+" "-")
-      lower-case))
-
-(defn- upper-if-upper-exists?
-  "Is c uppercase for those characters which have an upper case version?"
-  [^Character c]
-  (or (Character/isUpperCase c) (= c (Character/toUpperCase c))))
-
-(defn- lower-if-lower-exists?
-  "Is c lower for those characters which have an lower case version?"
-  [^Character c]
-  (or (Character/isLowerCase c) (= c (Character/toLowerCase c))))
-
-(defn ^String mixed-case?
-  "Return s if s contains both upper and lower case letters. "
-  [^String s]
-  {:pre [(string? s)]
-   :post [(or (nil? %) (string? %))]}
-  (when (and (seq (drop-while (complement upper-if-upper-exists?) s))
-             (seq (drop-while (complement lower-if-lower-exists?) s)))
-    s))
-
-(defn ^String collapse-whitespace
-  "Convert all adjacent whitespace characters in s to a single space."
-  [^String s]
-  {:pre [(string? s)]
-   :post [(string? %)]}
-  (.replaceAll s "[ \t\n\r]+" " "))
-
-(defn- ^Long levenshtein-distance
-  [s1 s2]
-  (let [subsolutions (atom {})
-        subsolution (fn [i j]
-                      (if (or (zero? i) (zero? j))
-                        (max i j)
-                        (get @subsolutions [i j])))]
-    (doseq [i (range 1 (inc (length s1)))]
-      (doseq [j (range 1 (inc (length s2)))]
-        (swap! subsolutions assoc [i j]
-               (min (inc (subsolution (dec i) j))
-                    (inc (subsolution i (dec j)))
-                    (+ (subsolution (dec i) (dec j))
-                       (if (= (.charAt s1 (dec i))
-                              (.charAt s2 (dec j)))
-                         0
-                         1))))))
-    (subsolution (length s1) (length s2))))
-
-(defn- hamming-distance [s1 s2]
-  (+
-   (reduce + (map #(if (= %1 %2) 0 1) s1 s2))
-   (- (max (length s1) (length s2))
-      (min (length s1) (length s2)))))
-
-(defn ^Long distance
-  "Get the distance between s1 and s2.
-
-  The default distance metric is the Lehvenstein distance.
-
-  The optional algorithm argument can be either :levenshtein to get
-  the default, or :hamming to get the Hamming distance between s1 and
-  s2."
-  ([^String s1 ^String s2]
-   {:pre [(string? s1)
-          (string? s2)]
-    :post [(integer? %)]}
-   (levenshtein-distance s1 s2))
-  ([^String s1 ^String s2 algorithm]
-   {:pre [(string? s1)
-          (string? s2)]
-    :post [(integer? %)]}
-   (case algorithm
-     :levenshtein (distance s1 s2)
-     :hamming (hamming-distance s1 s2)
-     (throw (IllegalArgumentException. (str "Unknown algorithm: " algorithm))))))
-
-(defn longest-common-substrings
-  "Returns the set of the longest common substrings in s1 and s2.
-
-  This implementation uses dynamic programming, and not a generalized
-  suffix tree, so the runtime is O(nm)."
-  [^String s1 ^String s2]
-  {:pre [(string? s1)
-         (string? s2)]
-   :post [(set? %)]}
-  (let [rows (inc (length s1))
-        cols (inc (length  s2))
-        ls (make-array Long rows cols)
-        z (atom 0)
-        ret (atom #{})]
-    (doseq [i (range 0 rows)]
-      (doseq [j (range 0 cols)]
-        (aset ls i j 0)))
-    (doseq [i (range 1 rows)]
-      (doseq [j (range 1 cols)]
-        (when(= (.charAt s1 (dec i)) (.charAt s2 (dec j)))
-          (if (or (= i 0) (= j 0))
-            (aset ls i j 1)
-            (aset ls i j (inc (aget ls (dec i) (dec j)))))
-          (if (> (aget ls i j) @z)
-            (do
-              (reset! z (aget ls i j))
-              (reset! ret #{(substring s1 (- i @z) i)}))
-            (when (= (aget ls i j) @z)
-              (swap! ret conj (substring s1 (- i @z) i)))))))
-    @ret))
+(ns superstring.core
+  (:require clojure.string)
+  (:refer-clojure :exclude [reverse replace contains?])
+  (:import java.text.Normalizer))
+
+(declare slice)
+
+;; Taken from [jackknife "0.1.6"]
+(defmacro ^:private defalias
+  "Defines an alias for a var: a new var with the same root binding (if
+  any) and similar metadata. The metadata of the alias is its initial
+  metadata (as provided by def) merged into the metadata of the original."
+  ([name orig]
+   `(do
+      (alter-meta!
+       (if (.hasRoot (var ~orig))
+         (def ~name (.getRawRoot (var ~orig)))
+         (def ~name))
+       ;; When copying metadata, disregard {:macro false}.
+       ;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273
+       #(conj (dissoc % :macro :added)
+              (apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %)))))
+      (var ~name)))
+  ([name orig doc]
+   (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig)))
+
+(defmacro ^:private alias-ns
+  "Create an alias for all public vars in ns in this ns."
+  [namespace]
+  `(do ~@(map
+          (fn [n] `(defalias ~(.sym n) ~(symbol (str (.ns n)) (str (.sym n)))))
+          (vals (ns-publics namespace)))))
+
+(alias-ns clojure.string)
+(def substring clojure.core/subs)
+
+(defn ^Long length
+  "Return the length of s."
+  [^String s]
+  {:pre [(string? s)]
+   :post [(integer? %)]}
+  (.length s))
+
+(defn ^Long index-of
+  "Return the starting position of the first occurrence of needle in s.
+
+  If start is provided, start the search at that position in s."
+  ([^String s needle]
+   {:pre [(string? s) (string? needle)]
+    :post [(integer? %)]}
+   (.indexOf s needle))
+  ([^String s needle ^Long start]
+   {:pre [(string? s) (string? needle) (integer? start)]
+    :post [(integer? %)]}
+   (.indexOf s needle start)))
+
+(defn ^Long last-index-of
+  "Return the starting position of the last occurrence of needle in s.
+
+  If start is provided, start the search at that position in s."
+  ([^String s needle]
+   {:pre [(string? s) (string? needle)]
+    :post [(integer? %)]}
+   (.lastIndexOf s needle))
+  ([^String s needle ^Long start]
+   {:pre [(string? s) (string? needle) (integer? start)]
+    :post [(integer? %)]}
+   (.lastIndexOf s needle start)))
+
+(defn- ^String slice-relative-to-end
+  [s index length]
+  (if (neg? (+ (superstring.core/length s) index))
+    nil ; slice outside beg of s
+    (slice s (+ (superstring.core/length s) index) length)))
+
+(defn ^String slice
+  "Return a slice of s beginning at index and of the given length.
+
+  If index is negative the starting index is relative to the end of the string.
+
+  The default length of the slice is 1.
+
+  If the requested slice ends outside the string boundaries, we return
+  the substring of s starting at index.
+
+  Returns nil if index falls outside the string boundaries or if
+  length is negative."
+  ([^String s index]
+   (slice s index 1))
+  ([^String s ^long index length]
+   (cond
+     (neg? length) nil
+     (neg? (+ (superstring.core/length s) index))
+     nil ; slice relative to end falls outside s
+     (neg? index) (slice-relative-to-end s index length)
+     (>= index (superstring.core/length s)) nil
+     (> (- length index) (superstring.core/length (substring s index)))
+     (substring s index)
+     :else (let [end (+ index length)]
+             (substring s index end)))))
+
+(defn ^String ends-with?
+  "Return s if s ends with suffix."
+  ([^String s ^String suffix]
+   (when (.endsWith s suffix)
+     s))
+  ([^String s ^String suffix ignore-case]
+   (if-not ignore-case
+     (ends-with? s suffix)
+     (let [end (substring s (max 0 (- (length s) (length suffix))))]
+       (when (.equalsIgnoreCase end suffix)
+         s)))))
+
+(defn ^String starts-with?
+  "Return s if s starts with with prefix.
+
+  If a third argument is provided the string comparison is insensitive to case."
+  ([^String s ^String prefix]
+   (when (.startsWith s prefix)
+     s))
+  ([^String s ^String prefix ignore-case]
+   (if-not ignore-case
+     (starts-with? s prefix)
+     (let [beg (substring s 0 (length prefix))]
+       (when (.equalsIgnoreCase beg prefix)
+         s)))))
+
+(defn ^String chop
+  "Return a new string with the last character removed.
+
+  If the string ends with \\r\\n, both characters are removed.
+
+  Applying chop to an empty string is a no-op."
+  [^String s]
+  (if (.endsWith s "\r\n")
+    (substring s 0 (- (length s) 2))
+    (substring s 0 (max 0 (dec (length s))))))
+
+(defn ^String chomp
+  "Return a new string with the given record separator removed from
+  the end (if present).
+
+  If separator is not provided chomp will remove \\n, \\r or \\r\\n from
+  the end of s."
+  ([^String s]
+   (cond
+     (.endsWith s "\r\n") (substring s 0 (- (length s) 2))
+     (.endsWith s "\r") (substring s 0 (dec (length s)))
+     (.endsWith s "\n") (substring s 0 (dec (length s)))
+     :else s))
+  ([^String s ^String separator]
+   (if (.endsWith s separator)
+     (substring s 0 (- (length s) (length separator)))
+     s)))
+
+(defn ^String capitalize
+  "Return a new string where the first character is in upper case and
+  all others in lower case."
+  [^String s]
+  (case (length s)
+    0 ""
+    1 (upper-case s)
+    (str (upper-case (substring s 0 1)) (lower-case (substring s 1)))) )
+
+(defn ^String swap-case
+  "Change lower case characters to upper case and vice versa."
+  [^String s]
+  (let [invert-case (fn [c]
+                      (cond
+                        (Character/isLowerCase c) (Character/toUpperCase c)
+                        (Character/isUpperCase c) (Character/toLowerCase c)
+                        :else c))]
+    (->> s (map invert-case) (apply str))))
+
+(defn- ^String gen-padding
+  "Generate the necessary padding to fill s upto width."
+  [^String s ^String padding width]
+  (let [missing (- width (length s))
+        full-lengths (Math/floor (/ missing (length padding)))
+        remaining (if (zero? full-lengths) (- width (length s))
+                      (rem missing (* full-lengths (length padding))))]
+    (str (apply str (repeat full-lengths padding))
+         (substring padding 0 remaining))))
+
+
+(defn ^String pad-right
+  "Pad the end of s with padding, or spaces, until the length of s matches
+  width."
+  ([^String s width]
+   (pad-right s width " "))
+  ([^String s width ^String padding]
+   {:pre [(not-empty padding)
+          (not (nil? s))]
+    :post [(= (length %) width)]}
+   (if (<= width (length s))
+     s
+     (str s (gen-padding s padding width)))))
+
+(defn ^String pad-left
+  "Pad the beginning of s with padding, or spaces, until the length of
+  s matches width."
+  ([^String s width]
+   (pad-left s width " "))
+  ([^String s width ^String padding]
+   {:pre [(not-empty padding)
+          (not (nil? s))]
+    :post [(= (length %) width)]}
+   (if (<= width (length s))
+     s
+     (str (gen-padding s padding width) s))))
+
+(defn ^String center
+  "Pad both ends of s with padding, or spaces, until the length of s
+  matches width."
+  ([^String s width]
+   (center s width " "))
+  ([^String s width ^String padding]
+   {:pre [(not-empty padding)
+          (not (nil? s))]
+    :post [(= (length %) width)]}
+   (if (<= width (length s))
+     s
+     (let [missing (- width (length s))
+           full-lengths (Math/ceil (/ missing (length padding)))
+           p (gen-padding s padding width)
+           lengths-before (Math/floor (/ full-lengths 2))]
+       (str (substring p 0 (* (length padding) lengths-before))
+            s
+            (substring p (* (length padding) lengths-before)))))))
+
+(defn ^String chop-suffix
+  "If s ends with suffix return a new string without the suffix.
+
+  Otherwise return s."
+  ([^String s ^String suffix]
+   (chop-suffix s suffix false))
+  ([^String s ^String suffix ignore-case]
+   {:pre [(not (nil? s))
+          (not (nil? suffix))]
+    :post [(not (nil? %))]}
+   (if (and (>= (length s) (length suffix))
+            (ends-with? s suffix ignore-case))
+     (substring s 0 (- (length s) (length suffix)))
+     s)))
+
+(defn ^String chop-prefix
+  "If s starts with with prefix return a new string without the prefix.
+
+  Otherwise return s."
+  ([^String s ^String prefix]
+   (chop-prefix s prefix false))
+  ([^String s ^String prefix ignore-case]
+   {:pre [(not (nil? s))
+          (not (nil? prefix))]
+    :post [(not (nil? %))]}
+   (if (and (>= (length s) (length prefix))
+            (starts-with? s prefix ignore-case))
+     (substring s (length prefix))
+     s)))
+
+(defn- case-sensitive-contains
+  [s needle]
+  (if (= needle "")
+    s
+    (when (.contains s needle)
+      s)))
+
+(defn- case-insensitive-contains
+  [s needle]
+  (if (= needle "")
+    s
+    (let [p (java.util.regex.Pattern/compile
+             (java.util.regex.Pattern/quote needle)
+             (bit-or java.util.regex.Pattern/CASE_INSENSITIVE
+                     java.util.regex.Pattern/UNICODE_CASE))]
+      (when (re-find p s)
+        s))))
+
+(defn ^String contains?
+  "Return s if s contains needle."
+  ([^String s ^String needle]
+   (case-sensitive-contains s needle))
+  ([^String s ^String needle ignore-case]
+   (if ignore-case
+     (case-insensitive-contains s needle)
+     (case-sensitive-contains s needle))))
+
+(defn ^String contains-all?
+  "Return s if s contains all needles."
+  ([^String s needles]
+   (when (every? (partial case-sensitive-contains s) needles)
+     s))
+  ([^String s needles ignore-case]
+   (if ignore-case
+     (when (every? (partial case-insensitive-contains s) needles)
+       s)
+     (contains-all? s needles))))
+
+(defn ^String contains-any?
+  "Return s if s contains any of the needles."
+  ([^String s needles]
+   (some (partial case-sensitive-contains s) needles))
+  ([^String s needles ignore-case]
+   (if ignore-case
+     (some (partial case-insensitive-contains s) needles)
+     (contains-any? s needles))))
+
+(defn ^String truncate
+  "If s is longer than len-3, cut it down to len-3 and append '...'."
+  [^String s len]
+  {:pre [(not (nil? s)) (>= len 3)]}
+  (if (> (length s) (max 3 (- len 3)))
+    (str (substring s 0 (- len 3)) "...")
+    s))
+
+(defn- char-equal-ignore-case
+  [^Character c1 ^Character c2]
+  (when (or (= c1 c2)
+            (= (Character/toUpperCase c1) c2)
+            (= (Character/toLowerCase c1) c2))
+    c1))
+
+(defn ^String common-prefix
+  "Return the longest common prefix of s1 and s2."
+  ([^String s1 ^String s2]
+   {:pre [(string? s1) (string? s2)]
+    :post [(string? %)]}
+   (->> s1
+        (map #(when (= %1 %2) %1) s2)
+        (take-while (complement nil?))
+        (apply str)))
+  ([^String s1 ^String s2 ignore-case]
+   {:pre [(string? s1) (string? s2)]
+    :post [(string? %)]}
+   (if-not ignore-case
+     (common-prefix s1 s2)
+     (->> s1
+          (map #(when (or (= %1 %2)
+                          (= (Character/toUpperCase %1) %2)
+                          (= (Character/toLowerCase %1) %2))
+                  %1)
+               s2)
+          (take-while (complement nil?))
+          (apply str)))))
+
+(defn ^String common-suffix
+  "Return the longest common suffix of s1 and s2."
+  ([^String s1 ^String s2]
+   {:pre [(string? s1) (string? s2)]
+    :post [(string? %)]}
+   (->> s1
+        reverse
+        (map #(when (= %1 %2) %1) (reverse s2))
+        (take-while (complement nil?))
+        (apply str)
+        reverse))
+  ([^String s1 ^String s2 ignore-case]
+   {:pre [(string? s1) (string? s2)]
+    :post [(string? %)]}
+   (if-not ignore-case
+     (common-suffix s1 s2)
+     (->> s1
+          reverse
+          (map char-equal-ignore-case (reverse s2))
+          (take-while (complement nil?))
+          (apply str)
+          reverse))))
+
+(defn- upper-exists?
+  "Does c exist in an upper case version?"
+  [^Character c]
+  (or (Character/isUpperCase c) (not= c (Character/toUpperCase c))))
+
+(defn ^String title-case
+  "Capitalize the first character of s and lower case the rest."
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (let [first-char (first s)
+        start (if (upper-exists? first-char) (upper-case first-char) first-char)]
+    (str start (lower-case (substring s 1)))))
+
+(defn ^String upper-case?
+  "Return s if s is all upper case.
+
+  Characters without case, e.g. numbers, are considered to be trivially
+  upper case."
+  [^String s]
+  {:pre [(string? s)]
+   :post [(or (nil? %) (string? %))]}
+  (when (reduce
+         (fn [acc ^Character c]
+           (and acc (or (Character/isUpperCase c) (= c (Character/toUpperCase c)))))
+         true s)
+    s))
+
+(defn ^String lower-case?
+  "Return s if s is all lower case.
+
+  Characters without case, e.g. numbers, are considered to be trivially
+  lower case."
+  [^String s]
+  {:pre [(string? s)]
+   :post [(or (nil? %) (string? %))]}
+  (when (reduce
+         (fn [acc ^Character c]
+           (and acc (or (Character/isLowerCase c) (= c (Character/toLowerCase c)))))
+         true s)
+    s))
+
+(defn- split-words [^String s]
+  (remove empty?
+          (-> s
+              (replace #"_|-" " ")
+              (replace #"(\p{javaUpperCase})((\p{javaUpperCase})[(\p{javaLowerCase})0-9])"
+                       "$1 $2")
+              (replace
+               #"(\p{javaLowerCase})(\p{javaUpperCase})" "$1 $2")
+              (split
+               #"[^\w0-9]+"))))
+
+(defn wrap-words
+  "Insert newlines in s so the length of each line doesn't exceed width."
+  [^String s width]
+  (->> (split s #"\n|\t|\n| ")
+       (remove empty?)
+       (reduce
+        (fn [{:keys [len res]} ^String word]
+          (if (< (+ len (length word)) width)
+            {:len (+ len (length word) 1) :res (conj res " " word)}
+            {:len (length word) :res (conj res "\n" word)}))
+        {:len 0 :res []})
+       :res
+       rest ; drop leading " "
+       (apply str)))
+
+(defn ^String lisp-case
+  "Lower case s and separate words with dashes.
+
+  foo bar => foo-bar
+  camelCase => camel-case
+
+  This is also referred to as kebab-case in some circles."
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (join "-" (map lower-case (split-words s))))
+
+(defn ^String camel-case
+  "Lower case first char in s and use capitalization to separate words.
+
+  foo bar => fooBar
+  camelCase => camelCase
+  PascalCase => pascalCase"
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (let [words (split-words s)]
+    (join ""  (conj (map capitalize (rest words)) (lower-case (first words))))))
+
+(defn ^String pascal-case
+  "Lower case first char in s and use capitalization to separate words.
+
+  foo bar => FooBar
+  camelCase => CamelCase
+  PascalCase => PascalCase"
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (join ""  (map capitalize (split-words s))))
+
+(defn ^String snake-case
+  "Lower case s and use underscores to separate words.
+
+  foo bar => foo_bar
+  camelCase => camel_case
+  PascalCase => pascal_case"
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (join "_"  (map lower-case (split-words s))))
+
+(defn ^String screaming-snake-case
+  "Upper case s and use underscores to separate words.
+
+  foo bar => FOO_BAR
+  camelCase => CAMEL_CASE
+  PascalCase => PASCAL_CASE"
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (join "_"  (map upper-case (split-words s))))
+
+(defn ^String strip-accents
+  "Strip all accents (diacritical marks) from s.
+
+  Et ça sera sa moitié => Et ca sera sa moitie"
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (-> s
+      (Normalizer/normalize java.text.Normalizer$Form/NFD)
+      (.replaceAll  "\\p{InCombiningDiacriticalMarks}+" "")))
+
+(defn ^String ascii?
+  "Return s if s only contains ASCII characters."
+  [^String s]
+  {:pre [(string? s)]
+   :post [(or (nil? %) (string? %))]}
+  ;; The ASCII character set is encoded as the integers from 0 to 127.
+  (when (reduce (fn [acc c] (and acc (< (int c) 128))) true s)
+    s))
+
+(defn ^String slug
+  "Transform s so it's suitable for use in URLs.
+
+  The following transformations are applied:
+
+  * Diacritical marks are removed from all characters.
+  * Any character which isn't alphanumeric or in #{_-.~} is removed.
+  * Lower case
+  * Whitespace is collapsed and replaced by a single dash."
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (-> s
+      (.replaceAll "\\s+" "-")
+      strip-accents
+      (.replaceAll "[^A-Za-z0-9_.~-]" "")
+      (.replaceAll "-+" "-")
+      lower-case))
+
+(defn- upper-if-upper-exists?
+  "Is c uppercase for those characters which have an upper case version?"
+  [^Character c]
+  (or (Character/isUpperCase c) (= c (Character/toUpperCase c))))
+
+(defn- lower-if-lower-exists?
+  "Is c lower for those characters which have an lower case version?"
+  [^Character c]
+  (or (Character/isLowerCase c) (= c (Character/toLowerCase c))))
+
+(defn ^String mixed-case?
+  "Return s if s contains both upper and lower case letters. "
+  [^String s]
+  {:pre [(string? s)]
+   :post [(or (nil? %) (string? %))]}
+  (when (and (seq (drop-while (complement upper-if-upper-exists?) s))
+             (seq (drop-while (complement lower-if-lower-exists?) s)))
+    s))
+
+(defn ^String collapse-whitespace
+  "Convert all adjacent whitespace characters in s to a single space."
+  [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
+  (.replaceAll s "[ \t\n\r]+" " "))
+
+(defn- ^Long levenshtein-distance
+  [s1 s2]
+  (let [subsolutions (atom {})
+        subsolution (fn [i j]
+                      (if (or (zero? i) (zero? j))
+                        (max i j)
+                        (get @subsolutions [i j])))]
+    (doseq [i (range 1 (inc (length s1)))]
+      (doseq [j (range 1 (inc (length s2)))]
+        (swap! subsolutions assoc [i j]
+               (min (inc (subsolution (dec i) j))
+                    (inc (subsolution i (dec j)))
+                    (+ (subsolution (dec i) (dec j))
+                       (if (= (.charAt s1 (dec i))
+                              (.charAt s2 (dec j)))
+                         0
+                         1))))))
+    (subsolution (length s1) (length s2))))
+
+(defn- hamming-distance [s1 s2]
+  (+
+   (reduce + (map #(if (= %1 %2) 0 1) s1 s2))
+   (- (max (length s1) (length s2))
+      (min (length s1) (length s2)))))
+
+(defn ^Long distance
+  "Get the distance between s1 and s2.
+
+  The default distance metric is the Lehvenstein distance.
+
+  The optional algorithm argument can be either :levenshtein to get
+  the default, or :hamming to get the Hamming distance between s1 and
+  s2."
+  ([^String s1 ^String s2]
+   {:pre [(string? s1)
+          (string? s2)]
+    :post [(integer? %)]}
+   (levenshtein-distance s1 s2))
+  ([^String s1 ^String s2 algorithm]
+   {:pre [(string? s1)
+          (string? s2)]
+    :post [(integer? %)]}
+   (case algorithm
+     :levenshtein (distance s1 s2)
+     :hamming (hamming-distance s1 s2)
+     (throw (IllegalArgumentException. (str "Unknown algorithm: " algorithm))))))
+
+(defn longest-common-substrings
+  "Returns the set of the longest common substrings in s1 and s2.
+
+  This implementation uses dynamic programming, and not a generalized
+  suffix tree, so the runtime is O(nm)."
+  [^String s1 ^String s2]
+  {:pre [(string? s1)
+         (string? s2)]
+   :post [(set? %)]}
+  (let [rows (inc (length s1))
+        cols (inc (length  s2))
+        ls (make-array Long rows cols)
+        z (atom 0)
+        ret (atom #{})]
+    (doseq [i (range 0 rows)]
+      (doseq [j (range 0 cols)]
+        (aset ls i j 0)))
+    (doseq [i (range 1 rows)]
+      (doseq [j (range 1 cols)]
+        (when(= (.charAt s1 (dec i)) (.charAt s2 (dec j)))
+          (if (or (= i 0) (= j 0))
+            (aset ls i j 1)
+            (aset ls i j (inc (aget ls (dec i) (dec j)))))
+          (if (> (aget ls i j) @z)
+            (do
+              (reset! z (aget ls i j))
+              (reset! ret #{(substring s1 (- i @z) i)}))
+            (when (= (aget ls i j) @z)
+              (swap! ret conj (substring s1 (- i @z) i)))))))
+    @ret))


Added info about the POC state

Added info about the POC state

--- src/zg/html_renderer.clj
+++ src/zg/html_renderer.clj
@@ -279,6 +279,8 @@
         [:div {:class "row"}
             "Glossary"
         ]
+        [:br]
+        [:h1 {:style "color:red"} "Please note that this application is in the Proof of concept state"]
         [:br]
         [:div {:class "row"}
             [:div {:class "navbar-header"}


make code more readable

make code more readable

--- src/zombie_run/view.cljs
+++ src/zombie_run/view.cljs
@@ -72,23 +72,29 @@
    [:tspan {:x 50 :y 2} "Move in the direction of a zombie"]
    [:tspan {:x 50 :y 4} "and press <f> to fire!"]])

+(defn display-player [game-state]
+  (when-let [pos (game/player-position game-state)]
+    (into [(make-player pos)]
+          (make-blood pos
+                      game/player-default-health
+                      (game/player-health game-state)))))
+
+(defn display-health-text [game-state]
+  (when-let [player-health (game/player-health game-state)]
+    (make-health-text player-health)))
+
 (defn world [game-state]
   [:div
    (into
      [:svg.world
       {:view-box "0 0 100 100"}]
      (mapcat identity
-             [[(when-let [player-health (game/player-health game-state)]
-                 (make-health-text player-health))
+             [[(display-health-text game-state)

                (make-fire-tip-text)

                (display-overlay-text game-state)]

-              (when-let [pos (game/player-position game-state)]
-                (into [(make-player pos)]
-                      (make-blood pos
-                                  game/player-default-health
-                                  (game/player-health game-state))))
+              (display-player game-state)

               (display-zombies game-state)]))])


[#113] Don't remove guard in fn macro

[#113] Don't remove guard in fn macro

--- priv/clojure/core.clj
+++ priv/clojure/core.clj
@@ -3734,6 +3734,7 @@
                         conds (or conds (meta params))
                         pre (:pre conds)
                         post (:post conds)
+                        when (:when conds)
                         body (if post
                                `((let [~'% ~(if (< 1 (count body))
                                               `(do ~@body)
@@ -3744,6 +3745,9 @@
                         body (if pre
                                (concat (map (fn* [c] `(assert ~c)) pre)
                                        body)
+                               body)
+                        body (if when
+                               (cons {:when when} body)
                                body)]
                     (maybe-destructured params body)))
         new-sigs (map psig sigs)]


Added index and sort child nodes by index.

--- evermind.web/src/evermind/web/core.cljs
+++ evermind.web/src/evermind/web/core.cljs
@@ -30,16 +30,17 @@
       (-> node :attributes :text))

 (defn update-node-position
-  [depth top bottom node]
+  [depth index top bottom node]
   (update-in node [:visu]
     (fn [c] {:x (* depth 20)
-             :y (+ top (/ (- bottom top) 2))})))
+             :y (+ top (/ (- bottom top) 2))
+             :index index})))

 (defn update-node
   ([root]
    (update-node 0 0 0 100 root))
   ([depth index top bottom node]
-   (let [newnode (update-node-position depth top bottom node)
+   (let [newnode (update-node-position depth index top bottom node)
          c (count (:children node))
          box-height (/ (- bottom top) c)
          d (inc depth)]
@@ -67,7 +68,7 @@
                          :y (-> node :visu :y)}
                     (-> node :attributes :text))
           (om/build-all node-view
-                        (:children node)
+                        (sort-by #(:index %) (:children node))
                         {:init-state {:select select}
                          :key :id})))))


consistent capitalization

consistent capitalization

--- test/cats/core_spec.cljc
+++ test/cats/core_spec.cljc
@@ -67,7 +67,7 @@

 (t/deftest mapseq-tests
-  (t/testing "It works with maybe values"
+  (t/testing "It works with Maybe values"
     (t/is (= (m/mapseq maybe/just [1 2 3 4 5])
              (maybe/just [1 2 3 4 5])))
     (t/is (= (maybe/nothing)


Deactivate wamp test for now.

Deactivate wamp test for now.

--- test/kabel/wamp_test.clj
+++ test/kabel/wamp_test.clj
@@ -12,7 +12,7 @@

 ;; TODO do not abuse poloniex

-(deftest wamp-test
+#_(deftest wamp-test
   (testing "Testing a simple subscription on the wamp middleware."
     (let [event-ch (chan)
           client (peer/client-peer S #uuid "898dcf36-e07a-4338-92fd-f818d573444a"


Fix unchunking in lazy

Fix unchunking in lazy

The unchunking was previously done after a map, potentially realizing
more input than desired.

--- src/clj/com/climate/claypoole/lazy.clj
+++ src/clj/com/climate/claypoole/lazy.clj
@@ -70,10 +70,10 @@
     (apply map f colls)
     (let [[shutdown? pool] (impl/->threadpool pool)]
       (->> colls
+           ;; make sure we're not chunking
+           (map impl/unchunk)
            ;; use map to take care of argument alignment
            (apply map vector)
-           ;; make sure we're not chunking
-           impl/unchunk
            ;; make futures
            (map (fn [a] (cp/future-call pool
                                         ;; Use with-meta for priority
@@ -122,10 +122,10 @@
                                                    (finally (.put result-q @p)))
                                              {:args a})))))]
       (->> colls
+           ;; make sure we're not chunking
+           (map impl/unchunk)
            ;; use map to take care of argument alignment
            (apply map vector)
-           ;; make sure we're not chunking
-           impl/unchunk
            ;; make futures
            (map run-one)
            ;; force buffer-size futures to start work in the pool


Some todos.

Some todos.

--- src/clj/onyx_dashboard/http/server.clj
+++ src/clj/onyx_dashboard/http/server.clj
@@ -28,19 +28,18 @@
             [:security :anti-forgery]
             {:read-token (fn [req] (-> req :params :csrf-token))}))

+; TODO: Move into component
 (def deployments (atom {}))
 (def tracking (atom {}))

-;(deref tracking)
-
-; Improve fn name
+; TODO:  Improve fn name
 (defn job-peer-allocated-task [job-allocations job-id peer-id]
   (ffirst
     (filter (fn [[task-id peer-ids]]
               (not-empty (filter #{peer-id} peer-ids)))
             job-allocations)))

-; Improve fn name
+; TODO:  Improve fn name
 (defn task-allocated-to-peer [allocations peer-id]
   (some identity
         (map (fn [job-id]
@@ -214,7 +213,7 @@
       (resources "/")
       (resources "/react" {:root "react"})
       (route/not-found "Page not found"))
-
+
     (let [event-handler-fut (start-event-handler sente peer-config)
           ; TODO: no way to currently stop this watch
           _ (refresh-deployments-watch (partial send-mult-fn


Fixed conditional check to be more specific.

--- src/cmr/opendap/components/caching.clj
+++ src/cmr/opendap/components/caching.clj
@@ -26,6 +26,12 @@
     (spit
       dumpfile
       (prn-str cache-data))))
+
+(defn item-has-value?
+  [item]
+  (cond (nil? item) false
+        (and (seq? item) (empty? item)) false
+        :else true))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;   Caching Component API   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -69,7 +75,7 @@
           (cache/hit ch item-key))
         (when-let [value (value-fn)]
           (log/debug "Concept cache miss; calling value function ...")
-          (when-not (or (nil? value) (empty? value))
+          (when (item-has-value? value)
             (swap! (get-cache system) #(cache/miss % item-key value))))))
     (lookup system item-key)))


Sync clojure version & comment in lein Dockerfiles

--- src/docker_clojure/dockerfile/lein.clj
+++ src/docker_clojure/dockerfile/lein.clj
@@ -68,7 +68,7 @@
           "ENV PATH=$PATH:$LEIN_INSTALL"
           "ENV LEIN_ROOT 1"
           ""
-          "# Install clojure 1.10.0 so users don't have to download it every time"
+          "# Install clojure 1.10.1 so users don't have to download it every time"
           "RUN echo '(defproject dummy \"\" :dependencies [[org.clojure/clojure \"1.10.1\"]])' > project.clj \\"
           "  && lein deps && rm project.clj"
           ""


Ready for ongoing bidi development

Ready for ongoing bidi development

--- modules/bidi/project.clj
+++ modules/bidi/project.clj
@@ -1,6 +1,6 @@
 ;; Copyright © 2014 JUXT LTD.

-(defproject juxt.modular/bidi "0.7.2"
+(defproject juxt.modular/bidi "0.7.3-SNAPSHOT"
   :description "A modular extension that provides support for bidi routing"
   :url "https://github.com/juxt/modular/tree/master/modules/bidi"
   :license {:name "The MIT License"


default timestamp for delete

default timestamp for delete

--- src/er_cassandra/model/alia/delete.clj
+++ src/er_cassandra/model/alia/delete.clj
@@ -97,7 +97,8 @@
                                               entity
                                               key
                                               record-or-key-value
-                                              nil)]
+                                              nil)
+            opts (ts/default-timestamp-opt opts)]
        (if record
          (delete-with-primary session entity key record opts)
          (return


Bump figwheel to 0.5.0-4

Bump figwheel to 0.5.0-4

--- src/leiningen/new/chestnut/project.clj
+++ src/leiningen/new/chestnut/project.clj
@@ -4,7 +4,7 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}

-  :dependencies [[org.clojure/clojure "1.7.0"]
+  :dependencies [[org.clojure/clojure "1.8.0-RC5"]
                  [org.clojure/clojurescript "1.7.228" :scope "provided"]
                  [ring "1.4.0"]
                  [ring/ring-defaults "0.1.5"]
@@ -94,8 +94,8 @@
   :auto {"sassc" {:file-pattern  #"\.(scss)$"}}{{/sass?}}

   :profiles {:dev
-             {:dependencies [[figwheel "0.5.0-3"]
-                             [figwheel-sidecar "0.5.0-3"]
+             {:dependencies [[figwheel "0.5.0-4"]
+                             [figwheel-sidecar "0.5.0-4"]
                              [com.cemerick/piggieback "0.2.1"]
                              [org.clojure/tools.nrepl "0.2.12"]]


Adds plugin to fetch version. Prep for Engraver.

--- src/leiningen/new/onyx_app/project.clj
+++ src/leiningen/new/onyx_app/project.clj
@@ -16,5 +16,6 @@

   :profiles {:uberjar {:aot [{{app-name}}.launcher.aeron-media-driver
                              {{app-name}}.launcher.launch-prod-peers]}
-             :dev {:dependencies [[org.clojure/tools.namespace "0.2.11"]]
+             :dev {:dependencies [[org.clojure/tools.namespace "0.2.11"]
+                                  [lein-project-version "0.1.0"]]
                    :source-paths ["src"]}})


Fix Emacs cider-jack-in-cljs failure

Fix Emacs cider-jack-in-cljs failure

Reported and discussed on Clojurians Slack #shadow-cljs on 2019-08-20.

Co-Authored-By: Quest Yarbrough <06472a716db165d695bc1637897e4361e90cc306@users.noreply.github.com>

--- src/leiningen/new/re_frame/project.clj
+++ src/leiningen/new/re_frame/project.clj
@@ -19,7 +19,9 @@
   :plugins [{{#garden?}}[lein-garden "0.2.8"]{{/garden?}}{{#less?}}
             [lein-less "1.7.5"]{{/less?}}]

-  :min-lein-version "2.5.3"
+  :min-lein-version "2.5.3"{{#cider?}}
+
+  :jvm-opts ["-Xmx1G"]{{/cider?}}

   :source-paths ["src/clj" "src/cljs"]{{#test?}}


Update nucleotide_count_test.clj

Update nucleotide_count_test.clj

Update namespace in function calls from test file (nucleotide_count -> nucleotide-count). This must happen to run tests without a compiler exception.

Exception:

CompilerException java.lang.RuntimeException: No such namespace: nucleotide_count ...

--- nucleotide-count/nucleotide_count_test.clj
+++ nucleotide-count/nucleotide_count_test.clj
@@ -2,31 +2,31 @@
 (load-file "nucleotide_count.clj")

 (deftest empty-dna-strand-has-no-adenosine
-  (is (= 0 (nucleotide_count/count \A, ""))))
+  (is (= 0 (nucleotide-count/count \A, ""))))

 (deftest empty-dna-strand-has-no-nucleotides
   (is (= {\A 0, \T 0, \C 0, \G 0}
-         (nucleotide_count/nucleotide-counts ""))))
+         (nucleotide-count/nucleotide-counts ""))))

 (deftest repetitive-cytidine-gets-counted
-  (is (= 5 (nucleotide_count/count \C "CCCCC"))))
+  (is (= 5 (nucleotide-count/count \C "CCCCC"))))

 (deftest repetitive-sequence-has-only-guanosine
   (is (= {\A 0, \T 0, \C 0, \G 8}
-         (nucleotide_count/nucleotide-counts "GGGGGGGG"))))
+         (nucleotide-count/nucleotide-counts "GGGGGGGG"))))

 (deftest counts-only-thymidine
-  (is (= 1 (nucleotide_count/count \T "GGGGGTAACCCGG"))))
+  (is (= 1 (nucleotide-count/count \T "GGGGGTAACCCGG"))))

 (deftest dna-has-no-uracil
-  (is (= 0 (nucleotide_count/count \U "GATTACA"))))
+  (is (= 0 (nucleotide-count/count \U "GATTACA"))))

 (deftest validates-nucleotides
-  (is (thrown-with-msg? Exception #"invalid nucleotide" (nucleotide_count/count \X "GACT"))))
+  (is (thrown-with-msg? Exception #"invalid nucleotide" (nucleotide-count/count \X "GACT"))))

 (deftest counts-all-nucleotides
   (let [s "AGCTTTTCATTCTGACTGCAACGGGCAATATGTCTCTGTGTGGATTAAAAAAAGAGTGTCTGATAGCAGC"]
     (is (= {\A 20, \T 21, \G 17, \C 12}
-           (nucleotide_count/nucleotide-counts s)))))
+           (nucleotide-count/nucleotide-counts s)))))

 (run-tests)


Adds counters for total cpu/mem/run times by failure reason

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -171,8 +171,8 @@
                       (catch Exception e
                         (log/debug e "Error reading a string from mesos status data. Is it in the format we expect?")))))})

-(defn update-reason-histos!
-  "Updates histograms for run time, cpu time, and memory time,
+(defn update-reason-metrics!
+  "Updates histograms and counters for run time, cpu time, and memory time,
   where the histograms have the failure reason in the title"
   [db mesos-reason instance-runtime {:keys [cpus mem]}]
   (let [reason (->> mesos-reason
@@ -180,14 +180,20 @@
                     (d/entity db)
                     :reason/name
                     name)
-        update-histo! (fn update-histo! [s v]
-                        (histograms/update!
-                          (histograms/histogram
-                            ["cook-mesos" "scheduler" "hist-task-fail" reason s])
-                          v))]
-    (update-histo! "times" instance-runtime)
-    (update-histo! "cpu-times" (* instance-runtime cpus))
-    (update-histo! "mem-times" (* instance-runtime mem))))
+        update-metrics! (fn update-metrics! [s v]
+                          (histograms/update!
+                            (histograms/histogram
+                              ["cook-mesos" "scheduler" "hist-task-fail" reason s])
+                            v)
+                          (counters/inc!
+                            (counters/counter
+                              ["cook-mesos" "scheduler" "hist-task-fail" reason s "total"])
+                            v))
+        instance-runtime-seconds (/ instance-runtime 1000)
+        mem-gb (/ mem 1024)]
+    (update-metrics! "times" instance-runtime-seconds)
+    (update-metrics! "cpu-times" (* instance-runtime-seconds cpus))
+    (update-metrics! "mem-times" (* instance-runtime-seconds mem-gb))))

 (defn handle-status-update
   "Takes a status update from mesos."
@@ -253,7 +259,7 @@
                                         job-resources
                                         instance-runtime)
              (when-not previous-reason
-               (update-reason-histos! db reason instance-runtime job-resources)))
+               (update-reason-metrics! db reason instance-runtime job-resources)))
            ;; This code kills any task that "shouldn't" be running
            (when (and
                    (or (nil? instance) ; We could know nothing about the task, meaning a DB error happened and it's a waste to finish


Fix unrelated unit test (#799)

Fix unrelated unit test (#799)

If the computation takes 0ms, then before=after, and the filter
  before <= X < after never matches any job.

--- scheduler/test/cook/test/mesos/api.clj
+++ scheduler/test/cook/test/mesos/api.clj
@@ -1575,7 +1575,7 @@
         handler (basic-handler conn)
         before (t/now)
         list-jobs-fn #(list-jobs-with-jobs handler "user" ["running" "waiting" "completed"]
-                                           (.getMillis before) (.getMillis (t/now)))
+                                           (.getMillis before) (+ 1 (.getMillis (t/now))))
         response-1 (submit-job handler "user")
         response-2 (submit-job handler "user")
         _ @(d/transact conn [[:db/add [:job/uuid (UUID/fromString (:uuid response-1))] :job/custom-executor true]])


add defsketch

add defsketch

--- ohack/src/ohack/core.clj
+++ ohack/src/ohack/core.clj
@@ -332,3 +332,10 @@
   (q/fill 200)
   (q/text "HELLO WORLD" 10 40)
   )
+
+;; this launches the sketch
+(q/defsketch mysketch
+  :title "visualizer"
+  :setup setup
+  :draw draw
+  :size (map vis-conf [:width :height]))


Добработка обработки ошибок

Добработка обработки ошибок

--- radiolamp-6P3S/src/ixinfestor/net.cljs
+++ radiolamp-6P3S/src/ixinfestor/net.cljs
@@ -30,7 +30,7 @@

-(defn get-data [uri params success-fn & [error-fn complete-fn disable-progress-element?]]
+(defn get-data [uri params success-fn & [error-fn complete-fn disable-progress-element? my-error-alert-fn]]
   (letfn [(get-response-as-transit-or-text [ee]
             (try
               (t/read r (.getResponseText ee))
@@ -46,10 +46,12 @@
                      (get-response-as-transit-or-text ee)
                      "\n---------------------------------------------------------\n\n")
             (when (and show-alert  (not= 0 (.getStatus ee)))
-              (js/alert (str
-                         "ERROR IN [" s "]\n"
-                         "Status: " (.getStatus ee) " - " (.getStatusText ee) "\n"
-                         (get-response-as-transit-or-text ee)))))
+              (if my-error-alert-fn
+                (my-error-alert-fn (.getStatus ee) (.getStatusText ee))
+                (js/alert (str
+                           "ERROR IN [" s "]\n"
+                           "Status: " (.getStatus ee) " - " (.getStatusText ee) "\n"
+                           (get-response-as-transit-or-text ee))))))

           ;; (redirect-to-root-when-not-transit [ee]
           ;;   (let [ct (.getResponseHeader ee "Content-Type")]
@@ -76,14 +78,14 @@
                      (fn [e]
                        (print "REQUEST ERROR")
                        (let [ee (.-target e)]
-
+
                          (try
                            (make-reload-if-reload-client (t/read r (.getResponseText ee)))
                            (catch js/Error e
                              (println "ERR -1 " e)))
-
+
                          (print-error "ERROR" ee false)
-
+
                          (when error-fn
                            (let [rt (.getResponseText ee)]
                              (try
@@ -100,7 +102,7 @@
                            (let [r (t/read r (.getResponseText ee))]
                              (make-reload-if-reload-client r)
                              (when success-fn (success-fn r)))
-                           (catch js/Error e
+                           (catch js/Error e
                              (println (str "ERR 1 " e))
                              (print-error "ERRON IN REQUEST SUCCESS" ee false))))))


fix #896

fix #896

--- src/status_im/chat/views/response.cljs
+++ src/status_im/chat/views/response.cljs
@@ -118,7 +118,7 @@
   [event]
   (let [{:strs [loading url]} (js->clj event)]
     (when-not (= "about:blank" url)
-      (if loading
+      (when-not loading
         (dispatch [:set-web-view-url url])
         (dispatch [:set-chat-command-content (str cu/command-prefix url)])))))


actually fix tests

actually fix tests

--- src/test/shadow/build/ns_form_test.clj
+++ src/test/shadow/build/ns_form_test.clj
@@ -210,7 +210,7 @@
            '{react-dnd-html5-backend alias$react-dnd-html5-backend}})]

     (is (= 'alias$react-dnd-html5-backend (get-in ast-resolved [:requires 'react-dnd-html5-backend])))
-    (is (= '[goog shadow.cljs_helpers cljs.core alias$react-dnd-html5-backend] (:deps ast-resolved)))
+    (is (= '[goog #_ shadow.cljs_helpers cljs.core alias$react-dnd-html5-backend] (:deps ast-resolved)))
     (is (= 'alias$react-dnd-html5-backend/default (get-in ast-resolved [:renames 'HTML5Backend])))
     ;; (pprint ast)
     ;; (pprint ast-resolved)


SER-1338 | Implement caching methods

SER-1338 | Implement caching methods

--- src/vignette/storage/static_assets.clj
+++ src/vignette/storage/static_assets.clj
@@ -2,7 +2,8 @@
   (:require [vignette.storage.protocols :refer :all]
             [org.httpkit.client :as http]
             [vignette.util.filesystem :as fs]
-            [clojure.java.io :as io]))
+            [clojure.java.io :as io]
+            [vignette.media-types :as mt]))

 (defn- parse-content-disp
   [header]
@@ -32,9 +33,22 @@
             (first-available (rest image-urls))))))))

 (defrecord StaticImageStorage [static-image-url] ImageStorageProtocol
-  (save-thumbnail [_ _ _] nil)
-  (get-thumbnail [_ _] nil)
-  (save-original [_ _ _] nil)
+  (save-thumbnail [this resource thumb-map]
+      (put* (:store this)
+        resource
+        thumb-map
+        mt/thumbnail-path)))
+
+  (get-thumbnail [this thumb-map]
+       (get* (:store this)
+         thumb-map
+         mt/thumbnail-path))
+
+  (save-original [this resource original-map]
+     (put* (:store this)
+       resource
+       original-map
+       mt/original-path))

   (get-original [_ original-map]
     (let [uuid (:uuid original-map)
@@ -45,7 +59,7 @@
     (if-let [uuid (:uuid image-map)]
       (let [static-image-response (http/head (static-image-url uuid))]
         (-> @static-image-response :status (= 200))))))
-
+

 (defn create-static-image-storage [static-image-url]
   (->StaticImageStorage static-image-url))


Add verbosity option to less-compile

Add verbosity option to less-compile

--- src/less4clj/core.clj
+++ src/less4clj/core.clj
@@ -124,21 +124,24 @@
   "Input can be:
    - File
    - String"
-  [input {:keys [source-map source-paths] :as options}]
-  (try
-    (let [ctx {:source-paths source-paths
-               :asset-map (webjars/asset-map)}
-          result (-> (DefaultLessCompiler.)
-                     (.compile
-                       (->less-source ctx input)
-                       (build-configuration options)))]
-      (doseq [warn (.getWarnings result)]
-        (util/warn "WARNING: %s\n" (.getMessage warn)))
-      {:output (.getCss result)
-       :source-map (if source-map (.getSourceMap result))})
-    (catch Less4jException e
-      (util/fail (.getMessage e))
-      {:error e})))
+  [input {:keys [source-map source-paths verbosity]
+          :or {verbosity 1}
+          :as options}]
+  (binding [util/*verbosity* verbosity]
+    (try
+      (let [ctx {:source-paths source-paths
+                 :asset-map (webjars/asset-map)}
+            result (-> (DefaultLessCompiler.)
+                       (.compile
+                         (->less-source ctx input)
+                         (build-configuration options)))]
+        (doseq [warn (.getWarnings result)]
+          (util/warn "WARNING: %s\n" (.getMessage warn)))
+        {:output (.getCss result)
+         :source-map (if source-map (.getSourceMap result))})
+      (catch Less4jException e
+        (util/fail (.getMessage e))
+        {:error e}))))

 (defn less-compile-to-file [path target-dir relative-path options]
   (let [input-file (io/file path)


Consider negative seconds values

Consider negative seconds values


don't allow already played walls

don't allow already played walls

--- src/quoridor/core.clj
+++ src/quoridor/core.clj
@@ -87,7 +87,7 @@

 (defn- allowed-wall-move?
   [state move]
-  (if (= (count move) 4)
+  (if (and (= (count move) 4) (not (contains? (state :walls) move)))
     true
     false))


account for url params in linkify regex

account for url params in linkify regex

--- src-cljs/frontend/components/chat.cljs
+++ src-cljs/frontend/components/chat.cljs
@@ -19,7 +19,7 @@
   (:require-macros [sablono.core :refer (html)])
   (:import [goog.ui IdGenerator]))

-(def url-regex #"(?im)\b(?:https?|ftp)://[-A-Za-z0-9+@#/%?=~_|!:,.;]*[-A-Za-z0-9+@#/%=~_|]")
+(def url-regex #"(?im)\b(?:https?|ftp)://[-A-Za-z0-9+@#/%?&=~_|!:,.;]*[-A-Za-z0-9+@#/%=~_|]")

 (defn linkify [text]
   (let [matches (re-seq url-regex text)


Show flash notification when user deletes env var

--- src-cljs/frontend/controllers/api.cljs
+++ src-cljs/frontend/controllers/api.cljs
@@ -543,9 +543,12 @@
   [target message status {:keys [resp context]} state]
   (if-not (= (:project-id context) (project-model/id (get-in state state/project-path)))
     state
-    (update-in state state/project-envvars-path (fn [vars]
-                                                  (remove #(= (:env-var-name context) (:name %))
-                                                          vars)))))
+    (-> state
+        (update-in state/project-envvars-path (fn [vars]
+                                                (remove #(= (:env-var-name context) (:name %))
+                                                        vars)))
+        (state/add-flash-notification (gstring/format "Environment variable '%s' deleted successfully."
+                                                      (:env-var-name context))))))

 (defmethod api-event [:save-ssh-key :success]


monotize-by

monotize-by

--- src/atom_finder/questions/code_age.clj
+++ src/atom_finder/questions/code_age.clj
@@ -99,25 +99,19 @@
                                           :date (->> commit commit-time ymd-str)}
                                          (treewalk->file repository tree-walk)))))))

-'(defn safe-mem-tu
-  [path content]
-    (log-err (str "Trying to parse " path) nil
-             (with-timeout 3
-               (mem-tu path content))))
-
-'((->> (range 1 15)
-     (map #(str gcc-path "/gcc/testsuite/g++.dg/lookup/koenig" % ".C"))
-     (pmap (fn [path]
-            (safe-mem-tu path (slurp path))))
-     (map prn)
-     dorun
-     time-mins))
+(defn monotize-by
+  "filter out non-monotonic values"
+  [cmp f coll]
+  (->> coll (partition 2 1) (filter (fn [[a b]] (cmp (f a) (f b)))) (map first)))

 '((-<>>
- gcc-repo
+   linux-repo
+ (rev-walk-from <> "be1f16ba35d97aff4d85c0daba0a02da51b7c83c")
  (pap (constantly (now)))
- first-monthly-commits
- (mapcat (partial repo-files gcc-repo))
+ (partition-by (fn [rc] (-> rc year-month (update-in [1] #(int (/ (dec %) 3))))))
+ (map last)
+ (monotize-by (comp (partial < 0) compare) year-month)
+ (mapcat (partial repo-files linux-repo))
  (filter (comp c-file? :path))
  ;(drop 6100)
  ;(map (partial pap #(select-keys % [:rev-str :path])))
@@ -130,6 +124,6 @@
  ;(take 3)
  (map prn)
  dorun
- (log-to "tmp/code-age_gcc_2017-10-14_02.edn")
+ (log-to "tmp/code-age_linux_2017-10-14_01.edn")
  time-mins
  ))


Return unmodified template on template details request failure.

--- src/clj/clj_templates/clojars_data.clj
+++ src/clj/clj_templates/clojars_data.clj
@@ -49,7 +49,8 @@
       (let [template-details (json/parse-string (:body res) true)]
         (assoc template :homepage (:homepage template-details)
                         :downloads (:downloads template-details)))
-      (timbre/error "Something went wrong when getting template detail info for template " template ": " (:body res)))))
+      (do (timbre/error "Something went wrong when getting template detail info for template " template ": " (:body res))
+          template))))

 (defn update-templates-details-info [templates]
   (map update-template-details-info


default 0 value heatmaps cells to white; no need to calculate their colour!

--- src/cljs/gointermod/heatmap/views.cljs
+++ src/cljs/gointermod/heatmap/views.cljs
@@ -39,13 +39,15 @@
 (defn calc-color [color-val]
   "Given a count value, this function returns an rgb value weighted to make higher counts darker, with the darkest colours being the maximum value found in the table.
   Results are weighted proportionally - so values of 1 will be quite dark if the highest value in the table is two, or quite light if the highest value is 30."
+  (if (= 0 color-val)
+    {:background "rgb(255,255,255)"}
   (let [heatmap (re-frame/subscribe [:heatmap-aggregate])
         max-val (last (:max-count @heatmap))
         calculated-color (int (/ (* color-val 255) max-val))
         bg-color (- 255 calculated-color)
         mid-color (int (/ (+ 255 bg-color) 2))]
   {:background (str "rgb(" bg-color "," mid-color "," "255)")}
-))
+)))

 (defn counts []
   ;;subscribe to the heatmap data


Add recursive binding into the same path

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -106,6 +106,35 @@
                          (swap! data assoc-in child-path val))
         (.log js/console (clj->js [event key val]))))))

+(defn r-item-binder [f]
+  (fn [data path msg]
+    (let [[event key val] msg
+          child-path (conj path key)]
+      (case event
+        :child_added (do
+                       (swap! data assoc-in child-path val)
+                       (when (= key :kids)
+                         (doseq [id val]
+                           (f id))))
+        :child_changed (do
+                         (swap! data assoc-in child-path val)
+                         (when (= key :kids)
+                           (doseq [id val]
+                             (f id))))
+        :child_removed (swap! data update-in path dissoc key)
+        (.log js/console (clj->js [event key val]))))))
+
+(defn- r-cache-fn [data path]
+  (fn [id] ; id is a str or number
+    (let [child-path (conj path (keyword (str id)))]
+      (when-not (get-in @data child-path)
+        (bind! data child-path
+               (id->fbref id)
+               (r-item-binder (r-cache-fn data path)))))))
+
+(defn r-cache [data path id]
+  ((r-cache-fn data path) id))
+
 (defn item-binder [data path msg]
   (let [[event key val] msg
         child-path (conj path key)]


CMR-812: Updated CMR extension and format support.

--- src/cmr/indexer/data/elasticsearch.clj
+++ src/cmr/indexer/data/elasticsearch.clj
@@ -159,7 +159,7 @@

 (def supported-formats
   "Defines the set of supported concept forms, new forms shold be added once it is supported."
-  #{"application/echo10+xml" "application/dif+xml" "application/iso-smap+xml"})
+  #{"application/echo10+xml" "application/dif+xml" "application/iso:smap+xml"})

 (defn prepare-batch
   "Convert a batch of concepts into elastic docs for bulk indexing."


Add systems to game state and refer by key in scenes

--- src/cljs/chocolatier/engine/ces.cljs
+++ src/cljs/chocolatier/engine/ces.cljs
@@ -20,9 +20,12 @@

 (defn mk-scene
-  "Add or update existing scene in the scenes hashmap"
-  [state uid fns]
-  (assoc-in state [:scenes uid] fns))
+  "Add or update existing scene in the game state.
+
+   system-ids are a collection of keywords referencing a system by
+   their unique ID."
+  [state uid system-ids]
+  (assoc-in state [:scenes uid] system-ids))

 (println "test add-scene" (mk-scene {} :yo [identity]))

@@ -35,10 +38,17 @@

 (println "test iter-fns" (iter-fns {} [#(assoc % :yo :dawg)]))

+(defn get-system-fns
+  "Return system functions with an id that matches system-ids in order."
+  [state system-ids]
+  (map #(% (:systems state)) system-ids))
+
 (defn game-loop
   [state scene-id frame-count]
+  (println (get-system-fns state (-> state :scenes scene-id)))
+  (println state)
   (if (< frame-count 10)
-    (recur (iter-fns state (-> state :scenes scene-id))
+    (recur (iter-fns state (get-system-fns state (-> state :scenes scene-id)))
            scene-id
            (inc frame-count))
     state))
@@ -109,7 +119,7 @@
           {} :yo))

 (defn mk-component
-  "Returns an updated state hashmap with the given component
+  "Returns an updated state hashmap with the given component.
    Wraps each function in fns with mk-component-fn.

    The return value of any component function should be the updated
@@ -142,12 +152,21 @@
 (println "test mk-system-fn"
          ((mk-system-fn (fn [s fns ents] s) :b) {:entities {:a [:b]}}))

+(defn mk-system
+  "Add the system function to the state. Wraps the system function using
+   mk-system-fn. Returns an update hashmap."
+  [state uid f & [component-id]]
+  (let [system-fn (if component-id
+                    (mk-system-fn f component-id)
+                    (mk-system-fn f))]
+    (assoc-in state [:systems uid] system-fn)))
+
 (defn integration-test
   "Test the entire CES implementation with a system that changes component state"
   []
-  (let [sys-fn (fn [state fns entity-ids]
-                 (apply deep-merge (for [f fns, e entity-ids] (f state e))))
-        test-system (mk-system-fn sys-fn :testable)
+  (let [test-system-fn (fn [state fns entity-ids]
+                         (apply deep-merge (for [f fns, e entity-ids]
+                                             (f state e))))
         test-fn (fn [component-state entity-id]
                   (println "testing" entity-id
                            component-state "->"
@@ -155,7 +174,8 @@
                                   (inc (or (:x component-state) 0))))
                   (assoc component-state :x (inc (or (:x component-state) 0))))
         state (-> {}
-                  (mk-scene :test-scene [test-system])
+                  (mk-scene :test-scene [:test-system])
+                  (mk-system :test-system test-system-fn :testable)
                   (mk-entity :player1 [:testable])
                   (mk-entity :player2 [:testable])
                   (mk-component :testable [test-fn]))]


Refactor - add `timetable-row-not-empty?` and `timetable-get-day-row`

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -424,6 +424,11 @@
    Timetable, where 0 = Monday, 1 = Tuesday, until 4 = Friday."
   [day]
   (nth Timetable day))
+
+(defn- timetable-get-day-row
+  "Retrieves a row for a given day in `Timetable`."
+  [day rowNum]
+  (nth (timetable-get-day day) rowNum))

 (defn- get-nr-rows-in-timetable-day
   "Returns the total number of rows in the given 0-indexed day in the Timetable,
@@ -595,6 +600,12 @@
             nil
             ttRow)))

+(defn- timetable-row-not-empty?
+  "Returns true if there no lesson for a given day and row in `Timetable`.
+   Returns false otherwise."
+  [day rowNum]
+  (not (empty? (timetable-get-day-row day rowNum))))
+
 (defn- create-lesson-div
   "Creates a <div> element for a new lesson using jQuery"
   [& {:keys [moduleCode moduleName lessonType lessonGroup venue slotsOcc
@@ -1260,10 +1271,9 @@
         ; implementation
         exclude-lessons-on-empty-rows
         (fn [lessonInfoSeq]
-          (filter #(let [day   (:day %1)
-                         row   (:rowNum %1)
-                         ttRow (get-in Timetable [day row])]
-                     (not (empty? ttRow)))
+          (filter #(let [day    (:day %1)
+                         rowNum (:rowNum %1)]
+                     (timetable-row-not-empty? day rowNum))
                   lessonInfoSeq))

         sort-lesson-info-seq