Revert "Added :trust-all? option to run-jetty"

The Jetty 7 API docs are not always accurate about what a function does.
The setTrustAll method only applies when there is no keystore or
truststore, rendering it useless for client certificates.

This reverts commit 00bb43e69c6987488606221880050ce2aa555f9d.

--- ring-jetty-adapter/src/ring/adapter/jetty.clj
+++ ring-jetty-adapter/src/ring/adapter/jetty.clj
@@ -26,7 +26,6 @@
   (let [context (SslContextFactory.)]
     (.setKeyStorePath context (options :keystore))
     (.setKeyStorePassword context (options :key-password))
-    (.setTrustAll context (boolean (options :trust-all?)))
     (when (options :truststore)
       (.setTruststore context (options :truststore)))
     (when (options :trust-password)
@@ -72,9 +71,8 @@
   :truststore   - a truststore to use for SSL connections
   :trust-password - the password to the truststore
   :max-threads  - the maximum number of threads to use (default 250)
-  :client-auth  - SSL client certificate authentication; may be set to :need,
-                  :want or :none (defaults to :none)
-  :trust-all?   - set to true to accept all client certificates"
+  :client-auth  - SSL client certificate authenticate, may be set to :need,
+                  :want or :none (defaults to :none)"
   [handler options]
   (let [^Server s (create-server (dissoc options :configurator))]
     (when-let [configurator (:configurator options)]


second todo txn test

second todo txn test

--- test/block_chain/message_handlers_test.clj
+++ test/block_chain/message_handlers_test.clj
@@ -105,14 +105,15 @@
       (is (= 3 (- (:amount source)
                   (reduce + (map :amount (:outputs utxn)))))))))

-;; TODO
-#_(deftest test-submitting-and-mining-transaction
-  (miner/mine-and-commit-db!)
+(deftest test-submitting-and-mining-transaction
   (let [key-b (wallet/generate-keypair 512)
-        payment (miner/generate-payment wallet/keypair (:address key-b) 25 (q/longest-chain @db/db))]
+        payment (txn/payment wallet/keypair
+                             (:address key-b)
+                             25
+                             @db/db)]
     (is (= payment (s/validate Transaction payment)))
-    (is (= 25 (bc/balance-db (:address wallet/keypair)
-                             @db/db)))
+    (is (= 25 (q/balance (:address wallet/keypair)
+                         @db/db)))
     (is (= 1 (count (:outputs payment))))
     (is (= {:message "transaction-accepted"
             :payload payment}
@@ -122,9 +123,9 @@
     (is (= 1 (count (q/transaction-pool @db/db))))
     (miner/mine-and-commit-db!)
     (is (empty? (q/transaction-pool @db/db)))
-    (is (= 25 (bc/balance-db (:address wallet/keypair)
+    (is (= 25 (q/balance (:address wallet/keypair)
                              @db/db)))
-    (is (= 25 (bc/balance-db (:address key-b) @db/db)))))
+    (is (= 25 (q/balance (:address key-b) @db/db)))))

 (deftest test-submitting-transaction-with-txn-fee
   (let [key-b (wallet/generate-keypair 512)]


wip: timed channel waits

wip: timed channel waits

--- src/otto/control.clj
+++ src/otto/control.clj
@@ -1,10 +1,11 @@
 (ns otto.control
-  (:require [clojure.core.async :as async :refer [go <! timeout]]))
+  (:require [clojure.core.async :as async :refer [<! alts!! chan go timeout]]))

 (defn update-repositories
   [orgs user _repos]
-  (doseq [o orgs]
-    (println (format "Updating repositories for %s using user %s" o user))))
+  (let [r (chan)
+        t (timeout 1000)]
+    (println (alts!! [r t]))))

 (defn periodically-update
   [orgs user interval repos]


:paredit-backward-delete functionality

:paredit-backward-delete functionality

--- src/paredit/core.clj
+++ src/paredit/core.clj
@@ -343,13 +343,14 @@
                  "(|{foo bar})" "({|foo bar})"
                  #_"(|#{foo bar})" #_"(#{|foo bar})"
                  }]
-      #_["BackDel" :paredit-backward-delete
+      ["BackDel" :paredit-backward-delete
                 {"(\"zot\" q|uux)" "(\"zot\" |uux)",
                 "(\"zot\"| quux)" "(\"zot|\" quux)",
                  "(\"zot|\" quux)" "(\"zo|\" quux)",
                  "(foo (|) bar)" "(foo | bar)",
-                 "(foo (, | ) bar)" "(foo | bar)",
-                 "(foo bar)|" "(foo bar|)"}]
+                 "(foo bar)|" "(foo bar|)",
+                 "(foo bar|)" "(foo ba|)"
+                 }]
     ]
   ])

@@ -556,6 +557,31 @@
             (delete t offset 1)))
       (delete t offset 1))))

+
+(defmethod paredit
+  :paredit-backward-delete
+  [cmd {:keys [text offset length] :as t}]
+  (let [offset (dec offset)
+        parsed (parse text (.length text))
+        parse-ok (not= :ko (:parser-state parsed))]
+    (if parse-ok
+      (let [offset-loc (-> parsed parsed-root-loc (loc-for-offset offset))
+            offset-node (-> offset-loc zip/node)
+            handled-forms (conj *open-brackets* \")
+            in-handled-form (handled-forms (:tag offset-node))]
+        (cond
+          (and in-handled-form (= offset (:offset offset-node)))
+            (if (> (-> offset-node :content count) 2)
+              t     ; don't move
+              (-> t ; delete the form
+                (delete (:offset offset-node) (- (:end-offset offset-node) (:offset offset-node)))
+                (shift-offset -1)))
+          (and in-handled-form (= offset (dec (:end-offset offset-node))))
+            (shift-offset t -1)
+          :else
+            (-> t (delete offset 1) (shift-offset -1))))
+      (-> t (delete offset 1) (shift-offset -1)))))
+
 (defn test-command [title-prefix command]
   (testing (str title-prefix " " (second command) " (\"" (first command) "\")")
     (doseq [[input expected] (get command 2)]


First sketch of adding rhythm to the music

--- src/pianola/core.clj
+++ src/pianola/core.clj
@@ -35,10 +35,10 @@

 (def run-automaton (partial next-gen automaton))

-(defn scale-rhythm [gen]
-  (map #(if (= 0 %)
+(defn scale-rhythm [note]
+  (if (= 0 note)
           0
-          (/ 1 %)) gen))
+          (/ 1 note)))

 (next-gen notes)

@@ -51,11 +51,14 @@
 (take 5 (iterate run-automaton notes))

 (def melody
-  (phrase rhythm
+  (phrase (scale-rhythm rhythm)
           notes))

+(take 5 (iterate run-automaton rhythm))
+(map scale-rhythm (flatten (take 5 (iterate run-automaton rhythm))))
+
 (def melodic-automaton
-  (phrase (flatten (iterate automate-rhythm rhythm))
+  (phrase (map scale-rhythm (flatten (iterate run-automaton rhythm)))
           (flatten (iterate run-automaton notes))))

 (play-tune melody)


Don't always assume websockets are available [IMMUTANT-600]

We blindly assumed the javax.websocket.server.ServerContainer was always
available, but it will only be available in EAP6 if websockets have been
configured in standalone.xml *and* in a jboss-web.xml in the WAR.

We can't know if a user's code will use websockets, so we have to try to
set up the endpoint for every servlet deployed. That means that users
that had no interest in websockets (and hadn't configured them) would
still be unable to run any ring handlers.

This changes the servlet init code to confirm the ServerContainer is
available, logging if it isn't found instead of throwing an NPE.

--- web/src/immutant/web/internal/servlet.clj
+++ web/src/immutant/web/internal/servlet.clj
@@ -15,7 +15,8 @@
 (ns ^{:no-doc true} immutant.web.internal.servlet
     (:require [immutant.web.internal.ring    :as ring]
               [immutant.web.internal.headers :as hdr]
-              [immutant.internal.util        :refer [try-resolve]]
+              [immutant.internal.util        :refer [try-resolve warn]]
+              [immutant.util                 :refer [in-eap?]]
               [immutant.web.async            :as async])

     (:import [org.projectodd.wunderboss.web.async Channel
@@ -118,14 +119,15 @@

 (defn add-endpoint-with-handler
   [^Servlet servlet ^ServletConfig config handler]
-    (let [servlet-context (.getServletContext config)
-          mapping (-> servlet-context
-                    (.getServletRegistration (-> servlet .getServletConfig .getServletName))
-                    .getMappings
-                    first)
-          path (apply str (take (- (count mapping) 2) mapping))
-          path (if (empty? path) "/" path)]
-      (.addEndpoint (server-container servlet-context)
+  (let [servlet-context (.getServletContext config)
+        mapping (-> servlet-context
+                  (.getServletRegistration (-> servlet .getServletConfig .getServletName))
+                  .getMappings
+                  first)
+        path (apply str (take (- (count mapping) 2) mapping))
+        path (if (empty? path) "/" path)]
+    (if-let [container (server-container servlet-context)]
+      (.addEndpoint container
         (.. ServerEndpointConfig$Builder
           (create DelegatingJavaxEndpoint path)
           (configurator (proxy [ServerEndpointConfig$Configurator] []
@@ -140,7 +142,10 @@
                               (when (instance? WebsocketChannel body)
                                 (DelegatingJavaxEndpoint/setCurrentDelegate
                                   (.endpoint ^WebsocketChannel body)))))))
-          build))))
+          build))
+      (if (in-eap?)
+        (warn "Websockets unavailable; see the Immutant EAP guide for details.")
+        (warn "Websockets unavailable; please check your configuration.")))))

 (defn add-endpoint
   "Adds a javax.websocket.Endpoint for the given `servlet` and `servlet-config`.


Documentation tuning

Documentation tuning

--- src/backloggery/core.clj
+++ src/backloggery/core.clj
@@ -9,9 +9,9 @@
 ; &unplayed= &alpha= &region= &console= &status= &rating= &aj_id=0 &id=1 comments= HTTP/1.1

 (register-flags ["--help"
-                 "Show detailed help. Try 'backloggery --help (formats|usage)"]
+                 "Show detailed help. Try 'bltool --help (formats|usage)'"]
                 ["--[no-]filter"
-                 "When adding, filter out games already on Backloggery. Requires loading the game list from Backloggery."
+                 "Filter out games already on Backloggery. Requires loading the game list from Backloggery."
                  :default false]
                 ["--input"
                  "For file-based formats, read input from this file. '-' means stdin."
@@ -33,7 +33,8 @@
     ------       --  ----
     backloggery  RW  Backloggery game library. When writing, equivalent to bl-add.
     bl-add        W  Add new games to Backloggery.
-    bl-edit       W  Edit existing games, overwriting current platform/completion/title information.
+    bl-edit      RW  Edit existing games, overwriting current information.
+                     In read mode, gets all game info, not just basic info (slow!)
     bl-delete     W  Delete all listed games; all properties except ID are ignored.
     steam        R   Game list from Steam Community
     html          W  HTML file that can submit changes to Backloggery


CMR-5695: Changes to allow SNS/SQS to be tested in a REPL pointing an AWS environment. Allow SQS to recover after a connection has been shut down.

--- message-queue-lib/src/cmr/message_queue/queue/sqs.clj
+++ message-queue-lib/src/cmr/message_queue/queue/sqs.clj
@@ -167,6 +167,66 @@
                      (into {}))]
    (get q-attrs queue-arn-attribute)))

+
+(defn set-aws-client-attr!
+  "Conditionally configure the AWS client instance with by calling the given
+  method with the given args."
+  [client-obj method args]
+  (when-not (nil? (first args))
+    (debug "\tConfig:" method "=" args)
+    (Reflector/invokeInstanceMethod
+     client-obj (name method) (object-array args))))
+
+(defn configure-aws-client
+  "Configure an AWS service client with values passed pair-wise to the methods
+  they are passed with. This function allows for the configuration of an AWS
+  service object after instantiation by passing it first an AWS service client
+  instance, and then a series of keywords and configuration values, where the
+  keywords are spelled the same as the client object's given setter method
+  and the configuration values are the results of having called a configuration
+  function that will pull a value from the environment or the default, in the
+  event of an undefined environment value.
+
+  Example usage:
+  ```
+  (configure-aws-client
+    (new AmazonSQSClient)
+    :setEndpoint (sqs-endpoint)
+    :setRegion (sqs-region)
+    :setTimeOffset (sqs-time-offset)))
+  ```
+
+  With the understanding, of course, that the configuration functions in the
+  example all have been created.
+
+  Note that since AWS service clients will set service defaults on their own,
+  it is best to define the default configuration value as nil, so as to avoid
+  unexpected client behaviour."
+  [client-obj & args]
+  (debug "Configuring client" client-obj)
+  (doseq [[config-key config-val] (partition 2 args)]
+    (set-aws-client-attr! client-obj config-key [config-val]))
+  client-obj)
+
+(defmulti create-aws-client
+  "Create an AWS service client, conditionally setting any configured values.
+
+  Note that if the configuration calls (e.g., `(sqs-endpoint)`) return `nil`,
+  the configuration operation doesn't actually take place."
+  identity)
+
+(defmethod create-aws-client :sqs
+  [^Keyword type]
+  (configure-aws-client
+    (new AmazonSQSClient)
+    :setEndpoint (sqs-endpoint)))
+
+(defmethod create-aws-client :sns
+  [^Keyword type]
+  (configure-aws-client
+    (new AmazonSNSClient)
+    :setEndpoint (sns-endpoint)))
+
 (defn- create-async-handler
   "Creates a thread that will asynchronously pull messages off the queue, pass them to the handler,
   and process the response. Throwables raised while reading the queue are caught to avoid exiting
@@ -183,15 +243,15 @@
                       ;; Tell SQS how long to wait before returning with no data (long polling).
                       (.setWaitTimeSeconds (Integer. (queue-polling-timeout))))]
     (a/thread
-      (loop []
+      (loop [sqs-client-atom (atom sqs-client)]
         (try
-          (let [rec-result (.receiveMessage sqs-client rec-req)]
+          (let [rec-result (.receiveMessage @sqs-client-atom rec-req)]
             (when-let [msg (first (.getMessages rec-result))]
               (let [msg-body (.getBody msg)
                     msg-content (json/decode msg-body true)]
                 (try
                   (handler msg-content)
-                  (.deleteMessage sqs-client queue-url (.getReceiptHandle msg))
+                  (.deleteMessage @sqs-client-atom queue-url (.getReceiptHandle msg))
                   (catch Throwable e
                     (error e "Message processing failed for message" (pr-str msg) "on queue" queue-name))))))
           ;; Catching this so the next catch block won't - this allows us to exit the thread after a test
@@ -203,8 +263,9 @@
           (catch Throwable t
             (error t "Async handler for queue" queue-name "continuing after failed message receive.")
             ;; We want to avoid a tight loop in case the call to getMessages is failing immediately.
-            (Thread/sleep 1000)))
-        (recur)))))
+            (Thread/sleep 1000)
+            (reset! sqs-client-atom (create-aws-client :sqs))))
+        (recur sqs-client-atom)))))

 (defn- create-queue
   "Create a queue and its dead-letter-queue if they don't already exist and connect the two."
@@ -301,65 +362,6 @@
 (def get-queue-url
   "Memoized function that returns the queue url for the given name."
   (memoize -get-queue-url))
-
-(defn set-aws-client-attr!
-  "Conditionally configure the AWS client instance with by calling the given
-  method with the given args."
-  [client-obj method args]
-  (when-not (nil? (first args))
-    (debug "\tConfig:" method "=" args)
-    (Reflector/invokeInstanceMethod
-     client-obj (name method) (object-array args))))
-
-(defn configure-aws-client
-  "Configure an AWS service client with values passed pair-wise to the methods
-  they are passed with. This function allows for the configuration of an AWS
-  service object after instantiation by passing it first an AWS service client
-  instance, and then a series of keywords and configuration values, where the
-  keywords are spelled the same as the client object's given setter method
-  and the configuration values are the results of having called a configuration
-  function that will pull a value from the environment or the default, in the
-  event of an undefined environment value.
-
-  Example usage:
-  ```
-  (configure-aws-client
-    (new AmazonSQSClient)
-    :setEndpoint (sqs-endpoint)
-    :setRegion (sqs-region)
-    :setTimeOffset (sqs-time-offset)))
-  ```
-
-  With the understanding, of course, that the configuration functions in the
-  example all have been created.
-
-  Note that since AWS service clients will set service defaults on their own,
-  it is best to define the default configuration value as nil, so as to avoid
-  unexpected client behaviour."
-  [client-obj & args]
-  (debug "Configuring client" client-obj)
-  (doseq [[config-key config-val] (partition 2 args)]
-    (set-aws-client-attr! client-obj config-key [config-val]))
-  client-obj)
-
-(defmulti create-aws-client
-  "Create an AWS service client, conditionally setting any configured values.
-
-  Note that if the configuration calls (e.g., `(sqs-endpoint)`) return `nil`,
-  the configuration operation doesn't actually take place."
-  identity)
-
-(defmethod create-aws-client :sqs
-  [^Keyword type]
-  (configure-aws-client
-    (new AmazonSQSClient)
-    :setEndpoint (sqs-endpoint)))
-
-(defmethod create-aws-client :sns
-  [^Keyword type]
-  (configure-aws-client
-    (new AmazonSNSClient)
-    :setEndpoint (sns-endpoint)))

 (defrecord SQSQueueBroker
   ;; A record containing fields related to accessing SNS/SQS exchanges and queues.
@@ -501,19 +503,19 @@
   ;; list the topics for the cmr-ingest_exchange exchange/topic
   (get-topic (:sns-client broker) "cmr_ingest_exchange")
   ;; list the queues for the cmr_ingest_exchange
-  (queue/get-queues-bound-to-exchange broker "jn_test_exchangeA5")
+  (queue-protocol/get-queues-bound-to-exchange broker "jn_test_exchangeA5")
   ;; create a test queue
   (create-queue (:sqs-client broker) "jn_test_queue3")
   ;; create a test exchange
   (create-exchange (:sns-client broker) "jn_test_exchange3")
   (create-exchange (:sns-client broker) "jn_test_exchange3b")
   ;; list the queues for the cmr_test_exchange
-  (queue/get-queues-bound-to-exchange broker "jn_test_exchangeA5")
+  (queue-protocol/get-queues-bound-to-exchange broker "jn_test_exchangeA5")
   ;; Bind the queue to the new exchange
   (bind-queue-to-exchanges (:sns-client broker) (:sqs-client broker) ["jn_test_exchangeA5"] "jn_test_queueY5")
   ;; subscribe to test queue with a simple handler that prints received messages
-  (queue/subscribe broker "jn_test_queueY5" (fn [msg] (do (println "MESSAGE!") (swap! msg-cnt-atom inc))))
+  (queue-protocol/subscribe broker "jn_test_queueY5" (fn [msg] (do (println "MESSAGE!") (swap! msg-cnt-atom inc))))
   ;; publish a message to the queue to verify our subscribe worked
-  (queue/publish-to-queue broker "jn_test_queueY5" {:action "concept-update" :dummy "dummy"})
+  (queue-protocol/publish-to-queue broker "jn_test_queueY5" {:action "concept-update" :dummy "dummy"})
   ;; publish a message to the exchange to verify the message is sent to the queue
-  (queue/publish-to-exchange broker "jn_test_exchangeA5" {:action "concept-update" :dummy "dummy"}))
+  (queue-protocol/publish-to-exchange broker "jn_test_exchangeA5" {:action "concept-update" :dummy "dummy"}))


