(PDB-3400) change varchar columns to text

Updates the varchar columns to text. I believe this should be fast
because varchar and text are binary coercible, but we'll need to verify
to be sure.

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1423,6 +1423,18 @@
      ON DELETE CASCADE;")

   {::vacuum-analyze #{"facts" "fact_values" "fact_paths"}})
+
+(defn varchar-columns-to-text []
+  (jdbc/do-commands
+    "alter table reports
+     alter column puppet_version type text,
+     alter column configuration_version type text"
+
+    "alter table resource_events
+     alter column status type text,
+     alter column property type text,
+     alter column containing_class type text,
+     alter column file type text"))

 (def migrations
   "The available migrations, as a map from migration version to migration function."
@@ -1465,7 +1477,8 @@
    61 add-latest-report-timestamp-to-certnames
    62 reports-partial-indices
    63 add-job-id
-   64 rededuplicate-facts})
+   64 rededuplicate-facts
+   65 varchar-columns-to-text})

 (def desired-schema-version (apply max (keys migrations)))


Fix glob

Fix glob

--- src/puppetlabs/trapperkeeper/config.clj
+++ src/puppetlabs/trapperkeeper/config.clj
@@ -71,7 +71,7 @@
     [path]
     (mapcat
       #(fs/glob (fs/file path %))
-      ["*.ini" "*.conf" "*.json" "*.properties" "*.edn" ".yaml" ".yml"])))
+      ["*.ini" "*.conf" "*.json" "*.properties" "*.edn" "*.yaml" "*.yml"])))

 (defn load-config
   "Given a path to a configuration file or directory of configuration files,


Fix alignment and status bar shifting

Fix alignment and status bar shifting

--- src/robinson/ui/components/robinson.clj
+++ src/robinson/ui/components/robinson.clj
@@ -190,14 +190,11 @@
           [:text {:style {:color infected-color}} ["\u2665"]]
           [:text {} [" "]]]]]])))

