CMR-2112 Collection search and validation code

--- system-int-test/test/cmr/system_int_test/ingest/ops_collections_translation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/ops_collections_translation_test.clj
@@ -1,19 +1,27 @@
 (ns cmr.system-int-test.ingest.ops-collections-translation-test
   "Translate OPS collections into various supported metadata formats."
-  (:require [clojure.test :refer :all]
-            [clj-http.client :as client]
-            [cmr.common.xml :as cx]
-            [cmr.system-int-test.utils.fast-xml :as fx]
-            [clojure.string :as str]
-            [cmr.common.log :refer [error info]]
-            [cmr.common.mime-types :as mt]
-            [cmr.system-int-test.utils.ingest-util :as ingest]
-            [cmr.system-int-test.utils.search-util :as search]
-            [cmr.system-int-test.utils.url-helper :as url]
-            [cmr.system-int-test.system :as s]
-            [cmr.umm-spec.umm-spec-core :as umm]))
+  (:require
+    [clj-http.client :as client]
+    [clojure.string :as str]
+    [clojure.test :refer :all]
+    [cmr.common.concepts :as concepts]
+    [cmr.common.log :refer [error info]]
+    [cmr.common.mime-types :as mt]
+    [cmr.common.xml :as cx]
+    [cmr.system-int-test.system :as s]
+    [cmr.system-int-test.utils.fast-xml :as fx]
+    [cmr.system-int-test.utils.ingest-util :as ingest]
+    [cmr.system-int-test.utils.search-util :as search]
+    [cmr.system-int-test.utils.url-helper :as url]
+    [cmr.umm-spec.json-schema :as json-schema]
+    [cmr.umm-spec.test.location-keywords-helper :as lkt]
+    [cmr.umm-spec.umm-json :as umm-json]
+    [cmr.umm-spec.umm-spec-core :as umm]
+    [cmr.umm-spec.validation.umm-spec-validation-core :as umm-validation]))

 (use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1"}))
+
+(def context (lkt/setup-context-for-test lkt/sample-keyword-map))

 (def starting-page-num
   "The starting page-num to retrieve collections for the translation test."
@@ -64,7 +72,7 @@
     "C1214604063-SCIOPS" ;;Line 291 - cvc-datatype-valid.1.2.1: '<http://pubs.usgs.gov/of/2014/1040/data/undersea_features.zip>' is not a valid value for 'anyURI'.
     "C1214595389-SCIOPS" ;;Line 108 - cvc-datatype-valid.1.2.1: 'IPY  http://ipy.antarcticanz.govt.nz/projects/southern-victoria-land-geology/' is not a valid value for 'anyURI'.
     "C1214608487-SCIOPS" ;;Line 303 - cvc-datatype-valid.1.2.1: 'Scanned images: http://atlas.gc.ca/site/english/maps/archives' is not a valid value for 'anyURI'.
-    "C1214603723-SCIOPS" ;;Line 132 - cvc-datatype-valid.1.2.1: '<http://sofia.usgs.gov/projects/workplans12/jem.html>' is not a valid value for 'anyURI'.
+    "C1214603723-SCIOPS"}) ;;Line 132 - cvc-datatype-valid.1.2.1: '<http://sofia.usgs.gov/projects/workplans12/jem.html>' is not a valid value for 'anyURI'.

     ;; The following collections failed ingest validation, but not xml schema validation.
     ;; I have changed the validation from ingest validation to xml validation, so we don't
@@ -91,7 +99,7 @@
     ; "C5862870-LARC_ASDC"
     ; "C5784310-LARC_ASDC"

-    })
+

 (def valid-formats
   "Valid metadata formats that is supported by CMR."
@@ -136,6 +144,40 @@
                 (format "Failed xml schema validation when translating %s to %s for collection %s. %s"
                         (name metadata-format) (name output-format) concept-id validation-errs))))))))

+
+(defn- translate-record-to-umm
+  "Translate collection from native format to UMM-C"
+  [record]
+  (let [{:keys [metadata-format metadata concept-id]} record]
+    (umm/parse-metadata context :collection metadata-format metadata {:apply-default? true})))
+
+(defn- get-collection-validation-errors
+  "Perform the following collection validations:
+   * Validate metadata against the XML schema
+   * Validation the UMM collection record against the current UMM JSON schema
+   * Valiadte the UMM collection against UMM collection rules
+  Return a list of validation errors."
+  [record]
+  (remove empty?
+   (concat
+     (umm/validate-xml :collection (:metadata-format record) (:metadata record))
+     (json-schema/validate-umm-json (umm-json/umm->json (:collection record)) :collection)
+     (umm-validation/validate-collection record))))
+
+(defn- translate-and-validation-collection
+  "For a search result record, translate the metadata to UMM, validate the metadata and UMM record
+  and return a validation result record including the concept id, provider id, entry title, and
+  all validation errors for the record."
+  [record]
+  (let [record (assoc record :collection (translate-record-to-umm record))
+        validation-errors (get-collection-validation-errors record)
+        concept-id (:concept-id record)]
+    (when (seq validation-errors)
+      {:concept-id concept-id
+       :provider-id (:provider-id (concepts/parse-concept-id concept-id))
+       :entry-title (get-in record [:collection :EntryTitle])
+       :errors validation-errors})))
+
 (defn get-collections
   "Returns the collections as a list of maps with concept-id, revision-id, metadata-format and metadata."
   [page-size page-num]
@@ -158,17 +200,44 @@
            (cx/elements-at-path parsed [:result])
            metadatas))))

+(defn- get-ops-collections-umm-validation-errors
+  "Loops through the collections in ops with a paged search. For each collection, validate the
+  metadata against the XML schema, validate the collection translated to UMM against the current
+  UMM JSON schema, and validate the UMM collection against the validation rules.
+  Return a list of all validation errors across all collections."
+  []
+  (loop [page-num starting-page-num results []]
+    (let [collections (get-collections search-page-size page-num)
+          error-results (map translate-and-validation-collection collections)
+          all-results (concat results (remove nil? error-results))]
+      (if (and (>= (count collections) search-page-size))
+        (recur (+ page-num 1) all-results)
+        all-results))))
+
+(defn- get-ops-collections-umm-validation-errors-debug
+  []
+  (let [colls (get-collections search-page-size 1)
+        error-results (map translate-and-validation-collection colls)
+        all-results (remove nil? error-results)]
+    (if (and (>= (count colls) search-page-size) (<= 200 (count colls)))
+      all-results
+      all-results)))
+
 ;; Comment out this test so that it will not be run as part of the build.
 #_(deftest ops-collections-translation
-  (testing "Translate OPS collections into various supported metadata formats and make sure they pass validation."
-    (loop [page-num starting-page-num]
-      (let [colls (get-collections search-page-size page-num)]
-        (info "Translating collections on page-num: " page-num)
-        (doseq [coll colls]
-          (verify-translation-via-schema-validation coll))
-        ;; We will turn on ingest validation later when ingest is backed by umm-spec-lib
-        ; (verify-translation-via-ingest-validation coll))
-        (when (>= (count colls) search-page-size)
-          (recur (+ page-num 1)))))
+   (testing "Translate OPS collections into various supported metadata formats and make sure they pass validation."
+     (loop [page-num starting-page-num]
+       (let [colls (get-collections search-page-size page-num)]
+         (info "Translating collections on page-num: " page-num)
+         (doseq [coll colls]
+           (verify-translation-via-schema-validation coll))
+         ;; We will turn on ingest validation later when ingest is backed by umm-spec-lib
+         ; (verify-translation-via-ingest-validation coll))
+         (when (>= (count colls) search-page-size)
+           (recur (+ page-num 1)))))
+     (info "Finished OPS collections translation.")))
+
+(deftest ops-collections-validation
+   (testing "get-collections the current collections in ops against the current UMM schema"
+     (def results (get-ops-collections-umm-validation-errors-debug))
     (info "Finished OPS collections translation.")))
-


More tweaks to output

More tweaks to output

