CMR-5192: Added SES system tests.

CMR-5192: Added SES system tests.

--- test/cmr/opendap/tests/system/app/sizing/core.clj
+++ test/cmr/opendap/tests/system/app/sizing/core.clj
@@ -14,26 +14,301 @@

 (use-fixtures :once test-system/with-system)

-(deftest binary-size-with-no-sizing-metadata
+(deftest dods-size-with-no-sizing-metadata
   (let [collection-id "C1200267318-HMR_TME"
         granule-id "G1200267320-HMR_TME"
         variable-id "V1200267322-HMR_TME"
         options (-> {}
                     (request/add-token-header (util/get-sit-token)))]
-    (testing "GET without bounding box ..."
-      (let [response @(httpc/get
-                       (format (str "http://localhost:%s"
-                                    "/service-bridge/size-estimate/collection/%s"
-                                    "?granules=%s"
-                                    "&variables=%s"
-                                    "&format=dods")
-                               (test-system/http-port)
-                               collection-id
-                               granule-id
-                               variable-id)
-                       options)]
-        (is (= 200 (:status response)))
-        (is (= "cmr-service-bridge.v2.1; format=json"
-               (get-in response [:headers :cmr-media-type])))
-        (is (= [{:bytes 6220800, :gb 0.005793571472167969, :mb 5.9326171875}]
+      (let [response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s"
+                                    "&format=dods")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 6220800
+                 :gb 0.005793571472167969
+                 :mb 5.9326171875}]
+               (util/parse-response response))))))
+
+(deftest netcdf3-size-with-no-sizing-metadata
+  (let [collection-id "C1200267318-HMR_TME"
+        granule-id "G1200267320-HMR_TME"
+        variable-id "V1200267322-HMR_TME"
+        options (-> {}
+                    (request/add-token-header (util/get-sit-token)))]
+    (testing "Explicit format ... "
+      (let [response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s"
+                                    "&format=nc")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 6231034
+                 :mb 5.942377090454102
+                 :gb 0.0058031026273965836}]
+               (util/parse-response response)))))
+    (testing "Implicit format ... "
+      (let [response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 6231034
+                 :mb 5.942377090454102
+                 :gb 0.0058031026273965836}]
                (util/parse-response response)))))))
+
+(deftest dods-size
+  (let [collection-id "C1200297231-HMR_TME"
+        granule-id "G1200297234-HMR_TME"
+        variable-id "V1200297235-HMR_TME"
+        options (-> {}
+                    (request/add-token-header (util/get-sit-token)))]
+    (testing "One variable ..."
+      (let [response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s"
+                                    "&format=dods")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 1
+                 :gb 9.313225746154785E-10
+                 :mb 9.5367431640625E-7}]
+               (util/parse-response response)))))
+    (testing "One variable (from a different granule) ..."
+      (let [granule-id "G1200301322-HMR_TME"
+            variable-id "V1200301323-HMR_TME"
+            response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s"
+                                    "&format=dods")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 11520000
+                 :gb 0.010728836059570312
+                 :mb 10.986328125}]
+               (util/parse-response response)))))
+    (testing "Multiple variables ..."
+      (let [variable2-id "V1200297236-HMR_TME"
+            response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s,%s"
+                                    "&format=dods")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id
+                               variable2-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 5760001
+                 :gb 0.005364418961107731
+                 :mb 5.493165016174316}]
+               (util/parse-response response)))))
+    (testing "Multiple variables (from a different granule) ..."
+      (let [granule-id "G1200301322-HMR_TME"
+            variable1-id "V1200301323-HMR_TME"
+            variable2-id "V1200301324-HMR_TME"
+            response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s,%s"
+                                    "&format=dods")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable1-id
+                               variable2-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 17280000
+                 :gb 0.01609325408935547
+                 :mb 16.4794921875}]
+               (util/parse-response response)))))
+    ;; XXX Currently not working; see CMR-5268
+    #_(testing "Mutlple granules, multiple variables ..."
+      (let [variable1-id "V1200297236-HMR_TME"
+            granule2-id "G1200301322-HMR_TME"
+            variable2-id "V1200301324-HMR_TME"
+            response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s,%s"
+                                    "&variables=%s"
+                                    "&format=dods")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               granule2-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 8158
+                 :gb 7.597729563713074E-6
+                 :mb 0.0077800750732421875}]
+               (util/parse-response response)))))))
+
+(deftest netcdf3-size
+  (let [collection-id "C1200297231-HMR_TME"
+        granule-id "G1200297234-HMR_TME"
+        variable-id "V1200297235-HMR_TME"
+        options (-> {}
+                    (request/add-token-header (util/get-sit-token)))]
+    (testing "One variable ..."
+      (let [response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s"
+                                    "&format=nc")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 8158
+                 :gb 7.597729563713074E-6
+                 :mb 0.0077800750732421875}]
+               (util/parse-response response)))))
+    (testing "One variable (from a different granule) ..."
+      (let [granule-id "G1200301322-HMR_TME"
+            variable-id "V1200301323-HMR_TME"
+            response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s"
+                                    "&format=nc")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 11527615
+                 :gb 0.01073592808097601
+                 :mb 10.993590354919434}]
+               (util/parse-response response)))))
+    (testing "Multiple variables ..."
+      (let [variable2-id "V1200297236-HMR_TME"
+            response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s,%s"
+                                    "&format=nc")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable-id
+                               variable2-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 5768158
+                 :gb 0.005372015759348869
+                 :mb 5.500944137573242}]
+               (util/parse-response response)))))
+    (testing "Multiple variables (from a different granule) ..."
+      (let [granule-id "G1200301322-HMR_TME"
+            variable1-id "V1200301323-HMR_TME"
+            variable2-id "V1200301324-HMR_TME"
+            response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s"
+                                    "&variables=%s,%s"
+                                    "&format=nc")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               variable1-id
+                               variable2-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 17287615
+                 :gb 0.016100346110761166
+                 :mb 16.486754417419434}]
+               (util/parse-response response)))))
+    ;; XXX Currently not working; see CMR-5268
+    #_(testing "Mutlple granules, multiple variables ..."
+      (let [variable1-id "V1200297236-HMR_TME"
+            granule2-id "G1200301322-HMR_TME"
+            variable2-id "V1200301324-HMR_TME"
+            response @(httpc/get
+                       (format (str "http://localhost:%s"
+                                    "/service-bridge/size-estimate/collection/%s"
+                                    "?granules=%s,%s"
+                                    "&variables=%s"
+                                    "&format=nc")
+                               (test-system/http-port)
+                               collection-id
+                               granule-id
+                               granule2-id
+                               variable-id)
+                       options)]
+        (is (= 200 (:status response)))
+        (is (= "cmr-service-bridge.v2.1; format=json"
+               (get-in response [:headers :cmr-media-type])))
+        (is (= [{:bytes 8158
+                 :gb 7.597729563713074E-6
+                 :mb 0.0077800750732421875}]
+               (util/parse-response response)))))))


wip - deconstructor ordering, naming changes

--- src/mirthsync/apis.clj
+++ src/mirthsync/apis.clj
@@ -371,7 +371,41 @@
       loc)))

 (def channel-deconstructors
-  [[(partial name-script-sequence "destinationConnector-filter-step-")
+  [[(fn [_] "PreprocessingScript")
+    #(cdzx/xml1-> % (this-tag= :preprocessingScript))]
+
+   [(fn [_] "PostprocessingScript")
+    #(cdzx/xml1-> % (this-tag= :postprocessingScript))]
+
+   [(fn [_] "DeployScript")
+    #(cdzx/xml1-> % (this-tag= :deployScript))]
+
+   [(fn [_] "UndeployScript")
+    #(cdzx/xml1-> % (this-tag= :undeployScript))]
+
+   [(fn [loc] (let [name (cdzx/xml1-> loc cz/up cz/up :name cdzx/text)]
+                (str "destinationConnector" (when-not (cs/blank? name)
+                                              (str "-" name)))))
+    #(cdzx/xml1-> % (this-tag= :script) [cz/up :properties cz/up :connector])]
+
+   [(fn [loc] (let [name (cdzx/xml1-> loc cz/up cz/up :name cdzx/text)]
+                (str "sourceConnector" (when-not (cs/blank? name)
+                                         (str "-" name)))))
+    #(cdzx/xml1-> % (this-tag= :script) [cz/up :properties cz/up :sourceConnector])]
+
+   [(partial name-script-sequence "sourceConnector-filter-step-")
+    #(cdzx/xml1-> %
+                  (this-tag= :com.mirth.connect.plugins.javascriptrule.JavaScriptRule)
+                  :script
+                  [cz/up cz/up cz/up :filter cz/up :sourceConnector])]
+
+   [(partial name-script-sequence "sourceConnector-transformer-step-")
+    #(cdzx/xml1-> %
+                  (this-tag= :com.mirth.connect.plugins.javascriptstep.JavaScriptStep)
+                  :script
+                  [cz/up cz/up cz/up :transformer cz/up :sourceConnector])]
+
+   [(partial name-script-sequence "destinationConnector-filter-step-")
     #(cdzx/xml1-> %
                   (this-tag= :com.mirth.connect.plugins.javascriptrule.JavaScriptRule)
                   :script
@@ -389,41 +423,7 @@
     #(cdzx/xml1-> %
                   (this-tag= :com.mirth.connect.plugins.javascriptstep.JavaScriptStep)
                   :script
-                  [cz/up cz/up cz/up :responseTransformer cz/up :connector cz/up :destinationConnectors])]
-
-   [(partial name-script-sequence "sourceConnector-transformer-step-")
-    #(cdzx/xml1-> %
-                  (this-tag= :com.mirth.connect.plugins.javascriptstep.JavaScriptStep)
-                  :script
-                  [cz/up cz/up cz/up :transformer cz/up :sourceConnector])]
-
-   [(partial name-script-sequence "sourceConnector-filter-step-")
-    #(cdzx/xml1-> %
-                  (this-tag= :com.mirth.connect.plugins.javascriptrule.JavaScriptRule)
-                  :script
-                  [cz/up cz/up cz/up :filter cz/up :sourceConnector])]
-
-   [(fn [loc] (let [name (cdzx/xml1-> loc cz/up cz/up :name cdzx/text)]
-                (str "sourceConnector" (when-not (cs/blank? name)
-                                         (str "-" name)))))
-    #(cdzx/xml1-> % (this-tag= :script) [cz/up :properties cz/up :sourceConnector])]
-
-   [(fn [loc] (let [name (cdzx/xml1-> loc cz/up cz/up :name cdzx/text)]
-                (str "connector" (when-not (cs/blank? name)
-                                         (str "-" name)))))
-    #(cdzx/xml1-> % (this-tag= :script) [cz/up :properties cz/up :connector])]
-
-   [(fn [_] "PreprocessingScript")
-    #(cdzx/xml1-> % (this-tag= :preprocessingScript))]
-
-   [(fn [_] "PostprocessingScript")
-    #(cdzx/xml1-> % (this-tag= :postprocessingScript))]
-
-   [(fn [_] "DeployScript")
-    #(cdzx/xml1-> % (this-tag= :deployScript))]
-
-   [(fn [_] "UndeployScript")
-    #(cdzx/xml1-> % (this-tag= :undeployScript))]])
+                  [cz/up cz/up cz/up :responseTransformer cz/up :connector cz/up :destinationConnectors])]])

 (defmethod mi/deconstruct-node :channels [_ file-path el-loc]


Unroll assocs, prefer reduce to apply

Unroll assocs, prefer reduce to apply

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -111,13 +111,12 @@
                                         [event]
                                         message)
               message)]
-    (assoc leaf
-           :hash-group
-           (reduce (fn [groups t]
-                     (assoc groups t (group-message msg catalog t)))
-                   {}
-                   next-tasks)
-           :message (apply dissoc msg (:exclusions (:routes leaf))))))
+    (-> leaf
+        (assoc :message (reduce dissoc msg (:exclusions (:routes leaf))))
+        (assoc :hash-group (reduce (fn [groups t]
+                                     (assoc groups t (group-message msg catalog t)))
+                                   {}
+                                   next-tasks)))))

@@ -135,10 +134,10 @@
                                 :leaves
                                 (map (fn [leaf]
                                        (-> leaf
-                                           (assoc :routes (add-route-data event result leaf downstream)
-                                                  :id id
-                                                  :acker-id acker-id
-                                                  :completion-id completion-id)
+                                           (assoc :routes (add-route-data event result leaf downstream))
+                                           (assoc :id id)
+                                           (assoc :acker-id acker-id)
+                                           (assoc :completion-id completion-id)
                                            (group-segments downstream catalog event)
                                            (add-ack-vals)))
                                      leaves))))


