Fix ls-file-names to only return the file names not the full path

--- src/overtone/helpers/file.clj
+++ src/overtone/helpers/file.clj
@@ -80,7 +80,7 @@
   of only the files within."
   [path]
   (let [files (filter #(.isFile %) (ls* path))]
-    (files->abs-paths files)))
+    (files->names files)))

 (defn ls-dir-paths
   "Given a path to a directory, returns a seq of strings representing the full


add docstrings

add docstrings

--- src/overtone/sc/ugen/core.clj
+++ src/overtone/sc/ugen/core.clj
@@ -12,7 +12,7 @@
 (def ugen-collide-ns-str "overtone.sc.ugen-collide")
 (defonce ugen-collide-ns (create-ns (symbol ugen-collide-ns-str)))
 (defonce overloaded-ugens* (atom {}))
-
+(defonce special-op-specs* (atom {}))

 (defn- op-rate
   "Lookup the rate of an input ugen, otherwise use IR because the operand
@@ -264,8 +264,6 @@
                       (:fn-names spec))]
     (doseq [[ugen-name ugen-fn] ugen-fns]
       (intern to-ns ugen-name ugen-fn))))
-
-(defonce special-op-specs* (atom {}))

 (defn- def-unary-op
   "def a unary op ugen (this is handled separately due to the fact that the
@@ -330,6 +328,9 @@
        (def-binary-op to-ns op-name special))))

 (defmacro with-overloaded-ugens
+  "Bind symbols for all overloaded ugens (i.e. + - / etc.) to the overloaded fn
+  in the ns overtone.sc.ugen-colliders. These fns will revert back to original
+  (Clojure) semantics if not passed with ugen args."
   [& body]
   (let [bindings (flatten (map (fn [[orig overload]]
                                  [orig (symbol ugen-collide-ns-str (str overload))])
@@ -338,5 +339,6 @@
       ~@body)))

 (defn combined-specs
+  "Return a combination of ugen specs and the auto-generated special-op specs."
   []
   (merge UGEN-SPECS @special-op-specs*))


Fix failed validation flow (#1023)

Fix failed validation flow (#1023)

Also enforce latest naming requirements on method names

--- src/cljs/main/broadfcui/page/method_repo/method/exporter.cljs
+++ src/cljs/main/broadfcui/page/method_repo/method/exporter.cljs
@@ -135,7 +135,8 @@
                           :defaultValue (if (= selected-config :blank)
                                           method-name
                                           (:name selected-config))
-                          :predicates [(input/nonempty "Name")]}]
+                          :predicates [(input/nonempty "Name")
+                                       (input/alphanumeric_-period "Name")]}]
         (when (= selected-config :blank)
           (list
            (style/create-form-label "Root Entity Type")
@@ -165,14 +166,16 @@
                        :onClick #(this :-export)}]))
    :-export
    (fn [{:keys [props state refs this]}]
-     (swap! state assoc :validation-errors nil :banner "Resolving...")
      (let [[name & errors] (input/get-and-validate refs "name-field")
            new-id (assoc (select-keys (:method-id props) [:namespace])
                     :name name)
            {:keys [selected-config]} @state]
        (cond errors (swap! state assoc :validation-errors errors)
              (= :blank selected-config) (this :-create-template new-id)
-             :else (this :-export-loaded-config (merge (:payloadObject selected-config) new-id)))))
+             :else (do
+                     (this :-export-loaded-config (merge (:payloadObject selected-config) new-id))
+                     (swap! state assoc :banner "Resolving...")))))
+
    :-create-template
    (fn [{:keys [props state refs this]} new-id]
      (swap! state assoc :banner "Creating template...")


CMR-620: Added granule counts to json results.

--- src/cmr/search/results_handlers/atom_json_results_handler.clj
+++ src/cmr/search/results_handlers/atom_json_results_handler.clj
@@ -29,10 +29,15 @@
        :items
        (map :id)))

-(defn- collection-atom-reference->json
-  "Converts a search result collection atom reference into json"
-  [reference]
-  (let [{:keys [id score title short-name version-id summary updated dataset-id collection-data-type
+(defmulti atom-reference->json
+  "Converts a search result atom reference into json"
+  (fn [results concept-type reference]
+    concept-type))
+
+(defmethod atom-reference->json :collection
+  [results concept-type reference]
+  (let [granule-counts-map (:granule-counts results)
+        {:keys [id score title short-name version-id summary updated dataset-id collection-data-type
                 processing-level-id original-format data-center archive-center start-date end-date
                 atom-links associated-difs online-access-flag browse-flag coordinate-system shapes]} reference
         shape-result (atom-spatial/shapes->json shapes)
@@ -54,15 +59,15 @@
                        :dif_ids associated-difs
                        :online_access_flag online-access-flag
                        :browse_flag browse-flag
+                       :granule_count (when granule-counts-map (get granule-counts-map id 0))
                        :links (map atom/atom-link->attribute-map atom-links)
                        :coordinate_system coordinate-system}
                       shape-result)]
     ;; remove entries with nil value
     (util/remove-nil-keys result)))

-(defn- granule-atom-reference->json
-  "Converts a search result granule atom reference into json"
-  [reference]
+(defmethod atom-reference->json :granule
+  [results concept-type reference]
   (let [{:keys [id title updated dataset-id producer-gran-id size original-format
                 data-center start-date end-date atom-links online-access-flag browse-flag
                 day-night cloud-cover coordinate-system shapes]} reference
@@ -91,15 +96,13 @@
   [context query results]
   (let [{:keys [items]} results
         {:keys [concept-type result-format]} query
-        atom-reference-to-json-fn (if (= :granule concept-type) granule-atom-reference->json
-                                    collection-atom-reference->json)
         items (if (= :granule (:concept-type query))
                 (atom/append-collection-links context items)
                 items)
         response-results {:feed
                           {:updated (str (time/now))
                            :id (url/atom-request-url context concept-type result-format)
-                           :title (atom/concept-type->atom-title (:concept-type query))
-                           :entry (map atom-reference-to-json-fn items)}}]
+                           :title (atom/concept-type->atom-title concept-type)
+                           :entry (map (partial atom-reference->json results concept-type) items)}}]
     (json/generate-string response-results {:pretty (:pretty? query)})))


Used the apply-filter and filter-tasks functions in generate-report. Not completely finished.

--- kanbanik-statistics/src/main/clojure/org/kanbanik/statistics.clj
+++ kanbanik-statistics/src/main/clojure/org/kanbanik/statistics.clj
@@ -59,20 +59,14 @@

 Currently supports only the workflowitem-id.
 "
-(filter (fn [task]
-  (= (:workflowitem-id filter-conditions) (:workflowitem-id task)))
-  tasks)
+  (filter
+   (fn [task] (= (:workflowitem-id filter-conditions) (:workflowitem-id task)))
+    tasks)
 )

 (defn apply-function [function tasks]
   ((function functions) tasks)
 )
-
-"maybe delete because the above two should do the trick"
-(defn calculate-one [function filter tasks]
-1
-)
-

 (defn generate-report [descriptor tasks]
 "
@@ -87,12 +81,13 @@
   (loop [res [] desc descriptor]
     (if (= (count desc) 0)
       res
-      (if (:children (first desc))
-        (recur (conj res [(calculate-one (:function (first desc)) (:filter (first desc)) tasks) (generate-report (:children (first desc)) tasks)]) (rest desc))
-        (recur (conj res 103) (rest desc))
-      )
+      (let [filtered-tasks (apply-filter (:filter (first desc)) tasks) function (:function (first desc))]
+           (if (:children (first desc))
+             (recur (conj res [(apply-function function filtered-tasks) (generate-report (:children (first desc)) filtered-tasks)]) (rest desc))
+             (recur (conj res (apply-function function filtered-tasks)) (rest desc))
+             )
+       )
     )
   )
-
 )


remove test for now-disallowed feature

remove test for now-disallowed feature

--- test/chat/test/server/db.clj
+++ test/chat/test/server/db.clj
@@ -409,46 +409,6 @@
            (db/get-user-visible-tag-ids (user :id))
            (set (map :id group-tags))))))

-#_(deftest tagging-thread-with-disjoint-groups
-  (let [user-1 (db/create-user! {:id (db/uuid)
-                                 :email "foo@bar.com"
-                                 :password "foobar"
-                                 :avatar ""})
-        user-2 (db/create-user! {:id (db/uuid)
-                                 :email "bar@foo.com"
-                                 :password "foobar"
-                                 :avatar ""})
-        group-1 (db/create-group! {:name "group1" :id (db/uuid)})
-        group-2 (db/create-group! {:name "group2" :id (db/uuid)})
-        tag-1 (db/create-tag! {:id (db/uuid) :name "tag1" :group-id (group-1 :id)})
-        tag-2 (db/create-tag! {:id (db/uuid) :name "tag2" :group-id (group-2 :id)})
-        thread-id (db/uuid)]
-
-    (db/user-add-to-group! (user-1 :id) (group-1 :id))
-    (db/user-subscribe-to-tag! (user-1 :id) (tag-1 :id))
-
-    (db/user-add-to-group! (user-1 :id) (group-2 :id))
-    (db/user-subscribe-to-tag! (user-1 :id) (tag-2 :id))
-
-    (db/user-add-to-group! (user-2 :id) (group-1 :id))
-    (db/user-subscribe-to-tag! (user-2 :id) (tag-1 :id))
-
-    (db/create-message! {:thread-id thread-id :id (db/uuid) :content "zzz"
-                         :user-id (user-1 :id) :created-at (java.util.Date.)
-                         :group-id (group-1 :id)
-                         :mentioned-tag-ids [(tag-1 :id) (tag-2 :id)]})
-
-    (is (db/user-can-see-thread? (user-1 :id) thread-id))
-    (is (db/user-can-see-thread? (user-2 :id) thread-id))
-    (let [u1-threads (db/get-open-threads-for-user (user-1 :id))
-          u2-threads (db/get-open-threads-for-user (user-2 :id))]
-      (is (= 1 (count u1-threads)))
-      (is (= 1 (count u2-threads)))
-      (is (= #{(tag-1 :id) (tag-2 :id)}
-             (set (:tag-ids (first u1-threads)))))
-      (is (= #{(tag-1 :id)}
-             (set (:tag-ids (first u2-threads))))))))
-
 (deftest extension-permissions
   (let [group-1 (db/create-group! {:id (db/uuid) :name "g1"})
         group-2 (db/create-group! {:id (db/uuid) :name "g2"})


ast adjustments

ast adjustments

--- src/clsl/ast.clj
+++ src/clsl/ast.clj
@@ -7,9 +7,9 @@
      (def ~name ~(symbol (str "->" name "-rec")))))

 (def-ast-type root [defns])
-(def-ast-type decl [id maybe-initialized-to])
-(def-ast-type fundef [id type params body])
-(def-ast-type param-decl [id type])
+(def-ast-type decl [id type maybe-initialized-to])
+(def-ast-type fun-def [id type params body])
+(def-ast-type param-decl [type maybe-id])
 (def-ast-type empty-expression [])
 (def-ast-type expression-stmt [expr])
 (def-ast-type jump [kind maybe-value])
@@ -30,4 +30,4 @@
 (def-ast-type identifier [id])
 (def-ast-type fun-call [func maybe-args])
 (def-ast-type type-decl [type maybe-array-spec])
-(def-ast-type type [name maybe-qualifiers])
+(def-ast-type full-type [name maybe-qualifiers])


CMR-2124: Adding comment to grant all admin.

--- access-control-app/int_test/cmr/access_control/int_test/access_control_test_util.clj
+++ access-control-app/int_test/cmr/access_control/int_test/access_control_test_util.clj
@@ -72,6 +72,7 @@
   (mock-echo-client/reset (conn-context))
   (mdb/reset (conn-context))
   (ac/reset (conn-context))
+  ;; Temporarily granting all admin. Remove this when implementing  CMR-2133, CMR-2134
   (e/grant-all-admin (conn-context))
   (f))


add login tests

add login tests

--- test/otaservice/api_test.clj
+++ test/otaservice/api_test.clj
@@ -3,43 +3,70 @@
   (:require [ring.mock.request :as mock]
             [cheshire.core :as cheshire]
             [deploy :refer :all]
+            [buddy.sign.jwt :as jwt]
+            [environ.core :refer [env]]
             [otaservice.api :refer [rest-api]]))

 (defn parse-body [body]
   (cheshire/parse-string (slurp body) true))