--- test/implementation/emission/plugins/fim_flare.clj
+++ test/implementation/emission/plugins/fim_flare.clj
@@ -4,7 +4,42 @@

 (def f #(subject/generate-reports (core/diff %1 %2)))

-(fact "representation top-level differences in sequentials"
+(fact "representing differences in maps"
+  (future-fact
+    (f '{:a a :b b} '{:a Z :b b})
+    => ["expected `a`, got `Z` at {:a % ...}"])    ; "in [:a] expected: a, was Z"
+
+  (future-fact
+    (f '{:a a :b b :c c} '{:a Z :b b :c Y})
+    => ["Expected `a`, got `Z` at {:a % ...}"      ; "in [:a] expected: a, was Z"
+        "Expected `a`, got `Z` at {:c % ...}"])    ; "in [:c] expected: c, was Y"
+
+  (future-fact "extra actual elements"
+    (f '{:a a :b b} '{:a a :b b :c c})
+    => ["Actual has extra key `:c` at {:c % ...}"] ; "map contained key: :c, but not expected."
+
+    (f '{:a a :b b} '{:a a :b b :c c :d d})
+    => ["Actual has extra keys `:c` and `:d` at {:c % ...}"]) ; use cl-format
+
+  (future-fact "Missing actual elements"
+    (f '{:a a :b b} '{:a a})
+    => ["Actual is missing key `:b` at {...}"]
+
+    (f '{:a a :b b} '{})
+    => ["Actual is missing keys `:a` and `:b` at {...}"]) ; alphabetic if sortable
+
+  (future-fact "maps within maps"
+    (f '{:a {:a a}} '{:a {:a z}})
+    => ["expected `a`, got `Z` at {:a {:a %...}}"]
+
+    (f '{1 {:a a :b b}} '{1 {:a a :b b :c c}})
+    => ["Actual has extra key `:c` at {1 {:c % ...}}"]
+
+    (f '{1 {:a a :b b}} '{1 {:a a}})
+    => ["Actual is missing key `:b` at {1 {...}}"])
+)
+
+(fact "representating differences in sequentials"
   (future-fact "indexes are highlighted with `%`"
     (f '[a] '[Z])
     => [       "Expected `a`, got `Z` at [%0..."])
@@ -28,33 +63,20 @@

   (future-fact "Actual has extra elements; location is last matching element"
     (f '[a b] '[a b c d e])
-    => [  "Actual has three extra elements `(c d e)` at [_ _ %2..."])
+    => [  "Actual has 3 extra elements `(c d e)` at [_ _ %2..."])
         ; "expected length of sequence is 2, actual length is 5.\nactual has 3 elements in excess: (c d e)"

   (future-fact "Actual has too few; location is one past end of actual"
     (f '[a b c d e f g] '[a b c d e])
-    => [   "Actual is missing `f` and one other element at [... %5...]"])
+    => [   "Actual is missing `f` and 1 other element at [... %5...]"])
         ;; "expected length of sequence is 7, actual length is 5.\nactual is missing 2 elements: (f g)"
+
+  (future-fact "sequentials within sequentials"
+    (f '[1 [2 3]   [4 5] [6 7] 8]
+       '[1 [2 3 X] [4  ] [6 Y] Z])
+    => ["Actual has 1 extra element `(X)` at [_ %1[_ %1...]]
 )

-(fact "representing top-level differences in maps"
-  (future-fact
-    (f '{:a a :b b} '{:a Z :b b})
-    => ["At {:a % ...}, expected `a`, actual `Z`"])    ; "in [:a] expected: a, was Z"
-
-  (future-fact
-    (f '{:a a :b b :c c} '{:a Z :b b :c Y})
-    => ["At {:a % ...}, expected `a`, actual `Z`"      ; "in [:a] expected: a, was Z"
-        "At {:c % ...}, expected `a`, actual `Z`"])    ; "in [:c] expected: c, was Y"
-
-  (future-fact "extra actual elements"
-    (f '{:a a :b b} '{:a a :b b :c c})
-    => ["At {...}, actual has extra key `:c`"])      ; "map contained key: :c, but not expected."
-
-  (future-fact "Missing actual elements"
-    (f '{:a a :b b} '{:a a})
-    => ["At {...}, actual is missing key `:b`"])      ; "expected map to contain key: :b, but not found."
-)

 ;; (fact "mixtures"


key summary to cause refresh

key summary to cause refresh

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/summary/tab.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/summary/tab.cljs
@@ -258,6 +258,7 @@

 (defn render [workspace-id on-delete nav-context]
-  (react/create-element Summary {:nav-context nav-context
+  (react/create-element Summary {:key workspace-id
+                                 :nav-context nav-context
                                  :workspace-id workspace-id
                                  :on-delete on-delete}))


Throw sane exception when parent directories can't be created.

--- boot/pod/src/boot/file.clj
+++ boot/pod/src/boot/file.clj
@@ -134,8 +134,11 @@
 (defn copy-with-lastmod
   [src-file dst-file]
   (let [last-mod (.lastModified src-file)
-        cp-src!  (partial io/copy src-file)]
+        cp-src!  (partial io/copy src-file)
+        dst-par  (.getParent dst-file)]
     (io/make-parents dst-file)
+    (when-not (.canWrite (io/file dst-par))
+      (throw (ex-info (format "Can't write to directory (%s)." dst-par) {:dir dst-par})))
     (when (.exists dst-file) (.delete dst-file))
     (if *hard-link*
       (hard-link src-file dst-file)


Flatten split-args implementation

Flatten split-args implementation

--- boot/core/src/boot/cli.clj
+++ boot/core/src/boot/cli.clj
@@ -163,12 +163,11 @@
     (:summary (cli/parse-opts [] cli-args))))

 (defn- split-args [args]
-  (loop [kw {} cli [] [arg & more] args]
-    (if-not arg
-      {:kw kw :cli cli}
-      (if-not (keyword? arg)
-        (recur kw (conj cli arg) more)
-        (recur (assoc kw arg (first more)) cli (rest more))))))
+  (loop [split {} [arg & more] args]
+    (cond
+      (nil? arg) split
+      (not (keyword? arg)) (recur (update-in split [:cli] (fnil conj []) arg) more)
+      :else (recur (update-in split [:kw] assoc arg (first more)) (rest more)))))

 (defmacro ^:private assert
   [test fmt & args]


CMR-3557 Removes unused commented functions and ns requires

--- access-control-app/src/cmr/access_control/services/acl_search_service.clj
+++ access-control-app/src/cmr/access_control/services/acl_search_service.clj
@@ -3,15 +3,11 @@
    validation and user visibility permission checks"
   (:require
     [camel-snake-kebab.core :as csk]
-    [clojure.edn :as edn]
     [clojure.string :as str]
     [cmr.access-control.data.acl-schema :as schema]
-    [cmr.access-control.services.acl-authorization :as acl-auth]
-    [cmr.access-control.services.acl-service :as acl-service]
     [cmr.access-control.services.auth-util :as auth-util]
     [cmr.access-control.services.group-service :as groups]
     [cmr.access-control.services.permitted-concept-id-search :as pcs]
-    [cmr.acl.core :as acl]
     [cmr.common-app.services.search :as cs]
     [cmr.common-app.services.search.group-query-conditions :as gc]
     [cmr.common-app.services.search.parameter-validation :as cpv]
@@ -21,7 +17,6 @@
     [cmr.common.log :refer [info debug]]
     [cmr.common.services.errors :as errors]
     [cmr.common.util :as util]
-    [cmr.transmit.echo.tokens :as tokens]
     [cmr.transmit.metadata-db2 :as mdb2]
     [cmr.umm.collection.product-specific-attribute :as psa]))

@@ -247,24 +242,6 @@
      type-errors))
  params)

-
-
-; ;; TODO Get rid of this function
-; (defn get-searchable-acls
-;   "Returns a lazy sequence of concept-ids for ACLs that are searchable for the given sids."
-;   [context acls-with-concept-id]
-;   (for [acl acls-with-concept-id
-;         :when (acl-auth/action-permitted-on-acl? context :read acl (:concept-id acl))]
-;     (:concept-id acl)))
-;
-; ;; TODO Get rid of this function
-; (defn make-acl-condition
-;   "Returns elastic condition to filter out ACLs that are not visible to the user."
-;   [context acls-with-concept-id]
-;   (let [concept-ids (get-searchable-acls context acls-with-concept-id)]
-;     (when (seq concept-ids)
-;       (common-qm/string-conditions :concept-id concept-ids true))))
-
 (defn search-for-acls
   "Searches for ACLs using given parameters. Returns result map from find-concepts
    including total time taken."


improved naming

improved naming

--- Clojure-Websockets/MainApp/src/cljs/birdwatch/ui/util.cljs
+++ Clojure-Websockets/MainApp/src/cljs/birdwatch/ui/util.cljs
@@ -66,11 +66,11 @@

 (defn entity-count
   "Gets count of specified entity from either tweet, or, when exists, original (retweeted) tweet."
-  [tweet state sym s]
+  [tweet state k s]
   (let [rt-id (if (contains? tweet :retweeted_status)
                 (:id_str (:retweeted_status tweet))
                 (:id_str tweet))
-        count (sym ((keyword rt-id) (:tweets-map state)))]
+        count (k ((keyword rt-id) (:tweets-map state)))]
     (if (not (nil? count)) (str (number-format count) s) "")))

 (defn rt-count


Disable tests for clj 1.5 and 1.6.

Disable tests for clj 1.5 and 1.6.

--- profiles.clj
+++ profiles.clj
@@ -1,5 +1,5 @@
 {:dev
- {:aliases {"test-all" ["with-profile" "dev,1.8:dev,1.6:dev,1.5:dev" "test"]}
+ {:aliases {"test-all" ["with-profile" "dev,1.8:dev" "test"]}
   :codeina {:sources ["src"]
             :reader :clojure
             :target "doc/dist/latest/api"
@@ -7,9 +7,7 @@
             :src-uri-prefix "#L"}
   :plugins [[funcool/codeina "0.3.0"]
             [lein-ancient "0.6.7"]]}
- :1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]}
- :1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]}
- :1.8 {:dependencies [[org.clojure/clojure "1.8.0-RC3"]]}
+ :1.8 {:dependencies [[org.clojure/clojure "1.8.0-RC4"]]}

  :examples
  {:dependencies [[ring "1.4.0"]


Fix process-sequence

Fix process-sequence

--- src/bogo_clojure/core.clj
+++ src/bogo_clojure/core.clj
@@ -28,6 +28,6 @@
   ([sequence]
      (process-sequence sequence TELEX))
   ([sequence typemode]
-     (reduce (fn [word key] (process-key word key typemode))
+     (reduce (fn [word key] (process-key word (str key) typemode))
              ""
              sequence)))


Formatting

Formatting

--- src/braid/server/sync.clj
+++ src/braid/server/sync.clj
@@ -26,8 +26,7 @@
             [braid.server.sync-handler :refer [event-msg-handler]]
             [braid.server.quests.db :as quests]
             [braid.server.quests.sync]
-            [braid.server.socket :refer [chsk-send!
-                                         connected-uids]]))
+            [braid.server.socket :refer [chsk-send! connected-uids]]))

 ;; Handler helpers


simplify go-go-gravity by just letting it die when pausing, and create new when resuming

--- src/client/game/core.cljs
+++ src/client/game/core.cljs
@@ -91,8 +91,7 @@
                  :history []}))

 ; required for pausing/resuming the gravity routine
-(def pause-grav (chan))
-(def resume-grav (chan))
+(def stop-grav (chan))

 (def battle
   "Boolean flag signaling whether we are in solo or battle mode."
@@ -205,6 +204,8 @@
     (doseq [y (reverse (range n-rows))]
       (<! (timeout 10))
       (swap! state assoc-in [:board y] (game-over-row)))))
+
+(declare go-go-gravity!)

 (defn spawn-piece!
   "Spawns the given piece at the starting position."
@@ -218,7 +219,7 @@
     (when @battle
       (socket/emit "update-player" piece))

-    (put! resume-grav 0))
+    (go-go-gravity!))

 (defn try-spawn-piece!
   "Checks if new piece can be written to starting position."
@@ -326,7 +327,7 @@
     (swap! state update-in [:history (-> @state :history count dec)]
                  assoc :height (tower-height new-board)
                        :collapsed (get-filled-row-indices new-board))
-    (put! pause-grav 0)
+    (stop-gravity!)

     ; If collapse routine returns a channel...
     ; then wait for it before spawning a new piece.
@@ -353,34 +354,27 @@
 (defn go-go-gravity!
   "Starts the gravity routine."
   []
-  ; Make sure gravity starts in paused mode.
-  ; Spawning the piece will signal the first "resume".
-  (put! pause-grav 0)
-
-  (go
-    (loop []
-      (let [soft-speed 35
-            level-speed (get-level-speed (:level @state))
-            speed (if (:soft-drop @state)
-                    (min soft-speed level-speed)
-                    level-speed)
-            time-chan (timeout speed)
-            quit-chan (:quit-chan @state)
-            [_ c] (alts! [time-chan pause-grav quit-chan])]
-
-        (condp = c
-
-          pause-grav
-          (let [[_ c] (alts! [resume-grav quit-chan])]
-            (if (= c resume-grav)
-              (recur)))
-
-          time-chan
-          (do
-            (apply-gravity!)
-            (recur))
-
-          nil)))))
+  (go-loop []
+    (let [soft-speed 35
+          level-speed (get-level-speed (:level @state))
+          speed (if (:soft-drop @state)
+                  (min soft-speed level-speed)
+                  level-speed)
+          time- (timeout speed)
+          quit (:quit-chan @state)
+          [_ c] (alts! [time- stop-grav quit])]
+      (when (= c time-)
+        (apply-gravity!)
+        (recur)))))
+
+(defn stop-gravity!
+  []
+  (put! stop-grav 0))
+
+(defn refresh-gravity!
+  []
+  (stop-gravity!)
+  (go-go-gravity!))

 ;;------------------------------------------------------------
@@ -458,7 +452,7 @@
   "Restores the state of the board pre-pausing, and resumes gravity"
   []
   (reset! state @paused-board)
-  (put! resume-grav 0)
+  (go-go-gravity!)
   (reset! paused? false)
   (reset! music-playing? @paused-music))

@@ -469,7 +463,7 @@
   (reset! paused-music @music-playing?)
   (go-go-game-over!)
   (swap! state assoc :piece nil)
-  (put! pause-grav 0)
+  (stop-gravity!)
   (reset! paused? true)
   (reset! music-playing? false))

@@ -546,10 +540,7 @@
         (let [[value c] (alts! [(:quit-chan @state) uc])]
           (when (= c uc)
             (swap! state assoc :soft-drop value)
-
-            ; force gravity to reset
-            (put! pause-grav 0)
-            (put! resume-grav 0)
+            (refresh-gravity!)
             (recur)))))

     ; Remove key events when quitting
@@ -597,7 +588,6 @@
   (try-spawn-piece!)
   (add-key-events)
   (go-go-draw!)
-  (go-go-gravity!)

   (display-points!)
   (try-publish-score!)


simplify analysis

simplify analysis