-    ;    (int (-> state :world :player :hp))
-    ;    (-> state :world :player :max-hp)
-    ;    (apply str (interpose " " (-> state :world :player :status)))
 (zc/def-component DblBarChart
   [this]
   (let [{:keys [fg-1 fg-2 p1 p2 width direction style]} (zc/props this)
-        root (* width (min p1 p2))
-        padding (* width (- 1 (max p1 p2)))
+        root (int (* width (min p1 p2)))
+        padding (int (* width (- 1 (max p1 p2))))
         diff (- width root padding)
         black-color (rcolor/color->rgb :black)]
       (case direction
@@ -256,7 +253,7 @@
   [this]
   (let [{:keys [game-state]} (zc/props this)]
     (zc/csx
-      [:view {:style {:top 20
+      [:view {:style {:top 21
                       :left 0
                       :width 80
                       :display :flex
@@ -264,7 +261,7 @@
          [Atmo {:time (rw/get-time game-state)
                 :atmo-data (get-in game-state [:data :atmo])}]
          [:view {} [
-           [HpWtlBars {:game-state game-state :style {:left 1}}]
+           [HpWtlBars {:game-state game-state}]
            [StatusUI {:wounded (rp/player-wounded? game-state)
                       :poisoned (rp/player-poisoned? game-state)
                       :infected (rp/player-infected? game-state)
@@ -889,7 +886,7 @@
                            :height 20
                            :position :fixed
                            :left 40
-                           :top 1
+                           :top 0
                            :padding 1
                            :display :flex
                            :flex-direction :column
@@ -911,7 +908,7 @@
                            :height 20
                            :position :fixed
                            :left 40
-                           :top 1
+                           :top 0
                            :padding 1
                            :background-color (rcolor/color->rgb :white)}} [
             [MultiSelect {:title "Inventory"
@@ -1055,7 +1052,7 @@
                             :height 20
                             :position :fixed
                             :left 40
-                            :top 1
+                            :top 0
                             :padding 1
                             :background-color (rcolor/color->rgb :white)}} [
              [MultiSelect {:title "Apply Inventory"
@@ -1069,7 +1066,7 @@
                             :height 20
                             :position :fixed
                             :left 40
-                            :top 1
+                            :top 0
                             :padding 1
                             :background-color (rcolor/color->rgb :white)}} [
              [MultiSelect {:title "Apply To"
@@ -1083,7 +1080,7 @@
                             :height 20
                             :position :fixed
                             :left 40
-                            :top 1
+                            :top 0
                             :padding 1
                             :background-color (rcolor/color->rgb :white)}} [
              [MultiSelect {:title "Quaff"
@@ -1098,7 +1095,7 @@
                             :height 20
                             :position :fixed
                             :left 40
-                            :top 1
+                            :top 0
                             :padding 1
                             :background-color (rcolor/color->rgb :white)}} [
              [MultiSelect {:title "Drop Inventory"
@@ -1112,7 +1109,7 @@
                             :height 20
                             :position :fixed
                             :left 40
-                            :top 1
+                            :top 0
                             :padding 1
                             :background-color (rcolor/color->rgb :white)}} [
              [MultiSelect {:title "Describe"
@@ -1127,7 +1124,7 @@
                             :height 20
                             :position :fixed
                             :left 40
-                            :top 1
+                            :top 0
                             :padding 1
                             :background-color (rcolor/color->rgb :white)}} [
              [MultiSelect {:title "Throw"
@@ -1140,7 +1137,7 @@
                             :height 20
                             :position :fixed
                             :left 40
-                            :top 1
+                            :top 0
                             :padding 1
                             :background-color (rcolor/color->rgb :white)}} [
              [MultiSelect {:title "Eat Inventory"
@@ -1209,7 +1206,7 @@
                            :height 20
                            :position :fixed
                            :left 40
-                           :top 1
+                           :top 0
                            :padding 1
                            :background-color (rcolor/color->rgb :white)}} [
             [MultiSelect {:title "Wield"
@@ -1223,7 +1220,7 @@
                            :height 20
                            :position :fixed
                            :left 40
-                           :top 1
+                           :top 0
                            :padding 1
                            :background-color (rcolor/color->rgb :white)}} [
             [MultiSelect {:title "Wield"
@@ -1385,7 +1382,7 @@
         log-color        (rcolor/darken-rgb (rcolor/color->rgb (get message :color)) darken-factor)]
     (zc/csx
         [:view {} [
-          [:text {:style {:position :fixed :top 1 :left 0}} [
+          [:text {:style {:position :fixed :top 0 :left 0}} [
             (if msg-above?
               (zc/csx [:text {} [
                         [Highlight {} ["/"]]
@@ -1494,7 +1491,7 @@
             (if-let [ui-hint (get-in game-state [:world :ui-hint])]
               ;; ui-hint
               (zc/csx [:view {} [
-                [:text {:style {:position :fixed :top 1 :left 1
+                [:text {:style {:position :fixed :top 0 :left 0
                                 :background-color [0 0 0 0]}} [
                           [:text {:style {:background-color [0 0 0]}} [ui-hint]]]]]])
               ;; regular concise message log
@@ -1583,13 +1580,15 @@
               [:view {:style {:color [255 255 255 255]
                               :background-color [0 0 0 0]
                               :position :fixed
-                              :top 20
+                              :top 18
                               :left 30}} [
                 [:text {} [
                   [:text {} ["Press "]]
                   [Highlight {}  ["space "]]
                   [:text {} ["to play"]]]]
-                [:text {} [[Highlight {} ["c"]] [:text  {} [" - configure"]]]]]]]]]]]]))
+                [:text {} [""]]
+                [:text {} [[Highlight {} ["c"]] [:text  {} [" - configure"]]]]
+                [:text {} [[Highlight {} ["q"]] [:text  {} [" - quit"]]]]]]]]]]]]))

 (zc/def-component Configure
   [this]


Add testcase: Update profile without current-password

--- test/clojars/test/integration/users.clj
+++ test/clojars/test/integration/users.clj
@@ -123,6 +123,13 @@
       (has (status? 200))
       (within [:div.error :ul :li]
               (has (text? "Current password is incorrect")))
+
+      (fill-in "New password" "newpassword")
+      (fill-in "Confirm new password" "newpassword")
+      (press "Update")
+      (has (status? 200))
+      (within [:div.error :ul :li]
+              (has (text? "Current password can't be blankCurrent password is incorrect")))

       (fill-in "Current password" "password")
       (fill-in "New password" "newpassword")


(maint) Remove duplicate import

(maint) Remove duplicate import

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -31,7 +31,6 @@
             [clojure.tools.logging :as log]
             [clojure.data :as data]
             [puppetlabs.puppetdb.scf.hash :as shash]
-            [puppetlabs.puppetdb.scf.storage-utils :as sutils]
             [schema.core :as s]
             [puppetlabs.puppetdb.schema :as pls :refer [defn-validated]]
             [puppetlabs.puppetdb.utils :as utils


(PDB-3639) Optimize existing-fact-values query

This was previously done with the text version of the value_hash column; it's
stored as bytea, so it required a conversion. Change the query to compare in the
bytea domain.

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -991,31 +991,31 @@
                                 :fact_path_id pid
                                 :fact_value_id vid})))

-(defn existing-row-ids
+(defn existing-fact-value-ids
   "Returns a map from value to id for each value that's already in the
    named database column."
-  [table column values]
-  (into {}
-        (for [{:keys [value id]}
-              (query-to-vec
-               (format
-                "WITH values AS (SELECT unnest(?) as vals)
-                   SELECT %s AS value, id FROM %s
-                   INNER JOIN values ON values.vals = %s"
-                column table column)
-               (sutils/array-to-param "text" String values))]
-          [value id])))
-
-(defn realize-records!
+  [vhashes]
+  (let [vhashes-param (sutils/array-to-param "bytea" PGobject
+                                             (map sutils/munge-hash-for-storage vhashes))
+        rows (query-to-vec "WITH new_hashes AS (SELECT unnest(?) as h)
+                              SELECT id, encode(value_hash::bytea, 'hex') value_hash FROM fact_values
+                              INNER JOIN new_hashes ON new_hashes.h = value_hash"
+                          vhashes-param)]
+    (->> rows
+         (map (fn [{:keys [value_hash id]}]
+                [value_hash id]))
+         (into {}))))
+
+(defn realize-fact-values!
   "Inserts the records (maps) into the named table and returns them
   with their new :id values."
-  [table munge-fn records]
+  [records]
   (when (seq records)
     (map #(assoc %1 :id %2)
          records
          (->> records
-              (map munge-fn)
-              (jdbc/insert-multi! table)
+              (map #(update % :value_hash sutils/munge-hash-for-storage))
+              (jdbc/insert-multi! :fact_values)
               (map :id)))))

 (defn realize-paths!
@@ -1048,19 +1048,18 @@

 (defn realize-values!
   "Ensures that all valuemaps exist in the database and returns a
-  map of value hashes to ids."
+  map of all value hashes to ids."
   [valuemaps]
   (if-let [valuemaps (seq valuemaps)]
     (let [vhashes (map :value_hash valuemaps)
-          existing-vhash-ids (existing-row-ids "fact_values"
-                                               (sutils/sql-hash-as-str "value_hash") vhashes)
+          existing-vhash-ids (existing-fact-value-ids vhashes)
           missing-vhashes (set/difference (set vhashes)
                                           (set (keys existing-vhash-ids)))]
       (into existing-vhash-ids
             (->> valuemaps
                  (filter (comp missing-vhashes :value_hash))
                  distinct
-                 (realize-records! :fact_values #(update % :value_hash sutils/munge-hash-for-storage))
+                 (realize-fact-values! )
                  (map #(vector (:value_hash %) (:id %))))))
     {}))


add blobs to retrieve blobs in a bucket; can generate signed urls and content streams

--- storage/src/clojure/gclouj/storage.clj
+++ storage/src/clojure/gclouj/storage.clj
@@ -1,15 +1,36 @@
 (ns gclouj.storage
   (:import [com.google.cloud AuthCredentials]
-           [com.google.cloud.storage StorageOptions Storage$BucketListOption Bucket]
-           [gclouj StorageOptionsFactory])
+           [com.google.cloud.storage StorageOptions Storage$BlobListOption Storage$BucketListOption Bucket Blob BlobId Storage$SignUrlOption Storage$BlobSourceOption]
+           [gclouj StorageOptionsFactory]
+           [java.util.concurrent TimeUnit]
+           [java.nio.channels Channels])
   (:require [clojure.java.io :as io]
-            [clj-time.coerce :as tc]))
+            [clj-time.coerce :as tc]
+            [clj-time.core :as tcc]))

 (defprotocol ToClojure
   (to-clojure [x]))

 (extend-protocol ToClojure
+  BlobId
+  (to-clojure [id] {:bucket (.bucket id)
+                    :name   (.name id)})
+  Blob
+  (to-clojure [blob] {:id                  (to-clojure (.blobId blob))
+                      :content-disposition (.contentDisposition blob)
+                      :content-encoding    (.contentEncoding blob)
+                      :content-language    (.contentLanguage blob)
+                      :content-type        (.contentType blob)
+                      :crc32c              (.crc32c blob)
+                      :generation          (.generation blob)
+                      :md5                 (.md5 blob)
+                      :metadata            (.metadata blob)
+                      :name                (.name blob)
+                      :bytes               (.size blob)
+                      :media-link          (.mediaLink blob)
+                      :updated-at          (tc/from-long (.updateTime blob))
+                      :directory           (.isDirectory blob)})
   Bucket
   (to-clojure [bucket] {:name          (.name bucket)
                         :created       (tc/from-long (.createTime bucket))
@@ -23,8 +44,27 @@
   ([] (.service (StorageOptions/defaultInstance)))
   ([^StorageOptions options] (.service options)))

-; storage.list().iterateAll()
+
 (defn buckets [service]
   (->> (.iterateAll (.list service (into-array Storage$BucketListOption [])))
        (iterator-seq)
        (map to-clojure)))
+
+(defn blobs [service bucket]
+  (->> (.iterateAll (.list service bucket (into-array Storage$BlobListOption [])))
+       (iterator-seq)
+       (map to-clojure)))
+
+
+(defn signed-url
+  "Generates a signed URL for the blob, valid for the length of the
+  period specified. Period should be a Joda
+  period,e.g.: (clj-time.core/minutes 5)"
+  [service {:keys [bucket name] :as blob-id} period]
+  (when-let [blob (.get service (BlobId/of bucket name))]
+    (.signUrl blob (tcc/in-seconds period) TimeUnit/SECONDS (into-array Storage$SignUrlOption []))))
+
+(defn content-stream
+  [service {:keys [bucket name] :as blob-id}]
+  (when-let [reader (.reader service (BlobId/of bucket name) (into-array Storage$BlobSourceOption []))]
+    (Channels/newInputStream reader)))


update metrics key to force string creation

--- kafka-clj/src/kafka_clj/pool/keyed.clj
+++ kafka-clj/src/kafka_clj/pool/keyed.clj
@@ -48,9 +48,14 @@
      v
      (get (add-keyed-pool ctx m-atom k pool-create-f) k))))

+(defn join-key [k]
+  (if (coll? k)
+    (clojure.string/join "/" k)
+    (str k)))
+
 (defn keyed-pool-stats [m-atom]
   (let [r-f (fn [state k apool]
-              (assoc state k (-pool-stats apool)))]
+              (assoc state (join-key k) (-pool-stats apool)))]
     (reduce-kv r-f {} @m-atom)))


Remove old tests that didn't do anything anyway

--- test.old/todo_repl_webapp/core_test.clj
+++ test.old/todo_repl_webapp/core_test.clj
@@ -1,7 +0,0 @@
-(ns todo-repl-webapp.core-test
-  (:require [clojure.test :refer :all]
-            [todo-repl-webapp.core :refer :all]))
-
-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))


Commas are not your friends

Commas are not your friends


Fix test.check times.

Fix test.check times.

--- test/onyx/log/generative_peer_join.clj
+++ test/onyx/log/generative_peer_join.clj
@@ -158,7 +158,7 @@
 (deftest balanced-task-balancing
   (checking
     "Checking Balanced allocation causes peers to be evenly over tasks"
-    50
+    (times 50)
     [{:keys [replica log peer-choices]}
      (log-gen/apply-entries-gen
        (gen/return


Make gen-key-test pass.

Make gen-key-test pass.

--- test/reforms/core/react_keys_test.cljs
+++ test/reforms/core/react_keys_test.cljs
@@ -11,20 +11,25 @@
     (-path [x]
       path)))

-(deftest
-  gen-key-test
+(extend-type default
+  IBinding
+  (-valid? [x]
+    false)
+  (-path [x]))
+
+(deftest gen-key-test
   (testing "given no args returns unique id"
-           (is (not= (gen-key) (gen-key))))
+    (is (not= (gen-key) (gen-key))))
   (testing "given nil args returns unique id"
-           (is (not= (gen-key nil nil) (gen-key nil nil))))
+    (is (not= (gen-key nil nil) (gen-key nil nil))))
   (testing "given strings joins them with hyphens"
-           (is (= "label-this-is-something") (gen-key "label" "this-is-something")))
+    (is (= "label-this-is-something") (gen-key "label" "this-is-something")))
   (testing "converts strings into lowercase identifiers"
-           (is (= "long-label-this--is-something") (gen-key "Long label" "This,?is-something")))
+    (is (= "long-label-this--is-something") (gen-key "Long label" "This,?is-something")))
   (testing "cursor, path and symbol"
-           (is (= "path1-path2" (gen-key [:path1 :path2])))
-           (is (= "path1-path2" (gen-key :path1 :path2)))
-           (is (= "foo-cursor-path-bar-path1-path2" (gen-key "foo"
-                                                             (make-cursor [:cursor :path])
-                                                             :bar
-                                                             [:path1 :path2])))))+    (is (= "path1-path2" (gen-key [:path1 :path2])))
+    (is (= "path1-path2" (gen-key :path1 :path2)))
+    (is (= "foo-cursor-path-bar-path1-path2" (gen-key "foo"
+                                                      (make-cursor [:cursor :path])
+                                                      :bar
+                                                      [:path1 :path2])))))


fix file leak in pom-properties-map

fix file leak in pom-properties-map

see https://github.com/boot-clj/boot/issues/138

--- boot/pod/src/boot/pod.clj
+++ boot/pod/src/boot/pod.clj
@@ -133,7 +133,8 @@
   (pom-prop-map
     (if (instance? Properties prop-or-jarpath)
       prop-or-jarpath
-      (doto (Properties.) (.load (io/input-stream prop-or-jarpath))))))
+      (with-open [pom-input-stream (io/input-stream prop-or-jarpath)]
+        (doto (Properties.) (.load pom-input-stream))))))

 (defn pom-xml
   [jarpath]


identify client in console

identify client in console

--- frontend/src/leftover/core.cljs
+++ frontend/src/leftover/core.cljs
@@ -20,6 +20,7 @@
 (def source-host (.. js/document -location -hostname))
 (def dev-mode (= "3449" source-port))
 (def unique-id (util/random-string 32))
+(util/log (str "Unique client id: " unique-id))

 (if dev-mode
   (def port "8000")


Remove gen-log

Remove gen-log

--- demo/klangdemo/core.cljs
+++ demo/klangdemo/core.cljs
@@ -71,7 +71,7 @@

 ;; Deref to generate logs
-@gen-logs
+;; @gen-logs

 (defonce gen (r/atom false))


make sections-for private

make sections-for private

--- src/open_company/resources/company.clj
+++ src/open_company/resources/company.clj
@@ -34,7 +34,7 @@
   [company]
   (set (cset/intersection common/section-names (set (keys company)))))

-(defn sections-for
+(defn- sections-for
   "Add a :sections key to given company containing category->ordered-sections mapping
   Only add sections to the ordered-sections list that are used in the company map"
   [company]


kibit

kibit

--- src/open_company/resources/company.clj
+++ src/open_company/resources/company.clj
@@ -160,8 +160,7 @@
 ;; ----- Create saveable company doc ----

 (defn real-sections [company]
-  (->> (select-keys company common/section-names)
-       (med/remove-vals :placeholder)))
+  (med/remove-vals :placeholder (select-keys company common/section-names)))

 (defn complete-real-sections
   [company user]


Default val

Default val

--- test/onyx/messaging/dummy_messenger.clj
+++ test/onyx/messaging/dummy_messenger.clj
@@ -14,5 +14,5 @@
   [messenger]
   {:address 1})

-(defmethod extensions/open-peer-site :dummy-messenger
+(defmethod extensions/open-peer-site :default
   [_ _] "localhost")


enforce position instant based ordering

enforce position instant based ordering

--- src/snap_spot/controllers/position.clj
+++ src/snap_spot/controllers/position.clj
@@ -25,7 +25,7 @@
 (defn send-past-positions [channel params]
   "send all past positions to websocket channel"
   (def positions (position/fetch-positions params))
-  (doseq [p (reverse positions)] (send-position channel p)))
+  (doseq [p (sort-by :instant > positions)] (send-position channel p)))

 (defn position-from-params [params]
   (def attrs [:lat :lon :instant])
@@ -62,7 +62,6 @@
                                :lon [v/required]
                                :instant [v/required]})

-(comment "need to enforce instant so that the positions stay ordered")
 (defn add [req]
   "update position for trip"
   (let [p (:params req)


refactor, use midje's fact wrapper macro

--- test/clojento/magento/db/t_products.clj
+++ test/clojento/magento/db/t_products.clj
@@ -13,76 +13,65 @@
 ; ------------------------------------------------------------------------------

 (facts "query product-entities"
-  (fact "get missing product(s)"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-entities conn {:product-ids [-1 -2]})) => [])
-  (fact "get product with id 1"
-        (with-open [conn (db/connection (:db @test-system))]
-          (first (db-products/product-entities conn {:product-ids [1]}))) => (just {:id 1 :sku "sku-1" :type "simple" :attribute-set 4 :date-created anything :date-updated anything}))
-  (fact "get multiple products"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-entities conn {:product-ids [1 2]})) => (just [(contains {:id 1})
-                                                                              (contains {:id 2})] :in-any-order)
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-entities conn {:product-ids [1 2 3]})) => (just [(contains {:id 1})
-                                                                                (contains {:id 2})
-                                                                                (contains {:id 3})] :in-any-order))
-  (fact "type of date-created"
-        (with-open [conn (db/connection (:db @test-system))]
-          (type (:date-created (first (db-products/product-entities conn {:product-ids [1]}))))) => org.joda.time.DateTime))
+  (with-state-changes [(around :facts (with-open [conn (db/connection (:db @test-system))] ?form))]
+    (fact "get missing product(s)"
+          (db-products/product-entities conn {:product-ids [-1 -2]}) => [])
+    (fact "get product with id 1"
+          (first (db-products/product-entities conn {:product-ids [1]})) => (just {:id 1 :sku "sku-1" :type "simple" :attribute-set 4 :date-created anything :date-updated anything}))
+    (fact "get multiple products"
+          (db-products/product-entities conn {:product-ids [1 2]}) => (just [(contains {:id 1})
+                                                                             (contains {:id 2})] :in-any-order)
+          (db-products/product-entities conn {:product-ids [1 2 3]}) => (just [(contains {:id 1})
+                                                                               (contains {:id 2})
+                                                                               (contains {:id 3})] :in-any-order))
+    (fact "type of date-created"
+          (type (:date-created (first (db-products/product-entities conn {:product-ids [1]})))) => org.joda.time.DateTime)))

 (facts "query product-websites"
-  (fact "get missing product(s)"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-websites conn {:product-ids [-1 -2]})) => [])
-  (fact "get product with id 1"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-websites conn {:product-ids [1]})) => (just [{:id 1 :website-id 1}
-                                                                            {:id 1 :website-id 2}] :in-any-order))
-  (fact "get multiple products"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-websites conn {:product-ids [1 2]})) => (just [{:id 1 :website-id 1}
-                                                                              {:id 1 :website-id 2}
-                                                                              {:id 2 :website-id 1}] :in-any-order)
-        (with-open [conn (db/connection (:db @test-system))]
-          (count (db-products/product-websites conn {:product-ids [3 2 1]}))) => 4))
+  (with-state-changes [(around :facts (with-open [conn (db/connection (:db @test-system))] ?form))]
+    (fact "get missing product(s)"
+          (db-products/product-websites conn {:product-ids [-1 -2]}) => [])
+    (fact "get product with id 1"
+          (db-products/product-websites conn {:product-ids [1]}) => (just [{:id 1 :website-id 1}
+                                                                           {:id 1 :website-id 2}] :in-any-order))
+    (fact "get multiple products"
+          (db-products/product-websites conn {:product-ids [1 2]}) => (just [{:id 1 :website-id 1}
+                                                                             {:id 1 :website-id 2}
+                                                                             {:id 2 :website-id 1}] :in-any-order)
+          (count (db-products/product-websites conn {:product-ids [3 2 1]})) => 4)))

 (facts "query product-stock"
-  (fact "get missing product"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-stock conn {:product-ids [-1]})) => [])
-  (fact "get product with id 1"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-stock conn {:product-ids [1]})) => (just [{:id 1 :website-id 1 :stock-id 1 :qty 2.0000M :stock-status 1}
-                                                                         {:id 1 :website-id 2 :stock-id 1 :qty 0.0000M :stock-status 0}] :in-any-order)))
+  (with-state-changes [(around :facts (with-open [conn (db/connection (:db @test-system))] ?form))]
+    (fact "get missing product"
+          (db-products/product-stock conn {:product-ids [-1]}) => [])
+    (fact "get product with id 1"
+          (db-products/product-stock conn {:product-ids [1]}) => (just [{:id 1 :website-id 1 :stock-id 1 :qty 2.0000M :stock-status 1}
+                                                                        {:id 1 :website-id 2 :stock-id 1 :qty 0.0000M :stock-status 0}] :in-any-order))))

 (facts "query product-attributes-varchar"
-  (fact "get missing product"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-attributes-varchar conn {:product-ids [-1]})) => [])
-  (fact "get product with id 1"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-attributes-varchar conn {:product-ids [1]})) => (just [{:id 1 :attribute-id 60 :store-id 0 :value "Simple Product 1"}
-                                                                                {:id 1 :attribute-id 71 :store-id 0 :value nil}
-                                                                                {:id 1 :attribute-id 73 :store-id 0 :value "This is the simple product with id 1"}] :in-any-order)))
+  (with-state-changes [(around :facts (with-open [conn (db/connection (:db @test-system))] ?form))]
+    (fact "get missing product"
+          (db-products/product-attributes-varchar conn {:product-ids [-1]}) => [])
+    (fact "get product with id 1"
+          (db-products/product-attributes-varchar conn {:product-ids [1]}) => (just [{:id 1 :attribute-id 60 :store-id 0 :value "Simple Product 1"}
+                                                                                {:id 1 :attribute-id 71 :store-id 0 :value nil}
+                                                                                {:id 1 :attribute-id 73 :store-id 0 :value "This is the simple product with id 1"}] :in-any-order))))

 (facts "query product-attributes-text"
-  (fact "get missing product"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-attributes-text conn {:product-ids [-1]})) => [])
-  (fact "get product with id 1"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-attributes-text conn {:product-ids [1]})) => (just [(contains {:id 1 :attribute-id 61 :store-id 0 :value anything})                   ; TODO h2 returns a org.h2.jdbc.JdbcClob, .toString == "This is the long description for product 1"
-                                                                                (contains {:id 1 :attribute-id 62 :store-id 0 :value anything})] :in-any-order))) ; TODO h2 returns a org.h2.jdbc.JdbcClob, .toString == "This is the short description for product 1"
+  (with-state-changes [(around :facts (with-open [conn (db/connection (:db @test-system))] ?form))]
+    (fact "get missing product"
+          (db-products/product-attributes-text conn {:product-ids [-1]}) => [])
+    (fact "get product with id 1"
+          (db-products/product-attributes-text conn {:product-ids [1]}) => (just [(contains {:id 1 :attribute-id 61 :store-id 0 :value anything})                   ; TODO h2 returns a org.h2.jdbc.JdbcClob, .toString == "This is the long description for product 1"
+                                                                                (contains {:id 1 :attribute-id 62 :store-id 0 :value anything})] :in-any-order)))) ; TODO h2 returns a org.h2.jdbc.JdbcClob, .toString == "This is the short description for product 1"

 (facts "query product-attributes-datetime"
-  (fact "get missing product"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-attributes-datetime conn {:product-ids [-1]})) => [])
-  (fact "get product with id 1"
-        (with-open [conn (db/connection (:db @test-system))]
-          (db-products/product-attributes-datetime conn {:product-ids [1]})) => (just [(contains {:id 1 :attribute-id 66 :store-id 1 :value anything})                   ; TODO checking dates
-                                                                                (contains {:id 1 :attribute-id 67 :store-id 1 :value anything})] :in-any-order))) ; TODO checking dates
+  (with-state-changes [(around :facts (with-open [conn (db/connection (:db @test-system))] ?form))]
+    (fact "get missing product"
+          (db-products/product-attributes-datetime conn {:product-ids [-1]}) => [])
+    (fact "get product with id 1"
+          (db-products/product-attributes-datetime conn {:product-ids [1]}) => (just [(contains {:id 1 :attribute-id 66 :store-id 1 :value anything})                   ; TODO checking dates
+                                                                                (contains {:id 1 :attribute-id 67 :store-id 1 :value anything})] :in-any-order)))) ; TODO checking dates

 ; ------------------------------------------------------------------------------