Rename internals.

Rename internals.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -190,7 +190,7 @@
 (defn inject-batch-resources [event]
   (let [cycle-params {:onyx.core/lifecycle-id (java.util.UUID/randomUUID)}
         results (l-ext/inject-batch-resources* event)]
-    (merge event cycle-params results ((:onyx.core/compiled-pre-batch-fn event) results))))
+    (merge event cycle-params results ((:onyx.core/compiled-before-batch-fn event) results))))

 (defn read-batch [event]
   (let [rets (p-ext/read-batch event)]
@@ -272,7 +272,7 @@

 (defn close-batch-resources [event]
   (let [results (l-ext/close-batch-resources* event)]
-    (merge event results ((:onyx.core/compiled-post-batch-fn event) results))))
+    (merge event results ((:onyx.core/compiled-after-batch-fn event) results))))

 (defn launch-aux-threads!
   [messenger event outbox-ch seal-ch completion-ch task-kill-ch]
@@ -392,16 +392,19 @@
      identity
      matched)))

-(defn compile-pre-task-functions [lifecycles task-name]
+(defn compile-start-task-functions [lifecycles task-name]
+  (compile-lifecycle-functions lifecycles task-name :lifecycle/start-task?))
+
+(defn compile-before-task-functions [lifecycles task-name]
   (compile-lifecycle-functions lifecycles task-name :lifecycle/before-task))

-(defn compile-pre-batch-task-functions [lifecycles task-name]
+(defn compile-before-batch-task-functions [lifecycles task-name]
   (compile-lifecycle-functions lifecycles task-name :lifecycle/before-batch))

-(defn compile-post-batch-task-functions [lifecycles task-name]
+(defn compile-after-batch-task-functions [lifecycles task-name]
   (compile-lifecycle-functions lifecycles task-name :lifecycle/after-batch))

-(defn compile-post-task-functions [lifecycles task-name]
+(defn compile-after-task-functions [lifecycles task-name]
   (compile-lifecycle-functions lifecycles task-name :lifecycle/after-task))

 (defrecord TaskLifeCycle
@@ -433,10 +436,11 @@
                            :onyx.core/catalog catalog
                            :onyx.core/workflow (extensions/read-chunk log :workflow job-id)
                            :onyx.core/flow-conditions flow-conditions
-                           :onyx.core/compiled-pre-fn (compile-pre-task-functions lifecycles (:name task))
-                           :onyx.core/compiled-pre-batch-fn (compile-pre-batch-task-functions lifecycles (:name task))
-                           :onyx.core/compiled-post-batch-fn (compile-post-batch-task-functions lifecycles (:name task))
-                           :onyx.core/compiled-post-fn (compile-post-task-functions lifecycles (:name task))
+                           :onyx.core/compiled-start-task-fn (compile-start-task-functions lifecycles (:name task))
+                           :onyx.core/compiled-before-task-fn (compile-before-task-functions lifecycles (:name task))
+                           :onyx.core/compiled-before-batch-fn (compile-before-batch-task-functions lifecycles (:name task))
+                           :onyx.core/compiled-after-batch-fn (compile-after-batch-task-functions lifecycles (:name task))
+                           :onyx.core/compiled-after-task-fn (compile-after-task-functions lifecycles (:name task))
                            :onyx.core/compiled-norm-fcs (compile-fc-norms flow-conditions (:name task))
                            :onyx.core/compiled-ex-fcs (compile-fc-exs flow-conditions (:name task))
                            :onyx.core/task-map catalog-entry
@@ -456,7 +460,7 @@
             injection-results (l-ext/inject-lifecycle-resources* pipeline-data)
             pipeline-data (merge pipeline-data
                                  injection-results
-                                 ((:onyx.core/compiled-pre-fn pipeline-data)
+                                 ((:onyx.core/compiled-before-task-fn pipeline-data)
                                   injection-results))]

         (while (and (first (alts!! [kill-ch task-kill-ch] :default true))
@@ -492,7 +496,7 @@
   (stop [component]
     (taoensso.timbre/info (format "[%s] Stopping Task LifeCycle for %s" id (:onyx.core/task (:pipeline-data component))))
     (when-let [event (:pipeline-data component)]
-      ((:onyx.core/compiled-post-fn event) (l-ext/close-lifecycle-resources* event))
+      ((:onyx.core/compiled-after-task-fn event) (l-ext/close-lifecycle-resources* event))

       ;; Ensure task operations are finished before closing peer connections
       (close! (:seal-ch component))


Fixed ESB button so it compiles in advanced mode

--- src/webapp/framework/client/coreclient.cljs
+++ src/webapp/framework/client/coreclient.cljs
@@ -262,9 +262,11 @@
       (-> ($ :#myModalLabel) (html title))

-     (-> (js/$ "#myModal") (.modal))
+      ;(. ($ "#myModal") (modal))
+      (js/showHelp)
 ))

+;(-> (js/$ "#myModal") (.modal))

 ;(popup "Pup" "
dd
")


1st time seeing realtime working! :)

1st time seeing realtime working! :)

This is good! So we can see it start to work!!!! Needed to compare the
old timestamp of queries with the new one

--- src/webapp/framework/client/coreclient.cljs
+++ src/webapp/framework/client/coreclient.cljs
@@ -1349,14 +1349,14 @@
          xx           (-> x :queries keys first)
          ;new-key     (dissoc (dissoc xx :start) :end)
          new-key      {:data-source     :todo_items
-                       :table           "todo_items"
+                       :table           nil
                        :where           nil
                        :db-table        "todo_items"
                        :params          nil
                        :order           nil
                        :realtime        true}
          ]
-     (log "Client realtime: " new-key)
+     ;(log "Client realtime: " new-key)
      (>! client-query-cache-requests  {
                                   :query-key     new-key

@@ -1418,9 +1418,14 @@

                  (let [new-query-atom  (get @client-query-cache  query-key)]

+
+                   ;(log (str "     :                old        : " (:timestamp old-val)))
+                   ;(log (str "     :                new        : " (:timestamp new-val)))
+                   ;(log (str "     : (add-watch data-query-atom: " (sort query-key)))
                    (if (or
                         (not (= (:start old-val) (:start new-val)))
                         (not (= (:end   old-val) (:end   new-val)))
+                        (>  (:timestamp new-val) (:timestamp old-val))
                         )
                      (do
                        ;(js/alert (pr-str "Query changed: " query-key))
@@ -1434,7 +1439,7 @@
                            (if (not already-loaded?)
                              (go
                               ;(js/alert (str "Query loaded?" already-loaded?))
-                              ;(js/alert (pr-str "query values:" (get @new-query-atom :values)))
+                              ;(log (pr-str " ********* query values:" (get @new-query-atom :values)))
                               (>! client-query-cache-requests  {
                                                            :query-key     query-key

@@ -1442,7 +1447,8 @@
                                                                            :start   (:start  new-val)
                                                                            :end     (:end    new-val)
                                                                            } })
-                              ))))
+                              )))
+                       )

                        (update-all-views-for-query   query-key)

@@ -1644,8 +1650,8 @@
          query-atom                 (get @client-query-cache   query-key)
          list-of-record-positions   (range (:start params) (inc (:end params)))
        ]
-    (log (str "     :" query-key))
-    (log (str "     :" records))
+   ; (log (str "     :" query-key))
+   ; (log (str "     :" records))

     ; -----------------------------------------------
     ; update the record count in the query
@@ -1671,17 +1677,18 @@
     ; update the record IDs in the query
     ; -----------------------------------------------
     (if query-atom
-      (reset!  query-atom
-               (assoc @query-atom :values
-                 (merge
-                  (apply merge (map
-                                (fn[record-pos
-                                    record-id]   {record-pos  record-id})
-
-                                list-of-record-positions
-                                records
-                                ))
-                  (get @query-atom :values)))))
+      (do
+        (reset!  query-atom
+                 (assoc @query-atom :values
+                   (merge
+                    (apply merge (map
+                                  (fn[record-pos
+                                      record-id]   {record-pos  record-id})
+
+                                  list-of-record-positions
+                                  records
+                                  ))
+                    (get @query-atom :values))))))

     ; -----------------------------------------------
@@ -1701,7 +1708,7 @@
        (update-all-views-for-query    query-key)

         ))
-    (if query-atom (log (str "CLIENT: @query-atom: " @query-atom)))
+    ;(if query-atom (log (str "CLIENT: @query-atom: " @query-atom)))
     ))