+(defn register-req [query]
+  (rest-api (-> (mock/request :post "/api/v1/register")
+                (mock/content-type "application/json")
+                (mock/body (cheshire/generate-string query)))))
+
+(defn login-req [query]
+  (rest-api (-> (mock/request :post "/api/v1/login")
+                (mock/content-type "application/json")
+                (mock/body (cheshire/generate-string query)))))
+
 (with-state-changes [(before :facts (migrate))
                      (after :facts (rollback-all))]
-  (facts "about authentication"
-         (let [register-req #(rest-api (-> (mock/request :post "/api/v1/register")
-                                           (mock/content-type "application/json")
-                                           (mock/body (cheshire/generate-string %))))]

-           (fact "if register with short login/pass proper error returned"
-                 (let [response (register-req {:username "tes" :password "passwor"})
+  (facts "about registration"
+         (fact "if register with short login/pass proper error returned"
+               (let [response (register-req {:username "tes" :password "passwor"})
+                     body (parse-body (:body response))]
+                 (:status response) => 400
+                 (:error body) => {:username ["Username length must be greater than 3"]
+                                   :password ["Password length must be greater than 7"]}))
+
+         (fact "correctly filled field do not show up in error message"
+               (let [response (register-req {:username "user" :password "wrong"})
+                     body (parse-body (:body response))]
+                 (:status response) => 400
+                 (:error body) =not=> (contains {:username anything})
+                 (:error body) => (contains {:password anything})))
+
+         (fact "successful registration returns username"
+               (let [sameuser "user"
+                     response (register-req {:username sameuser :password "password"})
+                     body (parse-body (:body response))]
+                 (:status response) => 200
+                 (:identity body) => sameuser))
+
+         (fact "registering with existing username returns proper code and error"
+               (let [sameuser "user"
+                     _ (register-req {:username sameuser :password "password"})
+                     response (register-req {:username sameuser :password "anything"})
+                     body (parse-body (:body response))]
+                 (:status response) => 409
+                 (:error body) => "User already exists"))))
+
+(let [creds {:username "user" :password "password"}
+      inv-pass {:username "user" :password "wrong"}]
+  (with-state-changes [(before :contents (do (migrate)
+                                             (register-req creds)))
+                       (after :contents (rollback-all))]
+
+    (facts "about authentication"
+           (fact "cannot login with wrong password"
+                 (let [response (login-req inv-pass)
                        body (parse-body (:body response))]
-                   (:status response) => 400
-                   (:error body) => {:username ["Username length must be greater than 3"]
-                                     :password ["Password length must be greater than 7"]}))
-
-           (fact "correctly filled field do not show up in error message"
-                 (let [response (register-req {:username "user" :password "wrong"})
-                       body (parse-body (:body response))]
-                   (:status response) => 400
-                   (:error body) =not=> (contains {:username anything})
-                   (:error body) => (contains {:password anything})))
-
-           (fact "successful registration returns username"
-                 (let [sameuser "user"
-                       response (register-req {:username sameuser :password "password"})
+                   (:status response) => 401
+                   (:error body) => "Wrong credentials"))
+           (fact "successful login returns JWS token with encrypted identity"
+                 (let [response (login-req creds)
                        body (parse-body (:body response))]
                    (:status response) => 200
-                   (:identity body) => sameuser))
-
-           (fact "registering with existing username returns proper code and error"
-                 (let [sameuser "user"
-                       _ (register-req {:username sameuser :password "password"})
-                       response (register-req {:username sameuser :password "anything"})
-                       body (parse-body (:body response))]
-                   (:status response) => 409
-                   (:error body) => "User already exists")))))
+                   (jwt/unsign (:token body) (env :secret)) => {:user (:username creds)})))))


Small readability improvements

Small readability improvements

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -183,33 +183,43 @@
         (diff* before after props)]
     (update-in added [:tree] merge (:tree changed))))

+;;; end modified boot functions
+
+(defn diff-filesets
+  [before after uses-meta]
+  (if uses-meta
+    ;; Change `fileset-diff` to `boot/fileset-diff` when
+    ;; https://github.com/boot-clj/boot/pull/566 is merged
+    (let [diff (fileset-diff before after :hash pm/+meta-key+)]
+      {:content-diff diff
+       :meta-diff diff})
+    {:content-diff (fileset-diff before after :hash)
+     :meta-diff (fileset-diff before after pm/+meta-key+)}))
+
 (defn content-pre-wrap
   "Wrapper for input parsing tasks. Calls `parse-form` on new or changed
   files with extensions in `extensions`, adds `tracer` to `:io.perun/trace`
   and writes files for subsequent tasks to process, if desired.
   `output-extension` can be used to indicate the type of file the task produces,
   or pass `nil` to overwrite with a file of the same name and extension. Pass
-  `pod` if one is needed for parsing"
-  [{:keys [parse-form-fn extensions output-extension tracer options pod]}]
+  `pod` if one is needed for parsing. Set `uses-meta` to `true` if parsing
+  depends on Perun metadata"
+  [{:keys [parse-form-fn extensions output-extension tracer options pod uses-meta]}]
   (let [tmp  (boot/tmp-dir!)
         prev (atom {})]
     (boot/with-pre-wrap fileset
-      (let [global-meta (pm/get-global-meta fileset)
-            prev-fs (:fs @prev)
-            content-changed-files (boot/fileset-diff prev-fs fileset :hash)
-            ;; Change `fileset-diff` to `boot/fileset-diff` when
-            ;; https://github.com/boot-clj/boot/pull/566 is merged
-            meta-changed-files (fileset-diff prev-fs fileset pm/+meta-key+)
-            parse-form (parse-form-fn (meta-by-ext content-changed-files extensions))
+      (let [{:keys [content-diff meta-diff]} (diff-filesets (:fs @prev) fileset uses-meta)
+            parse-form (parse-form-fn (meta-by-ext content-diff extensions))
             changed-meta (->> (if pod
                                 (pod/with-call-in @pod ~parse-form)
                                 (eval parse-form))
-                              (pm/merge-meta (meta-by-ext meta-changed-files extensions))
+                              (pm/merge-meta (meta-by-ext meta-diff extensions))
                               (trace tracer))
             input-fs (-> fileset
                          (pm/set-meta (:meta @prev))
                          (pm/set-meta changed-meta))
             input-meta (meta-by-ext input-fs extensions)
+            global-meta (pm/get-global-meta fileset)
             output-meta (doall
                          (for [{:keys [path parsed filename] :as entry*} input-meta]
                            (let [out-dir (:out-dir options)


CMR-1848: Removed an unused namespace

CMR-1848: Removed an unused namespace

--- umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
+++ umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
@@ -6,7 +6,6 @@
             [cmr.umm-spec.models.collection :as umm-c]
             [cmr.umm-spec.models.common :as cmn]
             [clj-time.core :as t]
-            [cmr.common.util :as util]
             [cmr.umm-spec.umm-to-xml-mappings.dif10 :as dif10]))

 (def example-record


Updated opencl alter implementations.

Updated opencl alter implementations.

--- src/clojure/uncomplicate/neanderthal/internal/opencl/clblock.clj
+++ src/clojure/uncomplicate/neanderthal/internal/opencl/clblock.clj
@@ -197,6 +197,8 @@
     (.set x val))
   (setBoxed [x i val]
     (.set x i val))
+  (alter [_ _]
+    (throw (UnsupportedOperationException. INEFFICIENT_OPERATION_MSG)))
   (alter [_ _ _]
     (throw (UnsupportedOperationException. INEFFICIENT_OPERATION_MSG)))
   RealVector
@@ -372,7 +374,9 @@
     (.set a val))
   (setBoxed [a i j val]
     (.set a i j val))
-  (alter [a i j f]
+  (alter [a _]
+    (throw (UnsupportedOperationException. INEFFICIENT_OPERATION_MSG)))
+  (alter [a _ _ _]
     (throw (UnsupportedOperationException. INEFFICIENT_OPERATION_MSG)))
   RealMatrix
   (mrows [_]
@@ -560,7 +564,9 @@
     (.set a val))
   (setBoxed [a i j val]
     (.set a i j val))
-  (alter [a i j f]
+  (alter [a _]
+    (throw (UnsupportedOperationException. INEFFICIENT_OPERATION_MSG)))
+  (alter [a _ _ _]
     (throw (UnsupportedOperationException. INEFFICIENT_OPERATION_MSG)))
   RealMatrix
   (mrows [_]


Resolved merge conflict.

Resolved merge conflict.

--- test/cmr/system_int_test/search/granule_temporal_search_test.clj
+++ test/cmr/system_int_test/search/granule_temporal_search_test.clj
@@ -77,3 +77,4 @@
     (let [{:keys [status errors]} (search/find-refs :granule {"temporal[]" "2011-01-01T10:00:00Z,2010-01-10T12:00:00Z"})]
       (is (= 422 status))
       (is (re-find #"start_date \[2011-01-01T10:00:00Z\] must be before end_date \[2010-01-10T12:00:00Z\]" (first errors))))))
+


[btf]

[btf]

--- src/ombs/db/old.clj
+++ src/ombs/db/old.clj
@@ -143,8 +143,7 @@

 (defn get-event
   ([ename date] (get-event (get-eid ename date)))
-  ([eid] (first (sql/select events (sql/where {:id eid}))))
-  )
+  ([eid] (first (sql/select events (sql/where {:id eid})))))

 (defn get-price
   ([ename date]


Require aeron directly from system Now that it's our only messaging layer we can directly require it. I saw some past weirdness because of this when not using onyx as a peer. We can remove this later and go back to the old way if we add another messaging layer.

--- src/onyx/system.clj
+++ src/onyx/system.clj
@@ -6,6 +6,7 @@
             [onyx.peer.task-lifecycle :refer [task-lifecycle new-task-information]]
             [onyx.peer.backpressure-poll :refer [backpressure-poll]]
             [onyx.messaging.acking-daemon :refer [acking-daemon]]
+            [onyx.messaging.aeron]
             [onyx.messaging.common :refer [messenger messaging-require messaging-peer-group]]
             [onyx.messaging.messenger-buffer :as buffer]
             [onyx.monitoring.no-op-monitoring]


(SERVER-1741) Add expected values for = in tests

For some unknown reason some test cases had equality checks with a
single value that were passing, but bumping tk-ws-jetty9 uncovered them.
This commit adds the appropriate values to the test cases.

--- test/integration/puppetlabs/services/legacy_routes/legacy_routes_test.clj
+++ test/integration/puppetlabs/services/legacy_routes/legacy_routes_test.clj
@@ -290,7 +290,7 @@
                  "1.2.3")))
      (let [node-response (http-get "/puppet/v3/node/localhost?environment=production")]
        (is (= 200 (:status node-response)))
-       (is (= "request routed to: /puppet/v3/node/localhost")))))
+       (is (= "request routed to: /puppet/v3/node/localhost" (:body node-response))))))

   (testing "The new map-style multi-server route configuration map still works."
     ;; For a multi-server config, we need to remove the existing webserver
@@ -328,7 +328,7 @@
                    "1.2.3")))
        (let [node-response (http-get "/puppet/v3/node/localhost?environment=production")]
          (is (= 200 (:status node-response)))
-         (is (= "request routed to: /puppet/v3/node/localhost"))))))
+         (is (= "request routed to: /puppet/v3/node/localhost" (:body node-response)))))))

   (testing "An exception is thrown if an improper master service route is found."
     (logutils/with-test-logging


Add tests for secretbox-rnd

Add tests for secretbox-rnd

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -65,3 +65,54 @@
       (is (thrown-with-msg?
            RuntimeException #"Ciphertext verification failed"
            (ms/open forgery st/secret-key))))))