finish ring-logger cleanup

finish ring-logger cleanup

--- src/block_chain/http.clj
+++ src/block_chain/http.clj
@@ -9,7 +9,6 @@
             [block-chain.db :as db]
             [block-chain.queries :as q]
             [schema.core :as s]
-            [ring.logger :as logger]
             [block-chain.schemas :refer :all]
             [clojure.java.io :as io]
             [compojure.core :refer [defroutes GET routes]]
@@ -178,8 +177,7 @@
 (def with-middleware
   (-> (routes web-ui api)
       (identity)
-      ;; (debug-logger)
-      #_(logger/wrap-with-logger)))
+      #_(debug-logger)))

 (defn start!
   ([] (start! 3001))


Adapt connection management to clojure.jdbc internals change of the last version.

--- src/suricatta/core.clj
+++ src/suricatta/core.clj
@@ -45,7 +45,7 @@
   ([dbspec] (context dbspec {}))
   ([dbspec opts]
    (let [^Connection connection (-> (jdbc.core/connection dbspec opts)
-                                    (jdbc.proto/get-connection))
+                                    (jdbc.proto/connection))
          ^SQLDialect dialect (if (:dialect dbspec)
                                (impl/translate-dialect (:dialect dbspec))
                                (JDBCUtils/dialect connection))


[#2309] Use defn instead of macro

[#2309] Use defn instead of macro

--- backend/src/akvo/lumen/util.clj
+++ backend/src/akvo/lumen/util.clj
@@ -86,10 +86,8 @@
    (conform s (adapter d))
    d))

-(defmacro as-middleware
-  "f should be a function of 3 arguments with a signature as (handler request opts)."
-  {:arglist '(f opts)}
+(defn as-middleware
   [f opts]
-  (list 'fn ['handler]
-        (list 'fn ['request]
-              (list f 'handler 'request opts))))
+  (fn [handler]
+    (fn [request]
+      (f handler request opts))))


Show aggregator in search results if available

--- src/discuss/components/search/statements.cljs
+++ src/discuss/components/search/statements.cljs
@@ -136,26 +136,33 @@
 (entrypoint)

 ;; -----------------------------------------------------------------------------
-@(om/app-state parser/reconciler)
+
 (defui Result
   Object
   (render [this]
-          (let [{:keys [text issue author]} (om/props this)]
+          (let [{:keys [text issue author identifier] :as search-result} (om/props this)
+                aggregator (:aggregate-id identifier)]
             (html [:div.bs-callout.bs-callout-info
                    [:div.row
                     [:div.col-sm-8
                      [:p (vlib/safe-html text)]
                      [:p [:span.btn.btn-sm.btn-primary
-                          {:on-click #(println "I want to use this statement:" text)}
+                          {:on-click #(om/transact! parser/reconciler `[(search/selected {:value ~search-result})
+                                                                        (search/results {:value []})])}
                           (t :search :reuse)]]]
                     [:div.col-sm-4
-                     [:div.text-right
-                      [:span.label.label-default
-                       (str (t :common :issue) ": " (:title issue))]
-                      [:br]
+                     [:div.text-rights
+                      (when issue
+                        [:span.label.label-default
+                         (str (t :common :issue) ": " (:title issue))
+                         [:br]])
+                      (when aggregator
+                        [:span.label.label-default
+                         (str (t :search :origin) ": " aggregator)
+                         [:br]])
                       [:span.label.label-default
                        (str (t :search :author) ": " (:nickname author))]]]]]))))
-(def ^:private result (om/factory Result))
+(def result (om/factory Result))

 (defui Results
   static om/IQuery
@@ -163,7 +170,7 @@
   Object
   (render [this]
           (let [{:keys [search/results]} (om/props this)]
-            (html [:div.results
+            (html [:div {:className (lib/prefix-name "search-results")}
                    (take 5
                          (map #(result (merge (lib/unique-react-key-dict) %)) results))]))))
 (def results (om/factory Results))


Adds pre-routes for signup and login to redirect authenticated users.

--- src/cadence/security.clj
+++ src/cadence/security.clj
@@ -2,16 +2,31 @@
   (:require [cemerick.friend :as friend]
             (cemerick.friend [workflows :as workflows]
                              [credentials :as creds])
-            ;[oauth.client :as oauth]
+            [cadence.model.flash :as flash]
+            [noir.response :as resp]
             [cadence.model :as model])
   (:use [noir.core :only [pre-route]]))

 (def friend-settings
-      {:credential-fn (partial creds/bcrypt-credential-fn model/get-user)
-       :workflows [(workflows/interactive-form)]
-       :login-uri "/login"
-       :unauthorized-redirect-uri "/login"
-       :default-landing-uri "/"})
+  {:credential-fn (partial creds/bcrypt-credential-fn model/get-user)
+   :workflows [(workflows/interactive-form)]
+   :login-uri "/login"
+   :unauthorized-redirect-uri "/login"
+   :default-landing-uri "/"})

 (pre-route [:any "/user/*"] {:as req}
-       (friend/authenticated nil))
+           (friend/authenticated nil))
+
+(pre-route [:any "/login"] {:as req}
+           (when-not (friend/anonymous?)
+             (flash/put! :warning
+                         "You must " [:a {:href "/logout"} "logout"]
+                         " before you can log in again.")
+             (resp/redirect "/user/profile")))
+
+(pre-route [:any "/signup"] {:as req}
+           (when-not (friend/anonymous?)
+             (flash/put! :warning
+                         "You need to " [:a {:href "/logout"} "logout"]
+                         " before creating an account.")
+             (resp/redirect "/user/profile")))


fixed channels repetitions

fixed channels repetitions

--- src/tango/channels.clj
+++ src/tango/channels.clj
@@ -21,30 +21,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Component

-;; TODO - start-clients-handler and start-message-handler should be merged
-
-(defn start-clients-handler
-  "Receives messages on a core.async channel used by clients and
-  puts those messages on this components out-channel."
-  [out-channel clients-in-channel]
-  (async/go-loop []
-    (when-let [message (async/<! clients-in-channel)]
-      (log-raw-message message)
-      (when message
-        (try
-          (let [topic (:topic message)
-                payload (:payload message)]
-            (log/trace (str "Client ChannelConnection received: " message))
-            (async/put! out-channel message))
-          (catch Exception e
-            (log/error e "Exception in Client ChannelConnection message go loop")
-            (async/>! out-channel (create-exception-message e))))
-        (recur)))))
-
 (defn start-message-handler
-  "Receives system messages to be sent to clients, any messages on
-  the components in-channel are put on the clients out-channel."
-  [in-channel out-channel clients-out-channel]
+  [name in-channel out-channel error-channel]
   (async/go-loop []
     (when-let [message (async/<! in-channel)]
       (log-raw-message message)
@@ -52,11 +30,11 @@
         (try
           (let [topic (:topic message)
                 payload (:payload message)]
-            (log/trace (str "ChannelConnection received: " message))
-            (async/put! clients-out-channel message))
+            (log/trace (str name " received: " message))
+            (async/put! out-channel message))
           (catch Exception e
-            (log/error e "Exception in ChannelConnection message go loop")
-            (async/>! out-channel (create-exception-message e))))
+            (log/error e (str "Exception in " name " message go loop"))
+            (async/>! error-channel (create-exception-message e))))
         (recur)))))

 (defrecord ChannelConnection [channel-connection-channels in-channel out-channel message-handler]
@@ -67,11 +45,16 @@
       component
       (let [clients-in-channel (async/chan)
             clients-out-channel (async/chan)
-            message-handler (start-message-handler (:in-channel channel-connection-channels)
-                                                   (:out-channel channel-connection-channels)
-                                                   clients-out-channel)
-            clients-handler (start-clients-handler (:out-channel channel-connection-channels)
-                                                   clients-in-channel)]
+            message-handler (start-message-handler
+                             "ChannelConnection"
+                             (:in-channel channel-connection-channels)
+                             clients-out-channel
+                             (:out-channel channel-connection-channels))
+            clients-handler (start-message-handler
+                             "Client ChannelConnection"
+                             (:out-channel channel-connection-channels)
+                             clients-in-channel
+                             clients-in-channel)]
         (assoc component
           :message-handler message-handler
           :in-channel clients-in-channel


backward incompatibility 0.6 - 0.7: variable from module doesnt need output mention

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -429,4 +429,4 @@
                       :endpoint (get s3-endpoints region)}}))

 (defn remote-output-of [module name]
-  (output-of (str "terraform_remote_state." module) "output" name))
+  (output-of "terraform_remote_state" module name))


require clojure.set because repl <-> compilation

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -3,20 +3,21 @@
             [cheshire.core :as json]
             [stencil.core :as mustache]
             [clj-yaml.core :as yaml]
-            [clojure.pprint :refer [pprint]]))
+            [clojure.pprint :refer [pprint]]
+            [clojure.set :as set]))

 (def account-id "165664414043")
 (def default-sgs ["allow_outbound" "allow_ssh"])