Correct `election_type` in `public_id` w/5.1 feeds

--- src/vip/data_processor/db/postgres.clj
+++ src/vip/data_processor/db/postgres.clj
@@ -163,7 +163,7 @@
               "VipObject.0.Election.*{1}.Date.*{1}")
         election-type (find-single-xml-tree-value
                        import-id
-                       "VipObject.0.Election.*{1}.ElectionType.*{1}")]
+                       "VipObject.0.Election.*{1}.ElectionType.*{1}.Text.*{1}")]
     {:date date
      :election-type election-type
      :state state


remove usage of dag_unify.core/merge

remove usage of dag_unify.core/merge

--- src/babel/lexiconfn.cljc
+++ src/babel/lexiconfn.cljc
@@ -457,10 +457,10 @@
     ;; MUSTDO: regenerate :serialized.

     (cache-serialization
-     (dag_unify.core/merge (dissoc-paths lexical-entry (list [:synsem :subcat :2]
-                                                             [:serialized]))
-            {:synsem {:subcat {:2 '()}}
-             :canary :tweet43})) ;; if the canary tweets, then the runtime is getting updated correctly.
+     (unifyc (dissoc-paths lexical-entry (list [:synsem :subcat :2]
+                                               [:serialized]))
+             {:synsem {:subcat {:2 '()}}
+              :canary :tweet43})) ;; if the canary tweets, then the runtime is getting updated correctly.

     lexical-entry) ;; the original transitive lexeme.


[core] Pull in clj.edn, .set/difference, .java.io

--- src/birdie_tell/core.clj
+++ src/birdie_tell/core.clj
@@ -8,7 +8,10 @@

   Each peer rereads its data regularly from a specified EDN data
   file. This data is arbitrary."
-  (:require [server.socket :as socket]
+  (:require [clojure.edn :as edn]
+            [clojure.set :refer [difference]]
+            [clojure.java.io :as io]
+            [server.socket :as socket]
             [cheshire.core :as cheshire]
             [clojure.edn :as edn]
             [clojure.string :as str]


Basic append/replace negative test.

Basic append/replace negative test.

--- src/cbfg/store-test.cljs
+++ src/cbfg/store-test.cljs
@@ -21,6 +21,10 @@
                   (e n (atake test (store/store-del test s 3 "does-not-exist" 0))
                      {:status :not-found, :key "does-not-exist", :opaque 3})
                   (e n (atake test (store/store-set test s 4 "does-not-exist" 0 "" :replace))
-                     {:status :not-found, :key "does-not-exist", :opaque 4}))
+                     {:status :not-found, :key "does-not-exist", :opaque 4})
+                  (e n (atake test (store/store-set test s 5 "does-not-exist" 0 "" :append))
+                     {:status :not-found, :key "does-not-exist", :opaque 5})
+                  (e n (atake test (store/store-set test s 6 "does-not-exist" 0 "" :replace))
+                     {:status :not-found, :key "does-not-exist", :opaque 6}))
            "pass"
            (str "FAIL: on test #" @n)))))


fixing path ;

fixing path ;

--- src/celestial/common.clj
+++ src/celestial/common.clj
@@ -8,7 +8,7 @@

 (def path
   (first (filter #(.exists (file %))
-    ["/etc/celestial.edn" (<< "~(System/getProperty \"user.home\")/.celestial.edn")])))
+    ["/etc/celestial/celestial.edn" (<< "~(System/getProperty \"user.home\")/.celestial.edn")])))

 (def config
    (if path


fix easing generator

fix easing generator

--- src/cljs/bardo/ease.cljs
+++ src/cljs/bardo/ease.cljs
@@ -96,22 +96,22 @@
                               (- t (/ 2.625 2.75)))
                            0.984375)))

-(def ease-fns {:linear identity
-               :quad quad
-               :cubic cubic
+(def ease-fns {:linear (constantly identity)
+               :quad (constantly quad)
+               :cubic (constantly cubic)
                :poly poly
-               :sine sine
-               :circle circle
-               :exp exp
-               :elastic elastic
-               :back back
-               :bounce bounce})
+               :sine (constantly sine)
+               :circle (constantly circle)
+               :exp (constantly exp)
+               :elastic (constantly elastic)
+               :back (constantly back)
+               :bounce (constantly bounce)})

 (defn ease
   [key & args]
-  (let [[fn start end] (map keyword (split (name key) "-"))
-        ease-fn (or (get ease-fns fn)
+  (let [[fn start end] (split (name key) "-")
+        ease-fn (or (get ease-fns (keyword fn))
                     identity)
-        mode (or (get modes (join "-" [start end]))
+        mode (or (get modes (keyword (join "-" [start end])))
                  identity)]
-    (comp clamp node (apply ease-fn args))))
+    ((comp clamp mode) (apply ease-fn args))))


Allow to move item back with shift+tab

Allow to move item back with shift+tab

--- src/cljs/notes/core.cljs
+++ src/cljs/notes/core.cljs
@@ -11,8 +11,6 @@
               [clojure.string :as string]
               [om.dom :as dom :include-macros true]))