+
+(deftest secretbox-rnd-test
+  (let [ctext (ms/secretbox-rnd st/ptext st/secret-key)
+        ptextlen (alength ^bytes st/ptext)]
+    (is (= (+ s/noncebytes ptextlen s/macbytes)
+           (alength ^bytes ctext)))
+
+    (let [out (byte-array ptextlen)]
+      (ms/decrypt-to-buf! out st/secret-key ctext)
+      (is (u/array-eq st/ptext out)))
+
+    (let [out (byte-array ptextlen)
+          forgery (r/randombytes (alength ^bytes out))]
+      (is (thrown-with-msg?
+           RuntimeException #"Ciphertext verification failed"
+           (ms/decrypt-to-buf! out st/secret-key forgery))))
+
+    (is (u/array-eq st/ptext (ms/decrypt st/secret-key ctext)))
+
+    (let [forgery (r/randombytes (alength ^bytes ctext))]
+      (is (thrown-with-msg?
+           RuntimeException #"Ciphertext verification failed"
+           (ms/decrypt st/secret-key forgery))))
+
+    (let [out (byte-array ptextlen)]
+      (ms/open-to-buf! out ctext st/secret-key)
+      (is (u/array-eq st/ptext out)))
+
+    (let [out (byte-array ptextlen)
+          forgery (r/randombytes (alength ^bytes out))]
+      (is (thrown-with-msg?
+           RuntimeException #"Ciphertext verification failed"
+           (ms/open-to-buf! out forgery st/secret-key))))
+
+    (is (u/array-eq st/ptext (ms/open ctext st/secret-key)))
+
+    (let [forgery (r/randombytes (alength ^bytes ctext))]
+      (is (thrown-with-msg?
+           RuntimeException #"Ciphertext verification failed"
+           (ms/open forgery st/secret-key)))))
+
+  (let [c1 (ms/secretbox-rnd st/ptext st/secret-key)
+        c2 (ms/secretbox-rnd st/ptext st/secret-key)]
+    (is (not (u/array-eq c1 c2)))
+    (is (not= (take s/noncebytes c1) (take s/noncebytes c2))))
+
+  (with-redefs [ms/random-nonce! (constantly (byte-array (range s/noncebytes)))]
+    (let [c1 (ms/secretbox-rnd st/ptext st/secret-key)
+          c2 (ms/secretbox-rnd st/ptext st/secret-key)]
+      (is (u/array-eq c1 c2))
+      (is (= (range s/noncebytes) (take s/noncebytes c1) (take s/noncebytes c2))))))


test change

test change

--- src/demo/web.clj
+++ src/demo/web.clj
@@ -23,7 +23,7 @@
   (let [count (:count session 0)
         session (assoc session :count (inc count))]
     (println "counter =>" count)
-    (-> (response (str "You accessed this page " count " times\n"))
+    (-> (response (str "You accessed this page " 1000  " times\n"))
       (assoc :session session))))

 (defn reverser


Fixing tree traversal

Fixing tree traversal

--- src/dev/core.clj
+++ src/dev/core.clj
@@ -9,7 +9,8 @@
 (defmulti processtreepart
   (fn [el]
     (if (coll? el)
-      (first el))))
+      (first el)
+      )))

 (defn tree-assembler
@@ -18,15 +19,16 @@
   ([tree form]
    (let [processed (processtreepart form)
          children (if (coll? form)
-                    (map (fn [el] (walk-tree el tree-assembler)) form)
+                    (map (fn [el] (walk-tree el #'tree-assembler)) form)
                     nil)]
      (if (nil? processed)
        (if (empty? children)
-         tree
-         (conj tree children))
+         nil
+         children))
        (if (empty? children)
-         (conj tree processed)
-         (replace-last (conj tree processed) children))))))
+         processed
+         [processed [children]]))))
+

 (defn walk-tree [top processor-fn]
   (let [children (map (fn [element]


fixed an issue with nil in %w calls

fixed an issue with nil in %w calls

--- src/minimaliterals/core.clj
+++ src/minimaliterals/core.clj
@@ -4,7 +4,7 @@
 (defmacro %w
   "strings list litteral, e.g.: (%w a b c) => '(\"a\" \"b\" \"c\")"
   [& els]
-  `(map str '~els))
+  `(map (fn [x#] (if (nil? x#) "nil" (str x#))) '~els))

 (defmacro %q
   "string litteral, e.g.: (%q a b c) => \"a b c\""


Need to bring in error.

Need to bring in error.

--- src/onyx_benchmark/peer.clj
+++ src/onyx_benchmark/peer.clj
@@ -4,7 +4,7 @@
             [riemann.client :as r]
             [onyx.peer.pipeline-extensions :as p-ext]
             [taoensso.timbre.appenders.rotor :as rotor]
-            [taoensso.timbre :refer  [info warn trace fatal level-compile-time] :as timbre]
+            [taoensso.timbre :refer  [info warn trace fatal error] :as timbre]
             [onyx.plugin.bench-plugin]
             [onyx.plugin.core-async]
             [onyx.api]))


remove unused find-data-file fn

remove unused find-data-file fn

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -14,9 +14,6 @@
       (update-in [:dependencies] into deps)
       pod/make-pod
       future))
-
-(defn find-data-file [fileset filename]
-  (->> fileset boot/input-files (boot/by-name [filename]) first))

 (def ^:private markdown-deps
   '[[endophile "0.1.2"]


add docstrings

add docstrings

--- src/overtone/libs/event.clj
+++ src/overtone/libs/event.clj
@@ -134,13 +134,15 @@
                    key)))

 (defn oneshot-event
-  ""
+  "Add a one-shot handler which will be removed when called. This
+   handler is guaranteed to be called only once."
   [event-type handler key]
   (log-event "Registering async self-removing event handler:: " event-type " with key: " key)
   (handlers/add-one-shot-handler! handler-pool event-type key handler))

 (defn oneshot-sync-event
-  ""
+  "Add a synchronous one-shot handler which will be removed when called. This
+   handler is guaranteed to be called only once."
   [event-type handler key]
   (log-event "Registering sync self-removing event handler:: " event-type " with key: " key)
   (handlers/add-one-shot-sync-handler! handler-pool event-type key handler))


refactor

refactor

--- src/om_bootstrap/util.cljs
+++ src/om_bootstrap/util.cljs
@@ -31,16 +31,15 @@
 ;;
 ;; Some of these are rewritten from various React addons.

-(sm/defn om-component? :- s/Bool
-  [x]
-  (boolean
-   (aget (.-props x) "__om_cursor")))
-
 (defn get-props
   "This is the same as om.core/get-props. We added it to get around
   the new precondition in Om 0.8.0."
   [x]
   (aget (.-props x) "__om_cursor"))
+
+(sm/defn om-component? :- s/Bool
+  [x]
+  (boolean (get-props x)))

 (sm/defn strict-valid-component? :- s/Bool
   "TODO: Once Om updates its externs to include this file, we can


reply to health checks

reply to health checks

--- src/pc/http/admin/outer.clj
+++ src/pc/http/admin/outer.clj
@@ -15,6 +15,9 @@
                                            "Please log in with Google"]
                                      "."]))))