-(letfn [(sensitive-merge-in*
+(letfn [(sensitive-merge-in*
           [mfns]
           (fn [a b]
             (if (map? a)
-              (do (when-let [dups (seq (clojure.set/intersection (set (keys a)) (set (keys b))))]
+              (do (when-let [dups (seq (set/intersection (set (keys a)) (set (keys b))))]
                     (prn "Duplicate keys: " dups))
                   (merge-with ((first mfns) (rest mfns)) a b))
               b)))
-        (merge-in*
+        (merge-in*
           [mfns]
           (fn [a b]
             (if (map? a)
@@ -25,9 +26,9 @@
         (merge-with-fn-seq
           [fn-seq]
           (partial merge-with
-                  ((first fn-seq) (rest fn-seq))))]
+                   ((first fn-seq) (rest fn-seq))))]
   (def merge-in
-    (merge-with-fn-seq (conj (repeat merge-in*) sensitive-merge-in*
+    (merge-with-fn-seq (conj (repeat merge-in*) sensitive-merge-in*
                              merge-in*))))

 (defn output-of [type resource-name & values]


Improve doc in context.stateful

Improve doc in context.stateful

--- src/main/clojure/lazytest/context/stateful.clj
+++ src/main/clojure/lazytest/context/stateful.clj
@@ -1,40 +1,43 @@
 (ns lazytest.context.stateful
   (:use [lazytest.context :only (Context context? setup teardown)]))

+;; You don't create instances of this; use the stateful function.
 (deftype StatefulContext [c state-atom]
-  ;; state-atom is a pair [value counter]. The wrapped setup/teardown
-  ;; functions are only called when counter is zero.
   Context
     (setup [this]
-	   (first
-	    (swap! state-atom
-		   (fn [[value counter]]
-		     [(if (zero? counter) (setup c) value)
-		      (inc counter)]))))
+      (first
+       (swap! state-atom
+	      (fn [[value counter]]
+		[(if (zero? counter) (setup c) value)
+		 (inc counter)]))))
     (teardown [this]
-	      (swap! state-atom
-		     (fn [[value counter]]
-		       (let [newcount (dec counter)]
-			 [(if (zero? newcount) (teardown c) value)
-			  newcount])))
-	      nil)
+      (swap! state-atom
+	     (fn [[value counter]]
+	       (let [newcount (dec counter)]
+		 (when (neg? newcount)
+		   (throw (IllegalStateException.
+			   "teardown called too many times on stateful context")))
+		 [(if (zero? newcount) (teardown c) value)
+		  newcount])))
+      nil)

   clojure.lang.IDeref
     (deref [this]
-	   (let [[value counter] @state-atom]
-	     (if (zero? counter)
-	       (throw (IllegalStateException.
-		       "Tried to deref context before setup."))
-	       value))))
+      (let [[value counter] @state-atom]
+	(if (zero? counter)
+	  (throw (IllegalStateException.
+		  "Tried to deref stateful context before setup."))
+	  value))))

 (defn stateful
   "Returns a Context that wraps Context c in a stateful container.
-  The state returned by c's setup function can be retrieved by
-  deref'ing this context.

-  Counts the number of times setup is called; does not call c's
-  teardown function until teardown has been called an equal number of
-  times."
+  The setup method of context c returns some state.  That state can be
+  retrieved by deref'ing this context.
+
+  Nested calls to setup/teardown are counted and handled
+  appropriately; only the outermost setup/teardown calls are passed to
+  the wrapped context."
   [c]
   {:pre [(context? c)]}
   (StatefulContext. c (atom [nil 0])))


add server sync endpoint to create group

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -103,6 +103,21 @@
       (timbre/warnf "User %s attempted to create a tag %s in a disallowed group"
                     user-id (?data :name) (?data :group-id)))))

+(defmethod event-msg-handler :chat/create-group
+  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
+  (when-let [user-id (get-in ring-req [:session :user-id])]
+    (println "Creating group" ?data)
+    (db/with-conn
+      (if-not (db/group-exists? (?data :name))
+        (let [new-group (db/create-group! ?data)]
+          (db/user-add-to-group! user-id (new-group :id)))
+        (do
+          (timbre/warnf "User %s attempted to create group that already exsits %s"
+                        user-id (?data :name))
+          (when ?reply-fn
+            (println "sending reply")
+            (?reply-fn {:error "Group name already taken"})))))))
+
 (defmethod event-msg-handler :session/start
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
   (when-let [user-id (get-in ring-req [:session :user-id])]


Set whether we want to show the aside menu for each navigation path

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -44,7 +44,8 @@
   (-> state
       state-utils/clear-page-state
       (assoc :navigation-point navigation-point
-             :navigation-data args)))
+             :navigation-data args
+             :navigation-settings {})))

 (defmethod navigated-to :default
   [history-imp navigation-point args state]
@@ -213,7 +214,9 @@
   [history-imp navigation-point args state]
   (-> state
       state-utils/clear-page-state
-      (assoc :navigation-point navigation-point :navigation-data args :navigation-settings {})))
+      (assoc :navigation-point navigation-point
+             :navigation-data args
+             :navigation-settings {:show-aside-menu :false})))

 (defmethod post-navigated-to! :add-projects
   [history-imp navigation-point _ previous-state current-state]
@@ -233,7 +236,7 @@
       state-utils/clear-page-state
       (assoc :navigation-point navigation-point
              :navigation-data args
-             :navigation-settings {})
+             :navigation-settings {:show-aside-menu :false})
       (assoc-in [:invite-data :org] (:org args))))

 (defmethod post-navigated-to! :invite-teammates
@@ -333,6 +336,7 @@
       state-utils/clear-page-state
       (assoc :navigation-point navigation-point)
       (assoc :navigation-data args)
+      (assoc :navigation-settings {})
       (assoc :org-settings-subpage subpage)
       (assoc :org-settings-org-name org)
       (assoc-in state/crumbs-path [{:type :org
@@ -397,6 +401,7 @@
         state-utils/clear-page-state
         (assoc :navigation-point navigation-point
                :navigation-data args
+               :navigation-settings {}
                :original-navigation-point orig-nav-point))))

 (defmethod post-navigated-to! :error
@@ -428,6 +433,7 @@
       state-utils/clear-page-state
       (assoc :navigation-point navigation-point)
       (assoc :navigation-data args)
+      (assoc :navigation-settings {})
       (assoc :account-settings-subpage subpage)))

 (defmethod post-navigated-to! :account


refactor

refactor

--- src/clj/bulldog/core.clj
+++ src/clj/bulldog/core.clj
@@ -80,8 +80,8 @@
     (server :timeout 100)
     (swap! state assoc :server nil)))