-(def TAB_KEY 9)
-(def ENTER_KEY 13)
 (defn now [] (new js/Date))
 (def custom-formatter (time-format/formatter "dd/MM/yyyy"))
 (def app-title (str "Notes " (time-format/unparse custom-formatter (time-core/date-time (.getFullYear (now)) (+ 1 (.getMonth (now))) (.getDate (now))))))
@@ -29,11 +27,55 @@
   (if (== 0 tab) content
     (reduce (fn [res _] (dom/ul nil res)) content (range 0 tab))))

+(def code->key
+  "map from a character code (read from events with event.which)
+  to a string representation of it.
+  Only need to add 'special' things here."
+  {13 "enter"
+   9  "tab"
+   37 "left"
+   38 "up"
+   39 "right"
+   40 "down"
+   46 "del"
+   186 ";"})
+
+(defn event-modifiers
+  "Given a keydown event, return the modifier keys that were being held."
+  [e]
+  (into [] (filter identity [(if (.-shiftKey e) "shift")
+                             (if (.-altKey e) "alt")
+                             (if (.-ctrlKey e) "ctrl")
+                             (if (.-metaKey e) "meta")])))
+
+(def mod-keys
+  "A vector of the modifier keys that we use to compare against to make
+  sure that we don't report things like pressing the shift key as independent events.
+  This may not be desirable behavior, depending on the use case, but it works for
+  what I need."
+  [;; shift
+   (js/String.fromCharCode 16)
+   ;; ctrl
+   (js/String.fromCharCode 17)
+   ;; alt
+   (js/String.fromCharCode 18)
+   ])
+
+(defn event->key
+  "Given an event, return a string like 'up' or 'shift+l' or 'ctrl+;'
+  describing the key that was pressed.
+  This fn will never return just 'shift' or any other lone modifier key."
+  [event]
+  (let [mods (event-modifiers event)
+        which (.-which event)
+        key (or (code->key which) (.toLowerCase (js/String.fromCharCode which)))]
+    (if (and key (not (empty? key)) (not (some #{key} mod-keys)))
+      (string/join "+" (conj mods key)))))
+
 (defn handle-new-note-keydown [e app owner]
-  (js/console.log (str (== (.-which e) 9)))
-  (let [pressed-key (.-which e)]
-  (case (str pressed-key)
-    "13"
+  (let [code (event->key e)]
+  (case code
+    "enter"
     (do
       (let [new-field (om/get-node owner "newNote")]
       (when-not (string/blank? (.. new-field -value trim))
@@ -46,10 +88,14 @@
             [:create new-note]))
         (set! (.-value new-field) "")))
         false)
-    "9" (do
-      (js/console.log "El Tab!")
+    "tab" (do
       (om/transact! app :tab
         #(+ % 1)
+        [:tab nil])
+      false)
+    "shift+tab" (do
+      (om/transact! app :tab
+        #(- % 1)
         [:tab nil])
       false)
     nil


Experiment more with meta-errors

Experiment more with meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -256,8 +256,8 @@
                                                      (second)
                                                      (nth case-index)))))
                                      siblings)
-                               0
-                               1)))))))
+                               1
+                               2)))))))
               ;
               (= cat :case-family-non-improvement)
               (if (not (:print-history argmap))
@@ -286,8 +286,47 @@
                                                   (second)
                                                   (nth case-index)))))
                                      siblings)