@@ -1732,14 +1739,13 @@

      (let [
            params         (merge (merge (:query-key request) (:subset-range request)) {:data-session-id     @data-session-id})
-
            return-value   (remote      !get-query-results-v2  params)
            records        (:records    return-value)
            records-count  (:count      return-value)
            timestamp      (:timestamp  return-value)
            ]

-       ;(log (pr-str (:query-key     request)))
+       ;(log (pr-str "            ***" (:query-key     request)))
        (add-data-query-result-v2   (:query-key     request)
                                    (:subset-range  request)
                                    records-count


Change summary text to talk about claims rather than facts.

--- src/midje/ideas/reporting/string_format.clj
+++ src/midje/ideas/reporting/string_format.clj
@@ -146,11 +146,11 @@

 (defn print-midje-summary-line [result]
   (let [midje-failure-message (condp = (:fail result)
-                                0 (color/pass (format "All claimed facts (%d) have been confirmed." (:pass result)))
+                                0 (color/pass (format "All claims (%d) have been confirmed." (:pass result)))
                                 1 (str (color/fail "FAILURE:")
-                                       (format " %d fact was not confirmed." (:fail result)))
+                                       (format " %d claim was not confirmed." (:fail result)))
                                 (str (color/fail "FAILURE:")
-                                     (format " %d facts were not confirmed." (:fail result))))
+                                     (format " %d claims were not confirmed." (:fail result))))

         potential-consolation (condp = (:pass result)
                                 0 ""


Update transaction_script.clj

Update transaction_script.clj

--- src/poeaa/transaction_script.clj
+++ src/poeaa/transaction_script.clj
@@ -7,6 +7,12 @@
 (declare insert-recognition)

 (declare add-days)
+
+(declare next)
+
+(declare find-recognitions-for)
+
+(declare date-time)

 (defn calculate-revenue-recognitions [contract-number]
   (let [contracts (find-contract contract-number)
@@ -23,3 +29,14 @@
             (insert-recognition contract-number (nth allocation 0) recognition-date)
             (insert-recognition contract-number (nth allocation 1) (add-days recognition-date 30))
             (insert-recognition contract-number (nth allocation 2) (add-days recognition-date 60))))))
+
+(defn recognized-revennue [contract-number as-of]
+  (loop [result 0
+         rs (find-recognitions-for contract-number as-of)]
+    (if rs
+        (recur (+ result (:amount rs)) (next rs))
+        result)))
+
+(calculate-revenue-recognitions 12322)
+
+(recognized-revennue 12322 (date-time 2015 12 25))


creation bumps

creation bumps

--- src/ontrail/mutate.clj
+++ src/ontrail/mutate.clj
@@ -92,7 +92,7 @@
                  :duration (parse-duration (:duration user-ex))
                  :sport (:sport user-ex)
                  :creationDate (parse-date (:date user-ex))
-                 :lastModifiedDate (parse-date (:date user-ex))
+                 :lastModifiedDate (time/now)
                  :user user}
         body (if (nil? (:body user-ex)) "" (:body user-ex)) ;; disallow nil body
         tags (parse-tags (:tags user-ex))


Gets rid of debug info

Gets rid of debug info

--- src/onyx/tasks/sql.clj
+++ src/onyx/tasks/sql.clj
@@ -162,7 +162,6 @@
     copy? :- s/Boolean
     copy-columns :- [s/Keyword]
     task-opts :- {s/Any s/Any}]
