CMR-4785: Updated MemoryDB to use extend and separated functions.

--- metadata-db-app/src/cmr/metadata_db/data/memory_db.clj
+++ metadata-db-app/src/cmr/metadata_db/data/memory_db.clj
@@ -154,8 +154,7 @@
     (map map-fn concepts)))

 (defrecord MemoryDB
-  [
-   ;; A sequence of concepts stored in metadata db
+  [;; A sequence of concepts stored in metadata db
    concepts-atom

    ;; The next id to use for generating a concept id.
@@ -165,295 +164,364 @@
    next-transaction-id-atom

    ;; A map of provider ids to providers that exist
-   providers-atom]
-
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  lifecycle/Lifecycle
-
-  (start [this system]
-         this)
-
-  (stop [this system]
-        this)
-
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  concepts/ConceptSearch
-
-  (find-concepts
-   [db providers params]
-   (let [found-concepts (mapcat #(concepts/search-with-params
-                                  @concepts-atom
-                                  (assoc params :provider-id (:provider-id %)))
-                                providers)]
-     (concepts->find-result found-concepts params)))
-
-  (find-latest-concepts
-   [db provider params]
-   (let [latest-concepts (latest-revisions @concepts-atom)
-         found-concepts (concepts/search-with-params
-                         latest-concepts
-                         (assoc params :provider-id (:provider-id provider)))]
-     (concepts->find-result found-concepts params)))
-
-  concepts/ConceptsStore
-
-  (generate-concept-id
-   [this concept]
-   (let [{:keys [concept-type provider-id]} concept
-         num (swap! next-id-atom inc)]
-     (cc/build-concept-id {:concept-type concept-type
-                           :sequence-number num
-                           :provider-id provider-id})))
-
-  (get-concept-id
-   [this concept-type provider native-id]
-   (let [provider-id (:provider-id provider)
-         concept-type (if (keyword? concept-type) concept-type (keyword concept-type))]
-     (->> @concepts-atom
-          (filter (fn [c]
+   providers-atom])
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CMR Component Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn start
+  [this system]
+  this)
+
+(defn stop
+  [this system]
+  this)
+
+(def component-lifecycle-behaviour
+  {:start start
+   :stop stop})
+
+(extend MemoryDB
+        lifecycle/Lifecycle
+        component-lifecycle-behaviour)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Metadata DB ConceptSearch Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn find-concepts
+  [db providers params]
+  (let [found-concepts (mapcat #(concepts/search-with-params
+                                @(:concepts-atom db)
+                                (assoc params :provider-id (:provider-id %)))
+                              providers)]
+    (concepts->find-result found-concepts params)))
+
+(defn find-latest-concepts
+  [db provider params]
+  (let [latest-concepts (latest-revisions @(:concepts-atom db))
+        found-concepts (concepts/search-with-params
+                        latest-concepts
+                        (assoc params :provider-id (:provider-id provider)))]
+    (concepts->find-result found-concepts params)))
+
+(def concept-search-behaviour
+  {:find-concepts find-concepts
+   :find-latest-concepts find-latest-concepts})
+
+(extend MemoryDB
+        concepts/ConceptSearch
+        concept-search-behaviour)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Metadata DB ConceptsStore Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn generate-concept-id
+  [db concept]
+  (let [{:keys [concept-type provider-id]} concept
+       num (swap! (:next-id-atom db) inc)]
+   (cc/build-concept-id {:concept-type concept-type
+                         :sequence-number num
+                         :provider-id provider-id})))
+
+(defn get-concept-id
+  [db concept-type provider native-id]
+  (let [provider-id (:provider-id provider)
+       concept-type (if (keyword? concept-type) concept-type (keyword concept-type))]
+   (->> @(:concepts-atom db)
+        (filter (fn [c]
+                  (and (= concept-type (:concept-type c))
+                       (= provider-id (:provider-id c))
+                       (= native-id (:native-id c)))))
+        first
+        :concept-id)))
+
+(defn get-granule-concept-ids
+  [db provider native-id]
+  (let [provider-id (:provider-id provider)
+        matched-gran (->> @(:concepts-atom db)
+                          (filter (fn [c]
+                                   (and (= :granule (:concept-type c))
+                                        (= provider-id (:provider-id c))
+                                        (= native-id (:native-id c)))))
+                          (sort-by :revisoin-id)
+                          last)
+        {:keys [concept-id deleted]} matched-gran
+        parent-collection-id (get-in matched-gran [:extra-fields :parent-collection-id])]
+    [concept-id parent-collection-id deleted]))
+
+(defn- -get-concept
+  [db concept-type provider concept-id]
+  (let [revisions (filter
+                   (fn [c]
                     (and (= concept-type (:concept-type c))
-                         (= provider-id (:provider-id c))
-                         (= native-id (:native-id c)))))
-          first
-          :concept-id)))
-
-  (get-granule-concept-ids
-   [this provider native-id]
-   (let [provider-id (:provider-id provider)
-         matched-gran (->> @concepts-atom
-                           (filter (fn [c]
-                                     (and (= :granule (:concept-type c))
-                                          (= provider-id (:provider-id c))
-                                          (= native-id (:native-id c)))))
-                           (sort-by :revisoin-id)
-                           last)
-         {:keys [concept-id deleted]} matched-gran
-         parent-collection-id (get-in matched-gran [:extra-fields :parent-collection-id])]
-     [concept-id parent-collection-id deleted]))
-
-  (get-concept
-   [db concept-type provider concept-id]
-   (let [revisions (filter
-                    (fn [c]
-                      (and (= concept-type (:concept-type c))
-                           (= (:provider-id provider) (:provider-id c))
-                           (= concept-id (:concept-id c))))
-                    @concepts-atom)]
-     (->> revisions
-          (sort-by :revision-id)
-          last)))
-
-  (get-concept
-   [db concept-type provider concept-id revision-id]
-   (if-not revision-id
-     (concepts/get-concept db concept-type provider concept-id)
-     (first (filter
-             (fn [c]
-               (and (= concept-type (:concept-type c))
-                    (= (:provider-id provider) (:provider-id c))
-                    (= concept-id (:concept-id c))
-                    (= revision-id (:revision-id c))))
-             @concepts-atom))))
-
-  (get-concepts
-   [this concept-type provider concept-id-revision-id-tuples]
-   (filter identity
-           (map (fn [[concept-id revision-id]]
-                  (concepts/get-concept this concept-type provider concept-id revision-id))
-                concept-id-revision-id-tuples)))
-
-  (get-latest-concepts
-   [db concept-type provider concept-ids]
-   (let [concept-id-set (set concept-ids)
-         concept-map (reduce (fn [concept-map {:keys [concept-id revision-id] :as concept}]
-                               (if (contains? concept-id-set concept-id)
-                                 (cond
-
-                                   (nil? (get concept-map concept-id))
-                                   (assoc concept-map concept-id concept)
-
-                                   (> revision-id (:revision-id (get concept-map concept-id)))
-                                   (assoc concept-map concept-id concept)
-
-                                   :else
-                                   concept-map)
-                                 concept-map))
-                             {}
-                             @concepts-atom)]
-     (keep (partial get concept-map) concept-ids)))
-
-  (get-transactions-for-concept
-   [db provider con-id]
-   (keep (fn [{:keys [concept-id revision-id transaction-id]}]
-           (when (= con-id concept-id)
-             {:revision-id revision-id :transaction-id transaction-id}))
-         @concepts-atom))
-
-  (save-concept
-   [this provider concept]
-   {:pre [(:revision-id concept)]}
-
-   (if-let [error (validate-concept-id-native-id-not-changing this provider concept)]
-     ;; There was a concept id, native id mismatch with earlier concepts
-     error
-     ;; Concept id native id pair was valid
-     (let [{:keys [concept-type provider-id concept-id revision-id]} concept
-           concept (update-in concept
-                              [:revision-date]
+                         (= (:provider-id provider) (:provider-id c))
+                         (= concept-id (:concept-id c))))
+                   @(:concepts-atom db))]
+    (->> revisions
+         (sort-by :revision-id)
+         last)))
+
+(defn- -get-concept-with-revision
+  [db concept-type provider concept-id revision-id]
+  (if-not revision-id
+    (concepts/get-concept db concept-type provider concept-id)
+    (first (filter
+            (fn [c]
+             (and (= concept-type (:concept-type c))
+                  (= (:provider-id provider) (:provider-id c))
+                  (= concept-id (:concept-id c))
+                  (= revision-id (:revision-id c))))
+            @(:concepts-atom db)))))
+
+(defn get-concept
+  ([db concept-type provider concept-id]
+    (-get-concept db concept-type provider concept-id))
+  ([db concept-type provider concept-id revision-id]
+    (-get-concept-with-revision
+     db concept-type provider concept-id revision-id)))
+
+(defn get-concepts
+  [db concept-type provider concept-id-revision-id-tuples]
+  (filter
+   identity
+   (map (fn [[concept-id revision-id]]
+          (concepts/get-concept db concept-type provider concept-id revision-id))
+        concept-id-revision-id-tuples)))
+
+(defn get-latest-concepts
+[db concept-type provider concept-ids]
+  (let [concept-id-set (set concept-ids)
+        concept-map (reduce (fn [concept-map {:keys [concept-id revision-id] :as concept}]
+                             (if (contains? concept-id-set concept-id)
+                               (cond
+
+                                 (nil? (get concept-map concept-id))
+                                 (assoc concept-map concept-id concept)
+
+                                 (> revision-id (:revision-id (get concept-map concept-id)))
+                                 (assoc concept-map concept-id concept)
+
+                                 :else
+                                 concept-map)
+                               concept-map))
+                            {}
+                            @(:concepts-atom db))]
+   (keep (partial get concept-map) concept-ids)))
+
+(defn get-transactions-for-concept
+  [db provider con-id]
+  (keep (fn [{:keys [concept-id revision-id transaction-id]}]
+         (when (= con-id concept-id)
+           {:revision-id revision-id :transaction-id transaction-id}))
+       @(:concepts-atom db)))
+
+(defn save-concept
+  [db provider concept]
+  {:pre [(:revision-id concept)]}
+
+  (if-let [error (validate-concept-id-native-id-not-changing db provider concept)]
+   ;; There was a concept id, native id mismatch with earlier concepts
+   error
+   ;; Concept id native id pair was valid
+   (let [{:keys [concept-type provider-id concept-id revision-id]} concept
+         concept (update-in concept
+                            [:revision-date]
+                            #(or % (f/unparse (f/formatters :date-time) (tk/now))))
+         ;; Set the created-at time to the current timekeeper time for concepts which have
+         ;; the created-at field and do not already have a :created-at time set.
+         concept (if (some #{concept-type} [:collection :granule :service :variable])
+                   (update-in concept
+                              [:created-at]
                               #(or % (f/unparse (f/formatters :date-time) (tk/now))))
-           ;; Set the created-at time to the current timekeeper time for concepts which have
-           ;; the created-at field and do not already have a :created-at time set.
-           concept (if (some #{concept-type} [:collection :granule :service :variable])
-                     (update-in concept
-                                [:created-at]
-                                #(or % (f/unparse (f/formatters :date-time) (tk/now))))
-                     concept)
-           concept (assoc concept :transaction-id (swap! next-transaction-id-atom inc))
-           concept (if (= concept-type :granule)
-                     (-> concept
-                         (dissoc :user-id)
-                         ;; This is not stored in the real db.
-                         (update-in [:extra-fields] dissoc :parent-entry-title))
-                     concept)]
-       (if (or (nil? revision-id)
-               (concepts/get-concept this concept-type provider concept-id revision-id))
-         {:error :revision-id-conflict}
-         (do
-           (swap! concepts-atom (fn [concepts]
-                                  (after-save this (conj concepts concept)
-                                              concept)))
-           nil)))))
-
-  (force-delete
-   [db concept-type provider concept-id revision-id]
-   (swap! concepts-atom
-          #(filter
-            (fn [c]
-              (not (and (= concept-type (:concept-type c))
-                        (= (:provider-id provider) (:provider-id c))
-                        (= concept-id (:concept-id c))
-                        (= revision-id (:revision-id c)))))
-            %)))
-
-  (force-delete-concepts
-   [db provider concept-type concept-id-revision-id-tuples]
-   (doseq [[concept-id revision-id] concept-id-revision-id-tuples]
-     (concepts/force-delete db concept-type provider concept-id revision-id)))
-
-  (get-concept-type-counts-by-collection
-   [db concept-type provider]
-   (->> @concepts-atom
-        (filter #(= (:provider-id provider) (:provider-id %)))
-        (filter #(= concept-type (:concept-type %)))
-        (group-by (comp :parent-collection-id :extra-fields))
-        (map #(update-in % [1] count))
-        (into {})))
-
-  (reset
-   [db]
-   (reset! concepts-atom [])
-   (reset! next-id-atom (dec cmr.metadata-db.data.oracle.concepts/INITIAL_CONCEPT_NUM))
-   (reset! next-transaction-id-atom 1))
-
-  (get-expired-concepts
-   [db provider concept-type]
-   (->> @concepts-atom
-        (filter #(= (:provider-id provider) (:provider-id %)))
-        (filter #(= concept-type (:concept-type %)))
-        latest-revisions
-        (filter expired?)
-        (remove :deleted)))
-
-  (get-tombstoned-concept-revisions
-   [db provider concept-type tombstone-cut-off-date limit]
-   (->> @concepts-atom
+                   concept)
+         concept (assoc concept :transaction-id (swap! (:next-transaction-id-atom db) inc))
+         concept (if (= concept-type :granule)
+                   (-> concept
+                       (dissoc :user-id)
+                       ;; This is not stored in the real db.
+                       (update-in [:extra-fields] dissoc :parent-entry-title))
+                   concept)]
+     (if (or (nil? revision-id)
+             (concepts/get-concept db concept-type provider concept-id revision-id))
+       {:error :revision-id-conflict}
+       (do
+         (swap! (:concepts-atom db) (fn [concepts]
+                                     (after-save db (conj concepts concept)
+                                                 concept)))
+         nil)))))
+
+(defn force-delete
+  [db concept-type provider concept-id revision-id]
+  (swap! (:concepts-atom db)
+         #(filter
+           (fn [c]
+            (not (and (= concept-type (:concept-type c))
+                      (= (:provider-id provider) (:provider-id c))
+                      (= concept-id (:concept-id c))
+                      (= revision-id (:revision-id c)))))
+           %)))
+
+(defn force-delete-concepts
+  [db provider concept-type concept-id-revision-id-tuples]
+  (doseq [[concept-id revision-id] concept-id-revision-id-tuples]
+    (concepts/force-delete db concept-type provider concept-id revision-id)))
+
+(defn get-concept-type-counts-by-collection
+  [db concept-type provider]
+  (->> @(:concepts-atom db)
+      (filter #(= (:provider-id provider) (:provider-id %)))
+      (filter #(= concept-type (:concept-type %)))
+      (group-by (comp :parent-collection-id :extra-fields))
+      (map #(update-in % [1] count))
+      (into {})))
+
+(defn reset
+  [db]
+  (reset! (:concepts-atom db) [])
+  (reset! (:next-id-atom db) (dec cmr.metadata-db.data.oracle.concepts/INITIAL_CONCEPT_NUM))
+  (reset! (:next-transaction-id-atom db) 1))
+
+(defn get-expired-concepts
+  [db provider concept-type]
+  (->> @(:concepts-atom db)
+       (filter #(= (:provider-id provider) (:provider-id %)))
+       (filter #(= concept-type (:concept-type %)))
+       latest-revisions
+       (filter expired?)
+       (remove :deleted)))
+
+(defn get-tombstoned-concept-revisions
+  [db provider concept-type tombstone-cut-off-date limit]
+  (->> @(:concepts-atom db)
+       (filter #(= concept-type (:concept-type %)))
+       (filter #(= (:provider-id provider) (:provider-id %)))
+       (filter :deleted)
+       (filter #(t/before? (p/parse-datetime (:revision-date %)) tombstone-cut-off-date))
+       (map #(vector (:concept-id %) (:revision-id %)))
+       (take limit)))
+
+(defn get-old-concept-revisions
+  [db provider concept-type max-versions limit]
+  (letfn [(drop-highest
+          [concepts]
+          (->> concepts
+               (sort-by :revision-id)
+               (drop-last max-versions)))]
+   (->> @(:concepts-atom db)
         (filter #(= concept-type (:concept-type %)))
         (filter #(= (:provider-id provider) (:provider-id %)))
-        (filter :deleted)
-        (filter #(t/before? (p/parse-datetime (:revision-date %)) tombstone-cut-off-date))
-        (map #(vector (:concept-id %) (:revision-id %)))
-        (take limit)))
-
-  (get-old-concept-revisions
-   [db provider concept-type max-versions limit]
-   (letfn [(drop-highest
-            [concepts]
-            (->> concepts
-                 (sort-by :revision-id)
-                 (drop-last max-versions)))]
-     (->> @concepts-atom
-          (filter #(= concept-type (:concept-type %)))
-          (filter #(= (:provider-id provider) (:provider-id %)))
-          (group-by :concept-id)
-          vals
-          (filter #(> (count %) max-versions))
-          (mapcat drop-highest)
-          (map concept->tuple))))
-
-  providers/ProvidersStore
-
-  (save-provider
-   [db {:keys [provider-id] :as provider}]
-   (swap! providers-atom assoc provider-id provider))
-
-  (get-providers
-   [db]
-   (vals @providers-atom))
-
-  (get-provider
-   [db provider-id]
-   (@providers-atom provider-id))
-
-  (update-provider
-   [db {:keys [provider-id] :as provider}]
-   (swap! providers-atom assoc provider-id provider))
-
-  (delete-provider
-   [db provider]
-   ;; Cascade to delete the concepts
-   (doseq [{:keys [concept-type concept-id revision-id]} (concepts/find-concepts db [provider] nil)]
-     (concepts/force-delete db concept-type provider concept-id revision-id))
-
-   ;; Cascade to delete the variable associations and service associations,
-   ;; this is a hacky way of doing things
-   (doseq [assoc-type [:variable-association :service-association]]
-     (doseq [association (concepts/find-concepts db
-                                                 [{:provider-id "CMR"}]
-                                                 {:concept-type assoc-type})]
-       (let [{:keys [concept-id revision-id extra-fields]} association
-             {:keys [associated-concept-id variable-concept-id service-concept-id]} extra-fields
-             referenced-providers (map (fn [cid]
-                                         (some-> cid
-                                                 cc/parse-concept-id
-                                                 :provider-id))
-                                       [associated-concept-id variable-concept-id service-concept-id])]
-         ;; If the association references the deleted provider through
-         ;; either collection or variable/service, delete the association
-         (when (some #{(:provider-id provider)} referenced-providers)
-           (concepts/force-delete
-             db assoc-type {:provider-id "CMR"} concept-id revision-id)))))
-
-   ;; to find items that reference the provider that should be deleted (e.g. ACLs)
-   (doseq [{:keys [concept-type concept-id revision-id]} (concepts/find-concepts
-                                                          db
-                                                          [pv/cmr-provider]
-                                                          {:target-provider-id (:provider-id provider)})]
-     (concepts/force-delete db concept-type pv/cmr-provider concept-id revision-id))
-   ;; finally delete the provider
-   (swap! providers-atom dissoc (:provider-id provider)))
-
-  (reset-providers
-   [db]
-   (reset! providers-atom {})))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
+        (group-by :concept-id)
+        vals
+        (filter #(> (count %) max-versions))
+        (mapcat drop-highest)
+        (map concept->tuple))))
+
+(def concept-store-behaviour
+  {:generate-concept-id generate-concept-id
+   :get-concept-id get-concept-id
+   :get-granule-concept-ids get-granule-concept-ids
+   :get-concept get-concept
+   :get-concepts get-concepts
+   :get-latest-concepts get-latest-concepts
+   :get-transactions-for-concept get-transactions-for-concept
+   :save-concept save-concept
+   :force-delete force-delete
+   :force-delete-concepts force-delete-concepts
+   :get-concept-type-counts-by-collection get-concept-type-counts-by-collection
+   :reset reset
+   :get-expired-concepts get-expired-concepts
+   :get-tombstoned-concept-revisions get-tombstoned-concept-revisions
+   :get-old-concept-revisions get-old-concept-revisions})
+
+(extend MemoryDB
+        concepts/ConceptsStore
+        concept-store-behaviour)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Metadata DB ProvidersStore Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn save-provider
+  [db {:keys [provider-id] :as provider}]
+  (swap! (:providers-atom db) assoc provider-id provider))
+
+(defn get-providers
+  [db]
+  (vals @(:providers-atom db)))
+
+(defn get-provider
+  [db provider-id]
+  (@(:providers-atom db) provider-id))
+
+(defn update-provider
+  [db {:keys [provider-id] :as provider}]
+  (swap! (:providers-atom db) assoc provider-id provider))
+
+(defn delete-provider
+  [db provider]
+  ;; Cascade to delete the concepts
+  (doseq [{:keys [concept-type concept-id revision-id]} (concepts/find-concepts db [provider] nil)]
+   (concepts/force-delete db concept-type provider concept-id revision-id))
+
+  ;; Cascade to delete the variable associations and service associations,
+  ;; this is a hacky way of doing things
+  (doseq [assoc-type [:variable-association :service-association]]
+   (doseq [association (concepts/find-concepts db
+                                               [{:provider-id "CMR"}]
+                                               {:concept-type assoc-type})]
+     (let [{:keys [concept-id revision-id extra-fields]} association
+           {:keys [associated-concept-id variable-concept-id service-concept-id]} extra-fields
+           referenced-providers (map (fn [cid]
+                                       (some-> cid
+                                               cc/parse-concept-id
+                                               :provider-id))
+                                     [associated-concept-id variable-concept-id service-concept-id])]
+       ;; If the association references the deleted provider through
+       ;; either collection or variable/service, delete the association
+       (when (some #{(:provider-id provider)} referenced-providers)
+         (concepts/force-delete
+           db assoc-type {:provider-id "CMR"} concept-id revision-id)))))
+
+  ;; to find items that reference the provider that should be deleted (e.g. ACLs)
+  (doseq [{:keys [concept-type concept-id revision-id]} (concepts/find-concepts
+                                                        db
+                                                        [pv/cmr-provider]
+                                                        {:target-provider-id (:provider-id provider)})]
+   (concepts/force-delete db concept-type pv/cmr-provider concept-id revision-id))
+  ;; finally delete the provider
+  (swap! (:providers-atom db) dissoc (:provider-id provider)))
+
+(defn reset-providers
+  [db]
+  (reset! (:providers-atom db) {}))
+
+(def provider-store-behaviour
+  {:save-provider save-provider
+   :get-providers get-providers
+   :get-provider get-provider
+   :update-provider update-provider
+   :delete-provider delete-provider
+   :reset-providers reset-providers})
+
+(extend MemoryDB
+        providers/ProvidersStore
+        provider-store-behaviour)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; MemoryDB Constructor
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn create-db
   "Creates and returns an in-memory database."
   ([]
    (create-db []))
   ([concepts]
+   ;; XXX as part of being self-documenting, let's use map->MemoryDB here
+   ;;     so we can look at the keys and know to what each corresponds in
+   ;      the record ...
    ;; sort by revision-id reversed so latest will be first
    (->MemoryDB (atom (reverse (sort-by :revision-id concepts)))
                (atom (dec cmr.metadata-db.data.oracle.concepts/INITIAL_CONCEPT_NUM))


Remove unused require of cljs.nodejs.

Remove unused require of cljs.nodejs.

--- src/aero/core.cljc
+++ src/aero/core.cljc
@@ -10,7 +10,6 @@
            [aero.vendor.dependency.v0v2v0.com.stuartsierra.dependency :as dep]))
   #?(:clj (:import (java.io StringReader)))
   #?(:cljs (:require [cljs.tools.reader :as edn]
-                     [cljs.nodejs :as nodejs]
                      [goog.string :as gstring]
                      goog.string.format
                      [clojure.walk :refer [walk postwalk]]


adding nesting.

adding nesting.

--- test/example/mad2.clj
+++ test/example/mad2.clj
@@ -80,5 +80,5 @@

 ;(play tone pitches metro)

-;(play ks1-demo (i2p [[:i _ :i] [:i :i :i _ :v _ :i]] :diatonic f4) metro)
+(play ks1-demo (i2p [[:i [:v _ :v] :i] [:i [:i :iv] :i _ :v _ :i]] :diatonic f4) metro)


parallelize test gathering

parallelize test gathering

--- src/bolth.clj
+++ src/bolth.clj
@@ -144,8 +144,10 @@

 (defn gather-tests [ns-re]
   (let [queue (atom [])]
-    (doseq [n (filter #(re-matches ns-re (name (ns-name %))) (all-ns))]
-      (gather-tests-from-ns queue n))
+    (dorun
+      (pmap
+        #(gather-tests-from-ns queue %)
+        (filter #(re-matches ns-re (name (ns-name %))) (all-ns))))
     queue))

 (defn prioritize-test [[test-var _ _ :as test-run] mapped-results]


Bump org.omcljs/om dependency to 1.0.0-alpha46

--- build.boot
+++ build.boot
@@ -25,7 +25,7 @@
                  [inflections "0.12.2"]
                  [org.clojure/clojure "1.9.0-alpha11"]
                  [org.clojure/clojurescript "1.9.229"]
-                 [org.omcljs/om "1.0.0-alpha45"]
+                 [org.omcljs/om "1.0.0-alpha46"]
                  [org.clojure/data.json "0.2.6"]

                  ;; Development dependencies


Bump up version

Bump up version

--- build.boot
+++ build.boot
@@ -6,7 +6,7 @@

 (require '[adzerk.bootlaces :refer :all])

-(def +version+ "0.0-3308-0")
+(def +version+ "1.0-SNAPSHOT")

 (bootlaces! +version+)


Whitespace

Whitespace

--- build.boot
+++ build.boot
@@ -198,16 +198,20 @@
   []
   (comp (with-pass-thru _ (println "======= Testing clj"))
         (test :platform     :clj)
+
         (with-pass-thru _ (println "======= Testing cljs | browser"))
         (test :platform     :cljs
               :target       :browser)
+
         (with-pass-thru _ (println "======= Testing cljs | browser | advanced"))
         (test :platform     :cljs
               :target       :browser
               :opt          :advanced)
+
         (with-pass-thru _ (println "======= Testing cljs | node"))
         (test :platform     :cljs
               :target       :nodejs)
+
         (with-pass-thru _ (println "======= Testing cljs | node | self-hosted"))
         (test :platform     :cljs
               :target       :nodejs


72 unit tests

72 unit tests

--- spec/ralang/core_spec.clj
+++ spec/ralang/core_spec.clj
@@ -106,8 +106,8 @@
         (def e [:token [:variable [:varID [:datatype "Float"] [:id "speed"]] [:expr [:num [:float "32.5"]]]]])
         (should= e (parser "Float speed = 32.5")))
     (it "parser: String variable"
-        (def e [:token [:variable [:varID [:datatype "String"] [:id "name"]] [:expr [:num [:string "Daniel"]]]]])
-        (should= e (parser "String name = \"Daniel\"")))
+        (def e [:token [:variable [:varID [:datatype "String"] [:id "name"]] [:expr [:num [:string "leString"]]]]])
+        (should= e (parser "String name = \"leString\"")))
     (it "parser: New function with 0 args and returns Void"
         (def e [:token [:function [:funcname [:id "leFunction"]] [:tuple] [:datatype "Void"]]])
         (should= e (parser "function leFunction() -> Void:")))
@@ -323,6 +323,30 @@
         (should= e (parser "if leVariable > raVariable:")))
     (it "parser: If Variable is different from another Variable"
         (def e [:token [:keyword [:if [:boolexpr [:expr [:varName "leVariable"]] [:booloper [:ne]] [:expr [:varName "raVariable"]]]]]])
-        (should= e (parser "if leVariable != raVariable:"))))
+        (should= e (parser "if leVariable != raVariable:")))
+    (it "parser: Else"
+        (should= [:token [:keyword [:else]]] (parser "else:")))
+    (it "parser: Return an Int"
+        (should= [:token [:keyword [:return [:expr [:num [:int "68"]]]]]] (parser "return 68")))
+    (it "parser: Return an Float"
+        (should= [:token [:keyword [:return [:expr [:num [:float "68.8"]]]]]] (parser "return 68.8")))
+    (it "parser: Return an String"
+        (should= [:token [:keyword [:return [:string "\"leString\""]]]] (parser "return \"leString\"")))
+    (it "parser: Return the result of adding 2 Ints together"
+        (should= [:token [:keyword [:return [:expr [:add [:num [:int "65"]] [:num [:int "9"]]]]]]] (parser "return 65+9")))
+    (it "parser: Return the result of function call"
+        (def e [:token
+               [:keyword
+               [:return
+               [:expr
+                    [:mul
+                        [:varName "n"]
+                        [:funccall [:id "factorial"]
+                            [:callargs
+                                [:expr
+                                    [:sub
+                                        [:varName "n"]
+                                        [:num [:int "1"]]]]]]]]]]])
+        (should= e (parser "return n*factorial(n-1)"))))

 (run-specs)


performance improvement

performance improvement

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@9382 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/SlideExplorer2/src/slide_explorer/view.clj
+++ plugins/SlideExplorer2/src/slide_explorer/view.clj
@@ -1,11 +1,16 @@
 (ns slide-explorer.view
   (:import (javax.swing AbstractAction JComponent JFrame JPanel JLabel KeyStroke)
-           (java.awt Color Graphics Graphics2D RenderingHints Window)
+           (java.awt Color Graphics Graphics2D Rectangle RenderingHints Window)
            (java.util UUID)
            (java.awt.event ComponentAdapter MouseAdapter WindowAdapter)
            (org.micromanager.utils GUIUpdater))
   (:use [org.micromanager.mm :only (edt)]
         [slide-explorer.image :only (crop overlay lut-object)]))
+
+(defmacro timer [expr]
+  `(let [ret# (time ~expr)]
+     (println '~expr)
+     ret#))

 ;; tile/pixels

@@ -95,8 +100,6 @@
   (bind-window-key window "F" #(full-screen! window))
   (bind-window-key window "ESCAPE" #(full-screen! nil)))

-
-
 (defn enable-anti-aliasing
   ([^Graphics g]
     (enable-anti-aliasing g true))
@@ -107,22 +110,36 @@
                          (if on
                            RenderingHints/VALUE_ANTIALIAS_ON
                            RenderingHints/VALUE_ANTIALIAS_OFF)))))
-
-(defn paint-tiles [^Graphics2D g available-tiles zoom]
+
+(defn draw-image [g image x y clip-bounds]
+  (let [image-rect (Rectangle. x y 512 512)]
+    (if (.intersects image-rect clip-bounds)
+      (do ;(println "drawn")
+          (.drawImage g image x y nil))
+      ;(println "not drawn")
+      )))
+
+(defn paint-tiles [^Graphics2D g available-tiles zoom clip-bounds [tile-width tile-height]]
+  ;(println "paint-tiles")
+  ;(println (System/currentTimeMillis))
+  ;(timer
   (doseq [[{:keys [nx ny nz nt nc]} image] (get available-tiles zoom)]
-    (let [[x y] (tile-to-pixels [nx ny] [512 512] zoom)]
-      (when image
-        (.drawImage g image
-                    x y nil)))))
+    (when image
+      (let [[x y] (tile-to-pixels [nx ny] [tile-width tile-height] zoom)]
+        (draw-image g image x y clip-bounds)
+          ))
+    ;)
+    ))

 (defn paint-screen [graphics screen-state available-tiles]
   (let [original-transform (.getTransform graphics)]
     (doto graphics
+      (.setClip 0 0 (:width @screen-state) (:height @screen-state))
       (.translate (+ (:x @screen-state) (/ (:width @screen-state) 2))
                   (+ (:y @screen-state) (/ (:height @screen-state) 2)))
       ;(.rotate @angle)
       enable-anti-aliasing
-      (paint-tiles @available-tiles (:zoom @screen-state))
+      (paint-tiles @available-tiles (:zoom @screen-state) (.getClipBounds graphics) [512 512])
       (.setColor Color/YELLOW)
       (.fillOval -30 -30
                  60 60)


add 1 more to colspan for assignment column

--- src/cljs/early_vote_site/early_vote_site_detail/views.cljs
+++ src/cljs/early_vote_site/early_vote_site_detail/views.cljs
@@ -32,7 +32,7 @@
       [:tbody
         (if (seq schedules)
           (map schedule->row schedules)
-          [:tr [:td {:colSpan 4} "No Schedules"]])]]))
+          [:tr [:td {:colSpan 5} "No Schedules"]])]]))

 (defn main-panel []
   (let [early-vote-site @(re-frame/subscribe [:selected-early-vote-site])]


Fix (#866)

Fix (#866)

--- src/cljs/main/broadfcui/page/groups/groups_management.cljs
+++ src/cljs/main/broadfcui/page/groups/groups_management.cljs
@@ -90,7 +90,7 @@
                [CreateGroupDialog
                 {:on-success #(this :-load-data)}]))}]])}}])
    :-delete-group
-   (fn [{:keys [state]}]
+   (fn [{:keys [state this]}]
      (swap! state assoc :deleting? true :delete-modal? nil)
      (endpoints/call-ajax-orch
       {:endpoint (endpoints/delete-group (:group-name @state))


Fix demand calculation

Fix demand calculation

We have to consider the demand for all skills and not just the demand
for skills that have been allocated some bundles.

--- src/baustellen.clj
+++ src/baustellen.clj
@@ -43,7 +43,7 @@
 (defn demand-met? [[site-k site-alloc] static-data]
   (and (some? site-alloc)
        (zero? (apply + (map #(demand {site-k site-alloc} [site-k %] static-data)
-                            (keys site-alloc))))))
+                            (keys (get-in static-data [:sites site-k :skills])))))))

 (defn indiv-alloc-brutto-payoff [[site-k site-alloc :as alloc] static-data]
   (if (demand-met? alloc static-data)


Change accounting for hierarchical refinements

--- src/edu/berkeley/ai/angelic/hierarchies/abstract_lookahead_trees.clj
+++ src/edu/berkeley/ai/angelic/hierarchies/abstract_lookahead_trees.clj
@@ -405,7 +405,6 @@

 (defmethod search/immediate-refinements ::ALTPlanNode [node]
   (util/timeout)
-  (util/sref-up! search/*ref-counter* inc)
   (let [urb         (search/upper-reward-bound node)
 	alt         (util/safe-get node :alt)
 	graph?      (util/safe-get alt :graph?)
@@ -418,6 +417,7 @@
 			       true))))
      ;; If ref-fn is correct, == when not fully primitive
    ;   (println "About to refine " (search/node-str node) " at " (hla-name (:hla ref-node)))
+      (util/sref-up! search/*ref-counter* inc)
       (let [was-tight?  (and (contains? #{true :full} graph?)
 			 (or (util/safe-get ^ref-node :was-tight?)
 			     (> (valuation-max-reward (pessimistic-valuation ref-node))


fix(resources): Create project if not exists on run POST - added test

--- src/integration/clojure/com/xebia/visualreview/itest/upload_test.clj
+++ src/integration/clojure/com/xebia/visualreview/itest/upload_test.clj
@@ -32,8 +32,7 @@
                 :timeStamp "2015-02-19T16:34:12"})

 (defn setup-projects []
-  (api/put-project! {:name project-name-1})
-  (api/put-project! {:name project-name-2}))
+  (api/put-project! {:name project-name-1}))

 (use-fixtures :each mock/logging-fixture mock/rebind-db-spec-fixture mock/setup-screenshot-dir-fixture mock/setup-db-fixture mock/test-server-fixture)

@@ -41,11 +40,18 @@

   (setup-projects)

+  (testing "There is one test project"
+    (let [projects (:body (api/get-projects))]
+      (is (= [{:id 1 :name project-name-1}] projects))))
+
+  (testing "Create run creates a project"
+    (is (= 201 (:status (-> (api/post-run! project-name-2 suite-name))))))
+
   (testing "There are two test projects"
     (let [projects (:body (api/get-projects))]
       (is (= [{:id 1 :name project-name-1} {:id 2 :name project-name-2}] projects))))

-  (testing "There are no runs or screenshots yet"
+  (testing "There are no runs or screenshots yet for project 1"
     (is (= 404 (:status (api/get-runs project-name-1 suite-name))) "Not found status"))

   (let [run-id (-> (api/post-run! project-name-1 suite-name) :body :id)]


Make tf-idf-document use transducers to mutably create array of tf-idf values.

--- project/analyze-data/src/analyze_data/tf_idf/core.clj
+++ project/analyze-data/src/analyze_data/tf_idf/core.clj
@@ -37,13 +37,20 @@
   [all-terms inverse-document-frequency term-document]
   (let [term-frequencies (normalized-term-frequency term-document)
         calc-tf-idf #(* (get term-frequencies % 0.0)
-                        (get inverse-document-frequency % 0.0))]
-    (m/sparse-array (map calc-tf-idf all-terms))))
+                        (get inverse-document-frequency % 0.0))
+        indexed-tf-idf-values (eduction (map calc-tf-idf)
+                                        (map-indexed #(vector %1 %2))
+                                        (filter #(not= 0.0 (second %)))
+                                        all-terms)
+        array (m/new-sparse-array [(count all-terms)])
+        set-value (fn [[index value]] (m/mset! array index value))]
+    (run! set-value indexed-tf-idf-values)
+    array))
+

 (defn tf-idf
   "Calculates (term frequency * inverse document frequency) values for a
   corpus of documents.
-

   term-corpus: a sequence of term sequences. A term is a word, or bigram, or
                trigram, etc. Each term sequence should represent a single


Add middleware support for establishing database transactions.

--- src/sql_file/middleware.clj
+++ src/sql_file/middleware.clj
@@ -40,7 +40,17 @@
     (throw (RuntimeException. "No current database connection for query.")))
   *db*)

+(defn db []
+  (current-db-connection))
+
 (defn wrap-db-connection [ app db-connection ]
   (fn [ req ]
     (call-with-db-connection (fn [] (app req)) db-connection)))

+(defn call-with-db-transaction [ fn ]
+  (jdbc/with-db-transaction [ txn (current-db-connection) ]
+    (binding [ *db* txn ]
+      (fn))))
+
+(defmacro with-db-transaction [ & body ]
+  `(call-with-db-transaction (fn [] ~@body)))


length check (140 characters should be enough for anybody)

--- src/statuses/views/main.clj
+++ src/statuses/views/main.clj
@@ -107,9 +107,19 @@
 (defpage "/statuses/updates/:id" {:keys [id]}
   (update-page (core/get-update @db (Integer/parseInt id))))

+(def max-length 140)
+
+(defpage "/statuses/too-long/:length" {:keys [length]}
+  (common/layout
+   (str "Sorry, the maximum lenght is " max-length " but you tried " length " characters")
+   (nav-links)))
+
 (defpage [:post "/statuses/updates"] {:keys [text reply-to]}
-  (swap! db core/add-update (user) text (parse-num reply-to nil))
-  (redirect "/statuses"))
+  (let [length (.length text)]
+    (if (<= length max-length)
+      (do (swap! db core/add-update (user) text (parse-num reply-to nil))
+          (redirect "/statuses"))
+      (redirect (str "/statuses/too-long/" length)))))

 (defpage "/statuses/info" []
   (let [item (fn [header content] (list [:tr [:td header] [:td content]]))]


Add test for mapping from 8 to 4 elements.

--- test/dsbdp/test/processing_fn_utils_tests.clj
+++ test/dsbdp/test/processing_fn_utils_tests.clj
@@ -77,3 +77,9 @@
         expected [1 1 1 1]]
     (is (= expected (calculate-distribution-mapping in-seq ratios)))))

+(deftest calculate-distribution-mapping-8-to-4-test
+  (let [in-seq (repeat 8 nil)
+        ratios [0.25 0.25 0.25 0.25]
+        expected [2 2 2 2]]
+    (is (= expected (calculate-distribution-mapping in-seq ratios)))))
+


Take add. arg in section-component

Take add. arg in section-component

--- app/src/cljs/app/components.cljs
+++ app/src/cljs/app/components.cljs
@@ -1,20 +1,24 @@
 (ns app.components)

 (defn section-component
-  [content]
+  [content header]
   [:div.singlecard
    [:div.mdl-card.mdl-shadow--2dp.ressection
-    content]])
+    [:div.sectionheader
+     [:h3 header]]
+    [:div.sectioncontent
+     content]]])
+
+

 (defn about-component
   [description]
   [:div#about
    [section-component
     [:div.about
-     [:div.aboutheader
-      [:h3 "Profile"]]
      [:div.aboutdescription
-      description]]]])
+      description]]
+    "About"]])

 (defn navlink-component
   "navigation link component.
@@ -40,7 +44,7 @@
    [section-component
     [:div.contact
      [:div.contactname
-      [:h3 name]]
+      [:h4 name]]
      [:div.contactphonemail.mdl-grid
       [:div.mdl-cell.mdl-cell--4-col
        [:i.material-icons "phone"]]
@@ -50,7 +54,8 @@
       [:div.mdl-cell.mdl-cell--4-col
        [:p phone]]
       [:div.mdl-cell.mdl-cell--4-col
-       [:p email]]]]]])
+       [:p email]]]]
+    "Contact"]])

 (defn single-project-component
   [project]


Use run! to clean up how health bars are updated

--- dungeon-crawler/desktop/src-common/dungeon_crawler/core.clj
+++ dungeon-crawler/desktop/src-common/dungeon_crawler/core.clj
@@ -7,6 +7,8 @@
             [play-clj.core :refer :all]
             [play-clj.g2d :refer :all]
             [play-clj.ui :refer :all]))
+
+(declare dungeon-crawler main-screen npc-health-screen overlay-screen)

 (defonce manager (asset-manager))
 (set-asset-manager! manager)
@@ -52,10 +54,16 @@
             (e/create-ogres 20)]
            flatten
            (reduce #(e/randomize-locations screen %1 %2) []))))
+
   :on-render
   (fn [screen entities]
     (clear!)
     (let [me (u/get-player entities)]
+      ; update health bars
+      (->> (some #(if (= (:id %) (:mouse-npc-id screen)) %) entities)
+           (run! npc-health-screen :on-update-health-bar :entity))
+      (run! overlay-screen :on-update-health-bar :entity me)
+      ; run game logic
       (->> entities
            (map (fn [entity]
                   (->> entity
@@ -67,9 +75,11 @@
            play-sounds!
            (render-sorted! screen u/sort-entities ["walls"])
            (update-screen! screen))))
+
   :on-resize
   (fn [screen entities]
     (height! screen u/vertical-tiles))
+
   :on-touch-down
   (fn [{:keys [input-x input-y button] :as screen} entities]
     (when (= button (button-code :right))
@@ -77,33 +87,38 @@
             victim (u/get-entity-at-cursor screen entities input-x input-y)
             victim (when (u/can-attack? me victim) victim)]
         (e/attack screen me victim entities))))
+
   :on-mouse-moved
   (fn [{:keys [input-x input-y] :as screen} entities]
-    (if (u/get-entity-at-cursor screen entities input-x input-y)
-      (input! :set-cursor-image (:attack-cursor screen) 0 0)
-      (input! :set-cursor-image nil 0 0))))
+    (let [e (u/get-entity-at-cursor screen entities input-x input-y)]
+      (input! :set-cursor-image (if e (:attack-cursor screen) nil) 0 0)
+      (update! screen :mouse-npc-id (:id e))
+      nil)))

 (defscreen npc-health-screen
   :on-show
   (fn [screen entities]
     (shape :filled))
+
   :on-render
   (fn [screen entities]
-    (when-let [e (u/get-entity-at-cursor (-> main-screen :screen deref)
-                                         (-> main-screen :entities deref)
-                                         (game :x)
-                                         (game :y))]
+    ; draw on main-screen so we can use its coordinate system
+    (draw! (-> main-screen :screen deref) entities))
+
+  ; custom function that is invoked in main-screen
+  :on-update-health-bar
+  (fn [screen entities]
+    (if-let [e (:entity screen)]
       (let [bar-x (:x e)
             bar-y (+ (:y e) (:height e))
             bar-w (:width e)
             pct (/ (:health e) (+ (:health e) (:wounds e)))]
-        (->> (shape (first entities)
-                    :set-color (color :red)
-                    :rect bar-x bar-y bar-w u/npc-bar-h
-                    :set-color (color :green)
-                    :rect bar-x bar-y (* bar-w pct) u/npc-bar-h)
-             vector
-             (draw! (-> main-screen :screen deref)))))))
+        (shape (first entities)
+               :set-color (color :red)
+               :rect bar-x bar-y bar-w u/npc-bar-h
+               :set-color (color :green)
+               :rect bar-x bar-y (* bar-w pct) u/npc-bar-h))
+      (shape (first entities)))))

 (defscreen overlay-screen
   :on-show
@@ -119,27 +134,36 @@
      ; this is meant for testing particle effects
      (comment assoc (particle-effect "particles/fire.p")
             :id :particle)])