-                               0
-                               1)))))))
+                               1
+                               2)))))))
+              ;
+              (= cat :case-family-non-improvement-or-uniformity)
+              (if (not (:print-history argmap))
+                (throw
+                  (Exception.
+                    ":print-history must be true for :case-family-non-improvement"))
+                (if (or (empty? (:parent-uuids ind))
+                        (empty? (rest (:history ind))))
+                  (vec (repeat (count (:errors ind)) 1))
+                  (let [siblings (filter #(and (= (first (:parent-uuids ind))
+                                                  (first (:parent-uuids %)))
+                                               (not (empty? (rest (:history %))))) ; new random sibs don't count
+                                         evaluated-population)]
+                    (vec (for [case-index (range (count (:errors ind)))]
+                           (if (zero? (nth (:errors ind) case-index)) ;; solved
+                             0
+                             (if
+                               (some (fn [sib]
+                                       (or (zero? (-> (:history sib) ;; sib solved
+                                                      (first)
+                                                      (nth case-index)))
+                                           (< (-> (:history sib) ;; sib error better than mom's
+                                                  (first)
+                                                  (nth case-index))
+                                              (-> (:history sib)
+                                                  (second)
+                                                  (nth case-index)))))
+                                     siblings)
+                               1
+                               (if (some (fn [sib]
+                                           (not= (-> (:history sib) ;; sib error different than mom's
+                                                     (first)
+                                                     (nth case-index))
+                                                 (-> (:history sib)
+                                                     (second)
+                                                     (nth case-index))))
+                                         siblings)
+                                 2
+                                 3))))))))
               ;
               (= cat :case-family-certainty)
               (if (not (:print-history argmap))


[#146] Use pmap when there are more than 2 different instances to query

--- api/src/clojure/org/akvo/flow_api/boundary/survey.clj
+++ api/src/clojure/org/akvo/flow_api/boundary/survey.clj
@@ -35,12 +35,13 @@
 (defn filter-surveys
   "Given a list of surveys, returns the ones that the user has access to"
   [user-email surveys remote-api]
-  (let [instances (into #{} (map :instance-id surveys))]
+  (let [instances (into #{} (map :instance-id surveys))
+        mapping-fn (if (> (count instances) 2) pmap map)]
     (survey/keep-allowed-to-see
       surveys
-      (pmap (fn [instance]
-             (let [user-id (user/id-by-email remote-api instance user-email)]
-               (ds/with-remote-api remote-api instance
-                 {:instance-id instance
-                  :survey-ids (doall (survey/list-ids user-id))})))
+      (mapping-fn (fn [instance]
+                    (let [user-id (user/id-by-email remote-api instance user-email)]
+                      (ds/with-remote-api remote-api instance
+                        {:instance-id instance
+                         :survey-ids (doall (survey/list-ids user-id))})))
         instances))))


add missing test: shell fails if exitcode not 0

--- test/clj/lambdacd/steps/shell_test.clj
+++ test/clj/lambdacd/steps/shell_test.clj
@@ -15,6 +15,8 @@
     (is (= 0 (:exit (bash (some-ctx) "/" "exit 0")))))
   (testing "that bash returns the right return code for a single failing command"
     (is (= 1 (:exit (bash (some-ctx) "/" "exit 1")))))
+  (testing "that bash returns fails if the exit code isn't 0"
+    (is (= :failure (:status (bash (some-ctx) "/" "exit 1")))))
   (testing "that bash returns the right return code for a series of commands"
     (is  (= 1 (:exit (bash (some-ctx) "/" "echo foo" "echo bar" "exit 1" "echo baz"))))))


Add without-keys util function.

Add without-keys util function.


CMR-3811: Added more tests.

CMR-3811: Added more tests.

--- system-int-test/test/cmr/system_int_test/search/facets/collection_facets_v2_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/facets/collection_facets_v2_search_test.clj
@@ -351,7 +351,6 @@
   (let [field-match-value (get-facet-field facets-result field value)]
     (is (= count (:count field-match-value)))))

-
 (deftest platform-facets-v2-test
   (let [coll (d/ingest "PROV1" (dc/collection
                                 {:entry-title "coll1"
@@ -407,6 +406,28 @@
         (assert-facet-field facets-result "Projects" "proj4" 1)
         (assert-facet-field-not-exist facets-result "Platforms" "P1")
         (assert-facet-field-not-exist facets-result "Platforms" "P2")
+        (assert-facet-field-not-exist facets-result "Projects" "proj3")))
+
+    (testing "search by both facet field param and regular param"
+      (let [facets-result (search-and-return-v2-facets {:short-name "S1"
+                                                        :platform-h ["P4"]})]
+        (assert-facet-field facets-result "Platforms" "P1" 1)
+        (assert-facet-field facets-result "Platforms" "P4" 0)
+        (assert-facet-field-not-exist facets-result "Platforms" "P2")
+        (assert-facet-field-not-exist facets-result "Instruments" "I3")
+        (assert-facet-field-not-exist facets-result "Instruments" "I4")
+        (assert-facet-field-not-exist facets-result "Projects" "proj3")
+        (assert-facet-field-not-exist facets-result "Projects" "proj4")))
+
+    (testing "search by more than one facet field params"
+      (let [facets-result (search-and-return-v2-facets {:platform-h ["P4"]
+                                                        :instrument-h ["I4"]})]
+        (assert-facet-field facets-result "Platforms" "P4" 1)
+        (assert-facet-field facets-result "Instruments" "I4" 1)
+        (assert-facet-field facets-result "Projects" "proj4" 1)
+        (assert-facet-field-not-exist facets-result "Platforms" "P1")
+        (assert-facet-field-not-exist facets-result "Platforms" "P2")
+        (assert-facet-field-not-exist facets-result "Instruments" "I3")
         (assert-facet-field-not-exist facets-result "Projects" "proj3")))))

 (comment


[scamp] Add 'do-comms to test lib as util fn.

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -133,6 +133,18 @@
                {"node-id0"
                 {:self {:id "node-id0"}, :upstream #{"flimflam"}, :downstream #{} :messages-seen {}}}}))))))

+(s/defn do-comms :- core/WorldSchema
+  "Take 'world and 'n. Process up to 'n messages. Return new 'world.
+   If 'world has no :message-envelopes before 'n messages have been
+   processed, 'world is returned immediately."
+  [world :- core/WorldSchema
+   n :- s/Int]
+  (if (or (zero? n)
+          (empty? (:message-envelopes world)))
+    world
+    (recur (core/do-comm world) (dec n))))
+
+
 (comment
 (binding [scamp.core/*rand* testing-rand*]
                                                                   (for [comm (range 2 252)]


Use linear-router always if there are conflicting routes

--- modules/reitit-core/src/reitit/core.cljc
+++ modules/reitit-core/src/reitit/core.cljc
@@ -350,10 +350,10 @@
          router (cond
                   router router
                   (and (= 1 (count routes)) (not wilds?)) single-static-path-router
+                  conflicting linear-router
                   (not wilds?) lookup-router
                   all-wilds? prefix-tree-router
-                  (not conflicting) mixed-router
-                  :else prefix-tree-router)]
+                  :else mixed-router)]

      (when-let [conflicts (:conflicts opts)]
        (when conflicting (conflicts conflicting)))


Photo displacement should not reuse random numbers

--- frontend/src/faceboard/helpers/person.cljs
+++ frontend/src/faceboard/helpers/person.cljs
@@ -36,12 +36,12 @@
 (defn photo-displace-x [person]
   (or
     (get-in person [:bio :photo :displace :x])
-    (rng (hash (get-in person [:bio :name])) -10 10)))      ; +/- 10px based on name
+    (rng (hash (get-in person [:bio :name])) 1 -10 10)))      ; +/- 10px based on name

 (defn photo-displace-y [person]
   (or
     (get-in person [:bio :photo :displace :y])
-    (rng (hash (get-in person [:bio :name])) -10 10)))      ; +/- 10px based on name
+    (rng (hash (get-in person [:bio :name])) 2 -10 10)))      ; +/- 10px based on name

 (defn photo-displace-z [person]
   (or (get-in person [:bio :photo :displace :z]) 0))        ; 0px unless requested by data


more default locations

more default locations

--- src/cake.clj
+++ src/cake.clj
@@ -32,7 +32,10 @@
                                   (name project-name))
                       :root ~root
                       :version ~version)
-               (assoc-or :library-path (str ~root "/lib")))))))
+               (assoc-or :library-path (str ~root "/lib")
+                         :compile-path (str ~root "/classes")
+                         :source-path  (str ~root "/src")
+                         :test-path    (str ~root "/test")))))))

 (defmacro deftask
   "Define a cake task. Each part of the body is optional. Task definitions can


Chart palette change

Chart palette change


Wider labels for bar charts

Wider labels for bar charts

--- src-cljs/acfe/chart.cljs
+++ src-cljs/acfe/chart.cljs
@@ -42,6 +42,7 @@
 			  :bar {:groupWidth "90%"}
 			  :colors chart-palette
 			  :height 100
+			  :chartArea (if (= chart-type :bar-chart) {:left 100 :width 400})
 			  :width (if (= chart-type :column-chart) 100 "auto")
 			  :tooltip {:textStyle {:fontSize 11}}
 			  :isStacked (cond


Add exit/quit to standalone mode

Add exit/quit to standalone mode

Since standalone uses the reader directly instead of going through a
parser layer, we'll just exit directly.

--- src/clj/reply/eval_modes/standalone.clj
+++ src/clj/reply/eval_modes/standalone.clj
@@ -36,6 +36,8 @@
 (defn main [options]
   (signals/set-signal-handler! "INT" handle-ctrl-c)
   (eval (initialization/construct-init-code options))
+  (eval '(defn quit [] (System/exit 0)))
+  (eval '(defn exit [] (System/exit 0)))
   (let [caught (->fn (:caught options)
                      clojure.main/repl-caught)]
     (clojure.main/repl :read (reply-read options)
@@ -43,5 +45,5 @@
                        :print reply-print
                        :prompt (constantly false)
                        :caught (fn [e] (caught (clojure.main/repl-exception e)))
-                     :need-prompt (constantly false))))
+                       :need-prompt (constantly false))))


pixi 4.5 particle container moved

pixi 4.5 particle container moved

--- src/cljs/infinitelives/pixi/sprite.cljs
+++ src/cljs/infinitelives/pixi/sprite.cljs
@@ -186,7 +186,7 @@
     ([container xhandle yhandle]
      (update-container-handle! container xhandle yhandle))))

-(extend-type js/PIXI.ParticleContainer
+(extend-type js/PIXI.particles.ParticleContainer
   Container
   (update-handle!
     ([container xhandle yhandle]
@@ -212,7 +212,7 @@
             particle-opts #{:position}}}]
   (let [container
         (if particle
-          (js/PIXI.ParticleContainer. nil (opts->js particle-opts))
+          (js/PIXI.particles.ParticleContainer. nil (opts->js particle-opts))
           (js/PIXI.Container.))]
     (assert container "creation of container failed and returned nil")
     (set! (.-x container) x)


cleanup layout styles

cleanup layout styles

--- src/cljs/swarmpit/component/layout.cljs
+++ src/cljs/swarmpit/component/layout.cljs
@@ -1,6 +1,5 @@
 (ns swarmpit.component.layout
   (:require [rum.core :as rum]
-            [material.components :as comp]
             [clojure.string :as str]
             [swarmpit.view :as view]
             [swarmpit.view-actions :as view-actions]
@@ -9,17 +8,6 @@
             [swarmpit.component.header :as header]))

 (enable-console-print!)
-
-(def styles
-  (let [theme (js->clj comp/theme)]
-    {:root    {:flexGrow 1
-               :zIndex   1
-               :overflow "hidden"
-               :position "relative"
-               :display  "flex"}
-     :context {:flexGrow        1
-               :backgroundColor (-> theme (get-in ["palette" "background" "default"]))
-               :padding         (* (-> theme (get-in ["spacing" "unit"])) 3)}}))

 (defn- page-domain
   [handler]


Boy dont you be putting no nulls in my code

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -226,7 +226,7 @@
                                                                                #js ["transitive-edge" "know" "output-transitive-connected" "connected"]])

 (.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["get-left-edge" "variable" "x" "xx"]
-                           null                                                                  #js ["get-left-edge" "variable" "y" "yy"]
+                                                                                #js ["get-left-edge" "variable" "y" "yy"]
                                                                                #js ["get-right-connected" "variable" "x" "yy"]
                                                                                #js ["get-right-connected" "variable" "y" "zz"]
                                                                                #js ["output-transitive-connected" "variable" "x" "xx"]


Expose functions in compiler

Expose functions in compiler

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -82,7 +82,8 @@

     ;; rewrite clauses
     (doseq [[rule-id clauses] @rule-id->clauses]
-      (doseq [[_ clause-type clause-id name] clauses]
+      (doseq [[_ clause-type clause-id name] clauses
+              :when (not #{"constant=" "variable=" "function="} name)]
         (let [fields (get @clause-id->fields clause-id)
               var->key (atom {})]
           (doseq [[_ field-type key val] fields]
@@ -144,6 +145,19 @@
                                                        ix-a (get var->ix variable-a)
                                                        ix-b (get var->ix variable-b)]
                                                    [(btree/equal) #js [ix-a ix-b]])
+                                     "=function" (let [variable (first (for [[_ field-type key val] fields
+                                                                             :when (= key "variable")]
+                                                                         val))
+                                                       js (first (for [[_ field-type key val] fields
+                                                                       :when (= key "js")]
+                                                                   val))
+                                                       ix (get var->ix variable)
+                                                       args (for [var @vars
+                                                                  :when (>= (.indexOf js var) 0)]
+                                                              var)
+                                                       arg-ixes (map var->ix args)
+                                                       fun (apply js/Function (conj (vec args) (str "return (" js ");")))]
+                                                   [(btree/function fun) (into-array (conj (vec arg-ixes) ix))])
                                      (let [clause-vars&keys (sort-by (fn [[val key]] (var->ix val))
                                                                      (for [[_ field-type key val] fields]
                                                                        [val key]))
@@ -234,3 +248,16 @@

 (.get-or-create-index kn "know" "connected" #js ["x" "y"])

+(.add-facts kn "know" "clauses" #js ["rule-id" "when|know|remember|forget" "clause-id" "name"] #js [#js ["x-function-edge" "when" "get-function-edge" "edge"]
+                                                                                #js ["x-function-edge" "when" "make-str" "=function"]
+                                                                                #js ["x-function-edge" "know" "know-str" "str-edge"]])
+
+(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["get-function-edge" "variable" "x" "xx"]
+                                                                                #js ["get-function-edge" "variable" "y" "yy"]
+                                                                                #js ["make-str" "variable" "variable" "zz"]
+                                                                                #js ["make-str" "constant" "js" "\"edge \" + xx + \" \" + yy"]
+                                                                                #js ["know-str" "variable" "name" "zz"]])
+
+(.run (nth (compile kn) 2) kn)
+
+(.get-or-create-index kn "know" "str-edge" #js ["name"])


rename namespace

rename namespace

--- src/babel/lexiconfn.cljc
+++ src/babel/lexiconfn.cljc
@@ -3,7 +3,7 @@
   (:require
    [babel.encyclopedia :refer [sem-impl]]
    [babel.exception :refer [exception]]
-   [babel.korma :refer [init-db]]
+   [babel.korma :as db]
    [babel.pos :refer [agreement-noun common-noun determiner
                       intransitive modal noun
                       subcat0 subcat1
@@ -28,7 +28,6 @@
 (defn read-lexicon
   "read a lexicon compiled from source by (defn compile-lex) and then written to the database by (defn write-lexicon)"
   [language]
-  (init-db)
   (log/info (str "reading lexicon for language: " language))
   (let [lexemes
         (-> (exec-raw [(str "SELECT canonical, serialized FROM lexeme "
@@ -795,12 +794,12 @@
                                  (canonical, structures, language, serialized)
                           VALUES (?,?::jsonb[],?,?::text[])")
              [canonical
-              (babel.korma/prepare-array
+              (db/prepare-array
                (vec (map (fn [lexeme]
                            (json/write-str (dissoc (strip-refs lexeme) :dag_unify.core/serialized)))
                          lexemes)))
               language
-              (babel.korma/prepare-array
+              (db/prepare-array
                (vec (map (fn [lexeme]
                            (str (vec (dag_unify.core/serialize lexeme))))
                          lexemes)))


reduce amount of unification

reduce amount of unification

--- src/babel/morphology.clj
+++ src/babel/morphology.clj
@@ -61,14 +61,15 @@

 (defn compile-patterns [unify-with patterns]
   (mapcat (fn [{g :g agr :agr p :p u :u}]
-            (map (fn [pair]
-                   {:u (unify unify-with
+            (let [u (unify unify-with
                               (or agr :top)
-                              (or u :top))
-                    :g g
-                    :agr agr
-                    :p pair})
-                 (group-by-two p)))
+                              (or u :top))]
+              (map (fn [pair]
+                     {:u u
+                      :g g
+                      :agr agr
+                      :p pair})
+                   (group-by-two p))))
        patterns))

 (defn do-replace-on [infinitive patterns]


More scan tests.

More scan tests.

--- src/cbfg/store-test.cljs
+++ src/cbfg/store-test.cljs
@@ -193,7 +193,27 @@
          (if (and (let [c (store/store-scan test-scan s @n "a" "z")]
                     (e n (atake test-scan c)
                        {:status :ok, :opaque @n}
-                       (atake test-scan c))))
+                       (atake test-scan c)))
+                  (let [c (store/store-set test-scan s @n "a" 0 "A" :set)]
+                    (e n (atake test-scan c)
+                       {:status :ok, :key "a", :opaque @n, :sq 1}
+                       (atake test-scan c)))
+                  (let [c (store/store-scan test-scan s @n "b" "z")]
+                    (e n (atake test-scan c)
+                       {:status :ok, :opaque @n}
+                       (atake test-scan c)))
+                  (let [c (store/store-scan test-scan s @n "a" "a")]
+                    (e n (atake test-scan c)
+                       {:status :ok, :opaque @n}
+                       (atake test-scan c)))
+                  (let [c (store/store-scan test-scan s @n "a" "z")
+                        m @n]
+                    (and (e n (atake test-scan c)
+                            {:status :part, :opaque m, :key "a", :sq 1, :val "A"}
+                            nil)
+                         (e n (atake test-scan c)
+                            {:status :ok, :opaque m}
+                            (atake test-scan c)))))
            "pass"
            (str "FAIL: on test-scan #" @n)))))


Closes #124

Closes #124

--- src/cia/init.clj
+++ src/cia/init.clj
@@ -30,7 +30,7 @@

 (defn init-mem-store! []
   (let [store-impls {store/actor-store     ma/->ActorStore
-                     store/judgement-store mem/->JudgementStore
+                     store/judgement-store mj/->JudgementStore
                      store/feedback-store  mf/->FeedbackStore
                      store/campaign-store  mca/->CampaignStore
                      store/coa-store       mco/->COAStore


get seed pws from profile, add yc test user

--- src/chat/server/seed.clj
+++ src/chat/server/seed.clj
@@ -1,5 +1,6 @@
 (ns chat.server.seed
-  (:require [chat.server.db :as db]))
+  (:require [chat.server.db :as db]
+            [environ.core :refer [env]]))

 (defn drop! []
   (datomic.api/delete-database db/*uri*))
@@ -11,20 +12,27 @@
   (db/with-conn
     (let [user-1 (db/create-user! {:id (db/uuid)
                                    :email "raf@leanpixel.com"
-                                   :password "foobar"
+                                   :password (get env :rafal-password "foobar")
                                    :avatar "https://s3-us-west-2.amazonaws.com/slack-files2/avatars/2015-05-08/4801271456_41230ac0b881cdf85c28_72.jpg"})
           user-2 (db/create-user! {:id (db/uuid)
                                    :email "james@leanpixel.com"
-                                   :password "foobar"
+                                   :password (get env :james-password "foobar")
                                    :avatar "https://s3-us-west-2.amazonaws.com/slack-files2/avatars/2015-05-09/4805955000_07dc272f0a7f9de7719e_192.jpg"})
+          user-3 (db/create-user! {:id (db/uuid)
+                                   :email "test@ycombinator.com"
+                                   :password (get env :tester-password "")
+                                   :avatar "https://s3.amazonaws.com/chat.leanpixel.com/ycombinator-logo.png"})

           tag-1 (db/create-tag! {:id (db/uuid) :name "penyopal"})
           tag-2 (db/create-tag! {:id (db/uuid) :name "watercooler"})

           _ (db/user-subscribe-to-tag! (user-1 :id) (tag-1 :id))
           _ (db/user-subscribe-to-tag! (user-2 :id) (tag-1 :id))
+          _ (db/user-subscribe-to-tag! (user-3 :id) (tag-1 :id))
+
           _ (db/user-subscribe-to-tag! (user-1 :id) (tag-2 :id))
           _ (db/user-subscribe-to-tag! (user-2 :id) (tag-2 :id))
+          _ (db/user-subscribe-to-tag! (user-3 :id) (tag-2 :id))

           msg (db/create-message! {:id (db/uuid)
                                    :user-id (user-1 :id)


Message formatting error fixed

Message formatting error fixed

--- src-cljs/client/websocket_handler.cljs
+++ src-cljs/client/websocket_handler.cljs
@@ -58,7 +58,7 @@

               ;; Send termination message to write loop and notify on meta channel
               (>! write-channel h/socket-closed-message)
-              (>! meta-channel  h/attempting-connect-message))))
+              (>! meta-channel (h/attempting-connect-message address))))
         (recur)))
     [(h/combine-channels read-channel write-channel)
      meta-channel]))


consistency

consistency

--- src-cljs/frontend/components/plan.cljs
+++ src-cljs/frontend/components/plan.cljs
@@ -81,6 +81,7 @@
             [:div.content {:key "active"}
              [:div.content.make
               (str (count active) " active user" (when (< 1 (count active)) "s") " on your plan")]
+             ;; TODO: should make active a ref
              (for [email (sort active)]
                [:div.access-card.make {:key email}
                 [:div.access-avatar
@@ -426,4 +427,4 @@
            (om/build plan-menu* {:plan-id (:db/id (:team/plan team))
                                  :team-uuid (:team/uuid team)
                                  :submenu submenu}
-                     {:react-key "plan-component*"})))))))
+                     {:react-key "plan-menu*"})))))))


Re-introduced accompanying chord to start of each measure

--- src/aeolian/composer.clj
+++ src/aeolian/composer.clj
@@ -49,7 +49,7 @@
 				(apply str
 					(flatten
 						(interpose
-							(str "|\n")
+							(str "|\n" n/major-root)
 							(partition notes-per-measure mapped-notes))))
 		]
 		(str n/major-root notes-in-measures)))


CLJS-1119: constant table emission logic is incorrect

move constant table emission after dependencies are compiled

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -1407,23 +1407,21 @@
            (let [compiled (util/measure compiler-stats
                             "Compile basic sources"
                             (doall (-compile source all-opts)))
-                 ;; the constants_table.js file is not used directly here, is picked up by
-                 ;; add-dependencies below
+                 js-sources (util/measure compiler-stats
+                              "Add dependencies"
+                              (doall
+                                (concat
+                                  (apply add-dependencies all-opts
+                                    (concat
+                                      (if (coll? compiled) compiled [compiled])
+                                      (when (= :nodejs (:target all-opts))
+                                        [(-compile (io/resource "cljs/nodejs.cljs") all-opts)])))
+                                  (when (= :nodejs (:target all-opts))
+                                    [(-compile (io/resource "cljs/nodejscli.cljs") all-opts)]))))
                  _ (when emit-constants
                      (comp/emit-constants-table-to-file
                        (::ana/constant-table @env/*compiler*)
                        (str (util/output-directory all-opts) "/constants_table.js")))
-                 js-sources (util/measure compiler-stats
-                              "Add dependencies"
-                              (doall
-                                (concat
-                                 (apply add-dependencies all-opts
-                                   (concat
-                                     (if (coll? compiled) compiled [compiled])
-                                     (when (= :nodejs (:target all-opts))
-                                       [(-compile (io/resource "cljs/nodejs.cljs") all-opts)])))
-                                 (when (= :nodejs (:target all-opts))
-                                   [(-compile (io/resource "cljs/nodejscli.cljs") all-opts)]))))
                  optim (:optimizations all-opts)
                  ret (if (and optim (not= optim :none))
                        (do


add module dependencies

add module dependencies

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -680,6 +680,11 @@
               ;; add inputs to module
               (doseq [^SourceFile module-source module-sources]
                 (.add js-module module-source))
+              (doseq [dep depends-on]
+                (if-let [parent-module (get-in (into {} ret) [dep :closure-module])]
+                  (.addDependency js-module ^JSModule parent-module)
+                  (throw (IllegalArgumentException.
+                           (str "Parent module " dep " does not exist")))))
               [sources'
                (conj ret
                  [name (assoc module-desc :closure-module js-module)])]))


emit keys in fspec describe

emit keys in fspec describe

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -1468,7 +1468,7 @@
                   (assert (valid? argspec args) (with-out-str (explain argspec args)))
                   (gen/generate (gen retspec)))))))
      (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn))
-     (describe* [_] `(fspec ~aform ~rform ~fform)))))
+     (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (clojure.spec/def ::any (spec (constantly true) :gen gen/any))


Registers are now upper-cased keywords.

Registers are now upper-cased keywords.

--- src/clj/minijava/gas.clj
+++ src/clj/minijava/gas.clj
@@ -94,7 +94,7 @@
 ;;the set of temps defined by this instruction
 (defn defs [instr]
   (case (type instr)
-    :minijava.gas/ret   (hash-set (tm/temp :eip))
+    :minijava.gas/ret   (hash-set (tm/temp :EIP))
     :minijava.gas/jcc   nil
     :minijava.gas/jmp   nil
     :minijava.gas/call  nil


[style] refactor fn

[style] refactor fn

--- src/clj_dstream/core.clj
+++ src/clj_dstream/core.clj
@@ -162,15 +162,13 @@
     state-after-put))

 (defn phase-space->cell-count [{:keys [::phase-space]}]
-  ;;TODO
-
-  (let [mapped  (map (fn [{:keys [::domain-interval ::domain-end ::domain-start]}]
-                       (-> (- domain-end domain-start)
-                           (/ domain-interval)
-                           int))
-                     phase-space)
-        reduced (reduce * mapped)]
-    reduced))
+  (->>
+    phase-space
+    (map (fn [{:keys [::domain-interval ::domain-end ::domain-start]}]
+           (-> (- domain-end domain-start)
+               (/ domain-interval)
+               int)))
+    (reduce *)))

 (defn dstream-iterations [state raw-data]
   (println "iters w state:")


Let's use the cp for now

Let's use the cp for now

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -30,14 +30,10 @@
 (defn clojurescript-version
   "Returns clojurescript version as a printable string."
   []
-  ('org.clojure/clojurescript
-   (->> "project.clj"
-        slurp
-        read-string
-        (drop-while (complement keyword?))
-        (apply hash-map)
-        :dependencies
-        (into {}))))
+  (-> (System/getProperty "java.class.path")
+      (string/split #":")
+      (->> (some #(re-find #"clojurescript-(.+)\.jar" %))
+           second)))

 (def go-reserved
   #{"break" "case" "chan" "const" "continue" "default"


removing old login code

removing old login code

--- src/cljs/ohds/views.cljs
+++ src/cljs/ohds/views.cljs
@@ -5,25 +5,6 @@
    [ohds.login.view :as login]
    [schema.core :as s :include-macros true]
    [petrol.core :refer [send! send-value!]]))
-
-
-(defn login [ui-channel app]
-  [:div {:class "form-signin"}
-   [:h2 {:class "form-signin-heading"}
-    "Please log in"]
-   [:div
-    [:input {:id "username"
-             :type :text
-             :placeholder "Username"
-             :on-change (send-value! ui-channel m/->ChangeUsername)}]]
-   [:div
-    [:input {:id "password"
-             :type :password
-             :placeholder "Password"
-             :on-change (send-value! ui-channel m/->ChangePassword)}]]
-   [:div
-    [:button {:on-click (send! ui-channel (m/->FieldworkerLogin))}
-     "Login"]]])

 (defn ohds-option [field]
   (s/validate ml/LocationOption field)


Remove unned ng-app directive

Remove unned ng-app directive

--- src/clj/subman/views.clj
+++ src/clj/subman/views.clj
@@ -2,8 +2,7 @@
   (:use [hiccup core page]))

 (defn index-page []
-  (html5 {:ng-app "subman"}
-         [:head
+  (html5 [:head
           [:title "Subman - subtitle search service with api"]
           (include-css "/components/bootstrap/dist/css/bootstrap.min.css"
                        "/components/bootstrap/dist/css/bootstrap-theme.min.css"


triming labels for autocomplete, this should be also fixed on input - so that label with whitespaces on end can't be entered

--- src/clj/swarmpit/api.clj
+++ src/clj/swarmpit/api.clj
@@ -14,7 +14,8 @@
             [swarmpit.registry.mapper.inbound :as rmi]
             [swarmpit.couchdb.client :as cc]
             [swarmpit.couchdb.mapper.inbound :as cmi]
-            [swarmpit.couchdb.mapper.outbound :as cmo]))
+            [swarmpit.couchdb.mapper.outbound :as cmo]
+            [clojure.string :as str]))

 ;;; User API

@@ -471,6 +472,7 @@
   (->> (services)
        (map #(->> % :labels
                   (map :name)
+                  (map str/trim)
                   (set)))
        (apply clojure.set/union)))


minor bug

minor bug

--- src/clj_discord/core.clj
+++ src/clj_discord/core.clj
@@ -75,11 +75,11 @@
                                (if log-events? (log-function "Sending heartbeat " @the-seq))
                                (ws/send-msg @the-socket (json/write-str {:op 1, :d @the-seq}))
                                (Thread/sleep @the-heartbeat-interval)
-                               )))
-                         (catch Exception e (do
-                                              (log-function "Caught exception: " (.getMessage e))
-                                              (reset! the-keepalive false)
-                                              ))))))
+                               ))
+                           (catch Exception e (do
+                                                (log-function "Caught exception: " (.getMessage e))
+                                                (reset! the-keepalive false)
+                                                )))))))
     (Thread/sleep 1000)
     (ws/send-msg @the-socket (json/write-str {:op 2, :d {"token" @the-token
                                                          "properties" {"$os" "linux"


reset markers working well

reset markers working well

--- src/cljs/lokate/map.cljs
+++ src/cljs/lokate/map.cljs
@@ -25,9 +25,9 @@
   icon)

 (defn reset-markers [owner]
-  (let [markers (om/get-state owner :markers)]
+  (let [units (om/get-state owner :units)]
     (dorun
-      (map #(.setIcon (:marker %) (reset-ico (:icon %))) (vals markers)))))
+      (map #(.setIcon (:marker %) (reset-ico (:icon %))) (vals units)))))

 (defn activate-marker
   [owner id]
@@ -99,6 +99,8 @@
         ;(when-let [u-id (-> next-props :route :opts :u-id)]
          ;(activate-marker owner u-id))

+        (reset-markers owner)
+
         (let [[route args] (first next-props)]
           (when (= route :unit)
             (let [[cid uid page] args]


Keep cursor on position

Keep cursor on position

--- src/cljs/notes/core.cljs
+++ src/cljs/notes/core.cljs
@@ -117,7 +117,12 @@
     nil
     )))))

-(defn focus-on-input [] (-> js/document (.querySelector "input") (.focus)))
+(defn focus-on-input []
+  (let [element (.querySelector js/document "input")
+        value (.-value element)
+        length (.-length value)]
+    (do (.focus element)
+       (.setSelectionRange element length length))))

 (defn list-view [app owner]
   (reify


Experiment more with :repeated-errors

Experiment more with :repeated-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -363,7 +363,7 @@
                            (if (some #{latest} (set olders))
                              2
                              0))))))
-              (if (not (:print-history argmap))
+              #_(if (not (:print-history argmap))
                 (throw
                   (Exception.
                     ":print-history must be true for :repeated-errors"))
@@ -372,6 +372,18 @@
                   (vec (for [case-index (range (count (:errors ind)))]
                          (let [latest (nth (first (:history ind)) case-index)
                                olders (map #(nth % case-index) (take 3 (rest (:history ind))))]
+                           (if (some #{latest} (set olders))
+                             2
+                             0))))))
+              (if (not (:print-history argmap))
+                (throw
+                  (Exception.
+                    ":print-history must be true for :repeated-errors"))
+                (if (empty? (rest (:history ind)))
+                  (vec (repeat (count (:errors ind)) 1))
+                  (vec (for [case-index (range (count (:errors ind)))]
+                         (let [latest (nth (first (:history ind)) case-index)
+                               olders (map #(nth % case-index) (rest (:history ind)))]
                            (if (some #{latest} (set olders))
                              2
                              0))))))


fix boxed-math warning

fix boxed-math warning

--- src/asphalt/internal.clj
+++ src/asphalt/internal.clj
@@ -110,7 +110,7 @@
     (apply assert-symbols))
   (when (odd? (count more-pairs))
     (expected "an even number of forms in binding vector" more-pairs))
-  (let [[iter & more-iters] (repeatedly (inc (/ (count more-pairs) 2)) gensym)
+  (let [[iter & more-iters] (repeatedly (inc (quot (count more-pairs) 2)) gensym)
         partition-pairs (partition 2 more-pairs)
         iter-pairs (interleave more-iters (map second partition-pairs))
         each-pairs (->> more-iters


Limit auto-expanding level

Limit auto-expanding level

--- src/devtools/format.cljs
+++ src/devtools/format.cljs
@@ -134,16 +134,19 @@
     (-write writer tmpl)
     (let [inner-tmpl #js []
           inner-writer (TemplateWriter. inner-tmpl)]
-      ((:fallback-worker opts) obj inner-writer opts)
+      (if (= *print-level* 1)
+        ((:fallback-worker opts) obj inner-writer (assoc opts :print-length 0))
+        ((:fallback-worker opts) obj inner-writer opts))
       (detect-else-case-and-patch-it inner-tmpl obj) ; an ugly special case
       (.merge writer (wrap-group-in-cljs-if-needed (wrap-group-in-reference-if-needed inner-tmpl obj) obj)))))

 (defn managed-pr-str [value]
   (let [tmpl (template span "")
         writer (TemplateWriter. tmpl)]
-    (pr-seq-writer [value] writer {:alt-worker   alt-worker
-                                   :print-length max-coll-elements
-                                   :more-text    abbreviation})
+    (binding [*print-level* 2]
+      (pr-seq-writer [value] writer {:alt-worker   alt-worker
+                                     :print-length max-coll-elements
+                                     :more-text    abbreviation}))
     (wrap-cljs-if-needed (cljs-value? value) tmpl)))

 (defn build-header [value]


Comment out manual testing code

Comment out manual testing code

--- src/atom_finder/core.clj
+++ src/atom_finder/core.clj
@@ -20,12 +20,12 @@
    )
 )

-(->> "macro-operator-precedence_redis_2017-03-10_1.edn"
-     read-data
-     (take 30)
-     (found-atom-source :macro-operator-precedence)
-     ;sum-found-atoms
-     )
+;(->> "macro-operator-precedence_redis_2017-03-10_1.edn"
+;     read-data
+;     (take 30)
+;     (found-atom-source :macro-operator-precedence)
+;     ;sum-found-atoms
+;     )

 ;sum-found-atoms => {:macro-operator-precedence 1760}
 ;sum-found-atoms => {:macro-operator-precedence  759} # After removing atomic macros (#define M1 123)


More vars in stack trace

More vars in stack trace

--- src/aurora/compiler.cljs
+++ src/aurora/compiler.cljs
@@ -85,6 +85,8 @@
    (= :match/bind (:type x)) `(do
                                 (let! ~(id->value (:id x)) ~(id->value input))
                                 (let! ~(id->cursor (:id x)) ~(id->cursor input))
+                                (set! (.. frame.vars ~(id->value (:id x))) ~(id->value (:id x)))
+                                (set! (.. frame.vars ~(id->cursor (:id x))) ~(id->cursor (:id x)))
                                 ~(pattern->jsth index (:pattern x) input))
    (= :tag (:type x)) (test->jsth `(= ~(tag->jsth index x) ~(id->value input)))
    (= :ref/id (:type x)) (test->jsth `(= ~(ref->jsth index x) ~(id->value input)))
@@ -164,6 +166,10 @@
        (set! frame.vars {})
        (stack.push frame)
        (set! notebook.stack frame.calls)
+       ~@(for! [arg (:args x)]
+               `(do
+                  (set! (.. frame.vars ~(id->value arg)) ~(id->value arg))
+                  (set! (.. frame.vars ~(id->cursor arg)) ~(id->cursor arg))))
        ~@(for! [step-id (:steps x)]
                `(do
                   ~(step->jsth index (get index step-id) step-id)


server fix

server fix

--- src/chat_server/core.clj
+++ src/chat_server/core.clj
@@ -9,9 +9,6 @@
           [route :only [files not-found]]
           [handler :only [site]]
           [route :only [not-found]])))
-
-; todo fix max message count
-
 ; store max-id and function next-id
 (defonce max-id (atom 0))
 (defn next-id []
@@ -41,7 +38,7 @@
       (.write wrtr line)))
     (reset! log-msgs [])))
 ; messages
-(defonce all-msgs (ref [{:id (next-id) :time (now) :msg "Добро пожаловаать в чат!" :author "system"}]))
+(defonce all-msgs (ref [{:id (next-id) :time (now) :msg "Добро пожаловать в чат!" :author "system"}]))
 (defn add-msg-to-storage [msg]
   (dosync (let [all-msgs* (conj @all-msgs msg)] (ref-set all-msgs all-msgs*))))
 (defn min-msg-id []
@@ -55,14 +52,16 @@
 ; login version 1
 (defmethod process-packet ["login" "1"] [packet channel]
   (do
-    (let [login (:data packet)]
+    (let [login (:data packet) id (- @max-id 20)]
       (swap! clients         assoc channel login)
-      (swap! clients-last-id assoc channel (- max-id 20)
+      (swap! clients-last-id assoc channel id)
       (println packet @clients-last-id)
-      (send! channel (json-str {:status "ok"})))))
+      (send! channel (json-str {:status "ok"}))
+      (dosync (ref-set all-msgs (conj @all-msgs {:id (next-id) :time (now) :msg (format "Пришел: %s" (@clients channel)) :author "system"}))))))
 ; logout version 1
 (defn logout [channel]
   (do
+    (dosync (ref-set all-msgs (conj @all-msgs {:id (next-id) :time (now) :msg (format "Ушел: %s" (@clients channel)) :author "system"})))
     (swap! clients dissoc channel)
     (swap! clients-last-id dissoc channel)
     (println @clients-last-id)
@@ -70,7 +69,6 @@
 (defmethod process-packet ["logout" "1"] [packet channel]
   (do
     (logout channel)
-    (println packet)
     (send! channel (json-str {:status "ok"}))))
 ; send version 1
 (defmethod process-packet ["send" "1"] [packet channel]
@@ -85,10 +83,13 @@
   (let [last-id (@clients-last-id channel) cur-id (+ @max-id 1)]
     (do
       (println packet @clients-last-id)
-      (if (not-nil? last-id) (do
-        (send! channel (json-str {:status "ok" :data (filter (fn [msg] (>= (:id msg) last-id)) @all-msgs)}))
-        (swap! clients-last-id assoc channel cur-id)
-        (clear-old-msgs))))))
+      (if (not-nil? last-id)
+        (do
+          ;(println (reverse (filter (fn [msg] (>= (:id msg) last-id)) @all-msgs)))
+          ;(println (filter (fn [msg] (>= (:id msg) last-id)) @all-msgs))
+          (send! channel (json-str {:status "ok" :data (sort-by :id < (filter (fn [msg] (>= (:id msg) last-id)) @all-msgs))}))
+          (swap! clients-last-id assoc channel cur-id)
+          (clear-old-msgs))))))
 ; perfomance dump version 1
 (defmethod process-packet ["dump" "1"] [packet channel] (dump))
 ; default method - simple print packet


Always convert JavaScript maps to JavaScriptFile records.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -187,12 +187,17 @@
 (defn javascript-file [^URL url provides requires]
   (JavaScriptFile. url (map name provides) (map name requires)))

+(defn map->javascript-file [m]
+  (javascript-file (to-url (:file m))
+                   (:provides m)
+                   (:requires m)))
+
 (defn read-js
   "Read a JavaScript file returning a map of file information."
   [f]
   (let [source (slurp f)
         m (parse-js-ns (string/split-lines source))]
-    (assoc m :file f :source source)))
+    (map->javascript-file (assoc m :file f))))

 (defprotocol Compilable
   (-compile [this opts] "Returns one or more IJavaScripts."))


Fix typo in doc.

Fix typo in doc.

--- src/clj/forma/schema.clj
+++ src/clj/forma/schema.clj
@@ -113,7 +113,7 @@
   FireArray
   (get-vals [x] (.getFires x))

-   ArrayValue
+  ArrayValue
    (get-vals [x] (get-vals (.getFieldValue x))))

 (defn count-vals [x]
@@ -359,7 +359,7 @@
   "Returns the ModisPixelLocation from a LocationProperty Thrift object.

   Arguments:
-    llocation-prop - The LocationProperty Thrift object."
+    location-prop - The LocationProperty Thrift object."
   [location-prop]
   (-> location-prop .getProperty .getPixelLocation))


Make a generic map object component

Make a generic map object component

--- src/cljs/gtfve/maps.cljs
+++ src/cljs/gtfve/maps.cljs
@@ -65,6 +65,22 @@
                                       :strokeOpacity 1.0
                                       :strokeWeight 2}))))

+(defn r-map-object [class opts gmap]
+  (let [obj (class. (clj->js @opts))]
+    (r/create-class
+     {:component-did-mount (fn [this]
+                             (let [[_ _ opts gmap] (r/argv this)
+                                   m-opts (merge @opts {:map gmap})]
+                               (.setOptions obj (clj->js m-opts))))
+      :component-did-update (fn [this]
+                              (let [[_ _ opts gmap] (r/argv this)
+                                    m-opts (merge @opts {:map gmap})]
+                                (.setOptions obj (clj->js m-opts))))
+      :component-will-unmount (fn [this]
+                                (.setMap obj nil))
+      :component-function (fn [class opts gmap]
+                            [:noscript])})))
+
 (defn r-marker [opts gmap]
   (let [marker (Maps.Marker. (clj->js @opts))]
     (r/create-class
@@ -106,6 +122,6 @@
                              (doall
                               (for [[id marker-opts] (:markers @state)]
                                 ^{:key id}
-                                [r-marker
+                                [r-map-object Maps.Marker
                                  (r/wrap marker-opts swap! state assoc-in [:markers id])
                                  @gmap]))])})))


fixed bug where markers weren't being added properly

--- src/cljs/lokate/map.cljs
+++ src/cljs/lokate/map.cljs
@@ -33,6 +33,7 @@

 (defn reset-markers [owner]
   (let [markers (om/get-state owner :markers)]
+    (.log js/console (pr-str markers))
     (dorun
       (map #(.setIcon (:marker %) (reset-ico (:icon %))) markers))))

@@ -69,11 +70,11 @@
     {:marker marker :icon icon :pos pos :id (:id point)}))

 (defn add-markers [data owner units]
-  (let [map (om/get-state owner :map)]
+  (let [map (om/get-state owner :map)
+        units (filter (comp not empty? :pos) units)]
     (om/update-state! owner :markers
       #(into % (for [unit units]
-                 (when-not (empty? (:pos unit))
-                   (mark-it! data owner map unit)))))))
+                 (mark-it! data owner map unit))))))

 (defn add-group [owner places opts]
   (map #({:name (:name %) :group (js/L.MarkerClusterGroup.)})))


add admin ns to views

add admin ns to views

--- src/cljs/ohds/views.cljs
+++ src/cljs/ohds/views.cljs
@@ -2,6 +2,7 @@
   (:require
    [ohds.messages :as m]
    [ohds.model :as ml]
+   [ohds.admin :as admin]
    [ohds.login.view :as login]
    [ohds.hierarchy.view :as hierarchy]
    [ohds.location.view :as location]


fix bugs

fix bugs

--- src/codeitlater/core.clj
+++ src/codeitlater/core.clj
@@ -45,14 +45,18 @@
 (defn read-files ;;:= TODO: directory format
   "(partial read-comments-inline commentMark)"
   ([commentDict]
-   (doall (for [filepath (get-all-files)]
-            (conj (read-comments-in-file ;;:= Debug: if filepath is "." or other directory
-                   filepath (get commentDict (re-find #"(?<=\w)\..*$" filepath)))
+   (doall (for [filepath (get-all-files)
+                :when (not (.isDirectory (io/file filepath)))
+                :let [mark (get commentDict (re-find #"(?<=\w)\..*$" filepath))]
+                :when mark]
+            (conj (read-comments-in-file filepath mark)
                   filepath))))
   ([commentDict root]
-   (doall (for [filepath (get-all-files root)]
-            (conj (read-comments-in-file
-                   filepath (get commentDict (re-find #"(?<=\w)\..*$" filepath)))
+   (doall (for [filepath (get-all-files root)
+                :when (not (.isDirectory (io/file filepath)))
+                :let [mark (get commentDict (re-find #"(?<=\w)\..*$" filepath))]
+                :when mark]
+            (conj (read-comments-in-file filepath mark)
                   filepath))))
   ([commentDict root & filetypes]
    (let [typepatterns (for [filetype filetypes
@@ -60,10 +64,12 @@
                         (list (re-pattern (str ".+" filetype "$"))
                               (str "." filetype)))]
      (doall (for [filepath (get-all-files root)
+                  :when (not (.isDirectory (io/file filepath)))
                   typepattern typepatterns
-                  :when (re-matches (first typepattern) filepath)]
-              (conj (read-comments-in-file
-                     filepath (get commentDict (last typepattern)))
+                  :when (re-matches (first typepattern) filepath)
+                  :let [mark (get commentDict (re-find #"(?<=\w)\..*$" filepath))]
+                  :when mark]
+              (conj (read-comments-in-file filepath (get commentDict (last typepattern)))
                     filepath))))))


Start refactoring out the binding logic

Start refactoring out the binding logic

Stories syncing/binding updated to new approach.

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -9,11 +9,14 @@

 (defonce channel-closers (atom {}))

+(defn- closer-path [data path]
+  (conj (vec (cons data path)) :-closer))
+
 (defn- save-channel-closer! [data path channel]
-  (swap! channel-closers assoc-in (cons data path) channel))
+  (swap! channel-closers assoc-in (closer-path data path) channel))

 (defn- close-channel! [data path]
-  (let [identifier (cons data path)]
+  (let [identifier (closer-path data path)]
     (when-let [close-chan (get-in @channel-closers identifier)]
       (put! close-chan :close)
       (swap! channel-closers dissoc-in identifier))))
@@ -23,25 +26,6 @@
     (if ks
       (recur (.child r (clojure.core/name k)) ks)
       (.child r (clojure.core/name k)))))
-
-(defn- unbind!
-  ([fb event keys]
-   (.off (walk-root fb keys) (clojure.core/name event)))
-  ([fb event keys f]
-   (.off (walk-root fb keys) (clojure.core/name event) f)))
-
-(defn- bind!
-  ([fb event keys f]
-   (.on (walk-root fb keys)
-        (clojure.core/name event)
-        f)))
-
-(defn bind-item!
-  [id data path]
-  (bind! root :value [:item (str id)]
-         (fn [snapshot]
-           (let [db (js->clj (.val snapshot) :keywordize-keys true)]
-             (swap! data assoc-in path db)))))

 (defn- id->fbref [id]
   (walk-root root [:item (str id)]))
@@ -89,38 +73,6 @@
              (.log js/console (clj->js [event key val]))))
          (recur)))
      data)))
-
-(defn init-story-sync! [data id path]
-  (let [close-chan (chan)
-        fbc (fb->chan (id->fbref id) close-chan)]
-    (save-channel-closer! data path close-chan)
-    (go-loop []
-      (when-let [msg (<! fbc)]
-        (let [[event key val] msg
-              child-path (conj path key)]
-          (case event
-            :child_added (swap! data assoc-in child-path val)
-            :child_changed (swap! data assoc-in child-path val)
-            :child_removed (swap! data update-in path dissoc key)
-            (.log js/console (clj->js [event key val]))))
-        (recur)))
-    close-chan))
-
-(defn init-stories-sync! [data path]
-  (let [ref (walk-root root [:topstories])
-        fbc (fb->chan ref)]
-    (go-loop []
-      (when-let [msg (<! fbc)]
-        (let [[event key val] msg
-              child-path (conj path key)]
-          (case event
-            :child_added (init-story-sync! data val child-path)
-            :child_changed (do (close-channel! data child-path)
-                               ;; TODO: check if race condition occurs here
-                               (init-story-sync! data val child-path))
-            :child_removed (swap! data update-in path dissoc key)
-            (.log js/console (clj->js [event key val]))))
-        (recur)))))

 (defn unbind-item-sync!
   [data path]
@@ -176,3 +128,42 @@
     (swap! data dissoc-in path)
     (swap! channel-closers assoc-in identifier
            (init-item-sync! data id path))))
+
+
+(declare bind!)
+
+(defn story-binder [data path msg]
+  (let [[event key val] msg
+        child-path (conj path key)]
+    (case event
+      :child_added (swap! data assoc-in child-path val)
+      :child_changed (swap! data assoc-in child-path val)
+      :child_removed (swap! data update-in path dissoc key)
+      (.log js/console (clj->js [event key val])))))
+
+(defn stories-binder [data path msg]
+  (let [[event key val] msg
+        child-path (conj path key)]
+    (case event
+      :child_added (bind! data child-path
+                          (id->fbref val)
+                          story-binder)
+      :child_changed (bind! data child-path
+                            (id->fbref val)
+                            story-binder)
+      (.log js/console (clj->js [event key val])))))
+
+(defn bind! [data path ref binder]
+  (close-channel! data path)
+  (let [close-chan (chan)
+        fbc (fb->chan ref close-chan)]
+    (save-channel-closer! data path close-chan)
+    (go-loop []
+      (when-let [msg (<! fbc)]
+        (binder data path msg)
+        (recur)))
+    close-chan))
+
+(defn init-stories-sync! [data path]
+  (let [ref (walk-root root [:topstories])]
+    (bind! data path ref stories-binder)))


Cleanup

Cleanup

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -8,7 +8,7 @@

 (defonce root (js/Firebase. url))

-(defonce channels (atom {}))
+(defonce channel-closers (atom {}))

 (defn- walk-root [r keys]
   (let [[k & ks] keys]
@@ -81,18 +81,18 @@
        (when-let [msg (<! fbc)]
          (let [[event key val] msg
                child-path (conj path key)]
-           (case event
+           (case event
              :child_added (swap! data assoc-in child-path val)
              :child_changed (swap! data assoc-in child-path val)
-             :child_removed (swap! data update-in path dissoc key)
+             :child_removed (swap! data update-in path dissoc key)
              (.log js/console (clj->js [event key val]))))
          (recur)))
      data)))

-(defn unbind-sync!
+(defn unbind-item-sync!
   [data path]
   (let [identifier (cons data path)]
-    (when-let [close-chan (get-in @channels identifier)]
+    (when-let [close-chan (get-in @channel-closers identifier)]
       (put! close-chan :close))
     (swap! data update-in path dissoc :item)))

@@ -130,17 +130,16 @@
                :child_removed (swap! data update-in path dissoc key)
                (.log js/console (clj->js [event key val]))))
            (recur)))
-       ;; The go loop still processes messages even after using .off
-       ;; on the source. As a workaround for now, create another tap
-       ;; on the close-mult and manually close the channel here.
+       ;; Close this go-loop as well in case it's not GC'ed.
+       ;; Should investigate.
        (go (<! close-loop-tap)
            (close! fbc))
        close-mult))))

 (defn reset-item-sync! [id data path]
   (let [identifier (cons data path)]
-    (when-let [close-chan (get-in @channels identifier)]
+    (when-let [close-chan (get-in @channel-closers identifier)]
       (put! close-chan :close))
     (swap! data update-in path dissoc :item)
-    (swap! channels assoc-in identifier
+    (swap! channel-closers assoc-in identifier
            (init-item-sync! data id path))))


Handle the default :pre/:post map if it happens to be used in the defconstrained macro body

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -204,14 +204,16 @@
      (contract ~(symbol (str name "-impl")) ~docstring ~@forms)))

 (defmacro defconstrainedfn
-  "Defines a function using the `contract` scheme with an additional `:body` element.
+  "Defines a function using the `contract` vector appearing after the arguments.

        (defconstrainedfn sqr
          [n] [number? (not= 0 n) => pos? number?]
          (* n n))

    Like the `contract` macro, multiple arity functions can be defined where each argument vector
-   is immediately followed by the relevent arity expectations.
+   is immediately followed by the relevent arity expectations.  This macro will also detect
+   if a map is in that constraints position and use that instead under the assumption that
+   Clojure's `:pre`/`:post` map is used instead.
   "
   [name & body]
   (let [mdata (if (string? (first body))
@@ -225,7 +227,9 @@
                 body)
         body  (for [[args cnstr & bd] body]
                 (list* args
-                       (second (build-constraints-map args cnstr))
+                       (if (map? cnstr)
+                         cnstr
+                         (second (build-constraints-map args cnstr)))
                        bd))]
     `(defn ~name
        ~(if (:doc mdata) (:doc mdata) "")