-   (println "write-rows, copy? = " (pr-str copy?))
    (write-rows task-name (merge {:sql/classname classname
                                  :sql/subprotocol subprotocol
                                  :sql/subname subname


cleanup and doc [CI SKIP]

cleanup and doc [CI SKIP]

--- internal/machina/src/samsara/machina/core.clj
+++ internal/machina/src/samsara/machina/core.clj
@@ -1,4 +1,17 @@
 (ns samsara.machina.core)
+;;
+;; This namespace contains an REPL exploration session on
+;; various possible implementation of a State Machine
+;; in Clojure. There are several characteristics that
+;; I'm keen to explore and achieve in the final system
+;; such as: simplicity, flexibility, robustness,
+;; speed, and more.
+;; I'll be writing several implementations of the
+;; state machine to solve a simple problem
+;; and try to evaluate which compromises I'm making
+;; in regards to the aforementioned characteristics.
+;;
+

 ;;
 ;; TODO: managed transition
@@ -14,26 +27,6 @@
         (str (java.util.Date.) \newline)
         :append true))

-
-(comment
-  (defn empty-machine
-    "defines a empty state machine which only goes from start->stop"
-    []
-    {:state :machina/start
-
-     :transitions {:machina/start [:machina/no-op :machina/stop]}})
-
-
-
-  (defn configure-machine [sm fns]
-    (-> sm
-        ;; turn the list of states and transitions into a map
-        (update :transitions (fn [ts]
-                               (->> (map (fn [[s0 t s1]] [s0 [t s1]]) ts)
-                                    (into {})))))))
-
-
-;;(configure-machine (empty-machine))

@@ -180,7 +173,7 @@

     (->> sm
          (iterate transition)
-         (take-while #(not= :machine/stop (:state %)))
+         (take-while #(not= :machina/stop (:state %)))
          (last))

@@ -249,7 +242,7 @@

     (->> sm
          (iterate transition)
-         (take-while #(not= :machine/stop (:state %)))
+         (take-while #(not= :machina/stop (:state %)))
          (last))

@@ -308,13 +301,13 @@

   ;; write to file example
   (def sm
-    {:state :machine/start
+    {:state :machina/start
      :epoch 0
      :data nil

      :dispatch
-     {:machine/stop identity
-      :machine/start
+     {:machina/stop identity
+      :machina/start
       (fn
         [sm]
         (assoc sm
@@ -369,7 +362,7 @@

     (->> sm
          (iterate transition)
-         (take-while #(not= :machine/stop (:state %)))
+         (take-while #(not= :machina/stop (:state %)))
          (last))

@@ -440,13 +433,13 @@

   ;; write to file example
   (def sm
-    {:state :machine/start
+    {:state :machina/start
      :epoch 0
      :data nil

      :dispatch
-     {:machine/stop identity
-      :machine/start
+     {:machina/stop identity
+      :machina/start
       (fn
         [sm]
         (assoc sm
@@ -466,7 +459,7 @@
         (assoc sm :state :write-to-file))}

      :error-policies
-     {:machine/default {:type        :retry
+     {:machina/default {:type        :retry
                         :max-retry   :forever
                         :retry-delay [:random-exp-backoff :base 3000 :+/- 0.35 :max 25000]}

@@ -498,7 +491,7 @@

     (->> sm
          (iterate transition)
-         (take-while #(not= :machine/stop (:state %)))
+         (take-while #(not= :machina/stop (:state %)))
          (last))


add test to be sure transaction date is saved and retrieved correctly

--- test/clj_money/models/transactions_test.clj
+++ test/clj_money/models/transactions_test.clj
@@ -60,7 +60,10 @@
       (let [retrieved (transactions/find-by-id storage-spec (:id transaction))]
         (is retrieved "The transaction is retrievable by ID")
         (is (= 2
-               (count (:items retrieved))) "The items are returned with the transaction")))))
+               (count (:items retrieved))) "The items are returned with the transaction")
+        (is (= (t/local-date 2016 3 2)
+               (:transaction-date retrieved))
+            "The transaction date is correct")))))

 (deftest transaction-date-is-required
   (let [context (test-context)


add separate graphs page for admin

add separate graphs page for admin

--- src/pc/views/admin.clj
+++ src/pc/views/admin.clj
@@ -47,10 +47,14 @@
          [:text {:x (+ (* 1.5 padding) 1000) :y (+ padding i)}
           (- max-users-per-day (int (* i (/ max-users-per-day 500))))]))
       (map-indexed (fn [i user-count]
-                     [:circle {:cx (+ padding (* x-tick-width i))
-                               :cy (+ padding (- 500 (* y-tick-width user-count)))
-                               :r 5
-                               :fill "blue"}])
+                     [:g
+                      [:circle {:cx (+ padding (* x-tick-width i))
+                                :cy (+ padding (- 500 (* y-tick-width user-count)))
+                                :r 5
+                                :fill "blue"
+                                }]
+                      [:title user-count]])
+
                    users-per-day)]
      [:svg {:width 1200 :height 600}
       [:rect {:x 20 :y 20 :width 1000 :height 500
@@ -63,10 +67,12 @@
          [:text {:x (+ (* 1.5 padding) 1000) :y (+ padding i)}
           (- max-users (int (* i (/ max-users 500))))]))
       (map-indexed (fn [i user-count]
-                     [:circle {:cx (+ padding (* x-tick-width i))
-                               :cy (+ padding (- 500 (* y-cumulative-tick-width user-count)))
-                               :r 5
-                               :fill "blue"}])
+                     [:g
+                      [:circle {:cx (+ padding (* x-tick-width i))
+                                :cy (+ padding (- 500 (* y-cumulative-tick-width user-count)))
+                                :r 5
+                                :fill "blue"}]
+                      [:title user-count]])
                    user-counts)])))

 (defn early-access-users []


Add index-of fn

Add index-of fn

--- src/playmary/util.cljs
+++ src/playmary/util.cljs
@@ -30,6 +30,11 @@
 (defn find-first
   [pred coll]
   (first (filter pred coll)))
+
+(defn index-of
+  [coll item]
+  (find-first (fn [i] (= item (nth coll i)))
+              (-> coll count range)))

 (def keyword->event-type
   {:keyup goog.events.EventType.KEYUP


added functional test for editing a conference | sg | #8

--- test/clj/conference_rating/functional_test.clj
+++ test/clj/conference_rating/functional_test.clj
@@ -40,6 +40,7 @@

 (defn fill-input [fill-map]
   (doseq [[k v] fill-map]
+    (taxi/clear (e2e-selector k))
     (taxi/send-keys (e2e-selector k) v)))

 (defn first-of-month [dates]
@@ -102,6 +103,16 @@
       (wait-for "page-conference-detail")
       (taxi/wait-until #(= "1" (text "text-icon-panel-number")))

+      ; edits conference
+      (click "button-edit-conference")
+      (wait-for "page-add-conference")
+      (fill-input {"input-conference-description" "some edited description"})
+      (click "button-create-conference")
+
+      ; detail page of the edited conference
+      (wait-for "page-conference-detail")
+      (is (= "some edited description" (text "text-conference-description")))
+
       ; deletes conference
       (click "button-delete-conference")
       (taxi/accept)


flush only once

flush only once

--- data/celestial/fixtures/populate.clj
+++ data/celestial/fixtures/populate.clj
@@ -105,5 +105,6 @@
   [& args]
   (set-user {:username "admin"}
      (populate-all)
+     (es/flush-)
      (u/delete-user "admin"); will be set up in next launch
      (println "populate done!")))


brighten title

brighten title

--- src/solar_system_of_js/core.cljs
+++ src/solar_system_of_js/core.cljs
@@ -153,7 +153,7 @@
   (font! "100 100px Roboto")
   (text-align! "center")
   (text-baseline! "middle")
-  (fill-style! "#555")
+  (fill-style! "#DDD")
   (fill-text! "Solar System of JS" x y)
   (restore!)
   )


fixing double reloads caused by figwheel-always

--- sidecar/src/figwheel_sidecar/core.clj
+++ sidecar/src/figwheel_sidecar/core.clj
@@ -275,9 +275,10 @@
   (cond
     (nil? cljs.env/*compiler*) changed-ns-syms'
     (false? (:recompile-dependents state))
-    (concat changed-ns-syms' (find-figwheel-always))
+    (union (keep (fn [n] (:name (ana-api/find-ns n))) changed-ns-syms')
+           (find-figwheel-always))
     :else
-    (let [changed-ns-syms       (set (map (fn [n] (:name (ana-api/find-ns n))) changed-ns-syms'))
+    (let [changed-ns-syms       (set (keep (fn [n] (:name (ana-api/find-ns n))) changed-ns-syms'))
           dependants            (set (mapcat
                                       transitive-dependents
                                       changed-ns-syms))


refactor type variable name

refactor type variable name

--- src-cljs/frontend/components/add_projects.cljs
+++ src-cljs/frontend/components/add_projects.cljs
@@ -104,7 +104,7 @@
       (let [repo (:repo data)
             settings (:settings data)
             login (get-in settings [:add-projects :selected-org :login])
-            type (get-in settings [:add-projects :selected-org :vcs_type])
+            vcs-type (get-in settings [:add-projects :selected-org :vcs_type])
             repo-id (repo-model/id repo)
             repo-url (vcs-url/project-path (:vcs_url repo))
             tooltip-id (str "view-project-tooltip-" (string/replace repo-id #"[^\w]" ""))
@@ -126,25 +126,23 @@
                    (button/link
                      {:kind :primary
                       :href (if (feature/enabled? "top-bar-ui-v-1")
-                              (routes/v1-setup-project-path {:org login :vcs_type type})
+                              (routes/v1-setup-project-path {:org login :vcs_type vcs-type})
                               (routes/v1-setup-project))
                       :on-click #(raise! owner [:setup-project-select-project repo-id])}
                      "Setup project")]

                   (managed-button
                     [:button {:on-click #(do
-                                           (raise! owner [:followed-repo (assoc repo
-                                                                           :login login
-                                                                           :type type)])
+                                           (raise! owner [:followed-repo repo])
                                            ; TODO: rm not building-on-circle? content when :onboarding-v1
                                            ; it out of treatment.
                                            (when (not building-on-circle?)
                                              (om/set-state! owner :building? true)
                                              ((om/get-shared owner :track-event)
-                                               {:event-type :build-project-clicked
-                                                :properties {:project-vcs-url repo-url
-                                                             :repo repo-name
-                                                             :org login}})))
+                                              {:event-type :build-project-clicked
+                                               :properties {:project-vcs-url repo-url
+                                                            :repo repo-name
+                                                            :org login}})))
                               ; TODO: rm not building-on-circle? content when :onboarding-v1
                               :title (if building-on-circle?
                                        "This project is currently building on CircleCI. Clicking will cause builds for this project to show up for you in the UI."
@@ -157,9 +155,7 @@
                [:li.repo-unfollow
                 title-el
                 (managed-button
-                 [:button {:on-click #(raise! owner [:unfollowed-repo (assoc repo
-                                                                             :login login
-                                                                             :type type)])
+                 [:button {:on-click #(raise! owner [:unfollowed-repo repo])
                            :data-spinner true}
                   [:span "Unfollow project"]])]


remove reminder for completed test

remove reminder for completed test

--- test/clj_money/models/transactions_test.clj
+++ test/clj_money/models/transactions_test.clj
@@ -595,8 +595,6 @@

 ; update a transaction

-; change date
-;  recalculation stops once new balance and index values match old values
 ; change account
 ;  old account balance and items are recalculated
 ;  new account balance and items are recalculated


fix CLI arg parsing test

fix CLI arg parsing test

--- test/puppetlabs/trapperkeeper/main_test.clj
+++ test/puppetlabs/trapperkeeper/main_test.clj
@@ -6,7 +6,7 @@
             [puppetlabs.trapperkeeper.testutils.bootstrap :refer [parse-and-bootstrap]]
             [slingshot.slingshot :refer [try+]]))

-(testing "CLI arg parsing"
+(deftest cli-arg-parsing
   (testing "Parsed CLI data"
     (let [bootstrap-file "/fake/path/bootstrap.cfg"
           config-dir     "/fake/config/dir"
@@ -39,10 +39,14 @@
       (is (= config-file-path (cli-data-fn :config)))))

   (testing "Fails if config CLI arg is not specified"
-    (try+
-      (main)
-      (catch map? m
-        (is (contains? m :error-message))
-        (is (re-matches
-              #"(?s)^.*Missing required argument '--config'.*$"
-              (m :error-message)))))))
+    ;; looks like `thrown-with-msg?` can't be used with slingshot. :(
+    (let [got-expected-exception (atom false)]
+      (try+
+        (parse-cli-args! [])
+        (catch map? m
+          (is (contains? m :error-message))
+          (is (re-matches
+                #"(?s)^.*Missing required argument '--config'.*$"
+                (m :error-message)))
+          (reset! got-expected-exception true)))
+      (is (true? @got-expected-exception)))))


Missed file on last commit.

Missed file on last commit.

--- Clojure/project.clj
+++ Clojure/project.clj
@@ -4,7 +4,8 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.6.0"]
-                 [org.clojure/clojurescript "0.0-2850"]]
+                 [org.clojure/clojurescript "0.0-2850"]
+                 [javax.jmdns/jmdns "3.4.1"]]
   :source-paths ["src"]
   :compiler {
      :output-dir "out"


Pretty sure there's not supposed to be an x there

--- src/wishlistd/views/wishlist.clj
+++ src/wishlistd/views/wishlist.clj
@@ -1,5 +1,5 @@
 (ns wishlistd.views.wishlist
-  (:require x[wishlistd.models.sql :as model])
+  (:require [wishlistd.models.sql :as model])
   (:use noir.fetch.remotes))

 (def layout (slurp "resources/public/index.html"))


Added game-id to message.

Added game-id to message.

--- src/wombats/sockets/messages.clj
+++ src/wombats/sockets/messages.clj
@@ -109,7 +109,8 @@
   [{:keys [game-config] :as game-state}]

   (get-message :game-info
-               {:game/round-start-time (get-start-time game-state)
+               {:game/id (:game/id game-config)
+                :game/round-start-time (get-start-time game-state)
                 :game/round-number (get-round-number game-state)
                 :game/max-players (:game/max-players game-config)
                 :game/player-count (count (:players game-state))


Move parts of Reaction to plain functions

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -193,14 +193,57 @@
   (run [this]))

 (defprotocol IComputedImpl
-  (-update-watching [this derefed])
-  (-handle-change [k sender oldval newval])
-  (-peek-at [this])
-  (-check-clean [this]))
+  (-peek-at [this]))

 (def clean 0)
 (def maybe-dirty 1)
 (def is-dirty 2)
+
+(declare reaction?)
+
+(defn- ra-notify-watches [ra oldval newval]
+  (reduce-kv (fn [_ key f]
+               (f key ra oldval newval)
+               nil)
+             nil ra.watches))
+
+(defn- ra-check-clean [ra]
+  (when (== ra.dirty? maybe-dirty)
+    (set! ra.norun? true)
+    (doseq [w ra.watching]
+      (when (reaction? w)
+        (-deref w)))
+    (set! ra.norun? false)
+    (when (== ra.dirty? maybe-dirty)
+      (set! ra.dirty? clean))))
+
+(defn- ra-handle-change [ra sender oldval newval]
+  (when ra.active?
+    (let [old-dirty ra.dirty?]
+      (set! ra.dirty? (max ra.dirty?
+                           (if (identical? oldval newval)
+                             (if (reaction? sender)
+                               maybe-dirty clean)
+                             is-dirty)))
+      (if (and ra.auto-run (not ra.norun?))
+        (do
+          ;; FIXME: is this correct?
+          (when (== ra.dirty? maybe-dirty)
+            (binding [*ratom-context* (js-obj)]
+              (ra-check-clean ra)))
+          (when-not (== ra.dirty? clean)
+            ((or ra.auto-run run) ra)))
+        (when (== old-dirty clean)
+          (ra-notify-watches ra ra.state ra.state))))))
+
+(defn- ra-update-watching [ra derefed]
+  (doseq [w derefed]
+    (when-not (contains? ra.watching w)
+      (add-watch w ra ra-handle-change)))
+  (doseq [w ra.watching]
+    (when-not (contains? derefed w)
+      (remove-watch w ra)))
+  (set! ra.watching derefed))

 (deftype Reaction [f ^:mutable state ^:mutable dirty? ^:mutable active?
                    ^:mutable watching ^:mutable watches
@@ -210,10 +253,7 @@

   IWatchable
   (-notify-watches [this oldval newval]
-    (reduce-kv (fn [_ key f]
-                 (f key this oldval newval)
-                 nil)
-               nil watches))
+    (ra-notify-watches this oldval newval))

   (-add-watch [this k wf]
     (set! watches (assoc watches k wf)))
@@ -231,7 +271,7 @@
       (when on-set
         (set! dirty? is-dirty)
         (on-set oldval newval))
-      (-notify-watches a oldval newval)
+      (ra-notify-watches a oldval newval)
       newval))

   ISwap
@@ -245,50 +285,11 @@
     (-reset! a (apply f (-peek-at a) x y more)))

   IComputedImpl
-  (-handle-change [this sender oldval newval]
-    (when active?
-      (let [old-dirty dirty?]
-        (set! dirty? (max dirty?
-                          (if (identical? oldval newval)
-                            maybe-dirty is-dirty)))
-        (if (and auto-run (not norun?))
-          (do
-            ;; FIXME: is this correct?
-            (when (== dirty? maybe-dirty)
-              (binding [*ratom-context* (js-obj)]
-                (-check-clean this)))
-            (when-not (== dirty? clean)
-              ((or auto-run run) this)))
-          (when (== old-dirty clean)
-            (-notify-watches this state state)))))
-    ;; (when (and active? (not (identical? oldval newval)))
-    ;;   (set! dirty? is-dirty)
-    ;;   ((or auto-run run) this))
-    )
-
-  (-update-watching [this derefed]
-    (doseq [w derefed]
-      (when-not (contains? watching w)
-        (add-watch w this -handle-change)))
-    (doseq [w watching]
-      (when-not (contains? derefed w)
-        (remove-watch w this)))
-    (set! watching derefed))
-
   (-peek-at [this]
     (if (== dirty? clean)
       state
       (binding [*ratom-context* nil]
         (-deref this))))
-
-  (-check-clean [this]
-    (when (== dirty? maybe-dirty)
-      (set! norun? true)
-      (doseq [w watching]
-        (-deref w))
-      (set! norun? false)
-      (when (== dirty? maybe-dirty)
-        (set! dirty? clean))))

   IRunnable
   (run [this]
@@ -297,19 +298,19 @@
           res (capture-derefed f this)
           derefed (captured this)]
       (when (not= derefed watching)
-        (-update-watching this derefed))
+        (ra-update-watching this derefed))
       (when-not active?
         (when debug (swap! -running inc))
         (set! active? true))
       (set! norun? false)
       (set! dirty? clean)
       (set! state res)
-      (-notify-watches this oldstate state)
+      (ra-notify-watches this oldstate state)
       res))

   IDeref
   (-deref [this]
-    (-check-clean this)
+    (ra-check-clean this)
     (if (or auto-run (some? *ratom-context*))
       (do
         (notify-deref-watcher! this)
@@ -321,7 +322,7 @@
           (let [oldstate state]
             (set! state (f))
             (when-not (identical? oldstate state)
-              (-notify-watches this oldstate state))))
+              (ra-notify-watches this oldstate state))))
         state)))

   IDisposable
@@ -349,6 +350,9 @@
   IHash
   (-hash [this] (goog/getUid this)))

+(defn- reaction? [ra]
+  (instance? Reaction ra))
+
 (defn make-reaction [f & {:keys [auto-run on-set on-dispose derefed]}]
   (let [runner (if (= auto-run true) run auto-run)
         active (not (nil? derefed))
@@ -358,7 +362,7 @@
                             runner on-set on-dispose false)]
     (when-not (nil? derefed)
       (when debug (swap! -running inc))
-      (-update-watching reaction derefed))
+      (ra-update-watching reaction derefed))
     reaction))


Don't leak route-based data from legacy pages

--- src-cljs/frontend/parser.cljs
+++ src-cljs/frontend/parser.cljs
@@ -155,24 +155,38 @@
 ;; frontend.routes/set-data sets the :app/route-data during navigation.
 (defmethod mutate `routes/set-data
   [{:keys [state] :as env} key params]
-  {:action #(let [route-data (cond-> {}
-                               (contains? params :organization)
-                               (assoc :route-data/organization
-                                      [:organization/by-vcs-type-and-name
-                                       (select-keys (:organization params)
-                                                    [:organization/vcs-type :organization/name])]))
-                  ;; Once Compassus lets us change the route and set route
-                  ;; data in one transaction, we can use the :route from the
-                  ;; env and stop passing it as a param. See
-                  ;; frontend.routes/open for more info.
-                  route (:route params)]
-              (swap! state assoc :app/route-data route-data)
-              (analytics/track {:event-type :pageview
-                                :navigation-point route
-                                :subpage :default
-                                :properties {:user (get-in @state [:app/current-user :user/login])
-                                             :view route
-                                             :org (get-in params [:organization :organization/name])}}))})
+  {:action (fn []
+             (let [route-data (cond-> {}
+                                (contains? params :organization)
+                                (assoc :route-data/organization
+                                       [:organization/by-vcs-type-and-name
+                                        (select-keys (:organization params)
+                                                     [:organization/vcs-type :organization/name])]))
+                   ;; Once Compassus lets us change the route and set route
+                   ;; data in one transaction, we can use the :route from the
+                   ;; env and stop passing it as a param. See
+                   ;; frontend.routes/open for more info.
+                   route (:route params)]
+               (swap! state #(-> %
+                                 (assoc :app/route-data route-data)
+
+                                 ;; Clean up the legacy state so it doesn't leak
+                                 ;; from the previous page. This goes away when
+                                 ;; the legacy state dies. In the Om Next world,
+                                 ;; all route data is in :app/route-data, and is
+                                 ;; replaced completely on each route change.
+                                 (update :legacy/state dissoc
+                                         :navigation-point
+                                         :navigation-data
+                                         :current-build-data
+                                         :current-org-data
+                                         :current-project-data)))
+               (analytics/track {:event-type :pageview
+                                 :navigation-point route
+                                 :subpage :default
+                                 :properties {:user (get-in @state [:app/current-user :user/login])
+                                              :view route
+                                              :org (get-in params [:organization :organization/name])}})))})

 (defn flattening-parser
   "Takes a parser. Returns a parser which ignores the root keys of the queries


Implement shape attrs transformation as reduce function.

--- frontend/uxbox/ui/shapes.cljs
+++ frontend/uxbox/ui/shapes.cljs
@@ -6,26 +6,27 @@
             [uxbox.util.data :refer (remove-nil-vals)]))

 (defn- transform-attr
-  [data [key value :as pair]]
+  [acc key value]
   (case key
     :view-box
-    [key (apply str (interpose " " value))]
+    (assoc! acc key (apply str (interpose " " value)))

     :lock
-    [:preserveAspectRatio (if value "xMidYMid" "none")]
+    (assoc! acc :preserveAspectRatio (if value "xMidYMid" "none"))

     :rotation
     (let [width (nth (:view-box data) 3)
           center-x (+ (:x data) (/ (:width data) 2))
           center-y (+ (:y data) (/ (:height data) 2))]
-      [:transform (str/format "rotate(%s %s %s)" value center-x center-y)])
+      (assoc! acc :transform (str/format "rotate(%s %s %s)"
+                                         value center-x center-y)))

-    pair))
+    (assoc! acc key value)))

 (defn- transform-attrs
   [data]
-  (let [xf (map (partial transform-attr data))]
-    (into {} xf data)))
+  (persistent!
+   (reduce-kv transform-attr (transient {}) data)))

 (defn- extract-attrs
   "Extract predefinet attrs from shapes."


formatting

formatting

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -7,8 +7,8 @@
    [figwheel.client.heads-up :as heads-up]
    [figwheel.client.file-reloading :as reloading]
    [clojure.string :as string]
-   [cljs.repl] ;; to support repl doc
-   )
+   ;; to support repl doc
+   [cljs.repl])
   (:require-macros
    [cljs.core.async.macros :refer [go go-loop]]))


Use 'ws://' instead of 'ws:' for compatibility with IE

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -146,6 +146,6 @@
                                                   (.dispatchEvent (.querySelector js/document "body")
                                                                   (js/CustomEvent. "figwheel.js-reload"
                                                                                (js-obj "detail" url))))
-                                :websocket-url (str "ws:" js/location.host "/figwheel-ws")}
+                                :websocket-url (str "ws://" js/location.host "/figwheel-ws")}
                               opts))))


fix(deps): update dependency org.clojure:clojure to v1.10.0 (#75)

--- technologies/clojure/project.clj
+++ technologies/clojure/project.clj
@@ -3,7 +3,7 @@
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.8.0"]
+  :dependencies [[org.clojure/clojure "1.10.0"]
                  [javax.servlet/servlet-api "2.5"]
                  [ring/ring-core "1.6.0-RC2"]
                  [http-kit "2.3.0"]


CMR-6161 removed unused radix

CMR-6161 removed unused radix

--- search-app/src/cmr/search/api/autocomplete.clj
+++ search-app/src/cmr/search/api/autocomplete.clj
@@ -20,7 +20,7 @@
 (defn- string-param-or-default->int
   [s default]
   (if s
-    (Integer/parseInt s 10)
+    (Integer/parseInt s)
     default))

 (defn- lower-case-and-trim


Dont provide completions for empty string

Former-commit-id: fc6660b82d8bf594014adead1041fa56284e791d

--- planck-cljs/src/planck/core.cljs
+++ planck-cljs/src/planck/core.cljs
@@ -89,10 +89,12 @@
                          (completion-candidates-for-ns @current-ns))]
     (let [buffer-match-suffix (re-find #"[a-zA-Z]*$" buffer)
           buffer-prefix (subs buffer 0 (- (count buffer) (count buffer-match-suffix)))]
-      (clj->js (map #(str buffer-prefix %)
-                 (sort
-                   (filter (partial is-completion? buffer-match-suffix)
-                     all-candidates)))))))
+      (clj->js (if (= "" buffer-match-suffix)
+                 []
+                 (map #(str buffer-prefix %)
+                  (sort
+                    (filter (partial is-completion? buffer-match-suffix)
+                      all-candidates))))))))

 (defn extension->lang [extension]
   (if (= ".js" extension)


Change test data domain

Change test data domain

--- example-src/devdemos/core.cljs
+++ example-src/devdemos/core.cljs
@@ -12,23 +12,18 @@
     :value "Name"}
    {:key :age
     :value "Age"
-    :editor components/int-editor}
-   {:key :owner
-    :value "Owner"}])
+    :editor components/int-editor}])

 (def example-data
   [{:id 1
-    :name "Rin Tin Tin"
-    :age 3
-    :owner "Lee Duncan"}
+    :name "Deadpool"
+    :age 32}
    {:id 2
-    :name "Lassie"
-    :age 10
-    :owner "Jeff"}
+    :name "Supergirl"
+    :age 27}
    {:id 3
-    :name "Krypto"
-    :age "24"
-    :owner "Clark Kent"}])
+    :name "Dr. Strange"
+    :age "43"}])

 (defonce example-atom (reagent/atom example-data))


Add some better tests for box

Add some better tests for box

--- test/caesium/crypto/box_test.clj
+++ test/caesium/crypto/box_test.clj
@@ -2,7 +2,8 @@
   (:require
    [caesium.crypto.box :as b]
    [caesium.util :as u]
-   [clojure.test :refer :all]
+   [caesium.crypto.scalarmult :as s]
+   [clojure.test :refer [deftest are is testing]]
    [caesium.vectors :as v]))

 (deftest const-tests
@@ -14,21 +15,28 @@
     b/macbytes 16
     b/primitive "curve25519xsalsa20poly1305"))

-(deftest box-keypair-generation
+(deftest keypair-generation-test
   (testing "generates new keypairs"
     (is (let [kp1 (b/generate-keypair)
               kp2 (b/generate-keypair)]
           (and (not (u/array-eq (:public kp1) (:public kp2)))
                (not (u/array-eq (:secret kp1) (:secret kp2)))))))
+  (testing "generate public key from seed"
+    (let [seed (s/int->scalar 1)
+          kp1 (b/generate-keypair seed)
+          kp2 (b/generate-keypair seed)]
+      (is (u/array-eq (:public kp1) (:public kp2)))
+      (is (u/array-eq (:secret kp1) (:secret kp2)))))
   (testing "generate public key from secret key"
-    (is (let [kp1 (b/generate-keypair)
-              kp2 (b/generate-keypair (:secret kp1))]
-          (u/array-eq (:public kp1) (:public kp2))))))
+    (let [kp1 (b/generate-keypair)
+          kp2 (b/sk->keypair (:secret kp1))]
+      (is (u/array-eq (:public kp1) (:public kp2)))
+      (is (u/array-eq (:secret kp1) (:secret kp2))))))

 (def box-vector
   (comp v/hex-resource (partial str "vectors/box/")))

-(deftest box-encrypt-decrypt-test
+(deftest encrypt-decrypt-test
   (let [nonce (box-vector "nonce")
         ptext (box-vector "plaintext")
         ctext (box-vector "ciphertext")


Rename local and move optimization check to inputs call

--- src/adzerk/boot_cljs/impl.clj
+++ src/adzerk/boot_cljs/impl.clj
@@ -61,7 +61,7 @@
   ;; or there are stale namespace problems with tests. However, if compiling
   ;; with optimizations other than :none adding directories will break the
   ;; build and defeat tree shaking and :main option.
-  (let [directories (when (#{nil :none} optimizations) (:directories pod/env))
+  (let [dirs (:directories pod/env)
         messages (atom {:exception nil
                         :warnings []})
         handler (fn [warning-type env extra]
@@ -73,11 +73,11 @@
                                                              :type warning-type}))))]
     (try
       (build
-        (apply inputs input-path directories)
+        (apply inputs input-path (if (#{nil :none} optimizations) dirs))
         (assoc opts :warning-handlers [default-warning-handler handler])
         stored-env)
       (catch Exception e
-        (handle-ex e directories messages)))
+        (handle-ex e dirs messages)))
     {:messages  @messages
      :dep-order (dep-order stored-env opts)}))


Color cycles should figure max head distance.

Previously the max calculation was being done only at the level of the
fixture itself, while frame-level calculations were being done at the
head level.

--- src/afterglow/effects/fun.clj
+++ src/afterglow/effects/fun.clj
@@ -454,7 +454,7 @@
                             transition-phase-function transition-during-down-beat
                             effect-name "Phrase Color Cycle"}}]
   {:pre [(some? *show*)]}
-  (let [max-distance (transform/max-distance measure fixtures)
+  (let [max-distance (transform/max-distance measure (channels/find-rgb-heads fixtures))
         previous-color (atom nil)
         current-index (atom nil)
         current-color (atom nil)


[hotfix][tests] Reformat default flink configuration map

--- flink-jepsen/src/jepsen/flink/db.clj
+++ flink-jepsen/src/jepsen/flink/db.clj
@@ -38,21 +38,21 @@

 (defn- default-flink-configuration
   [test node]
-  {:high-availability                     "zookeeper"
-   :high-availability.zookeeper.quorum    (zookeeper-quorum test)
-   :high-availability.storageDir          "hdfs:///flink/ha"
-   :jobmanager.memory.process.size        "2048m"
-   :jobmanager.rpc.address                node
-   :state.savepoints.dir                  "hdfs:///flink/savepoints"
-   :rest.address                          node
-   :rest.port                             8081
-   :rest.bind-address                     "0.0.0.0"
-   :taskmanager.numberOfTaskSlots         taskmanager-slots
-   :yarn.application-attempts             99999
-   :slotmanager.taskmanager-timeout       10000
-   :state.backend.local-recovery          "true"
-   :taskmanager.memory.process.size "2048m"
-   :taskmanager.registration.timeout      "30 s"})
+  {:high-availability                  "zookeeper"
+   :high-availability.zookeeper.quorum (zookeeper-quorum test)
+   :high-availability.storageDir       "hdfs:///flink/ha"
+   :jobmanager.memory.process.size     "2048m"
+   :jobmanager.rpc.address             node
+   :state.savepoints.dir               "hdfs:///flink/savepoints"
+   :rest.address                       node
+   :rest.port                          8081
+   :rest.bind-address                  "0.0.0.0"
+   :taskmanager.numberOfTaskSlots      taskmanager-slots
+   :yarn.application-attempts          99999
+   :slotmanager.taskmanager-timeout    10000
+   :state.backend.local-recovery       "true"
+   :taskmanager.memory.process.size    "2048m"
+   :taskmanager.registration.timeout   "30 s"})

 (defn flink-configuration
   [test node]


Add an HTTP server keep-alive test ensuring that messages sent from a completed exchange don't get written to the socket.

--- test/picard/test/http/server.clj
+++ test/picard/test/http/server.clj
@@ -369,6 +369,44 @@

     (is (no-msgs ch1))))

+(defcoretest sending-message-from-completed-exchange-on-keepalive-connection
+  [ch1]
+  (start
+   (let [latch (atom true)]
+     (fn [dn]
+       (fn [evt val]
+         (when (= :request evt)
+           (if @latch
+             (do
+               (dn :response [200 {"content-length" "5"} "Hello"])
+               (future
+                 (Thread/sleep 50)
+                 (try
+                   (dn :response [200 {"content-length" "5"} "FAIL!"])
+                   (catch Exception e
+                     (enqueue ch1 [:error e]))))
+               (reset! latch false))
+             (future
+               (Thread/sleep 100)
+               (dn :response [200 {"content-length" "5"} "World"]))))))))
+
+  (with-socket
+    (write-socket "GET / HTTP/1.1\r\n\r\n")
+
+    (is (receiving
+         "HTTP/1.1 200 OK\r\n"
+         "content-length: 5\r\n\r\n"
+         "Hello"))
+
+    (write-socket "GET / HTTP/1.1\r\n\r\n")
+
+    (is (receiving
+         "HTTP/1.1 200 OK\r\n"
+         "content-length: 5\r\n\r\n"
+         "World"))
+
+    (is (next-msgs ch1 :error #(instance? Exception %)))))
+
 (defcoretest keepalive-head-requests
   [ch1 ch2]
   (start


+subcat '()

+subcat '()

--- src/babel/francais/writer.clj
+++ src/babel/francais/writer.clj
@@ -50,7 +50,8 @@
            (fn [verb]
              (log/debug (str "verb: " (strip-refs verb)))
              (let [root-form (get-in verb [:français :français])
-                   spec {:root {:français {:français root-form}}}]
+                   spec {:root {:français {:français root-form}}
+                         :synsem {:subcat '()}}]
                (log/info (str "generating with verb: '" root-form "'"))
                (writer/generate-from-spec
                 (medium) (strip-refs spec)


fix bug

fix bug

--- src/bench_assoc_unrolling.clj
+++ src/bench_assoc_unrolling.clj
@@ -49,7 +49,7 @@

 (def persistent-hash-map
   (into {}
-        (map vec (range 20) (range 20))))
+        (map vector (range 20) (range 20))))

 (defn bench-single-assoc-persistent-hash-map
   (bench


Store status message

Store status message

--- frontend/src/cruncher/utils/lib.cljs
+++ frontend/src/cruncher/utils/lib.cljs
@@ -11,7 +11,9 @@
             :error   {:message nil}
             :info    {:message nil}
             :app     {:loading? false
-                      :progress {}}}))
+                      :progress {:to-delete 100
+                                 :deleted   0
+                                 :status    "ok"}}}))

 (declare get-pokemon-by-id)

@@ -74,7 +76,8 @@
 (defmethod mutate 'status/progress
   [{:keys [state]} _ {:keys [status]}]
   {:action (fn [] (swap! state update-in [:app :progress]
-                         (fn [] {:to-delete (:to_delete status)
+                         (fn [] {:status    (:status status)
+                                 :to-delete (:to_delete status)
                                  :deleted   (:deleted status)})))})

 (defonce reconciler


changed sparkles to call!

changed sparkles to call!

--- src/caesium/crypto/pwhash.clj
+++ src/caesium/crypto/pwhash.clj
@@ -83,7 +83,7 @@

 (defn pwhash-to-buf!
   [buf msg salt opslimit memlimit alg]
-  (b/✨ pwhash buf msg salt opslimit memlimit alg)
+  (b/call! pwhash buf msg salt opslimit memlimit alg)
   buf)

 (defn pwhash
@@ -99,7 +99,7 @@

 (defn pwhash-str-to-buf!
   [buf msg opslimit memlimit]
-  (b/✨ pwhash-str buf msg opslimit memlimit)
+  (b/call! pwhash-str buf msg opslimit memlimit)
   buf)

 (defn pwhash-str
@@ -114,7 +114,7 @@

 (defn pwhash-str-alg-to-buf!
   [buf msg opslimit memlimit alg]
-  (b/✨ pwhash-str-alg buf msg opslimit memlimit alg)
+  (b/call! pwhash-str-alg buf msg opslimit memlimit alg)
   buf)

 (defn pwhash-str-alg
@@ -130,21 +130,21 @@
   [hashpass passwd]
   (let [buf (bb/->indirect-byte-buf hashpass)
         msg (bb/->indirect-byte-buf passwd)]
-    (b/✨ pwhash-str-verify buf msg)))
+    (b/call! pwhash-str-verify buf msg)))

 (defn str-needs-rehash
   [hashpass opslimit memlimit]
   (let [buf (bb/->indirect-byte-buf hashpass)]
-    (b/✨  str-needs-rehash buf opslimit memlimit)))
+    (b/call! str-needs-rehash buf opslimit memlimit)))

 (defn pwhash-argon2i-to-buf!
   [buf msg salt opslimit memlimit alg]
-  (b/✨ pwhash-argon2i buf msg salt opslimit memlimit alg)
+  (b/call! pwhash-argon2i buf msg salt opslimit memlimit alg)
   buf)

 (defn argon2i-str-to-buf!
   [buf msg opslimit memlimit]
-  (b/✨ pwhash-argon2i-str buf msg opslimit memlimit)
+  (b/call! pwhash-argon2i-str buf msg opslimit memlimit)
   buf)

 (defn argon2i
@@ -171,16 +171,16 @@
   [hashpass passwd]
   (let [buf (bb/->indirect-byte-buf hashpass)
         msg (bb/->indirect-byte-buf passwd)]
-    (b/✨ argon2i-str-verify buf msg)))
+    (b/call! argon2i-str-verify buf msg)))

 (defn argon2i-str-needs-rehash
   [hashpass opslimit memlimit]
   (let [buf (bb/->indirect-byte-buf hashpass)]
-    (b/✨  argon2i-str-needs-rehash buf opslimit memlimit)))
+    (b/call! argon2i-str-needs-rehash buf opslimit memlimit)))

 (defn argon2id-to-buf!
   [buf msg salt opslimit memlimit alg]
-  (b/✨ pwhash-argon2id buf msg salt opslimit memlimit alg)
+  (b/call! pwhash-argon2id buf msg salt opslimit memlimit alg)
   buf)

 (defn argon2id
@@ -196,7 +196,7 @@

 (defn argon2id-str-to-buf!
   [buf msg opslimit memlimit]
-  (b/✨ pwhash-argon2id-str buf msg opslimit memlimit)
+  (b/call! pwhash-argon2id-str buf msg opslimit memlimit)
   buf)

 (defn argon2id-str
@@ -212,16 +212,16 @@
   [hashpass passwd]
   (let [buf (bb/->indirect-byte-buf hashpass)
         msg (bb/->indirect-byte-buf passwd)]
-    (b/✨ argon2id-str-verify buf msg)))
+    (b/call! argon2id-str-verify buf msg)))

 (defn argon2id-str-needs-rehash
   [hashpass opslimit memlimit]
   (let [buf (bb/->indirect-byte-buf hashpass)]
-    (b/✨  argon2id-str-needs-rehash buf opslimit memlimit)))
+    (b/call! argon2id-str-needs-rehash buf opslimit memlimit)))

 (defn scryptsalsa208sha256-to-buf!
   [buf msg salt opslimit memlimit]
-  (b/✨ pwhash-scryptsalsa208sha256 buf msg salt opslimit memlimit)
+  (b/call! pwhash-scryptsalsa208sha256 buf msg salt opslimit memlimit)
   buf)

 (defn scryptsalsa208sha256
@@ -237,7 +237,7 @@

 (defn scryptsalsa208sha256-str-to-buf!
   [buf msg opslimit memlimit]
-  (b/✨ pwhash-scryptsalsa208sha256-str buf msg opslimit memlimit)
+  (b/call! pwhash-scryptsalsa208sha256-str buf msg opslimit memlimit)
   buf)

 (defn scryptsalsa208sha256-str
@@ -253,9 +253,9 @@
   [hashpass passwd]
   (let [buf (bb/->indirect-byte-buf hashpass)
         msg (bb/->indirect-byte-buf passwd)]
-    (b/✨ scryptsalsa208sha256-str-verify buf msg)))
+    (b/call! scryptsalsa208sha256-str-verify buf msg)))

 (defn scryptsalsa208sha256-str-needs-rehash
   [hashpass opslimit memlimit]
   (let [buf (bb/->indirect-byte-buf hashpass)]
-    (b/✨  scryptsalsa208sha256-str-needs-rehash buf opslimit memlimit)))
+    (b/call!  scryptsalsa208sha256-str-needs-rehash buf opslimit memlimit)))


returning user name field in request oauth2 context

--- src/cerber/oauth2/context.clj
+++ src/cerber/oauth2/context.clj
@@ -89,6 +89,7 @@
                                     :scopes scopes}
                           ::user   {:id (:user-id token)
                                     :login login
+                                    :name (:name user)
                                     :roles (:roles user)}))))

 (defn user-valid? [req]
@@ -112,7 +113,7 @@
 (defn user-authenticated? [req]
   (let [user (user/find-user (-> req :session :login))]
     (or (and (:enabled? user)
-             (assoc req ::user (select-keys user [:id :login :roles :enabled?])))
+             (assoc req ::user (select-keys user [:id :login :name :roles :enabled?])))
         error/unauthorized)))

 (defn user-password-valid? [req ^cerber.oauth2.authenticator.Authenticator authenticator]


Make SIGHUP restart the system and SIGTERM stop it

SIGINT still works to stop the system. The code is now much cleaner
and uses a var in the core namespace to store the system state, so
that it remains globally accessible.

--- clstreams/src/clstreams/core.clj
+++ clstreams/src/clstreams/core.clj
@@ -6,26 +6,39 @@
             [clstreams.pipelines]))

 (defn run-system
-  [system]
-  (let [system-state (atom system)
-        stop? (promise)]
+  [system-state-var]
+  (let [next-step (promise)
+        orig-handlers
+        (->
+         {}
+         (into (for [sgn [:term :int]]
+                 [sgn
+                  (signal/with-handler sgn
+                    (log/debugf "Received SIG%s" (-> sgn name .toUpperCase))
+                    (deliver next-step :end))]))
+         (into (for [sgn [:hup]]
+                 [sgn
+                  (signal/with-handler sgn
+                    (log/debugf "Received SIG%s" (-> sgn name .toUpperCase))
+                    (deliver next-step :restart))])))]

-    (signal/with-handler :int
-      (log/info "Received SIGINT")
-      (deliver stop? true))
+    (log/info "Starting topology")
+    (alter-var-root system-state-var component/start)

-    (swap! system-state component/start)
-    (log/info "Topology initialized successfully")
+    (let [ns @next-step]

-    @stop?
+      (doseq [[sgn orig-handler] orig-handlers]
+        (sun.misc.Signal/handle (signal/->signal :int) orig-handler))

-    (log/info "Stopping topology")
-    (swap! system-state component/stop)
-    (log/info "Topology stopped")
-    (System/exit 0)))
+      (log/info "Stopping topology")
+      (alter-var-root system-state-var component/stop)
+
+      (case ns
+        :end (System/exit 0)
+        :restart (recur system-state-var)))))

 (defn -main
   [func-name]
-  (let [system (eval (symbol func-name))]
-    (run-system system)))
+  (def system-state (eval (symbol func-name)))
+  (run-system #'system-state))


divide safely

divide safely

--- src/clj/clj_money/trading.clj
+++ src/clj/clj_money/trading.clj
@@ -192,7 +192,7 @@
               :items items
               :lot-items [{:lot-id (:id lot)
                            :lot-action :buy
-                           :price (/ value shares)
+                           :price (with-precision 4 (/ value shares))
                            :shares shares}]}))))

 (defn- create-capital-gains-items
@@ -567,7 +567,7 @@
   (let [updated (-> lot
                     (update-in [:shares-purchased] #(* % ratio))
                     (update-in [:shares-owned] #(* % ratio))
-                    (update-in [:purchase-price] #(/ % ratio)))]
+                    (update-in [:purchase-price] #(with-precision 4 (/ % ratio))))]
     (lots/update storage updated)))

 (defn- apply-split-to-item
@@ -588,8 +588,9 @@
     (let [shares-owned (->> lots
                             (map :shares-owned)
                             (reduce + 0M))]
-      (assoc context :ratio (/ (+ shares-owned shares-gained)
-                               shares-owned)))))
+      (assoc context :ratio (with-precision 4
+                              (/ (+ shares-owned shares-gained)
+                                 shares-owned))))))

 (defn- process-split-lots
   [{:keys [storage lots ratio] :as context}]


spec.test bugfixes: - test should only re-instrument what it unstrumented - docstring fixes - give all check-1 results same shape

Signed-off-by: Rich Hickey <2f3b32171da334ad5d7d0db393d0928eef4308ab@gmail.com>

--- src/clj/clojure/spec/test.clj
+++ src/clj/clojure/spec/test.clj
@@ -179,11 +179,11 @@
   [s]
   (when-let [v (resolve s)]
     (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)]
+      (swap! instrumented-vars dissoc v)
       (let [current @v]
         (when (= wrapped current)
-          (alter-var-root v (constantly raw))))
-      (swap! instrumented-vars dissoc v))
-    (->sym v)))
+          (alter-var-root v (constantly raw))
+          (->sym v))))))

 (defn- opt-syms
   "Returns set of symbols referenced by 'instrument' opts map"
@@ -282,7 +282,7 @@

 (defn- check-call
   "Returns true if call passes specs, otherwise *returns* an exception
-with explain-data under ::check-call."
+with explain-data + ::s/failure."
   [f specs args]
   (let [cargs (when (:args specs) (s/conform (:args specs) args))]
     (if (= cargs ::s/invalid)
@@ -306,10 +306,6 @@
       (let [prop (gen/for-all* [g] #(check-call f specs %))]
         (apply gen/quick-check num-tests prop (mapcat identity opts))))))

-(defn- failure-type
-  [x]
-  (::s/failure (ex-data x)))
-
 (defn- make-check-result
   "Builds spec result map."
   [check-sym spec test-check-ret]
@@ -318,27 +314,29 @@
          (when check-sym
            {:sym check-sym})
          (when-let [result (-> test-check-ret :result)]
-           {:result result})
+           (when-not (true? result) {:failure result}))
          (when-let [shrunk (-> test-check-ret :shrunk)]
-           {:result (:result shrunk)})))
+           {:failure (:result shrunk)})))

 (defn- check-1
-  [{:keys [s f v spec]} {:keys [result-callback] :as opts}]
-  (when v (unstrument s))
-  (try
-   (let [f (or f (when v @v))]
+  [{:keys [s f v spec] :as foo} {:keys [result-callback] :as opts}]
+  (let [f (or v (when v @v))
+        re-inst? (and v (seq (unstrument s)) true)]
+    (try
      (cond
       (nil? f)
-      {::s/failure :no-fn :sym s :spec spec}
+      {:failure (ex-info "No fn to spec" {::s/failure :no-fn})
+       :sym s :spec spec}

       (:args spec)
       (let [tcret (quick-check f spec opts)]
         (make-check-result s spec tcret))

       :default
-      {::s/failure :no-args-spec :sym s :spec spec}))
-   (finally
-    (when v (instrument s)))))
+      {:failure (ex-info "No :args spec" {::s/failure :no-args-spec})
+       :sym s :spec spec})
+     (finally
+      (when re-inst? (instrument s))))))

 (defn- sym->check-map
   [s]
@@ -359,10 +357,10 @@
      (validate-check-opts opts)
      (check-1 {:f f :spec spec} opts)))

-(defn testable-syms
+(defn checkable-syms
   "Given an opts map as per check, returns the set of syms that
 can be tested."
-  ([] (testable-syms nil))
+  ([] (checkable-syms nil))
   ([opts]
      (validate-check-opts opts)
      (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
@@ -371,7 +369,7 @@
 (defn check
   "Run generative tests for spec conformance on vars named by
 sym-or-syms, a symbol or collection of symbols. If sym-or-syms
-is not specified, check all testable vars.
+is not specified, check all checkable vars.

 The opts map includes the following optional keys, where stc
 aliases clojure.spec.test.check:
@@ -387,37 +385,33 @@
 keys

 :spec       the spec tested
-:type       the type of the check result
 :sym        optional symbol naming the var tested
-:result     optional check result
+:failure    optional test failure
 ::stc/ret   optional value returned by test.check/quick-check

-Values for the :result key can be one of
-
-true        passing check
-exception   code under check threw
-map         with explain-data under :clojure.spec/problems
-
-Values for the :type key can be one of
-
-:check-passed   all checked fn returns conformed
+The value for :failure can be any exception. Exceptions thrown by
+spec itself will have an ::s/failure value in ex-data:
+
 :check-failed   at least one checked return did not conform
-:check-threw    checked fn threw an exception
 :no-args-spec   no :args spec provided
 :no-fn          no fn provided
 :no-fspec       no fspec provided
 :no-gen         unable to generate :args
 :instrument     invalid args detected by instrument
 "
-  ([] (check (testable-syms)))
+  ([] (check (checkable-syms)))
   ([sym-or-syms] (check sym-or-syms nil))
   ([sym-or-syms opts]
      (->> (collectionize sym-or-syms)
-          (filter (testable-syms opts))
+          (filter (checkable-syms opts))
           (pmap
            #(check-1 (sym->check-map %) opts)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting  ;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- failure-type
+  [x]
+  (::s/failure (ex-data x)))

 (defn- unwrap-failure
   [x]
@@ -426,22 +420,27 @@
     x))

 (defn- result-type
+  "Returns the type of the check result. This can be any of the
+::s/failure keywords documented in 'check', or:
+
+  :check-passed   all checked fn returns conformed
+  :check-threw    checked fn threw an exception"
   [ret]
-  (let [result (:result ret)]
+  (let [failure (:failure ret)]
     (cond
-     (true? result) :check-passed
-     (failure-type result) (failure-type result)
+     (nil? failure) :check-passed
+     (failure-type failure) (failure-type failure)
      :default :check-threw)))

 (defn abbrev-result
   "Given a check result, returns an abbreviated version
 suitable for summary use."
   [x]
-  (if (true? (:result x))
-    (dissoc x :spec ::stc/ret :result)
+  (if (:failure x)
     (-> (dissoc x ::stc/ret)
         (update :spec s/describe)
-        (update :result unwrap-failure))))
+        (update :failure unwrap-failure))
+    (dissoc x :spec ::stc/ret)))

 (defn summarize-results
   "Given a collection of check-results, e.g. from 'check', pretty


update Genetics Pavilion tests

update Genetics Pavilion tests

--- src/clj/test/cards-assets.clj
+++ src/clj/test/cards-assets.clj
@@ -231,9 +231,10 @@
     (is (= 1 (:agenda-point (get-corp))) "Corp has 1 point")))

 (deftest genetics-pavilion
+  "Genetics Pavilion - Limit Runner to 2 draws per turn, but only during Runner's turn"
   (do-game
     (new-game (default-corp [(qty "Genetics Pavilion" 1)])
-              (default-runner [(qty "Diesel" 2) (qty "Sure Gamble" 3)]))
+              (default-runner [(qty "Diesel" 1) (qty "Sure Gamble" 3) (qty "Sports Hopper" 1)]))
     (play-from-hand state :corp "Genetics Pavilion" "New remote")
     (let [gp (get-content state :remote1 0)]
       (take-credits state :corp)
@@ -241,21 +242,48 @@
       (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
       (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
       (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
-      (is (= 2 (count (:hand (get-runner)))))
+      (play-from-hand state :runner "Sports Hopper")
       (play-from-hand state :runner "Diesel")
-      (is (= 3 (count (:hand (get-runner)))) "Drew only 2 cards because of Genetics Pavilion")
-      (take-credits state :runner)
-      (core/derez state :corp (refresh gp))
-      (take-credits state :corp)
-      (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
-      (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
-      (core/move state :runner (find-card "Diesel" (:discard (get-runner))) :deck)
+      (is (= 2 (count (:hand (get-runner)))) "Drew only 2 cards because of Genetics Pavilion")
+      (take-credits state :runner)
+      (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+      (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+      (let [hopper (get-in @state [:runner :rig :hardware 0])]
+        (card-ability state :runner hopper 0)
+        (is (= 3 (count (:hand (get-runner)))) "Able to draw 3 cards during Corp's turn")
+        (core/derez state :corp (refresh gp))
+        (take-credits state :corp)
+        (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+        (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+        (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+        (core/move state :runner (find-card "Diesel" (:discard (get-runner))) :hand)
+        (is (= 1 (count (:hand (get-runner)))))
+        (play-from-hand state :runner "Diesel")
+        (is (= 3 (count (:hand (get-runner)))) "Drew 3 cards with Diesel")
+        (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+        (core/rez state :corp (refresh gp))
+        (core/draw state :runner)
+        (is (= 2 (count (:hand (get-runner)))) "No card drawn; GP counts cards drawn prior to rez")))))
+
+(deftest genetics-pavilion-fisk-investment
+  (do-game
+    (new-game (default-corp [(qty "Genetics Pavilion" 1) (qty "Hedge Fund" 3)])
+              (default-runner [(qty "Fisk Investment Seminar" 1) (qty "Sure Gamble" 3)]))
+    (play-from-hand state :corp "Genetics Pavilion" "New remote")
+    (let [gp (get-content state :remote1 0)]
+      (take-credits state :corp)
+      (core/rez state :corp gp)
+      (core/move state :corp (find-card "Hedge Fund" (:hand (get-corp))) :deck)
+      (core/move state :corp (find-card "Hedge Fund" (:hand (get-corp))) :deck)
+      (core/move state :corp (find-card "Hedge Fund" (:hand (get-corp))) :deck)
+      (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+      (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+      (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
       (is (= 1 (count (:hand (get-runner)))))
-      (play-from-hand state :runner "Diesel")
-      (is (= 3 (count (:hand (get-runner)))) "Drew 3 cards with Diesel")
-      (core/rez state :corp (refresh gp))
-      (core/draw state :runner)
-      (is (= 3 (count (:hand (get-runner)))) "No card drawn; GP counts cards drawn prior to rez"))))
+      (is (= 0 (count (:hand (get-corp)))))
+      (play-from-hand state :runner "Fisk Investment Seminar")
+      (is (= 2 (count (:hand (get-runner)))) "Drew only 2 cards because of Genetics Pavilion")
+      (is (= 3 (count (:hand (get-corp)))) "Drew all 3 cards"))))

 (deftest ghost-branch
   "Ghost Branch - Advanceable; give the Runner tags equal to advancements when accessed"


Test for Political Graffiti

Test for Political Graffiti

--- src/clj/test/cards-events.clj
+++ src/clj/test/cards-events.clj
@@ -377,6 +377,35 @@
     (play-from-hand state :runner "Notoriety")
     (is (= 1 (count (:scored (get-runner)))) "Notoriety moved to score area")
     (is (= 1 (:agenda-point (get-runner))) "Notoriety scored for 1 agenda point")))
+
+(deftest political-graffiti
+  "Political Graffiti - swapping with Turntable works / purging viruses restores points"
+  (do-game
+    (new-game (default-corp [(qty "Breaking News" 1) (qty "Chronos Project" 1)])
+              (default-runner [(qty "Turntable" 1) (qty "Political Graffiti" 1)]))
+    (play-from-hand state :corp "Breaking News" "New remote")
+    (score-agenda state :corp (get-content state :remote1 0))
+    (is (= 1 (:agenda-point (get-corp))))
+    (take-credits state :corp)
+    (play-from-hand state :runner "Political Graffiti")
+    (is (= [:archives] (get-in @state [:run :server])) "Run initiated on Archives")
+    (run-successful state)
+    (prompt-choice :runner "Run ability")
+    (prompt-select :runner (find-card "Breaking News" (:scored (get-corp))))
+    (is (= 0 (:agenda-point (get-corp))) "Political Dealings lowered agenda points by 1")
+    (play-from-hand state :runner "Turntable")
+    (run-empty-server state "HQ")
+    (prompt-choice :runner "Steal")
+    (is (= 1 (:agenda-point (get-runner))) "Chronos Project stolen")
+    (let [tt (get-in @state [:runner :rig :hardware 0])]
+      (card-ability state :runner tt 0)
+      (prompt-select :runner (find-card "Breaking News" (:scored (get-corp))))
+      (is (= 1 (:agenda-point (get-corp))))
+      (is (= 0 (:agenda-point (get-runner))))
+      (take-credits state :runner)
+      (core/purge state :corp)
+      (is (= 1 (:agenda-point (get-corp))))
+      (is (= 1 (:agenda-point (get-runner)))))))

 (deftest retrieval-run
   "Retrieval Run - Run Archives successfully and install a program from Heap for free"


Use mmap for FASTA random reading.

Use mmap for FASTA random reading.

--- src/cljam/io/fasta/reader.clj
+++ src/cljam/io/fasta/reader.clj
@@ -5,7 +5,8 @@
             [cljam.io.fasta.util :refer [header-line? parse-header-line]]
             [cljam.io.fasta-index.core :as fasta-index])
   (:import [java.io RandomAccessFile InputStream]
-           [java.nio ByteBuffer]))
+           [java.nio ByteBuffer CharBuffer]
+           [java.nio.channels FileChannel$MapMode]))

 ;; FASTAReader
 ;; -----------
@@ -73,34 +74,35 @@
                      (map? s) (cons s (lazy-seq (read-fn* rdr name))))))]
     (read-fn rdr nil)))

-(defn- read-sequence-with-offset
-  [^FASTAReader rdr offset-start offset-end {:keys [mask?]}]
-  (let [len (- offset-end offset-start)
-        ba (byte-array len)
+(defn read-sequence
+  [^FASTAReader rdr name start end {:keys [mask?]}]
+  (let [fai @(.index-delay rdr)
+        {:keys [len]} (fasta-index/get-header fai name)
+        buf (CharBuffer/allocate (inc (- end start)))
         r ^RandomAccessFile (.reader rdr)]
-    (doto r
-      (.seek offset-start)
-      (.read ba 0 len))
-    (-> (String. ba)
-        (cstr/replace #"\n" "")
-        ((if mask? identity cstr/upper-case)))))
+    (when-let [[s e] (fasta-index/get-span fai name (dec start) end)]
+      (dotimes [_ (- 1 start)]
+        (.put buf \N))
+      (let [mbb (.. r getChannel (map FileChannel$MapMode/READ_ONLY s (- e s)))]
+        (if mask?
+          (while (.hasRemaining mbb)
+            (let [c (unchecked-char (.get mbb))]
+              (when-not (or (= \newline c) (= \return c))
+                (.put buf c))))
+          (while (.hasRemaining mbb)
+            (let [c (unchecked-long (.get mbb))]
+              (when-not (or (= 10 c) (= 13 c))
+                ;; toUpperCase works only for ASCII chars.
+                (.put buf (unchecked-char (bit-and c 0x5f))))))))
+      (dotimes [_ (- end len)]
+        (.put buf \N))
+      (.flip buf)
+      (.toString buf))))

 (defn read-whole-sequence
   [^FASTAReader rdr name opts]
-  (let [fai @(.index-delay rdr)
-        header (fasta-index/get-header fai name)
-        [offset-start offset-end] (fasta-index/get-span fai name 0 (:len header))]
-    (read-sequence-with-offset rdr offset-start offset-end opts)))
-
-(defn read-sequence
-  [^FASTAReader rdr name start end opts]
-  (let [fai @(.index-delay rdr)
-        header (fasta-index/get-header fai name)]
-    (when-let [[offset-start offset-end] (fasta-index/get-span fai name (dec start) end)]
-      (->> (concat (repeat (max 0 (- 1 start)) \N)
-                   (read-sequence-with-offset rdr offset-start offset-end opts)
-                   (repeat (max 0 (- end (:len header))) \N))
-           (apply str)))))
+  (let [{:keys [len]} (fasta-index/get-header @(.index-delay rdr) name)]
+    (read-sequence rdr name 1 len opts)))

 (defn read
   "Reads FASTA sequence data, returning its information as a lazy sequence."


reorder functions to match demo list order

--- src/cljs/geometer/turtle.cljc
+++ src/cljs/geometer/turtle.cljc
@@ -102,6 +102,17 @@
                 (take 48 (cycle [line ry]))
                 (take 48 (cycle [line ry-]))]))

+(defn hexen []
+  (turtle-mesh
+   (map (fn [a turn-out turn len]
+          (concat
+           [(angle a) turn-out (length (/ len 2)) tz (length len) (angle 60)]
+           (take 12 (cycle [turn line]))))
+        [60 120 240 300 0 45 90 -90 -45]
+        (cycle [rx- rx ry- ry])
+        (cycle [ry- ry rx rx-])
+        [6 6 6 6 9 9 9 9])))
+
 (defn branch [level]
   (if (= 0 level)
     [(length 1.5) cylinder]
@@ -112,14 +123,3 @@

 (defn plant []
   (turtle-mesh (branch 2)))
-
-(defn hexen []
-  (turtle-mesh
-   (map (fn [a turn-out turn len]
-          (concat
-           [(angle a) turn-out (length (/ len 2)) tz (length len) (angle 60)]
-           (take 12 (cycle [turn line]))))
-        [60 120 240 300 0 45 90 -90 -45]
-        (cycle [rx- rx ry- ry])
-        (cycle [ry- ry rx rx-])
-        [6 6 6 6 9 9 9 9])))


More wip

More wip

--- src/cljs/my_project/core.cljs
+++ src/cljs/my_project/core.cljs
@@ -7,16 +7,16 @@
                                     load-img!]]

     [cloj.math.misc         :refer [cos-01]]
+    [cloj.math.vec2         :as v2 :refer [v2]]

-    ; [cloj.system            :refer [ISystem
-    ;                                 get-resource-manager
-    ;                                 get-render-engine ]]
+    [cloj.system            :refer [get-resource-manager
+                                    get-render-engine]]

     [game.html              :refer [mk-system]]
-    [game.gane :as game]
+    [game.game              :as game]

-
-    [gaz.tiles              :refer [mk-tile-map mix-it-up]]
+    [gaz.tiles              :refer [mk-tile-map mix-it-up
+                                    render-level]]
     [gaz.appstate           :refer [app-state]]
     [gaz.canvascomp         :refer [build-canvas-component ]]

@@ -32,16 +32,16 @@

 (def rt-gaz
   (-> (get-resource-manager system)
-      (rman/create-render-target! "shit-canvas" 100 100)))
+      (create-render-target! "shit-canvas" 100 100)))

 (def im-gaz
  (-> (get-resource-manager system)
-     (rman/load-img! "shit-tiles")))
+     (load-img! "shit-tiles")))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defonce update-chan (chan))

-(def level-dims (v2/v2 10 10))
+(def level-dims (v2 10 10))

 (def level
   (->