+
   :on-render
   (fn [screen entities]
     (->> (for [entity entities]
            (case (:id entity)
              :fps (doto entity (label! :set-text (str (game :fps))))
-             :bar (let [me (u/get-player (-> main-screen :entities deref))
-                        pct (/ (:health me) (+ (:health me) (:wounds me)))]
-                    (shape entity
-                           :set-color (color :red)
-                           :rect 0 0 u/bar-w u/bar-h
-                           :set-color (color :green)
-                           :rect 0 0 u/bar-w (* u/bar-h pct)))
              entity))
          (render! screen)))
+
   :on-resize
   (fn [screen entities]
     (height! screen 300)
     (for [e entities]
       (case (:id e)
         :particle (assoc e :x (width screen) :y 0)
-        e))))
+        e)))
+
+  ; custom function that is invoked in main-screen
+  :on-update-health-bar
+  (fn [screen entities]
+    (for [entity entities]
+      (case (:id entity)
+        :bar (let [me (:entity screen)
+                   pct (/ (:health me) (+ (:health me) (:wounds me)))]
+               (shape entity
+                      :set-color (color :red)
+                      :rect 0 0 u/bar-w u/bar-h
+                      :set-color (color :green)
+                      :rect 0 0 u/bar-w (* u/bar-h pct)))
+        entity))))

 (defgame dungeon-crawler
   :on-create


moves loop working

moves loop working

--- src/tenbytenbot/tactics.clj
+++ src/tenbytenbot/tactics.clj
@@ -6,22 +6,13 @@

-(defn play [board slot-nums debug]
+(defn play [board slot-nums step]
   "elects a move to perform"
   (let [slots (vec (map (fn [num] (get p/pieces num)) slot-nums))]

-    (when debug
-      (println "----")
-      (doseq [[i slot] (map-indexed vector slots)]
-        (println (str "\n" i ":"))
-        (m/mprint slot)))
-
-    (let [pos [0 0]
-          slot-index 0
+    (let [pos [(* step 3) 0]
+          slot-index step
           slot (get slots slot-index)]
-
-      (when debug
-        (println (str "\nabout to play " slot-index " on " pos "...")))

       { :slot slot
         :slot-index slot-index
@@ -31,23 +22,42 @@

 (defn go []
   "play a tenbyten game"
-  (let [debug true
-        board (m/mcreate [10 10])
-        ng (io/new-game)]
+  (let [verbose true
+        debug true]

-    (when debug
-      (println ng))
+    (loop [board (m/mcreate [10 10])
+           state (io/new-game)]

-    (let [p (play board (:slots ng) debug)
-          [x y] (:pos p)]
+      (when debug
+        (println "server state:")
+        (println state))

-      (let [r (io/play (:id ng) (:step ng) (:slot-index p) x y)
-            board2 (m/glue board (:slot p) (:pos p))]
-        (when debug
-          (println r)
-          (println)
-          (m/mprint (:slot p))
-          (println)
-          (m/mprint board2))
+      (when verbose
+        (println)
+        (m/mprint board)
+        (println))

-        ))))
+      (let [move (play board (:slots state) (:step state))
+            [x y] (:pos move)]
+
+        (when verbose
+          (println (str "About to play slot #" (:slot-index move) " on pos " x ", " y ))
+
+          (when (:slot move)
+            (println)
+            (m/mprint (:slot move))
+            (println)))
+
+        (let [new-board (try
+                          (m/glue board (:slot move) (:pos move))
+                          (catch Exception ex
+                            ;(println ex)
+                            (println "invalid move!")
+                            nil))]
+
+          (if (nil? new-board)
+            nil
+            (let [new-state (io/play (:id state) (:step state) (:slot-index move) x y)]
+              (if (:err new-state)
+                (println (:err new-state))
+                (recur new-board new-state)))))))))


Upgrade karma to 4.3.0

Upgrade karma to 4.3.0

--- src/deps.cljs
+++ src/deps.cljs
@@ -4,7 +4,7 @@
                 "react-dom"          "16.8.6"}

  :npm-dev-deps {"shadow-cljs"           "2.8.52"
-                "karma"                 "4.2.0"
+                "karma"                 "4.3.0"
                 "karma-chrome-launcher" "3.1.0"
                 "karma-cljs-test"       "0.1.0"
                 "karma-junit-reporter"  "1.2.0"}}


blog order

blog order


DGE matrix algorithms take care of ld.

DGE matrix algorithms take care of ld.

--- test/uncomplicate/neanderthal/examples/codingthematrix/ch02_test.clj
+++ test/uncomplicate/neanderthal/examples/codingthematrix/ch02_test.clj
@@ -8,10 +8,10 @@

 (facts
  "2.1 What is a Vector?"
- (let [v (dv 3.14159 2.718281828 -1.0 2.0)]
+ (let [v (dv 3.14159 2.718281828 -1.0 2.0)]
    (dim v) => 4
    (vect? v ) => true
-
+
    (ifn? v) => true
    (v 0) => (entry v 0)
    (v 1) => (entry v 1)
@@ -102,7 +102,7 @@

  (let [haystack (dv 1 -1 1 1 1 -1 1 1 1)
        needle (dv 1 -1 1 1 -1 1)]
-   (map #(dot (segment haystack % (dim needle)) needle)
+   (map #(dot (subvector haystack % (dim needle)) needle)
         (range (inc (- (dim haystack) (dim needle)))))
    => [2.0 2.0 0.0 0.0]))

@@ -118,4 +118,3 @@
 (facts "2.10.4 Printing vectors"
        (pr-str (dv 2 3 4))
        => "#<DoubleBlockVector| n:3, stride:1 (2.0 3.0 4.0)>")
-


Change an error message

Change an error message

--- src/whisper2cyanite/cli.clj
+++ src/whisper2cyanite/cli.clj
@@ -25,7 +25,7 @@
    ["-R" "--rollups ROLLUPS"
     "Define rollups. Format: <seconds_per_point[:retention],...> Example: 60,300:31536000"
     :parse-fn #(parse-rollups %)
-    :validate [check-rollups "Invalid rollup"]]
+    :validate [check-rollups "Invalid rollup(s)"]]
    ["-j" "--jobs JOBS" "Number of jobs to run simultaneously"
     :parse-fn #(Integer/parseInt %)
     :validate [#(< 0 %) "Must be a number > 0"]]


make the initial chat go all of the way to the top

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -15,8 +15,7 @@
   (reify
     om/IInitState
     (init-state [_]
-      {:listener-key (.getNextUniqueId (.getInstance IdGenerator))
-       :mount-time (js/Date.)})
+      {:listener-key (.getNextUniqueId (.getInstance IdGenerator))})
     om/IDidMount
     (did-mount [_]
       (d/listen! (om/get-shared owner :db)
@@ -46,7 +45,7 @@
             dummy-chat {:chat/body "Welcome to Precursor! Right-click on the canvas to access tools and share your url to collaborate."
                         :chat/color "#00b233"
                         :session/uuid "Danny"
-                        :server/timestamp (om/get-state owner :mount-time)}]
+                        :server/timestamp (js/Date. 0)}]
         (html
          [:section.aside-chat
           [:div.chat-messages {:ref "chat-messages"}


Don't let the future pool hang around so long [IMMUTANT-7]

--- support/build-support/src/main/clojure/immutant/build/tools.clj
+++ support/build-support/src/main/clojure/immutant/build/tools.clj
@@ -27,6 +27,9 @@
   (:require [clojure.contrib.lazy-xml :as lazy-xml])
   (:require [org.satta.glob :as glob])
   (:use [clojure.pprint :only [pprint]]))
+
+;; short-circuit the future pool so we don't have to wait 60s for it to exit
+(.setKeepAliveTime clojure.lang.Agent/soloExecutor 100 java.util.concurrent.TimeUnit/MILLISECONDS)

 (defn unzip [zip-file dest-dir]
   (let [result (shell/sh "unzip" "-q" "-d" (str dest-dir) zip-file)]


Added in better character names and icons.

--- src-browser/simplestrat/core.cljs
+++ src-browser/simplestrat/core.cljs
@@ -28,23 +28,25 @@
 (defn makestartingcharacters []
   [
    (world/create-character
-    {:charactername "Angry monster" :id 1 :iconindex 128 :coords [5 4] :team :team2 :starthealth 2
-     :actions [(action/createmoveaction "crawl" 1 1) (action/createmajoraction "bite" 1 1 1)]})
+    {:charactername "Angry Red Monster" :id 1 :iconindex 128 :coords [5 4] :team :team2 :starthealth 2
+     :actions [(action/createmoveaction "waddle" 1 1) (action/createmajoraction "bite" 1 1 1)
+               (action/createmajoraction "flame" 1 1 2)]})
    (world/create-character
-    {:charactername "Angry monster" :id 2 :iconindex 129 :coords [7 4] :team :team2 :starthealth 3
+    {:charactername "Gold Demon" :id 2 :iconindex 131 :coords [7 4] :team :team2 :starthealth 3
      :actions [(action/createmoveaction "crawl" 1 1) (action/createmajoraction "spew" 1 1 1)]})
    (world/create-character
-    {:charactername "Angry monster" :id 3 :iconindex 132 :coords [5 6] :team :team2 :starthealth 2
-     :actions [(action/createmoveaction "crawl" 1 1) (action/createmajoraction "bite" 1 1 1)]})
+    {:charactername "Orange Golem" :id 3 :iconindex 129 :coords [5 6] :team :team2 :starthealth 5
+     :actions [(action/createmoveaction "stomp" 1 1) (action/createmajoraction "punch" 1 1 1)]})
+
    (world/create-character
-    {:charactername "Moe" :id 4 :iconindex 130 :coords [3 3] :team :team1 :starthealth 2
-     :actions [(action/createmoveaction "walk" 1 1) (action/createmajoraction "punch" 1 1 1)]})
+    {:charactername "Knight" :id 4 :iconindex 160 :coords [3 3] :team :team1 :starthealth 5
+     :actions [(action/createmoveaction "walk" 1 1) (action/createmajoraction "sword" 1 1 1)]})
    (world/create-character
-    {:charactername "Shemp" :id 5 :iconindex 191 :coords [3 5] :team :team1 :starthealth 2
+    {:charactername "Guy with Gun" :id 5 :iconindex 191 :coords [2 4] :team :team1 :starthealth 2
      :actions [(action/createmoveaction "walk" 26 1) (action/createmajoraction "shoot" 1 3 1)]})
    (world/create-character
-    {:charactername "Curly" :id 6 :iconindex 184 :coords [3 4] :team :team1 :starthealth 2
-     :actions [(action/createmoveaction "walk" 1 1) (action/createmajoraction "punch" 1 1 1)]})
+    {:charactername "A Wizard Did It" :id 6 :iconindex 162 :coords [3 5] :team :team1 :starthealth 2
+     :actions [(action/createmoveaction "walk" 1 1) (action/createmajoraction "lightning" 1 1 1)]})
    ])

 (defn addstartingcharacters [gamestate]
@@ -52,7 +54,7 @@
     (reduce world/put-character gamestate characters)))

 (defn makestartingstate []
-  (let [gamemap (world/makestartingmap {:width 10 :height 10})
+  (let [gamemap (world/makestartingmap {:width 8 :height 8})
         emptygamestate (world/makeemptygamestate)]
     (-> emptygamestate
         (assoc :map gamemap)
@@ -92,7 +94,7 @@
 ;;

 (defn createjsstartgame []
-  (repl/connect "http://localhost:9000/repl")
+  #_(repl/connect "http://localhost:9000/repl")
   (renderer/initializerenderer "target")

   ;; the preloader loads all the assets and then calls startgame


Minor cleanup.

Minor cleanup.

--- src-cljs/githubcomments/core.cljs
+++ src-cljs/githubcomments/core.cljs
@@ -27,7 +27,8 @@
   (go (let [element (dom/getElement "github-comments")
             repo [(dataset/get element "repositoryOwner")
                   (dataset/get element "repositoryName")]
-            response (async/<! (repo-comments repo))]
-        (display-comments (rendered-comments repo (:body response)) element))))
+            response (async/<! (repo-comments repo))
+            comments (rendered-comments repo (:body response))]
+        (display-comments comments element))))

 (init)


order jars by group_name, jar_name and only show one version

--- src/clojars/db.clj
+++ src/clojars/db.clj
@@ -113,9 +113,6 @@
           (group :group_name :jar_name)
           (order :created :desc)
           (limit 5)))
-
-(defn browse-jars []
-  (select jars (order :jar_name :asc)))

 (defn jar-exists [groupname jarname]
   (-> (exec-raw
@@ -144,6 +141,17 @@
                                  :version version}))
                     (order :created :desc)
                     (limit 1)))))
+
+(defn latest-jars []
+  (select jars
+          (modifier "distinct")
+          (fields :group_name :jar_name)
+          (order :group_name :asc)
+          (order :jar_name :asc)
+          (limit 20)))
+
+(defn browse-jars []
+  (map #(find-jar (:group_name %) (:jar_name %)) (latest-jars)))

 (defn add-user [email username password ssh-key]
   (insert users


service config 0.x -> 3.x

service config 0.x -> 3.x

--- src/cljs/swarmpit/component/service/create_config.cljs
+++ src/cljs/swarmpit/component/service/create_config.cljs
@@ -2,7 +2,6 @@
   (:require [material.icon :as icon]
             [material.component :as comp]
             [material.component.form :as form]
-            [material.component.panel :as panel]
             [swarmpit.component.mixin :as mixin]
             [swarmpit.component.state :as state]
             [swarmpit.component.message :as message]
@@ -121,63 +120,125 @@
       (when (<= 1.30 (state/get-value [:docker :api]))
         (configs/configs-handler))
       ;(placement/placement-handler)
-      ;(labels/labels-handler)
+      (labels/labels-handler)
       (settings/tags-handler repository))))

 (rum/defc form-settings < rum/static []
-  [:div.form-layout-group
-   (form/subsection "General settings")
-   (settings/form false)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "General")
+    (settings/form false)))

 (rum/defc form-ports < rum/static []
-  [:div.form-layout-group.form-layout-group-border
-   (form/section-add "Ports" ports/add-item)
-   (ports/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Ports"
+      (comp/button
+        {:color   "primary"
+         :onClick ports/add-item}
+        (comp/svg icon/add-small) "Add port"))
+    (ports/form)))

 (rum/defc form-networks < rum/static []
-  [:div.form-layout-group.form-layout-group-border
-   (form/section-add "Networks" networks/add-item)
-   (networks/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Networks"
+      (comp/button
+        {:color   "primary"
+         :onClick networks/add-item}
+        (comp/svg icon/add-small) "Add network"))
+    (networks/form)))

 (rum/defc form-mounts < rum/static []
-  [:div.form-layout-group.form-layout-group-border
-   (form/section-add "Mounts" mounts/add-item)
-   (mounts/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Mounts"
+      (comp/button
+        {:color   "primary"
+         :onClick mounts/add-item}
+        (comp/svg icon/add-small) "Add mount"))
+    (mounts/form)))

 (rum/defc form-secrets < rum/reactive []
-  [:div.form-layout-group.form-layout-group-border
-   (form/section-add "Secrets" secrets/add-item)
-   (secrets/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Secrets"
+      (comp/button
+        {:color   "primary"
+         :onClick secrets/add-item}
+        (comp/svg icon/add-small) "Add secret"))
+    (secrets/form)))

 (rum/defc form-configs < rum/reactive []
-  [:div.form-layout-group.form-layout-group-border
-   (form/section-add "Configs" configs/add-item)
-   (configs/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Configs"
+      (comp/button
+        {:color   "primary"
+         :onClick configs/add-item}
+        (comp/svg icon/add-small) "Add config"))
+    (configs/form)))

 (rum/defc form-variables < rum/static []
-  [:div.form-layout-group.form-layout-group-border
-   (form/section-add "Environment Variables" variables/add-item)
-   (variables/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Environment variables"
+      (comp/button
+        {:color   "primary"
+         :onClick variables/add-item}
+        (comp/svg icon/add-small) "Add variable"))
+    (variables/form)))

 (rum/defc form-labels < rum/static []
-  [:div.form-layout-group.form-layout-group-border
-   (form/section-add "Labels" labels/add-item)
-   (labels/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Labels"
+      (comp/button
+        {:color   "primary"
+         :onClick labels/add-item}
+        (comp/svg icon/add-small) "Add label"))
+    (labels/form)))

 (rum/defc form-logdriver < rum/static []
-  [:div.form-layout-group.form-layout-group-border
-   (form/subsection "Logging")
-   (logdriver/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Logging")
+    (logdriver/form)))

 (rum/defc form-resources < rum/static []
-  [:div.form-layout-group.form-layout-group-border
-   (form/subsection "Resources")
-   (resources/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Resources")
+    (resources/form)))

 (rum/defc form-deployment < rum/static []
-  [:div.form-layout-group.form-layout-group-border
-   (form/subsection "Deployment")
-   (deployment/form)])
+  (comp/grid
+    {:item true
+     :xs   12}
+    (form/section
+      "Deployment")
+    ;(deployment/form)
+    ))

 (rum/defc form < rum/reactive
                  mixin-init-form [_]
@@ -191,130 +252,18 @@
           (comp/paper
             {:className "Swarmpit-paper Swarmpit-form-context"
              :elevation 0}
-
             (comp/grid
               {:container true
                :spacing   40}
-              (comp/grid
-                {:item true
-                 :xs   12}
-                (form/section
-                  "General")
-                (settings/form false))
-              (comp/grid
-                {:item true
-                 :xs   12}
-                (form/section
-                  "Ports"
-                  (comp/button
-                    {:color   "primary"
-                     :onClick ports/add-item}
-                    (comp/svg icon/add-small) "Add port"))
-                (ports/form))
-              (comp/grid
-                {:item true
-                 :xs   12}
-                (form/section
-                  "Networks"
-                  (comp/button
-                    {:color   "primary"
-                     :onClick networks/add-item}
-                    (comp/svg icon/add-small) "Add network"))
-                (networks/form))
-              (comp/grid
-                {:item true
-                 :xs   12}
-                (form/section
-                  "Mounts"
-                  (comp/button
-                    {:color   "primary"
-                     :onClick mounts/add-item}
-                    (comp/svg icon/add-small) "Add mount"))
-                (mounts/form))
-              (comp/grid
-                {:item true
-                 :xs   12}
-                (form/section
-                  "Secrets"
-                  (comp/button
-                    {:color   "primary"
-                     :onClick secrets/add-item}
-                    (comp/svg icon/add-small) "Add secret"))
-                (secrets/form))
-
+              (form-settings)
+              (form-ports)
+              (form-networks)
+              (form-mounts)
+              (form-secrets)
               (when (<= 1.30 (state/get-value [:docker :api]))
-                (comp/grid
-                  {:item true
-                   :xs   12}
-                  (form/section
-                    "Configs"
-                    (comp/button
-                      {:color   "primary"
-                       :onClick configs/add-item}
-                      (comp/svg icon/add-small) "Add config"))
-                  (configs/form)))
-
-
-
-
-              ;(comp/grid
-              ;  {:item true
-              ;   :xs   12
-              ;   :sm   6}
-              ;  (comp/typography
-              ;    {:variant      "h6"
-              ;     :gutterBottom true} "IPAM")
-              ;  (section-ipam item))
-              ;(comp/grid
-              ;  {:item true
-              ;   :xs   12}
-              ;  (comp/typography
-              ;    {:variant      "h6"
-              ;     :gutterBottom true} "Driver")
-              ;  (section-driver item plugins))
-              )
-
-            )
-
-
-          ;(form-settings)
-
-          ;(form-ports)
-          ;(form-networks)
-          ;(form-mounts)
-          ;(form-secrets)
-          ;(when (<= 1.30 (state/get-value [:docker :api]))
-          ;  (form-configs))
-          ;(form-variables)
-          ;(form-labels)
-          ;(form-logdriver)
-          ;(form-resources)
-          ;(form-deployment)
-
-          ]]))))
-
-
-;[:div
-; [:div.form-panel
-;  [:div.form-panel-left
-;   (panel/info icon/services "New service")]
-;  [:div.form-panel-right
-;   (comp/progress-button
-;     {:label      "Create"
-;      :disabled   (or (not (:valid? settings-state))
-;                      (not (:valid? resources-state)))
-;      :primary    true
-;      :onTouchTap create-service-handler} processing?)]]
-; [:div.form-layout
-;  (form-settings)
-;  (form-ports)
-;  (form-networks)
-;  (form-mounts)
-;  (form-secrets)
-;  (when (<= 1.30 (state/get-value [:docker :api]))
-;    (form-configs))
-;  (form-variables)
-;  (form-labels)
-;  (form-logdriver)
-;  (form-resources)
-;  (form-deployment)]]+                (form-configs))
+              (form-variables)
+              (form-labels)
+              (form-logdriver)
+              (form-resources)
+              (form-deployment)))]]))))


