Remove game from games when finished

Remove game from games when finished

--- src/clj/ji/service.clj
+++ src/clj/ji/service.clj
@@ -112,6 +112,7 @@
         m {:game-chan game-chan
            :join-chan join-chan}]
     (swap! game-envs assoc game-id m)
+    (go (<! game-chan) (swap! game-envs dissoc game-id))
     m))

 (defn get-game-env!


Update clj-http dependency (only used in tests).

--- profiles.clj
+++ profiles.clj
@@ -2,7 +2,7 @@
  {:global-vars {*warn-on-reflection* false}
   :aliases {"test-all" ["with-profile" "dev,1.9:dev,1.7:dev" "test"]}
   :source-paths ["dev"]
-  :dependencies [[clj-http "3.0.0" :exclusions [org.clojure/tools.reader]]
+  :dependencies [[clj-http "3.4.1" :exclusions [org.clojure/tools.reader]]
                  [aleph "0.4.1" :exclusions [primitive-math io.netty/netty-all]]
                  [org.clojure/tools.namespace "0.2.11"]
                  [ring/ring-core "1.4.0" :exclusions [javax.servlet/servlet-api


Update profiles.clj.

Update profiles.clj.

--- profiles.clj
+++ profiles.clj
@@ -1,5 +1,5 @@
 {:dev
- {:aliases {"test-all" ["with-profile" "dev,1.8:dev,1.6:dev,1.5:dev:dev" "test"]}
+ {:aliases {"test-all" ["with-profile" "dev,1.8:dev,1.6:dev,1.5:dev" "test"]}
   :codeina {:sources ["src"]
             :reader :clojure
             :target "doc/dist/latest/api"


adjust take-adj-poss to match what it used to be in visualization 2. theoretically, this is identical to the old one, but cleaner, and I think i'm going to use it for the blog post

--- src/viz/core.cljs
+++ src/viz/core.cljs
@@ -51,7 +51,7 @@
        :forest (forest/new-forest grid/isometric)
        }
       (set-grid-size)
-      (add-ghost {:start-pos [-2 -2]
+      (add-ghost {:start-pos [-10 -10]
                   :color-fn (fn [state]
                               (let [frames-per-color-cycle
                                     (* (:color-cycle-period state) (:frame-rate state))]
@@ -93,12 +93,15 @@
 (defn- dist-from [pos1 pos2]
   (q/sqrt (dist-from-sqr pos1 pos2)))

-(defn take-adj-poss [adj-poss]
-  (if
-    (or (empty? adj-poss)
-          (< (rand) 0.15)) nil
+(defn take-adj-poss [grid-width pos adj-poss]
+  (let [dist-from-center (dist-from [0 0] pos)
+        width grid-width
+        dist-ratio (/ (- width dist-from-center) width)
+        ]
     (take
-      (max 1 (int (* (rand) (count adj-poss))))
+      (int (* (q/map-range (rand) 0 1 0.75 1)
+              dist-ratio
+              (count adj-poss)))
       adj-poss)))

 (defn- mk-poss-fn [state]
@@ -107,7 +110,7 @@
       (->> adj-poss
            (filter #(in-bounds? grid-size %))
            (sort-by #(dist-from-sqr % [0 0]))
-           (take-adj-poss)))))
+           (take-adj-poss (grid-size 0) pos)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; update


API changed to support both types of dictionary

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -242,29 +242,29 @@
         (clojure.pprint/pprint words)))

 (defn process-wordlist-json
-    [request]
-    (let [search-results (db-interface/read-all-words)
+    [request dictionary-type]
+    (let [search-results (db-interface/read-all-words dictionary-type)
           json-output    (words->json search-results)]
         (-> (http-response/response json-output)
             (http-response/content-type "application/json"))))

 (defn process-wordlist-text
-    [request]
-    (let [search-results (db-interface/read-all-words)
+    [request dictionary-type]
+    (let [search-results (db-interface/read-all-words dictionary-type)
           text-output    (words->text search-results)]
         (-> (http-response/response text-output)
             (http-response/content-type "text/plain"))))

 (defn process-wordlist-xml
-    [request]
-    (let [search-results (db-interface/read-all-words)
+    [request dictionary-type]
+    (let [search-results (db-interface/read-all-words dictionary-type)
           xml-output     (words->xml search-results)]
         (-> (http-response/response xml-output)
             (http-response/content-type "text/xml"))))

 (defn process-wordlist-edn
-    [request]
-    (let [search-results (db-interface/read-all-words)
+    [request dictionary-type]
+    (let [search-results (db-interface/read-all-words dictionary-type)
           edn-output     (words->edn search-results)]
         (-> (http-response/response edn-output)
             (http-response/content-type "application/edn"))))
@@ -316,10 +316,14 @@
             "/users-whitelist"   (process-user-list     request title :whitelist)
             "/users-blacklist"   (process-user-list     request title :blacklist)
             "/user"              (process-user-info     request title)
-            "/wordlist/json"     (process-wordlist-json request)
-            "/wordlist/text"     (process-wordlist-text request)
-            "/wordlist/xml"      (process-wordlist-xml  request)
-            "/wordlist/edn"      (process-wordlist-edn  request)
+            "/whitelist/json"    (process-wordlist-json request :whitelist)
+            "/whitelist/text"    (process-wordlist-text request :whitelist)
+            "/whitelist/xml"     (process-wordlist-xml  request :whitelist)
+            "/whitelist/edn"     (process-wordlist-edn  request :whitelist)
+            "/blacklist/json"    (process-wordlist-json request :blacklist)
+            "/blacklist/text"    (process-wordlist-text request :blacklist)
+            "/blacklist/xml"     (process-wordlist-xml  request :blacklist)
+            "/blacklist/edn"     (process-wordlist-edn  request :blacklist)
             ;"/delete-word"      (process-delete-word   request)
             ;"/undelete-word"    (process-undelete-word request)
             )))


Update dependencies.

Update dependencies.

--- profiles.clj
+++ profiles.clj
@@ -41,7 +41,7 @@
                         "-Xms4g"]
    :main ^:skip-aot bench}]

- :1.9 {:dependencies [[org.clojure/clojure "1.9.0-alpha1"]]}
+ :1.9 {:dependencies [[org.clojure/clojure "1.9.0-alpha4"]]}
  :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]}

  ;; Examples


Remove CIDER compliment hack

Remove CIDER compliment hack

The problem this solves was fixed upstream [1] and the new version [2]
was included in CIDER.

[1]: https://github.com/alexander-yakushev/compliment/commit/8d838dfbedc4b3e6fe23627171f53bfa901ee93d
[2]: https://github.com/alexander-yakushev/compliment/commit/2a22dd537634cfcdd689c0718fd0b132abb0d2fe

--- profiles.clj
+++ profiles.clj
@@ -9,20 +9,7 @@
                         [org.clojure/tools.nrepl "0.2.12"]]

          :plugins [;; REPL-side support for CIDER and other editor tools
-                   [cider/cider-nrepl "0.15.0-SNAPSHOT"]]
-
-         :injections [;; Make a tweak to the internal code used by compliment, the
-                      ;; completion library used by cider-nrepl, to recognize which
-                      ;; symbols could be vars. In particular, change the function
-                      ;; to (constantly true) -- that is, *all* symbols could be
-                      ;; vars. I haven't found any downsides to this (yet), and it
-                      ;; fixes a problem with the regex used by default not
-                      ;; recognizing vars in the '.' namespace.
-                      ;;
-                      ;; Needless to say, this is a hack.
-                      (alter-var-root
-                        #'cider.inlined-deps.compliment.v0v3v1.compliment.sources.ns-mappings/var-symbol?
-                        (constantly (constantly true)))]}
+                   [cider/cider-nrepl "0.15.0-SNAPSHOT"]]}

  :cljs {:dependencies [;; ClojureScript REPL in Emacs
                        [com.cemerick/piggieback "0.2.1"]


Accumulated state now added to get-body.

--- src/plugboard/webfunction/plugboards.clj
+++ src/plugboard/webfunction/plugboards.clj
@@ -74,10 +74,10 @@
     {"Content-Type" ct}
     {}))

-(defn get-body [status request webfn content-type]
+(defn get-body [status state request webfn content-type]
   (if (not (nil? webfn))
     (with-bindings {(var web/*web-context*)
-                    {:status status :request request :meta (meta webfn) :content-type content-type}}
+                    {:status status :state state :request request :meta (meta webfn) :content-type content-type}}
       (webfn))))

 (defn initialize-state [req]
@@ -116,7 +116,7 @@
             content-type (:content-type cf) ; TODO: Add a bit of
                                         ; destructuring here.
             headers (merge (get-in state [:response :headers] (get-headers-from-webfn webfn)))
-            body (get-body status req webfn content-type)]
+            body (get-body status state req webfn content-type)]
         (if (map? body)
           {:status status :headers (merge headers (:headers body)) :body (:body body)}
           {:status status :headers headers :body body}))


CMR-3044: Responsed to PR comments.

CMR-3044: Responsed to PR comments.

--- message-queue-lib/src/cmr/message_queue/queue/sqs.clj
+++ message-queue-lib/src/cmr/message_queue/queue/sqs.clj
@@ -44,6 +44,11 @@
  {:default 20
   :type Long})

+(def queue-arn-attribute
+  "String used by the AWS SQS API to identify the attribute containing a queue's
+  Amazon Resource Name"
+  "QueueArn")
+
 (defn- dead-letter-queue
   "Returns the dead-letter-queue name for a given queue name. The
   given queue name should already be normalized."
@@ -56,7 +61,9 @@
   (str/replace arn #".*:" ""))

 (defn- normalize-queue-name
-  "Replace dots with underscores"
+  "Replace dots with underscores. This is needed because SQS only allows
+  alpha-numeric chars plus dashes and underscores in queue names, while
+  CMR has dots (periods) in queue names."
   [queue-name]
   (str/replace queue-name "." "_"))

@@ -65,11 +72,12 @@
   [sns-client exchange-name]
   (let [exchange-name (normalize-queue-name exchange-name)
         topics (into [] (.getTopics (.listTopics sns-client)))]
-   (some (fn [topic] (let [topic-arn (.getTopicArn topic)
-                           topic-name (arn->name topic-arn)]
-                      (when (= exchange-name topic-name)
-                       topic)))
-         topics)))
+   (some (fn [topic]
+             (let [topic-arn (.getTopicArn topic)
+                   topic-name (arn->name topic-arn)]
+               (when (= exchange-name topic-name)
+                     topic)))
+     topics)))

 (def get-topic
  "Memoized function that returns the Topic with the given display name."
@@ -77,14 +85,15 @@

 (defn- get-queue-arn
   "Get the Amazon Resource Name (ARN) for the given queue.
-   Queue name must be normalized."
+  See http://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html.
+  Queue name must be normalized."
   [sqs-client queue-name]
   (let [q-url (.getQueueUrl (.getQueueUrl sqs-client queue-name))
-        q-attrs (->> (java.util.ArrayList. ["QueueArn"])
+        q-attrs (->> (ArrayList. [queue-arn-attribute])
                      (.getQueueAttributes sqs-client q-url)
                      .getAttributes
                      (into {}))]
-   (get q-attrs "QueueArn")))
+   (get q-attrs queue-arn-attribute)))

 (defn- create-async-handler
   "Creates a thread that will asynchronously pull messages off the queue, pass them to the handler,
@@ -94,26 +103,24 @@
   (let [queue-name (normalize-queue-name queue-name)
         sqs-client (get queue-broker :sqs-client)
         queue-url (.getQueueUrl (.getQueueUrl sqs-client queue-name))
-        rec-req (ReceiveMessageRequest. queue-url)
-        timeout (queue-polling-timeout)]
-    ;; Only take one message at a time form the queue.
+        rec-req (ReceiveMessageRequest. queue-url)]
+    ;; Only take one message at a time from the queue.
     (.setMaxNumberOfMessages rec-req (Integer. 1))
     ;; Tell SQS how long to wait before returning with no data (long polling).
     (.setWaitTimeSeconds rec-req (Integer. (queue-polling-timeout)))
     (a/thread
       (try
         (u/while-let [rec-result (.receiveMessage sqs-client rec-req)]
-          (let [messages (into [] (.getMessages rec-result))]
-            (when-let [msg (first messages)]
-              (let [msg-body (.getBody msg)
-                    msg-content (json/decode msg-body true)]
-                (try
-                  (handler msg-content)
-                  (.deleteMessage sqs-client queue-url (.getReceiptHandle msg))
-                  (catch Throwable e
-                    (error e "Message processing failed for message" (pr-str msg) "on queue" queue-name)))))))
-        (catch Exception e
-          (warn  "Async handler for queue" queue-name "completing."))))))
+          (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))
+                (catch Throwable e
+                  (error e "Message processing failed for message" (pr-str msg) "on queue" queue-name))))))
+        (catch Throwable e
+          (error  e "Async handler for queue" queue-name "completing."))))))

 (defn- create-queue
  "Create a queue and its dead-letter-queue if they don't already exist and connect the two."
@@ -128,7 +135,7 @@
        redrive-policy (str "{\"maxReceiveCount\":\"5\", \"deadLetterTargetArn\": \"" dlq-arn "\"}")
        ;; create the primary queue
        queue-url (.getQueueUrl (.createQueue sqs-client q-name))
-       q-attrs (java.util.HashMap. {"RedrivePolicy" redrive-policy "VisibilityTimeout" "30"})
+       q-attrs (HashMap. {"RedrivePolicy" redrive-policy "VisibilityTimeout" "30"})
        set-queue-attrs-request (doto (SetQueueAttributesRequest.)
                                      (.setAttributes q-attrs)
                                      (.setQueueUrl queue-url))]
@@ -169,7 +176,7 @@
        q-url (.getQueueUrl (.getQueueUrl sqs-client q-name))
        ;; create an access policy to allow the topic to publish to the queue
        access-policy (sns-to-sqs-access-policy sns-client sqs-client queue-name exchange-names)
-       q-attrs (java.util.HashMap. {"Policy" access-policy})
+       q-attrs (HashMap. {"Policy" access-policy})

        ;; create and empty SetQueueAttributesRequest object and then set the attributes on it
        set-queue-attrs-request (doto (SetQueueAttributesRequest.)
@@ -187,7 +194,7 @@
 (defn- normalized-queue-name->original-queue-name
   "Convert a normalized queue name to the original queue name used to create it."
   [queue-broker queue-name]
-  (get (:normalized-queue-names queue-broker) queue-name queue-name))
+  (get-in queue-broker [:normalized-queue-names queue-name] queue-name))

 (defn- -get-queue-url
   "Returns the queue url for the given queue name."
@@ -199,7 +206,8 @@
   (memoize -get-queue-url))

 (defrecord SQSQueueBroker
- [
+  ;; A record containig fields related to accessing SNS/SQS exchanges and queues.
+  [
    ;; Connection to AWS SNS
    sns-client

@@ -210,32 +218,34 @@
    queues

    ;; map of normalized queue names to original queue names - needed for testing with queue broker wrapper
+   ;; See normalize-queue-name for an explanation of normalized queue names.
    normalized-queue-names

    ;; exchanges (topics) known to this broker
    exchanges

    ;; a map of queues to seqeunces of exchange names to which they should be bound
-   bindings]
-
-    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- lifecycle/Lifecycle
+   queues-to-exchanges]
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  lifecycle/Lifecycle

   (start
     [this system]
     (let [sqs-client (AmazonSQSClient.)
           sns-client (AmazonSNSClient.)
-          normalized-queue-names (reduce (fn [m queue-name] (let [nqn (normalize-queue-name queue-name)]
-                                                               (assoc m nqn queue-name)))
+          normalized-queue-names (reduce (fn [m queue-name]
+                                             (let [nqn (normalize-queue-name queue-name)]
+                                               (assoc m nqn queue-name)))
                                          {}
                                          queues)]
       (doseq [queue-name queues]
         (create-queue sqs-client queue-name))
       (doseq [exchange-name exchanges]
         (create-exchange sns-client exchange-name))
-      (doseq [queue (keys bindings)
-              :let [exchanges (get bindings queue)]]
-          (bind-queue-to-exchanges sns-client sqs-client exchanges queue))
+      (doseq [queue (keys queues-to-exchanges)
+              :let [exchanges (get queues-to-exchanges queue)]]
+        (bind-queue-to-exchanges sns-client sqs-client exchanges queue))
       (assoc this :sns-client sns-client :sqs-client sqs-client :normalized-queue-names normalized-queue-names)))

   (stop
@@ -243,7 +253,8 @@
     (.shutdown sns-client)
     (.shutdown sqs-client)
     this)
-    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   queue/Queue

   (publish-to-queue
@@ -259,77 +270,67 @@
           topic (get-topic sns-client exchange-name)
           topic-arn (.getTopicArn topic)
           subs (into [] (.getSubscriptions (.listSubscriptionsByTopic sns-client topic-arn)))]
-      (map (fn [sub] (->> sub
-                          .getEndpoint
-                          arn->name
-                          (normalized-queue-name->original-queue-name this)))
+      (map (fn [sub]
+               (->> sub
+                    .getEndpoint
+                    arn->name
+                    (normalized-queue-name->original-queue-name this)))
            subs)))

   (publish-to-exchange
-     [this exchange-name msg]
-     (let [msg (json/generate-string msg)
-           exchange-name (normalize-queue-name exchange-name)
-           topic (get-topic sns-client exchange-name)
-           topic-arn (.getTopicArn topic)]
+    [this exchange-name msg]
+    (let [msg (json/generate-string msg)
+          exchange-name (normalize-queue-name exchange-name)
+          topic (get-topic sns-client exchange-name)
+          topic-arn (.getTopicArn topic)]
       (.publish sns-client topic-arn msg)))

   (subscribe
-     [this queue-name handler]
-     (let [queue-name (normalize-queue-name queue-name)]
+    [this queue-name handler]
+    (let [queue-name (normalize-queue-name queue-name)]
       (create-async-handler this queue-name handler)))

   (reset
-     [this]
-     (let [sqs-client (:sqs-client this)]
-       (doseq [queue (:queues this)
-               :let [queue-name (normalize-queue-name queue)
-                     dlq-name (dead-letter-queue queue-name)
-                     queue-url (.getQueueUrl (.getQueueUrl sqs-client queue-name))
-                     dlq-url (.getQueueUrl (.getQueueUrl sqs-client dlq-name))
-                     q-purge-req (PurgeQueueRequest. queue-url)
-                     dlq-purge-req (PurgeQueueRequest. dlq-url)]]
-         (.purgeQueue sqs-client q-purge-req)
-         (.purgeQueue sqs-client dlq-purge-req))))
+    [this]
+    (let [sqs-client (:sqs-client this)]
+      (doseq [queue (:queues this)
+              :let [queue-name (normalize-queue-name queue)
+                    dlq-name (dead-letter-queue queue-name)
+                    queue-url (.getQueueUrl (.getQueueUrl sqs-client queue-name))
+                    dlq-url (.getQueueUrl (.getQueueUrl sqs-client dlq-name))
+                    q-purge-req (PurgeQueueRequest. queue-url)
+                    dlq-purge-req (PurgeQueueRequest. dlq-url)]]
+        (.purgeQueue sqs-client q-purge-req)
+        (.purgeQueue sqs-client dlq-purge-req))))

   (health
-     [this]
-     ;; try to get a list of queues and topic (exchanges) to test the connection to SNS/SQS
-     (try
-       (.listQueues sqs-client)
-       (.listTopics sns-client)
-       {:ok? true}
-       (catch Throwable e
-         {:ok? false :msg (.getMessage e)}))))
+    [this]
+    ;; try to get a list of queues and topics (exchanges) to test the connection to SNS/SQS
+    (try
+      (.listQueues sqs-client)
+      (.listTopics sns-client)
+      {:ok? true}
+      (catch Throwable e
+        {:ok? false :msg (.getMessage e)}))))
+
+(record-pretty-printer/enable-record-pretty-printing SQSQueueBroker)

 (defn create-queue-broker
   "Creates a broker that uses SNS/SQS"
   [{:keys [queues exchanges queues-to-exchanges]}]
   (->SQSQueueBroker nil nil queues nil exchanges queues-to-exchanges))

+;; Tests to make sure SNS/SQS is working
 (comment
-  (cmr.system-int-test.utils.ingest-util/create-provider {:provider-guid "provguid1" :provider-id "PROV1"})
-  (normalize-queue-name "cmr_access_control_index.queue")
-
+  ;; create a broker
   (def broker (lifecycle/start (create-queue-broker {}) nil))
+  ;; list the topics for the cmr-ingest_exchange exchange/topic
   (get-topic (:sns-client broker) "cmr_ingest_exchange")
-  (.getTopics (.listTopics (:sns-client broker)))
+  ;; list the queues for the cmr_ingest_exchange
   (queue/get-queues-bound-to-exchange broker "cmr_ingest_exchange")
-  (queue/subscribe broker "cmr-test-queue" (fn [msg] (println "Got Message: " msg)))
-  (queue/publish-to-queue broker "cmr-test-queue" "{\"body\": \"ABC\"}")
-
-  (create-queue broker "index.queue.test")
-
-  (def client (AmazonSQSClient.))
-  (def queue-url (.getQueueUrl (.getQueueUrl client "cmr-index-queue")))
-  (def msg-res (.sendMessage client queue-url "This is a test message"))
-  (str msg-res)
-
-  (def rec-msg (.receiveMessage client queue-url))
-  (str rec-msg)
-  (def messages (.getMessages rec-msg))
-  (def rhandle (.getReceiptHandle (.get messages 0)))
-  (.deleteMessage client queue-url rhandle)
-
-  (def topic-arn "arn:aws:sns:us-east-1:985962406024:cmr-indexer")
-  (def sns-client (AmazonSNSClient.))
-  (.publish sns-client topic-arn "This is a test message."))
+  ;; create a test queue
+  (create-queue (:sqs-client broker) "cmr-test.queue")
+  ;; subscribe to test queue with a simple handler that prints received messages
+  (queue/subscribe broker "cmr-test.queue" (fn [msg] (println "Got Message: " msg)))
+  ;; publish a message to the queue to verify our subscribe worked
+  (queue/publish-to-queue broker "cmr-test.queue" "{\"body\": \"ABC\"}"))


:loading: -> :hammer_and_wrench:

:loading: -> :hammer_and_wrench:

--- src/puppeteer/domain/usecase/message.clj
+++ src/puppeteer/domain/usecase/message.clj
@@ -22,7 +22,7 @@
         :user-id (:user-id message)
         :text ""
         :attachments [(map->Attachment
-                        {:text (str ":loading: Building " user-name "/" repo-name "/" branch-name " ...")})]}
+                        {:text (str ":hammer_and_wrench: Building " user-name "/" repo-name "/" branch-name " ...")})]}
        map->Message
        (r/send-message message-repository)))

@@ -56,7 +56,7 @@
   (->> {:channel-id (:channel-id message)
         :text ""
         :attachments [(map->Attachment
-                        {:text (str ":loading: Deploying " user-name "/" repo-name "/" branch-name " ...")})]}
+                        {:text (str ":hammer_and_wrench: Deploying " user-name "/" repo-name "/" branch-name " ...")})]}
        map->Message
        (r/send-message message-repository)))


Revert "Statistics are calculated from the whole dataset."

This reverts commit 17853bd03eb7e2125b95be3d390c44427541a47d.

--- src/fist/models/db.clj
+++ src/fist/models/db.clj
@@ -90,7 +90,7 @@
                    :player %
                    :stats (stats-fn
                             (:id %)
-                            (time/date-time 2013 1 1)
+                            (time/first-day-of-the-month (time/now))
                             (time/plus (time/last-day-of-the-month (time/now)) (time/days 1)))})
       (get-players))))


CMR-1812: Adding comment on catalog item identifiers for acls.

--- search-app/src/cmr/search/services/acls/granule_acls.clj
+++ search-app/src/cmr/search/services/acls/granule_acls.clj
@@ -219,7 +219,8 @@
 ;; acls match concept functions

 (defn granule-identifier-matches-concept?
-  "Returns true if the granule identifier is nil or it matches the concept."
+  "Returns true if the granule identifier (a field in catalog item identities in ACLs) is nil or it
+  matches the concept."
   [gran-identifier concept]
   (let [{:keys [access-value temporal]} gran-identifier
         umm-temporal (:temporal concept)]
@@ -233,7 +234,8 @@
            true))))

 (defn collection-identifier-matches-concept?
-  "Returns true if the collection identifier is nil or it matches the concept."
+  "Returns true if the collection identifier (a field in catalog item identities in ACLs) is nil or
+  it matches the concept."
   [context coll-identifier concept]
   (if coll-identifier
     (let [collection-concept-id (:collection-concept-id concept)


continuing work on smart errors

continuing work on smart errors

--- sidecar/src/figwheel_sidecar/config_check/type_check.clj
+++ sidecar/src/figwheel_sidecar/config_check/type_check.clj
@@ -515,9 +515,14 @@
           true
           {:Error :wrong-type :alternate-type preferred-type})))))

+#_(which-type-wins? 'RootMap (map first [['FigOpts] ['FigOpts] ['FigOpts] ['FigOpts]]))
+
+#_(analysis-type-matches 'RootMap [['FigOpts] ['FigOpts] ['FigOpts] ['FigOpts]])
+
 (defn limit-analysis-to-type [parent-type analysis]
   (filter #(= (first %) parent-type) analysis))

+#_(frequencies-to-pct (cons 'RootMap (map first [['FigOpts] ['FigOpts] ['FigOpts] ['FigOpts]])))
 ;; XXX
 #_(pp)
 ;; TODO still have to have a diferrent message for whole hog replacement
@@ -670,22 +675,36 @@
   (let [parent-config-value (error-parent-value error)
         analysis            (detailed-config-analysis parent-config-value)
         actual-parent-type? (analysis-type-matches parent-type analysis)]
+    #_(prn root-type actual-parent-type?)
+    #_(pprint/pprint analysis)
+    #_(if (= bad-key :magicl))
     (if (not (true? actual-parent-type?))
-      ;; not parent type we are looking at a misplaced configuration value
+      ;; not parent type we are looking at a misplaced configuration
+      ;; value
+      ;; TODO this is still weak
       [{:Error :wrong-position-for-value
         :current-path (-> error :path rest)
         :expected-type parent-type
         :actual-type (:alternate-type actual-parent-type?)
-        :suggested-path-for-value 'TODO
-        :source-error error}]
+        :correct-paths (get-paths-for-type root-type (:alternate-type actual-parent-type?))}]
       ;; now we can determing if this is most likely a mispelled key
       (if-let [mispelled-key-error (misspelled-key? parent-type parent-config-value bad-key analysis)]
         [mispelled-key-error]
-        ;; then we can check to see if it is a misplaced key
-
-        [])
-
-      )))
+        (if-let [misplaced-key-error
+                 (misplaced-key? root-type
+                                 (get error :orig-config)
+                                 parent-type
+                                 parent-config-value
+                                 bad-key)]
+          [misplaced-key-error]
+          (if-let [misspelled-misplaced-key-error
+                   (misspelled-misplaced-key? root-type
+                                              (get error :orig-config)
+                                              parent-type
+                                              parent-config-value
+                                              bad-key)]
+            [misspelled-misplaced-key-error]
+            []))))))

 #_(pp)

@@ -726,11 +745,10 @@
                   err' (unknown-key-error-helper root-type (first type-sig) key value error)]
               (if (empty? err')
                 [(assoc error :Error (:Error-type error))]
-                (map #(assoc %
-                           :path (:path error)
-                           :value (:value error)
-                           :type-sig (:type-sig error)
-                           :orig-error error) err'))
+                (map #(merge {:path (:path error)
+                              :value (:value error)
+                              :type-sig (:type-sig error)
+                              :orig-error error}  %) err'))
               ))
         errors))

@@ -868,6 +886,9 @@
                   ;; this value
                   ;; this needs to be refactored as we are covering the
                   ;; same ground as above
+                  ;; TODO make this conditional like keyword
+                  ;; predicates
+                  ;; BEFORE keyword predicates
                   (when (and (map? val) (> (count val) 0))
                     (for [[k _ [pt _ val-typ]] (schema-rules :-)
                           :when (and
@@ -916,11 +937,14 @@
     (mapcat (fn [[k v]] (tc-kv k v)) (map vector (range) (seq exp)))))

 (defn tc-analyze [exp]
-  (cond
-    (or (map? exp) (sequence-like? exp))
-    (tc-complex exp)
-    (not (coll? exp))
-    (tc-simple exp)))
+  (distinct
+   (filter
+    not-empty
+    (cond
+      (or (map? exp) (sequence-like? exp))
+      (tc-complex exp)
+      (not (coll? exp))
+      (tc-simple exp)))))

 (defn tc-with-parent [parent-typ exp]
   (let [res (tc-analyze exp)]
@@ -1079,6 +1103,14 @@
    :line " It should be probably be spelled "
    (color (pr-str correction) :green)]
   )
+
+(defmethod error-help-message :wrong-position-for-value
+  [{:keys [key correction correct-paths]}]
+  [:group
+   "The value below "
+   " is most likely in the wrong place in your config."])
+
+#_(pp)
 ;; printing

 (defn print-path [[x & xs] leaf-node edn]
@@ -1137,7 +1169,7 @@
     (error-help-message error)
     :break
     :break
-    [:nest 2
+    [:nest 2
      (print-path (reverse (rest path))
                  leaf-node
                  orig-config)]
@@ -1382,6 +1414,26 @@
                     (document-key (first correct-type) correction))
                    {:width 40}))

+#_{:path (:five),
+   :value 5,
+   :current-path (),
+   :type-sig (RootMap),
+   :suggested-path-for-value [:figwheel],
+   :expected-type RootMap,
+   :actual-type FigOpts,
+   :Error :wrong-position-for-value,
+}
+
+(defmethod print-error :wrong-position-for-value [{:keys [key value correct-paths correct-type orig-error orig-config type-sig] :as error}]
+  (pprint-document (print-wrong-path-error
+                    (assoc error :correction (first (first correct-paths)))
+                    [:group
+                     (format-value value :bold)
+                     [:line " <- "]
+                     (str "^ value is in the wrong place")]
+                    (document-key (first correct-type) (first (first correct-paths))))
+                   {:width 40}))
+
 (defmethod print-error :failed-key-predicate [{:keys [key value orig-error orig-config type-sig path] :as error}]
   (pprint-document (print-path-error error
                                      (format-key-value
@@ -1416,10 +1468,16 @@
     (mapv #(do (print-error (assoc % :orig-config config)) %)
           (type-check root config))))

+
 (defn print-errors-test [config]
   #_(type-check 'RootMap config)
   (mapv #(print-error (assoc % :orig-config config))
         (type-check 'RootMap config)))
+
+(defn print-errors-test-first [config]
+  #_(type-check 'RootMap config)
+  (mapv #(print-error (assoc % :orig-config config))
+        (take 1 (type-check 'RootMap config))))

 (defn pp []
   (with-schema (index-spec
@@ -1462,6 +1520,7 @@
                 (requires-keys 'OtherType :faster)
                 )

+

   #_ (doall  (type-check 'RootMap {:figwheel {:five 6
                                             :string 'asdf
@@ -1470,7 +1529,7 @@
                                             :magicl "asdf"}
                                  :willywonka 4}))

-  (print-errors-test {:figwheel {:five 6
+  #_(print-errors-test {:figwheel {:five 6
                                  :string 'asdf
                                  :boolean 4
                                  :builds {5 5}
@@ -1488,7 +1547,23 @@
                       :magicl "asdf"

                       :willywonka 4})
-
+    (first (type-check 'RootMap {:five 5
+                                 :string "asdf"
+                                 :boolean true
+                                 :builds {"asdf" 5}
+                                 :what [ true ]
+                                 :other { :master 4
+                                          :faster "asdf"}
+                                 :magical "asdf"}))
+    (print-errors-test-first {:five "asdf"
+                              :string "asdf"
+                              :boolean true
+                              :builds {"asdf" 5}
+                              :what [ true]
+                              :other { :master 4
+                                      :faster "asdf"}
+                              :magical "asdf"})
+
   #_(doall (document-key 'FigOpts :other))

     )


master: when doesn't work within doto.

master: when doesn't work within doto.

--- src/gmail_clj/core.clj
+++ src/gmail_clj/core.clj
@@ -165,8 +165,8 @@
     (doto (MimeMessage. session)
           (.setFrom (address (:from msg)))
           (.addRecipient Message$RecipientType/TO (address (:to msg)))
-          ;(when (:bcc msg) (.addRecipient Message$RecipientType/CC (address (:cc msg)))
-          ;(when (:bcc msg) (.addRecipient Message$RecipientType/BCC (address (:bcc msg))))
+          ;(.addRecipient Message$RecipientType/CC (address (:cc msg)))
+          ;(.addRecipient Message$RecipientType/BCC (address (:bcc msg)))
           (.setSubject (:subject msg))
           (.setText (:body msg)))))


signatures

signatures

--- src/imageinfo/core.clj
+++ src/imageinfo/core.clj
@@ -22,15 +22,6 @@
   (.getInt
     (doto (java.nio.ByteBuffer/wrap (byte-array byte-values))
       (.order java.nio.ByteOrder/BIG_ENDIAN))))
-
-(def png-signature
-  [137 80 78 71 13 10 26 10])
-
-(defn recognize-png [])
-
-(defn recognize-jpeg [])
-
-(defn recognize-gif [])

 ;; ===== PNG

@@ -79,15 +70,26 @@

 ;; ===== GIFS

-(def gif-signature '(0x47 0x49 0x46))
-
 ;; close stream??
 (defn read-gif [stream]
   (let [header (read-bytes stream 6)
-        is-gif? (= gif-signature (take 3 header))
         screen-descriptor (read-bytes stream 7)]
     {:width (u16 (first screen-descriptor) (second screen-descriptor))
      :height (u16 (nth screen-descriptor 2) (nth screen-descriptor 3))}))
+
+;; ===== INFO
+
+(def png-signature
+  '(0x89 0x50 0x4e 0x47 0x0D 0x0A 0x1A 0x0A))
+
+(def jpg-signature
+  '(0xff 0xd8))
+
+(def gif-signature
+  '(0x47 0x49 0x46))
+
+(defn info [stream])
+

 ; (defn read-gif-canvas-width [screen-descriptor]
 ;   (println "GETTING WIDT")


changed pred from aiutare to help

changed pred from aiutare to help

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -136,7 +136,7 @@
                         :sem {:pred :increase}}}

    "ayudar" {:synsem {:cat :verb
-                      :sem {:pred :aiutare
+                      :sem {:pred :help
                             :obj {:human true}}}}

    "bailar" {:synsem {:cat :verb


Remove reference to not existent class.

Remove reference to not existent class.

--- src/buddy/auth/middleware.clj
+++ src/buddy/auth/middleware.clj
@@ -17,8 +17,7 @@
             [buddy.auth.accessrules :as accessrules]
             [buddy.auth :refer [authenticated? throw-unauthorized]]
             [ring.util.response :refer [response response?]]
-            [slingshot.slingshot :refer [throw+ try+]])
-  (:import buddy.exceptions.UnauthorizedAccessException))
+            [slingshot.slingshot :refer [throw+ try+]]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Authentication


Don't show the genre for :musiknoten and :taktilesbuch

--- src/catalog/layout/dtbook.clj
+++ src/catalog/layout/dtbook.clj
@@ -21,8 +21,9 @@
       false))

 (defn catalog-entry [{:keys [creator record-id title subtitles name-of-part source-publisher
-                             source-date genre-text description producer-brief rucksackbuch?
-                             rucksackbuch-number library-signature product-number price]}]
+                             source-date genre genre-text description producer-brief
+                             rucksackbuch? rucksackbuch-number
+                             library-signature product-number price]}]
   [:div {:brl:class "ps"}
    [:p {:brl:class "tit"} (wrap creator "" ": " false)
     (->> [(wrap title) (for [s subtitles] (wrap s)) (wrap name-of-part)]
@@ -31,7 +32,9 @@
          (string/join " "))
     " - "
     (wrap source-publisher "" ", " false) (wrap (layout/year source-date))]
-   [:p {:brl:class "gen"} (wrap genre-text "Genre: ")]
+   (when ((set layout/genres) genre)
+     ;; don't show the genre for :musiknoten and :taktilesbuch
+     [:p {:brl:class "gen"} (wrap genre-text "Genre: ")])
    [:p {:brl:class "ann"} (wrap description)]
    (if rucksackbuch?
      [:p {:brl:class "pro"} (wrap producer-brief "" ", " false) (wrap rucksackbuch-number "Rucksackbuch Nr. ")]


Validating vsphere entity

Validating vsphere entity

--- src/celestial/persistency.clj
+++ src/celestial/persistency.clj
@@ -14,6 +14,7 @@
   (:require
     [proxmox.validations :as pv]
     [aws.validations :as av]
+    [vsphere.validations :as vs]
     [taoensso.carmine :as car]
     [cemerick.friend :as friend]
     [celestial.validations :as cv]
@@ -90,9 +91,9 @@
   )

 (def hyp-to-v
-  {:proxmox pv/validate-entity
-   :aws    av/validate-entity
-   })
+  {:proxmox pv/validate-entity
+   :aws av/validate-entity
+   :vsphere vs/validate-entity})

 (defn validate-system
   [system]


Working track builder.

Working track builder.

--- sonic-jam/src/sonic_jam/core.cljs
+++ sonic-jam/src/sonic_jam/core.cljs
@@ -12,6 +12,9 @@

 (defn grids []
   (om/ref-cursor (:grids (om/root-cursor app-state))))
+
+(defn samples []
+  (om/ref-cursor (:samples (om/root-cursor app-state))))

 (defn cell-view [{:keys [cursor id]} _]
   (reify
@@ -58,87 +61,55 @@
                                            :get-state-ch (:get-state-ch state)}]
                             (om/build grid-view id {:state sub-state})))))))))

-(declare track-builder)
-
-(defn play-builder [{:keys [cursor id grid-state]} _]
+(defn track-builder [{:keys [cursor id set-state-ch]} owner]
   (reify
-    om/IRender
-    (render [_]
-      (print "play-builder")
-      (dom/p #js {:style #js {:color "#999"}}
-             (dom/span #js {:onClick #(om/set-state! grid-state :builder-fn track-builder)} "{-")
-             (dom/span nil " play options ")
-             (dom/span nil "}")))))
-
-(defn synth-builder [{:keys [cursor id grid-state]} _]
-  (reify
-    om/IRender
-    (render [_]
-      (print "synth-builder")
-      (dom/p #js {:style #js {:color "#999"}}
-             (dom/span #js {:onClick #(om/set-state! grid-state :builder-fn track-builder)} "{-")
-             (dom/span nil " synth options ")
-             (dom/span nil "}")))))
-
-(defn sample-builder [{:keys [cursor id grid-state]} _]
-  (reify
-    om/IRender
-    (render [_]
-      (print "sample-builder")
-      (dom/p #js {:style #js {:color "#999"}}
-             (dom/span #js {:onClick #(om/set-state! grid-state :builder-fn track-builder)} "{-")
-             (dom/select #js {:onChange #(print "bonk")}
-                         (dom/option nil "0")
-                         (dom/option nil "1"))
-             (dom/span nil "}")))))
-
-(defn type-builder [{:keys [cursor id grid-state]} _]
-  (reify
-    om/IRender
-    (render [_]
-      (print "type-builder")
-      (let [merge-fn #(merge %3 {:builder-fn %1 :builder-type %2})
-            set-type #(om/update-state! grid-state (partial merge-fn %1 %2))]
-        (dom/p #js {:style #js {:color "#999"}}
-               (dom/span #js {:onClick #(om/set-state! grid-state :builder-fn track-builder)} "{-")
-               (dom/span #js {:onClick #(set-type play-builder "play")} " play ")
-               (dom/span #js {:onClick #(set-type synth-builder "synth")} " synth ")
-               (dom/span #js {:onClick #(set-type sample-builder "sample")} " sample ")
-               (dom/span nil "}"))))))
-
-(defn width-builder [{:keys [cursor id grid-state]} _]
-  (reify
-    om/IRender
-    (render [_]
-      (print "width-builder")
-      (let [merge-fn #(merge %2 {:builder-fn type-builder :builder-width %1})
-            set-width #(om/update-state! grid-state (partial merge-fn %))]
-        (dom/p #js {:style #js {:color "#999"}}
-               (dom/span #js {:onClick #(om/set-state! grid-state :builder-fn track-builder)} "{-")
-               (dom/span #js {:onClick #(set-width 1)} " 1 ")
-               (dom/span #js {:onClick #(set-width 2)} " 2 ")
-               (dom/span #js {:onClick #(set-width 4)} " 4 ")
-               (dom/span #js {:onClick #(set-width 8)} " 8 ")
-               (dom/span #js {:onClick #(set-width 16)} " 16 ")
-               (dom/span #js {:onClick #(set-width 32)} " 32 ")
-               (dom/span #js {:onClick #(set-width 64)} " 64 ")
-               (dom/span nil "}"))))))
-
-(defn track-builder [{:keys [cursor id grid-state]} _]
-  (reify
-    om/IRender
-    (render [_]
-      (print "track-builder")
-      (dom/p #js {:style #js {:color "#999"}}
-             (dom/span #js {:onClick #(om/set-state! grid-state :builder-fn width-builder)} "{+}")))))
+    om/IInitState
+    (init-state [_]
+      {:state :init})
+    om/IRenderState
+    (render-state [_ state]
+      (let [p (partial dom/p #js {:style #js {:color "#999"}})
+            transition #(om/update-state! owner (fn [s] (merge s %)))
+            commit #(condp = (:type state)
+                      "sample" (let [track {"type" (:type state)
+                                            "beats" (repeat (:width state) [0])
+                                            "sample" (:sample state)
+                                            "params" {}}
+                                     tracks (clj->js (conj cursor track))]
+                                 (transition {:state :init})
+                                 (om/update! cursor tracks)
+                                 (go (>! set-state-ch id)))
+                      :else (print "cannot commit"))]
+        (condp = (:state state)
+          :init (p (dom/span #js {:onClick #(transition {:state :width})} "{+}"))
+          :width (p (dom/span #js {:onClick #(transition {:state :init})} "{-")
+                    (dom/span #js {:onClick #(transition {:state :type :width 1})} " 1 ")
+                    (dom/span #js {:onClick #(transition {:state :type :width 2})} " 2 ")
+                    (dom/span #js {:onClick #(transition {:state :type :width 4})} " 4 ")
+                    (dom/span #js {:onClick #(transition {:state :type :width 8})} " 8 ")
+                    (dom/span #js {:onClick #(transition {:state :type :width 16})} " 16 ")
+                    (dom/span #js {:onClick #(transition {:state :type :width 32})} " 32 ")
+                    (dom/span #js {:onClick #(transition {:state :type :width 64})} " 64 ")
+                    (dom/span nil "}"))
+          :type (p (dom/span #js {:onClick #(transition {:state :init})} (str "{- " (:width state) " ... "))
+                   (dom/span #js {:onClick #(transition {:state :sample :type "sample"})} " sample ")
+                   (dom/span #js {:onClick #(print "bonk")} " play ")
+                   (dom/span #js {:onClick #(print "bonk")} " synth ")
+                   (dom/span nil "}"))
+          :sample (p (dom/span #js {:onClick #(transition {:state :init})} (str "{- " (:width state) " sample ... "))
+                     (apply dom/select #js {:onChange #(transition {:state :commit :sample (-> % .-target .-value)})}
+                            (map #(dom/option nil %) (om/observe owner (samples)) id))
+                     (dom/span nil "}"))
+          :commit (p (dom/span #js {:onClick #(transition {:state :init})}
+                               (str "{- " (:width state) " sample " (:sample state) " ... "))
+                     (dom/span #js {:onClick commit} " commit? ")
+                     (dom/span nil "}")))))))

 (defn grid-view [id owner]
   (reify
     om/IInitState
     (init-state [_]
-      {:grid-expanded true ;; false
-       :builder-fn track-builder
-       :builder-state {}})
+      {:grid-expanded true}) ;; false
     om/IRenderState
     (render-state [_ state]
       (let [cursor (get (om/observe owner (grids)) id)]
@@ -158,7 +129,9 @@
                                                       (get cursor "tracks")
                                                       (repeat id))]
                                      (om/build-all track-view cursors {:state state})))
-                            (om/build (:builder-fn state) {:cursor cursor :id id :grid-state owner}))))))))
+                            (om/build track-builder {:cursor (get cursor "tracks")
+                                                     :id id
+                                                     :set-state-ch (:set-state-ch state)}))))))))

 (defn app-view [cursor _]
   (reify


Use the same github credentials for test as for development.

--- src/circle/workers/github.clj
+++ src/circle/workers/github.clj
@@ -44,13 +44,17 @@

 ;;; https://github.com/account/applications/4814
 (def development-github {:client_id "586bf699b48f69a09d8c"
+                         :client_secret "1e93bdce2246fd69d9040875338b4137d525e400"})
+(def test-github {:client_id "586bf699b48f69a09d8c"
                    :client_secret "1e93bdce2246fd69d9040875338b4137d525e400"})

 (defn default []
   (cond
    (env/production?) production-github
    (env/staging?) staging-github
-   (env/development?) development-github))
+   (env/development?) development-github
+   (env/test?) test-github))
+

 (defn settings []
   (default))


remove old dep causing compiler errors

remove old dep causing compiler errors

--- src/clj/battlebots/router.clj
+++ src/clj/battlebots/router.clj
@@ -10,8 +10,7 @@
             [battlebots.controllers.players :as players]
             [battlebots.controllers.authenication :as auth]
             [battlebots.views.index :refer [index]]
-            [battlebots.controllers.socket :as ws]
-            [battlebots.utils :refer [in?]]))
+            [battlebots.controllers.socket :as ws]))

 ;;
 ;; Helper functions


add instructional prompt to Indexing, re-alphabetize; fix Wanton Destruction :msg

--- src/clj/game/cards-events.clj
+++ src/clj/game/cards-events.clj
@@ -293,17 +293,19 @@
                                card nil)
                               (unregister-events card))}}}

-   "Indexing"
-   {:effect (effect (run :rd {:replace-access
-                              {:msg "rearrange the top 5 cards of R&D"
-                               :effect (req (doseq [c (take 5 (:deck corp))]
-                                              (move state side c :play-area)))}} card))}
-
    "Independent Thinking"
    (let [cards-to-draw (fn [ts] (* (count ts) (if (not-any? #(has? % :subtype "Directive") ts) 1 2)))]
      {:choices {:max 5 :req #(and (:installed %) (= (:side %) "Runner"))}
       :effect (effect (trash-cards targets) (draw :runner (cards-to-draw targets)))
       :msg (msg "trash " (count targets) " card" (when (not= 1(count targets)) "s") " and draw " (cards-to-draw targets) " cards")})
+
+   "Indexing"
+   {:effect (effect (run :rd {:replace-access
+                              {:msg "rearrange the top 5 cards of R&D"
+                               :effect (req (prompt! state side card
+                                                     (str "Drag cards from the play area back onto R&D") ["OK"] {})
+                                            (doseq [c (take 5 (:deck corp))]
+                                              (move state side c :play-area)))}} card))}

    "Infiltration"
    {:prompt "Gain 2 [Credits] or expose a card?" :choices ["Gain 2 [Credits]" "Expose a card"]
@@ -672,16 +674,14 @@
                                :effect (effect (lose :corp :credit target) (gain :tag 1))}} card))}

    "Wanton Destruction"
-   {:effect (effect
-             (run :hq {:req (req (= target :hq))
-                       :replace-access
-                       {:msg (msg "Wanton Destruction to force the Corp to discard " target
-                                  " cards from HQ at random")
-                        :prompt "How many [Click] do you want to spend?"
-                        :choices (req (map str (range 1 (inc (:click runner)))))
-                        :effect (req (let [n (Integer/parseInt target)]
-                                       (when (pay state :runner card :click n)
-                                         (trash-cards state :corp (take n (shuffle (:hand corp)))))))}} card))}
+   {:effect (effect (run :hq {:req (req (= target :hq))
+                              :replace-access
+                              {:msg (msg "force the Corp to discard " target " cards from HQ at random")
+                               :prompt "How many [Click] do you want to spend?"
+                               :choices (req (map str (range 1 (inc (:click runner)))))
+                               :effect (req (let [n (Integer/parseInt target)]
+                                              (when (pay state :runner card :click n)
+                                                (trash-cards state :corp (take n (shuffle (:hand corp)))))))}} card))}

    "Windfall"
    {:effect (req (shuffle! state :runner :deck)


clean up the format a bit

clean up the format a bit

the ns section was looking a bit odd - e.g. [null :] or [ :]

--- src/clj/runbld/util/debug.clj
+++ src/clj/runbld/util/debug.clj
@@ -38,12 +38,14 @@
                            [(first more) (rest more)]
                            [nil more])]
     (swap! debug-log conj
-           (format "[%s] [%s %s:%s] %s%s"
+           (format "[%s] [%s] %s%s"
                    (f/unparse date-format (t/now))
-                   ns
-                   (:line form-meta "")
-                   (:column form-meta "")
-                   (apply print-str msgs)
+                   (if ns
+                     (format "%s %s:%s"
+                             ns
+                             (:line form-meta "")
+                             (:column form-meta ""))
+                     "")
                    (apply pr-str msgs)
                    (if throwable
                      (str "\n" (with-out-str


Code clean up. Proper use of sequences.

Code clean up. Proper use of sequences.

--- src/cljs/clojuroids/core.cljs
+++ src/cljs/clojuroids/core.cljs
@@ -19,19 +19,16 @@
    :angle 0
    :rot rot})

-(defn update-roid [roid]
-  (let [[vel-x vel-y] (:vel roid)
-        posx (+ (:posx roid) vel-x)
-        posy (+ (:posy roid) vel-y)
+(defn update-object [obj]
+  (let [[vel-x vel-y] (:vel obj)
+        posx (+ (:posx obj) vel-x)
+        posy (+ (:posy obj) vel-y)
         posx (if (< posx -50) (+ width 50) posx)
         posx (if (> posx (+ width 50)) -50 posx)
         posy (if (< posy -50) (+ height 50) posy)
         posy (if (> posy (+ height 50)) -50 posy)
-        rot-angle (bit-and (+ (:angle roid) (:rot roid)) degree-mask)]
-    (assoc roid :posx posx :posy posy :angle rot-angle)))
-
-(defn update-roids [roids]
-  (vec (for [roid roids] (update-roid roid))))
+        rot-angle (bit-and (+ (:angle obj) (:rot obj)) degree-mask)]
+    (assoc obj :posx posx :posy posy :angle rot-angle)))

 (defn draw-points [roid]
   (let [points (:points roid) rot-angle (:angle roid)
@@ -43,31 +40,25 @@
 (defn draw [roid]
   (let [points (draw-points roid) [x y] (first points)]
     (doto ctx (.beginPath) (.moveTo x y))
-    (doall (map (fn [[x y]] (. ctx (lineTo x y))) (rest points)))
+    (dorun (map (fn [[x y]] (. ctx (lineTo x y))) (rest points)))
     (doto ctx (.closePath) (aset "strokeStyle" "#ffffff") (.stroke))))
-
-(defn render-roids [roids]
-  (loop [roids roids]
-    (draw (first roids))
-    (if (not (empty? roids))
-      (recur (rest roids)))))

 (defn request-animation-frame [roids ship]
   (. js/window
      (requestAnimationFrame
       (fn [t]
         (clear-canvas)
-        (render-roids roids)
+        (dorun (map draw roids))
         (draw ship)))))

 (defn render [roids ship]
   (let [input-chan (input/user-input)]
     (go-loop [roids roids ship ship]
       (request-animation-frame roids ship)
-      (let [ship (alt! [input-chan] ([v] (ship/handle-input ship v)) :default ship)]
+      (let [ship (alt! [input-chan] ([v] (ship/handle-input ship v)) :default ship)
+            ship (ship/update-velocity ship)]
         (<! (timeout 33))
-        (recur (update-roids roids)
-               (-> ship (ship/update-velocity) (update-roid)))))))
+        (recur (map update-object roids) (update-object ship))))))

 (defn rotation [min max]
   (let [r1 (range (bit-not (dec max)) (bit-not (dec min)))


Renamed the function 'project-point' to 'P4->P2'

--- src/cljs/drawer/geometry.cljs
+++ src/cljs/drawer/geometry.cljs
@@ -1,5 +1,6 @@
 (ns drawer.geometry
-  (:require [drawer.math :as math]))
+  (:require [drawer.math :as math]
+            [drawer.util :as util]))

 (defn default-obj-connections
   "Returns the default connections
@@ -36,7 +37,7 @@
     [(/ (* px h-dist) fd)
      (/ (* py v-dist) fd)]))

-(defn project-point
+(defn P4->P2
   "Projects a 4D point onto the 2d plain."
   [point camera]
   (-> point
@@ -49,7 +50,7 @@
   [obj :points2d]"
   [obj camera]
   (assoc obj :points2d
-         (mapv #(project-point %1 camera)
+         (mapv #(P4->P2 %1 camera)
                (obj :points))))

 (defn- get-object-part
@@ -140,7 +141,7 @@
   ([camera points connections center speed]
      {:points points
       :connections connections
-      :points2d (mapv #(project-point %1 camera) points)
+      :points2d (mapv #(P4->P2 %1 camera) points)
       :rotation {:active (not (every? zero? speed))
                  :speed speed
                  :center center}}))


Allow the merge conflict to be empty.

Allow the merge conflict to be empty.

--- src/cljx/geschichte/repo.cljx
+++ src/cljx/geschichte/repo.cljx
@@ -95,12 +95,14 @@
 (defn- raw-commit
   "Commits to meta in branch with a value for an ordered set of parents.
    Returns a map with metadata and value+inlined metadata."
-  [{:keys [meta transactions] :as repo} parents author branch]
+  [{:keys [meta transactions] :as repo} parents author branch
+   & {:keys [allow-empty-txs?]
+      :or {allow-empty-txs? false}}]
   (when-not (consistent-causal? (:causal-order meta))
     (throw (ex-info "Causal order does not contain commits of all referenced parents."
                     {:type :inconsistent-causal-order
                      :meta meta})))
-  (when (empty? transactions)
+  (when (and (not allow-empty-txs?) (empty? transactions))
     (throw (ex-info "No transactions to commit."
                      {:type :no-transactions
                       :repo repo
@@ -257,7 +259,8 @@
                                          remote-heads)
            new-causal (merge-ancestors (:causal-order meta) (:cut lcas) (:returnpaths-b lcas))]
        (debug "merging: into " author (:id meta) lcas)
-       (raw-commit (assoc-in repo [:meta :causal-order] new-causal) (vec heads) author branch))))
+       (raw-commit (assoc-in repo [:meta :causal-order] new-causal) (vec heads) author branch
+                   :allow-empty-txs? true))))


Fixed typo and added default setting for result-set-fetch-size

--- src/cmr/oracle/connection.clj
+++ src/cmr/oracle/connection.clj
@@ -1,5 +1,5 @@
 (ns cmr.oracle.connection
- "Contains a record definition that implements the ConcpetStore and Lifecycle protocols
+  "Contains a record definition that implements the ConcpetStore and Lifecycle protocols
   backed by an Oracle database."
   (:require [cmr.common.lifecycle :as lifecycle]
             [cmr.common.log :refer (debug info warn error)]
@@ -62,7 +62,7 @@
    ;; The database pool of connections
    datasource

-   ;; The number of resutls to pull back simultaneously during a query
+   ;; The number of results to pull back simultaneously during a query
    result-set-fetch-size
    ]

@@ -92,5 +92,7 @@

 (defn create-db
   "Creates and returns the database connection pool."
-  [spec result-set-fetch-size]
-  (->OracleStore spec nil result-set-fetch-size))
+  ([spec]
+   (create-db spec 2000))
+  ([spec result-set-fetch-size]
+   (->OracleStore spec nil result-set-fetch-size)))


Stop using --git-dir and --work-tree for 'git fn.

It turns out that git-stash and other shell based git commands don't
honor either the commandline flags (--git-dir/--work-tree) or the
environment variables (GIT_DIR/GIT_WORK_TREE). We now use the :dir
option to c.j.s/sh to change directory.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -27,11 +27,10 @@
   [{:keys [^File gitdir ok-statuses]
     :or {ok-statuses #{0}}} & subcmd]
   ;; We won't handle bare repos or displaced worktrees
-  (let [dir-args (if (nil? gitdir)
+  (let [cmd-args (if (nil? gitdir)
                    []
-                   [(str "--git-dir=" (.getPath gitdir))
-                    (str "--work-tree=" (.getParent gitdir))])
-        all-args (concat dir-args subcmd)
+                   [:dir (.getParent gitdir)])
+        all-args (concat subcmd cmd-args)
         ;; _ (prn :calling (doall (cons 'git all-args)))
         {:keys [exit] :as rtn} (apply sh "git" all-args)
         rtn (assoc rtn :bool (if (zero? (:exit rtn))


Use :voom for dep metadata, not :voom-bump

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -419,7 +419,7 @@
             (partition 2 1 (concat commits [:end]))))))

 (defn fresh-version [[prj ver :as dep]]
-  (let [voom-meta (:voom-bump (meta dep))
+  (let [voom-meta (:voom (meta dep))
         ver-spec (or (:version voom-meta)
                      (re-find #"^[^.]+." ver))
         groups (->> (newest-voom-ver-by-spec prj ver-spec voom-meta)


adjust cache rollover boundary in exemplar generators

--- test/exemplar.clj
+++ test/exemplar.clj
@@ -204,7 +204,7 @@

     (write-exemplar dir "map_10_items" "10 item map"  (map-of-size 10))

-    (doseq [i [10 90 91 92 93 94 95]]
+    (doseq [i [10 1935 1936 1937]]
       (write-exemplar
         dir
         (str "map_" i "_nested")
@@ -262,21 +262,21 @@

     (write-exemplar
       dir
-      "vector_93_keywords_repeated_twice"
-      "Vector of 93 keywords, repeated twice"
-      (vector-of-keywords 93 186))
-
-    (write-exemplar
-      dir
-      "vector_94_keywords_repeated_twice"
-      "Vector of 94 keywords, repeated twice"
-      (vector-of-keywords 94 188))
-
-    (write-exemplar
-      dir
-      "vector_95_keywords_repeated_twice"
-      "Vector of 95 keywords, repeated twice"
-      (vector-of-keywords 95 190))
+      "vector_1935_keywords_repeated_twice"
+      "Vector of 1935 keywords, repeated twice"
+      (vector-of-keywords 1935 3870))
+
+    (write-exemplar
+      dir
+      "vector_1936_keywords_repeated_twice"
+      "Vector of 1936 keywords, repeated twice"
+      (vector-of-keywords 1936 3872))
+
+    (write-exemplar
+      dir
+      "vector_1937_keywords_repeated_twice"
+      "Vector of 1937 keywords, repeated twice"
+      (vector-of-keywords 1937 3874))

     (write-exemplar
       dir


Discretizing layouts

Discretizing layouts

i.e. fitting them to a grid of given resolution.

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/layouts/common.clj
+++ src/conexp/layouts/common.clj
@@ -77,8 +77,8 @@
 (defn- fit-point-to-grid
   "Moves given point [x y] to the next point on the grid given by the
   origin [x_origin y_origin] and the paddings x_pad and y_pad."
-  [[x_origin y_origin] x_pad y_pad [x y]] [(+ x_origin (*
-  x_pad (round (/ (- x x_origin) x_pad)))),
+  [[x_origin y_origin] x_pad y_pad [x y]]
+  [(+ x_origin (* x_pad (round (/ (- x x_origin) x_pad)))),
    (+ y_origin (* y_pad (round (/ (- y y_origin) y_pad))))])

 (defn fit-layout-to-grid
@@ -95,6 +95,18 @@
                                (transient {})
                                (positions layout))))))

+(defn discretize-layout
+  "Adjusts the given layout to fit on a grid of x_cells cells in the x
+  coordinate and y_cells cells in the y coordinate."
+  [layout x_cells y_cells]
+  (assert (< 0 x_cells))
+  (assert (< 0 y_cells))
+  (let [[x_min y_min x_max y_max] (enclosing-rectangle (vals (positions layout))),
+        origin [x_min y_min],
+        x_pad  (/ (- x_max x_min) x_cells),
+        y_pad  (/ (- y_max y_min) y_cells)]
+    (fit-layout-to-grid layout origin x_pad y_pad)))
+
 ;;;

 nil


Create fns for reference interaction

Create fns for reference interaction

--- src/discuss/utils/common.cljs
+++ src/discuss/utils/common.cljs
@@ -32,6 +32,7 @@
                              :csrf       nil
                              :statement  ""
                              :selection  nil
+                             :selected-reference nil
                              :logged-in? false}
                 :clipboard  {:selections nil
                              :current    nil}
@@ -106,6 +107,19 @@
   (get-in @app-state [:user :logged-in?]))

+;;;; State changing
+(defn update-state-item!
+  "Get the cursor for given key and select a field to apply the function to it."
+  [col key f]
+  (om/transact! (get-cursor col) key f))
+
+(defn update-state-map!
+  "Get the cursor for given key and update it with the new collection of data."
+  [key col]
+  (let [state (get-cursor key)]
+    (om/transact! state (fn [] col))))
+
+
 ;;;; References
 (defn get-references
   "Returns a list of references which were received from the discussion system."
@@ -117,19 +131,17 @@
   ([id col]
    (first (filter #(= (str->int id) (:uid %)) col)))
   ([id]
-    (get-reference id (get-references))))
-
-;;;; State changing
-(defn update-state-item!
-  "Get the cursor for given key and select a field to apply the function to it."
-  [col key f]
-  (om/transact! (get-cursor col) key f))
-
-(defn update-state-map!
-  "Get the cursor for given key and update it with the new collection of data."
-  [key col]
-  (let [state (get-cursor key)]
-    (om/transact! state (fn [] col))))
+   (get-reference id (get-references))))
+
+(defn save-selected-reference!
+  "Saves the currently clicked reference for further processing."
+  [ref]
+  (update-state-item! :user :selected-reference (fn [_] ref)))
+
+(defn selected-reference
+  "Returns the currently selected reference."
+  []
+  (get-in @app-state [:user :selected-reference]))

 ;;;; CSRF Token


Don't mangle walletconnect in optimized builds

--- src/district0x/ui/events.cljs
+++ src/district0x/ui/events.cljs
@@ -31,6 +31,7 @@
     [district0x.ui.utils :as d0x-ui-utils :refer [get-window-size to-locale-string current-location-hash namehash file-write]]
     [district0x.ui.web3-fx :as web3-fx.ethereum]
     [district0x.ui.window-fx]
+    [goog.object]
     [goog.string :as gstring]
     [goog.string.format]
     [madvas.re-frame.google-analytics-fx]
@@ -93,8 +94,8 @@
   ;; I've found the persisted connection to be extremely unreliable
   (.removeItem (.-localStorage js/window) "walletconnect")
   ;; https://lwhorton.github.io/2018/10/20/clojurescript-interop-with-javascript.html
-  (let [web3-modal-class (.. js/window -Web3Modal -default)
-        wallet-connect-provider (.. js/window -WalletConnectProvider -default)
+  (let [web3-modal-class (goog.object/get (goog.object/get js/window "Web3Modal") "default")
+        wallet-connect-provider (goog.object/get (goog.object/get js/window "WalletConnectProvider") "default")
         ;; Inspired by https://github.com/Web3Modal/web3modal-vanilla-js-example/blob/master/example.js#L52
         provider-options (clj->js {:walletconnect {:package wallet-connect-provider :options {:infuraId infura-id }}})
         web3-modal-options (clj->js {:cacheProvider false :providerOptions provider-options :disableInjectedProvider false})


add core.logic

add core.logic

--- stuf/project.clj
+++ stuf/project.clj
@@ -5,4 +5,5 @@
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[instaparse "1.4.1"]
                  [org.clojure/clojure "1.7.0"]
+                 [org.clojure/core.logic "0.8.10"]
                  [prismatic/schema "1.0.1"]])


CMR-4247 - Converted nested conditional in-memory db fn to multimethod.

--- metadata-db-app/src/cmr/metadata_db/data/memory_db.clj
+++ metadata-db-app/src/cmr/metadata_db/data/memory_db.clj
@@ -15,47 +15,59 @@
    [cmr.metadata-db.data.providers :as providers]
    [cmr.metadata-db.services.provider-validation :as pv]))

-(defn after-save
-  "Handler for save calls. It will be passed the list of concepts and the concept that was just
-  saved. It should manipulate anything required and return the new list of concepts."
+(defmulti after-save
+  "Handler for save calls. It will be passed the list of concepts and the
+  concept that was just saved. Implementing mehods should manipulate anything
+  required and return the new list of concepts."
+  (fn [db concepts concept]
+    (:concept-type concept)))
+
+(defmethod after-save :collection
   [db concepts concept]
-  (cond (and (= :collection (:concept-type concept))
-             (:deleted concept))
-        (filter #(not= (:concept-id concept) (get-in % [:extra-fields :parent-collection-id]))
-                concepts)
-
-        ;; CMR-2520 Remove this case when asynchronous cascaded deletes are implemented.
-        (and (= :tag (:concept-type concept))
-             (:deleted concept))
-        (let [tag-associations (tag/get-tag-associations-for-tag-tombstone db concept)
-              tombstones (map (fn [ta] (-> ta
-                                           (assoc :metadata "" :deleted true)
-                                           (update :revision-id inc)))
-                              tag-associations)]
-          ;; publish tag-association delete events
-          (doseq [tombstone tombstones]
-            (ingest-events/publish-event
-              (:context db)
-              (ingest-events/concept-delete-event tombstone)))
-          (concat concepts tombstones))
-
-        ;; CMR-2520 Remove this case when asynchronous cascaded deletes are implemented.
-        (and (= :variable (:concept-type concept))
-             (:deleted concept))
-        (let [variable-associations (variable/get-associations-for-variable-tombstone
-                                     db concept)
-              tombstones (map (fn [ta] (-> ta
-                                           (assoc :metadata "" :deleted true)
-                                           (update :revision-id inc)))
-                              variable-associations)]
-          ;; publish variable-association delete events
-          (doseq [tombstone tombstones]
-            (ingest-events/publish-event
-              (:context db)
-              (ingest-events/concept-delete-event tombstone)))
-          (concat concepts tombstones))
-
-        :else concepts))
+  (if-not (:deleted concept)
+    concepts
+    (filter #(not= (:concept-id concept)
+                   (get-in % [:extra-fields :parent-collection-id]))
+            concepts)))
+
+;; CMR-2520 Readdress this case when asynchronous cascaded deletes are implemented.
+(defmethod after-save :tag
+  [db concepts concept]
+  (if-not (:deleted concept)
+    concepts
+    (let [tag-associations (tag/get-tag-associations-for-tag-tombstone db concept)
+          tombstones (map (fn [ta] (-> ta
+                                       (assoc :metadata "" :deleted true)
+                                       (update :revision-id inc)))
+                          tag-associations)]
+      ;; publish tag-association delete events
+      (doseq [tombstone tombstones]
+        (ingest-events/publish-event
+          (:context db)
+          (ingest-events/concept-delete-event tombstone)))
+      (concat concepts tombstones))))
+
+;; CMR-2520 Readdress this case when asynchronous cascaded deletes are implemented.
+(defmethod after-save :variable
+  [db concepts concept]
+  (if-not (:deleted concept)
+    concepts
+    (let [variable-associations (variable/get-associations-for-variable-tombstone
+                                 db concept)
+          tombstones (map (fn [ta] (-> ta
+                                       (assoc :metadata "" :deleted true)
+                                       (update :revision-id inc)))
+                          variable-associations)]
+      ;; publish variable-association delete events
+      (doseq [tombstone tombstones]
+        (ingest-events/publish-event
+          (:context db)
+          (ingest-events/concept-delete-event tombstone)))
+      (concat concepts tombstones))))
+
+(defmethod after-save :default
+  [db concepts concept]
+  concepts)

 (defn- concept->tuple
   "Converts a concept into a concept id revision id tuple"


Insert info about test waive into the database

--- src/emender_jenkins/waive.clj
+++ src/emender_jenkins/waive.clj
@@ -65,5 +65,6 @@
     [request]
         (let [waive-input-data  (read-waive-input-data request)
               parsed-waive-data (parse-waive-data waive-input-data)]
+              (db-interface/insert-test-waive parsed-waive-data)
               parsed-waive-data))


Removing a temporary change in the metadata db test.

--- int_test/cmr/metadata_db/int_test/utility.clj
+++ int_test/cmr/metadata_db/int_test/utility.clj
@@ -19,9 +19,7 @@
 (defn concept
   "Creates a concept to be used for testing."
   []
-  {
-   :concept-id ""
-   :concept-type :collection
+  {:concept-type :collection
    :native-id "provider collection id"
    :provider-id "PROV1"
    :metadata "xml here"
@@ -82,10 +80,10 @@
   [concepts concept-id-revision-ids]
   (if (not= (count concepts) (count concept-id-revision-ids))
     false
-    (every? true?
-            (map (fn [[con-id rev-id]]
+    (every? true?
+            (map (fn [[con-id rev-id]]
                    (some (fn [concept]
-                           (and (= (get concept "concept-id") con-id)
+                           (and (= (get concept "concept-id") con-id)
                                 (= (get concept "revision-id" rev-id))))
                          concepts))
                  concept-id-revision-ids))))
@@ -120,7 +118,7 @@
   tombstone."
   [concept-id & revision-id]
   (let [revision-id (first revision-id)
-        url (if revision-id
+        url (if revision-id
               (format "%s%s/%s" concepts-url concept-id revision-id)
               (format "%s%s" concepts-url concept-id))
         response (client/delete url


Add bottom section

Add bottom section

--- frontend/components/integrations.cljs
+++ frontend/components/integrations.cljs
@@ -167,7 +167,7 @@
                  [:h1 "Deploy to " [:img {:src (utils/cdn-path "img/outer/integrations/heroku-icon.svg") :alt "Heroku"}] " from CircleCI"]
                  [:p "Experience a simple, modern continuous delivery workflow now."]]
                 [:a {:role "button"} "Sign up for CircleCI"]]]]
-             [:div.bottom-section
+             [:div.middle-section
               [:div.bullet
                [:div.content
                 [:h2 "Test before you deploy. Always."]
@@ -197,4 +197,8 @@
                  [:br]
                  [:div {:style {:width "600px" :margin "0 auto"}}
                   [:p "This video shows step-by-step how to configure CircleCI to test your application and deploy to Heroku, and how CircleCI keeps defects from getting into production. "
-                   "See our docs for a " [:a {:href "/docs/"} "followup video"] " showing how to setup a more robust continuous delivery pipeline with staging and prod environments."]]]]]))))
+                   "See our docs for a " [:a {:href "/docs/"} "followup video"] " showing how to setup a more robust continuous delivery pipeline with staging and prod environments."]]]]
+             [:div.bottom-section
+              [:h2 "Ready for world-class" [:br] "continuous delivery?"]
+              [:a {:role "button"} "Sign up for Free"]
+              [:p "Want more information? See our complete" [:br] [:a {:href "/docs/continuous-deployment-with-heroku"} "documentation on deploying to Heroku."]]]]))))


fix(web/project.clj): fix java.lang.NoClassDefFoundError due to missing clj-webdriver dependencies

--- web/project.clj
+++ web/project.clj
@@ -93,6 +93,9 @@
                         [pjstadig/humane-test-output "0.7.0"]
                         [org.clojure/core.cache "0.6.3"]
                         [clj-webdriver/clj-webdriver "0.6.1"]
+                        [org.apache.httpcomponents/httpcore "4.4"]
+                        [org.apache.httpcomponents/httpclient "4.4"]
+                        [org.apache.httpcomponents/httpmime "4.4"]
                         [leiningen "2.5.1"]
                         [figwheel "0.2.5"]
                         [weasel "0.6.0"]


- +(defn any-possible-complement?) : filtering bolts: exclude those for which no complements can be found - use lazy-mapcat to aggregate bolts within (defn lightning-bolts)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -22,6 +22,7 @@
 (declare add-all-comps)
 (declare add-all-comps-with-paths)
 (declare add-complement-to-bolt)
+(declare any-possible-complement?)
 (declare bolt-depth)
 (declare candidate-parents)
 (declare exception)
@@ -97,34 +98,39 @@
         parents (lazy-shuffle (candidate-parents grammar spec))]
     (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
           (when (= false (get-in spec [:head :phrasal] false))
-            (mapfn (fn [parent]
-                     (let [pred (get-in spec [:synsem :sem :pred])
-                           cat (get-in spec [:synsem :cat])
-                           pred-set (if (:pred2lex language-model) (get (:pred2lex language-model) pred))
-                           cat-set (if (:cat2lex language-model) (get (:cat2lex language-model) cat))
-                           subset
-                           (cond
-                             (and (not (= :top pred)) (not (empty? pred-set))
-                                  (not (= :top cat)) (not (empty? cat-set)))
-                             (intersection-with-identity pred-set cat-set)
-                             true (get-lex parent :head (:index language-model)))]
-                       (over/overh parent (lazy-shuffle subset))))
-                   parents))
+            (lazy-mapcat
+             (fn [parent]
+               (let [pred (get-in spec [:synsem :sem :pred])
+                     cat (get-in spec [:synsem :cat])
+                     pred-set (if (:pred2lex language-model) (get (:pred2lex language-model) pred))
+                     cat-set (if (:cat2lex language-model) (get (:cat2lex language-model) cat))
+                     subset
+                     (cond
+                       (and (not (= :top pred)) (not-empty pred-set)
+                            (not (= :top cat)) (not-empty cat-set))
+                       (intersection-with-identity pred-set cat-set)
+                       true (get-lex parent :head (:index language-model)))]
+                 (over/overh parent (lazy-shuffle subset))))
+             parents))
           phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
           (if (and (< total-depth max-total-depth)
                    (= true (get-in spec [:head :phrasal] true)))
-            (mapfn (fn [parent]
-                     (over/overh parent
-                                 (lightning-bolts language-model (get-in parent [:head])
-                                                  (+ 1 depth) (+ 1 total-depth)
-                                                  :max-total-depth max-total-depth)))
-                   parents))]
-      (reduce concat
-              (if (lexemes-before-phrases total-depth max-total-depth)
-                (lazy-cat lexical phrasal)
-                (lazy-cat phrasal lexical))))))
-
-;; TODO: catch exception thrown by add-complement-by-bolt: "could generate neither phrasal nor lexical complements for bolt"
+            (lazy-mapcat (fn [parent]
+                           (over/overh
+                            parent
+                            (lightning-bolts language-model (get-in parent [:head])
+                                             (+ 1 depth) (+ 1 total-depth)
+                                             :max-total-depth max-total-depth)))
+                         parents))]
+        (filter
+         (fn [bolt]
+           (any-possible-complement?
+            bolt [:comp] language-model total-depth
+            :max-total-depth max-total-depth))
+         (if (lexemes-before-phrases total-depth max-total-depth)
+           (lazy-cat lexical phrasal)
+           (lazy-cat phrasal lexical))))))
+
 (defn add-all-comps [bolts language-model total-depth truncate-children max-total-depth]
   "At each point in each bolt in the list of list of bolts,
 _bolt-groups_, add all possible complements at all open nodes in the
@@ -240,6 +246,54 @@
                            (take max-generated-complements
                                  (lazy-cat phrasal-complements lexical-complements))))))))

+;; TODO: was copied from (defn add-complement-to-bolt) and then modified:
+;; refactor both above and below so that commonalities are shared.
+(defn any-possible-complement? [bolt path language-model total-depth
+                                & {:keys [max-total-depth]
+                                   :or {max-total-depth max-total-depth}}]
+  (let [lexicon (or (-> :generate :lexicon language-model)
+                    (:lexicon language-model))
+        spec (get-in bolt path)
+        immediate-parent (get-in bolt (butlast path))
+        complement-candidate-lexemes
+        (if (not (= true (get-in bolt (concat path [:phrasal]))))
+          (let [pred (get-in spec [:synsem :sem :pred])
+                cat (get-in spec [:synsem :cat])
+                pred-set (if (and (:pred2lex language-model)
+                                  (not (= :top pred)))
+                           (get (:pred2lex language-model) pred))
+                cat-set (if (and (:cat2lex language-model)
+                                 (not (= :top cat)))
+                          (get (:cat2lex language-model) cat))
+                subset
+                (cond (empty? pred-set)
+                      cat-set
+                      (empty? cat-set)
+                      pred-set
+                      true
+                      (intersection-with-identity pred-set cat-set))]
+            (if (not (empty? subset))
+              subset
+              (let [index (:index language-model)
+                    indexed (if index (get-lex immediate-parent :comp index))]
+                indexed))))
+        bolt-child-synsem (strip-refs (get-in bolt (concat path [:synsem]) :top))
+        lexical-complements (filter (fn [lexeme]
+                                      (and (not-fail? (unify (strip-refs (get-in lexeme [:synsem] :top))
+                                                             bolt-child-synsem))))
+                                    complement-candidate-lexemes)]
+    (or (not (empty? lexical-complements))
+        (not (empty?
+              (filter #(not-fail? %)
+                      (mapfn (fn [complement]
+                               (unify (strip-refs (get-in bolt [:synsem]))
+                                      (assoc-in {} (concat path [:synsem])
+                                                complement)))
+                             (if (and (> max-total-depth total-depth)
+                                      (= true (get-in spec [:phrasal] true)))
+                               (generate-all spec language-model (+ (count path) total-depth)
+                                             :max-total-depth max-total-depth)))))))))
+
 (defn bolt-depth [bolt]
   (if-let [head (get-in bolt [:head] nil)]
     (+ 1 (bolt-depth head))


more logging for (defn generate-all) to diagnose failures

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -39,6 +39,7 @@
 (declare lightning-bolts)
 (declare not-fail?)

+;; TODO: demote 'depth' and 'max-depth' down to lower level functions
 (defn generate-all [spec model & [depth max-depth]]
   (let [depth (or depth 0)
         truncate truncate
@@ -47,14 +48,14 @@
     (->>
      (lightning-bolts model spec depth max-depth)

-     ;; for each bolt, create a map of complement positions
+     ;; For each bolt, create a map of complement positions
      ;; within the bolt to possible complements for that position
-     (pmap #(assoc
-             (comp-paths-to-complements % model depth max-depth)
-             [] (list %)))
-
-     ;; for each such map in each bolt, find all possible combinations of complements, taking one complement per path.
-     ;; the result is a trellis for each bolt, and a path through this trellis is one complement for each complement position.
+     (pmap (fn [bolt] (assoc
+                       (comp-paths-to-complements bolt model depth max-depth)
+                       [] (list bolt))))
+
+     ;; For each such map:complement-position -> complements, find all possible combinations of complements, taking one complement per position.
+     ;; The result is a trellis for each bolt, and a path through this trellis is a generated expression, with one complement for each complement position.
      (pmap (fn [each-bolt-and-comps]
              (let [paths-to-comps (keys each-bolt-and-comps)
                    vals (vals each-bolt-and-comps)]
@@ -62,22 +63,37 @@
                       (zipmap paths-to-comps each-path-through-trellis))
                     (apply combo/cartesian-product vals)))))

-     (mapcat (fn [bolt-group]
-               (->> bolt-group
-                    (map (fn [bolt-and-comps]
-                           (let [bolt (get bolt-and-comps [])
-                                 paths-and-comps (dissoc bolt-and-comps [])
-                                 paths-to-comps (keys paths-and-comps)]
-                             (apply unify
-                                    (cons bolt
-                                          (map (fn [path-to-comp]
-                                                 (let [complement (get paths-and-comps path-to-comp)
-                                                       result (assoc-in bolt path-to-comp complement)]
-                                                    (if (= true truncate)
-                                                      (dissoc-paths result [path-to-comp])
-                                                      result)))
-                                               paths-to-comps)))))))))
-     (map #(do-defaults % model))
+     ;; for each such path through each such trellis, unify the bolt with all of its complements to create a final expression tree.
+     (mapcat (fn [bolt-groups] ;; TODO: explain what a 'bolt group' is: (a map from complement positions to a complement for each such position)
+               (map (fn [bolt-and-comps]
+                      (let [bolt (get bolt-and-comps [])
+                            paths-and-comps (dissoc bolt-and-comps [])
+                            paths-to-comps (keys paths-and-comps)]
+                        (log/debug (str "generate-all paths: " (clojure.string/join "," paths-to-comps)))
+                        (log/debug (str "generate-all vals: " (clojure.string/join "," (map #((:morph model) %) (vals paths-and-comps)))))
+                        (let [result
+                              (reduce (fn [a b]
+                                        (let [result (unify a b)]
+                                          (when (and (not (= :fail a)) (not (= :fail b)))
+                                            (if (= :fail result)
+                                              (log/debug (str "unify(" ((:morph-ps model) a) "," ((:morph-ps model) b) ") => fail@"
+                                                              (fail-path a b)))
+                                              (log/debug (str "unify(" ((:morph-ps model) a) "," ((:morph-ps model) b) ") => "
+                                                              ((:morph-ps model) result)))))
+                                          result))
+                                      (cons bolt
+                                            (map (fn [path-to-comp]
+                                                   (let [complement (get paths-and-comps path-to-comp)
+                                                         result (assoc-in bolt path-to-comp complement)]
+                                                     (if (= true truncate)
+                                                       (dissoc-paths result [path-to-comp])
+                                                       result)))
+                                                 paths-to-comps)))]
+                          (log/debug (str "generate-all: result: " ((:morph model) result)))
+                          result)))
+                    bolt-groups)))
+     (map #(do-defaults % model)) ;; for each tree, run model defaults.
+     ;; TODO: move truncate here
      (remove #(= :fail %)))))

 (defn generate


fix spacing between inducer labels

fix spacing between inducer labels

--- src/bract/core/echo.clj
+++ src/bract/core/echo.clj
@@ -28,8 +28,8 @@
   `(let [new-hy# (conj *inducer-hierarchy* (util/shorten-name ~inducer-name))]
      (binding [*inducer-hierarchy* new-hy#
                *inducer-prefix*    (->> new-hy#
-                                     (map #(format "[%s]" %))
-                                     (string/join \space))]
+                                     (map #(format "[%s] " %))
+                                     (string/join ""))]
        ~@body)))


SQUASHME rparen too many

SQUASHME rparen too many

--- src/grimoire/api/web/read.clj
+++ src/grimoire/api/web/read.clj
@@ -53,7 +53,7 @@
   (do-thing-req "versions" ->Version artifact-thing))

 (defmethod api/list-namespaces :web [config version-thing]
-  (do-thing-req "namespaces" ->Ns version-thing)))
+  (do-thing-req "namespaces" ->Ns version-thing))

 (defmethod api/list-defs :web [config namespace-thing]
   (do-thing-req "all" ->Def namespace-thing))


add CORS

add CORS

--- src/pathfinder/web.clj
+++ src/pathfinder/web.clj
@@ -4,7 +4,7 @@
             [compojure.core :refer :all]
             [compojure.route :as route]
             [compojure.handler :as handler]
-            [ring.util.response :refer [response]]
+            [ring.util.response :refer [response header]]
             [ring.middleware.json :as json-m]
             [ring.adapter.jetty :as j]

@@ -22,11 +22,20 @@
   (GET "/" [] (last-n nil))
   (route/not-found {:error "not found"}))

+(defn wrap-cors
+  [handler]
+  (fn [req]
+    (->
+     req
+     handler
+     (header "Access-Control-Allow-Origin" "*"))))
+
 (def app
   (->
    (handler/site app-routes)
    json-m/wrap-json-response
-   json-m/wrap-json-params))
+   json-m/wrap-json-params
+   wrap-cors))

 (defn main-handler
   [req]


Update key: event-time

Update key: event-time

--- src/photon/streams.clj
+++ src/photon/streams.clj
@@ -271,7 +271,7 @@
                         (long server-timestamp))
         new-msg (assoc! msg :server-timestamp
                         new-timestamp)
-        new-msg (assoc! new-msg :photon-timestamp
+        new-msg (assoc! new-msg :event-time
                         now)
         new-msg (assoc! new-msg :order-id
                         (+ (* 1000 new-timestamp)


some experiments cleanup

some experiments cleanup

--- internal/machina/src/samsara/machina/core.clj
+++ internal/machina/src/samsara/machina/core.clj
@@ -9,21 +9,28 @@

-(defn empty-machine
-  "defines a empty state machine which only goes from start->stop"
-  []
-  {:state :machina/start
-
-   :transitions {:machina/start [:machina/no-op :machina/stop]}})
-
-
-
-(defn configure-machine [sm fns]
-  (-> sm
-      ;; turn the list of states and transitions into a map
-      (update :transitions (fn [ts]
-                             (->> (map (fn [[s0 t s1]] [s0 [t s1]]) ts)
-                                  (into {}))))))
+(defn write-to-file [f]
+  (spit f
+        (str (java.util.Date.) \newline)
+        :append true))
+
+
+(comment
+  (defn empty-machine
+    "defines a empty state machine which only goes from start->stop"
+    []
+    {:state :machina/start
+
+     :transitions {:machina/start [:machina/no-op :machina/stop]}})
+
+
+
+  (defn configure-machine [sm fns]
+    (-> sm
+        ;; turn the list of states and transitions into a map
+        (update :transitions (fn [ts]
+                               (->> (map (fn [[s0 t s1]] [s0 [t s1]]) ts)
+                                    (into {})))))))

 ;;(configure-machine (empty-machine))
@@ -32,7 +39,7 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                                                                            ;;
-;;                        ---==| C O U N T E R |==----                        ;;
+;;                  ---==| F I R S T   A T T E M P T |==----                  ;;
 ;;                                                                            ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -131,9 +138,9 @@

   (comment
-    (play sm)
+    (transition sm)
     (->> sm
-         (iterate play)
+         (iterate transition)
          (take-while #(not= :machina/stop (:state %)))
          #_(map :data)
          last
@@ -158,11 +165,7 @@
               :on-failure (constantly :sleep)}

-      :write-to-file {:fn*        (do! (fn [f]
-                                         (println "write?")
-                                         (spit f
-                                               (str (java.util.Date.) \newline)
-                                               :append true)))
+      :write-to-file {:fn*        (do! write-to-file)

                       :on-success (fn [sm] (println "OK")   (clojure.pprint/pprint sm) :sleep)
                       :on-failure (fn [sm] (println "FAIL") (clojure.pprint/pprint sm) :sleep)}}})
@@ -196,80 +199,93 @@
 ;;                                                                            ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-
-
-;; write to file example
-(def sm
-  {:state :machina/start
-   :data   nil
-   :transitions
-   {:machina/start {:fn*        (constantly "/tmp/1/2/3/4/5/file.txt")
-                    :on-success (constantly :write-to-file)
-                    :on-failure (constantly :machina/stop)}
-
-
-    :sleep {:fn*        (do! (fn [_] (Thread/sleep 1000)))
-            :on-success (constantly :write-to-file)
-            :on-failure (constantly :sleep)}
-
-
-    :write-to-file {:fn*        (do! (fn [f]
-                                       (println "write?")
-                                       (spit f
-                                             (str (java.util.Date.) \newline)
-                                             :append true)))
-
-                    :on-success (fn [sm] (println "OK")   (clojure.pprint/pprint sm) :sleep)
-                    :on-failure (fn [sm] (println "FAIL") (clojure.pprint/pprint sm) :sleep)}}})
-
-
-;;
-;; Most generic approach
-;; but not much re-use.
-;;
-(defmulti transition :state)
-
-(defmethod transition :machina/stop
-  [sm]
-  sm)
-
-
-(defmethod transition :machina/start
-  [sm]
-  (assoc sm
-         :data "/tmp/1/2/3/4/5/file.txt"
-         :state :write-to-file))
-
-
-(defmethod transition :write-to-file
-  [{f :data :as sm}]
-  (try
-    (spit f
-          (str (java.util.Date.) \newline)
-          :append true)
-    (assoc sm :state :sleep)
-    (catch Exception x
-      (assoc sm :state :sleep))))
-
-
-(defmethod transition :sleep
-  [sm]
-  (Thread/sleep 1000)
-  (assoc sm :state :write-to-file))
-
-(comment
-
-  (-> sm
-      transition
-      transition
-      transition
-      )
-
-  (->> sm
-       (iterate transition)
-       (take-while #(not= :machine/stop (:state %)))
-       (last))
-
-
-
-  )
+(comment
+
+  ;; write to file example
+  (def sm
+    {:state :machina/start
+     :data   nil
+     :transitions
+     {:machina/start {:fn*        (constantly "/tmp/1/2/3/4/5/file.txt")
+                      :on-success (constantly :write-to-file)
+                      :on-failure (constantly :machina/stop)}
+
+
+      :sleep {:fn*        (do! (fn [_] (Thread/sleep 1000)))
+              :on-success (constantly :write-to-file)
+              :on-failure (constantly :sleep)}
+
+
+      :write-to-file {:fn*        (do! write-to-file)
+
+                      :on-success (fn [sm] (println "OK")   (clojure.pprint/pprint sm) :sleep)
+                      :on-failure (fn [sm] (println "FAIL") (clojure.pprint/pprint sm) :sleep)}}})
+
+
+  ;;
+  ;; Most generic approach
+  ;; but not much re-use.
+  ;; also hard to make cross-cutting concerns
+  ;; like a function which displays all
+  ;; the state transitions or even
+  ;; measure the time spent in each state.
+  ;;
+  (defmulti transition :state)
+
+  (defmethod transition :machina/stop
+    [sm]
+    sm)
+
+
+  (defmethod transition :machina/start
+    [sm]
+    (assoc sm
+           :data "/tmp/1/2/3/4/5/file.txt"
+           :state :write-to-file))
+
+
+  (defmethod transition :write-to-file
+    [{f :data :as sm}]
+    (try
+      (write-to-file f)
+      (assoc sm :state :sleep)
+      (catch Exception x
+        (assoc sm :state :sleep))))
+
+
+  (defmethod transition :sleep
+    [sm]
+    (Thread/sleep 1000)
+    (assoc sm :state :write-to-file))
+
+  (comment
+
+    (-> sm
+        transition
+        transition
+        transition
+        )
+
+    (->> sm
+         (iterate transition)
+         (take-while #(not= :machine/stop (:state %)))
+         (last))
+
+
+
+    ))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                                                                            ;;
+;;                 ---==| F O U R T H   A T T E M P T |==----                 ;;
+;;                                                                            ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; this time i'm going to use the same basic and generic idea of
+;; a f(stm) -> stm' but without the multi-method dispatch
+;; so that it is possible to add wrappers/filters style functions
+;; which handle cross/cutting concerns.
+;;


Kaikki propertiesit yhteen tiedostoon

Kaikki propertiesit yhteen tiedostoon

--- mtg-pairings-server/src/mtg_pairings_server/server.clj
+++ mtg-pairings-server/src/mtg_pairings_server/server.clj
@@ -25,7 +25,7 @@
       (c/context "/player" [] player-routes))))

 (defn run! []
-  (let [db-properties (edn/read-string (slurp "db.properties"))
+  (let [{db-properties :db, server-properties :server} (edn/read-string (slurp "properties.edn"))
         db (create-korma-db db-properties)
         stop-fn (hs/run-server
                   (-> (routes)
@@ -33,7 +33,7 @@
                     wrap-session
                     wrap-json-response
                     (wrap-json-body {:keywords? true}))
-                  {:port 8080})]
+                  server-properties)]
     (json-gen/add-encoder org.joda.time.LocalDate
       (fn [c generator]
         (.writeString generator (str c))))


add memoization to list-top-projects

add memoization to list-top-projects

--- src/clj/hsm/actions.clj
+++ src/clj/hsm/actions.clj
@@ -1,5 +1,6 @@
 (ns hsm.actions
   (:require
+    [clojure.core.memoize :as memo]
     [clojure.tools.logging :as log]
     [schema.core :as s]
     [clojurewerkz.cassaforte.cql  :as cql]
@@ -235,7 +236,7 @@
   [dict]
   (assoc dict :id (str (:id dict))))

-(defn list-top-proj
+(defn list-top-proj*
   "Given platform/language returns top n projects"
   [db platform limit-by]
   (let [conn (:connection db)
@@ -246,6 +247,8 @@
         stringify-id
         (take limit-by (reverse
                           (sort-by :watchers projects)))))))
+
+(def list-top-proj (memo/ttl list-top-proj* :ttl/threshold 60000 ))

 (defn load-project
   [db proj]


refactored describe macro

refactored describe macro

--- src/clj/speclj/core.clj
+++ src/clj/speclj/core.clj
@@ -3,7 +3,7 @@
   in both Clojure and ClojureScript."
   (:require [clojure.data]))

-(defn- cljs? []
+(defn cljs? []
   (boolean (find-ns 'cljs.analyzer)))

 (defmacro it
@@ -34,7 +34,9 @@
      (binding [speclj.config/*parent-description* description#]
        (doseq [component# (list ~@components)]
          (speclj.components/install component# description#)))
-     (when-not-bound speclj.config/*parent-description*
+       (when-not ~(if (not (cljs?))
+                    `(bound? #'speclj.config/*parent-description*)
+                    `speclj.config/*parent-description*)
        (speclj.running/submit-description (speclj.config/active-runner) description#))
      description#))


Don't show traceback if index already exists

--- src/clj/subman/core.clj
+++ src/clj/subman/core.clj
@@ -30,7 +30,7 @@
   [& args]
   (models/connect!)
   (try (models/create-index)
-    (catch Exception e (println e)))
+    (catch Exception e))
   (models/update-total-count)
   (future (init-pool))
   (let [port (Integer/parseInt


Chris - refactor code to use the tread last macro for readability

--- src/clj_cctray/core.clj
+++ src/clj_cctray/core.clj
@@ -32,7 +32,8 @@
   (parse-options options all-post-processors))

 (defn get-projects [url & {:keys [options]}]
-  (apply-processors (post-processors options)
-                   (map (partial apply-processors (project-processors options))
-                        (apply-processors (pre-processors options)
-                                         (parser/get-projects url)))))
+  (->>
+    (parser/get-projects url)
+    (apply-processors (pre-processors options))
+    (map (partial apply-processors (project-processors options)))
+    (apply-processors (post-processors options))))


Fix conditional that broke with-graphics for clj.

--- src/cljc/quil/core.cljc
+++ src/cljc/quil/core.cljc
@@ -4588,9 +4588,9 @@
   [graphics & body]
   `(let [gr# ~graphics]
      (binding [quil.core/*graphics* gr#]
-       #?@(:clj (.beginDraw gr#))
+       #?(:clj (.beginDraw gr#))
        ~@body
-       #?@(:clj (.endDraw gr#)))))
+       #?(:clj (.endDraw gr#)))))

 (defn ^{:requires-bindings false
         :category "Environment"


Fixed CLJS and changed the name.

Fixed CLJS and changed the name.

--- src/cljc/quil/core.cljc
+++ src/cljc/quil/core.cljc
@@ -1873,11 +1873,12 @@
     :category "Environment"
     :subcategory nil
     :added "2.7.2"}
-  is-looping
+  looping?
   "Returns whether the sketch is looping."
   []
   #?(:clj (.isLooping (ap/current-applet))
-     :cljs (.-__isLooping (ap/current-applet))))
+     :cljs @(:looping? (meta (qa/current-applet)))
+     ))

 (defn