-(defn start-all-services
-  "startAllServices™"
+(defn start-server
+  "start the server"
   [port pw]
   (let [state (atom {:server nil
                      :store (<!! (new-mem-store)) #_(<!! (new-fs-store "data"))})]
@@ -98,7 +98,7 @@

 (comment

-  (def state (start-all-services 8080 "test"))
+  (def state (start-server 8080 "test"))

   #_(def state (atom {}))


after login route to who-keyword page

after login route to who-keyword page

--- src/cljs/bmihw/core.cljs
+++ src/cljs/bmihw/core.cljs
@@ -11,11 +11,25 @@
 (def stuff (atom nil))
 (def fb (js/Firebase. "https://bmihw.firebaseio.com"))

+;; -------------------------
+;; WHO KEYWORD
+;; -------------------------
+(defn who-keyword-page
+  []
+  [:div [:h2 "WHO KEYWORD"]
+   [:div [:a {:href "#/"} "go to the home page"]]])
+
+
+;; -------------------------
+;; HOME - LOGIN PAGE
+;; -------------------------
 (defn auth-twitter-handler
   [error, authData]
   (if error
     (reset! stuff error)
-    (reset! stuff authData)))
+    (do
+      (reset! stuff authData)
+      (session/put! :current-page #'who-keyword-page))))

 (defn auth-twitter
   []
@@ -23,18 +37,21 @@
                        "twitter"
                        auth-twitter-handler))

-;; -------------------------
-;; Views
-(defn home-page []
+
+(defn home-page
+  []
   [:div [:h2 "Welcome to bmihw"]
    [:input {:type "button" :value "Login"
             :on-click #(auth-twitter)}]
    [:div @stuff]
    [:div [:a {:href "#/about"} "go to about page"]]])

-(defn about-page []
+(defn about-page
+  []
   [:div [:h2 "About bmihw"]
    [:div [:a {:href "#/"} "go to the home page"]]])
+
+

 (defn current-page []
   [:div [(session/get :current-page)]])


fix exception on commit for newly added unit

--- src/cljs/lokate/app.cljs
+++ src/cljs/lokate/app.cljs
@@ -174,7 +174,7 @@
         (fn [[topic cid uid commit]]
           (om/transact! data [:model :history uid]
             #(conj % commit) :history)
-          (om/transact! (u/get-unit data cid uid) []
+          (om/transact! data [:model :collections cid :units uid]
             #(merge % (-> commit :data)) :unit))))

     om/IRender


Implemented the play and pause buttons.

Implemented the play and pause buttons.

--- src/cljs/vdd/player.cljs
+++ src/cljs/vdd/player.cljs
@@ -7,6 +7,9 @@

 ; TODO This jams too much all in one file. We should try to abstract away some of it like the
 ; button stuff and the slider.
+
+(def ^{:doc "Defines the duration in ms between play framews"}
+  duration 200)

 (def player-control
   (hiccups/html
@@ -21,17 +24,6 @@
        [:a.btn.last {:href "#"}[:i.icon-step-forward]]]]
      [:div.slider]]))

-
-(defn- play
-  "Handles the play button press."
-  [player-state-atom]
-
-  )
-
-(defn- pause
-  "Handles the pause button press."
-  [player-state-atom]
-  )

 (defn- go-to-index
   "Helper function to go to a specific index"
@@ -48,6 +40,33 @@
         (data-handler item)
         (ui.slider/set-value! (:slider player-state) new-index)
         (swap! player-state-atom assoc :index new-index)))))
+
+(defn- play-next-frame
+  "Animates playing and looping through the visualization data"
+  [player-state-atom]
+  (let [{items :items
+         playing :playing} @player-state-atom
+        next-index-fn (fn [curr-index]
+                        (if (= curr-index (-> items count dec))
+                          0
+                          (inc curr-index)))]
+    (when playing
+      (do
+        (go-to-index player-state-atom next-index-fn)
+        (js/setTimeout (partial play-next-frame player-state-atom) duration)))))
+
+(defn- play
+  "Handles the play button press."
+  [player-state-atom]
+  (when (not (:playing @player-state-atom))
+    (do
+      (swap! player-state-atom assoc :playing true)
+      (play-next-frame player-state-atom))))
+
+(defn- pause
+  "Handles the pause button press."
+  [player-state-atom]
+  (swap! player-state-atom assoc :playing false))

 (defn- back
   "Handles the back button press."
@@ -78,7 +97,7 @@
    {:items items
     :data-handler data-handler
     :index -1
-    :playing true
+    :playing false
     :slider slider}))

 (defn- player-data-handler
@@ -110,6 +129,8 @@
 (defn- slide
   "Handles the slider sliding to a new value."
   [state-atom new-index]
+  ; The user took control of the slider so make sure we're not playing
+  (pause state-atom)
   (go-to-index state-atom (constantly new-index)))

 (defn- setup-slider


Use alpha1 of the plugin for integs.

Use alpha1 of the plugin for integs.

--- integration-tests/project.clj
+++ integration-tests/project.clj
@@ -14,7 +14,7 @@

 (defproject org.immutant/integs "2.0.0-SNAPSHOT"
   :plugins [[lein-modules "0.3.8"]
-            [lein-immutant "2.0.0-SNAPSHOT"]]
+            [lein-immutant "2.0.0.alpha1"]]
   :dependencies [[org.immutant/immutant _]
                  [org.immutant/wildfly _]]
   :aliases {"all" ^:replace ["do" "clean," "test"]}


CMR-3773: Moving comment section to bottom.

--- orbits-lib/src/cmr/orbits/orbits_runtime.clj
+++ orbits-lib/src/cmr/orbits/orbits_runtime.clj
@@ -22,36 +22,6 @@
                   (getEngineByName "jruby"))]
     (.eval jruby "load 'orbits/echo_orbits_impl.rb'")
     jruby))
-
-;; Allows easily evaluating Ruby code in the Clojure REPL.
-(comment
- (def jruby (create-jruby-runtime))
-
- (defn eval-jruby
-   [s]
-   (.eval jruby (java.io.StringReader. s)))
-
- (area-crossing-range
-  (:orbits user/system)
-  {:lat-range [-45 45]
-   :geometry-type :br
-   :coords [-45, 45, 45, -45]
-   :ascending? true
-   :inclination 98.15
-   :period 98.88
-   :swath-width 1450.0
-   :start-clat -90.0
-   :num-orbits 0.5})
-
- (denormalize-latitude-range
-  (:orbits user/system)
-  50 720)
-
- (do
-   (eval-jruby "load 'spec/coordinate_spec.rb'")
-   (eval-jruby "load 'spec/geometry_backtracking_spec.rb'"))
-
- (eval-jruby "require 'rspec/core'; RSpec::Core::Runner.run([])"))

 ;; An wrapper component for the JRuby runtime
 (defrecord OrbitsRuntime
@@ -108,3 +78,32 @@
         {:keys [jruby-runtime]} orbits-runtime]
     (.invokeFunction jruby-runtime "denormalizeLatitudeRange" (to-array args))))

+;; Allows easily evaluating Ruby code in the Clojure REPL.
+(comment
+ (def jruby (create-jruby-runtime))
+
+ (defn eval-jruby
+   [s]
+   (.eval jruby (java.io.StringReader. s)))
+
+ (area-crossing-range
+  (:orbits user/system)
+  {:lat-range [-45 45]
+   :geometry-type :br
+   :coords [-45, 45, 45, -45]
+   :ascending? true
+   :inclination 98.15
+   :period 98.88
+   :swath-width 1450.0
+   :start-clat -90.0
+   :num-orbits 0.5})
+
+ (denormalize-latitude-range
+  (:orbits user/system)
+  50 720)
+
+ (do
+   (eval-jruby "load 'spec/coordinate_spec.rb'")
+   (eval-jruby "load 'spec/geometry_backtracking_spec.rb'"))
+
+ (eval-jruby "require 'rspec/core'; RSpec::Core::Runner.run([])"))


Add some ^:no-doc for cljdoc.

Add some ^:no-doc for cljdoc.

--- src/zprint/core.cljc
+++ src/zprint/core.cljc
@@ -329,7 +329,7 @@

 (declare zprint-str-internal)

-(defn dzprint-zipper
+(defn ^:no-doc dzprint-zipper
   "If we are running in zipper mode, do an internal version of zprint
   on a structure."
   [options coll]
@@ -343,7 +343,7 @@
            e
            coll-str))))

-(defn dzprint-sexpr
+(defn ^:no-doc dzprint-sexpr
   "If we are running in zipper mode, do an internal version of zprint
   on a structure."
   [options coll]


Random examples for a slower machine

Random examples for a slower machine

--- src/atom_finder/questions/random_examples.clj
+++ src/atom_finder/questions/random_examples.clj
@@ -30,30 +30,29 @@
      time-mins
      )))

-; 2:20 for 100k
-(def random-atoms
-  (->>
-   random-c-files
-   (take 100000)
-   (pap (constantly (now)))
-   (upmapcat
-    (fn [filename]
-      (with-timeout 120
-        (log-err "parsing random example" nil
-                 (for [[name atms] (->> filename parse-file find-all-atoms)
-                       atm atms]
-                   (log-err "serializing random example" nil
-                            {:file (filename atm)
-                             :line (start-line atm)
-                             :type name
-                             ;;:atom atm
-                             :github-url (github-url atm)
-                             :code-str (write-tree atm)}))))))
-   (remove nil?)
-   shuffle
-   time-mins
-   ))
-
+; 4hrs for 100k on Transformer
+'((def random-atoms
+    (->>
+     random-c-files
+     (take 10000)
+     (pap (constantly (now)))
+     (pmapcat
+      (fn [file]
+        (with-timeout 120
+          (log-err "parsing random example" nil
+                   (for [[name atms] (->> file parse-file find-all-atoms)
+                         atm atms]
+                     (log-err "serializing random example" nil
+                              {:file (filename atm)
+                               :line (start-line atm)
+                               :type name
+                               ;;:atom atm
+                               :github-url (github-url atm)
+                               :code-str (write-tree atm)}))))))
+     (remove nil?)
+     shuffle
+     time-mins
+     )))

 (quote
 (->>
@@ -61,7 +60,7 @@
  (group-by :type)
  ;;first last first :github-url)
  (map-values (partial distinct-by (%->> :github-url (re-find #"[^#]*"))))
- (map-values (partial take 40))
+ (map-values (partial take 50))
  (def grouped-examples)
  time-mins
  )
@@ -70,7 +69,7 @@
 (quote
  (->> grouped-examples
      (map-values (partial map #(str (:github-url %1) "\n\n" (:code-str %1) "\n\n--------------\n")))
-     (map (fn [[type atoms]] (spit (str "tmp/atom-examples_reversed_macro-op_literal-enc/" (name type) ".txt") (str/join "\n" atoms))))
+     (map (fn [[type atoms]] (spit (str "tmp/atom-examples_v" (name type) ".txt") (str/join "\n" atoms))))
      )
  )


format-config: Make private

format-config: Make private

--- src/whitman/config.clj
+++ src/whitman/config.clj
@@ -2,7 +2,7 @@
   (:require [clojure.data.json :as json]
             [whitman.utils :as utils]))

-(defn format-config [cfg]
+(defn ^{:private true } format-config [cfg]
   (assoc cfg "user-agent" (format (get cfg "user-agent") utils/version)))

 (defn read-config [path]


Relaxing output file constraints to account for small differences between lib versions

--- test/vignette/http/integration_gif_test.clj
+++ test/vignette/http/integration_gif_test.clj
@@ -38,7 +38,7 @@
            (:status response) => 200
            (get (:headers response) "Surrogate-Key") => "936b19e79decb9240a0b65ff437ae5ea033c0f69"
            (get (:headers response) "Content-Disposition") => "inline; filename=\"chuck-large-animated.webp\"; filename*=UTF-8''chuck-large-animated.webp"
-           (Integer/parseInt (get (:headers response) "Content-Length")) => (roughly 183990 50)
+           (Integer/parseInt (get (:headers response) "Content-Length")) => (roughly 176260 8500)
            (get (:headers response) "Connection") => "close"
            (get (:headers response) "Cache-Control") => "public, max-age=31536000"
            (get (:headers response) "Content-Type") => "image/webp"
@@ -49,7 +49,7 @@
            (:status response) => 200
            (get (:headers response) "Surrogate-Key") => "936b19e79decb9240a0b65ff437ae5ea033c0f69"
            (get (:headers response) "Content-Disposition") => "inline; filename=\"chuck-large-animated.gif\"; filename*=UTF-8''chuck-large-animated.gif"
-           (Integer/parseInt (get (:headers response) "Content-Length")) => (roughly 519260 50)
+           (Integer/parseInt (get (:headers response) "Content-Length")) => (roughly 522200 3000)
            (get (:headers response) "Connection") => "close"
            (get (:headers response) "Cache-Control") => "public, max-age=31536000"
            (get (:headers response) "Content-Type") => "image/gif"
@@ -91,7 +91,7 @@
            (:status response) => 200
            (get (:headers response) "Surrogate-Key") => "818d43fd30960d035baf60affcde0e05f921a6cc"
            (get (:headers response) "Content-Disposition") => "inline; filename=\"static.gif\"; filename*=UTF-8''static.gif"
-           (Integer/parseInt (get (:headers response) "Content-Length")) => (roughly 12530 50)
+           (Integer/parseInt (get (:headers response) "Content-Length")) => (roughly 12800 300)
            (get (:headers response) "Connection") => "close"
            (get (:headers response) "Cache-Control") => "public, max-age=31536000"
            (get (:headers response) "Content-Type") => "image/gif"


Fix NPE in common-job-scheduler when no job requires peers

This is caused when :onyx/max-peers is set for all tasks and no new
peers should be scheduled to the job despite available peers existing

--- src/onyx/scheduling/balanced_job_scheduler.clj
+++ src/onyx/scheduling/balanced_job_scheduler.clj
@@ -59,5 +59,8 @@
   (loop [jobs* jobs n* n]
     (if (zero? n*)
       jobs*
-      (recur (update-in jobs* [(select-job-requiring-peer replica jobs*)] inc)
-             (dec n*)))))
+      (let [job (select-job-requiring-peer replica jobs*)]
+        (if job
+          (recur (update jobs* job inc)
+                 (dec n*))
+          jobs*)))))


rewrite (filter-subclause->predicate) to be much cleaner thanks to Cam.

--- src/metabase/driver/generic_sql/query_processor.clj
+++ src/metabase/driver/generic_sql/query_processor.clj
@@ -134,30 +134,25 @@
   "Given a filter SUBCLAUSE, return a Korma filter predicate form for use in korma `where`.

     (filter-subclause->predicate [\">\" 1413 1]) -> {:field_name [> 1]} "
-  [[_ field-id :as subclause]]
-  (if-not (> (count subclause) 4)
-    ;; most filter clauses have 4 or fewer args and only 1 field-id, so handle those here
-    {(field-id->kw field-id)
-     (match subclause
-       [">"  _ value]        ['>    value]
-       ["<"  _ value]        ['<    value]
-       [">=" _ value]        ['>=   value]
-       ["<=" _ value]        ['<=   value]
-       ["="  _ value]        ['=    value]
-       ["!=" _ value]        ['not= value]
-       ["NOT_NULL" _]        ['not= nil]
-       ["IS_NULL" _]         ['=    nil]
-       ["BETWEEN" _ min max] ['between [min max]])}
-    ;; for the more obscure filtering cases we have another approach
-    (let [[operation lat-field-id lon-field-id lat-max lon-min lat-min lon-max] subclause
-          lat-kw (field-id->kw lat-field-id)
-          lon-kw (field-id->kw lon-field-id)]
-      (case (keyword operation)
-        :INSIDE `(~'and
-                   {~lat-kw [~'< ~lat-max]}
-                   {~lat-kw [~'> ~lat-min]}
-                   {~lon-kw [~'< ~lon-max]}
-                   {~lon-kw [~'> ~lon-min]})))))
+  [subclause]
+  (match subclause
+    ["INSIDE" lat-field lon-field lat-max lon-min lat-min lon-max] (let [lat-kw (field-id->kw lat-field)
+                                                                         lon-kw (field-id->kw lon-field)]
+                                                                     `(~'and ~@[{lat-kw ['< lat-max]}
+                                                                                {lat-kw ['> lat-min]}
+                                                                                {lon-kw ['< lon-max]}
+                                                                                {lon-kw ['> lon-min]}]))
+    [_ field-id & _] {(field-id->kw field-id)
+                      (match subclause
+                        [">"  _ value]        ['>    value]
+                        ["<"  _ value]        ['<    value]
+                        [">=" _ value]        ['>=   value]
+                        ["<=" _ value]        ['<=   value]
+                        ["="  _ value]        ['=    value]
+                        ["!=" _ value]        ['not= value]
+                        ["NOT_NULL" _]        ['not= nil]
+                        ["IS_NULL" _]         ['=    nil]
+                        ["BETWEEN" _ min max] ['between [min max]])}))

 (defmethod apply-form :filter [[_ filter-clause]]
   (match filter-clause


changes blocking sleep to async sleep (#1602)

--- waiter/src/waiter/scheduler/kubernetes.clj
+++ waiter/src/waiter/scheduler/kubernetes.clj
@@ -1922,7 +1922,8 @@
      (async/go
        (try
          (log/info "starting K8s event fetcher")
-         (let [load-events (fn [k8s-object-key] (get-cached-events-chan k8s-object-key->event-cache k8s-object-key query-events scheduler options))]
+         (let [interval-ms 10000
+               load-events (fn [k8s-object-key] (get-cached-events-chan k8s-object-key->event-cache k8s-object-key query-events scheduler options))]
            (loop [iter 0]
              (cid/with-correlation-id
                (str "k8s-event-fetcher-iter-" iter)
@@ -1965,7 +1966,7 @@
                                    (async/put! fetch-events-chan events-update))))
                              (recur (dissoc event-chan->object-id current-chan))))))))))
              (update-event-fetcher-state-with event-fetcher-state {:last-successful-iteration (du/date-to-str (t/now))})
-             (utils/sleep 10000)
+             (async/<! (async/timeout interval-ms))
              (recur (inc iter))))
          (catch Throwable t
            (log/error t "unhandled error in K8s event fetcher")


[bug] fix regressions on creating new account

--- src/status_im/ui/screens/accounts/login/events.cljs
+++ src/status_im/ui/screens/accounts/login/events.cljs
@@ -1,15 +1,13 @@
 (ns status-im.ui.screens.accounts.login.events
-  (:require
-    status-im.ui.screens.accounts.login.navigation
-
-    [re-frame.core :refer [dispatch reg-fx]]
-    [status-im.utils.handlers :refer [register-handler-db register-handler-fx]]
-    [taoensso.timbre :as log]
-    [status-im.chat.sign-up :as sign-up]
-    [status-im.utils.types :refer [json->clj]]
-    [status-im.data-store.core :as data-store]
-    [status-im.native-module.core :as status]
-    [status-im.constants :refer [console-chat-id]]))
+  (:require status-im.ui.screens.accounts.login.navigation
+            [re-frame.core :refer [dispatch reg-fx]]
+            [status-im.utils.handlers :refer [register-handler-db register-handler-fx]]
+            [taoensso.timbre :as log]
+            [status-im.chat.sign-up :as sign-up]
+            [status-im.utils.types :refer [json->clj]]
+            [status-im.data-store.core :as data-store]
+            [status-im.native-module.core :as status]
+            [status-im.constants :refer [console-chat-id]]))

 ;;;; FX

@@ -97,15 +95,9 @@
                         wrap-with-stop-node-fx)]
       (wrap-fn db' address password))))

-(defn is-new-account?
-  "checks if the account is in the accounts in the db"
-  [{:accounts/keys [accounts]} address]
-  (let [present? (set (keys accounts))]
-    (not (present? address))))
-
 (register-handler-fx
   :login-handler
-  (fn [{db :db} [_ login-result address]]
+  (fn [{{:accounts/keys [account-creation?] :as db} :db} [_ login-result address]]
     (let [data    (json->clj login-result)
           error   (:error data)
           success (zero? (count error))
@@ -114,10 +106,9 @@
       (merge
        {:db (if success db' (assoc-in db' [:accounts/login :error] error))}
        (when success
-         (let [new-account? (is-new-account? db address)]
-           (log/debug "Logged in" (when new-account? " new account") ":" address)
-           {::clear-web-data nil
-            ::change-account [address new-account?]}))))))
+         (log/debug "Logged in" (when account-creation? " new account") ":" address)
+         {::clear-web-data nil
+          ::change-account [address account-creation?]})))))

 (register-handler-fx
   :change-account-handler


[STORM-1427] remove tuple.clj referance in core.clj

--- storm-core/src/clj/backtype/storm/ui/core.clj
+++ storm-core/src/clj/backtype/storm/ui/core.clj
@@ -21,7 +21,7 @@
         ring.middleware.multipart-params)
   (:use [ring.middleware.json :only [wrap-json-params]])
   (:use [hiccup core page-helpers])
-  (:use [backtype.storm config util log stats tuple zookeeper converter])
+  (:use [backtype.storm config util log stats zookeeper converter])
   (:use [backtype.storm.ui helpers])
   (:use [backtype.storm.daemon [common :only [ACKER-COMPONENT-ID ACKER-INIT-STREAM-ID ACKER-ACK-STREAM-ID
                                               ACKER-FAIL-STREAM-ID mk-authorization-handler


removing unnecessary helper func print-map

--- storm-core/src/clj/backtype/storm/ui/core.clj
+++ storm-core/src/clj/backtype/storm/ui/core.clj
@@ -309,11 +309,6 @@
                          (StringEscapeUtils/escapeJavaScript name) "', '"
                          command "', " is-wait ", " default-wait ")")}])

-(defn print-map [t]
-  (doseq [[k v] t]
-    (log-message "key " k " value " v)
-    ))
-
 (defn cluster-configuration []
   (with-nimbus nimbus
     (.getNimbusConf ^Nimbus$Client nimbus)))


Add serialization for mikera.matrixx.Matrix...

--- src/polismath/components/core_matrix_boot.clj
+++ src/polismath/components/core_matrix_boot.clj
@@ -21,6 +21,7 @@
                    ;'clojure.core.matrix.impl.ndarray.NDArray])
                    ;; Could this be the new ns?
                    'mikera.arrayz.NDArray
+                   'mikera.matrixx.Matrix
                    ;'clojure.core.matrix.impl.ndarray.NDArray
                    'clojure.core.matrix.impl.ndarray_object.NDArray])


Fixing imports

Fixing imports

--- test/org/libraryweasel/ligature/core_test.clj
+++ test/org/libraryweasel/ligature/core_test.clj
@@ -8,35 +8,34 @@

 (ns org.libraryweasel.ligature.core-test
   (:require [clojure.test :refer :all]
-            [org.libraryweasel.ligature.core :refer :all]
-            [clojure.spec.alpha :as s]
-            [org.libraryweasel.ligature.core :as l]))
+            [org.libraryweasel.ligature.core :as l]
+            [clojure.spec.alpha :as s]))

 (deftest identifier?-test
   (testing "Common examples"
-    (is (not (identifier? "")))
-    (is (identifier? "http://localhost/people/7"))
-    (is (not (identifier? "http://localhost(/people/7")))
-    (is (not (identifier? "http://localhost /people/7")))
-    (is (identifier? "hello"))
-    (is (identifier? "_:"))
-    (is (identifier? "_:valid"))
-    (is (identifier? "_:1"))
-    (is (identifier? "_:1344")))) ; TODO more test cases
+    (is (not (l/identifier? "")))
+    (is (l/identifier? "http://localhost/people/7"))
+    (is (not (l/identifier? "http://localhost(/people/7")))
+    (is (not (l/identifier? "http://localhost /people/7")))
+    (is (l/identifier? "hello"))
+    (is (l/identifier? "_:"))
+    (is (l/identifier? "_:valid"))
+    (is (l/identifier? "_:1"))
+    (is (l/identifier? "_:1344")))) ; TODO more test cases

 (deftest lang-literal?-test
   (testing "Common examples"
-    (is (not (lang-literal? "not a lang lit")))
-    (is (not (lang-literal? {:value "" :lang ""})))
-    (is (lang-literal? {:value "Hello" :lang "en"}))
-    (is (not (lang-literal? {:value "Bonjour" :lang "fr" :type "fr"}))))) ; TODO more test cases
+    (is (not (l/lang-literal? "not a lang lit")))
+    (is (not (l/lang-literal? {:value "" :lang ""})))
+    (is (l/lang-literal? {:value "Hello" :lang "en"}))
+    (is (not (l/lang-literal? {:value "Bonjour" :lang "fr" :type "fr"}))))) ; TODO more test cases

 (deftest typed-literal?-test
   (testing "Common examples"
-    (is (not (typed-literal? "not a typed literal")))
-    (is (not (typed-literal? {})))
-    (is (typed-literal? {:value "Hello" :type "identifier"}))
-    (is (not (typed-literal? {:value "56" :type "number" :lang "en"}))))) ; TODO more test cases
+    (is (not (l/typed-literal? "not a typed literal")))
+    (is (not (l/typed-literal? {})))
+    (is (l/typed-literal? {:value "Hello" :type "identifier"}))
+    (is (not (l/typed-literal? {:value "56" :type "number" :lang "en"}))))) ; TODO more test cases

 (deftest statement?-test
   (testing "Common examples"
@@ -58,11 +57,11 @@

 (deftest lang-tag?-test
   (testing "Common examples"
-    (is (not (lang-tag? "")))
-    (is (lang-tag? "en"))
-    (is (not (lang-tag? "en-")))
-    (is (lang-tag? "en-fr"))
-    (is (not (lang-tag? "en-fr-")))
-    (is (lang-tag? "en-fr-sp"))
-    (is (lang-tag? "ennnenefnk-dkfjkjfl-dfakjelfkjalkf-fakjeflkajlkfj"))
-    (is (not (lang-tag? "en-fr-ef ")))))
+    (is (not (l/lang-tag? "")))
+    (is (l/lang-tag? "en"))
+    (is (not (l/lang-tag? "en-")))
+    (is (l/lang-tag? "en-fr"))
+    (is (not (l/lang-tag? "en-fr-")))
+    (is (l/lang-tag? "en-fr-sp"))
+    (is (l/lang-tag? "ennnenefnk-dkfjkjfl-dfakjelfkjalkf-fakjeflkajlkfj"))
+    (is (not (l/lang-tag? "en-fr-ef ")))))


Update gp.clj

Update gp.clj

--- src/simple_symbolic_regression_clojure/gp.clj
+++ src/simple_symbolic_regression_clojure/gp.clj
@@ -68,7 +68,7 @@
   (assoc individual :score score))

 (defn get-score [individual]
-  (:score individual))
+  (:score (deref individual)))

 ;;; Generating random scripts, individuals, etc.


newline

newline

--- test/vignette/api/legacy/integration_test.clj
+++ test/vignette/api/legacy/integration_test.clj
@@ -24,4 +24,4 @@
     (< actual max)))

 (facts :legacy-requests
-       (parse-request-log "legacy/request.log") => (less-than 0.01))+       (parse-request-log "legacy/request.log") => (less-than 0.01))


Check output fields when they exist

Check output fields when they exist

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -48,7 +48,8 @@
                              index)))
   (ensure-index [this kind name default-fields]
                 (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
-                (when (empty? (get-in kind->name->fields->index [kind name]))
+                (if-let [fields->index (get-in kind->name->fields->index [kind name])]
+                  (assert (= (set default-fields) (set (first (keys fields->index)))))
                   (.get-or-create-index this kind name default-fields)))
   (add-facts [this kind name fields facts]
              (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))


Adds macro while-timout to avoid test hangs

--- storm-core/src/clj/backtype/storm/testing.clj
+++ storm-core/src/clj/backtype/storm/testing.clj
@@ -164,6 +164,14 @@
     (rmr t)
     ))

+(def TEST-TIMEOUT-MS 5000)
+
+(defmacro while-timeout [timeout-ms condition & body]
+  `(let [end-time# (+ (System/currentTimeMillis) ~timeout-ms)]
+    (while ~condition
+      (when (> (System/currentTimeMillis) end-time#)
+        (throw (AssertionError. (str "Test timed out (" ~timeout-ms "ms)"))))
+      ~@body)))

 (defn wait-until-cluster-waiting
   "Wait until the cluster is idle. Should be used with time simulation."
@@ -176,7 +184,7 @@
                   supervisors
                   workers) ; because a worker may already be dead
         ]
-    (while (not (every? (memfn waiting?) daemons))
+    (while-timeout TEST-TIMEOUT-MS (not (every? (memfn waiting?) daemons))
       (Thread/sleep 10)
 ;;      (doseq [d daemons]
 ;;        (if-not ((memfn waiting?) d)
@@ -443,11 +451,11 @@

     (let [storm-id (common/get-storm-id state storm-name)]
-      (while (not (every? exhausted? (spout-objects spouts)))
+      (while-timeout TEST-TIMEOUT-MS (not (every? exhausted? (spout-objects spouts)))
         (simulate-wait cluster-map))

       (.killTopologyWithOpts (:nimbus cluster-map) storm-name (doto (KillOptions.) (.set_wait_secs 0)))
-      (while (.assignment-info state storm-id nil)
+      (while-timeout TEST-TIMEOUT-MS (.assignment-info state storm-id nil)
         (simulate-wait cluster-map))
       (when cleanup-state
         (doseq [spout (spout-objects spouts)]
@@ -554,7 +562,7 @@
                            (not= (global-amt track-id "transferred")
                                  (global-amt track-id "processed"))
                            ))]
-        (while (waiting?)
+        (while-timeout TEST-TIMEOUT-MS (waiting?)
           ;; (println "Spout emitted: " (global-amt track-id "spout-emitted"))
           ;; (println "Processed: " (global-amt track-id "processed"))
           ;; (println "Transferred: " (global-amt track-id "transferred"))


moving setup-postgres call inside of postgres test to not interefere with non-postgres test in the file

--- test/vip/data_processor/db/tree_statistics_test.clj
+++ test/vip/data_processor/db/tree_statistics_test.clj
@@ -6,8 +6,6 @@
             [vip.data-processor.validation.xml :as xml]
             [vip.data-processor.test-helpers :refer :all]
             [korma.core :as korma]))
-
-(use-fixtures :once setup-postgres)

 (deftest camel->snake-test
   (testing "got the regex close"
@@ -18,6 +16,7 @@
        "lowercase" "lowercase")))

 (deftest ^:postgres validate-polling-locations-by-type
+  (setup-postgres #())
   (let [ctx {:input (xml-input "v5-polling-locations-by-type.xml")
              :pipeline [psql/start-run
                         xml/load-xml-ltree


Declare bytes class statically for avoid use reflection api on runtime.

--- src/buddy/core/bytes.clj
+++ src/buddy/core/bytes.clj
@@ -19,14 +19,16 @@
   (:import java.nio.ByteBuffer
            java.util.Arrays))

+(def ^:private +bytes-class+
+  (Class/forName "[B"))
+
 (defn bytes?
   "Test if a first parameter is a byte
   array or not."
   [x]
   (if (nil? x)
     false
-    (= (Class/forName "[B")
-       (.getClass x))))
+    (= +bytes-class+ (.getClass x))))

 (defn fill!
   "Assigns the specified byte value to each element


using supernal bound-fn

using supernal bound-fn

--- src/celestial/launch.clj
+++ src/celestial/launch.clj
@@ -45,15 +45,6 @@
     (set-config! [:appenders :spit :enabled?] true)
     (set-level! (log* :level))))

-(defn tid-hook
-  "sets up env binding for a Java based thread see http://bit.ly/14F7clG"
-  [b & [f & _]] (b (bound-fn* f)))
-
-(defn setup-hooks
-   "setting up misc hooks"
-   []
-  (add-hook #'supernal.core/bound-future #'tid-hook))
-
 (defn clean-up []
   (debug "Shutting down...")
   (jobs/shutdown-workers)
@@ -91,7 +82,6 @@
   (p/reset-admin)
   (mg/setup-migrations)
   (add-shutdown)
-  (setup-hooks)
   (ssh-config {:key (get! :ssh :private-key-path) :user "root"} )
   (default-key)
   (start-nrepl)


Switch devsrc to running the real main fn

--- devsrc/comic_reader/dev.cljs
+++ devsrc/comic_reader/dev.cljs
@@ -4,13 +4,13 @@

 (enable-console-print!)

-;; TODO: Put figwheel setups into some kind of dev namespace
 (fw/start {
-           ;; configure a websocket url if you are using your own server
+           ;; configure a websocket url if you are using your own
+           ;; server
            :websocket-url "ws://localhost:3449/figwheel-ws"

            ;; optional callback
-           :on-jsload (fn [] (.log js/console "Loaded figwheel!"))
+           :on-jsload main/run

            ;; The heads up display is enabled by default
            ;; to disable it:


License into core-test module

License into core-test module

--- test/cloverage_jenkins_reporter/core_test.clj
+++ test/cloverage_jenkins_reporter/core_test.clj
@@ -1,3 +1,31 @@
+;;;
+;;;   Statistic about code coverage measured by Cloverage reporter.
+;;;
+;;; Copyright (c) 2015  Pavel Tisnovsky, Red Hat
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions are met:
+;;;     * Redistributions of source code must retain the above copyright
+;;;       notice, this list of conditions and the following disclaimer.
+;;;     * Redistributions in binary form must reproduce the above copyright
+;;;       notice, this list of conditions and the following disclaimer in the
+;;;       documentation and/or other materials provided with the distribution.
+;;;     * Neither the name of the Red Hat nor the
+;;;       names of its contributors may be used to endorse or promote products
+;;;       derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;;; DISCLAIMED. IN NO EVENT SHALL Pavel Tisnovsky BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
 (ns cloverage-jenkins-reporter.core-test
   (:require [clojure.test :refer :all]
             [cloverage-jenkins-reporter.core :refer :all]))


Migrate alts-slide to Om component

Migrate alts-slide to Om component

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -93,26 +93,28 @@
             [:rect {:x 0 :y 0 :width 280 :height 100 :fill "red"}]
             [:text {:x 30 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}} "(timeout 2000)"]]]])))))

-
-(defrecord AltsSlide [opts]
-  Slide
-  (init-slide-state [_]
-    {:default-font (:font-size opts)
-     :status "READY"})
-  (render-slide [_ data owner]
-    (let [default-font (om/get-state owner :default-font)]
-      [:div
-       [:svg {:version "1.1" :width 800 :height 600}
-        [:text {:x 30 :y 120 :style {:font-size default-font :stroke "white" :fill "white"}} (om/get-state owner :status)]
-        [:g {:transform "translate(70,150)"
-             :onClick (fn [_]
-                        (om/set-state! owner :status "WAITING")
-                        (go
-                          (<! (timeout 2000))
-                          (om/set-state! owner :status "CLOSED")))}
-         [:rect {:x 0 :y 0 :width 280 :height 100 :fill "red"}]
-         [:text {:x 30 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}}
-          "(alts! ch (time-out 2000))"]]]])))
+(defn alts-slide [data owner opts]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:default-font (:font-size opts)
+       :status "READY"})
+    om/IRender
+    (render [_]
+      (let [default-font (om/get-state owner :default-font)]
+        (html
+         [:div
+          [:svg {:version "1.1" :width 800 :height 600}
+           [:text {:x 30 :y 120 :style {:font-size default-font :stroke "white" :fill "white"}} (om/get-state owner :status)]
+           [:g {:transform "translate(70,150)"
+                :onClick (fn [_]
+                           (om/set-state! owner :status "WAITING")
+                           (go
+                             (<! (timeout 2000))
+                             (om/set-state! owner :status "CLOSED")))}
+            [:rect {:x 0 :y 0 :width 280 :height 100 :fill "red"}]
+            [:text {:x 30 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}}
+             "(alts! ch (time-out 2000))"]]]])))))

 (defn create-circle [offset angle]
   (fn [app owner]
@@ -202,8 +204,9 @@
           {:subtitle "buffers (TODO)"
            :code "(<! (chan))"}

-          #_{:subtitle "alts!"
-           :custom (AltsSlide. {:font-size "30pt"})}
+          {:subtitle "alts!"
+           :custom alts-slide
+           :opts {:font-size "30pt"}}

           {:subtitle "go blocks"
            :custom go-block-slide


Provide visibility into error message in spawned threads.

--- src/clj/fleetdb/util.clj
+++ src/clj/fleetdb/util.clj
@@ -1,5 +1,6 @@
 (ns fleetdb.util
   (:require (clojure.contrib [def :as def]))
+  (:require (clj-stacktrace [repl :as stacktrace]))
   (:import  (fleetdb FleetDBException)))

 (def/defalias def- def/defvar-)
@@ -79,4 +80,11 @@
   (reduce (fn [int-m [k v]] (assoc int-m k (f k v))) {} m))

 (defmacro spawn [& body]
-  `(doto (Thread. (fn [] ~@body)) (.start)))
+  `(doto (Thread.
+           (fn []
+             (try
+               ~@body
+               (catch Exception e#
+                 (stacktrace/pst-on System/err false e#)
+                 (.println System/err)))))
+        (.start)))


Print info about results file location after running simulation

--- src/clj_gatling/core.clj
+++ src/clj_gatling/core.clj
@@ -49,4 +49,5 @@
         csv (csv/write-csv (create-result result) :delimiter "\t" :end-of-line "\n")]
     (println csv)
     (spit "results/23/simulation.log" csv)
-    (create-chart "results")))
+    (create-chart "results")
+    (println "Open results/out/index.html")))


Remove responsibility of creating results dir from highcharts reporter

--- src/clj_gatling/core.clj
+++ src/clj_gatling/core.clj
@@ -15,9 +15,8 @@
     (create-dir (str results-dir "/input"))
     results-dir))

-(defn- gatling-highcharts-reporter [root]
-  (let [results-dir (create-results-dir root)
-        start-time (LocalDateTime.)]
+(defn- gatling-highcharts-reporter [results-dir]
+  (let [start-time (LocalDateTime.)]
     {:writer (partial report/gatling-csv-writer (str results-dir  "/input") start-time)
      :generator (fn [_]
                   (println "Creating report from files in" results-dir)
@@ -47,10 +46,11 @@
 (defn run [simulation {:keys [concurrency root timeout-in-ms context requests duration reporter]
                        :or {concurrency 1
                             root "target/results"
-                            reporter (gatling-highcharts-reporter root)
                             timeout-in-ms 5000
                             context {}}}]
-  (let [result (simulation/run simulation {:concurrency concurrency
+  (let [results-dir (create-results-dir root)
+        reporter (or reporter (gatling-highcharts-reporter results-dir))
+        result (simulation/run simulation {:concurrency concurrency
                                            :timeout-in-ms timeout-in-ms
                                            :context context
                                            :requests requests


multi-page memory-mapped tiff working

multi-page memory-mapped tiff working

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

--- plugins/OMETiff/src/org/micromanager/ometiff/core.clj
+++ plugins/OMETiff/src/org/micromanager/ometiff/core.clj
@@ -13,7 +13,7 @@
           (map #(bit-and 0xFF %)
            (take n (iterate #(bit-shift-right % 8) val))))]
     (for [char chars]
-      (if (> char 0x7F) (- char 0xFF) char))))
+      (if (> char 0x7F) (- char 0x100) char))))

 (def tag-codes
   {
@@ -32,7 +32,7 @@

 (def type-codes {:byte 1, :ascii 2, :short 3, :long 4, :rational 5})

-(def type-length {:byte 1, :ascii 1, :short 2, :long 4, :rational 8})
+(def type-length {:byte 1, :ascii 1, :short 2, :long 4, :rational 4})

 (defn make-tag
   "Create a big-endian tiff image IFD entry"
@@ -64,8 +64,8 @@
     (let [ifd-entry-count 11
           pixel-size-cm (* 1e-4 pixel-size-um)
           pixels-per-image (* width height)
-          bytes-per-image (* width height (bit-shift-right bits-per-pixel 1))
-          pixel-size-offset (+ 2 (* 12 ifd-entry-count) current-offset)
+          bytes-per-image (* width height (/ bits-per-pixel 8))
+          pixel-size-offset (+ current-offset 2 (* 12 ifd-entry-count) 4 2)
           image-offset (+ pixel-size-offset 8)
           ifd-entries
             (map #(apply make-tag %)
@@ -79,22 +79,27 @@
                [:StripByteCounts :long 1 (* width height)]
                [:XResolution :rational 1 pixel-size-offset]
                [:YResolution :rational 1 pixel-size-offset]
-               [:ResolutionUnit :short 1 (if pixel-size-cm 3)]])
+               [:ResolutionUnit :short 1 (if pixel-size-cm 3 1)]
+               ])
               ]
+    ;  (println "pso:" pixel-size-offset ", bpi:" bytes-per-image ", current: " current-offset "; next: "  (+ image-offset bytes-per-image))
       (concat
         (make-bytes ifd-entry-count 2)
         (list ifd-entries)
         (make-bytes (if final-image? 0 (+ image-offset bytes-per-image)) 4)
-        (rational-value pixel-size-cm)))))
+        (make-bytes 0 2)
+        (rational-value pixel-size-cm)
+        ))))

 ;; Memory-mapped files

 (defn open-mmap [file size]
-  (let [rwChannel (.getChannel (RandomAccessFile. file "rwd"))
+  (let [f (RandomAccessFile. file "rwd")
+        rwChannel (.getChannel f)
         dbb (.map rwChannel FileChannel$MapMode/READ_WRITE 0 size)
         dsb (.asShortBuffer dbb)]
-    {:rwChannel rwChannel :byte-buf dbb :short-buf dsb}))
+    {:file f :rwChannel rwChannel :byte-buf dbb :short-buf dsb}))

 (defn write-seq [mmap byte-vals]
   (.put (:byte-buf mmap) (byte-array (map byte byte-vals))))
@@ -109,7 +114,8 @@
   (let [chan (:rwChannel mmap)]
     (doto chan
       (.truncate (get-pos mmap))
-      .close)))
+      .close)
+    (.close (:file mmap))))

 ; (.position dbb) <-- gets cursor pos
 ; (.position dbb 10) <-- sets cursor pos
@@ -133,13 +139,33 @@

 ;; write minimal one-page tiff

-(defn write-one-page-tiff [pix w h]
-  (let [mmap (open-mmap "test1.tif" 1000000000)]
+(defn write-one-page-tiff [name pix w h]
+  (let [mmap (open-mmap name 1000000000)]
     (write-seq mmap
       (create-header))
     (write-seq mmap
       (create-IFD (get-pos mmap) w h 8 1.0 true))
-    (write-bytes mmap pix)
+    (dorun (repeatedly 500 #(write-bytes mmap pix)))
+    (close-mmap mmap)))
+
+(defn write-multi-page-tiff [name pix w h n]
+  (if (not= (* w h) (count pix))
+    (throw (Exception. "Pixel array doesn't match requested dimensions.")))
+  (let [mmap (open-mmap name 1200000000)]
+    (write-seq mmap
+      (create-header))
+    (doseq [i (range n)]
+      (let [last-image (= i (dec n))
+            pos (get-pos mmap)]
+        ;(println i)
+        (write-seq mmap
+          (create-IFD pos w h 8 1.0 last-image))
+        (write-bytes mmap pix)
+       ; (println "pos:" (get-pos mmap))
+        ))
     (close-mmap mmap)))

-   +(defn big-test []
+  (let [img (rand-byte-image 2560 4320 1)]
+    (time (write-multi-page-tiff "test.tif" img 2560 4320 100))))
+


add some axis and flavor

add some axis and flavor

--- src/cljs/ceres/core.cljs
+++ src/cljs/ceres/core.cljs
@@ -47,7 +47,7 @@
   (-> d3
       .-scale
       (.ordinal)
-      (.domain (vec (range (count data))))
+      (.domain (vec (keys data)))
       (.rangeRoundBands [0 width] 0.5)))

@@ -55,53 +55,76 @@
   (-> d3
       .-scale
       (.linear)
-      (.domain [(apply max data) 0])
+      (.domain [0 (apply max data)])
       (.range [height 0])))

-(defn create-svg [margin width height]
-  (-> d3
-      (.select "#tweets-count")
+(defn create-x-axis [x]
+  (-> d3
+      .-svg
+      (.axis)
+      (.scale x)
+      (.orient "bottom")))
+
+(defn create-y-axis [y]
+  (-> d3
+      .-svg
+      (.axis)
+      (.scale y)
+      (.orient "left")))
+
+
+(defn create-svg [target margin width height]
+  (-> d3
+      (.select target)
       (.append "svg")
       (.attr {:width  (+ width (margin :left) (margin :right))
-              :height (+ height (margin :top) (margin :bottom))})
+              :height (+ height (margin :top) (margin :bottom))
+              :id "tweet-count-chart"})
       (.append "g")
       (.attr {:transform (str "translate(" (margin :left) "," (margin :top) ")")})))

-(defn create-bars [data height width margin]
-  (let [svg (create-svg margin width height)
+(defn create-bars [target data text height width margin]
+  (let [svg (create-svg target margin width height)
         x1 (x data width)
-        y1 (y data height)]
-    (-> svg
-        (.selectAll "g.bar")
-        (.data data)
-        (.enter)
-        (.append "g")
-        (.attr (clj->js {:class "bar"
-                         :transform #(str "translate(" (x1 %2) "," (- height  (y1 (data %2))) ")" )}))
-        (.style {:fill "steelblue"}))))
-
-
-(defn draw-bars [data height width margin]
-  (let [bars (create-bars data height width margin)
+        y1 (y (vals data) height)
+        x-axis (create-x-axis x1)
+        y-axis (create-y-axis y1)]
+    (do
+      (-> svg
+          (.append "g")
+          (.attr {:class "x axis"
+                  :transform (str "translate(0," height ")")})
+          (.call x-axis))
+      (-> svg
+          (.append "g")
+          (.attr {:class "y axis"})
+          (.call y-axis))
+      (-> svg
+          (.selectAll "g.bar")
+          (.data data)
+          (.enter)
+          (.append "g")
+          (.attr (clj->js {:class "bar"
+                           :transform #(str "translate(" (x1 (key %1)) ",0)" )}))
+          (.style {:fill "steelblue"})))))
+
+
+(defn draw-bars [target data text height width margin]
+  (let [bars (create-bars target data text height width margin)
         x1 (x data width)
-        y1 (y data height)]
+        y1 (y (vals data) height)]
     (do
       (-> bars
           (.append "rect")
-          (.attr {:height  #(y1 %)
-                  :width (.rangeBand x1)}))
-      (-> bars
-          (.append "text")
-          (.attr {:x (/ (.rangeBand x1) 2)
-                  :y y1
-                  :dy "-0.35em"
-                  :text-anchor "middle"})
-          (.style "fill" "white")
-          (.text identity)))))
+          (.attr {:height  #(- height  (y1 (val %1)))
+                  :y #(y1 (val %1 ))
+                  :width (.rangeBand x1)})))))

 ;; --- D3 end ---
+
+
 (defsnippet tweet-item "templates/tweet-list.html" [:.tweet-item]
   [tweet owner]
   {[:.tweet-text] (content (:text tweet))
@@ -125,14 +148,8 @@

 (deftemplate stat-screen "templates/stats.html" [app]
-  {[:#selected-stat] (content "Tweets Count")
-   [:#tweets-count] (listen
-                     :on-mount
-                     #(let [data [23 34 99 34 11]
-                            margin {:top 50 :right 50 :bottom 50 :left 50}
-                            width (- (.-clientWidth (. js/document (getElementById "tweets-count"))) (margin :left) (margin :right))
-                            height (- 500  (margin :top) (margin :bottom))]
-                        (draw-bars data height width margin)))})
+  {[:#selected-stat] (content "Tweets Count")})
+

 (deftemplate tweet-list "templates/tweet-list.html" [data owner]
@@ -184,10 +201,19 @@
                          (inc tweet-count)))))

                   :news-frequencies
-                  (om/transact!
-                   app
-                   :news-frequencies
-                   (fn [old] data)))
+                  (do
+                    (om/transact!
+                     app
+                     :news-frequencies
+                     (fn [old] data))
+                    (let [freqs data
+                          text (mapv first data)
+                          margin {:top 50 :right 50 :bottom 50 :left 50}
+                          width (- (.-clientWidth (. js/document (getElementById "tweets-count"))) (margin :left) (margin :right))
+                          height (- 500  (margin :top) (margin :bottom))]
+                      (if (empty? freqs)
+                        nil
+                        (draw-bars "#tweets-count" freqs text height width margin)))))
                 (recur))))))

     om/IRenderState


Experiment more with meta-errors

Experiment more with meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -461,7 +461,7 @@
                          (= e (max p1e p2e)) 3
                          :else 4)))
                 (vec (repeat (count (:errors ind)) 5)))
-              (if (and (:parent1-errors ind) (:parent2-errors ind))
+              #_(if (and (:parent1-errors ind) (:parent2-errors ind))
                 (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
                                              (:errors ind)
                                              (:parent1-errors ind)
@@ -473,6 +473,19 @@
                          (= e (max p1e p2e)) 4
                          :else 3)))
                 (vec (repeat (count (:errors ind)) 5)))
+              (if (and (:parent1-errors ind) (:parent2-errors ind))
+                (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
+                                             (:errors ind)
+                                             (:parent1-errors ind)
+                                             (:parent2-errors ind))]
+                       (cond
+                         (zero? e) 0
+                         (< e (min p1e p2e)) 1
+                         (= e (min p1e p2e)) 3
+                         (< e (max p1e p2e)) 2
+                         (= e (max p1e p2e)) 5
+                         :else 4)))
+                (vec (repeat (count (:errors ind)) 6)))
               ;
               (= cat :error-neglect)
               #_(if (and (:parent1-errors ind) (:parent2-errors ind))


Add full-metadata merging example.

Add full-metadata merging example.

Works between two jvms over the network.

--- src/geschichte/synch.clj
+++ src/geschichte/synch.clj
@@ -1,12 +1,10 @@
 (ns ^:shared geschichte.synch
     "Synching related pub-sub protocols."
-    (:use [geschichte.protocols])
+    (:use [geschichte.meta :refer [update]]
+          [geschichte.protocols])
     (:require [clojure.set :as set]
               [geschichte.platform :refer [put! take-all! client-connect!
                                            start-server!]]))
-
-;; for testing; idempotent, commutative
-(def update merge)

 (defn dispatch
@@ -113,21 +111,49 @@

 ;; start listening for incoming websocket connections
+#_(do (use '[geschichte.repo])
+    (def schema {:type ::schema :version 1})
+    (def repo {:meta
+               {:causal-order
+                {#uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3" #{},
+                 :root #uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3"},
+                :last-update #inst "2013-12-04T23:03:45.465-00:00",
+                :head "master",
+                :public true,
+                :branches {"master" #{#uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3"}},
+                :schema {:version 1, :type "http://github.com/ghubber/geschichte"},
+                :pull-requests {},
+                :id #uuid "22aa0537-6e66-43e4-bda2-2b4211e0e4ec",
+                :description "test repo"},
+               :value
+               {:geschichte.meta/meta
+                {:ts #inst "2013-12-04T23:03:45.465-00:00",
+                 :author "user@mail.com",
+                 :schema {:version 1, :type :geschichte.synch/schema},
+                 :branch "master",
+                 :id #uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3"},
+                :value 42}})
+    (def meta (:meta repo))
+    (def repo-up (commit meta "user@mail.com" schema "master"
+                         (first ((:branches meta) (:head meta))) {:value 43})))
+
 #_(def peer-a (create-peer "127.0.0.1"
                            9090
                            {}
-                           {"user@mail.com" {1 {1 42}}}))
+                           #_{"user@mail.com" {1 {1 42}}}
+                           {"user@mail.com" {(:id meta) meta}}))
 #_(-start peer-a)
 ;; subscribe to remote peer(s) as well
 #_(def peer-b (create-peer "127.0.0.1"
                            9091
-                           {"user@mail.com" {1 #{"127.0.0.1:9090"}} }
-                           {"user@mail.com" {1 {1 42}}}))
+                           {"user@mail.com" {(:id meta) #{"127.0.0.1:9090"}} }
+                           #_{"user@mail.com" {1 {1 42}}}
+                           {"user@mail.com" {(:id meta) meta}}))
 #_(-start peer-b)

 ;; publish and then check for update of meta in subscriptions of other peer

-#_(-publish peer-b "user@mail.com" 1 {1 42 2 43})
+#_(-publish peer-b "user@mail.com" (:id meta) (:meta repo-up))
 #_(-publish peer-a "user@mail.com" 1 {1 42 2 43 3 44})
 #_(-publish peer-b "user@mail.com" 1 {4 45})

@@ -138,6 +164,9 @@

 ;; dumb in memory peer for testing TODO move to tests
+
+;; for testing; idempotent, commutative
+#_(def update merge)

 (declare network)
 (defrecord Peer [state]


Default :nrepl-port to 0 in dev mode [IMMUTANT-372]

--- modules/core/src/main/clojure/immutant/repl.clj
+++ modules/core/src/main/clojure/immutant/repl.clj
@@ -104,7 +104,7 @@
   "Looks for nrepl-port and swank-port values in the given config, and starts
 the appropriate servers."
   [config]
-  (let [port (:nrepl-port config)
+  (let [port (:nrepl-port config (if (util/dev-mode?) 0 nil))
         interface (:nrepl-interface config)]
     (if (or port interface)
       (let [ss (-> (start-nrepl interface


Fix a CUDA vect-math return value bug.

Fix a CUDA vect-math return value bug.

--- src/clojure/uncomplicate/neanderthal/internal/device/cublas.clj
+++ src/clojure/uncomplicate/neanderthal/internal/device/cublas.clj
@@ -565,7 +565,7 @@
                             (.buffer x) (.offset x) (.stride x)
                             (.buffer y) (.offset y) (.stride y)
                             (.buffer z) (.offset z) (.stride z)))))
-   y))
+   z))

 (defn ^:private vector-linear-frac [modl hstream ^CUBlockVector x ^CUBlockVector y
                                     scalea shifta scaleb shiftb ^CUBlockVector z]


Fix lookup implementation

Fix lookup implementation

--- src/hodgepodge/core.cljs
+++ src/hodgepodge/core.cljs
@@ -63,8 +63,11 @@
   ILookup
   (-lookup
     ([^js/Storage s key]
-       (-lookup s key nil))
+       (let [sk (serialize key)]
+         (when (contains-key? s sk)
+           (deserialize (get-item s sk)))))
     ([^js/Storage s key not-found]
-       (if (contains-key? s (serialize key))
-         (deserialize (get-item s (serialize key)))
-         not-found))))
+       (let [sk (serialize key)]
+         (if (contains-key? s sk)
+           (deserialize (get-item s sk))
+           not-found)))))


Update to latest http-kit

Update to latest http-kit

--- modules/http-kit/project.clj
+++ modules/http-kit/project.clj
@@ -1,11 +1,11 @@
 ;; Copyright © 2014 JUXT LTD.

-(defproject juxt.modular/http-kit "0.5.3"
+(defproject juxt.modular/http-kit "0.5.4"
   :description "A modular extension that provides support for http-kit channels"
   :url "https://github.com/juxt/modular/tree/master/modules/http-kit"
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}
-  :dependencies [[http-kit "2.1.16"]
-                 [prismatic/schema "0.2.1"]
+  :dependencies [[http-kit "2.1.18"]
+                 [prismatic/schema "0.2.2"]
                  [juxt.modular/ring "0.5.2"]
                  ])


bind animate class with section, not just drawings

--- frontend/components/landing_b.cljs
+++ frontend/components/landing_b.cljs
@@ -102,10 +102,11 @@
                  [:a {:on-click #(put! controls-ch [:home-scroll-one-clicked])}
                   "Learn more"
                   (common/ico :chevron-down)]]]
-               [:section.home-purpose {:ref "first-fig-visible"}
-                [:div.home-drawings {:class (concat
-                                              (when (:first-fig-animate state) ["animate"])
-                                              (when (:first-fig-visible state) ["visible"]))}
+               [:section.home-purpose {:ref "first-fig-visible"
+                                       :class (concat
+                                                (when (:first-fig-animate state) ["animate"])
+                                                (when (:first-fig-visible state) ["visible"]))}
+                [:div.home-drawings
                  [:figure]
                  [:figure]
                  [:figure


adding main fn

adding main fn

--- resources/leiningen/new/ow_app/src/clj/core.clj
+++ resources/leiningen/new/ow_app/src/clj/core.clj
@@ -1,4 +1,8 @@
-(ns {{name}}.core)
+(ns {{name}}.core
+  (:gen-class))

 (defn hello-clj []
   (println "hello clj"))
+
+(defn -main [& args]
+  (hello-clj))


Bugfix heuristic dictionary generation.

Bugfix heuristic dictionary generation.

--- src/connect5_ai/core.clj
+++ src/connect5_ai/core.clj
@@ -35,7 +35,7 @@
 (defn fill-heuristics-dict
   ""
   []
-  (reduce #(assoc-in %1 [%2] (calc-heuristic %2 :max :min))
+  (reduce #(assoc-in %1 %2 (calc-heuristic %2 :max :min))
           (gen-heuristic-dictionary width-heuristic-calculation)
           (apply clojure.math.combinatorics/cartesian-product
                  (for [_ (range width-heuristic-calculation)] [:min :max :wall :empty]))))


Remove `+max-electrons-in-shell+` from v2 for clarity

--- test/com/nomistech/clojure_the_language/c_900_appy_stuff/s_100_science/ss_atomic_orbitals_v2.clj
+++ test/com/nomistech/clojure_the_language/c_900_appy_stuff/s_100_science/ss_atomic_orbitals_v2.clj
@@ -42,12 +42,6 @@
   (->> +max-orbitals-in-shell+
        (reductions +)))

-(def +max-electrons-in-shell+
-  "For each shell, starting with a notional shell 0 which has no orbitals...
-  the maximum number of electrons in that shell."
-  (map (partial * 2)
-       +max-orbitals-in-shell+))
-
 (def +max-electrons-across-all-shells+
   "For each shell, starting with a notional shell 0 which has no orbitals...
   the maximum number of electrons in total, across this shell and all
@@ -75,8 +69,5 @@
 (fact +max-orbitals-across-all-shells+
   => [0 1 5 9 18 27 43 59])

-(fact +max-electrons-in-shell+
-  => [0 2 8 8 18 18 32 32])
-
 (fact +max-electrons-across-all-shells+
   => [0 2 10 18 36 54 86 118])


[#1077] Render geoloc columns as wkt in the dataset grid

--- backend/src/akvo/lumen/lib/dataset_impl.clj
+++ backend/src/akvo/lumen/lib/dataset_impl.clj
@@ -17,20 +17,30 @@
 (defn create [tenant-conn config jwt-claims body]
   (import/handle-import-request tenant-conn config jwt-claims body))

+(defn column-sort-order
+  "Return this columns sort order (an integer) or nil if the dataset
+  is not sorted by this column"
+  [column]
+  (get column "sort"))
+
 (defn select-data-sql [table-name columns]
-  (let [column-names (map #(get % "columnName") columns)
-        f (fn [m] (get m "sort"))
-        sort-columns (conj
-                      (vec
-                       (for [c (sort-by f (filter f columns))]
-                         (str (get c "columnName") " " (get c "direction"))))
-                      "rnum")
-        order-by-expr (str/join "," sort-columns)
-        sql (format "SELECT %s FROM %s ORDER BY %s"
-                    (str/join "," column-names)
-                    table-name
-                    order-by-expr)]
-    sql))
+  (let [
+        select-expr (->> columns
+                         (map (fn [{:strs [type columnName]}]
+                                (if (= type "geopoint")
+                                  (format "ST_AsText(%s)" columnName)
+                                  columnName)))
+                         (str/join ", "))
+        order-by-expr (as-> columns cols
+                        (filter column-sort-order cols)
+                        (sort-by column-sort-order cols)
+                        (mapv #(format "%s %s" (get % "columnName") (get % "direction")) cols)
+                        (conj cols "rnum")
+                        (str/join ", " cols))]
+    (format "SELECT %s FROM %s ORDER BY %s"
+            select-expr
+            table-name
+            order-by-expr)))

 (defn fetch [conn id]
   (if-let [dataset (dataset-by-id conn {:id id})]


obo/homologous_to ---> RO_0002158

obo/homologous_to ---> RO_0002158

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/ice_to_bio/homologene_rules.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/ice_to_bio/homologene_rules.clj
@@ -5,10 +5,10 @@

 `{:name "homologene-eg-gene-homologous-to"
-  :head ((?/gene1 obo/homologous_to ?/gene2);)
+  :head (;(?/gene1 obo/RO_0002158 ?/gene2);)

          (?/r1 rdf/type owl/Restriction)
-         (?/r1 owl/onProperty obo/homologous_to)
+         (?/r1 owl/onProperty obo/RO_0002158)
          (?/r1 owl/someValuesFrom ?/gene2)

          ;;still need to add a sufficient definition?


Adjusted anchor points for movement on left/right edges w/doppel present

--- desktop/src-common/ds3/ship.clj
+++ desktop/src-common/ds3/ship.clj
@@ -15,6 +15,8 @@
 (def tractor-beam-speed (c/screen-to-world 0.75))
 (def drop-speed (c/screen-to-world 1.1))
 (def default-r2 (c/screen-to-world 1.0))
+(def ship-width (c/screen-to-world 12))
+(def ship-half-width (c/screen-to-world 6))

 (defn create-ship-entity!
   ([screen]
@@ -34,7 +36,7 @@
       (body-position! (cond (= label :ship?)
                             (c/screen-to-world (/ c/game-width 2))
                             :else
-                            (+ (c/screen-to-world 12) (:ship-x screen))) c/ship-y-default 0)
+                            (+ ship-width (:ship-x screen))) c/ship-y-default 0)
       (body! :set-linear-velocity 0 0)))))

 (defn- create-ship-body!
@@ -62,8 +64,8 @@
   (let [ship (assoc (first (filter #(:ship? %) entities)) :has-doppel? true)
         all-others (filter #(nil? (:ship? %)) entities)
         doppel (create-ship-entity! screen :doppel?)]
-    (body-position! ship (- (:x ship) (c/screen-to-world 6)) (:y ship) (:angle ship))
-    (body-position! doppel (+ (:x ship) (c/screen-to-world 6)) (:y ship) (:angle ship))
+    (body-position! ship (- (:x ship) ship-half-width) (:y ship) (:angle ship))
+    (body-position! doppel (+ (:x ship) ship-half-width) (:y ship) (:angle ship))
     (-> all-others
         (conj ship)
         (conj doppel))))
@@ -151,14 +153,14 @@
               :else entity)))
     entity))

-(defn- move [screen entities {:keys [:x :y :angle] :as entity} direction]
+(defn- move [screen entities {:keys [:x :y :angle :has-doppel?] :as entity} direction]
   (let [mv-fn (case direction
                 :right +
                 :left -
                 :straight (fn[x _] x))
         x (mv-fn x speed)
         x-anchored (cond (> x c/game-width-adj) c/game-width-adj
-                         (< x 0) 0
+                         (< x (if has-doppel? (- ship-width) 0)) (if has-doppel? (- ship-width) 0)
                          :else x)
         y-diff (- y c/ship-y-default)
         y-anchored (cond (> y-diff drop-speed) (- y drop-speed)
@@ -166,7 +168,7 @@
         doppel (first (filter #(:doppel? %) entities))]
     (body-position! entity x-anchored y-anchored angle)
     (if doppel
-      (body-position! doppel (+ x-anchored (c/screen-to-world 12)) y-anchored angle))
+      (body-position! doppel (+ x-anchored ship-width) y-anchored angle))
     (update! screen :ship-x x-anchored))
   entity)


この問題ではたまたま影響なかったけど重要なバグ修正

この問題ではたまたま影響なかったけど重要なバグ修正

result:
https://paiza.jp/poh/ando/share/b7c8f4d5


make time transient

make time transient

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/aurora/runtime.cljs
+++ src/aurora/runtime.cljs
@@ -116,7 +116,7 @@
     (aset name->lifetime "ui/style" "transient")
     (aset name->lifetime "ui/event-listener" "transient")

-    (aset name->lifetime "time" "external")))
+    (aset name->lifetime "time" "transient")))

 (defn env []
   (let [kn (knowledge)