adding ability to take players collection from command line

--- src/cartagena/console.clj
+++ src/cartagena/console.clj
@@ -93,6 +93,10 @@
       (perform-action no-action game-state))))

 (defn -main
-  "Calls the function to get the number of players... goes on from there"
+  "Calls the function to get the number of players... goes on from there
+
+  The list of players should be input as a single string containing the vector of player maps with name values escaped."
   [& args]
-  (prompt-action (engine/new-game! [{:name "tanya" :color :orange} {:name "rusty" :color :black}])))
+  (if args
+    (prompt-action (engine/new-game! (read-string (first args))))
+    (prompt-action (engine/new-game! [{:name "tanya" :color :orange} {:name "rusty" :color :black}]))))


Add TODO re: rendering performance

Add TODO re: rendering performance

--- src/app/cljs/one/repmax/view.cljs
+++ src/app/cljs/one/repmax/view.cljs
@@ -10,6 +10,8 @@
   when rendering views."}
   snippets (snippets/snippets))

+;; TODO Time this approach (i.e., "Scorched Earth") versus hiding/showing
+;;      *existing* list items after a search
 (defn- render-exercise-list [exercises]
   (let [content (xpath "//div[@id='exercise-list']/ol")]
     (d/destroy-children! content)


fix drag off board

fix drag off board

--- src/chessground/drag.cljs
+++ src/chessground/drag.cljs
@@ -35,7 +35,7 @@
   (let [piece (.-target event)
         orig (.-parentNode piece)
         dest (.-dropzone event)]
-    (-> dest .-classList (.remove drag-over-class))
+    (when dest (-> dest .-classList (.remove drag-over-class)))
     (-> piece .-classList (.remove dragging-class))
     (when-let [orig-key (common/square-key orig)]
       (if (and dest (= (.-parentNode orig) (.-parentNode dest)))


only keep the param names when storing :method-params instead of the entire param AST

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -640,7 +640,7 @@
              :protocol-inline (:protocol-inline init-expr)
              :variadic (:variadic init-expr)
              :max-fixed-arity (:max-fixed-arity init-expr)
-             :method-params (map :params (:methods init-expr))
+             :method-params (map #(vec (map :name (:params %))) (:methods init-expr))
              :methods (map (fn [method]
                              (let [tag (infer-tag env (assoc method :op :method))]
                                (cond-> (select-keys method


fix `cljs.analyzer/confirm-var-exists` so that occurences `cljs.core/Foo.bar` do not emit warnings - we now correctly check for `cljs.core/Foo`

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -293,12 +293,17 @@
   (contains? '#{goog goog.object goog.string goog.array Math} prefix))

 (defn confirm-var-exists [env prefix suffix]
-  (when (and (not (implicit-import? env prefix suffix))
-             (not (and (not (get-in @env/*compiler* [::namespaces prefix]))
-                       (or (get (:requires (:ns env)) prefix)
-                           (get (:imports (:ns env)) prefix))))
-             (not (get-in @env/*compiler* [::namespaces prefix :defs suffix])))
-    (warning :undeclared-var env {:prefix prefix :suffix suffix})))
+  (let [sufstr (str suffix)
+        suffix (symbol
+                 (if (re-find #"\." sufstr)
+                   (first (string/split sufstr #"\."))
+                   suffix))]
+    (when (and (not (implicit-import? env prefix suffix))
+               (not (and (not (get-in @env/*compiler* [::namespaces prefix]))
+                         (or (get (:requires (:ns env)) prefix)
+                             (get (:imports (:ns env)) prefix))))
+               (not (get-in @env/*compiler* [::namespaces prefix :defs suffix])))
+      (warning :undeclared-var env {:prefix prefix :suffix suffix}))))

 (defn resolve-ns-alias [env name]
   (let [sym (symbol name)]


children re-added, children multimethod removed

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -773,13 +773,18 @@
         else-expr (analyze env else)]
     {:env env :op :if :form form
      :test test-expr :then then-expr :else else-expr
-     :unchecked @*unchecked-if*}))
+     :unchecked @*unchecked-if*
+     :children [test-expr then-expr else-expr]}))

 (defmethod parse 'throw
   [op env [_ throw :as form] name]
   (let [throw-expr (disallowing-recur (analyze (assoc env :context :expr) throw))]
     {:env env :op :throw :form form
-     :throw throw-expr}))
+     :throw throw-expr
+     :children [throw-expr]}))
+
+(defn- block-children [{:keys [statements ret]}]
+  (conj (vec statements) ret))

 (defmethod parse 'try*
   [op env [_ & body :as form] name]
@@ -813,7 +818,9 @@
      :try try
      :finally finally
      :name mname
-     :catch catch}))
+     :catch catch
+     :children (vec (mapcat block-children
+                            [try catch finally]))}))

 (defmethod parse 'def
   [op env form name]
@@ -872,7 +879,8 @@
               :name name :doc doc :init init-expr}
              (when tag {:tag tag})
              (when dynamic {:dynamic true})
-             (when export-as {:export export-as})))))
+             (when export-as {:export export-as})
+             (when init-expr {:children [init-expr]})))))

 (defn- analyze-fn-method [env locals meth]
   (letfn [(uniqify [[p & r]]
@@ -918,11 +926,14 @@
     {:env env :op :fn :form form :name mname :methods methods :variadic variadic
      :recur-frames *recur-frames* :loop-lets *loop-lets*
      :jsdoc [(when variadic "@param {...*} var_args")]
-     :max-fixed-arity max-fixed-arity}))
+     :max-fixed-arity max-fixed-arity
+     :children (vec (mapcat block-children
+                            methods))}))

 (defmethod parse 'do
   [op env [_ & exprs :as form] _]
-  (merge {:env env :op :do :form form} (analyze-block env exprs)))
+  (let [block (analyze-block env exprs)]
+    (merge {:env env :op :do :form form :children (block-children block)} block)))

 (defn analyze-let
   [encl-env [_ bindings & exprs :as form] is-loop]
@@ -954,7 +965,9 @@
                                *loop-lets* (cons {:names (vec (map :name bes))} *loop-lets*))]
           (analyze-block (assoc env :context (if (= :expr context) :return context)) exprs))]
     {:env encl-env :op :let :loop is-loop
-     :bindings bes :statements statements :ret ret :form form}))
+     :bindings bes :statements statements :ret ret :form form
+     :children (into (vec (map :init bes))
+                     (conj (vec statements) ret))}))

 (defmethod parse 'let*
   [op encl-env form _]
@@ -967,13 +980,15 @@
 (defmethod parse 'recur
   [op env [_ & exprs :as form] _]
   (let [context (:context env)
-        frame (first *recur-frames*)]
+        frame (first *recur-frames*)
+        exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs)))]
     (assert frame "Can't recur here")
     (assert (= (count exprs) (count (:names frame))) "recur argument count mismatch")
     (reset! (:flag frame) true)
     (assoc {:env env :op :recur :form form}
       :frame frame
-      :exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs))))))
+      :exprs exprs
+      :children exprs)))

 (defmethod parse 'quote
   [_ env [_ x] _]
@@ -985,7 +1000,8 @@
    (let [enve (assoc env :context :expr)
          ctorexpr (analyze enve ctor)
          argexprs (vec (map #(analyze enve %) args))]
-     {:env env :op :new :form form :ctor ctorexpr :args argexprs})))
+     {:env env :op :new :form form :ctor ctorexpr :args argexprs
+      :children (into [ctorexpr] argexprs)})))

 (defmethod parse 'set!
   [_ env [_ target val alt :as form] _]
@@ -1019,7 +1035,8 @@
        (assert targetexpr "set! target must be a field or a symbol naming a var")
        (cond
         (= targetexpr ::set-unchecked-if) {:env env :op :no-op}
-        :else {:env env :op :set! :form form :target targetexpr :val valexpr})))))
+        :else {:env env :op :set! :form form :target targetexpr :val valexpr
+               :children [targetexpr valexpr]})))))

 (defmethod parse 'ns
   [_ env [_ name & args :as form] _]
@@ -1168,12 +1185,14 @@
      (case dot-action
            ::access {:env env :op :dot :form form
                      :target targetexpr
-                     :field field}
+                     :field field
+                     :children [targetexpr]}
            ::call   (let [argexprs (map #(analyze enve %) args)]
                       {:env env :op :dot :form form
                        :target targetexpr
                        :method method
-                       :args argexprs})))))
+                       :args argexprs
+                       :children (into [targetexpr] argexprs)})))))

 (defmethod parse 'js*
   [op env [_ jsform & args :as form] _]
@@ -1189,7 +1208,7 @@
            enve (assoc env :context :expr)
            argexprs (vec (map #(analyze enve %) args))]
        {:env env :op :js :segs (seg jsform) :args argexprs
-        :tag (-> form meta :tag) :form form}))
+        :tag (-> form meta :tag) :form form :children argexprs}))
     (let [interp (fn interp [^String s]
                    (let [idx (.indexOf s "~{")]
                      (if (= -1 idx)
@@ -1215,7 +1234,7 @@
            (warning env
              (str "WARNING: Wrong number of args (" argc ") passed to " name)))))
      {:env env :op :invoke :form form :f fexpr :args argexprs
-      :tag (-> fexpr :info :tag)})))
+      :tag (-> fexpr :info :tag) :children (into [fexpr] argexprs)})))

 (defn analyze-symbol
   "Finds the var associated with sym"
@@ -1283,20 +1302,21 @@
         ks (disallowing-recur (vec (map #(analyze expr-env % name) (keys form))))
         vs (disallowing-recur (vec (map #(analyze expr-env % name) (vals form))))]
     (analyze-wrap-meta {:op :map :env env :form form
-                        :keys ks :vals vs :simple-keys? simple-keys?}
+                        :keys ks :vals vs :simple-keys? simple-keys?
+                        :children (vec (interleave ks vs))}
                        name)))

 (defn analyze-vector
   [env form name]
   (let [expr-env (assoc env :context :expr)
         items (disallowing-recur (vec (map #(analyze expr-env % name) form)))]
-    (analyze-wrap-meta {:op :vector :env env :form form :items items} name)))
+    (analyze-wrap-meta {:op :vector :env env :form form :items items :children items} name)))

 (defn analyze-set
   [env form name]
   (let [expr-env (assoc env :context :expr)
         items (disallowing-recur (vec (map #(analyze expr-env % name) form)))]
-    (analyze-wrap-meta {:op :set :env env :form form :items items} name)))
+    (analyze-wrap-meta {:op :set :env env :form form :items items :children items} name)))

 (defn analyze-wrap-meta [expr name]
   (let [form (:form expr)]
@@ -1305,14 +1325,16 @@
             expr (assoc-in expr [:env :context] :expr) ; change expr to :expr
             meta-expr (analyze-map (:env expr) (meta form) name)]
         {:op :meta :env env :form form
-         :meta meta-expr :expr expr})
+         :meta meta-expr :expr expr :children [meta-expr expr]})
       expr)))

 (defn analyze
   "Given an environment, a map containing {:locals (mapping of names to bindings), :context
   (one of :statement, :expr, :return), :ns (a symbol naming the
   compilation ns)}, and form, returns an expression object (a map
-  containing at least :form, :op and :env keys)."
+  containing at least :form, :op and :env keys). If expr has any (immediately)
+  nested exprs, must have :children [exprs...] entry. This will
+  facilitate code walking without knowing the details of the op set."
   ([env form] (analyze env form nil))
   ([env form name]
      (let [form (if (instance? clojure.lang.LazySeq form)
@@ -1483,84 +1505,6 @@
                  ns-info (compile-file cljs-file output-file)]
              (recur (rest cljs-files) (conj output-files (assoc ns-info :file-name (.getPath output-file)))))
            output-files)))))
-
-(defmulti children
-  "Returns the children [exprs..] of an expression object. This will
-   facilitate code walking without knowing the details of the op set."
-  :op)
-
-(defmethod children :if [ast]
-  [(:test ast) (:then ast) (:else ast)])
-
-(defmethod children :throw [ast]
-  [(:throw ast)])
-
-(defn- block-children [block]
-  (let [statements (when-let [statements (:statements block)]
-                     (vec statements))
-        ret (when-let [ret (:ret block)]
-              [ret])
-        children (into statements ret)]
-    (when-not (empty? children)
-      children)))
-
-(defmethod children :try* [ast]
-  (vec (mapcat block-children
-               [(:try ast)
-                (:catch ast)
-                (:finally ast)])))
-
-(defmethod children :def [ast]
-  (when-let [init (:init ast)]
-    [init]))
-
-(defmethod children :fn [ast]
-  (vec (mapcat block-children (:methods ast))))
-
-(defmethod children :do [ast]
-  (block-children ast))
-
-(defmethod children :let [ast]
-  (let [inits (vec (map :init (:bindings ast)))]
-    (into inits
-          (block-children ast))))
-
-(defmethod children :recur [ast]
-  (:exprs ast))
-
-(defmethod children :new [ast]
-  (into [(:ctor ast)]
-        (:args ast)))
-
-(defmethod children :set! [ast]
-  [(:target ast)
-   (:val ast)])
-
-(defmethod children :dot [ast]
-  (into [(:target ast)]
-        (:args ast)))
-
-(defmethod children :js [ast]
-  (vec (:args ast)))
-
-(defmethod children :invoke [ast]
-  (into [(:f ast)]
-        (:args ast)))
-
-(defmethod children :map [ast]
-  (vec (interleave (:keys ast) (:vals ast))))
-
-(defmethod children :vector [ast]
-  (:items ast))
-
-(defmethod children :set [ast]
-  (:items ast))
-
-(defmethod children :meta [ast]
-  [(:meta ast) (:expr ast)])
-
-(defmethod children :default [ast]
-  nil)

 (comment
   ;; compile-root


add parse-ns which just parses the ns portion of a file so that we can we return proper information for dependency analysis even for files that have not changed.

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -808,6 +808,24 @@
   (or (not (.exists dest))
       (> (.lastModified src) (.lastModified dest))))

+(defn parse-ns [src dest]
+  (with-core-cljs
+    (binding [ana/*cljs-ns* 'cljs.user]
+      (loop [forms (forms-seq src)]
+        (if (seq forms)
+          (let [env (ana/empty-env)
+                ast (ana/analyze env (first forms))]
+            (if (= (:op ast) :ns)
+              (let [ns-name (:name ast)
+                    deps    (merge (:uses ast) (:requires ast))]
+                {:ns (or ns-name 'cljs.user)
+                 :provides [ns-name]
+                 :requires (if (= ns-name 'cljs.core)
+                             (set (vals deps))
+                             (conj (set (vals deps)) 'cljs.core))
+                 :file dest})
+              (recur (rest forms)))))))))
+
 (defn compile-file
   "Compiles src to a file of the same name, but with a .js extension,
    in the src file's directory.
@@ -831,7 +849,7 @@
          (if (requires-compilation? src-file dest-file)
            (do (mkdirs dest-file)
                (compile-file* src-file dest-file))
-           {:file dest-file})
+           (parse-ns src-file dest-file))
          (throw (java.io.FileNotFoundException. (str "The file " src " does not exist.")))))))

 (comment


Implemented (partially) VarDecl Removed conflicting imports from x86

--- src/clj/minijava/tree.clj
+++ src/clj/minijava/tree.clj
@@ -125,7 +125,13 @@

 (defmethod tree minijava.ast.VarDecl
   [x frame]
-  (allocLocal frame (.name x) true))
+  (cond
+   (=  (.kind x) (.LOCAL minijava.ast.VarDecl$Kind))
+   (Statement  (allocLocal frame (.name x)  false))
+   (=  (.kind x)  (.FIELD minijava.ast.VarDecl$Kind))
+   (Statement nil) ;;we need to support classes before this can be figured out.
+   (=  (.kind x) (.FORMAL minijava.ast.VarDecl$Kind))
+   (Statement  nil))) ;;formals are allocated at frame creation (call) so this case does nothing (?)

 (defmethod tree minijava.ast.While
   [x frame]
@@ -141,4 +147,6 @@

 (defmethod tree minijava.ast.ArrayLookup
   [x frame]
-  (Mem (BinaryOp :+ (exp (lookup frame (.name x))) (-> x .index tree unEx))))
+  (Mem (BinaryOp :+ (exp (lookup frame (.name x)))
+                 (BinaryOp :* (Const 4)
+                           (-> x .index tree unEx)))))


no 500 on 404

no 500 on 404

--- src/clj/tictag/server.clj
+++ src/clj/tictag/server.clj
@@ -319,7 +319,8 @@
                                     :ERROR))]
       (trace resp)
       (if (or (= resp :ERROR)
-              (and (>= (:status resp) 500)
+              (and (number? (:status resp))
+                   (>= (:status resp) 500)
                    (< (:status resp) 600)))
         (do (error req resp)
             {:status 500


Turn REST status into an array

Turn REST status into an array

--- src/cljs/bartleby/db.cljs
+++ src/cljs/bartleby/db.cljs
@@ -2,5 +2,5 @@

 (def default-db
   "Default state"
-  {:rest ""
+  {:rest nil
    :tasks []})


Adds function to validate whether a piece can move - initial implementation is simply to check whose turn it is to move

--- src/cljs/chess/board.cljs
+++ src/cljs/chess/board.cljs
@@ -138,6 +138,16 @@
                :moves (conj moves [from-sq to-sq])}
               game))

+(defn can-move?
+  [{:keys [board moves]} fr]
+  (if-let [p (board (fr->i fr))]
+    (let [turn-colour (if (even? (count moves))
+                       :white
+                       :black)
+          piece-colour (colour p)]
+      (= turn-colour piece-colour))
+    false))
+
 (def new-game
   (let [a1 (fr->i "a1")
         a2 (fr->i "a2")


Added join, upper/lower-case, capitalize, and escape to cljs.string -- ref #47.

--- src/cljs/cljs/string.cljs
+++ src/cljs/cljs/string.cljs
@@ -1,5 +1,5 @@
 (ns cljs.string
-  ;; TODO get refer-clojure exclude working
+  ;; TODO pending refer-clojure exclude support
   #_(:refer-clojure :exclude [replace reverse])
   (:require [goog.string :as gstring]
             [goog.string.StringBuffer :as gstringbuf]))
@@ -17,13 +17,15 @@
       (when coll
         (.append sb (first coll))
         (recur (next coll))))
-    (str sb)))
+    (. sb (toString))))

-(defn- replace-by
-  [s re f])
+;; TODO all replace* functions pending regexp support
+#_(defn- replace-by
+    [s re f]
+    )

-(defn replace
-  "Replaces all instance of match with replacement in s.
+#_(defn replace
+    "Replaces all instance of match with replacement in s.

    match/replacement can be:

@@ -32,16 +34,16 @@
    pattern / (string or function of match).

    See also replace-first."
-  [s match replacement])
+    [s match replacement])

-(defn- replace-first-by
-  [s re f])
+#_(defn- replace-first-by
+    [s re f])

-(defn- replace-first-char
-  [s match replace])
+#_(defn- replace-first-char
+    [s match replace])

-(defn replace-first
-  "Replaces the first instance of match with replacement in s.
+#_(defn replace-first
+    "Replaces the first instance of match with replacement in s.

    match/replacement can be:

@@ -50,64 +52,106 @@
    pattern / (string or function of match).

    See also replace-all."
-  [s match replacement])
+    [s match replacement])

-(comment
+(defn join
+  "Returns a string of all elements in coll, as returned by (seq coll),
+   separated by an optional separator."
+  ([coll]
+     (apply str coll))
+  ([separator coll]
+     (apply str (interpose separator coll))))

-  (defn join
-    "Returns a string of all elements in coll, as returned by (seq coll),
-   separated by an optional separator."
-    ([coll])
-    ([separator coll]))
+(defn upper-case
+  "Converts string to all upper-case."
+  [s]
+  (. s (toUpperCase)))

-  (defn capitalize
-    "Converts first character of the string to upper-case, all other
+(defn lower-case
+  "Converts string to all lower-case."
+  [s]
+  (. s (toLowerCase)))
+
+(defn capitalize
+  "Converts first character of the string to upper-case, all other
   characters to lower-case."
-    [s])
+  [s]
+  (if (< (count s) 2)
+    (upper-case s)
+    (str (upper-case (subs s 0 1))
+         (lower-case (subs s 1)))))

-  (defn upper-case
-    "Converts string to all upper-case."
-    [s])
-
-  (defn lower-case
-    "Converts string to all lower-case."
-    [s])
-
-  (defn split
+;; TODO pending regexp support
+#_(defn split
     "Splits string on a regular expression.  Optional argument limit is
   the maximum number of splits. Not lazy. Returns vector of the splits."
     ([s re])
     ([s re limit]))

-  (defn split-lines
-    "Splits s on \\n or \\r\\n."
+#_(defn split-lines
+  "Splits s on \\n or \\r\\n."
+  [s])
+
+;; TODO all whitespace related functions pending regexp support
+#_(def whitespace)
+
+#_(defn triml
+    "Removes whitespace from the left side of string."
     [s])

-  (defn trim
+#_(defn trimr
+    "Removes whitespace from the right side of string."
+    [s])
+
+#_(defn trim
     "Removes whitespace from both ends of string."
     [s])

-  (defn triml
-    "Removes whitespace from the left side of string."
-    [s])
-
-  (defn trimr
-    "Removes whitespace from the right side of string."
-    [s])
-
-  (defn trim-newline
+#_(defn trim-newline
     "Removes all trailing newline \\n or return \\r characters from
   string.  Similar to Perl's chomp."
     [s])

-  (defn blank?
+#_(defn blank?
     "True if s is nil, empty, or contains only whitespace."
-    [s])
+    [s]
+    (if s
+      (loop [index (int 0)]
+        (if (= (.length s))
+          true
+          (if )))
+      true))

-  (defn escape
-    "Return a new string, using cmap to escape each character ch
+(defn escape
+  "Return a new string, using cmap to escape each character ch
    from s as follows:

    If (cmap ch) is nil, append ch to the new string.
    If (cmap ch) is non-nil, append (str (cmap ch)) instead."
-    [s cmap]))+  [s cmap]
+  (let [buffer (gstring/StringBuffer.)
+        length (.length s)]
+    (loop [index 0]
+      (if (= length index)
+        (. buffer (toString))
+        (let [ch (.charAt s index)]
+          (if-let [replacement (get cmap ch)]
+            (.append buffer (str replacement))
+            (.append buffer ch))
+          (recur (inc index)))))))
+
+(comment
+
+  ;; TODO pending regexp support
+  (defn escape1
+    "Is this a better implementation for JavaScript?"
+    [s cmap]
+    (loop [ret s
+           cm cmap]
+      (let [[ch replacement] (first cmap)
+            ret (.replace ret
+                          (re-pattern (str "/" ch "/g"))
+                          (str replacement))]
+        (if (next cm)
+          (recur ret (rest cm))
+          ret))))


issue #4 excercise display attempt

issue #4 excercise display attempt

--- src/cljs/hit_wl/core.cljs
+++ src/cljs/hit_wl/core.cljs
@@ -76,8 +76,10 @@
   [:tr
    (for [h headers]
      (do
-       (.log js/console (str  "table-row " (coll? (row h)) " "
-                              (sequential? (row h)) (get  (row h) 0) ) )
+       (comment  (.log js/console (str (for [a (row h)] ["." a])))
+                 (.log js/console (str  "table-row " (coll? (row h)) " "
+                                        (sequential? (row h))
+                                        ) ))
        [:td (if (coll? (row h))
                     (list-items (row h))
                     (str  (row h)))]))])


Add autofocus and on-keypress for enter

Add autofocus and on-keypress for enter

--- src/cljs/kanban/core.cljs
+++ src/cljs/kanban/core.cljs
@@ -29,8 +29,11 @@
     (if editing
       [:div.card.editing [:input {:type "text"
                                   :value title
+                                  :autoFocus true
                                   :on-change #(update-title card-cursor (.. % -target -value))
-                                  :on-blur #(stop-editing card-cursor)}]]
+                                  :on-blur #(stop-editing card-cursor)
+                                  :on-key-press #(if (= (.-charCode %) 13)
+                                                   (stop-editing card-cursor))}]]
       [:div.card {:on-click #(start-editing card-cursor)} title])))


Rename make-graph -> make-sparse-graph, add extra keys to the graph map for successors, predecessors, and p, q, r nodes

--- src/cljs/nchart/core.cljs
+++ src/cljs/nchart/core.cljs
@@ -152,14 +152,18 @@
                (rest input-groups))))))

-(defn make-graph
-  "Main entry point, kicks off processing of input groupings"
+(defn make-sparse-graph
+  "Creates a sparse graph, as defined in ESK"
   ([input]
-     (make-graph input
-                 {:layers []
-                  :edges []
-                  :last-nodes-by-character {}
-                  :last-nodes-by-node {}}))
+     (make-sparse-graph input
+                        {:layers []
+                         :succs {}
+                         :preds {}
+                         :p #{}
+                         :q #{}
+                         :r #{}
+                         :last-nodes-by-character {}
+                         :last-nodes-by-node {}}))
   ([input graph]
      (if (empty? input)
        graph


Add bracket accessors to Array instances

--- src/clojure_ruby/core.clj
+++ src/clojure_ruby/core.clj
@@ -76,11 +76,19 @@
                        (= (:data this) other)))}
    :host-methods {:string (fn string-host-string [this] (:data this))}})

+(defn create-array [cnt val]
+  {:data (atom (vec (repeat cnt val)))
+   :methods {"[]" (fn array-bracket [this idx]
+                    (let [idx (host-send idx :number)]
+                      (nth @(:data this) idx)))
+             "[]=" (fn array-bracket-assign [this idx val]
+                     (let [idx (host-send idx :number)]
+                       (swap! (:data this) assoc idx val)))}})
+
 (def Array
   {:methods {"new" (fn Array-new [this cnt val]
-                     (let [cnt (host-send cnt :number)
-                           val (host-send val :number)]
-                       (atom (vec (repeat cnt val)))))}})
+                     (let [cnt (host-send cnt :number)]
+                       (create-array cnt val)))}})

 (swap! variables assoc "Array" Array)


Added :skip to the translation of Plushy.

--- src/clojush/translate.clj
+++ src/clojush/translate.clj
@@ -164,21 +164,26 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Plushy translation

-(defn plushy-gene-to-plush-gene
-  "Used when reducing a Plushy genome to a Plush genome. Takes the Plush
-  genome so far and the next Plushy instruction."
-  [plush instruction]
-  (if (= instruction :close)
-    (if (empty? plush)
-      plush
-      (update-in plush [(dec (count plush)) :close] inc))
-    (conj plush {:instruction instruction :close 0})))
-
 (defn translate-plushy-to-plush
   "Translates Plushy genome into a Plush genome."
   [{:keys [genome]}]
-  (apply list
-         (reduce plushy-gene-to-plush-gene [] genome)))
+  (loop [genome genome
+         plush []]
+    (cond
+      (empty? genome) (apply list plush)
+      ;; :skip ignores the next gene
+      (= (first genome) :skip) (recur (drop 2 genome)
+                                      plush)
+      ;; if plush is empty, can't increment :close marker, so skip
+      (and (empty? plush)
+           (= (first genome) :close)) (recur (rest genome)
+                                             plush)
+      ;; :close adds to the close count of the previous gene
+      (= (first genome) :close) (recur (rest genome)
+                                       (update-in plush [(dec (count plush)) :close] inc))
+      ;; otherwise, just make a new instruction
+      :else (recur (rest genome)
+                   (conj plush {:instruction (first genome) :close 0})))))

 (defn population-translate-plushy-to-push
   "Converts the population of Plushy genomes into Push programs."