--- src/clj/ceres/curator.clj
+++ src/clj/ceres/curator.clj
@@ -225,20 +225,12 @@
   (let [impact-forest (compute-impact-forest source)
         analytics (pmap analyze-tree impact-forest)
         sizes (map :size analytics)
-        pub-times (map :pub-times analytics)
         heights (map :height analytics)
-        delays (apply concat (map :delays analytics))
         users (->> analytics (map :users) (apply concat))
-        hashtags (->> analytics (map :hashtags) flatten)
         overall-size (reduce + sizes)]
     {:source source
      :article-count (count impact-forest)
-     :users users
-     :hashtags hashtags
-     :pub-times pub-times
-     :heights heights
-     :sizes sizes
-     :delays delays
+     :analytics analytics
      :total-impact overall-size
      :avg-impact (float (/ overall-size (count sizes)))
      :no-reactions (float (/ (count (filter #(< % 1) heights)) (count heights)))


CLJS-918: preserve :arglists metadata in analysis cache

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -515,7 +515,7 @@
                  m (assoc (zipmap ks (map #(list 'quote (get var %)) ks))
                      :name `(quote ~(symbol (name (:name var))))
                      :test `(when ~sym (.-cljs$lang$test ~sym))
-                     :arglists (:arglists var))]
+                     :arglists (map with-meta (:arglists var) (:arglists-meta var)))]
             (analyze env m))}))

 (defmethod parse 'if
@@ -689,6 +689,7 @@
                :max-fixed-arity (:max-fixed-arity init-expr)
                :method-params params
                :arglists (:arglists sym-meta)
+               :arglists-meta (doall (map meta (:arglists sym-meta)))
                :methods (map (fn [method]
                                (let [tag (infer-tag env (assoc method :op :method))]
                                  (cond-> (select-keys method


emit cljs.core.ObjMap.EMPTY when map is empty

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -349,6 +349,9 @@
   [{:keys [env simple-keys? keys vals]}]
   (emit-wrap env
     (cond
+      (zero? (count keys))
+      (emits "cljs.core.ObjMap.EMPTY")
+
       (and simple-keys? (<= (count keys) obj-map-threshold))
       (emits "cljs.core.ObjMap.fromObject(["
              (comma-sep keys) ; keys


Made path-seq portable

Made path-seq portable

Signed-off-by: Brenton Ashworth <1d17d9de8cdc4334ed2cad585a02d8c1d3605456@gmail.com>

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -1145,7 +1145,10 @@

 (defn path-seq
   [file-str]
-  (string/split file-str (re-pattern java.io.File/separator)))
+  (->> java.io.File/separator
+       java.util.regex.Pattern/quote
+       re-pattern
+       (string/split file-str)))

 (defn to-path
   [parts]


Use deep merge for config.

Use deep merge for config.

--- src/clj/hatnik/config.clj
+++ src/clj/hatnik/config.clj
@@ -1,7 +1,23 @@
 (ns hatnik.config)

+(defn deep-merge-with
+  "Like merge-with, but merges maps recursively, appling the given fn
+  only when there's a non-map at a particular level.
+
+  (deepmerge + {:a {:b {:c 1 :d {:x 1 :y 2}} :e 3} :f 4}
+  {:a {:b {:c 2 :d {:z 9} :z 3} :e 100}})
+  -> {:a {:b {:z 3, :c 3, :d {:z 9, :x 1, :y 2}}, :e 103}, :f 4}"
+  [f & maps]
+  (apply
+   (fn m [& maps]
+     (if (every? map? maps)
+       (apply merge-with m maps)
+       (apply f maps)))
+   maps))
+
 (defn get-config []
-  (merge
+  (deep-merge-with
+   (fn [_ value] value)
    (read-string (slurp "config.default.clj"))
    (try (read-string (slurp "config.clj"))
         (catch Exception e


type hints

type hints

--- src/clj/morpheus/core.clj
+++ src/clj/morpheus/core.clj
@@ -4,7 +4,8 @@
             [morpheus.models.core :as models]
             [neb.server :as nserver]
             [cluster-connector.utils.for-debug :refer [$]])
-  (:gen-class))
+  (:gen-class)
+  (:import (clojure.lang IFn)))

 (set! *warn-on-reflection* true)

@@ -28,5 +29,5 @@
   (start-server)
   (.addShutdownHook
     (Runtime/getRuntime)
-    (Thread. shutdown-server))
+    (Thread. ^IFn shutdown-server))
   (println "Server started"))


Correctly set capturing capturing-armor when loading unit specs

--- src/clj/zetawar/game.cljs
+++ src/clj/zetawar/game.cljs
@@ -960,26 +960,24 @@
   (into []
         (mapcat
          (fn [[unit-type-name unit-def]]
-           (let [{:keys [cost can-capture movement min-range max-range
-                         armor-type armor capturing-armor repair
-                         capturing-armor repair state-map image
-                         terrain-effects attack-strengths]} unit-def
+           (let [{:keys [armor capturing-armor state-map]} unit-def
                  unit-state-map-id (to-unit-state-map-id state-map)
                  unit-type-eid (db/next-temp-id)]
              (-> [{:db/id unit-type-eid
                    :unit-type/id (to-unit-type-id unit-type-name)
                    :unit-type/name (:name unit-def)
-                   :unit-type/cost cost
-                   :unit-type/can-capture can-capture
-                   :unit-type/movement movement
-                   :unit-type/min-range min-range
-                   :unit-type/max-range max-range
-                   :unit-type/armor-type (to-armor-type armor-type)
+                   :unit-type/cost (:cost unit-def)
+                   :unit-type/can-capture (:can-capture unit-def)
+                   :unit-type/movement (:movement unit-def)
+                   :unit-type/min-range (:min-range unit-def)
+                   :unit-type/max-range (:max-range unit-def)
+                   :unit-type/armor-type (-> unit-def :armor-type to-armor-type)
                    :unit-type/armor armor
-                   :unit-type/capturing-armor armor
-                   :unit-type/repair repair
+                   ;; FIXME: this should be getting capturing armor
+                   :unit-type/capturing-armor (or capturing-armor armor)
+                   :unit-type/repair (:repair unit-def)
                    :unit-type/state-map [:unit-state-map/id unit-state-map-id]
-                   :unit-type/image image}]
+                   :unit-type/image (:image unit-def)}]
                  (into (attack-strengths-tx db unit-type-eid attack-strengths))
                  (into (terrain-effects-tx db unit-type-eid terrain-effects))))))
         units-def))


Clean up.

Clean up.

--- src/cljs/medusa/core.cljs
+++ src/cljs/medusa/core.cljs
@@ -29,7 +29,7 @@
                         :subscriptions []
                         :selected-detector nil
                         :selected-metric nil
-                        :selected-filter nil
+                        :metrics-filter nil
                         :selected-date-range [start-date end-date]
                         :error {}})))

@@ -44,7 +44,7 @@
                  :on-click #(put! event-channel [:detector-selected @detector])}
                 (:name detector)])]))))

-(defn metrics-list [{:keys [selected-filter metrics selected-metric]} owner]
+(defn metrics-list [{:keys [metrics-filter metrics selected-metric]} owner]
   (reify
     om/IDidMount
     (did-mount [_]
@@ -79,7 +79,7 @@
                                :id "metrics-selector"}
          [:option ""]
          (for [metric (->> metrics
-                           (filter #(re-find (re-pattern (or selected-filter ".*")) (:name %)))
+                           (filter #(re-find (re-pattern (or metrics-filter ".*")) (:name %)))
                            (sort-by :name))]
            [:option (when (= (:id metric) (:id selected-metric))
                       {:selected true})
@@ -114,7 +114,7 @@
         [:label {:for "end-date"} "To: "]
         (html/text-field {:ref "end-date", :class "form-control"} "end-date" (get selected-date-range 1))]))))

-(defn metrics-filter [{:keys [metrics selected-filter]} owner]
+(defn metrics-regexp-filter [{:keys [metrics metrics-filter]} owner]
   (reify
     om/IRenderState
     (render-state [_ {:keys [event-channel]}]
@@ -129,19 +129,19 @@
                (html/text-field {:ref "metrics-filter"
                                  :class "form-control"
                                  :on-change handler}
-                                "metrics-filter" selected-filter)])))))
-
-(defn query-controls [{:keys [selected-filter metrics selected-metric selected-date-range] :as state} owner]
+                                "metrics-filter" metrics-filter)])))))
+
+(defn query-controls [{:keys [metrics-filter metrics selected-metric selected-date-range] :as state} owner]
   (reify
     om/IRenderState
     (render-state [_ {:keys [event-channel]}]
       (html
        [:form
-        (om/build metrics-filter
-                  (select-keys state [:selected-filter :metrics])
+        (om/build metrics-regexp-filter
+                  (select-keys state [:metrics-filter :metrics])
                   {:init-state {:event-channel event-channel}})
         (om/build metrics-list
-                  (select-keys state [:selected-filter :metrics :selected-metric])
+                  (select-keys state [:metrics-filter :metrics :selected-metric])
                   {:init-state {:event-channel event-channel}})
         (om/build date-selector
                   (select-keys state [:selected-date-range])
@@ -194,17 +194,17 @@
       "graph" (alert-graph {:date date, :description description} owner)
       nil)))

-(defn alerts-list [{:keys [alerts selected-filter]}]
+(defn alerts-list [{:keys [alerts metrics-filter]}]
   (reify
     om/IRender
     (render [_]
       (html [:div.list-group
              (om/build-all alert
-                           (filter #(re-find (re-pattern (or selected-filter ".*"))
+                           (filter #(re-find (re-pattern (or metrics-filter ".*"))
                                              (:metric_name %))
                                    alerts))]))))

-(defn description [{:keys [alerts selected-detector selected-filter selected-metric login subscriptions]} owner]
+(defn description [{:keys [alerts selected-detector metrics-filter selected-metric login subscriptions]} owner]
   (reify
     om/IRenderState
     (render-state [_ {:keys [event-channel]}]
@@ -229,7 +229,7 @@
                                   "subscription-status")
                   " Keep me posted about the current selection"]]])
              (om/build alerts-list {:alerts alerts
-                                    :selected-filter selected-filter})])))))
+                                    :metrics-filter metrics-filter})])))))

 (defn error-notification [{:keys [error]}]
   (reify
@@ -368,16 +368,16 @@
                                                            :to selected-end-date})))))
             route-update (fn [updated-state]
                            (let [state (merge @state updated-state)
-                                 {:keys [selected-detector selected-filter selected-metric selected-date-range]} state
+                                 {:keys [selected-detector metrics-filter selected-metric selected-date-range]} state
                                  [from to] selected-date-range]
                              (if selected-metric
                                (routing/goto :detector-id (:id selected-detector)
-                                             :metrics-filter selected-filter
+                                             :metrics-filter metrics-filter
                                              :metric-id (:id selected-metric)
                                              :from from
                                              :to to)
                                (routing/goto :detector-id (:id selected-detector)
-                                             :metrics-filter selected-filter
+                                             :metrics-filter metrics-filter
                                              :from from
                                              :to to))))
             route-handler (fn [state event-channel]
@@ -429,7 +429,7 @@
                                         (-> state
                                             (assoc :selected-detector detector
                                                    :selected-metric metric
-                                                   :selected-filter filter
+                                                   :metrics-filter filter
                                                    :selected-date-range [from to]
                                                    :alerts nil)
                                             (assoc-in [:error :message] ""))))
@@ -438,7 +438,7 @@
                   (when (not= pre-query (extract-query)) (retrieve-alerts)))

                 :filter-selected