+(defpage root "/health-check" [req]
+  {:status 200 :body ":up"})
+
 (defpage google-auth "/auth/google" [req]
   (let [{:strs [code state]} (-> req :query-string url/query->map pc.utils/inspect)
         parsed-state (-> state url/url-decode json/decode pc.utils/inspect)]


Comment out consumer count for now.

Comment out consumer count for now.

--- src/onyx/queue/hornetq.clj
+++ src/onyx/queue/hornetq.clj
@@ -95,36 +95,38 @@

 (defmethod extensions/n-consumers HornetQClusteredConnection
   [queue queue-name]
-  (let [session (.createSession (:session-factory queue))
-        requestor (ClientRequestor. session "jms.queue.hornetq.management")
-        message (.createMessage session false)
-        attr (format "core.clusterconnection.%s" (:cluster-name queue))]
-    (ManagementHelper/putAttribute message attr "nodes")
-    (.start session)
+  ;; (let [session (.createSession (:session-factory queue))
+  ;;       requestor (ClientRequestor. session "jms.queue.hornetq.management")
+  ;;       message (.createMessage session false)
+  ;;       attr (format "core.clusterconnection.%s" (:cluster-name queue))]
+  ;;   (ManagementHelper/putAttribute message attr "nodes")
+  ;;   (.start session)

-    (let [reply (.request requestor message)
-          result (ManagementHelper/getResult reply)
-          host-port-pairs
-          (map (fn [x] (let [[h p] (split x #":")]
-                        [(second (split h #"/")) p]))
-               (vals result))
-          locators (map (partial apply connect-standalone) host-port-pairs)
-          session-factories (map #(.createSessionFactory %) locators)
-          sessions (map (fn [sf] (let [s (.createSession sf)] (.start s) s)) session-factories)
-          consumer-counts
-          (doall
-           (map (fn [s]
-                  (.start s)
-                  (let [query (.queueQuery s (SimpleString. queue-name))
-                        n (.getConsumerCount query)]
-                    (.close s)
-                    n))
-                sessions))]
-      (.close session)
-      (doall (map #(.close %) sessions))
-      (doall (map #(.close %) session-factories))
-      (doall (map #(.close %) locators))
-      (apply + consumer-counts))))
+  ;;   (let [reply (.request requestor message)
+  ;;         result (ManagementHelper/getResult reply)
+  ;;         host-port-pairs
+  ;;         (map (fn [x] (let [[h p] (split x #":")]
+  ;;                       [(second (split h #"/")) p]))
+  ;;              (vals result))
+  ;;         locators (map (partial apply connect-standalone) host-port-pairs)
+  ;;         session-factories (map #(.createSessionFactory %) locators)
+  ;;         sessions (map (fn [sf] (let [s (.createSession sf)] (.start s) s)) session-factories)
+  ;;         consumer-counts
+  ;;         (doall
+  ;;          (map (fn [s]
+  ;;                 (.start s)
+  ;;                 (let [query (.queueQuery s (SimpleString. queue-name))
+  ;;                       n (.getConsumerCount query)]
+  ;;                   (.close s)
+  ;;                   n))
+  ;;               sessions))]
+  ;;     (.close session)
+  ;;     (doall (map #(.close %) sessions))
+  ;;     (doall (map #(.close %) session-factories))
+  ;;     (doall (map #(.close %) locators))
+  ;;     (apply + consumer-counts)))
+  0
+  )

 (defmethod extensions/bootstrap-queue HornetQClusteredConnection
   [queue task]


syntax fix

syntax fix

--- src/otp_api_proxy/core.clj
+++ src/otp_api_proxy/core.clj
@@ -436,7 +436,7 @@
      You should have received a copy of the GNU General Public License
      along with this program.  If not, see <http://www.gnu.org/licenses/>.
    */
-	decodePolyline : function(polyline) {
+	var decodePolyline = function(polyline) {

 		  var currentPosition = 0;


include route span

include route span

--- src/otp_api_proxy/core.clj
+++ src/otp_api_proxy/core.clj
@@ -145,9 +145,8 @@
       (first (filter #(= (:route_id %) route-id) routes )))))

 (defn anaheim-route-span [route-id day-in-la]
-  (let [routes (load-anaheim-routes!!)]
-    (:route_url
-      (first (filter #(= (:route_id %) route-id) routes )))))
+  ;; should we do any caching here??
+  (gtfs-api-routes-span-request route-id day-in-la))

 (defn anaheim-stop-text2go [stop-id]
   (let [stops (load-anaheim-stops!!)]
@@ -178,26 +177,48 @@
 (defn itinernary->add-text2go
   "add text2go codes into the stopCode field of an OTP Itinerary"
   [itin]
-  (let [add-code (fn [i path]
-                   (assoc-in i
-                             (concat path [:stopCode])
-                             (anaheim-stop-text2go
-                               (get-in i (concat path [:stopId :id])))))
-        walk-add-code (fn [i]
-                        (clojure.walk/postwalk
-                          (fn [x]
-                            (if (:stopId x)
-                              (assoc x
-                                     :stopCode
-                                     (anaheim-stop-text2go
-                                       (get-in x [:stopId :id])))
-                              x))
-                          i))]
-    (-> itin
-        (add-code [:from])
-        (add-code [:to])
-        (walk-add-code)
-        )))
+  (let [walk-add-code (fn [x]
+                        (if (:stopId x)
+                          (assoc x
+                                 :stopCode
+                                 (anaheim-stop-text2go
+                                   (get-in x [:stopId :id])))
+                          x))]
+    (clojure.walk/postwalk walk-add-code itin)))
+
+(defn itinernary->add-route-url
+  "add routeUrl (schedule information) for each route in otp itinerary."
+  [itin]
+  (let [walk-add-url (fn [x]
+                       (if (:routeId x)
+                         (assoc x
+                                :routeUrl
+                                (anaheim-route-url
+                                  (get x :routeId)))
+                         x))]
+    (clojure.walk/postwalk walk-add-url itin)))
+
+
+(defn service-date->day-in-la
+  "convert service date of the form YYYYMMDD to YYYY-MM-DD"
+  [service-date]
+  (clojure.string/replace service-date #"^(....)(..)(..)$" "$1-$2-$3"))
+
+
+
+;; capture current day in a closure
+(defn itinernary->add-route-span
+  "add routeSpan (service span) for each route in otp itinerary"
+  [itin]
+  (let [walk-add-span (fn [x]
+                       (if (and (:serviceDate x) (:routeId x))
+                         (assoc x
+                                :routeSpan
+                                (anaheim-route-span
+                                  (get x :routeId)
+                                  (service-date->day-in-la (:serviceDate x))))
+                         x))]
+    (clojure.walk/postwalk walk-add-span itin)))

 (defresource ws-echo [echo]
   :last-modified  #inst "2015-04-09"
@@ -219,6 +240,8 @@
                (-> (simple-otp-request-cached)
                    otp-response->itinerary
                    itinernary->add-text2go
+                   itinernary->add-route-url
+                   itinernary->add-route-span
                    )))

 (defresource ws-otp-pass-through [otp-instance route-params params request]


[WR] associate generated xml filename to ctx

--- src/vip/data_processor/s3.clj
+++ src/vip/data_processor/s3.clj
@@ -50,4 +50,4 @@
   (let [new-filename (xml-filename ctx)]
     (put-object (str "processed-feeds/" new-filename)
                 (.toFile (:xml-output-file ctx)))
-    ctx))
+    (assoc ctx :generated-xml-filename new-filename)))


Use restarting supervisor to reconnect.

Use restarting supervisor to reconnect.

--- src/polo_collector/core.clj
+++ src/polo_collector/core.clj
@@ -14,7 +14,8 @@
             [replikativ.crdt.cdvcs.stage :as cs]
             [replikativ.stage :as s]
             [taoensso.timbre :as timbre]
-            [superv.async :refer [go-try <? <?? go-loop-try S]]
+            [superv.async :refer [go-try <? <?? go-loop-try S
+                                  restarting-supervisor]]
             [konserve.core :as k]))

 (timbre/set-level! :info)
@@ -71,7 +72,10 @@
                                                 "realm1"
                                                 #(new-event pending %))
                                        json))
-    (<?? S (peer/connect S polo-client "wss://api.poloniex.com/"))
+    (restarting-supervisor
+     (fn [S]
+       (go-try S
+         (<? S (peer/connect S polo-client "wss://api.poloniex.com/")))))
     ;; we def things here, so we can independently stop and start the stream from the REPL
     ;; HACK block main thread
     (<?? S c)))


New public API fn to better support Java interop.

--- src/onyx/api.clj
+++ src/onyx/api.clj
@@ -300,12 +300,19 @@
 (defn ^{:added "0.6.0"} shutdown-peer
   "Shuts down the virtual peer, which releases all of its resources
    and removes it from the execution of any tasks. This peer will
-   not longer volunteer for tasks."
+   not longer volunteer for tasks. Returns nil."
   [peer]
   (>!! (:shutdown-ch peer) true)
   (<!! (:ack-ch peer))
   (close! (:shutdown-ch peer))
   (close! (:ack-ch peer)))
+
+(defn ^{:added "0.8.1"} shutdown-peers
+  "Like shutdown-peers, but takes a sequence of peers as an argument,
+   shutting each down in order. Returns nil."
+  [peers]
+  (doseq [p peers]
+    (shutdown-peer p)))

 (defn ^{:added "0.6.0"} start-env
   "Starts a development environment using an in-memory implementation ZooKeeper."


141 add filter

141 add filter

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -1236,5 +1236,6 @@
       sets
       (min-set (update sets)))))
 ;;141
-(defn [trump]
-  (fn [game] (map identity game)))
+(defn mk[trump]
+  (fn [[{lead :suit} & rst :as trick]]
+    (sort-by :rank (filter #(= (:suit % trick) lead) trick))))


Fix migration to full urls

Fix migration to full urls

--- frontend/src/faceboard/migrations/m003_socials_to_full_links.cljs
+++ frontend/src/faceboard/migrations/m003_socials_to_full_links.cljs
@@ -10,17 +10,19 @@
       :else [(str/lower (first parts)) (str/lower (second parts))])))

 (defn build-known-url [type id]
-  (condp #(str/starts-with? %2 %1) type                     ; recognized urls from id
-    "facebook" (str "https://www.facebook.com/" id)
-    "twitter" (str "https://twitter.com/" id)
-    "github" (str "https://github.com/" id)
-    "linkedin" (str "https://www.linkedin.com/in/" id)
-    "flickr" (str "https://www.flickr.com/people/" id)
-    "lastfm" (str "http://www.last.fm/user/" id)
-    "hacker-news" (str "https://news.ycombinator.com/user?id=" id)
-    "reddit" (str "http://www.reddit.com/user/" id)
-    "instagram" (str "https://instagram.com/" id)
-    nil))
+  (if (str/starts-with? id "http")
+    id
+    (condp #(str/starts-with? %2 %1) type                   ; recognized urls from id
+      "facebook" (str "https://www.facebook.com/" id)
+      "twitter" (str "https://twitter.com/" id)
+      "github" (str "https://github.com/" id)
+      "linkedin" (str "https://www.linkedin.com/in/" id)
+      "flickr" (str "https://www.flickr.com/people/" id)
+      "lastfm" (str "http://www.last.fm/user/" id)
+      "hacker-news" (str "https://news.ycombinator.com/user?id=" id)
+      "reddit" (str "http://www.reddit.com/user/" id)
+      "instagram" (str "https://instagram.com/" id)
+      nil)))

 (defn- convert-parts [[type id]]
   (or (build-known-url type id) id))


prepare access grant emails

prepare access grant emails

--- src/pc/email.clj
+++ src/pc/email.clj
@@ -2,8 +2,27 @@
   (:require [clojure.string :as str]
             [clj-time.core :as time]
             [clj-time.format]
+            [datomic.api :as d]
             [hiccup.core :as hiccup]
-            [pc.mailgun :as mailgun]))
+            [pc.datomic :as pcd]
+            [pc.mailgun :as mailgun]
+            [pc.models.access-grant :as access-grant-model]))
+
+(defn emails-to-send [db eid]
+  (set (map first
+            (d/q '{:find [?emails]
+                   :in [$ ?e]
+                   :where [[?e :needs-email ?email-eid]
+                           [?email-eid :db/ident ?emails]]}
+                 db eid))))
+
+(defn mark-sent-email
+  "Returns true if this was the first transaction to mark the email as sent. False if it wasn't."
+  [eid email-enum]
+  (let [t @(d/transact (pcd/conn) [[:db/retract eid :needs-email email-enum]
+                                   [:db/add eid :sent-email email-enum]])]
+    (and (contains? (emails-to-send (:db-before t) eid) email-enum)
+         (not (contains? (emails-to-send (:db-after t) eid) email-enum)))))

 (defn chat-invite-html [doc-id]
   (hiccup/html
@@ -23,33 +42,80 @@
               :alt "Images disabled? Just come and take a look."
               :src (str "https://prcrsr.com/document/" doc-id ".png?rand=" (rand))}]]]
      [:p {:style "font-size: 12px"}
-      "Tell us if this message is an error info@prcrsr.com."
+      "Tell us if this message was sent in error info@prcrsr.com."
       ;; Add some hidden text so that Google doesn't try to trim these.
       [:span {:style "display: none; max-height: 0px; font-size: 0px; overflow: hidden;"}
        " Sent at "
        (clj-time.format/unparse (clj-time.format/formatters :rfc822) (time/now))
        "."]]]]))

+(defn format-inviter [inviter]
+  (str/trim (str (:cust/first-name inviter)
+                 (when (and (:cust/first-name inviter)
+                            (:cust/last-name inviter))
+                   (str " " (:cust/last-name inviter)))
+                 " "
+                 (cond (and (not (:cust/last-name inviter))
+                            (:cust/first-name inviter))
+                       (str "(" (:cust/email inviter) ") ")
+
+                       (not (:cust/first-name inviter))
+                       (str (:cust/email inviter) " ")
+
+                       :else nil))))
+
 (defn send-chat-invite [{:keys [cust to-email doc-id]}]
   (mailgun/send-message {:from "Precursor <joinme@prcrsr.com>"
                          :to to-email
-                         :subject (str/trim (str (:cust/first-name cust)
-                                                 (when (and (:cust/first-name cust)
-                                                            (:cust/last-name cust))
-                                                   (str " " (:cust/last-name cust)))
-                                                 " "
-                                                 (cond (and (not (:cust/last-name cust))
-                                                            (:cust/first-name cust))
-                                                       (str "(" (:cust/email cust) ") ")
-
-                                                       (not (:cust/first-name cust))
-                                                       (str (:cust/email cust) " ")
-
-                                                       :else nil)
-                                                 "invited you to a document on Precursor"))
+                         :subject (str (format-inviter cust)
+                                       " invited you to a document on Precursor")
                          :text (str "Hey there,\nCome draw with me on Precursor: https://prcrsr.com/document" doc-id)
                          :html (chat-invite-html doc-id)
                          :o:tracking "yes"
                          :o:tracking-opens "yes"
                          :o:tracking-clicks "no"
                          :o:campaign "chat_invites"}))
+
+(defn access-grant-html [doc-id token]
+  (let [doc-link (str "https://prcrsr.com/document/" doc-id "?access-grant-token=" token)]
+    (hiccup/html
+     [:html
+      [:body
+       [:p
+        "I'm prototyping something on Precursor, come join me at "
+        [:a {:href doc-link}
+         (str "https://prcrsr.com/document/" doc-id)]
+        "."]
+       [:p "This is what I have so far:"]
+       [:p
+        [:a {:href doc-link
+             :style "display: inline-block"}
+         [:img {:width 325
+                :style "border: 1px solid #888888;"
+                :alt "Images disabled? Just come and take a look."
+                :src (str "https://prcrsr.com/document/" doc-id ".png?rand=" (rand) "&access-grant-token=" token)}]]]
+       [:p {:style "font-size: 12px"}
+        "Tell us if this message was sent in error info@prcrsr.com."
+        ;; Add some hidden text so that Google doesn't try to trim these.
+        [:span {:style "display: none; max-height: 0px; font-size: 0px; overflow: hidden;"}
+         " Sent at "
+         (clj-time.format/unparse (clj-time.format/formatters :rfc822) (time/now))
+         "."]]]])))
+
+
+;; TODO: need to keep track of who sent the access grant!
+(defn send-access-grant [db access-grant-eid]
+  (let [access-grant (d/entity db access-grant-eid)
+        doc-id (:access-grant/document access-grant)
+        granter (access-grant-model/get-granter access-grant)
+        token (:access-grant/token access-grant)]
+    (mailgun/send-message {:from "Precursor <joinme@prcrsr.com>"
+                           :to (:access-grant/email access-grant)
+                           :subject (str (format))
+                           :text (str "Hey there,\nCome draw with me on Precursor: https://prcrsr.com/document" doc-id
+                                      "?access-grant-token=" token)
+                           :html (access-grant-html doc-id token)
+                           :o:tracking "yes"
+                           :o:tracking-opens "yes"
+                           :o:tracking-clicks "no"
+                           :o:campaign "access_grant_invites"})))


fixed server port reference

fixed server port reference

--- support/src/figwheel/core.clj
+++ support/src/figwheel/core.clj
@@ -150,11 +150,8 @@
 ;; I would love to just check the compiled javascript files to see if
 ;; they changed and then just send them to the browser. There is a
 ;; great simplicity to that strategy. But unfortunately we can't speak
-;; for the reloadability of 3 party libraries. For this reason I am
+;; for the reloadability of 3rd party libraries. For this reason I am
 ;; only realoding files that are in the scope of the current project.
-
-;; I do this in a kinda hacky way where I compare the names of the
-;; changed source files to the changed compiled javascript files.

 ;; I also treat the 'goog.addDependancy' files as a different case.
 ;; These are checked for explicit changes and sent only when the
@@ -172,12 +169,6 @@
           changed-project-ns (intersection changed-compiled-ns changed-source-file-ns)
           sendable-files (map (partial make-sendable-file state) changed-project-ns)
           files-to-send  (concat (get-dependency-files state) sendable-files)]
-      (p/pprint changed-compiled-ns)
-      (p/pprint changed-source-file-ns)
-      (p/pprint changed-project-ns)
-
-      (p/pprint sendable-files)
-      (p/pprint files-to-send)
       (send-changed-files state files-to-send))))

 (defn initial-check-sums [state]
@@ -202,7 +193,7 @@

 (defn start-server [{:keys [js-dirs ring-handler] :as opts}]
   (let [state (create-initial-state opts)]
-    (println (str "Figwheel: Starting server at http://localhost:" (:server-port opts)))
+    (println (str "Figwheel: Starting server at http://localhost:" (:server-port state)))
     (println (str "Figwheel: Serving files from 'resources/" (:http-server-root state) "'"))
     (assoc state :http-server (server state))))


Add delta-p generator; correct delta-p monitor


closing time...

closing time...

--- src/text_stream/handler.clj
+++ src/text_stream/handler.clj
@@ -40,7 +40,7 @@

                 (d/let-flow [ready (s/take! conn)]
                             ;; First message must be "go"
-                            (if-not (= ready "go")
+                            (if-not (= (clojure.string/trim ready) "go")
                               (do
                                 (s/close! conn)
                                 (templates/invalid-response
@@ -88,11 +88,12 @@
                             (dosync
                              (alter streams assoc sid new-map)))))
                       conn)
-                     (s/on-closed
-                      (doall
-                       (map #(.close %)
-                            (bus/downstream streamrooms sid)))
-                      conn)))))))
+                     (s/on-closed conn
+                      (fn []
+                        (bus/publish! streamrooms sid "nooope!")
+                        (doall
+                         (map #(.close %)
+                              (bus/downstream streamrooms sid)))))))))))

 ;; TODO: write macro to simplify /<>/:stream-id
 (defroutes app-routes


Try replacing "postgres" in heroku's DATABASE_URL

--- src/swartz/models/core.clj
+++ src/swartz/models/core.clj
@@ -1,5 +1,8 @@
 (ns swartz.models.core
-  (:require [environ.core :refer [env]]))
+  (:require [environ.core :refer [env]]
+            [clojure.string :as str]))

-(def db {:connection-uri (env :database-url)
+(def db {:connection-uri (str/replace (env :database-url)
+                                      #":postgres:"
+                                      ":postgresql:")
          :classname "org.postgresql.Driver"})


Modified the S3 names to use Timestamp and lastoffset

--- src/uswitch/bifrost/s3.clj
+++ src/uswitch/bifrost/s3.clj
@@ -12,20 +12,22 @@

 (def buffer-size 100)

-(defn generate-key [consumer-group-id topic partition first-offset]
-  (format "%s/%s/partition=%s/%s.baldr.gz"
+(defn generate-key [consumer-group-id topic partition first-offset last-offset]
+  (format "%s/%s/partition=%s/T%s-%s-%s.baldr.gz"
           consumer-group-id
           topic
           partition
-          (format "%010d" first-offset)))
+          (format "%013d" (System/currentTimeMillis))
+          (format "%010d" first-offset)
+          (format "%010d" last-offset)))

 (def caching-rate-gauge (memoize rate-gauge))

-(defn upload-to-s3 [credentials bucket consumer-group-id topic partition first-offset file-path]
+(defn upload-to-s3 [credentials bucket consumer-group-id topic partition first-offset last-offset file-path]
   (let [f (file file-path)]
     (if (.exists f)
       (let [g        (caching-rate-gauge (str topic "-" partition "-uploadBytes"))
-            key      (generate-key consumer-group-id topic partition first-offset)
+            key      (generate-key consumer-group-id topic partition first-offset last-offset)
             dest-url (str "s3n://" bucket "/" key)]
         (info "Uploading" file-path "to" dest-url)
         (time! (timer (str topic "-s3-upload-time"))
@@ -54,6 +56,7 @@
                       (upload-to-s3 credentials bucket (consumer-properties "group.id")
                                     topic partition
                                     first-offset
+                                    last-offset
                                     file-path)
                       {:goto :commit}
                       (catch Exception e


Add missing info message rendering.

Add missing info message rendering.

--- src/uxbox/ui/messages.cljs
+++ src/uxbox/ui/messages.cljs
@@ -80,6 +80,7 @@
   (let [message (rum/react message-l)]
     (case (:type message)
       :error (notification-box message)
+      :info (notification-box message)
       :dialog (dialog-box message)
       nil)))


GET request should not modify the data store

--- src/wordly/routes/home.clj
+++ src/wordly/routes/home.clj
@@ -90,6 +90,13 @@
   (layout/common
    (new-word-count-template {})))

+(defn show-word-count [request]
+  (layout/common
+   (let [url (get-in request [:params :url])]
+         (if (storage/get STORE url)
+           (show-word-count-template url)
+           [:h1 "URL NOT FOUND"]))))
+
 (defn create-word-count [request]
   (layout/common
    (let [url (get-in request [:params :url])
@@ -101,7 +108,7 @@
 (defroutes home-routes
   (GET "/" [] (home))
   (GET "/word-counts/new" [] (new-word-count))
-  (GET "/word-counts" request (create-word-count request)) ;; TODO - replace with /word-counts/id
+  (GET "/word-counts" request (show-word-count request))
   (POST "/word-counts" request (create-word-count request)))

 (defn init []


Add test for unsupported media type.

Add test for unsupported media type.

--- spec/freefrog/rest_spec.clj
+++ spec/freefrog/rest_spec.clj
@@ -128,6 +128,13 @@
         (should= 200 (:status @response))
         (should= (json/generate-string sample-gov-log) (:body @response))))

+    (context "posting to the governance endpoint with an unsupported content-type"
+      (with response (http-post-request "/circles/1234/governance"
+                                        nil
+                                        {:content-type "application/json"}))
+      (it "should return a 415"
+        (should= 415 (:status @response))))
+
     (context "posting to the governance endpoint"
       (with response (http-post-request "/circles/1234/governance"))
       (it "should return a 201"
@@ -152,6 +159,13 @@
           (with-redefs [p/get-governance-log (fn [& args] {:is-open? true :agenda nil})]
             (it)))

+        (context "putting to the agenda endpoint with an unsupported media type"
+          (with response (http-put-request "/circles/1234/governance/5678/agenda"
+                                           "New agenda"
+                                           {:content-type "application/json"}))
+          (it "should return a 415"
+            (should= 415 (:status @response))))
+
         (context "putting to the agenda endpoint"
           (with response (http-put-request "/circles/1234/governance/5678/agenda"
                                            "New agenda"))


New test: test-main

New test: test-main

--- test/clouseau/test_core.clj
+++ test/clouseau/test_core.clj
@@ -172,3 +172,13 @@
             (is (= {:port 65537}   (start-server "65537")))
             (is (= {:port 1000000} (start-server "1000000"))))))

+(deftest test-main
+    (testing "clouseau.core/-main"
+        ; use mock instead of jetty/run-jetty
+        (with-redefs [jetty/run-jetty (fn [app port] port)]
+            (is (= {:port 3000}    (-main)))
+            (is (= {:port 3000}    (-main "-1")))
+            (is (= {:port 3000}    (-main "-p" "3000")))
+            (is (= {:port 9999}    (-main "-p" "9999")))
+            )))
+


Minor cosmetic changes on tests.

Minor cosmetic changes on tests.

--- test/decimal/core_spec.cljs
+++ test/decimal/core_spec.cljs
@@ -76,8 +76,8 @@
     (equal-or-both-NaN (dc/div v 2) (.div (dc/-decimal v) 2))
     (equal-or-both-NaN (dc// v 2) (.div (dc/-decimal v) 2))
     (equal-or-both-NaN (dc/div' v 2) (.divToInt (dc/-decimal v) 2))
-    (equal-or-both-NaN (dc/max v 2) (.apply (.-max dc/+decimal+) dc/+decimal+ (clj->js [v 2])))
-    (equal-or-both-NaN (dc/min v 2) (.apply (.-min dc/+decimal+) dc/+decimal+ (clj->js [v 2])))
+    (equal-or-both-NaN (dc/max v 2) (.apply (.-max dc/+decimal+) dc/+decimal+ #js [v 2]))
+    (equal-or-both-NaN (dc/min v 2) (.apply (.-min dc/+decimal+) dc/+decimal+ #js [v 2]))
     (equal-or-both-NaN (dc/floor v) (.floor (dc/-decimal v)))
     (equal-or-both-NaN (dc/round v) (.round (dc/-decimal v)))
     (equal-or-both-NaN (dc/ceil v) (.ceil (dc/-decimal v)))


More consistent naming for nested tests.

--- test/decl_ui/core_test.cljs
+++ test/decl_ui/core_test.cljs
@@ -18,17 +18,17 @@

 (deftest test-compile-ui
   (testing "Markup generation"
-    (testing "Static markup"
+    (testing "of static markup"
       (install! {} "{:text \"Hello\"}" "[:div#text \"Hello\"]" {} {})
       (is (= "Hello" (text (sel1 "#text"))))))
-  (testing "Data binding"
-    (testing "One way cell binding"
+  (testing "Binding"
+    (testing "cells to render inside tags"
       (install! {} "{:text \"Hello\"}" "[:div#text #= :text]" {} {})
       (is (= "Hello" (text (sel1 "#text")))))
-    (testing "Nested markup"
+    (testing "cells in nested markup"
       (install! {} "{:text \"Hello\"}" "[:div [:div#text #= :text]]" {} {})
       (is (= "Hello" (text (sel1 "#text")))))
-    (testing "Two-way cell binding"
+    (testing "cells for two-way synchronization"
       (install! {} "{:text \"Hello\"}"
                 "[:div
                  [:ui/button \"btn\" #= :text]
@@ -42,18 +42,18 @@
       (async done
         (go (is (= "Bye" (text (sel1 "#result"))))
             (done))))
-    (testing "Deep binding to nested data"
+    (testing "to nested data"
       (install! {} "{:user {:name \"John Smith\"}}"
                 "[:div#user-name #= [:user :name]]"
                 {} {})
       (is (= "John Smith" (text (sel1 "#user-name")))))
-    (testing "Deep binding to unnested data"
+    (testing "to flat data using key sequence"
       (install! {} "{:text \"Hello world\"}"
                 "[:div#result #= [:text]]"
                 {} {})
       (is (= "Hello world" (text (sel1 "#result"))))))
-  (testing "Callbacks"
-    (testing "Simple invocation"
+  (testing "Callback"
+    (testing "invoked with no arguments"
       (let [clicked (atom false)]
         (install! {} "{:text \"Hello\"}"
                   "[:div
@@ -67,7 +67,7 @@
         (async done
           (go (is @clicked)
               (done)))))
-    (testing "Invocation with arguments"
+    (testing "invoked with value arguments"
       (let [received-value (atom false)]
         (install! {} "{:text \"Hello\"}"
                   "[:div
@@ -81,7 +81,7 @@
         (async done
           (go (is (= 666 @received-value))
               (done)))))
-    (testing "Invocation with binding"
+    (testing "invoked with binding"
       (let [received-value (atom false)]
         (install! {} "{:text \"Hello\"}"
                   "[:div
@@ -95,7 +95,7 @@
         (async done
           (go (is (= "Hello" @received-value))
               (done)))))
-    (testing "Invocation with deep binding"
+    (testing "invoked with deep binding"
       (install! {} "{:user {:name \"John\"} :text \"Hello world\"}"
                 "[:div
                  [:button {:id \"btn\" :on-click (ui/handle-click #= [:user :name] #= [:text])}]
@@ -118,6 +118,14 @@
                 {}
                 {'ui/query (fn [] "Hello world")})
       (is (= "Hello world" (text (sel1 "#result")))))
+    (testing "to callback binding to global cells"
+      (install! {:text "Hello world"}
+                "{:upcased-text #= (ui/upcase #= :text)}"
+                "[:div#result #= :upcased-text]"
+                {}
+                {'ui/upcase (fn [_ text]
+                              (str/upper-case text))})
+      (is (= "HELLO WORLD" (text (sel1 "#result")))))
     (testing "to callback binding to data"
       (install! {:text "Hello world"}
                 "{:upcased-text #= (ui/upcase #= :text)}"


adding tests

adding tests

--- test/one_hyde/test/core.clj
+++ test/one_hyde/test/core.clj
@@ -64,3 +64,13 @@

     (let [m (meta (generate-html "with_layout_format.clj"))]
     (is (= "html4" (:format m))))))
+
+;;; generate
+(deftest generate-html-test
+  ;(= ""  (html (generate-html "gen_test.clj")))
+  (is true)
+  )
+
+(deftest compile-template-test
+  (is true)
+  )


Not sure how this changed.

Not sure how this changed.

--- test/picard/test/client.clj
+++ test/picard/test/client.clj
@@ -420,7 +420,7 @@
     (is (no-msgs-for ch))
     (picard/shutdown-pool pool)))

-(defcoretest handling-100-continue-requests-and-responses
+(defcoretest ^{:focus true} handling-100-continue-requests-and-responses
   [ch1 ch2]
   (deftrackedapp [downstream]
     (fn [evt val]
@@ -433,7 +433,7 @@

   (let [downstream
         (client/request
-         ["Localhost" 4040]
+         ["localhost" 4040]
          [{:path-info       "/"
            :request-method  "POST"
            "content-length" "5"


All octaves now derived from raw notes

All octaves now derived from raw notes

--- src/aeolian/abc/notes.clj
+++ src/aeolian/abc/notes.clj
@@ -1,11 +1,12 @@
 (ns aeolian.abc.notes)

 (def rest-note "z")
-(def octave-1 ["C," "E," "G," "B,"])
-(def octave-2 ["C" "E" "G" "B"])
-(def octave-3 ["c" "e" "g" "b"])
-(def octave-4 ["c'" "e'" "g'" "b'"])
-(def octave-5 ["c''" "e''" "g''" "b''"])
+(def raw-notes ["C" "E" "G" "B"])
+(def octave-1 (map #(str %1 ",") raw-notes))
+(def octave-2 raw-notes)
+(def octave-3 (map clojure.string/lower-case raw-notes))
+(def octave-4 (map #(str %1 "'") octave-3))
+(def octave-5 (map #(str %1 "'") octave-4))

 (defn pick-chord-for-method-length [method-length]
 	(cond


fix test

fix test

--- test/scrabble/core_test.clj
+++ test/scrabble/core_test.clj
@@ -62,4 +62,4 @@
 (deftest anagrams-test
   (testing "simple-anagrams"
     (are [ans word] (= (anagrams word) ans)
-      #{"cab" "ac" "ca" "ba"} "abc")))
+      #{"ab" "cab" "cb" "ac" "ca" "abc" "ba" "bc"} "abc")))


fix tests that incorrectly assumed quoted things come back as map as array rep instead of 2-element array rep


Resolve job type

Resolve job type

--- src-cljs/frontend/send.cljs
+++ src-cljs/frontend/send.cljs
@@ -54,8 +54,16 @@
     ("waiting" "queued" "not_running" "blocked" "pending") :job-run-status/waiting
     :job-run-status/unknown))

+(defn- job-type [job-type-str]
+  (case job-type-str
+    "approval" :job-type/approval
+    "build" :job-type/build
+    :job-type/unknown))
+
 (defn adapt-to-job [job-response]
-  (update job-response :job/status job-run-status))
+  (-> job-response
+      (update :job/status job-run-status)
+      (update :job/type job-type)))

 (defn denormalize-required [job jobs-by-id]
   (assoc job


Associated in on part first time called.

--- src/async/http/client.clj
+++ src/async/http/client.clj
@@ -137,5 +137,4 @@
                        :part mk-seq
                        :completed done-seq
                        :error error-collect)]
-       (dosync (alter resp assoc :body s-seq))
        resp)))


Add better error checking to Steam reader.

It will now throw if:
- --from steam was specified but --steam-name was not
- the game list for the given --steam-name is private, empty, or otherwise inaccessible

--- src/bltool/data/steam.clj
+++ src/bltool/data/steam.clj
@@ -3,6 +3,7 @@
   (:require [bltool.flags :refer :all])
   (:require [clj-http.client :as http])
   (:require [clojure.data.xml :as xml])
+  (:require [slingshot.slingshot :refer [throw+]])
   (:require [clojure.string :refer [trim]]))

 (register-flags ["--steam-name" "Steam Community name"]
@@ -11,12 +12,22 @@
 (defn- xml-to-map
   [tag]
     (let [tag-content (fn [tag] [(:tag tag) (apply str (:content tag))])]
-      (into {} (map tag-content (:content tag)))))
+      (into {} (map tag-content (:content tag)))))
+
+(defn- check-games
+  [games]
+  (if (empty? games)
+    (throw+ (str "Couldn't find any games at http://steamcommunity.com/id/" (:steam-name *opts*)
+                 " -- are you sure you specified the right --steam-name?"))
+    games))

 (defmethod read-games "steam" [_]
+  (if (not (:steam-name *opts*))
+    (throw+ "No Steam Community name specified - use the --steam-name option."))
   (let [name (:steam-name *opts*)
         url (str "http://steamcommunity.com/id/" name "/games?tab=all&xml=1")]
     (->> url http/get :body xml/parse-str xml-seq (filter #(= :game (:tag %)))
       (map (comp trim :name xml-to-map))
       sort
-      (map (fn [name] { :id "0" :name name :platform (:steam-platform *opts*) :progress "unplayed" })))))
+      (map (fn [name] { :id "0" :name name :platform (:steam-platform *opts*) :progress "unplayed" }))
+      check-games)))


add :cat within :français for use by conjugation

--- src/babel/francais/grammar.cljc
+++ src/babel/francais/grammar.cljc
@@ -97,31 +97,55 @@
 (def hc-agreement
   (let [agr (atom :top)]
     {:synsem {:agr agr}
-     :head {:synsem {:agr agr}}
+     :head {:français {:agr agr}
+            :synsem {:agr agr}}
      :comp {:français {:agr agr}
             :synsem {:agr agr}}}))

 (def head-first
   (let [head-français (atom :top)
-        comp-français (atom :top)]
+        comp-français (atom :top)
+        head-cat (atom :top)
+        comp-cat (atom :top)]
     (unify
-     {:comp {:français {:initial false}}
-      :head {:français {:initial true}}}
-     {:head {:français head-français}
-      :comp {:français comp-français}
+     {:comp {:français {:cat comp-cat
+                        :initial false}}
+      :head {:français {:cat head-cat
+                        :initial true}
+             :synsem {:cat head-cat}}
+      :synsem {:cat head-cat}}
+
+     {:head {:synsem {:cat head-cat}
+             :français head-français}
+      :comp {:synsem {:cat comp-cat}
+             :français comp-français}
       :français {:a head-français
-                :b comp-français}})))
+                 :b comp-français}}
+     {:français {:a {:cat head-cat}
+                 :b {:cat comp-cat}}})))

 (def head-last
   (let [head-français (atom :top)
-        comp-français (atom :top)]
+        comp-français (atom :top)
+        head-cat (atom :top)
+        comp-cat (atom :top)]
     (unify
-     {:comp {:français {:initial true}}
-      :head {:français {:initial false}}}
-     {:head {:français head-français}
-      :comp {:français comp-français}
+     {:comp {:français {:cat comp-cat
+                        :initial true}
+             :synsem {:cat comp-cat}}
+      :head {:français {:cat head-cat
+                        :initial false}
+             :synsem {:cat head-cat}}
+      :synsem {:cat head-cat}}
+
+     {:head {:synsem {:cat head-cat}
+             :français head-français}
+      :comp {:synsem {:cat comp-cat}
+             :français comp-français}
       :français {:a comp-français
-                :b head-français}})))
+                 :b head-français}}
+     {:français {:a {:cat comp-cat}
+                 :b {:cat head-cat}}})))

 ;; -- BEGIN SCHEMA DEFINITIONS
 (def schema-10
@@ -331,7 +355,8 @@
                    (unify c10
                            root-is-head
                            {:rule "s-imperfect-nonphrasal"
-                            :head {:phrasal false}
+                            :head {:phrasal false
+                                   :français {:present {:conjugated true}}}
                             :synsem {:aux false
                                      :infl :imperfect
                                      :cat :verb


object of essere<PP> must be complete (subcat=empty)

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -1062,6 +1062,7 @@
                                    :agr {:gender gender
                                          :number number}}
                                :2 {:cat :prep
+                                   :subcat '()
                                    :sem {:pred pred
                                          :obj obj}}
                                :3 '()}}}))


+dell' +l'

+dell' +l'

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -799,6 +799,11 @@
                 :def :partitivo
                 :agr {:number :plur
                       :gender :masc}}}
+      "dell"
+      {:synsem {:cat :det
+                :def :partitivo
+                :agr {:number :sing
+                      :gender :top}}}
       "della"
       {:synsem {:cat :det
                 :def :partitivo
@@ -1235,6 +1240,11 @@
                  :sem {:human true
                        :pred :I}
                  :subcat '()}}]
+   "l"
+   {:synsem {:cat :det
+             :def :def
+             :agr {:gender :top
+                   :number :sing}}}
       "la"
       ;; TODO: refactor commonalities
       ;; 1. pronoun: human


simplify lexical compilation with if-then-with-fn

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -3,7 +3,8 @@
   (:refer-clojure :exclude [get-in merge])
   (:require
    [babel.lexicon :refer [universals]]
-   [babel.lexiconfn :refer [compile-lex if-then map-function-on-map-vals unify]]
+   [babel.lexiconfn :refer [compile-lex if-then if-then-with-fn
+                            map-function-on-map-vals unify]]
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
    [babel.italiano.morphology :refer [exception-generator italian-specific-rules phonize]]
@@ -2158,20 +2159,14 @@
 (def lexicon (-> (compile-lex lexicon-source
                               exception-generator
                               phonize italian-specific-rules)
-
-                 (map-function-on-map-vals
-                  (fn [k vals]
-                    (do
-                      (map (fn [val]
-                             (let [pred (get-in val [:synsem :sem :pred] nil)]
-                               (cond
-                                 (and pred (get universals pred))
-                                 ;; since there are universals for this verb's :pred, unify the verb with the universals.
-                                 (unify (get universals pred)
-                                        val)
-                                 true
-                                 val)))
-                           vals))))
+
+                 (if-then-with-fn
+                  (fn [val]
+                    (if (get universals (get-in val [:synsem :sem :pred]))
+                      :top
+                      :fail))
+                  (fn [val]
+                    (get universals (get-in val [:synsem :sem :pred]))))

                  ;; make an intransitive version of every verb which has an
                  ;; [:sem :obj] path.


fix typo

fix typo

--- src/babel/italiano/workbook.clj
+++ src/babel/italiano/workbook.clj
@@ -233,7 +233,7 @@

 ;; not sure why this is necessary: investigate why english/workbook.clj doesn't need it.
 (def foo (count (take 1 (parse "io dormo"))))
-(def foo2 (count (take 1 (generate {:synsem {:sem {:pred :dormo
+(def foo2 (count (take 1 (generate {:synsem {:sem {:pred :sleep
                                                    :tense :present
                                                    :subj {:pred :I}}}}))))


Added small pause after door shuts so that door also locks

--- src/chicken_coop/core.clj
+++ src/chicken_coop/core.clj
@@ -27,6 +27,7 @@
   (hb/forward! hb)
   (wait-till (closed? floor-btn)
     (log "Stopping door")
+    (Thread/sleep 100)
     (hb/stop! hb)))


macroexpansion support for (.member x ...) and (Ctor. ...)

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -9,7 +9,7 @@
 (set! *warn-on-reflection* true)

 (ns cljs.compiler
-  (:refer-clojure :exclude [munge load-file])
+  (:refer-clojure :exclude [munge load-file macroexpand-1])
   (:require [clojure.java.io :as io]))

 (declare resolve-var)
@@ -210,9 +210,9 @@
 (defmethod emit :new
   [{:keys [ctor args env]}]
   (emit-wrap env
-             (print (str "new " (emits ctor) "("
+             (print (str "(new " (emits ctor) "("
                          (comma-sep (map emits args))
-                         ")"))))
+                         "))"))))

 (defmethod emit :set!
   [{:keys [target val env]}]
@@ -474,15 +474,31 @@
     (when (and mvar (.isMacro mvar))
       @mvar)))

+(defn macroexpand-1 [env form]
+  (let [op (first form)]
+    (if (specials op)
+      form
+      (if-let [mac (and (symbol? op) (get-expander op env))]
+        (apply mac form env (rest form))
+        (if (symbol? op)
+          (let [opname (name op)]
+            (cond
+             (= (first opname) \.) (let [[target & args] (next form)]
+                                     (list* '. target (symbol (subs opname 1)) args))
+             (= (last opname) \.) (list* 'new (symbol (subs opname 0 (dec (count opname)))) (next form))
+             :else form))
+          form)))))
+
 (defn analyze-seq
   [env form name]
   (let [op (first form)]
     (assert (not (nil? op)) "Can't call nil")
-    (if (specials op)
-      (parse op env form name)
-      (if-let [mac (and (symbol? op) (get-expander op env))]
-        (analyze env (apply mac form env (rest form)))
-        (parse-invoke env form)))))
+    (let [mform (macroexpand-1 env form)]
+      (if (identical? form mform)
+        (if (specials op)
+          (parse op env form name)
+          (parse-invoke env form))
+        (analyze env mform name)))))

 (defn analyze
   "Given an environment, a map containing {:locals (mapping of names to bindings), :context


fix missing safe-exec in write-bq-table-raw

--- src/clj/datasplash/bq.clj
+++ src/clj/datasplash/bq.clj
@@ -201,13 +201,17 @@
       (let [^String out (cust-fn elt)]
         (TableDestination. out nil)))))

+(defn format-fn
+  []
+  (proxy [SerializableFunction] []
+    (apply [elt] (safe-exec (clj-nested->table-row elt)))))
+
 (defn write-bq-table-raw
   ([to options ^PCollection pcoll]
    (let [opts (assoc options :label :write-bq-table-raw)]
      (apply-transform pcoll (-> (BigQueryIO/write)
                                 (.to to)
-                                (.withFormatFunction (proxy [SerializableFunction] []
-                                                       (apply [elt] (clj-nested->table-row elt)))))
+                                (.withFormatFunction (format-fn)))
                       write-bq-table-schema opts)))
   ([to pcoll] (write-bq-table-raw to {} pcoll)))


comment top leve call

comment top leve call

--- src/clj/xl/word_break.clj
+++ src/clj/xl/word_break.clj
@@ -78,4 +78,4 @@
     )
   )

-(samples)+;(samples)


Add support for stochastic attack damage

--- src/clj/zetawar/game.cljs
+++ src/clj/zetawar/game.cljs
@@ -442,7 +442,7 @@
     (catch :default ex
       false)))

-(defn attack-damage [db attacker defender attacker-terrain defender-terrain]
+(defn attack-damage [db game attacker defender attacker-terrain defender-terrain]
   (let [defender-armor-type (get-in defender [:unit/type :unit-type/armor-type])
         [attacker-q attacker-r] (unit-hex attacker)
         [defender-q defender-r] (unit-hex defender)
@@ -495,20 +495,29 @@
                          (* (count adjacent-attack-hexes) 1)
                          (* (count flanking-attack-hexes) 2)
                          (* (count opposite-attack-hexes) 3))]
-    (js/Math.round
-     (max 0 (* (:unit/count attacker)
-               (+ 0.5 (* 0.05 (+ (- (+ attack-strength attack-bonus)
-                                    (+ armor armor-bonus))
-                                 gang-up-bonus))))))))
+    ;; TODO: test stochastic-attacks
+    (let [p (-> (+ 0.5 (* 0.05 (+ (- (+ attack-strength attack-bonus)
+                                     (+ armor armor-bonus))
+                                  gang-up-bonus)))
+                (max 0)
+                (min 1))]
+      (js/Math.round
+       (if (:game/stochastic-attacks game)
+         (let [hits (->> (repeatedly #(rand))
+                         (take (* 6 (:unit/count attacker)))
+                         (filter #(< % p))
+                         count)]
+           (quot hits 6))
+         (* (:unit/count attacker) p))))))

 (defn battle-damage
   ([db game attacker defender]
    (let [attacker-terrain (:unit/terrain attacker)
          defender-terrain (:unit/terrain defender)
          attack-count (:unit/attack-count attacker 0)
-         defender-damage (attack-damage db attacker defender attacker-terrain defender-terrain)
+         defender-damage (attack-damage db game attacker defender attacker-terrain defender-terrain)
          attacker-damage (if (in-range? db defender attacker)
-                           (attack-damage db defender attacker defender-terrain attacker-terrain)
+                           (attack-damage db game defender attacker defender-terrain attacker-terrain)
                            0)]
      [(min (:unit/count attacker) attacker-damage)
       (min (:unit/count defender) defender-damage)]))


minor refactor

minor refactor

--- src/cljs/greffe/core.cljs
+++ src/cljs/greffe/core.cljs
@@ -27,8 +27,9 @@

             (go-loop []
               (let [xml-doc (<! xml-chan)
-                    data-doc (cx/parse xml-doc)
-                    doc-zip (zip/xml-zip data-doc)]
+                    doc-zip (-> xml-doc
+                              cx/parse
+                              zip/xml-zip)]
                 (om/transact! app
                   (fn [a]
                     (let [nodes (take-while


Adding acl-cache reset and get-acls will now refresh the cache if there are no acls.

--- src/cmr/acl/acl_cache.clj
+++ src/cmr/acl/acl_cache.clj
@@ -10,25 +10,19 @@
             [cmr.common.log :as log :refer (debug info warn error)]
             [clojure.walk :as w]))

+(def initial-cache-state
+  {:acls nil
+   :last-updated nil})
+
 (defn create-acl-cache
   "Creates a new empty ACL cache. The cache itself is just an atom with a map."
   []
-  (atom {:acls nil
-         :last-updated nil}))
+  (atom initial-cache-state))

 (defn- context->acl-cache
   "Gets the acl cache from the context"
   [context]
   (get-in context [:system :acl-cache]))
-
-(defn get-acls
-  "Gets the current cached acls."
-  [context]
-  (if-let [acls (-> context context->acl-cache deref :acls)]
-    acls
-    ;; We treat acls not being in the cache as an internal error. We want every request to be fast.
-    ;; This could be changed to actually refresh the acl cache.
-    (errors/internal-error! "ACLS were not in cache.")))

 (defn- set-acl-provider-id
   "Sets the provider-id in the acl to replace the provider guid"
@@ -40,6 +34,13 @@
                    (assoc :provider-id (provider-guid-id-map (:provider-guid cii)))
                    (dissoc :provider-guid)))))

+(defn reset
+  "Resets the cache back to it's initial state"
+  [context]
+  (-> context
+      context->acl-cache
+      (reset! initial-cache-state)))
+
 (defn refresh-acl-cache
   "Refreshes the acls stored in the cache. This should be called from a background job on a timer
   to keep the cache fresh. This will throw an exception if there is a problem fetching ACLs. The
@@ -50,6 +51,17 @@
         acls (mapv (partial set-acl-provider-id provider-guid-id-map)
                    (echo-acls/get-acls-by-type context "CATALOG_ITEM"))]
     (reset! acl-cache-atom {:acls acls :last-updated (t/now)})))
+
+(defn get-acls
+  "Gets the current cached acls."
+  [context]
+  (let [acl-cache-atom (context->acl-cache context)]
+    (when-not (-> acl-cache-atom deref :acls)
+      (info "No acls found in cache. Manually triggering acl cache refresh")
+      (refresh-acl-cache context))
+    (if-let [acls (-> context context->acl-cache deref :acls)]
+      acls
+      (errors/internal-error! "ACLS were not in cache."))))

 ;; TODO we need a way to manually trigger this from integration tests.
 ;; Add an endpoint to search and indexer for refreshing the acl cache.


Triple goes to 40 now, not 50

Triple goes to 40 now, not 50

--- clojure/triple.clj
+++ clojure/triple.clj
@@ -1,3 +1,3 @@
-(doseq [c (range 1 51) b (range 1 c) a (range 1 b)]
+(doseq [c (range 1 41) b (range 1 c) a (range 1 b)]
   (if (= (+ (* b b) (* a a)) (* c c))
     (printf "%d, %d, %d\n" a b c)))


Refactor test (don't bind vars where they aren't used)

--- test/grafter/tabular_test.clj
+++ test/grafter/tabular_test.clj
@@ -255,9 +255,9 @@

 (deftest columns-tests
-  (let [expected-dataset (test-dataset 5 2)
-        test-data (test-dataset 5 10)]
-    (testing "columns"
+  (testing "columns"
+    (let [expected-dataset (test-dataset 5 2)
+          test-data (test-dataset 5 10)]
       (testing "Narrows by string names"
         (is (= expected-dataset
                (columns test-data ["a" "b"]))  "Should select just columns a and b"))
@@ -278,46 +278,44 @@
                      (columns test-data (range 10 100)))
             "Raises an exception if columns when paired with data are not actually column headings."))

-      (testing "preserves metadata"
-        (let [md {:foo :bar}
-              ds (with-meta (make-dataset [[1 2 3]]) md)]
-          (is (= md
-                 (meta (columns ds [0]))))))
-
-      (testing "still returns a dataset even with only one row"
-        (let [test-data (make-dataset [["Doc Brown" "Einstein"]] ["Owner" "Dog"])
-              result (columns test-data ["Owner" "Dog"])]
-          (is (is-a-dataset? result))
-
-          (is (= test-data result))))
-
       (testing "Returns all columns from unordered sequence"
         (let [expected-dataset (assoc (test-dataset 5 4)
-                                      :column-names
-                                      ["a" "b" "d" "c"])]
+                                 :column-names
+                                 ["a" "b" "d" "c"])]
           (is (= expected-dataset
                  (columns test-data [:a :b :d :c]))
-              "should return dataset containing the cols :a :b :d :c")))
-
-      (testing "Duplicate columns in the selection leads to duplicated column-names"
-        ;; NOTE that these behaviour's aren't really desirable - but its
-        ;; hard to prevent without using only finite sequences for
-        ;; selection.
-        ;;
-        ;; These tests are primarily to document this behaviour - even
-        ;; though it can be undesirable.
-        (let [expected-dataset (make-dataset [[0 0] [1 1]]
-                                             ["a" "a"])
-              test-dataset (test-dataset 2 2)
-
-              result (columns test-dataset ["a" "a"])]
-          (is (= ["a" "a"] (column-names result)))
-          (is (= expected-dataset result))
-          ;; Columns crops the supplied sequence to the data.
-          ;; This means duplicate columns may sneak in.
-          (is (= expected-dataset (columns test-dataset ["a" "a" "b"]))))))))
-
-
+              "should return dataset containing the cols :a :b :d :c"))))
+
+    (testing "preserves metadata"
+      (let [md {:foo :bar}
+            ds (with-meta (make-dataset [[1 2 3]]) md)]
+        (is (= md
+               (meta (columns ds [0]))))))
+
+    (testing "still returns a dataset even with only one row"
+      (let [test-data (make-dataset [["Doc Brown" "Einstein"]] ["Owner" "Dog"])
+            result (columns test-data ["Owner" "Dog"])]
+        (is (is-a-dataset? result))
+
+        (is (= test-data result))))
+
+    (testing "Duplicate columns in the selection leads to duplicated column-names"
+      ;; NOTE that these behaviour's aren't really desirable - but its
+      ;; hard to prevent without using only finite sequences for
+      ;; selection.
+      ;;
+      ;; These tests are primarily to document this behaviour - even
+      ;; though it can be undesirable.
+      (let [expected-dataset (make-dataset [[0 0] [1 1]]
+                                           ["a" "a"])
+            test-dataset (test-dataset 2 2)
+
+            result (columns test-dataset ["a" "a"])]
+        (is (= ["a" "a"] (column-names result)))
+        (is (= expected-dataset result))
+        ;; Columns crops the supplied sequence to the data.
+        ;; This means duplicate columns may sneak in.
+        (is (= expected-dataset (columns test-dataset ["a" "a" "b"])))))))

 (deftest rows-tests
   (let [test-data (test-dataset 10 2)]


Fix test.

Fix test.

--- test/onyx/log/notify_test.clj
+++ test/onyx/log/notify_test.clj
@@ -48,7 +48,37 @@

 (def old-replica {:pairs {a-id b-id b-id c-id c-id a-id} :peers [a-id b-id c-id]})

-(def old-local-state {:log (:log env) :id d-id})
+(def old-local-state {:log (:log env) :id a-id})
+
+(def new-replica (f old-replica))
+
+(def diff (rep-diff old-replica new-replica))
+
+(def reactions (rep-reactions old-replica new-replica diff {:id a-id}))
+
+(doseq [reaction reactions]
+  (let [log-entry (create-log-entry (:fn reaction) (:args reaction))]
+    (extensions/write-log-entry (:log env) log-entry)))
+
+(def new-local-state
+  (extensions/fire-side-effects! read-entry old-replica new-replica diff old-local-state))
+
+(def message-id (<!! ch))
+
+(def read-entry (extensions/read-log-entry (:log env) message-id))
+
+(fact (:fn read-entry) => :notify-join-cluster)
+(fact (:args read-entry) => {:observer d-id :subject b-id})
+
+(def f (partial extensions/apply-log-entry read-entry))
+
+(def rep-diff (partial extensions/replica-diff read-entry))
+
+(def rep-reactions (partial extensions/reactions read-entry))
+
+(def old-replica new-replica)
+
+(def old-local-state {:log (:log env) :id d-id :watch-ch (chan)})

 (def new-replica (f old-replica))

@@ -67,41 +97,11 @@

 (def read-entry (extensions/read-log-entry (:log env) message-id))

-(fact (:fn read-entry) => :notify-join-cluster)
-(fact (:args read-entry) => {:observer c-id :subject d-id})
-
-(def f (partial extensions/apply-log-entry read-entry))
-
-(def rep-diff (partial extensions/replica-diff read-entry))
-
-(def rep-reactions (partial extensions/reactions read-entry))
-
-(def old-replica new-replica)
-
-(def old-local-state {:log (:log env) :id c-id :watch-ch (chan)})
-
-(def new-replica (f old-replica))
-
-(def diff (rep-diff old-replica new-replica))
-
-(def reactions (rep-reactions old-replica new-replica diff {:id c-id}))
-
-(doseq [reaction reactions]
-  (let [log-entry (create-log-entry (:fn reaction) (:args reaction))]
-    (extensions/write-log-entry (:log env) log-entry)))
-
-(def new-local-state
-  (extensions/fire-side-effects! read-entry old-replica new-replica diff old-local-state))
-
-(def message-id (<!! ch))
-
-(def read-entry (extensions/read-log-entry (:log env) message-id))
-
 (fact (:fn read-entry) => :accept-join-cluster)
-(fact (:args read-entry) => {:accepted {:observer "d"
-                             :subject "a"}
-                             :updated-watch {:observer "c"
-                                             :subject "d"}})
+(fact (:args read-entry) => {:accepted-joiner "d"
+                             :accepted-observer "a"
+                             :subject "b"
+                             :observer "d"})

 (def conn (zk/connect (:zookeeper/address (:zookeeper (:env config)))))


Fix multiple history bugs

Fix multiple history bugs

--- src-cljs/cljs_workspace/om_history.cljs
+++ src-cljs/cljs_workspace/om_history.cljs
@@ -3,7 +3,8 @@
             [om.dom :as dom :include-macros true]
             [cljs-workspace.morph
               :as morphic
-              :refer [set-position set-fill set-extent add-morph remove-morph]]))
+              :refer [set-position set-fill set-extent add-morph remove-morph]]
+            [cljs-workspace.branch-vis :refer [render-tree]]))

 (enable-console-print!)

@@ -18,9 +19,6 @@
 ;; global atom referencing the current state of the app
 (def app-state (atom nil))

-;; global atom referencing the total history graph
-(def app-history (atom [@app-state]))
-

 (defn init-history [init-state]
   (reset! app-state init-state)
@@ -34,7 +32,10 @@
   @branch-count)

 ;; global atom referencing the branch that we currently operate on
-(def current-branch (atom {:id (generate-uuid) :data (atom @app-history)}))
+(def current-branch (atom {:id (generate-uuid) :data (atom [])}))
+
+;; global atom referencing the total history graph
+(def app-history (@current-branch :data))

 ;; ffd
 (def history-view)
@@ -50,19 +51,22 @@

 (defn nth-history
   ([i]
-    (nth-history i @current-branch))
-  ([i {:keys [_ data]}]
+    (nth-history i @(@current-branch :data)))
+  ([i data]
     ;; lookup in unrolled linked list
-    (if (< i (dec (count @data)))
-      (nth @data i)
-      (when-let [cont ((last @data) :cont)]
-        (nth-history (- i (dec (count @data))) cont)
+    (if (< i (dec (count data)))
+      (let [e (nth data i)]
+        (if (e :cont)
+          (first @((e :cont) :data))
+          e))
+      (if-let [cont ((last data) :cont)]
+        (nth-history (- i (dec (count data))) cont)
         nil))))

 (defn len [unrolled-list]
   (+ -1 (count unrolled-list)
     (when-let [end (last unrolled-list)]
-      (when-let [n (end :cont)] (len n)))))
+      (when-let [n @(end :cont)] (len n)))))

 (def history-indicator
   {:id "indexMorph"
@@ -124,27 +128,34 @@
 ;
 ; -----\----
 ;       \------
-; [ . . . .  {:cont ---------------------> [ . . . . . ]
-;             :branch | }]
-;                     \
-;                      V
-;                      [ . . . . . { . . }]
+; {:id ... :data [ . . . .  {:cont ---------------------> [ . . . . . ]
+;                            :fork | }]}
+;                                  \
+;                                   V
+;                                  {:id ... :data [ . . . . . { . . }]}

 (defn branch-at [i n]
   (prn "Branching at " i)
   (swap! branch-count inc)
-  (let [index i
+  (let [index (* (dec (len @(@current-branch :data))) (/ i 100))
         new-branch {:id (generate-uuid) :data (atom [])}
         ; split the current branch
         data @(@current-branch :data)
-        [pre-branch post-branch] [(vec (take index data)) (vec (drop index data))]
+        pre-branch (vec (take index data))
+        post-branch (vec (drop index data))
         ; insert the branching point into the old branch
-        branched-branch (into [] (concat pre-branch [{:cont post-branch :branch new-branch}]))]
+        branched-branch (conj pre-branch {:cont (atom post-branch) :fork new-branch})]
       ; update the old branch with the inserted version
       (reset! (@current-branch :data) branched-branch)
       ; let current branch pointer point to new branch
       (add-new-branch new-branch)
       (reset! reverted-to -1)))
+
+(defn append-to-branch [branch s]
+  ; in case the branch got forked we have to jump these interruptions
+  (if-let [cont ((last @branch) :cont)]
+    (append-to-branch cont s)
+  (swap! branch conj n)))

 (defn save-state [n]
     (cond (> 100 @reverted-to -1 )
@@ -154,8 +165,9 @@
       :else
       (let [b @(@current-branch :data)]
         (when-not (= (last b) n)
-          (swap! (@current-branch :data) conj n))
+          (append-to-branch (@current-branch :data) n)
         (let [c (len @(@current-branch :data))]
+            (render-tree @app-history)
             (prn (str c " Saved " (pluralize c "State")))))))

 ; (om/root


Fixed title position & text and axis text position

--- src-cljs/kixi/hecuba/widgets/chart.cljs
+++ src-cljs/kixi/hecuba/widgets/chart.cljs
@@ -22,6 +22,7 @@
                              str
                              (str/split #"-"))
         data             (into [] (->> measurements
+                                       (filter #(number? (:value %)))
                                        (map #(assoc % :id device_id))
                                        (map #(assoc % :timestamp (tf/parse amon-date (:timestamp %))))))
         unit             (get-in cursor [:unit])
@@ -31,14 +32,13 @@
         s                (.addSeries dimple-chart type js/dimple.plot.line (clj->js [x y]))]
     (aset s "data" (clj->js data))
     (set! (.-tickFormat x) "%a %d %b %Y %H:%M")
+    (set! (.-title x) "Time")
     (.addLegend dimple-chart "5%" "10%" "20%" "10%" "right")
     (.draw dimple-chart)
+    (.attr (.-titleShape x) "y" 515)
     (.text (.-titleShape y) unit)
-    (.attr (.selectAll (.-shapes x) "text") "transform" (fn [d]
-                                                          (let [transform (.attr (.select d3 (js* "this")) "transform")]
-                                                            (when-not (empty?
-                                                                       transform)
-                                                              (str transform " rotate(-45)")))))))
+    (.attr (.selectAll (.-shapes x) "text") "transform" "rotate(45,0,12.6015625) translate(5, 0)")
+    (.attr (.selectAll (.-shapes x) "text") "style" "text-anchor: start; font-family: sans-serif; font-size: 10px;")))

 (defn chart-item
   [cursor owner]


[:human true] => [:spec [:of [:human true]]]

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -79,7 +79,8 @@
                   :pet false
                   :part-of-human-body false
                   :physical-object true
-                  :place false}
+                  :place false
+                  :spec {:of {:human true}}}

    {:living false} {:animate false
                     :human false}
@@ -94,8 +95,7 @@
                 :buyable true
                 :edible false
                 :human false
-                :spec {:of {:human true}}
-                }
+                :spec {:of {:human true}}}

    {:physical-object false} {:animate false}


remove this: already present where it should be, in verb section

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -196,17 +196,6 @@

    {:pred :student}  {:human true}

-   ;; The following inference rule is not
-   ;; yet used, but intended as a way to integrate
-   ;; verbs into the encyclopedia as we do with nouns.
-   ;; Note the use of {:cat :verb} to distinguish this
-   ;; from ..
-   {:pred :study
-    :cat :verb}      {:activity true
-                      :subj {:human true}
-                      :obj {:legible true}}
-
-   ;; .. the next rule which applies to nouns only.
    {:pred :study
     :cat :noun}      {:place true}


cleanup

cleanup

--- src/babel/italiano/lab.cljc
+++ src/babel/italiano/lab.cljc
@@ -1,27 +1,19 @@
 (ns babel.italiano.lab
   (:refer-clojure :exclude [get-in])
   (:require
-   [babel.directory :refer [models]]
-   [babel.italiano :as italiano :refer [analyze generate model morph morph-ps parse preprocess]]
-   [babel.italiano.grammar :as grammar :refer [model-plus-lexicon]]
-   [babel.italiano.lexicon :as lexicon]
-   [babel.italiano.morphology :as morph :refer [analyze-regular]]
-   [babel.italiano.morphology.nouns :as nouns]
-   [babel.lexiconfn :refer [write-lexicon]]
-   [babel.italiano.morphology.verbs :as verbs]
+   [babel.directory :refer []]
+   [babel.italiano :as italiano :refer [analyze generate model morph morph-ps parse]]
+   [babel.italiano.grammar :refer [model-plus-lexicon]]
    [babel.test.test :as btest]
    #?(:cljs [babel.logjs :as log])
    [clojure.pprint :refer [pprint]]
-   #?(:clj [clojure.test :as realtest :refer [is]])
-   #?(:cljs [cljs.test :refer-macros [is]])
    #?(:clj [clojure.tools.logging :as log])
    #?(:clj [clojure.repl :refer [doc]])
-   [clojure.string :as string]
    [clojure.set :as set]
-   [dag_unify.core :refer [copy fail? get-in strip-refs unify]]))
+   [dag_unify.core :refer [get-in strip-refs]]))

 (defn generate-speed-test [spec & [times]]
-  (btest/generate-speed-test spec models times))
+  (btest/generate-speed-test spec model times))

 (defn run-passato-prossimo-test []
   (generate-speed-test {:synsem {:cat :verb :subcat []
@@ -195,7 +187,7 @@
         chosen-subset (set (take 3 (shuffle transitive-verbs)))

         model
-        (babel.italiano.grammar/model-plus-lexicon
+        (model-plus-lexicon
          ;; filtered lexicon:
          (into {}
                (for [[k lexemes] lexicon]


Refactor, move failures by testcases closes towards runtime by testcases

--- src/buildviz/testsuites.clj
+++ src/buildviz/testsuites.clj
@@ -41,12 +41,6 @@

 (defn- unroll-testsuites [testsuites]
   (mapcat (partial unroll-testcases-for-suite []) testsuites))
-
-
-(defn- failed-testcase-ids [unrolled-testcases]
-  (map #(first %)
-       (remove #(junit-xml/is-ok? (last %))
-               unrolled-testcases)))

 (defn- assoc-testcase-entry [testsuite testcase-id testcase-data]
@@ -71,10 +65,21 @@
   (zipmap (keys unrolled-testcase-map)
           (map #(assoc {} :failedCount %) (vals unrolled-testcase-map))))

+(defn- count-failures [unrolled-testcases]
+  (->> unrolled-testcases
+       (group-by first)
+       (map (fn [[testcase-id group]]
+              [testcase-id (->> group
+                                (map last)
+                                (remove junit-xml/is-ok?)
+                                count)]))
+       (filter (fn [[testcase-id fail-count]]
+                 (< 0 fail-count)))
+       (into {})))
+
 (defn- accumulate-testsuite-failures-by-testcase [test-runs]
   (->> (mapcat unroll-testsuites test-runs)
-       failed-testcase-ids
-       frequencies
+       count-failures
        build-testcase-data-with-failures))

 (defn accumulate-testsuite-failures [test-runs]