-                (route-update {:selected-filter message})
+                (route-update {:metrics-filter message})

                 :detector-selected
                 (route-update {:selected-detector message
@@ -470,7 +470,7 @@
                          (select-keys state [:detectors :selected-detector])
                          {:init-state {:event-channel event-channel}})
                (om/build query-controls
-                         (select-keys state [:selected-filter
+                         (select-keys state [:metrics-filter
                                              :metrics
                                              :selected-metric
                                              :selected-date-range])
@@ -479,7 +479,7 @@
               [:div.col-md-9
                (om/build description
                          (select-keys state [:selected-detector
-                                             :selected-filter
+                                             :metrics-filter
                                              :selected-metric
                                              :alerts
                                              :login


bugfix

bugfix

--- src/cljx/mesh/images.cljx
+++ src/cljx/mesh/images.cljx
@@ -1,7 +1,7 @@
 (ns mesh.images
   (:refer-clojure :exclude [+ - * /])
   (:require [garden.core :refer [css]]
-            [garden.units :as u :refer [px pt pc]]
+            [garden.units :as u :refer [px pt pc em]]
             [garden.color :as color :refer [hsl rgb rgba]]
             [garden.arithmetic :refer [+ - * /]]
             [garden.stylesheet :refer [at-media]]))


Add more examples

Add more examples

--- src/clojure/cfbt/ch08.clj
+++ src/clojure/cfbt/ch08.clj
@@ -79,3 +79,100 @@
 (list '+ 1 (inc 1)) ;; (+ 1 2)

 ;; Using Syntax Quoting in a Macro (p173)
+
+(defmacro code-critic
+  "Phrases are courtesy Hermes Conrad from Futurama"
+  [bad good]
+  (list 'do
+        (list 'println
+              "Great squid of Madrid, this is bad code:"
+              (list 'quote bad))
+        (list 'println
+              "Sweet gorilla of Manila, this is good code:"
+              (list 'quote good))))
+
+(code-critic (1 + 1) (+ 1 1))
+l;; => "Great squid of Madrid, this is bad code: (1 + 1)
+;;    "Sweet gorilla of Manila, this is good code: (+ 1 1)
+
+;; Use of syntax quoting
+(defmacro code-critic
+  [bad good]
+  `(do (println "Great squid of Madrid, this is bad code:"
+                (quote ~bad))
+       (println "Sweet gorilla of Manila, this is good code:"
+                (quote ~good))))
+
+(code-critic (1 + 1) (+ 1 1))
+
+;; Refactoring a Macro and Unquote Splicing
+(defn criticize-code
+  [criticism code]
+  `(println ~criticism (quote ~code)))
+
+(defmacro code-critic
+  [bad good]
+  `(do ~(criticize-code "Curses bacteria of Liberta, this is bad code:" bad)
+       ~(criticize-code "Sweet secred boa of Western and Easten Samoa, this is good code: " good)))
+
+(code-critic (1 * 2) (* 1 2))
+
+;; remove some duplication
+;; (defmacro code-critic
+;;   [bad good]
+;;   `(do ~(map #(apply criticize-code %)
+;;              [["This is bad code: " bad]
+;;               ["This is great code: " good]])))
+`(+ ~(list 1 2 3))
+;; (clojure.core/+ (1 2 3))
+
+`(+ ~@(list 1 2 3))
+;; (clojure.core/+ 1 2 3)
+
+(defmacro code-critic
+  [good bad]
+  `(do ~@(map #(apply criticize-code %)
+              [["Sweet lion of Zion, this is bad code:" bad]
+               ["Great cow of Moscow, this is good code:" good]])))
+
+(code-critic (3 * 4) (* 4 3))
+;; Sweet lion of Zion, this is bad code: (* 4 3)
+;; Great cow of Moscow, this is good code: (3 * 4)
+
+;; Things to Watch Out For
+(def message "Good job!")
+
+ (defmacro with-mischief
+  [& stuff-to-do]
+  (concat (list 'let ['message "Oh, big deal!"])
+          stuff-to-do))
+
+(with-mischief
+  (str "Here's how I feel about that thing you did " message))
+;; => "Here's how I feel about that thing you did Oh, big deal!"
+
+(defmacro with-mischief
+  [& stuff-to-do]
+  `(let [message "Oh, big deal!"]
+     ~@stuff-to-do))
+
+;; (with-mischief
+;;   (str "Here's how I feel about that thing you did: " message))
+;; RuntimeException: => Can't let qualified name: cfbt.ch08/message
+
+;;(gensym)
+(gensym 'message) ;; message25849
+(gensym 'message) ;; message25852
+
+;; Here is how to fix it
+(defmacro without-mischief
+  [& stuff-to-do]
+  (let [macro-message (gensym 'message)]
+    `(let [~macro-message "Oh, big deal!"]
+       ~@stuff-to-do
+       (println "I still need to say: " ~macro-message))))
+
+(without-mischief
+ (println "Here's how I feel about that thing you did: " message))
+
+;; Double Evaluation (p178): TBC


Clarify API doc.

Clarify API doc.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -425,9 +425,10 @@
     (params/build-param-formula Number #(/ %1 %2) beats-param cycles-param)))

 (defn make-sawtooth-cue
-  "Create a cue which applies a sawtooth oscillator to the specified
-  group of fixtures, with cue parameters to adjust the beat ratio,
-  starting with default values established by show parameters."
+  "Create a cue which applies a sawtooth oscillator to the dimmers of
+  the specified group of fixtures, with cue parameters to adjust the
+  beat ratio, starting with default values established by show
+  parameters."
   [group x y color]
   (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "saw")]
     (ct/set-cue! (:cue-grid *show*) x y
@@ -448,9 +449,10 @@
                            :end-keys end-keys))))

 (defn make-triangle-cue
-  "Create a cue which applies a triangle oscillator to the specified
-  set of fixtures, with cue parameters to adjust the beat ratio,
-  starting with default values established by show parameters."
+  "Create a cue which applies a triangle oscillator to the dimmers of
+  the specified set of fixtures, with cue parameters to adjust the
+  beat ratio, starting with default values established by show
+  parameters."
   [group x y color]
   (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "triangle")]
     (ct/set-cue! (:cue-grid *show*) x y
@@ -469,9 +471,9 @@
                          :end-keys end-keys))))

 (defn make-sine-cue
-  "Create a cue which applies a sine oscillator to the specified
-  set of fixtures, with cue parameters to adjust the beat ratio,
-  starting with default values established by show parameters."
+  "Create a cue which applies a sine oscillator to the dimmers of the
+  specified set of fixtures, with cue parameters to adjust the beat
+  ratio, starting with default values established by show parameters."
   [group x y color]
   (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "sine")]
     (ct/set-cue! (:cue-grid *show*) x y
@@ -491,9 +493,10 @@
                          :end-keys end-keys))))

 (defn make-square-cue
-  "Create a cue which applies a square oscillator to the specified set
-  of fixtures, with cue parameters to adjust the beat ratio and pulse
-  width, starting with default values established by show parameters."
+  "Create a cue which applies a square oscillator to the dimmers of
+  the specified set of fixtures, with cue parameters to adjust the
+  beat ratio and pulse width, starting with default values established
+  by show parameters."
   [group x y color]
   (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "square")]
     (ct/set-cue! (:cue-grid *show*) x y


Add blackout-universe example.

Add blackout-universe example.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -47,3 +47,9 @@
                     (catch Exception e
                       (error e "Problem trying to ramp channels")))
                  scheduler)))
+
+(defn blackout-universe
+  "Sends zero to every channel of the specified universe"
+  [universe]
+  (let [levels (byte-array 512)]
+    (ola/UpdateDmxData {:universe universe :data (ByteString/copyFrom levels)} nil)))


CMR-2748: Fixing missed commit that caused internal error.

--- indexer-app/src/cmr/indexer/data/collection_granule_aggregation_cache.clj
+++ indexer-app/src/cmr/indexer/data/collection_granule_aggregation_cache.clj
@@ -65,7 +65,7 @@
    concept id to a map of information about that collection."
   [aggregate-response]
   (let [coll-concept-id-result (get-in aggregate-response [:aggregations :collection-concept-id])]
-    (when (> (:sum_other_doc_count coll-concept-id-result)) 0
+    (when (> (:sum_other_doc_count coll-concept-id-result) 0)
       (errors/internal-error!
        (str "Found more collections that expected when fetching collection concept ids: "
             (:sum_other_doc_count coll-concept-id-result))))


[#1077] Fix issue where it was not possible for a popup column to be same as the point color column

--- backend/src/akvo/lumen/lib/visualisation/map_config.clj
+++ backend/src/akvo/lumen/lib/visualisation/map_config.clj
@@ -5,21 +5,20 @@
   (let [point-size (if (string? point-size)
                      (Long/parseLong point-size)
                      point-size)]
-    (get {1 3
-          2 4
-          3 7
-          4 10
-          5 13} point-size 8)))
+    ({1 3
+      2 4
+      3 7
+      4 10
+      5 13} point-size 8)))

 (defn point-color-css [point-color-column point-color-mapping]
-  ;; #s [ c2 = 'Vaasa' ] { marked-fill: }
   (when point-color-column
     (for [{:strs [value color]} point-color-mapping]
       (format "[ %s = %s ] { marker-fill: %s }"
               point-color-column
               (if (number? value)
                 value
-                (str "'" value "'"))
+                (format "'%s'" value))
               (pr-str color)))))

 (defn cartocss [point-size point-color-column point-color-mapping]
@@ -29,7 +28,8 @@
               marker-fill: #6ca429;
               marker-line-color: #ddd;
               marker-width: %s;
-            %s }"
+              %s
+           }"
           (marker-width point-size)
           (str/join " " (point-color-css point-color-column point-color-mapping))))

@@ -40,15 +40,15 @@
       (str/replace #" +" " ")))

 (defn sql [table-name geom-column popup-columns point-color-column where-clause]
-  (format "select %s from %s where %s"
-          (str/join ", " (if point-color-column
-                           (into popup-columns [geom-column point-color-column])
-                           (conj popup-columns geom-column)) )
-          table-name
-          where-clause))
+  (let [columns (distinct
+                 (cond-> (conj popup-columns geom-column)
+                   point-color-column (conj point-color-column)))]
+    (format "select %s from %s where %s"
+            (str/join ", " columns)
+            table-name
+            where-clause)))

 (defn build [table-name visualisation-spec where-clause metadata]
-  (clojure.pprint/pprint visualisation-spec)
   (let [layer-spec (first (get-in visualisation-spec ["spec" "layers"]))
         geom-column (get layer-spec "geom")
         popup-columns (mapv #(get % "column")


Optimize TaskRequestAdapter. (#1859)

Optimize TaskRequestAdapter. (#1859)

* Optimize TaskRequestAdapter.

* Update scheduler/src/cook/scheduler/scheduler.clj

Co-authored-by: Nikolai Sinkov <096e2ca855e0d5a71823216f5078b4ae8955c1a2@gmail.com>

Co-authored-by: Scott Crosby <23e8f75489aff47cf2cd5a529e9a769a24e9501c@twosigma.com>
Co-authored-by: Nikolai Sinkov <096e2ca855e0d5a71823216f5078b4ae8955c1a2@gmail.com>

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -481,9 +481,11 @@
                         (offer-resource-ranges offer "ports"))))

-(defrecord TaskRequestAdapter [job resources task-id assigned-resources guuid->considerable-cotask-ids constraints scalar-requests]
+
+; job and resources appear to be unused, but they are used. Other code paths destructure job and resource out.
+(defrecord TaskRequestAdapter [job resources cpus mem ports uuid task-id assigned-resources guuid->considerable-cotask-ids constraints scalar-requests]
   TaskRequest
-  (getCPUs [_] (:cpus resources))
+  (getCPUs [_] cpus)
   ; We support disk but support different types of disk, so we set this metric to 0.0 and take care of binpacking disk in the disk-host-constraint
   (getDisk [_] 0.0)
   (getHardConstraints [_] constraints)
@@ -492,11 +494,11 @@
   (getAssignedResources [_] @assigned-resources)
   (setAssignedResources [_ v] (reset! assigned-resources v))
   (getCustomNamedResources [_] {})
-  (getMemory [_] (:mem resources))
+  (getMemory [_] mem)
   (getNetworkMbps [_] 0.0)
-  (getPorts [_] (:ports resources))
+  (getPorts [_] ports)
   (getSoftConstraints [_] [])
-  (taskGroupName [_] (str (:job/uuid job))))
+  (taskGroupName [_] uuid))

 (def adjust-job-resources-for-pool-fn
   (memoize
@@ -529,7 +531,12 @@
         constraints-list (into (list) constraints)
         scalar-requests (job->scalar-request job)
         pool-specific-resources ((adjust-job-resources-for-pool-fn pool-name) job resources)]
-    (->TaskRequestAdapter job pool-specific-resources task-id assigned-resources guuid->considerable-cotask-ids constraints-list scalar-requests)))
+    (->TaskRequestAdapter job resources
+                          (:cpus pool-specific-resources)
+                          (:mem pool-specific-resources)
+                          (:ports pool-specific-resources)
+                          (-> job :job/uuid str)
+                           task-id assigned-resources guuid->considerable-cotask-ids constraints-list scalar-requests)))

 (defn jobs->resource-maps
   "Given a collection of jobs, returns a collection


Shortens the 'launching matched tasks' log (#1721)

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -899,13 +899,9 @@
               user->num-jobs (->> matches
                                   (mapcat :task-metadata-seq)
                                   (map (comp tools/job-ent->user :job :task-request))
-                                  frequencies)
-              hostnames-matched (->> offers-matched
-                                     (map :hostname)
-                                     distinct)]
+                                  frequencies)]
           (log/info "In" pool-name "pool, launching matched tasks"
-                    {:hostnames-matched hostnames-matched
-                     :number-offers-matched num-offers-matched
+                    {:number-offers-matched num-offers-matched
                      :number-tasks (count task-txns)
                      :user->number-jobs user->num-jobs})
           (meters/mark! scheduler-offer-matched num-offers-matched)


Made temp-file-store compatible with old multipart-params middleware

--- ring-core/src/ring/middleware/multipart_params/temp_file.clj
+++ ring-core/src/ring/middleware/multipart_params/temp_file.clj
@@ -9,4 +9,5 @@
     (with-open [out (io/output-stream temp-file)]
       (io/copy (:stream item) out))
     (-> (select-keys item [:filename :content-type])
-        (assoc :temp-file temp-file))))
+        (assoc :tempfile temp-file
+               :size (.length temp-file)))))


Changed :refer :all to :refer [only-the-needed-stuff]

--- src/main/clojure/conexp/fca/applications/socialanalytics.clj
+++ src/main/clojure/conexp/fca/applications/socialanalytics.clj
@@ -8,7 +8,12 @@

 (ns conexp.fca.applications.socialanalytics
   "Provides some functionallity for Socialanalytics."
-  (:require [conexp.fca.contexts :refer :all]
+  (:require [conexp.fca.contexts :refer [objects
+                                         attributes
+                                         object-derivation
+                                         attribute-derivation
+                                         context?
+                                         incident?]]
             [clojure.set :refer [intersection
                                  union]]))


Add some privates

Add some privates

--- src/angelic/search/implicit/dash_astar.clj
+++ src/angelic/search/implicit/dash_astar.clj
@@ -126,17 +126,17 @@

 (defrecord PubSubHub [^ArrayList subscribers ^ArrayList publications])

-(defn make-pubsubhub
+(defn- make-pubsubhub
   "A hub for publications streams; every subscriber fn is called on every publication."
   [] (PubSubHub. (ArrayList.) (ArrayList.)))

-(defn publications [psh] (doall (seq (:publications psh))))
-
-(defn publish!     [psh pub]
+(defn- publications [psh] (doall (seq (:publications psh))))
+
+(defn- publish!     [psh pub]
   (.add ^ArrayList (:publications psh) pub)
   (doseq [sub (doall (seq (:subscribers psh)))] (sub pub)))

-(defn subscribe!   [psh sub]
+(defn- subscribe!   [psh sub]
   (.add ^ArrayList (:subscribers psh) sub)
   (doseq [pub (doall (seq (:publications psh)))] (sub pub)))

@@ -152,17 +152,17 @@
 (def *decreases* (ArrayList.))
 (def *subsumes* (ArrayList.))

-(defn schedule-increase! [sp] (.add ^ArrayList *increases* sp))
-(defn schedule-decrease! [sp] (.add ^ArrayList *decreases* sp))
-(defn schedule-subsumption! [ts subsumed-ts] (.add ^ArrayList *subsumes* [ts subsumed-ts]))
-
-(defn do-changes! [^ArrayList a f] (doseq [sp a] (f sp)) (.clear a))
+(defn- schedule-increase! [sp] (.add ^ArrayList *increases* sp))
+(defn- schedule-decrease! [sp] (.add ^ArrayList *decreases* sp))
+(defn- schedule-subsumption! [ts subsumed-ts] (.add ^ArrayList *subsumes* [ts subsumed-ts]))
+
+(defn- do-changes! [^ArrayList a f] (doseq [sp a] (f sp)) (.clear a))

 (defprotocol Evaluable
   (evaluate! [s])
   (sp-name             [s] "A name to identify this subproblem type (indep. of input)"))

-(defn evaluate-and-update! [s]
+(defn- evaluate-and-update! [s]
   (evaluate! s)
   (do-changes! *increases* sg/summary-increased!)
   (do-changes! *subsumes* (fn [[ts subsumed-ts]] (sg/connect-subsumed! ts subsumed-ts)))


Implemented entity deletion support.

Implemented entity deletion support.

--- src/appengine_magic/services/datastore.clj
+++ src/appengine_magic/services/datastore.clj
@@ -171,6 +171,14 @@
         ;; constructor would be in a different namespace.
         entity-record (eval `(new ~entity-record-type ~@(repeat (count raw-properties) nil)))]
     (with-meta (merge entity-record properties) {:key (.getKey entity)})))
+
+
+(defn delete! [target]
+  (let [target (if (sequential? target) target [target])
+        key (if (every? #(instance? Key %) target)
+                target
+                (map get-key-object target))]
+    (.delete (get-datastore-service) key)))

 (defmacro defentity [name properties &


better count of go terms for showing/hiding the ontology graph. previously we based our decisions on how many go terms there were overall but it really needed to be filtered by ontology branch. It is now. Cool.

--- src/cljs/gointermod/ontology/handlers.cljs
+++ src/cljs/gointermod/ontology/handlers.cljs
@@ -68,13 +68,21 @@
     ) [] these-results)
     ))

-(defn get-all-go-terms
+(defn get-all-go-terms-by-organism
   "gets go terms for all organisms that have results."
   [db]
   (assoc db :go-terms
     (reduce (fn [new-map [id organism]]
       (assoc new-map id (get-go-terms id db))
 ) {} (:multi-mine-results db))))
+
+(defn get-count-of-go-terms-by-filter
+  "Returns the count of terms represented by the active ontology."
+  [db]
+  (let [filter-ontology (:active-filter db)
+        results (apply concat (vals (:multi-mine-results db)))]
+  (count (filter (fn [result] (= (:ontology-branch result) filter-ontology)) results))))
+

 (defn loading-state
   "sets all organisms go results to loading."
@@ -107,20 +115,21 @@

 (defn handle-large-result
   "This is the counterpart of query-for-go-tree, for when there are simply too many results for it to be sane to return results"
-  [db count-of-terms]
+  [db]
   (->
-      (assoc-in db [:go-ontology :nodes] (str count-of-terms " or more "))
+      (assoc-in db [:go-ontology :nodes]
+        (str (count-go-terms (:go-terms db)) " or more "))
       (assoc-in [:go-ontology :loading] false)))

 (re-frame/register-handler
  :load-go-graph
  ;;decides if there're too many terms to search for or not, and either searches or tells the users sorry, too big.
  (fn [db [_ _]]
-    (let [go-termed-db (get-all-go-terms db)
-          count-of-terms (count-go-terms (:go-terms go-termed-db))]
-      (if (< count-of-terms 40)
+    (let [go-terms-by-filter (get-count-of-go-terms-by-filter db)
+          go-termed-db (get-all-go-terms-by-organism db)]
+      (if (< go-terms-by-filter 40)
         (query-for-go-tree go-termed-db)
-        (handle-large-result go-termed-db count-of-terms)
+        (handle-large-result go-termed-db)
       )
 )))


Refactor session related protocol names.

--- src/clojure/catacumba/handlers/session.clj
+++ src/clojure/catacumba/handlers/session.clj
@@ -54,14 +54,15 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defprotocol ISession
-  (^:private empty? [_] "Check if the session is empty.")
-  (^:private accessed? [_] "Check if session is accessed")
-  (^:private modified? [_] "Check if session is modified"))
+  (-get-id [_] "Get the session id.")
+  (-empty? [_] "Check if the session is empty.")
+  (-accessed? [_] "Check if session is accessed")
+  (-modified? [_] "Check if session is modified"))

 (defprotocol ISessionStorage
-  (^:private read-session [_ key] "")
-  (^:private write-session [_ key data] "")
-  (^:private delete-session [_ key] ""))
+  (-read [_ key] "")
+  (-write [_ key data] "")
+  (-delete [_ key] ""))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Types
@@ -104,9 +105,10 @@
     (.deref data))

   ISession
-  (empty? [_] (= (count @data) 0))
-  (accessed? [_] @accessed)
-  (modified? [_] @modified))
+  (-get-id [_] sessionid)
+  (-empty? [_] (= (count @data) 0))
+  (-accessed? [_] @accessed)
+  (-modified? [_] @modified))

 (alter-meta! #'->Session assoc :private true)


Call it updating password, not resetting it. Reset is coming next.

--- src/foreclojure/login.clj
+++ src/foreclojure/login.clj
@@ -29,13 +29,13 @@
           (response/redirect "/problems"))
       (flash-error "Error logging in." "/login"))))

-(def-page reset-password-page []
+(def-page update-password-page []
   (with-user [{:keys [user]}]
-    [:div#reset-pwd
-     [:h2 "Reset password for " user]
+    [:div#update-pwd
+     [:h2 "Change password for " user]
      [:span.error (session/flash-get :error)]
      [:table
-      (form-to [:post "/login/reset"]
+      (form-to [:post "/login/update"]
         (map form-row
              [[password-field :old-pwd "Current password"]
               [password-field :pwd "New password"]
@@ -43,7 +43,7 @@
         [:tr
          [:td (submit-button "Reset now")]])]]))

-(defn do-reset-password! [old-pwd new-pwd repeat-pwd]
+(defn do-udpate-password! [old-pwd new-pwd repeat-pwd]
   (with-user [{:keys [user pwd]}]
     (let [encryptor (StrongPasswordEncryptor.)]
       (assuming [(= new-pwd repeat-pwd)
@@ -56,15 +56,15 @@
                    :upsert false)
           (html-doc
            [:div#reset-succeeded "Password for " user " reset successfully"]))
-        (flash-error why "/login/reset")))))
+        (flash-error why "/login/update")))))

 (defroutes login-routes
   (GET  "/login" [] (my-login-page))
   (POST "/login" {{:strs [user pwd]} :form-params}
     (do-login user pwd))
-  (GET  "/login/reset" [] (reset-password-page))
-  (POST "/login/reset" {{:strs [old-pwd pwd repeat-pwd]} :form-params}
-    (do-reset-password! old-pwd pwd repeat-pwd))
+  (GET  "/login/update" [] (change-password-page))
+  (POST "/login/update" {{:strs [old-pwd pwd repeat-pwd]} :form-params}
+    (do-change-password! old-pwd pwd repeat-pwd))
   (GET "/logout" []
     (do (session/session-delete-key! :user)
         (response/redirect "/"))))


fix missing 'cache' var (was renamed to dev-cache)

--- src/chat/server/invite.clj
+++ src/chat/server/invite.clj
@@ -29,17 +29,17 @@
 (defn cache-set! [k v]
   (if prod?
     (car/wcar redis-conn (car/set k v))
-    (swap! cache assoc k v)))
+    (swap! dev-cache assoc k v)))

 (defn cache-get [k]
   (if prod?
     (car/wcar redis-conn (car/get k))
-    (@cache k)))
+    (@dev-cache k)))

 (defn cache-del! [k]
   (if prod?
     (car/wcar redis-conn (car/del k))
-    (swap! cache dissoc k)))
+    (swap! dev-cache dissoc k)))

 (defn random-nonce
   "url-safe random nonce"


updating state of position, checkmating, fixing tests

--- src/chess_clojure/core.clj
+++ src/chess_clojure/core.clj
@@ -49,7 +49,7 @@

 (defn my-is-a?[my-type obj]
   (and (map? obj)
-  (= my-type (:type obj))))
+       (= my-type (:type obj))))

 (defn piece-at-location[position location]
   (get (:piece-locations position) location))
@@ -89,7 +89,7 @@
   )

 (defn unoccupied?[position location]
-   (not (occupied? position location)))
+  (not (occupied? position location)))

 (defn num->alpha[x]
   (assert number? x)
@@ -138,8 +138,8 @@

 (def piece-color
   {"r" :black "n" :black "b" :black "q" :black "k" :black
-                  "R" :white "N" :white "B" :white "Q" :white "K" :white
-                  "P" :white})
+   "R" :white "N" :white "B" :white "Q" :white "K" :white
+   "P" :white})

 (defn friendly-square? [position location]
   (and (occupied? position location)
@@ -322,12 +322,12 @@

 (defn non-ranging-moves[position location rules]
   "returns moves, including captures. For king and knight"
-    (map (fn[loc2] [location loc2])
-         (remove (fn[loc2] (friendly-square? position loc2))
-                 (filter on-board?
-                         (map (fn[rule] (apply rule location))
-                              rules))
-                 )))
+  (map (fn[loc2] [location loc2])
+       (remove (fn[loc2] (friendly-square? position loc2))
+               (filter on-board?
+                       (map (fn[rule] (apply rule location))
+                            rules))
+               )))

 (def is-ranging? #{"q" "Q" "b" "B" "r" "R"})
@@ -343,6 +343,7 @@
   (when debug
     (println "entering ranging-moves-in-direction, direction-fn is" direction-fn))
   (let [[x y] location
+        debug false
         ]
     (when debug
       (println x y)
@@ -353,7 +354,7 @@
            accum []
            ]
       (let [loc-to-test (first locs-to-test)]
-        (when false
+        (when debug
           (println "processing " loc-to-test))
         (cond
           (off-board? loc-to-test)
@@ -393,7 +394,7 @@
   (let [
         op (if (= :white (:player-to-move position)) inc dec)
         ]
-  "return valid capture locations for the pawn at given location"
+    "return valid capture locations for the pawn at given location"
     (keep
       (fn[dec-or-inc]
         (if (unoccupied? position [(dec-or-inc x) (op y)])
@@ -418,6 +419,7 @@

 (defn pawn-non-capturing-moves[position [x y :as location] ]
   (assert (is-pawn? (piece-at-location position location)))
+  (when debug (println position location))
   (let [piece (piece-at-location position location)
         op (if (white-piece? piece)
              +
@@ -454,9 +456,13 @@
 ;; (:piece-locations (string->position "  n\n   \n   " ))

 (def opposite-color {:black :white :white :black})
+
 (defn flip-position[position]
-   (update-in position [:player-to-move] opposite-color)
-  )
+  (assoc position :flipped true
+                     :locations-under-attack []
+                              :player-to-move (opposite-color (:player-to-move position))))
+ ;; (flip-position starting-position)
+;; (println starting-position)

 (defn locations-under-attack-moves[position]
   {
@@ -485,7 +491,7 @@
     ))

 ;; (locations-under-attack starting-position)
-   ;;      (locations-under-attack (string->position "Bk" :black))
+;;      (locations-under-attack (string->position "Bk" :black))
 ;;
 (defn locations-under-attack[position]
   {
@@ -493,9 +499,10 @@
    :pre [(my-is-a? :position position)] }

   (let [enemy-position (flip-position position)]
-    (set (filter (partial unoccupied? enemy-position)
-            (map second (locations-under-attack-moves enemy-position))))
-  ))
+   (when debug (println "enemy-position" enemy-position))
+    (set (map second (moves enemy-position)))))
+        ;; (filter (partial unoccupied? enemy-position)
+                ;; (map second (locations-under-attack-moves enemy-position))))

@@ -508,23 +515,62 @@
                 "K"
                 "k")]
     (some #(if (= piece (second %))
-                (first %))
+             (first %))
           (:piece-locations position))
     ))
-;; (update-position starting-position)
+;; (:king-moves (string->position-and-print "K" :white)
+;;         (king-moves (string->position-and-print "K" :white))
+;;
+(defn king-moves[position]
+  (when debug
+  (println "king-moves")
+  (println position))
+
+  (remove (fn[move]
+           (when debug (println "move in fn is" move)
+            (println "second move" (second move))
+            (println (:locations-under-attack position)))
+            (contains? (:locations-under-attack position)
+                               (second move)))
+          (non-ranging-moves position (king-location position)
+                             king-rules)
+          ))
+
+(defn update-checkmated[position]
+  (assoc position :checkmated
+           (and (:in-check position)
+                (= 0 (count (:king-moves position))))))
+
+(defn update-in-check[position]
+  (assoc position :in-check
+           (contains? (:locations-under-attack position)
+                      (king-location position))
+  ))
+
+
+(defn update-under-attack[position]
+    (assoc position :locations-under-attack
+           (locations-under-attack position)))
+
+(defn update-king-moves[position]
+        (assoc position :king-moves (king-moves position)))
+(defn update-moves[position]
+   (assoc position :moves (moves position))
+  )
+(defn update-algebraic-moves[position]
+   (assoc position :algebraic-moves
+       (map (partial move->algebraic-notation position)
+          (:moves position))))
+(pprint starting-position)
 (defn update-position[position]
-  (let [under-attack
-           (locations-under-attack position)
-        ]
-   (assoc position
-          :locations-under-attack
-           under-attack
-          :in-check
-          (contains? under-attack (king-location position))
-
-  )))
-
-;; (string->position "r" :white)
+  (-> position update-under-attack
+      update-king-moves
+      update-in-check
+      update-checkmated
+      update-moves
+      update-algebraic-moves))
+
+;; (string->position "rK" :white)
 (defn string->position[string color]
   {:post  [(is-position? %)]
    :pre [(string? string)
@@ -532,23 +578,23 @@
   (let [lines (vec (reverse (clojure.string/split-lines string)))
         ]
     (update-position
-    { :type :position
-     :player-to-move color
-     :piece-locations
-     (into (sorted-map)
-           (remove
-             (fn [x]
-               (or (nil? (second x))
-                   (= "" (second x))
-                   (= " " (second x ))))
-             (for [x (range 8) y (range 8)
-                   :let [ location [x y]
-                         piece (str (get (get lines y) x))
-                         ]
-                   ]
-               [location piece]  ;; map entry
-               )))
-     })))
+      { :type :position
+       :player-to-move color
+       :piece-locations
+       (into (sorted-map)
+             (remove
+               (fn [x]
+                 (or (nil? (second x))
+                     (= "" (second x))
+                     (= " " (second x ))))
+               (for [x (range 8) y (range 8)
+                     :let [ location [x y]
+                           piece (str (get (get lines y) x))
+                           ]
+                     ]
+                 [location piece]  ;; map entry
+                 )))
+       })))

 (def starting-position
   "Horizontal rows are ranks. Vertical rows are files"
@@ -572,12 +618,10 @@
               (ranging-moves position loc (:rules piece-info))
               (is-pawn? piece)
               (pawn-moves position loc)
-             (is-knight? piece)
+              (is-knight? piece)
               (non-ranging-moves position loc (:rules piece-info))
-             (is-king? piece)
-              (remove (fn[move] (contains? (:locations-under-attack position)
-                                           (second move)))
-              (non-ranging-moves position loc (:rules piece-info)))
+              (is-king? piece)
+              (:king-moves position)
               true
               (assert false)
               )))
@@ -599,20 +643,22 @@
 ;;;;;;;;;;;;;; TESTS ;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn string->position-and-print[x y]
-   (let [position (string->position x y)]
-     (println (position->string position))
-     position))
+  (let [position (string->position x y)]
+    (println (position->string position))
+    position))
+
 ;; (test-king-cannot-move-to-a-location-under-attack)
 ;; (locations-under-attack (string->position-and-print "bbn\n\nK" :white))
 (defn test-king-cannot-move-to-a-location-under-attack[]
-      (is (= []
-         (moves (string->position-and-print "bbn\n\nK" :white)))))
+  (is (= []
+         (moves (string->position "bbn\n\nK" :white)))))

 (defn test-king-moves[]
   (is (= '([[0 0] [1 1]] [[0 0] [1 0]] [[0 0] [0 1]])
          (moves (string->position "k" :black)))
       )
-  (is (= '([[0 0] [1 1]] [[0 0] [0 1]])
+  (is (=
+         '([[0 0] [1 1]] [[0 0] [1 0]] [[0 0] [0 1]])
          (moves (string->position "kN" :black))))
   )
 (defn test-non-ranging-moves[]
@@ -637,36 +683,59 @@
          (count (moves (string->position "  n\n   \n   " :black)))

          )))
-(test-knight-moves)
+
 (defn test-moves[]
-  (println "test-moves")
-  (moves (string->position "R" :white) )
-  )
-;; (test-moves)
+  (is (= 37
+  (count (moves (string->position "      P\nRNBQK" :white) )))
+  ))
+
 (defn test-position->string[]
   (is (=
         starting-position-string
         (position->string
           (string->position starting-position-string :white)))))
+
+
 (defn test-pawn-moves[]
-  (let [ position starting-position]
-    (pprint (map (partial move->algebraic-notation starting-position)
-                 (pawn-moves starting-position [0 1])))
-    ))
+(is (= '("Pa2a3")
+       (map (partial move->algebraic-notation starting-position)
+                 (pawn-moves starting-position [0 1])))))
+
+(defn test-not-in-check[]
+  (is (not (:in-check starting-position)))
+  )
+(defn test-in-check[]
+  (is (:in-check
+  (string->position "rK" :white) )
+  ))
+(defn test-checkmated[]
+  (is (:checkmated
+  (string->position "PPPP\nK  r" :white) )
+  ))
+;; (moves (string->position "rK" :black) )
+;;
+;; (king-location (string->position "rK" :white))
 (defn test-starting-moves[]
   (let [position starting-position]
     (map #(move->algebraic-notation position %)
          (moves starting-position))))
 (defn run-tests[]
+  (test-moves)
+  (test-not-in-check)
+  (test-checkmated)
+  (test-in-check)
   (test-king-moves)
   (test-king-cannot-move-to-a-location-under-attack)
   (test-pawn-moves)
-  (test-position->string)
-  (test-starting-moves)
+  ;;(test-position->string)
+  ;;(test-starting-moves)
   )
 ;;(run-tests)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;(test-king-moves)
-(test-starting-moves)
-  (test-king-cannot-move-to-a-location-under-attack)
-
+;;(test-starting-moves)
+;;(test-king-cannot-move-to-a-location-under-attack)
+;;  (test-in-check)
+(println "running tests")
+(run-tests)
+


Remove GML -> JTS cache

Remove GML -> JTS cache

This cache is causing concurrency issues.

--- src/main/clojure/pdok/featured/feature.clj
+++ src/main/clojure/pdok/featured/feature.clj
@@ -1,7 +1,6 @@
 (ns pdok.featured.feature
     (:refer-clojure :exclude [type])
     (:require [clojure.string :as str]
-      [clojure.core.cache :as cache]
       [clojure.java.io :as io]
       [clojure.tools.logging :as log])
     (:import [pdok.featured NilAttribute GMLParser]
@@ -66,15 +65,9 @@

 (defmethod as-jts :default [_] nil)

-(def gml->jts-cache (atom (cache/lu-cache-factory {} :threshold 30000)))
-
 (defmethod as-jts "gml" [^GeometryAttribute obj]
            (when-let [gml (.getGeometry obj)]
-                     (if (cache/has? @gml->jts-cache gml)
-                       (cache/lookup @gml->jts-cache gml)
-                       (let [jts (gml3-as-jts gml)
-                             _ (swap! gml->jts-cache #(cache/miss % gml jts))]
-                            jts))))
+             (gml3-as-jts gml)))

 (defmethod as-jts "jts" [^GeometryAttribute obj]
            (.getGeometry obj))


link to title on game over screen

link to title on game over screen

--- src/client/pages/play.cljs
+++ src/client/pages/play.cljs
@@ -105,7 +105,8 @@

 (hiccups/defhtml gameover-html [ranks]
   [:div.hdr-93a4f
-    [:img.logo-dd80d {:src "/img/t3tr0s_logo_200w.png" :alt "T3TR0S Logo"}]
+    [:a {:href "#/menu"}
+      [:img.logo-dd80d {:src "/img/t3tr0s_logo_200w.png" :alt "T3TR0S Logo"}]]
     [:h1.title-6637f "Game over"]]
   [:div.results-1b4f3
     [:table.table-9be14
@@ -157,10 +158,9 @@

 (defn on-time-left
   "Called when server sends a time-left update."
-  [total-seconds]
-
-  (if (dom/by-id "gameScreenTimeLeft")
-    (dom/set-html! "gameScreenTimeLeft" (util/seconds->time-str total-seconds)))
+  [seconds-left]
+
+  (.html ($ "#gameScreenTimeLeft") (util/seconds->time-str seconds-left))

   ;; Use this as a mechanism for starting the game
   ;; if the players join late.  Otherwise, they


Rewrite solve-board to return lazy sequence

--- src/clj/ji/domain/game.clj
+++ src/clj/ji/domain/game.clj
@@ -34,17 +34,16 @@
             (assoc c3 feat (solve-feature feat (feat c1) (feat c2))))
           c1 (keys features)))

-(defn solve-board ;; TODO Return LAZY sequence
-  "Returns sets in board"
+(defn solve-board
+  "Returns lazy sequence of sets on board"
   [board]
-  (let [s-board (set board)]
-    (reduce (fn [sets [a b]]
-              (let [c (solve-set a b)]
-                (if (contains? s-board c)
-                  (conj sets #{a b c})
-                  sets)))
-            #{}
-            (for [a board b board :when (not= a b)] [a b]))))
+  (let [solve-pair (fn [[c1 c2]]
+                     (if-let [c3 (board (solve-set c1 c2))]
+                       #{c1 c2 c3}))]
+    (->> (for [a board b board :when (not= a b)] [a b])
+         (map solve-pair)
+         (keep identity)
+         (distinct))))

 (defrecord Game [deck board players])


Partially re-implemented canon. Not yet functioning.

--- src/clj/minijava/canon.clj
+++ src/clj/minijava/canon.clj
@@ -1,85 +1,139 @@
 (ns minijava.canon
-  "Implementation of the canonicalization algorithms for IR."
+  "Implementation of the canon-localicalization algorithms for IR."
   (:use (minijava ir)
         clojure.contrib.seq)
   (:require [minijava.temp :as tm]))

-(declare canon)
-
-(defn remove-double-eseq
-  "(ExpSeq s1 (ExpSeq s2 e)) -> [s1 s2 e]"
-  [tree]
-  (let [s1 (canon (:seqs tree ))
-        s2 (canon (get-in tree [:exp :seqs]))
-        e  (canon  (get-in tree [:exp :exp]))]
-    (conj (vec (concat s1 s2))
-          e)))
-
-(defn remove-eseq-left
-  "(BinaryOp op (ExpSeq stmt expr) e2) -> [stmt (BinaryOp op expr e2)]"
+(declare canon-local)
+
+(defn raise-double-eseq
+  "(ExpSeq s1 (ExpSeq s2 e)) -> (ExpSeq (Seq s1 s2) e)"
+  [tree]
+  (let [s1 (canon-local (:seqs tree ))
+        s2 (canon-local (get-in tree [:exp :seqs]))
+        e  (canon-local  (get-in tree [:exp :exp]))]
+   		(ExpSeq (Seq s1 s2) e)))
+
+(defn raise-eseq-left-binop
+  "(BinaryOp op (ExpSeq stmt expr) e2) -> (ExpSeq stmt (BinaryOp op expr e2))"
   [tree]
-  (let [stmt (canon (get-in tree [:exp1 :seqs]))
-        expr (canon (get-in tree [:exp1 :exp]))]
-    (conj (vec stmt)
-          (merge tree [:exp1 expr]))))
+  (let [stmt (canon-local (get-in tree [:exp1 :seqs]))
+        expr (canon-local (get-in tree [:exp1 :exp]))]
+				(ExpSeq stmt (merge tree [:exp1 expr]))
+))
+
+(defn raise-eseq-left-cond
+  "(BinaryOp op (ExpSeq stmt expr) e2) -> (ExpSeq stmt (BinaryOp op expr e2))"
+  [tree]
+  (let [stmt (canon-local (get-in tree [:exp1 :seqs]))
+        expr (canon-local (get-in tree [:exp1 :exp]))]
+				(Seq [stmt (merge tree [:exp1 expr])])
+))
+
+(defn raise-eseq-center
+  "(Mem (ExpSeq stmt expr)) -> (ExpSeq stmt (Mem expr))"
+  [tree]
+(cond (= :minijava.ir/Mem (type tree))
+		  (let [stmt (canon-local (get-in tree [:adr :seqs]))
+		        expr (canon-local (get-in tree [:adr :exp]))]
+						(ExpSeq (merge tree [:adr expr])))
+			(= :minijava.ir/Jump (type tree))
+		  (let [stmt (canon-local (get-in tree [:lbl :seqs]))
+		        expr (canon-local (get-in tree [:lbl :exp]))]
+						(ExpSeq stmt (merge tree [:lbl expr])))
+))
+

  ;; is this correct for CJumps, or just for Binops? As seen in figure
  ;; 8.1 (3), if a Cjump is fed into this, it should end up with no
  ;; ESeqs, just Seqs.
-(defn remove-eseq-commute
-  "(BinaryOp op e1 (ExpSeq s2 e2)) -> [s2 (BinaryOp op e1 e2)]"
-  [tree]
-  (let [e1 (canon (get tree :exp1))
-        s2 (canon (get-in tree [:exp2 :seqs]))
-        e2 (canon (get-in tree [:exp2 :exp]))]
-    (conj (vec s2)
-          (merge tree [:exp2 e2]))))
-
-(defn remove-eseq-no-commute
-  "(BinaryOp op e1 (ExpSeq s2 e2))
-     -> [(Move e1 (Temp t)) s2 (BinaryOp op (Temp t e2))]"
-  [tree]
-  (let [e1 (canon (get tree :exp1))
-        s1 (canon (get-in tree [:exp2 :seqs]))
-        e2 (canon (get-in tree [:exp2 :exp]))
+(defn raise-eseq-commute-binop
+  "(BinaryOp op e1 (ExpSeq s2 e2)) -> (ExpSeq s2 (BinaryOp op e1 e2))"
+  [tree]
+  (let [e1 (canon-local (get tree :exp1))
+        s2 (canon-local (get-in tree [:exp2 :seqs]))
+        e2 (canon-local (get-in tree [:exp2 :exp]))]
+   			(ExpSeq s2 (merge tree [:exp2 e2]))))
+
+(defn raise-eseq-commute-cond
+  "(Conditional op e1 (ExpSeq s2 e2) t f) -> (ExpSeq s2 (Conditional op e1 e2 t f))"
+  [tree]
+  (let [e1 (canon-local (get tree :exp1))
+        s2 (canon-local (get-in tree [:exp2 :seqs]))
+        e2 (canon-local (get-in tree [:exp2 :exp]))]
+   			(Seq [s2 (merge tree [:exp2 e2])])))
+
+
+
+
+
+(defn raise-eseq-no-commute-binop
+  "(BinaryOp op e1 (ExpSeq s1 e2))
+     -> (ExpSeq (Move e1 (Temp t)) (ExpSeq s1 (BinaryOp op (Temp t e2))))"
+  [tree]
+  (let [e1 (canon-local (get tree :exp1))
+        s1 (canon-local (get-in tree [:exp2 :seqs]))
+        e2 (canon-local (get-in tree [:exp2 :exp]))
         t  (tm/temp)]
-    (concat [(Move e1 (Temp t))]
-            s1
-            [(merge tree [:exp1 (Temp t)]
-                    [:exp2 e2])])))
+			(ExpSeq (Move e1 (Temp t)) (ExpSeq s1 (merge tree [:exp1 (Temp t)] [:exp2 e2])))
+))
+
+(defn raise-eseq-no-commute-cond
+  "(Conditional op e1 (ExpSeq s1 e2))
+     -> (Seq (Move e1 (Temp t)) s1 (Conditional op (Temp t e2)))"
+  [tree]
+  (let [e1 (canon-local (get tree :exp1))
+        s1 (canon-local (get-in tree [:exp2 :seqs]))
+        e2 (canon-local (get-in tree [:exp2 :exp]))
+        t  (tm/temp)]
+			(Seq [(Move e1 (Temp t)) (Seq s1 (merge tree [:exp1 (Temp t)] [:exp2 e2]))])
+))
+

 (defn matches-double-eseq?
   [s]
   (and (= :minijava.ir/ExpSeq (type s))
        (= :minijava.ir/ExpSeq (type (:exp s)))))

-(defn matches-eseq-left?
-  [s]
-  (or (and (= :minijava.ir/BinaryOp (type s)) ;; see figure 8.1
-           (= :minijava.ir/ExpSeq (type (:exp1 s))))
-      (and (= :minijava.ir/Mem (type s))
+(defn matches-eseq-left-cond?
+  [s]
+   (and (= :minijava.ir/Conditional (type s))
+           (= :minijava.ir/ExpSeq (type (:exp1 s)))))
+
+(defn matches-eseq-left-binop?
+  [s]
+  (and (= :minijava.ir/BinaryOp (type s)) ;; see figure 8.1
+           (= :minijava.ir/ExpSeq (type (:exp1 s)))))
+
+;;For things like Mem, Jump, that have only one argument
+(defn matches-eseq-center [s]
+		 (and (= :minijava.ir/Mem (type s))
            (= :minijava.ir/ExpSeq (type (:adr s))))
       (and (= :minijava.ir/Jump (type s))
            (= :minijava.ir/ExpSeq (type (:lbl s))))
-      (and (= :minijava.ir/Conditional (type s))
-           (= :minijava.ir/ExpSeq (type (:exp1 s))))))
-
-
-(defn matches-eseq-commute?
-  [s]
-  (or (and (= :minijava.ir/BinaryOp (type s)) ;; see figure 8.1
+)
+
+
+(defn matches-eseq-commute-binop?
+  [s]
+ (and (= :minijava.ir/BinaryOp (type s)) ;; see figure 8.1
            (= :minijava.ir/ExpSeq (type (:exp2 s))))
-      (and (= :minijava.ir/Conditional (type s))
-           (= :minijava.ir/ExpSeq (type (:exp2 s))))))
+    )
+(defn matches-eseq-commute-cond?
+  [s]
+  (and (= :minijava.ir/Conditional (type s));; see figure 8.1
+           (= :minijava.ir/ExpSeq (type (:exp2 s))))
+ )
+

 (defn isit? [x t]
   (= (type x) t))

-;; support function for Commutes, taken from Canon.java
+;; support function for Commutes, taken from canon-local.java
 (defn isNop [a]
   (and (isit? a :minijava.ir/Statement) (isit? (:exp a) :minijava.ir/Const)))

-;; commutes, translated from Canon.java
+;; commutes, translated from canon-local.java
 (defn commutes
   [a b]
   (or (isNop a) (isit? b :minijava.ir/Name) (isit? b :minijava.ir/Const)))
@@ -107,10 +161,10 @@
 								arg2 (if (not (= :minijava.ir/Call (type (:exp2 s)))) (:exp2 s)
 											;;;exp2 is a call, so wrap it in an eseq
 											(let [t (tm/temp)] (ExpSeq (Move (:exp2 s) t) t)))]
-								(canon (BinaryOp (:op s) arg1 arg2)));;ok; now create a new binop with these arguments, and run canon on it
+								(canon-local (BinaryOp (:op s) arg1 arg2)));;ok; now create a new binop with these arguments, and run canon-local on it
 				(= :minijava.ir/ExpSeq (type s))
 					;;s is an expseq, and its expression is a call
-					(canon (ExpSeq (:seqs s)
+					(canon-local (ExpSeq (:seqs s)
 								 (let [t (tm/temp)] (ExpSeq (Move (:exp s) t) t))))
 			(= :minijava.ir/Conditional (type s))
 							;;s is an conditional, and one or both arguments are calls
@@ -120,10 +174,10 @@
 								arg2 (if (not (= :minijava.ir/Call (type (:exp2 s)))) (:exp2 s)
 											;;;exp2 is a call, so wrap it in an eseq
 											(let [t (tm/temp)] (ExpSeq (Move (:exp2 s) t) t)))]
-								(canon (Conditional (:op s) arg1 arg2 (:t s) (:f s))));;ok; now create a new binop with these arguments, and run canon on it
+								(canon-local (Conditional (:op s) arg1 arg2 (:t s) (:f s))));;ok; now create a new binop with these arguments, and run canon-local on it
 			(= :minijava.ir/Mem (type s))
 					;;s is an Mem, and its adress is a call
-					(canon (Mem (let [t (tm/temp)] (ExpSeq (Move (:exp s) t) t))))
+					(canon-local (Mem (let [t (tm/temp)] (ExpSeq (Move (:exp s) t) t))))

 				:else s
 ))
@@ -135,36 +189,81 @@
   [s]
   (commutes (second (first s)) (second (second s))))

-(defn canon
-  "Converts a Seq to linear IR form."
-  [s]
-	    (cond
-			 (matches-eseq-left? s) (remove-eseq-left s)
-			 (matches-double-eseq? s) (remove-double-eseq s)
-			 (matches-eseq-commute? s)
+;;Whether or not any change whatsoever was made to the structure of the tree during the most recent round of canon-localoicalization
+;;If so, we should set this to false and run canon-local again.
+(def *global-change* (atom true))
+
+(defn canon-local
+  "Converts a Statement or Expression to linear IR form."
+  [s]
+	(let [*local-change* (atom false)
+				newS
+    (cond
+			 (matches-eseq-left-binop? s) (do (println "match left binop")	(reset! *local-change* true)	(raise-eseq-left-binop s))
+		 	 (matches-eseq-left-cond? s) (do (println "match left cond")	(reset! *local-change* true)	 (raise-eseq-left-cond s))
+			 (matches-double-eseq? s) (do (println "match double eseq")	(reset! *local-change* true)	 (raise-double-eseq s)	)
+			 (matches-eseq-commute-binop? s)
+					(do(println "match commute binop") (reset! *local-change* true)
 			       (if (commutes? s)
-			         (remove-eseq-commute s)
-			         (remove-eseq-no-commute s))
-						;;If s contains Call as an argument, and s is NOT a move, then construct a new ESeq node moving the result of the call into the return value register.
-						;;Then recurse on the newly created node.
-					 (contains-call? s)
-							(reorganize-call s)
+			         (raise-eseq-commute-binop s)
+			         (raise-eseq-no-commute-binop s))
+					)
+			 (matches-eseq-commute-cond? s)
+			      (do(println "match commute cond") (reset! *local-change* true)
+								(if (commutes? s)
+						         (raise-eseq-commute-cond s)
+						         (raise-eseq-no-commute-cond s))
+							)
+			;;If s contains Call as an argument, and s is NOT a move, then construct a new ESeq node moving the result of the call into the return value register.
+			;;Then recurse on the newly created node.
+	;;		(contains-call? s) ;;this wont work with the current approach; have to remove calls in a separate procedure
+	;;				(do (reset! *local-change* true) (reorganize-call s))
 		(= :minijava.ir/Seq (type s))
-				(flatten;;run canon on each element of the sequence
-					  (for [s (:seqs s)] (canon s)))
+		(do	(println "match seq")	(Seq (flatten;;run canon-local on each element of the sequence
+					  (for [s (:seqs s)] (canon-local s)))))
 		(= :minijava.ir/ExpSeq (type s)) ;;is this right?
-			   (list (canon (:seqs s)) (canon (:exp s)))
+			 (do	(println "match expseq")  (ExpSeq (canon-local (:seqs s)) (canon-local (:exp s))) )
 		(= :minijava.ir/BinaryOp (type s))
-				(BinaryOp (:op s) (canon (:exp1 s))  (canon (:exp2 s)))
+				(do	(println "match binop") (BinaryOp (:op s) (canon-local (:exp1 s))  (canon-local (:exp2 s))))
 		(= :minijava.ir/Conditional (type s))
-				(Conditional (:op s) (canon (:exp1 s))  (canon (:exp2 s)) (:t s) (:f s))
+				(do	(println "match cond")(Conditional (:op s) (canon-local (:exp1 s))  (canon-local (:exp2 s)) (:t s) (:f s)))
 		(= :minijava.ir/Call (type s))
-				(Call (:lbl s) (canon (:args s)))
+				(Call (:lbl s) (canon-local (:args s)))
 		(= :minijava.ir/Statement (type s))
-				(Statement (canon (:exp s)))
+				(Statement (canon-local (:exp s)))
 		:else
-				s;;no changes or recursion needed for Consts, Jmps, NoOps,Temp, Name, etc
-))
+			s;;no changes or recursion needed for Consts, Jmps, NoOps,Temp, Name, etc
+		)]
+		(if @*local-change* (reset! *global-change* true))
+		newS))
+
+(defn canon-raise [t]
+ (do
+	(reset! *global-change* true)
+	(let [*current-tree* (atom t)]
+ 	(while @*global-change*
+	(do	(reset! *global-change* false)
+		(swap! *current-tree* canon-local)))
+	@*current-tree*)
+	)
+)
+
+(defn remove-seqs[t]
+		(cond
+				(= :minijava.ir/Seq (type t))
+						(flatten (for [t (:seqs t)] (remove-seqs t)))
+				:else t;;All seqs are guaranteed to be top level (not contained in anything but a seq), so we dont need to explore other nodes.
+	)
+)
+
+
+(defn canon [t]
+	(let [raised (canon-raise t)]
+	;;now remove all the top level sequences, and return a vector of statements, with no seqs (or expseqs, but those were already removed)
+	(remove-seqs t)
+))
+
+

 ;; BASIC BLOCKS


Fix remaining weird fields

Fix remaining weird fields

--- src/clj/schedule/types.clj
+++ src/clj/schedule/types.clj
@@ -21,27 +21,33 @@
  :extends schedule.HardSoftSolution
  :init init
  :state state
- :methods [[^{PlanningEntityCollectionProperty {}} getTestItems [] java.util.ArrayList]
-           [^{ValueRangeProvider {"id" "slotRange"}} getSlotRange [] java.util.ArrayList]]
+ :methods [[^{PlanningEntityCollectionProperty {}} getEvents [] java.util.List]
+           [setEvents [java.util.List] void]
+           [^{ValueRangeProvider {"id" "slotRange"}} getSlotRange [] java.util.ArrayList]
+           [setSlotRange [java.util.ArrayList] void]]
  :prefix "solution-")

-(defn solution-init []
-  [[] (ref {})])
+(defn- solution-init []
+  [[] (ref {:events (ArrayList.)
+            :slotRange (ArrayList.)})])

-(defn solution-getTestItems [this]
-  (ArrayList.))
+(defn- solution-getEvents [this]
+  (ArrayList. (getValue this :events)))

-(defn solution-getProblemFacts [this]
-  (ArrayList.))
+(defn- solution-getProblemFacts [this]
+  (getValue this :events))

-(defn solution-setScore [this score]
+(defn- solution-getScore [this]
+  (getValue this :score))
+
+(defn- solution-setScore [this score]
   (setValue this :score score))

-(defn solution-getSlotRange [this]
-  (ArrayList.))
+(defn- solution-getSlotRange [this]
+  (getValue this :slotRange))

-(defn solution-getScore	[this]
-  (getValue this :score))
+(defn- solution-setSlotRange [this value]
+  (setValue this :slotRange value))

 (gen-class
  :name ^{PlanningEntity {}} schedule.types.Event
@@ -51,11 +57,11 @@
  :methods [[^{PlanningVariable {"valueRangeProviderRefs" ["slotRange"]}} getSlot [] Object]
            [setSlot [Object] void]])

-(defn event-init []
+(defn- event-init []
   [[] (ref {})])

-(defn event-getSlot [this]
+(defn- event-getSlot [this]
   (getValue this :slot))

-(defn event-setSlot [this item]
+(defn- event-setSlot [this item]
   (setValue this :slot item))


Add keybindings for start/stop drawing, sizes

--- src/cljs/pizarra/core.cljs
+++ src/cljs/pizarra/core.cljs
@@ -58,6 +58,16 @@
   (doseq [action (om/value actions)]
     (-draw action context)))

+(defn start-drawing [canvas]
+  (-> canvas
+    (update-in [:actions] (partial -start line-tool))
+    (assoc :drawing? true)))
+
+(defn stop-drawing [canvas]
+  (-> canvas
+    (update-in [:actions] (partial -end line-tool))
+    (assoc :drawing? false)))
+
 (defn canvas [data owner]
   (reify
     om/IDidMount
@@ -76,13 +86,9 @@
            {:onSelectStart (fn [_])
             :onMouseDown (fn [e]
                            (.preventDefault e)
-                           (om/transact! data [:actions] (partial -start line-tool))
-                           (om/update! data [:drawing?] true))
+                           (om/transact! data [] start-drawing))
             :onMouseUp (fn [_]
-                         (let [idx (dec (count (:actions @data)))]
-                           (om/transact! data [:actions idx]
-                                         (partial -end line-tool) :add-to-undo)
-                           (om/update! data [:drawing?] false)))
+                         (om/transact! data [] stop-drawing :add-to-undo))
             :onMouseMove (fn [e]
                            (when (:drawing? @data)
                              (let [dom (om/get-node owner)
@@ -150,6 +156,21 @@
 (.bind js/Mousetrap #js ["u" "ctrl+z" "command+z"] #(undo/do-undo app-state))
 (.bind js/Mousetrap #js ["ctrl+r"] #(undo/do-redo app-state))

+(.bind js/Mousetrap "i" #(swap! app-state update-in [:canvas] start-drawing))
+(.bind js/Mousetrap "esc" (fn [_]
+                            (swap! app-state update-in [:canvas] stop-drawing)
+                            (undo/push-onto-undo-stack @app-state)))
+
+(defn bind-number [nkey width]
+  (.bind js/Mousetrap
+         (str nkey)
+         (fn []
+           (swap! app-state update-in [:tools] assoc :lineWidth width))))
+
+(doseq [i (range 1 10)]
+  (bind-number i i))
+(bind-number 0 10)
+
 (comment

 (swap! app-state update-in [:canvas :actions 0 :props] assoc :strokeStyle "#999999")


Snap to 45-degree angles

Snap to 45-degree angles

--- src/cljs/pizarra/core.cljs
+++ src/cljs/pizarra/core.cljs
@@ -51,10 +51,26 @@
     (-end [_ actions]
       actions)))

+(defn slope [[[x0 y0] [x1 y1]]]
+  (/ (- y1 y0) (- x1 x0)))
+
+(defn adjusted-slope [m]
+  (cond
+    (< 0.5 m 2) 1
+    (< -0.5 m 0.5) 0
+    (< -2 m -0.5) -1
+    :else ::infinity))
+
+(defn adjust-points [m [[x0 y0] [x1 y1]]]
+  (if (= m ::infinity)
+    [[x0 y0] [x0 y1]]
+    (let [new-y (+ (* m (- x1 x0)) y0)]
+      [[x0 y0] [x1 new-y]])))
+
 (defn snap [points]
   (if (get-in @app-state [:tools :snap])
-    (let [y0 (get-in points [0 1])]
-      [(first points) [(get-in points [1 0]) y0]])
+    (let [m (adjusted-slope (slope points))]
+      (adjust-points m points))
     points))

 (defn next-point [points x y]


Pass the compiler state as :*compiler* to eval-str*, closes #195

--- src/cljs/replumb/repl.cljs
+++ src/cljs/replumb/repl.cljs
@@ -58,7 +58,6 @@
   cannot be found."
   [opts rdr]
   (binding [ana/*cljs-ns* (:current-ns @app-env)
-            env/*compiler* st
             r/*data-readers* tags/*cljs-data-readers*
             r/resolve-symbol ana/resolve-symbol]
     (r/read opts rdr)))
@@ -68,7 +67,6 @@
   cannot be found."
   [opts s]
   (binding [ana/*cljs-ns* (:current-ns @app-env)
-            env/*compiler* st
             r/*data-readers* tags/*cljs-data-readers*
             r/resolve-symbol ana/resolve-symbol]
     (r/read-string opts s)))
@@ -155,6 +153,7 @@
     :load (:load-fn! user-opts)
     :eval (make-js-eval-fn user-opts)
     :verbose (or (:verbose user-opts) false)
+    :*compiler* (set! env/*compiler* st)
     :static-fns (or (:static-fns user-opts) false)}))

 (defn load-eval-opts!


allow options in protocol

allow options in protocol

--- src/cljs_api_gen/parse.clj
+++ src/cljs_api_gen/parse.clj
@@ -235,11 +235,17 @@
         docstring (let [d (first form)]
                     (when (string? d) d))
         form (if docstring (drop 1 form) form)
+        [opts form] (loop [opts {}
+                           [a b & etc :as form] form]
+                      (if (keyword? a)
+                        (recur (assoc opts a b) etc)
+                        [opts form]))
         method-lists form
         pmethods (mapv parse-protocol-method method-lists)]
     (when (or *parse-private-defs?*
               (not private?))
       {:docstring docstring
+       :options opts
        :signature nil
        :methods pmethods
        :type "protocol"})))


cljsbuild is required for notify-command

--- sidecar/project.clj
+++ sidecar/project.clj
@@ -14,6 +14,7 @@
    [ring-cors "0.1.4"]
    [compojure "1.1.7"]
    [clj-stacktrace "0.2.7"]
+   [cljsbuild "1.0.4"]
    [clojurescript-build "0.1.2-SNAPSHOT"]
    [watchtower "0.1.1"]
    [digest "1.4.3"]])


Make hello-world/hello public

Make hello-world/hello public

--- hello-world/example.clj
+++ hello-world/example.clj
@@ -1,4 +1,4 @@
 (ns hello-world)

-(defn- hello [name]
+(defn hello [name]
   (str "Hello, " name "!"))


Make run handle n arguments.

Make run handle n arguments.

--- src/overtunes/songs/canone_alla_quarta.clj
+++ src/overtunes/songs/canone_alla_quarta.clj
@@ -34,10 +34,11 @@

 (defn bpm [per-minute] #(-> % (/ per-minute) (* 60) (* 1000)))
 (defn syncopate [timing durations] #(->> % (sum-n durations) timing))
-(defn run [a b]
-  (if (<= a b)
-    (range a (inc b))
-    (reverse (run b a))))
+(defn run [a & bs]
+  (let [up-or-down #(if (<= %1 %2) (range %1 %2) (reverse (range (inc %2) (inc %1))))]
+    (if bs
+      (concat (up-or-down a (first bs)) (apply run bs))
+      [a])))

 (defn melody [notes]
   (let [functionalise #(update-all % [:time :pitch] natural-map)


[#2861] Add custom java.time.Instant json generator [tests]

--- backend/test/akvo/lumen/lib/transformation_test.clj
+++ backend/test/akvo/lumen/lib/transformation_test.clj
@@ -27,6 +27,7 @@
             [akvo.lumen.test-utils :refer [update-file import-file at-least-one-true retry-job-execution] :as tu]
             [akvo.lumen.util :refer [conform squuid]]
             [cheshire.core :as json]
+            [cheshire.generate :as ches.generate]
             [clj-time.coerce :as tcc]
             [clj-time.core :as tc]
             [clj-time.format :as timef]
@@ -39,6 +40,8 @@
             [clojure.walk :refer (stringify-keys keywordize-keys)]
             [hugsql.core :as hugsql])
   (:import [akvo.lumen.postgres Geoshape Geopoint]))
+
+(ches.generate/add-encoder java.time.Instant (fn [obj jsonGenerator] (.writeString jsonGenerator (str obj))))

 (alias 'import.column.text.s                    'akvo.lumen.specs.import.column.text)
 (alias 'import.column.number.s                    'akvo.lumen.specs.import.column.number)