CLJS-702: warn if protocol signature doesn't matched declared

check that protocol implementation method signatures are not repeated
and actually match

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -795,6 +795,24 @@
               (add-proto-methods* pprefix type type-sym sig)))
           sigs)))))

+(defn validate-impl-sigs [env p method]
+  (when-not (= p 'Object)
+    (let [var (ana/resolve-var (dissoc env :locals) p)
+          minfo (-> var :protocol-info :methods)
+          [fname sigs] (if (core/vector? (second method))
+                         [(first method) [(second method)]]
+                         [(first method) (map first (rest method))])
+          decmeths (core/get minfo fname)]
+      (loop [sigs sigs seen #{}]
+        (when (seq sigs)
+          (let [sig (first sigs)
+                c   (count sig)]
+            (when (contains? seen c)
+              (ana/warning :protocol-duped-method env {:protocol p :fname fname}))
+            (when-not (some #{c} (map count decmeths))
+              (ana/warning :protocol-invalid-method env {:protocol p :fname fname}))
+            (recur (next sigs) (conj seen c))))))))
+
 (defn validate-impls [env impls]
   (loop [protos #{} impls impls]
     (when (seq impls)
@@ -803,6 +821,8 @@
             impls   (drop-while seq? (next impls))]
         (when (contains? protos proto)
           (ana/warning :protocol-multiple-impls env {:protocol proto}))
+        (core/doseq [method methods]
+          (validate-impl-sigs env proto method))
         (recur (conj protos proto) impls)))))

 (defmacro extend-type [type-sym & impls]


another attempt at refresh of recurring credits on hosted cards

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1435,8 +1435,14 @@
                            :zone '(:onhost) ;; hosted cards should not be in :discard or :hand etc
                            :previous-zone (:zone target))]
        (update! state side (update-in card [:hosted] #(conj % c)))
+       (when-let [events (:events (card-def target))]
+         (register-events state side events c))
        (when (and installed (:recurring (card-def c)))
          (card-init state side c false))
+       (when-let [events (:events (card-def target))]
+         (when (and installed (:recurring (card-def c)))
+           (unregister-events state side target)
+           (register-events state side events c)))
        c))))

 (defn is-tagged? [state]


add google urchin id

add google urchin id


Add creds

Add creds

--- src/clj/sbsk/core.clj
+++ src/clj/sbsk/core.clj
@@ -94,7 +94,8 @@
         input-stream (java.io.ByteArrayInputStream. some-bytes)
         key-name (apply str data-name-parts)]
     (println "-" key-name (count some-bytes))
-    (s3/put-object :bucket-name bucket-full-name
+    (s3/put-object creds
+                   :bucket-name bucket-full-name
                    :key key-name
                    :input-stream input-stream
                    :metadata {:content-length (count some-bytes)}


automatically determine multipart type by class

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -1,13 +1,17 @@
 (ns clj-http.core
   "Core HTTP request/response implementation."
   (:require [clojure.pprint])
-  (:import (java.net URI)
+  (:import (java.io File InputStream)
+           (java.net URI)
            (org.apache.http HttpRequest HttpEntityEnclosingRequest
                             HttpResponse Header HttpHost)
            (org.apache.http.util EntityUtils)
            (org.apache.http.entity ByteArrayEntity)
            (org.apache.http.entity.mime MultipartEntity)
-           (org.apache.http.entity.mime.content ByteArrayBody)
+           (org.apache.http.entity.mime.content ByteArrayBody
+                                                FileBody
+                                                InputStreamBody
+                                                StringBody)
            (org.apache.http.client HttpClient)
            (org.apache.http.client.methods HttpGet HttpHead HttpPut
                                            HttpPost HttpDelete
@@ -49,6 +53,29 @@
   (if insecure?
     (SingleClientConnManager. insecure-scheme-registry)
     (SingleClientConnManager.)))
+
+(defn- create-multipart-entity
+  "Takes a multipart map and creates a MultipartEntity with each key/val pair
+   added as a part, determining part type by the val type."
+  [multipart]
+  (let [mp-entity (MultipartEntity.)]
+    (doseq [[k v] multipart]
+      (let [klass (type v)
+            filename (name k)
+            part (cond
+                  (= klass File)
+                  (FileBody. v filename)
+
+                  (= klass InputStream)
+                  (InputStreamBody. v filename)
+
+                  (= klass (type (byte-array 0)))
+                  (ByteArrayBody. v filename)
+
+                  (= klass String)
+                  (StringBody. v))]
+        (.addPart mp-entity filename part)))
+    mp-entity))

 (defn request
   "Executes the HTTP request corresponding to the given Ring request map and
@@ -98,7 +125,8 @@
           (let [mp-entity (MultipartEntity.)]
             (doseq [[k v] multipart]
               (.addPart mp-entity (name k) (ByteArrayBody. v (name k))))
-            (.setEntity #^HttpEntityEnclosingRequest http-req mp-entity))
+            (.setEntity #^HttpEntityEnclosingRequest http-req
+                        (create-multipart-entity multipart)))
           (when body
             (let [http-body (ByteArrayEntity. body)]
               (.setEntity #^HttpEntityEnclosingRequest http-req http-body))))


Modify wrap-log-exceptions to log Throwables.

Also simplify error logging.

--- src/incise/server.clj
+++ src/incise/server.clj
@@ -23,11 +23,8 @@
   (fn [& args]
     (try
       (apply func args)
-      (catch Exception e
-        (let [cause-trace (with-out-str (print-cause-trace e))]
-         (if bubble
-           (error cause-trace)
-           (fatal cause-trace)))
+      (catch Throwable e
+        (error (with-out-str (print-cause-trace e)))
         (when bubble (throw e))))))

 (defn create-app


No need for build-message-buf

No need for build-message-buf

--- src/onyx/messaging/protocol_netty.clj
+++ src/onyx/messaging/protocol_netty.clj
@@ -133,14 +133,6 @@
    :messages (let [message-count (.readInt buf)]
                (doall (repeatedly message-count #(read-message-buf decompress-f buf))))})

-(defn build-msg-buf [msg]
-  (let [t ^byte (:type msg)]
-    (cond
-      (= t messages-type-id) (build-messages-msg-buf (:messages msg))
-      (= t ack-type-id) (build-ack-msg-buf (:id msg) (:completion-id msg) (:ack-val msg))
-      (= t completion-type-id) (build-completion-msg-buf (:id msg))
-      (= t retry-type-id) (build-retry-msg-buf (:id msg)))))
-
 (defn read-buf [decompress-f ^ByteBuf buf]
   (let [msg-type ^byte (.readByte buf)]
     (cond (= msg-type messages-type-id)


(PDB-4636) core/main: support custom exit status/message via throw

Exit with final messages and a custom exit status whenever an ex-info
exception with a :kind of core/exit is thrown.  The :message must be a
sequence of pairs of the form

  [[message-string stream] ...]

Print and flush each message on the indicated stream.  This will
support custom shutdown service requests.

--- src/puppetlabs/trapperkeeper/core.clj
+++ src/puppetlabs/trapperkeeper/core.clj
@@ -158,20 +158,58 @@
     (run-app app)
     (swap! internal/tk-apps (partial remove #{app}))))

+(def exit-request-schema
+  "A process exit request like
+  {:kind :puppetlabs.trapperkeeper.core/exit
+   :status 7
+   :messages [[\"something for stderr\n\" *err*]]
+              [\"something for stdout\n\" *out*]]
+              [\"something else for stderr\n\" *err*]]"
+  {:kind ::exit
+   :status schema/Int
+   :messages [[(schema/one schema/Str "message")
+               (schema/one java.io.Writer "stream")]]})
+
 (defn- parse-args [args]
-  (let [quit (fn [status msg stream]
-               (binding [*out* stream]
-                 (println msg)
-                 (flush))
-               (System/exit status))]
+  "Returns valid CLIData or throws an ::exit."
+  (letfn [(quit [status msg stream ex-msg]
+            (throw (ex-info ex-msg
+                            ;; Matches exit-request-schema
+                            {:kind ::exit
+                             :status status
+                             :messages [[(str msg "\n") stream]]})))]
     (try
       (internal/parse-cli-args! (or args ()))
       (catch ExceptionInfo ex
         (let [{:keys [kind msg] :as data} (ex-data ex)]
           (case (some-> kind without-ns)
-            :cli-error (quit 1 msg *err*)
-            :cli-help (quit 0 msg *out*)
+            :cli-error (quit 1 msg *err* (i18n/trs "Invalid program arguments"))
+            :cli-help (quit 0 msg *out* (i18n/trs "Command line --help requested"))
             (throw ex)))))))
+
+(defn- handle-exit
+  "Prints any messages provided to the indicated streams, and returns
+  the appropriate process exit status."
+  [{:keys [status messages]}]
+  ;; Check values carefully here since throwing ::exit is a public interface
+  (letfn [(show [stream msg]
+            (binding [*out* stream]
+              (print msg)
+              (flush)))]
+    (doseq [[string stream :as message] messages
+            :when (try
+                    (schema/validate [(schema/one schema/Str "message")
+                                      (schema/one java.io.Writer "stream")]
+                                     message)
+                    (catch Exception ex
+                      (show *err* (i18n/trs "Malformed exit message: {0}\n" ex))
+                      false))]
+      (show stream string))
+    (if (integer? status)
+      status
+      (do
+        (show *err* (i18n/trs "Invalid exit status requested, exiting with 2"))
+        2))))

 (defn main
   "Launches the trapperkeeper framework. This function blocks until
@@ -182,7 +220,14 @@
   {:pre [((some-fn sequential? nil?) args)
          (every? string? args)]}
   (try
-    (run (parse-args args))
-    (finally
-      (log/debug (i18n/trs "Finished TK main lifecycle, shutting down Clojure agent threads."))
-      (shutdown-agents))))
+    (let [cli (parse-args args)]
+      (try
+        (run cli)
+        (finally
+          (log/debug (i18n/trs "Finished TK main lifecycle, shutting down Clojure agent threads."))
+          (shutdown-agents))))
+    (catch ExceptionInfo ex
+      (let [{:keys [kind] :as data} (ex-data ex)]
+        (when-not (= ::exit kind)
+          (throw ex))
+        (System/exit (handle-exit data))))))


don't print exception on ClassNotFoundException in if-ns

--- src/useful.clj
+++ src/useful.clj
@@ -117,8 +117,9 @@
   `(try (ns ~(ns-name *ns*) ~ns-reference)
         (eval '~then-form)
         (catch Exception e#
-          (when-not (instance? java.io.FileNotFoundException e#)
-            (println "Error loading" '~ns-reference (.getMessage e#)))
+          (when-not (or (instance? java.io.FileNotFoundException    e#)
+                        (instance? java.lang.ClassNotFoundException e#))
+            (printf "%s: %s %s" (.getName (class e#)) (.getMessage e#) '~ns-reference))
           (eval '~else-form))))

 (defn tap


Changes in get_jobs result structure: jobs/tests and books/titles

--- src/emender_jenkins/results.clj
+++ src/emender_jenkins/results.clj
@@ -179,7 +179,7 @@
 (defn select-results-for-book
     "Select results for given book and return them as a map with results separated for preview, stage, prod."
     [product version book-name results]
-    {:jobs
+    {:tests
         {:preview (job-for-environment product version book-name :preview results)
          :stage   (job-for-environment product version book-name :stage   results)
          :prod    (job-for-environment product version book-name :prod    results)}})
@@ -187,7 +187,7 @@
 (defn select-results-for-product-version
     "Select results for all books for given product and version."
     [product version results]
-    {:books
+    {:titles
         (into {}
               (for [book (books-for-product-version results product version)]
                    [book (select-results-for-book product version book results)]))})


combine-responses should filter nils

combine-responses should filter nils

--- src/er_cassandra/model/util.clj
+++ src/er_cassandra/model/util.clj
@@ -7,7 +7,8 @@
   "combine a seq of Deferred responses into
    a single Deferred response"
   [responses]
-  (apply d/zip responses))
+  (d/chain (apply d/zip responses)
+           (fn [r] (filter identity r))))

 (defn create-lookup-record
   "construct a lookup record"


Use sets rather than a hash for things awaiting pauses

--- src/exploud/redis.clj
+++ src/exploud/redis.clj
@@ -56,12 +56,19 @@
   [application environment region]
   (str/join "-" [application environment region]))

-(defn- create-description
+(defn- create-description-with-id
   [[k id]]
   (let [[application environment region] (str/split k #"-" 3)]
     {:application application
      :environment environment
      :id id
+     :region region}))
+
+(defn- create-description
+  [k]
+  (let [[application environment region] (str/split k #"-" 3)]
+    {:application application
+     :environment environment
      :region region}))

 (defn paused?
@@ -70,11 +77,11 @@

 (defn paused
   []
-  (map create-description (apply hash-map (using-redis (car/hgetall paused-key)))))
+  (map create-description-with-id (apply hash-map (using-redis (car/hgetall paused-key)))))

 (defn pause
-  [application environment region]
-  (pos? (using-redis (car/hsetnx paused-key (field-for application environment region)))))
+  [application environment id region]
+  (pos? (using-redis (car/hsetnx paused-key (field-for application environment region) id))))

 (defn resume
   [application environment region]
@@ -82,19 +89,19 @@

 (defn pause-registered?
   [application environment region]
-  (using-redis (car/hget awaiting-pause-key (field-for application environment region))))
+  (using-redis (car/sismember awaiting-pause-key (field-for application environment region))))

 (defn awaiting-pause
   []
-  (map create-description (apply hash-map (using-redis (car/hgetall awaiting-pause-key)))))
+  (map create-description (using-redis (car/smembers awaiting-pause-key))))

 (defn register-pause
   [application environment region]
-  (pos? (using-redis (car/hsetnx awaiting-pause-key (field-for application environment region)))))
+  (pos? (using-redis (car/sadd awaiting-pause-key (field-for application environment region)))))

 (defn unregister-pause
   [application environment region]
-  (pos? (using-redis (car/hdel awaiting-pause-key (field-for application environment region)))))
+  (pos? (using-redis (car/srem awaiting-pause-key (field-for application environment region)))))

 (defn in-progress?
   [application environment region]
@@ -102,7 +109,7 @@

 (defn in-progress
   []
-  (map create-description (apply hash-map (using-redis (car/hgetall in-progress-key)))))
+  (map create-description-with-id (apply hash-map (using-redis (car/hgetall in-progress-key)))))

 (defn begin-deployment
   [{:keys [application environment id region]}]


fix a bug that the display file list throws ex

--- src/leiningen/leinsync/list.clj
+++ src/leiningen/leinsync/list.clj
@@ -113,12 +113,14 @@
   (subs hash-str 0 (min desired-length (count hash-str))))

 (defn compact-hash-str [desired-length m]
-  (if (contains? m :marker)
-    (str
-     (:marker m)
-     (get-in m [:value :timestamp]) " "
-     (sub-hash-str (get-in m [:value :md5] "?????") desired-length))
-    (sub-hash-str (:md5 m) desired-length)))
+  (if (map? m)
+    (if (contains? m :marker)
+      (str
+       (:marker m)
+       (get-in m [:value :timestamp]) " "
+       (sub-hash-str (get-in m [:value :md5] "?????") desired-length))
+      (sub-hash-str (:md5 m) desired-length))
+    m))

 (defn display-hash-value [v desired-length]
   (zipmap (keys v) (map (partial compact-hash-str desired-length) (vals v))))


add missing defn- macro

add missing defn- macro

--- src/main/clojure/cljs/core.cljc
+++ src/main/clojure/cljs/core.cljc
@@ -320,6 +320,12 @@
            (list* 'fn* name new-sigs)
            (cons 'fn* new-sigs))
          (meta &form)))))
+
+#?(:cljs
+   (core/defmacro defn-
+     "same as defn, yielding non-public def"
+     [name & decls]
+     (list* `defn (with-meta name (assoc (meta name) :private true)) decls)))

 #?(:cljs
    (core/defmacro if-let


change println to debug-logging

change println to debug-logging

--- src/lambdacd/util.clj
+++ src/lambdacd/util.clj
@@ -2,7 +2,8 @@
   (:require [clojure.core.async :as async]
             [clojure.java.io :as io]
             [clojure.string :as string]
-            [clojure.java.shell :as jsh]))
+            [clojure.java.shell :as jsh]
+            [clojure.tools.logging :as log]))

 (defn range-from [from len] (range (inc from) (+ (inc from) len)))

@@ -17,5 +18,5 @@
   [cwd & commands]
   (let [combined-command (str "bash -c '" (string/join " && " commands) "' 2>&1") ;; very hacky but it does the job of redirecting stderr to stdout
         result (jsh/sh "bash" "-c" combined-command  :dir cwd)]
-    (println "executed" combined-command "in" cwd)
+    (log/debug (str "executed " combined-command " in " cwd))
     result))


Minor changes in JSON parsing code.

Minor changes in JSON parsing code.

--- src/notes/handler.clj
+++ src/notes/handler.clj
@@ -5,10 +5,10 @@
         [hiccup.page]
         [hiccup.element]
         [ring.util.response]
-        [clojure.data],
-        [clojure.java.io])
+        [clojure.data])
   (:require [compojure.handler :as handler]
             [compojure.route :as route]
+            [clojure.java.io :as io]
             [monger.core :as mg]
             [monger.collection :as mc]
             [monger.query :as mq]
@@ -21,17 +21,14 @@

 (def mongo-host "localhost")
 (def mongo-port "27017")
-(def mongo-username "test")
-(def mongo-password "test")
 (def environment-file "/home/dotcloud/environment.json")

-(if (.exists (as-file environment-file))
-(
-  (def environment (json/read (reader (file environment-file))))
-  (def mongo-host (val (find environment "DOTCLOUD_MONGO_MONGODB_HOST")))
-  (def mongo-port (val (find environment "DOTCLOUD_MONGO_MONGODB_PORT")))))
+(if (.exists (io/file environment-file))
+  (let [environment (with-open [f (io/reader environment-file)] (json/read f))]
+    (def mongo-host (get environment "DOTCLOUD_MONGO_MONGODB_HOST"))
+    (def mongo-port (get environment "DOTCLOUD_MONGO_MONGODB_PORT"))))

-(mg/connect-via-uri! (str "mongodb://" mongo-username ":" mongo-password "@" mongo-host ":" mongo-port "/notes"))
+(mg/connect-via-uri! (str "mongodb://test:test@" mongo-host ":" mongo-port "/notes"))

 (defn save-note! [note]
   (mc/insert "notes" note))
@@ -105,4 +102,4 @@
   (route/not-found "Not Found"))

 (def app
-  (handler/site app-routes))
+  (handler/site app-routes))


Add documentation to dar.read

Add documentation to dar.read

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/dar/read.clj
+++ src/obcc/dar/read.clj
@@ -24,15 +24,36 @@
             [pandect.algo.sha1 :refer :all])
   (:refer-clojure :exclude [read]))

+;;--------------------------------------------------------------------------------------
+;; read-protobuf - reads a single protobuf message from a delimited stream
+;;
+;; our protobuf file consists of two primary message types, delimited by a size.
+;; (fl/protobuf-seq) is designed to return an infinite lazy sequence of one type
+;; so we need to feed this through (first) to extract only one.
+;;--------------------------------------------------------------------------------------
 (defn read-protobuf [t is] (->> is (fl/protobuf-seq t) first))

+;;--------------------------------------------------------------------------------------
+;; read-XX - read one instance of a specific type of protobuf message [Header|Archive]
+;;--------------------------------------------------------------------------------------
 (defn read-header [is] (read-protobuf Header is))
 (defn read-archive [is] (read-protobuf Archive is))

+;;--------------------------------------------------------------------------------------
+;; make-input-stream - factory function for creating an input-stream for a specific entry
+;;
+;; We install the necessary decompressor such that the output of this stream represents
+;; raw, uncompressed original data
+;;--------------------------------------------------------------------------------------
 (defn make-input-stream [type entry]
   (let [is (->> entry :data .newInput)]
     (codecs/decompressor type is)))

+;;--------------------------------------------------------------------------------------
+;; import-header - imports and validates a Header object from the input stream
+;;
+;; evaluates to the parsed header if successful, or throws an exception otherwise
+;;--------------------------------------------------------------------------------------
 (defn import-header [is]
   (if-let [header (read-header is)]
     (let [compat (select-keys header [:magic :version])]
@@ -41,9 +62,17 @@
         (throw (Exception. (str "Incompatible header detected (expected: " CompatVersion " got: " compat ")")))))
     (throw (Exception. (str "Failed to read archive header")))))

+;;--------------------------------------------------------------------------------------
+;; import-archive - imports an Archive object from the input stream
+;;--------------------------------------------------------------------------------------
 (defn import-archive [is]
   (read-archive is)) ;; FIXME - check digitial signature

+;;--------------------------------------------------------------------------------------
+;; import-entry - validates an entry object
+;;
+;; returns the proper input-stream-factory when sucessful, or throws an exception otherwise
+;;--------------------------------------------------------------------------------------
 (defn import-entry [compression entry]
   (let [type (:description compression)
         factory #(make-input-stream type entry)]
@@ -57,12 +86,32 @@
     ;; and inject our stream factory
     {:entry entry :input-stream-factory factory}))

+;;--------------------------------------------------------------------------------------
+;; import-payload - imports a Payload object from Archive::Payload field
+;;
+;; We separate Archive from Payload to delineate signature boundaries.  Everything within
+;; Payload is expected to be optionally digitally signed (and thus verified upon import)
+;;--------------------------------------------------------------------------------------
 (defn import-payload [archive] (->> archive :payload .newInput (fl/protobuf-load-stream Payload)))

+;;--------------------------------------------------------------------------------------
+;; synth-index - synthesize an index of entries, keyed by :path
+;;
+;; Takes a payload object and constructs a map of entries, keyed by their path.  Each
+;; entry is fully verified and processed (such as attaching an input-stream filter)
+;;--------------------------------------------------------------------------------------
 (defn synth-index [payload]
   (let [compression (:compression payload)]
     (->> (:entries payload) (map #(vector (:path %) (import-entry compression %))) (into {}))))

+;;--------------------------------------------------------------------------------------
+;; entry-stream - instantiate an input-stream from the factory
+;;
+;; This allows a caller to obtain a simple input-stream interface to our entries where
+;; all the details such as compression are already factored in.  Therefore, this stream
+;; is suitable to any number of tasks such as interpreting results, verifying contents,
+;; or writing data to files
+;;--------------------------------------------------------------------------------------
 (defn entry-stream [entry]
   (let [factory (:input-stream-factory entry)]
     (factory)))


a release

a release

--- src/ontrail/pages.clj
+++ src/ontrail/pages.clj
@@ -244,7 +244,7 @@
      (navi user)
      [:h2 "Lisää uusi suoritus"]
      [:form {:role "form" :accept-charset "UTF-8" :method "POST" :action (url "/addex")}
-      (form-group "title" "Otsikko")
+      (form-group "title" "Otsikko" {:required "required"})
       [:div.form-group
        [:label {:for "sport"} "Laji"]
        [:select.form-control {:name "sport" :required "required"} (form/select-options sports)]]


Update load-library docstring

Update load-library docstring

--- src/naughtmq/core.clj
+++ src/naughtmq/core.clj
@@ -56,7 +56,8 @@
     path))

 (defn- load-library
-  "Loads the given path (string) as a native library."
+  "Loads the given file as a native library. The file must be in the native
+  folder in the CLASSPATH."
   [s]
   (let [file_path (save-library s)]
     (try (System/load file_path)


Render properly the icon on layers toolbox.

--- src/uxbox/ui/workspace/toolboxes.cljs
+++ src/uxbox/ui/workspace/toolboxes.cljs
@@ -117,7 +117,7 @@
       [:div.element-actions
        [:div.toggle-element {:class "selected"} i/eye]
        [:div.block-element i/lock]]
-      [:div.element-icon i/box]
+      [:div.element-icon (shapes/render item)]
       [:span (or (:name item)
                  (:id item))]])))


add more debugging statements

add more debugging statements

--- src/chat/server/extensions/asana.clj
+++ src/chat/server/extensions/asana.clj
@@ -99,9 +99,10 @@
           (db/set-extension-config! (extension :id) :webhook-secret secret))
       {:status 200 :headers {"X-Hook-Secret" secret}})
     (if-let [signature (get-in event-req [:headers "x-hook-signature"])]
-      (do (timbre/debugf "webhook %s" event-req)
+      (let [body (str (:body event-req))]
+        (timbre/debugf "webhook %s" event-req)
           (if (hmac-verify {:secret (get-in extension [:config :webhook-secret])
-                            :data (str (:body event-req))
+                            :data body
                             :mac signature})
             (do
               (timbre/debugf "webhook signature okay")
@@ -113,7 +114,8 @@
                 (timbre/debugf "event data: %s" data)
                 (timbre/debugf "new issues %s" new-issues)
                 {:status 200}))
-            {:status 400 :body "bad hmac"}))
+            (do (timbre/debugf "bad hmac")
+                {:status 400 :body "bad hmac"})))
       (do (timbre/warnf "missing signature on webhook %s" event-req)
           {:status 400 :body "missing signature"}))))


More logging improvements

More logging improvements

--- src/circle/backend/load_balancer.clj
+++ src/circle/backend/load_balancer.clj
@@ -121,7 +121,7 @@

 (defn add-availability-zone [lb-name new-zone]
   (with-elb-client client
-    (println "adding" new-zone "to" lb-name)
+    (infof "adding %s to %s" new-zone lb-name)
     (-> client
         (.enableAvailabilityZonesForLoadBalancer (EnableAvailabilityZonesForLoadBalancerRequest. lb-name [new-zone])))))

@@ -131,7 +131,6 @@
     true))

 (defn get-health [lb-name & instance-ids]
-  {:post [(do (println "get-health:" %) true)]}
   (let [request (DescribeInstanceHealthRequest. lb-name)]
     (when instance-ids
       (.setInstances request (map #(Instance. %) instance-ids)))


Syntax: use vectors for imports

Syntax: use vectors for imports

--- src/clj/attendance/google/sheets.clj
+++ src/clj/attendance/google/sheets.clj
@@ -1,18 +1,20 @@
 (ns attendance.google.sheets
-  (:require [attendance.base64 :as b64]
-            [clojure.java.io :as io]
-            [environ.core :refer [env]])
+  (:require
+   [attendance.base64 :as b64]
+   [clojure.java.io :as io]
+   [environ.core :refer [env]])
   (:import
-    (java.net URL URI)
-    (java.security KeyStore)
-    (java.io ByteArrayInputStream)
-    (java.nio.charset StandardCharsets)
-    (com.google.gdata.data.spreadsheet SpreadsheetFeed CellFeed)
-    (com.google.gdata.client.spreadsheet SpreadsheetService)
-    (com.google.api.client.util SecurityUtils)
-    (com.google.api.client.googleapis.auth.oauth2 GoogleCredential GoogleCredential$Builder)
-    (com.google.api.client.json.jackson2 JacksonFactory)
-    (com.google.api.client.googleapis.javanet GoogleNetHttpTransport)))
+   [java.net URL URI]
+   [java.security KeyStore]
+   [java.io ByteArrayInputStream]
+   [java.nio.charset StandardCharsets]
+   [com.google.gdata.data.spreadsheet SpreadsheetFeed CellFeed]
+   [com.google.gdata.client.spreadsheet SpreadsheetService]
+   [com.google.api.client.util SecurityUtils]
+   [com.google.api.client.googleapis.auth.oauth2
+    GoogleCredential GoogleCredential$Builder]
+   [com.google.api.client.json.jackson2 JacksonFactory]
+   [com.google.api.client.googleapis.javanet GoogleNetHttpTransport]))

 (def sheet-feed-url
   (URL. "https://spreadsheets.google.com/feeds/spreadsheets/private/full"))


part fix for identifying sub packages

part fix for identifying sub packages

--- src/clj/ikea_clojure_cup/product.clj
+++ src/clj/ikea_clojure_cup/product.clj
@@ -4,6 +4,9 @@
             [hickory.select :as s]
             [hickory.core :as hick]
             [clojure.string :as cs]))
+
+(defn- extract-int [string]
+  (-> (re-find #"\d+" string) Integer/parseInt))

 (defn- get-hick-packages [site-htree]
   ;(s/or ..) doesn't work so have to use concat
@@ -25,6 +28,15 @@
             []
             table-rows)))

+(defn- get-hick-sub-product-packages [site-htree]
+  (map (fn [{:keys [content]}]
+         {:width (extract-int (first content))
+          :height (extract-int(nth content 2))
+          :length (extract-int (nth content 4))})
+       (filter #(.contains (-> % :content first) "Width")
+               (s/select (s/child (s/class "ikea-measurements")
+                                  (s/tag :p)) site-htree))))
+
 (defn- transform-packages [hick-packages]
   (reduce (fn [v {:keys [dimensions-and-weight packages weight-unit dimension-unit]}]
             (conj v {:width (nth dimensions-and-weight 0)
@@ -39,8 +51,10 @@

 (defn product [region lang product-context id]
   (let [url (format "http://m.ikea.com/%s/%s/catalog/products/%s/%s/measurements/" region lang product-context id)
-        response (http-kit/get url)]
-    (transform-packages (get-hick-packages (-> @response :body hick/parse hick/as-hickory))) ))
+        response (http-kit/get url)
+        site-htree (-> @response :body hick/parse hick/as-hickory)]
+    (into (transform-packages (get-hick-packages site-htree))
+          (get-hick-sub-product-packages site-htree))))

 ;; (count (get-hick-packages single))
 ;; (count (get-hick-packages multi))
@@ -55,4 +69,3 @@
 ;;   (product "au" "en" "spr" "39111083")
   )

-(def spr-sample )


Rename `timetable-prune-empty-rows` to `overall-timetable-prune-empty-rows`

Because we are gonna add a very similarly named function next.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -721,7 +721,7 @@

 ; Forward declaration
 (declare add-module-lesson-group!)
-(declare timetable-prune-empty-rows)
+(declare overall-timetable-prune-empty-rows)
 (declare add-missing-td-elements-replacing-lesson)
 (declare remove-lesson-group-html)
 (declare shift-lessons-upwards-to-replace-empty-slots!)
@@ -791,7 +791,7 @@
           ($lesson-div-remove $divElem (:startTime augTTLessonInfo)
                               (:endTime augTTLessonInfo))))

-      (timetable-prune-empty-rows affectedDaysSet)
+      (overall-timetable-prune-empty-rows affectedDaysSet)
       (set! Lessons-Created-By-Draggable nil)

       ; User has dropped the draggable helper <div> onto a droppable
@@ -808,7 +808,7 @@
                 (timetable-remove-lesson! day rowNum ttLessonInfo)))

             (shift-lessons-upwards-to-replace-empty-slots! augTTLessonInfoSeq)
-            (timetable-prune-empty-rows affectedDaysSet)
+            (overall-timetable-prune-empty-rows affectedDaysSet)
             (update-ModulesSelected-for-affected-days affectedDaysSet)

             ; add the newly selected lesson group
@@ -1357,7 +1357,7 @@
                              nextLessonInfoVec
                              augTTLessonInfoTo$DivElem)))))))

-(defn- timetable-prune-empty-rows
+(defn- overall-timetable-prune-empty-rows
   "Removes empty rows resulting from the removal of lessons on given days."
   [affectedDaysSet]
   (doseq [day affectedDaysSet]
@@ -1473,7 +1473,7 @@
         ; Perform shifting due to removal of lesson <div>s
         (shift-lessons-upwards-to-replace-empty-slots! augTTLessonInfoSeq)
         (.log js/console "Here too bro")
-        (timetable-prune-empty-rows affectedDaysSet)
+        (overall-timetable-prune-empty-rows affectedDaysSet)
         (.log js/console "Whats up")

         ; Update `ModulesSelected`


`timetable-prune-empty-rows` - use destructuring

and some other shortcuts

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -1332,22 +1332,15 @@
   [affectedDaysSet]
   (doseq [day affectedDaysSet]
     (let [nrRows          (get-nr-rows-in-timetable-day day)
-          ttDay           (timetable-get-day day)
-
-          rowsPartition
-          (reduce (fn [rPart [rowIdx ttRow]]
-                    (if (empty? ttRow)
-                      (update-in rPart [:emptyRows]
-                                 (fn [emptyRowsVec]
-                                   (conj emptyRowsVec rowIdx)))
-                      (update-in rPart [:nonEmptyRows]
-                                 (fn [nonEmptyRowsVec]
-                                   (conj nonEmptyRowsVec rowIdx)))))
-                  {:emptyRows [], :nonEmptyRows []}
-                  (map vector (range (count ttDay)) ttDay))
-
-          emptyRowsVec    (:emptyRows rowsPartition)
-          nonEmptyRowsVec (:nonEmptyRows rowsPartition)
+
+          {:keys [emptyRowsVec nonEmptyRowsVec]}
+          (reduce (fn [rPart rowIdx]
+                    (if (timetable-row-empty? day rowIdx)
+                        (update-in rPart [:emptyRowsVec] #(conj %1 rowIdx))
+                        (update-in rPart [:nonEmptyRowsVec] #(conj %1 rowIdx))))
+                  {:emptyRowsVec [], :nonEmptyRowsVec []}
+                  (range nrRows))
+
           nrEmptyRows     (count emptyRowsVec)
           nrNonEmptyRows  (- nrRows nrEmptyRows)
           $day            (nth HTML-Timetable day)


Remove extra code

Remove extra code

--- src/cljs/robinson/webglterminal.cljs
+++ src/cljs/robinson/webglterminal.cljs
@@ -164,13 +164,6 @@
     (mat4/identity m)
     (mat4/translate m m (clj->js v))))

-(defn animate [draw-fn]
-  (letfn [(loop [frame]
-            (fn []
-              (.requestAnimationFrame js/window (loop (inc frame)))
-              (draw-fn frame)))]
-         ((loop 0))))
-
 ;; Normally this would be a record, but until http://dev.clojure.org/jira/browse/CLJ-1224 is fixed
 ;; it is not performant to memoize records because hashCode values are not cached and are recalculated
 ;; each time.
@@ -200,11 +193,11 @@
           _                (log/info "Using font" normal-font)
           default-fg-color [(long default-fg-color-r) (long default-fg-color-g) (long default-fg-color-b)]
           default-bg-color [(long default-bg-color-g) (long default-bg-color-g) (long default-bg-color-b)]
-          ;; TODO: create texture atlas
+          ;; create texture atlas
           _                (draw-character-canvas!)
           character-map    (atom (vec (repeat rows (vec (repeat columns (make-terminal-character \space default-fg-color default-bg-color #{}))))))
           cursor-xy        (atom nil)
-          ;; adjust canvas height
+          ;; adjust terminal canvas height
           _                (dom/setProperties
                              terminal-canvas-dom
                              (clj->js {:width (* 80 12)
@@ -214,14 +207,11 @@
           ;; create texture atlas as gl texture
           characters-texture  (texture/create-texture gl
                                                       :image character-canvas-dom
-                                                      ;;:generate-mipmaps? true
-                                                      ;;:pixel-store-modes {webgl/unpack-flip-y-webgl true}
                                                       :parameters {texture-parameter-name/texture-mag-filter texture-filter/nearest
                                                                    texture-parameter-name/texture-min-filter texture-filter/nearest})
-          ;; TODO: create 12x16 quad
-          ;tw 0.5
-          ;th 0.5
+          ;; init shaders
           shader-prog         (init-shaders gl)
+          ;; We just need one vertex buffer, a texture-mapped quad will suffice for drawing a character.
           square-vertex-buffer
             (buffers/create-buffer gl
               (ta/float32 [12.0, 16.0, 0.0,
@@ -231,6 +221,7 @@
               buffer-object/array-buffer
               buffer-object/static-draw
               3)
+          ;; We'll need a set of texture coords -- one for each character, but we'll memoize on a 4-tuple of uvs.
           square-texture-buffer-fn (memoize (fn [[u0 v0 u1 v1]]
                                               (let [u0 (/ u0 256)
                                                     v0 (/ v0 256)
@@ -247,6 +238,7 @@
           vertex-position-attribute (shaders/get-attrib-location gl shader-prog "aVertexPosition")
           texture-coord-attribute   (shaders/get-attrib-location gl shader-prog "aTextureCoord")

+          ;; Draws character c at position [x y] on the terminal canvas using gl.
           draw-character   (fn [c x y]
                              (let [uvs (character->uvs (get c :character))]
                              ;(log/info "character->pos" (str character->pos))
@@ -286,47 +278,7 @@
                                      (.drawLine 0
                                                 y
                                                 char-width
-                                                y))))))
-          key-queue        []#_(LinkedBlockingQueue.)
-          on-key-fn        (or on-key-fn
-                               (fn default-on-key-fn [k]
-                                 (.add key-queue k)))
-          terminal-renderer nil #_(proxy [JComponent] []
-                             (getPreferredSize []
-                               (let [graphics      ^Graphics    (proxy-super getGraphics)
-                                     font-metrics  ^FontMetrics (.getFontMetrics graphics normal-font)
-                                     screen-width               (* columns (.charWidth font-metrics \space))
-                                     screen-height              (* rows (.getHeight font-metrics))
-                                     char-width                 (/ screen-width columns)
-                                     char-height                (/ screen-height rows)]
-                                 (Dimension. screen-width screen-height)))
-                             (paintComponent [^Graphics graphics]
-                               (log-time "blit"
-                                 (let [graphics-2d ^Graphics2D           (.create graphics)
-                                       font-metrics ^FontMetrics         (.getFontMetrics graphics normal-font)
-                                       screen-width                      (* columns (.charWidth font-metrics \space))
-                                       screen-height                     (* rows (.getHeight font-metrics))
-                                       char-width                        (/ screen-width columns)
-                                       char-height                       (/ screen-height rows)]
-                                   (doto graphics
-                                     (.fillRect 0 0 screen-width screen-height))))))
-                                   ;(doseq [row (range rows)]
-                                   ;  (println (apply str (map #(get % :character) (get @character-map row)))))
-          icon            nil #_(.getImage (java.awt.Toolkit/getDefaultToolkit) "images/icon.png")
-          frame           nil #_(doto (JFrame. "Robinson")
-                             (.. (getContentPane) (setLayout (BorderLayout.)))
-                             (.. (getContentPane) (add terminal-renderer BorderLayout/CENTER))
-                             (.addKeyListener keyListener)
-                             (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
-                             (.setLocationByPlatform true)
-                             (.setLocationRelativeTo nil)
-                             (.setAlwaysOnTop true)
-                             (.setAlwaysOnTop false)
-                             (.setVisible true)
-                             (.setIconImage icon)
-                             (.setFocusTraversalKeysEnabled false)
-                             (.setResizable false)
-                             (.pack))]
+                                                y))))))]
       (reify rat/ATerminal
         (get-size [this]
           [columns rows])


clear events when test data is deleted

clear events when test data is deleted

--- src/pc/stripe/dev.clj
+++ src/pc/stripe/dev.clj
@@ -26,13 +26,19 @@

 (defn fetch-events []
-  (when-let [new-events (seq (get (stripe/fetch-events :ending-before (-> @events last (get "id")))
-                                  "data"))]
-    (log/infof "fetched %s new Stripe events" (count new-events))
-    (add-events new-events)
-    (doseq [event new-events]
-      (http/post (urls/make-url "/hooks/stripe") {:body (json/encode event)
-                                                  :throw-exceptions false}))))
+  (try+
+   (when-let [new-events (seq (get (stripe/fetch-events :ending-before (-> @events last (get "id")))
+                                   "data"))]
+     (log/infof "fetched %s new Stripe events" (count new-events))
+     (add-events new-events)
+     (doseq [event (sort-by #(get % "created") new-events)]
+       (http/post (urls/make-url "/hooks/stripe") {:body (json/encode event)
+                                                   :throw-exceptions false})))
+   (catch [:status 400] e
+     (when (some-> e :body json/decode (get-in ["error" "param"]) (= "ending_before"))
+       (log/infof "event in events doesn't exist, data was probably cleared, resetting events")
+       (reset! events []))
+     (throw+))))

 (defn retry-event [evt-id]
   (when-let [evt (first (filter #(= evt-id (get % "id")) @events))]


allow us to leave posts off of the overview page

--- src/pc/views/blog.clj
+++ src/pc/views/blog.clj
@@ -17,12 +17,9 @@
       (swap! requires conj ns))))

 (defn post-fn [slug]
-  (try
-    (maybe-require slug)
-    (ns-resolve (post-ns slug)
-                (symbol slug))
-    (catch Exception e
-      nil)))
+  (maybe-require slug)
+  (ns-resolve (post-ns slug)
+              (symbol slug)))

 (defn post-url [slug]
   (str "/blog/" slug))
@@ -30,15 +27,16 @@
 (def slugs
   "Sorted array of slugs, assumes the post content can be found in the
    function returned by post-fn"
-  ["interactive-layers"
-   ;; "product-hunt-wake-up-call"
+  [{:slug "interactive-layers"
+    :display-in-overview true}
+   {:slug "product-hunt-wake-up-call"
+    :display-in-overview false}
    ;; "instrumenting-om-components"
    ;; "lets-replace-pen-and-paper"
    ])

 (defn post-exists? [slug]
-  (not= -1 (.indexOf slugs slug))
-  (post-fn slug))
+  (not= -1 (.indexOf (map :slug slugs) slug)))

 (def logomark
   [:i {:class "icon-logomark"}
@@ -73,7 +71,7 @@
   [:div.blogroll
    (blog-head)
    [:article
-    (for [slug slugs
+    (for [slug (->> slugs (filter :display-in-overview) (map :slug))
           :let [{:keys [title blurb author] :as content} ((post-fn slug))]]
       [:div.blogroll-post
        [:a.blogroll-post-title {:href (post-url slug)}


fixes duplication... but prevents new tweets from getting in

--- src/seathree/data.clj
+++ src/seathree/data.clj
@@ -240,18 +240,11 @@
           ;; tweets after this tweet's id)
           (let [last-tweet-id     (:id (redis cfg #(car/lindex (tweets-key user-data) 0)))
                 tweets            (with-retries 3 #(get-tweets-from-twitter cfg user-data last-tweet-id))]
-            (log/debug tweets)
             (if (not (nil? tweets))
               (let [retrying-translate (fn [text] (with-retries 3 #(translate cfg user-data text)))
                     translated-tweets  (->> tweets
                                             (map retrying-translate)
                                             (filter #(not (nil? %))))]
                 (if (not (empty? translated-tweets))
-                    (redis cfg #(apply (partial car/lpush (tweets-key user-data)) translated-tweets))
-                    (log/debug "Failed to translate any tweets"))))))))))
-
-(defn get-tweets-from-cache
-  "Pull out and return all tweet data for the requested user
-   map. Assocs tweet list with user data."
-  [cfg user-data]
-  (redis cfg #(car/lrange (tweets-key user-data) 0 -1)))
+                  (store-tweets cfg user-data translated-tweets)
+                  (log/debug "Failed to translate any tweets"))))))))))


change spec

change spec

--- src/synthesis_crawlers/core.clj
+++ src/synthesis_crawlers/core.clj
@@ -9,10 +9,12 @@
            (org.jsoup.nodes Element)
            (info.debatty.java.stringsimilarity Jaccard)))

-(s/def ::attributes (s/coll-of keyword?))
+(s/def ::attribute keyword?)
+(s/def ::attributes (s/coll-of ::attribute))
 (s/def ::sites (s/map-of string? #(instance? java.util.regex.Pattern %)))
 (s/def ::knowledge (s/coll-of string?))
-(s/def ::attr-extractor (s/map-of keyword? string?))
+(s/def ::attr-knowledge (s/map-of  ::attribute ::knowledge))
+(s/def ::attr-extractor (s/map-of keyword? (s/or :complete string? :empty nil?)))
 (s/def ::container-extractor string?)
 (s/def ::complete-attr-extractor (s/map-of keyword? string?))
 (s/def ::extractor (s/map-of ::container-extractor ::attr-extractor))
@@ -97,7 +99,8 @@
 (s/fdef extract-knowledge
         :args (s/cat :sites ::sites
                      :site-extractor ::site-extractor
-                     :crawled-extractors ::site-extractor))
+                     :crawled-extractors ::site-extractor)
+        :ret ::attr-knowledge)
 (defn extract-knowledge
   "extracts knwoledge from the specified site"
   [sites site-extractor crawled-extractors]
@@ -154,5 +157,8 @@
   (loop [attr-knowledge {}
          s-extractors site-extractors
          crawled-extractors {}]
-    (uncrawled-extractors s-extractors crawled-extractors)
+    (let [new-knowledge (merge-with into
+                                    attr-knowledge
+                                    (extract-knowledge sites s-extractors crawled-extractors))]
+      nil)
     nil))


Minor refactor - use assoc instead of merge in derive-column

--- src/tabular/grafter/tabular.clj
+++ src/tabular/grafter/tabular.clj
@@ -255,7 +255,7 @@
                             (map (fn [row]
                                    (let [args-from-cols (select-row-values resolved-from-cols row)
                                          new-col-val (apply f args-from-cols)]
-                                     (merge row {new-column-name new-col-val })))))
+                                     (assoc row new-column-name new-col-val)))))
                        (concat (column-names dataset) [new-column-name]))
          (with-meta (meta dataset))))))


move kibana into private subnet

move kibana into private subnet

--- src/terraboot/elasticsearch.clj
+++ src/terraboot/elasticsearch.clj
@@ -80,7 +80,7 @@
              (aws-instance (vpc-unique "kibana") {
                                                   :ami "ami-9b9c86f7"
                                                   :vpc_security_group_ids [(vpc-id-of "aws_security_group" "kibana")]
-                                                  :subnet_id (vpc-id-of "aws_subnet" "public-a")
+                                                  :subnet_id (vpc-id-of "aws_subnet" "private-a")
                                                   })

              (vpc-security-group "kibana" {})


more helpful error message

more helpful error message

--- src/selmer/parser.clj
+++ src/selmer/parser.clj
@@ -109,7 +109,7 @@
 (defn expr-tag [{:keys [tag-name args] :as tag} rdr]
   (if-let [handler (tag-name @expr-tags)]
     (handler args tag-content render-template rdr)
-    (throw (Exception. (str "unrecognized tag: " tag-name)))))
+    (throw (Exception. (str "unrecognized tag: " tag-name " - did you forget to close a tag?")))))

 ;; Same as a vanilla data tag with a value, but composes
 ;; the filter fns. Like, {{ data-var | upper | safe }}


Port word-source to Clojure

Port word-source to Clojure

--- src/test_utils/word_source.cljc
+++ src/test_utils/word_source.cljc
@@ -4,12 +4,15 @@
 #?(:cljs (def fs (js/require "fs")))

 (defn read-text-file [pathname]
-  #?(:cljs (.readFileSync fs pathname "utf-8")))
+  #?(:cljs (.readFileSync fs pathname "utf-8"))
+  #?(:clj (slurp pathname)))

 (defn empty-string? [to-test]
   "Determine if to-test is an empty string."
   (and (string? to-test)
-       (== (.-length to-test) 0)))
+       (== #?(:cljs (.-length to-test))
+           #?(:clj (.length to-test))
+           0)))

 (defn parse-lines [text]
   (clj-str/split text #"\n"))


generating array with repeat

generating array with repeat

--- src/tic_tac_toe/tic_tac_toe.clj
+++ src/tic_tac_toe/tic_tac_toe.clj
@@ -48,17 +48,17 @@
 ;; (def arry (make-array Integer/TYPE 3 3))
 ;; (for [_ (range 3)] (for [_ (range 3)] nil))

+;; (reduce #(conj %1 (for [_ (range %2)] nil)) [] (repeat 3 3))
+;; (reduce #(conj %1 (repeat %2 nil)) [] (repeat 3 3))
+;; (repeat 3 (repeat 3 nil)) ; simpest
+
+
 (defn join-row [row]
   (join "|" (map #(if (nil? %) " " %) row)))
-
-(join-row [nil 'o 'x])

 (defn print-array [array]
   (print (join "\n-----\n" (map join-row array)))
   (println))
-
-;; print array state
-(print-array *array*)

 (defn chars-seq [string]
   (split string #""))


whitespace

whitespace

--- src/splash/macros.clj
+++ src/splash/macros.clj
@@ -4,10 +4,10 @@
   [& pairs]
   `(do (when-not ~(first pairs)
          (throw (IllegalArgumentException.
-                  (str (first ~'&form) " requires " ~(second pairs) " in " ~'*ns* ":" (:line (meta ~'&form))))))
-     ~(let [more (nnext pairs)]
-        (when more
-          (list* `assert-args more)))))
+                 (str (first ~'&form) " requires " ~(second pairs) " in " ~'*ns* ":" (:line (meta ~'&form))))))
+       ~(let [more (nnext pairs)]
+          (when more
+            (list* `assert-args more)))))

 (defmacro get-layer [canvas layer]
   `(-> ~canvas :layer ~layer))


rename `sample-weighted-foods` to `select-sampled-food`

--- src/whatsoup/meal_generator.clj
+++ src/whatsoup/meal_generator.clj
@@ -135,7 +135,7 @@
               (repeat (sample-n score) food))]
       (mapcat create-sample (seq scored-foods)))))

-(defn sample-weighted-foods [mg ingredient selected-foods]
+(defn select-sampled-food [mg ingredient selected-foods]
   (->> (:candidate-foods ingredient)
        (index-with #(kb/score (:food-kb mg) % selected-foods))
        (sample-foods)
@@ -147,7 +147,7 @@
 (defn match-ingredient [mg ingredient selected-foods]
   (if (unambiguous-selection? ingredient)
     (select-food ingredient ((:picker mg) (:candidate-foods ingredient)))
-    (sample-weighted-foods mg ingredient selected-foods)))
+    (select-sampled-food mg ingredient selected-foods)))

 (defn next-matchable-ingredient [mg recipe]


make a few functions work with either seq or vec

--- c5db/src/main/clojure/c5db/control.clj
+++ c5db/src/main/clojure/c5db/control.clj
@@ -110,19 +110,24 @@
     (killall-process))

 (defn kill [node-id]
-    (if (seq? node-id)
-        (doall (map remove-process node-id))
-        (remove-process node-id)))
+  (let [mult #(doall (map remove-process node-id))
+        sing #(remove-process node-id)]
+    (cond
+      (vector? node-id) (mult)
+      (seq? node-id) (mult)
+      :else (sing))))

 (defn killall []
     "alias for killall-process"
     (killall-process))

 (defn tail [node-id]
-    (if (seq? node-id)
-        (doall (map tail-log node-id))
-        (tail-log node-id)))
-
+  (let [mult #(doall (map tail-log node-id))
+        sing #(tail-log node-id)]
+  (cond
+    (vector? node-id) (mult)
+    (seq? node-id) (mult)
+    :else (sing))))

 ;;; Calling into c5 code such as ConfigDirectory, etc


fix up unit test failure.

fix up unit test failure.

--- test/metabase/email/messages_test.clj
+++ test/metabase/email/messages_test.clj
@@ -27,13 +27,10 @@
   `(binding [email/*send-email-fn* fake-inbox-email-fn]
      (reset-inbox!)
      ;; Push some fake settings for SMTP username + password, and restore originals when done
-     (let [orig-username# (email/email-smtp-username)
-           orig-password# (email/email-smtp-password)]
-       (email/email-smtp-username "fake_smtp_username")
-       (email/email-smtp-password "ABCD1234!!")
+     (let [orig-hostname# (email/email-smtp-host)]
+       (email/email-smtp-host "fake_smtp_host")
        (try ~@body
-            (finally (email/email-smtp-username orig-username#)
-                     (email/email-smtp-password orig-password#))))))
+            (finally (email/email-smtp-host orig-hostname#))))))

 ;; new user email
 ;; NOTE: we are not validating the content of the email body namely because it's got randomized elements and thus


Added a Clojure implementation of the IDSymbol protocol.

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -3,25 +3,36 @@
   (:import (org.gavrog.joss.dsyms.basic DelaneySymbol)))

 (defprotocol IDSymbol
+  (element? [_ D])
   (elements [_])
+  (index? [_ i])
   (indices [_])
   (s [_ i D])
   (v [_ i j D]))

 (extend-type DelaneySymbol
   IDSymbol
+  (element? [ds D] (.hasElement ds D))
   (elements [ds] (iterator-seq (.elements ds)))
+  (index? [ds i] (.hasIndex ds i))
   (indices [ds] (iterator-seq (.indices ds)))
   (s [ds i D] (when (.definesOp ds i D) (.op ds i D)))
   (v [ds i j D] (when (.definesV ds i j D) (.v ds i j D))))

-(deftype DSymbol [idcs elms s v]
+(deftype DSymbol [idcs elms s# v#]
   IDSymbol
-  (elements [_] elms)
-  (indices [_] idcs)
-  (s [_ i D] (get s [i, D]))
-  (v [_ i j D]
-     (cond)))
+  (element? [_ D] (elms D))
+  (elements [_] (seq elms))
+  (index? [_ i] (idcs i))
+  (indices [_] (seq idcs))
+  (s [_ i D] ((s# i) D))
+  (v [ds i j D]
+     (when (and (element? ds D) (index? ds i) (index? ds j))
+       (cond (= j (inc i)) ((v# i) D)
+             (= j (dec i)) ((v# j) D)
+             (= j i) 1
+             (= (s ds i D) (s ds j D)) 2
+             :else 1))))

 ;; General D-symbol functions


delaney.clj: removed redundancy from (traversal) output

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -65,7 +65,7 @@
 (defn traversal [ds indices seeds]
   (let [stacks (map #(vector % ()) (take 2 indices))
         queues (map #(vector % empty-queue) (drop 2 indices))
-        as-root #(vector % :root %)
+        as-root #(vector :root %)
         unseen (fn [i seen bag] (pop-while #(seen [% i]) bag))
         pop-seen #(for [[i ys] %1] (vector i (unseen i %2 ys)))
         push-neighbors #(for [[i ys] %1] (vector i (conj ys %2)))]
@@ -77,7 +77,7 @@
            (seq todo-for-i)
            (let [D (first todo-for-i)
                  Di (s ds i D)
-                 head [D i Di]
+                 head [i Di]
                  todo (if Di (vec (push-neighbors todo Di)) todo)
                  seen (conj seen (as-root Di) [D i] [Di i])]
              (lazy-seq (cons head (collect seeds-left todo seen))))
@@ -94,22 +94,23 @@

 (defn orbit-reps
   ([ds indices seeds]
-    (for [[D i] (traversal ds indices seeds) :when (= :root i)] D))
+    (for [[i D] (traversal ds indices seeds) :when (= :root i)] D))
   ([ds indices]
     (orbit-reps ds indices (elements ds))))

 (defn orbit-elements [ds indices seed]
-  (distinct (for [[_ i D] (traversal ds indices [seed])] D)))
+  (distinct (for [[i D] (traversal ds indices [seed])] D)))

 (defn connected? [ds]
   (> 2 (count (orbit-reps ds (indices ds)))))

 (defn partial-orientation [ds]
   (loop [ori {}
-         [[Di i D] & xs] (traversal ds (indices ds) (elements ds))]
+         [[i D] & xs] (traversal ds (indices ds) (elements ds))]
     (cond (nil? i) ori
           (or (nil? D) (ori D)) (recur ori xs)
-          :else (recur (assoc ori D (if (= :root i) 1 (- (ori Di)))) xs))))
+          :else (recur (assoc ori D
+                              (if (= :root i) 1 (- (ori (s ds i D))))) xs))))

 (defn loopless? [ds]
   (every? (fn [[i D]] (not= D (s ds i D)))
@@ -131,10 +132,11 @@
         ipairs (map vector indices (rest indices))
         spins (fn [D] (for [[i j] ipairs] (or (v ds i j D) 0)))
         step (fn step [xs emap n]
-               (if-let [[Di i D] (first xs)]
+               (if-let [[i D] (first xs)]
                  (if (nil? D)
                    (recur (rest xs) emap n)
-                   (let [[Ei E] (sort [(emap Di) (or (emap D) n)])
+                   (let [Di (s ds i D)
+                         [Ei E] (sort [(emap Di) (or (emap D) n)])
                          head (if (= i :root) [-1 E] [(imap i) Ei E])
                          xs (rest xs)]
                      (if (not= E n)
@@ -186,8 +188,8 @@
         :else (recur (walk ds E j i))))))

 (defn orbit-loopless? [ds indices D]
-  (empty? (for [[D i] (traversal ds indices [D])
-                :when (and (not= i :root) (or (nil? D) (= D (s ds i D))))]
+  (empty? (for [[i E] (traversal ds indices [D])
+                :when (and (not= i :root) (or (nil? E) (= E (s ds i E))))]
             D)))

 (defn curvature


Remove debug message from update-cb-info in devcards

--- src/cards/util.cljs
+++ src/cards/util.cljs
@@ -2,7 +2,6 @@
   (:require [om.dom :as dom]))

 (defn update-cb-info [tag state & params]
-  (println "update-cb-info" tag state params)
   (swap! state (fn [state] (-> state
                                (update-in [:callbacks tag :counter] inc)
                                (assoc-in [:callbacks tag :params] params)))))


Comment out prn

Comment out prn

--- src/transit/write.clj
+++ src/transit/write.clj
@@ -271,7 +271,7 @@

 (defn emit-encoded
   [em h tag o as-map-key cache]
-  (prn "EMIT ENCODED" em h tag o as-map-key cache)
+  ;;(prn "EMIT ENCODED" em h tag o as-map-key cache)
   (if (= (.length ^String tag) 1)
     (let [rep (rep h o)]
       (if (string? rep)


Calculate ring.

Calculate ring.

--- src/onyx/coordinator/log/datomic.clj
+++ src/onyx/coordinator/log/datomic.clj
@@ -50,21 +50,25 @@
    :task/ingress-queues (:ingress-queues task)
    :task/egress-queues (or (vals (:egress-queues task)) [])})

-(defn find-incomplete-tasks [db]
-  (let [query '[:find ?task :where [?task :task/complete? false]]]
-    (d/q query db)))
+(defn find-incomplete-tasks [db job-id]
+  (let [query '[:find ?task :in $ ?job :where
+                [?job :job/task ?task]
+                [?task :task/complete? false]]]
+    (d/q query db job-id)))

-(defn find-active-task-ids [db tasks]
-  (let [query '[:find ?task :in $ ?task :where [?peer :peer/task ?task]]]
-    (into #{} (mapcat #(first (d/q query db (:db/id %))) tasks))))
+(defn find-active-task-ids [db job-id tasks]
+  (let [query '[:find ?task :in $ ?job ?task :where
+                [?job :job/task ?task]
+                [?peer :peer/task ?task]]]
+    (into #{} (mapcat #(first (d/q query db (:db/id %))) job-id tasks))))

 (defn sort-tasks-by-phase [db tasks]
   (sort-by :task/phase (map (fn [[t]] (d/entity db t)) tasks)))

-(defn next-essential-task [db]
-  (let [incomplete-tasks (find-incomplete-tasks db)
+(defn next-essential-task [db job-id]
+  (let [incomplete-tasks (find-incomplete-tasks db job-id)
         sorted-tasks (sort-tasks-by-phase db incomplete-tasks)
-        active-tasks (find-active-task-ids db sorted-tasks)]
+        active-tasks (find-active-task-ids db job-id sorted-tasks)]
     (filter (fn [t] (not (contains? active-tasks (:db/id t)))) sorted-tasks)))

 (defn all-active-jobs-ids [db]
@@ -87,7 +91,7 @@

 (defn job-candidate-seq [job-seq last-offered]
   (->> (cycle job-seq)
-       (drop (.indexOf job-seq last-offered))
+       (drop (inc (.indexOf job-seq last-offered)))
        (take (count job-seq))))

 (defmethod extensions/mark-peer-born Datomic
@@ -109,10 +113,11 @@

 (defmethod extensions/next-tasks Datomic
   [log]
-  (let [db (d/db (:conn log))]
-    (prn (all-active-jobs-ids db))
-    (prn (last-offered-job db))
-    (next-essential-task db)))
+  (let [db (d/db (:conn log))
+        job-seq (job-candidate-seq (all-active-jobs-ids db)
+                                   (last-offered-job db))
+        candidates (map (partial next-essential-task db) job-seq)]
+    (first (filter identity candidates))))

 (defn select-nodes [ent]
   (select-keys ent [:node/peer :node/payload :node/ack


Formatting, better comments.

Formatting, better comments.

--- src/onyx/plugin/messaging_output.clj
+++ src/onyx/plugin/messaging_output.clj
@@ -48,7 +48,7 @@

 ;; TODO: split out destinations for retry, may need to switch destinations, can
 ;; do every thing in a single offer
-;; TODO: be smart about sending messages to ;; multiple co-located tasks
+;; TODO: be smart about sending messages to multiple co-located tasks
 (defn send-messages [messenger ^MessageEncoder encoder buffer prepared]
   (let [replica-version (m/replica-version messenger)
         epoch (m/epoch messenger)
@@ -124,11 +124,12 @@
             false)))))

 (defn new-messenger-output [{:keys [onyx.core/task-map onyx.core/monitoring] :as event}]
-  ;; FIXME: should be configured via information model
   (let [write-batch-size (or (:onyx/batch-write-size task-map) (:onyx/batch-size task-map))
+        ;; FIXME: should be configured via information model
         bs (byte-array 10000000)
         buffer (UnsafeBuffer. bs)
         tmp-storage (java.util.ArrayList. 2000)]
-    ;; set message type in buffer ahead of time
+    ;; set message type in buffer early, as we will be re-using the buffer
     (sz/put-message-type buffer 0 sz/message-id)
-    (->MessengerOutput nil (MessageEncoder.) buffer (long write-batch-size) tmp-storage (:written-bytes monitoring))))
+    (->MessengerOutput nil (MessageEncoder.) buffer (long write-batch-size)
+                       tmp-storage (:written-bytes monitoring))))


Adds histograms by failure reason for run/cpu/mem time (#734)

* Adds histograms by failure reason for run/cpu/mem time

* Refactors the histogram titles

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -170,6 +170,24 @@
                                         (String. (.toByteArray (:data s)))))
                       (catch Exception e
                         (log/debug e "Error reading a string from mesos status data. Is it in the format we expect?")))))})
+
+(defn update-reason-histos!
+  "Updates histograms for run time, cpu time, and memory time,
+  where the histograms have the failure reason in the title"
+  [db mesos-reason instance-runtime {:keys [cpus mem]}]
+  (let [reason (->> mesos-reason
+                    (reason/mesos-reason->cook-reason-entity-id db)
+                    (d/entity db)
+                    :reason/name
+                    name)
+        update-histo! (fn update-histo! [s v]
+                        (histograms/update!
+                          (histograms/histogram
+                            ["cook-mesos" "scheduler" "hist-task-fail" reason s])
+                          v))]
+    (update-histo! "times" instance-runtime)
+    (update-histo! "cpu-times" (* instance-runtime cpus))
+    (update-histo! "mem-times" (* instance-runtime mem))))

 (defn handle-status-update
   "Takes a status update from mesos."
@@ -233,7 +251,9 @@
                                         instance-runtime)
              (handle-throughput-metrics complete-throughput-metrics
                                         job-resources
-                                        instance-runtime))
+                                        instance-runtime)
+             (when-not previous-reason
+               (update-reason-histos! db reason instance-runtime job-resources)))
            ;; This code kills any task that "shouldn't" be running
            (when (and
                    (or (nil? instance) ; We could know nothing about the task, meaning a DB error happened and it's a waste to finish


Make tests-to-run also run tests in current namespace

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

--- src/conexp/util.clj
+++ src/conexp/util.clj
@@ -150,9 +150,11 @@

 (defmacro tests-to-run
   "Defines tests to run when the namespace in which this macro is
-  called is tested by test-ns."
+  called is tested by test-ns.  Additionally, runs all tests in the
+  current namespace, before all other tests in supplied as arguments."
   [& namespaces]
   `(defn ~'test-ns-hook []
+     (test-all-vars ~'*ns*)
      (doseq [ns# '~namespaces]
        (let [result# (do (require ns#) (test-ns ns#))]
          (dosync


Fix leap year tests

Fix leap year tests

--- assignments/clojure/leap/leap_test.clj
+++ assignments/clojure/leap/leap_test.clj
@@ -11,6 +11,6 @@
   (is (not (leap-year? 1900))))

 (deftest exceptional-century
-  (is (leap-year? 2000)))
+  (is (leap-year? 2400)))

 (run-tests)


[#2789] Fixing test

[#2789] Fixing test

--- backend/test/akvo/lumen/test_utils.clj
+++ backend/test/akvo/lumen/test_utils.clj
@@ -165,6 +165,7 @@
   (fn [handler]
     (fn [req]
       (handler (assoc req :jwt-claims {"typ" "Bearer"
+                                       "given_name" "User$auth$"
                                        "https://akvo.org/user_metadata" {"new_authz_flag" "true"}})))))

 (defmethod ig/init-key :akvo.lumen.test-utils/wrap-auth-datasets  [_ {:keys [tenant-manager] :as opts}]


fix typo

fix typo

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

--- plugins/SlideExplorer2/src/slide_explorer/cache.clj
+++ plugins/SlideExplorer2/src/slide_explorer/cache.clj
@@ -52,7 +52,7 @@
 (defn add-item
   "Add an item to the LRU persistent map. Like assoc."
   ([lru-map key val overwrite?]
-  (if (or (not lru-map key)
+  (if (or (not (lru-map key))
           overwrite?)
     (-> lru-map
         (assoc key val)


fixed next button was enabled when on last page

--- src/tango/cljs/adjudicator/core.cljs
+++ src/tango/cljs/adjudicator/core.cljs
@@ -353,9 +353,9 @@
                                                            :app/heat-page])} "Previous"))
         (dom/div #js {:className "col-xs-offset-4 col-xs-4"}
           (dom/button #js {:className "btn btn-primary btn-block btn-lg"
-                           :disabled (= current-page last-page)
-                           :onClick  #(om/transact! this `[(app/heat-page {:page ~(inc current-page)})
-                                                           :app/heat-page])} "Next"))))))
+                           :disabled  (= current-page (dec last-page))
+                           :onClick   #(om/transact! this `[(app/heat-page {:page ~(inc current-page)})
+                                                            :app/heat-page])} "Next"))))))

 ;https://medium.com/@kovasb/om-next-the-reconciler-af26f02a6fb4#.kwq2t2jzr
 (defui MainComponent


Break infinite loop when we hear about unknown tasks.

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -210,6 +210,7 @@
                                           job-resources
                                           instance-runtime))
              (when (or (nil? instance)
+                       (not= task-state :task-lost) ; killing an unknown task causes a TASK_LOST message. Break the cycle!
                        (= prior-job-state :job.state/completed)
                        (= prior-instance-status :instance.status/failed))
                (log/warn "Attempting to kill task" task-id


Add more tests

Add more tests

--- test/icecap/async_util_test.clj
+++ test/icecap/async_util_test.clj
@@ -1,19 +1,24 @@
-(ns icecap.async-util
+(ns icecap.async-util-test
   (:require [clojure.core.async :refer [<!! go] :as a]
             [icecap.async-util :refer :all]
             [clojure.test :refer :all]))

+(defn ^:private assert-false?
+  "Checks if this is an exception matching the one raised when
+  evaluating `(assert false)`."
+  [e]
+  (and (instance? AssertionError e)
+       (= (.getMessage e) "Assert failed: false")))
+
 (defmacro ^:private has-exc
-  "Checks if the given chan has a failed assertion on it, and then closes."
-  [c]
-  `(is
-    (let [e# (<!! ~c)
-          n# (<!! ~c)]
-      (prn e#)
-      (prn n#)
-      (and (instance? AssertionError e#)
-           (= (.getMessage e#)
-              "Assert failed: false")           ))))
+  "Checks if the given chan has a failed assertion on it, and then
+  closes."
+  [chan-expr]
+  `(is (let [c# ~chan-expr
+             exception# (<!! c#)
+             next-val# (<!! c#)]
+         (and (assert-false? exception#)
+              (nil? next-val#)))))

 (deftest go-catch-tests
   (testing "returns exceptions"
@@ -26,8 +31,19 @@

 (deftest <!!?-tests
   (testing "take a value"
-    (is (= (<!!? (go 1))
-           1)))
+    (is (= (<!!? (go 1 2 3))
+           3)))
   (testing "raise an exc"
     (is (thrown-with-msg? AssertionError #"Assert failed: false"
                           (<!!? (go-catch (assert false)))))))
+
+(deftest <!?-tests
+  (testing "take a value"
+    (let [inner-chan (a/to-chan [1 2 3])
+          outer-chan (go (<!? inner-chan))]
+      (is (= (<!! outer-chan)
+             1))))
+  (testing "raise an exc"
+    (let [err-chan (go-catch (assert false))
+          <!?-chan (go-catch (<!? err-chan))]
+      (is (assert-false? (<!! <!?-chan))))))


CMR-5016: Added test for CORS headers.

CMR-5016: Added test for CORS headers.

--- system-int-test/test/cmr/system_int_test/header_test.clj
+++ system-int-test/test/cmr/system_int_test/header_test.clj
@@ -1,10 +1,13 @@
 (ns cmr.system-int-test.header_test
   "Tests for headers in ingest and search responses"
   (:require [clojure.test :refer :all]
+            [clj-http.client :as client]
+            [clojure.string :as string]
             [cmr.system-int-test.utils.ingest-util :as ingest]
             [cmr.system-int-test.utils.search-util :as search]
             [cmr.system-int-test.utils.index-util :as index]
             [cmr.system-int-test.data2.collection :as dc]
+            [cmr.system-int-test.utils.url-helper :as url]
             [cmr.common-app.api.routes :as routes]))

 (use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1"}))
@@ -67,3 +70,21 @@
                               {:headers {:cmr-request-id cmr-request-id}
                                :throw-exceptions false})]
       (is (cmr-request-id-in-header? headers cmr-request-id)))))
+
+(deftest cors-headers
+  (testing "allowed headers in options search request"
+    (let [allowed-headers (-> (client/options (url/search-url :collection))
+                              (get-in [:headers "Access-Control-Allow-Headers"])
+                              (string/split #", "))]
+      (is (some #{"Echo-Token"} allowed-headers))
+      (is (some #{"Client-Id"} allowed-headers))
+      (is (some #{"CMR-Request-Id"} allowed-headers))
+      (is (some #{"CMR-Scroll-Id"} allowed-headers))))
+
+  (testing "exposed headers in search request"
+    (let [exposed-headers (-> (client/head (url/search-url :collection))
+                              (get-in [:headers "Access-Control-Expose-Headers"])
+                              (string/split #", "))]
+      (is (some #{"CMR-Hits"} exposed-headers))
+      (is (some #{"CMR-Request-Id"} exposed-headers))
+      (is (some #{"CMR-Scroll-Id"} exposed-headers)))))


Undo earlier change

Undo earlier change

don’t ruin the core classes!

--- src/webapp/framework/server/core.clj
+++ src/webapp/framework/server/core.clj
@@ -40,7 +40,7 @@
            (if (:action params) (:action params) (:systemaction params))
            " "

-           (if (or (> (count (keys (load-string (str (:params params))))) 0) post-data)
+           (if (or (> (count (keys (load-string  (:params params)))) 0) post-data)
              (str  (:params params)))
            " "


Remove describe relative-path-from from copy-spec.

--- spec/incise/parsers/impl/copy_spec.clj
+++ spec/incise/parsers/impl/copy_spec.clj
@@ -7,17 +7,13 @@

 (def spec-temp-dir (partial temp-dir "incise-copy-spec"))

-(defn in-directory? [directory file-in-dir]
-  ""
+(defn in-directory?
+  "Check to see if the given file has a canonical path with the given
+  directory."
+  [directory file-in-dir]
   (let [dir-path (.getCanonicalPath directory)
         file-path (.getCanonicalPath file-in-dir)]
     (= dir-path (subs file-path 0 (count dir-path)))))
-
-(describe "relative-path-from"
-  (with dir (file "/hey/there/"))
-  (with afile (file "/hey/there/pants/party"))
-  (it "returns a relative path from the given directory"
-    (should= "pants/party" (relative-path-from @dir @afile))))

 (describe "parse"
   (with copyme (file (resource "spec/COPYME")))


delaney.clj: DSymbol reader treats zeroes correctly

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -233,7 +233,8 @@
   (reduce (fn [ds i]
             (reduce (fn [ds [D E]] (glue ds i D E))
                     ds
-                    (pairs (nth gluings i) (elements ds))))
+                    (filter (fn [[D E]] (element? ds E))
+                            (pairs (nth gluings i) (elements ds)))))
           ds
           (range (count gluings))))

@@ -241,7 +242,8 @@
   (reduce (fn [ds i]
             (reduce (fn [ds [D v]] (spin ds i (inc i) D v))
                     ds
-                    (zipmap (orbit-reps ds [i (inc i)]) (nth spins i))))
+                    (filter (fn [[D v]] (> v 0))
+                      (zipmap (orbit-reps ds [i (inc i)]) (nth spins i)))))
           ds
           (range (count spins))))


[scamp] use utils ns

[scamp] use utils ns

--- modules/scamp/src/scamp/core.clj
+++ modules/scamp/src/scamp/core.clj
@@ -16,7 +16,8 @@
   "
   (:require [clojure.string :as str]
             [taoensso.timbre :as timbre]
-            [schema.core :as s]))
+            [schema.core :as s]
+            [scamp.util :as util]))

 (s/set-fn-validation! true)

@@ -64,10 +65,6 @@
   [base-duration agitation-distance]
   (let [agitation (- (*rand* agitation-distance) (/ agitation-distance 2))]
     (int (+ base-duration agitation))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn- concatv [coll & colls]
-  (vec (apply concat coll colls)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Schema definitions
@@ -389,7 +386,7 @@
                                   [(assoc node
                                           :send-next-heartbeats-milli-time
                                           (+ milli-time heartbeat-interval-in-millis))
-                                   (concatv msgs
+                                   (util/concatv msgs
                                            (mapv #(msg->envelope %
                                                                  :heartbeat
                                                                  this-node-contact-address)
@@ -483,7 +480,7 @@
   messages added."
   [world :- WorldSchema
    new-messages :- [MessageEnvelopeSchema]]
-  (update-in world [:message-envelopes] concatv new-messages))
+  (update-in world [:message-envelopes] util/concatv new-messages))

 (s/defn get-node-from-world :- NetworkedNodeSchema
   [world :- WorldSchema
@@ -627,12 +624,7 @@
                :receive-msg-node-unsubscription
                :replacement-messages replacement-messages
                :drop-me-msgs drop-me-msgs)
-      [(node->removed node) (concatv replacement-messages drop-me-msgs)])))
-
-(s/defn set-disclude :- #{s/Any}
-  [s :- #{s/Any}
-   to-remove :- s/Any]
-  (into #{} (remove #(= % to-remove) s)))
+      [(node->removed node) (util/concatv replacement-messages drop-me-msgs)])))

 (s/defmethod receive-msg :node-removal :- CommUpdateSchema
   #_"Take 'config, a 'node, and the contact address of a
@@ -650,8 +642,8 @@
                :node node
                :node-to-remove node-to-remove)
   [(-> node
-       (update-in [:upstream] set-disclude node-to-remove)
-       (update-in [:downstream] set-disclude node-to-remove))
+       (update-in [:upstream] util/set-disclude node-to-remove)
+       (update-in [:downstream] util/set-disclude node-to-remove))
    []])

 (s/defmethod receive-msg :heartbeat :- CommUpdateSchema
@@ -715,7 +707,7 @@
       (tick-clock-millis!) ; This makes 1000 msg/"second" the upper bound of throughput.
       (world-do-async-processing world)
       (-> world
-          (assoc :message-envelopes (concatv message-envelopes new-message-envelopes))
+          (assoc :message-envelopes (util/concatv message-envelopes new-message-envelopes))
           (assoc-in [:network destination-node-id] new-destination-node)))))

 (s/defn world-do-all-comms :- WorldSchema


lein-release plugin: preparing 0.3.31 release

--- re_view/project.clj
+++ re_view/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view "0.3.31-SNAPSHOT"
+(defproject re-view "0.3.31"
   :description "Tiny React wrapper"
   :url "https://www.github.com/braintripping/re-view/tree/master/re_view"
   :license {:name "Eclipse Public License"


prevent 'currently typing' message form animating

--- src-cljs/frontend/components/chat.cljs
+++ src-cljs/frontend/components/chat.cljs
@@ -140,7 +140,7 @@
           (if chat-submit-learned?
             (list
               (when (seq chatting)
-                [:label.chat-typing-notice {:data-typing-notice (let [uuid->cust (get-in app [:cust-data :uuid->cust])
+                [:div.chat-typing-notice {:data-typing-notice (let [uuid->cust (get-in app [:cust-data :uuid->cust])
                                                                     cust-names (reduce (fn [acc chatter]
                                                                                (conj acc
                                                                                (gstring/truncate


Pretty print JavaScript arrays and objects

--- planck-cljs/src/planck/pprint/data.cljs
+++ planck-cljs/src/planck/pprint/data.cljs
@@ -5,6 +5,7 @@
    [clojure.string :as string]
    [fipp.engine :refer [pprint-document]]
    [fipp.visit :refer [visit visit*]]
+   [goog.object :as gobj]
    [planck.themes]))

 ;; Derived from fipp.edn
@@ -56,8 +57,20 @@
   fipp.visit/IVisitor

   (visit-unknown [this x]
-    (if (instance? Eduction x)
+    (cond
+      (instance? Eduction x)
       (visit this (sequence x))
+      (array? x)
+      (pretty-coll this "#js [" x :line "]" visit)
+      (object? x)
+      (let [kvs (map (fn [k]
+                       [(cond-> k (some? (re-matches #"[A-Za-z][\w\*\+\?!\-']*" k)) keyword)
+                        (gobj/get x k)])
+                  (js-keys x))]
+        (pretty-coll this "#js {" kvs [:span "," :line] "}"
+          (fn [printer [k v]]
+            [:span (visit printer k) " " (visit printer v)])))
+      :else
       [:text (binding [*print-meta* false] (pr-str x))]))

   (visit-nil [this]


Function for counting vars and ops in formulas added

--- src/logic/tools.clj
+++ src/logic/tools.clj
@@ -37,3 +37,28 @@
         (str "!" (clj-to-fml arg1))
         (str "(" (clj-to-fml arg1) (apply str (map #(str (reconvert-map op) (clj-to-fml %)) (rest (rest fml)))) ")")))
     fml))
+
+(defn- count-rec [f [cnt-op cnt-var]]
+  (cond
+    (not (seq? f)) [cnt-op (inc cnt-var)]
+    (= (first f) 'not) (count-rec (second f) [(inc cnt-op) cnt-var])
+    :else (count-rec (nth f 2) (count-rec (second f) [(inc cnt-op) cnt-var]))
+    ))
+
+(defn count-vars-ops [fml]
+  (let [p-fml (javaCCparse fml)
+        [cnt-op cnt-var] (count-rec p-fml [0 0])]
+
+    (println "Number of operators:" cnt-op)
+    (println "Number of variables:" cnt-var)))
+
+(comment
+	(require '[parser_measures.formulas :as forms])
+
+	(count-vars-ops forms/formula-usa)
+	(count-vars-ops forms/formula-4-queens)
+	(count-vars-ops forms/formula-8-queens)
+	(count-vars-ops forms/formula-quarter-sudoku)
+	(count-vars-ops forms/formula-half-sudoku)
+	(count-vars-ops forms/formula-sudoku)
+)


More elegant solution for newline problem

--- cortex/test/cljc/cortex/util_test.cljc
+++ cortex/test/cljc/cortex/util_test.cljc
@@ -203,12 +203,12 @@
   (testing "lazy-map macro"
     (is (= (with-out-str
              (let [m (lazy-map
-                       {:a (print "value :a was realized")
-                        :b (print "value :b was realized")
-                        :c (print "value :c was realized")})]
+                       {:a (println "value :a was realized")
+                        :b (println "value :b was realized")
+                        :c (println "value :c was realized")})]
                (doseq [k [:b :c]]
                  (k m))))
-           "value :b was realizedvalue :c was realized")))
+           (format "value :b was realized%nvalue :c was realized%n"))))
   (testing "forcing a lazy map"
     (is (= (->> (lazy-map
                   {:a (println "value :a was realized")
@@ -294,5 +294,5 @@
            "[[1.0 0.0] [0.0 1.0]]"))))

 (deftest sprintf-test
-  (is (= (.trim (with-out-str (sprintf "%(d%n" [[1 -3 5] [-7 3]])))
-         "[[1 (3) 5] [(7) 3]]")))
+  (is (= (with-out-str (sprintf "%(d%n" [[1 -3 5] [-7 3]]))
+         (format "[[1 (3) 5] [(7) 3]]%n"))))


render the docs

render the docs

--- frontend/components/documentation.cljs
+++ frontend/components/documentation.cljs
@@ -1,322 +1,80 @@
 (ns frontend.components.documentation
-  (:require [om.core :as om :include-macros true]
+  (:require [clojure.string :as string]
+            [dommy.core :as dommy]
+            [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
-            [frontend.components.docs.android :as android]
-            [frontend.components.docs.api :as api]
-            [frontend.components.docs.background-process :as background-process]
-            [frontend.components.docs.browser-debugging :as browser-debugging]
-            [frontend.components.docs.build-artifacts :as build-artifacts]
-            [frontend.components.docs.bundler-latest :as bundler-latest]
-            [frontend.components.docs.cant-follow :as cant-follow]
-            [frontend.components.docs.capybara-timeout :as capybara-timeout]
-            [frontend.components.docs.chromedriver-moving-elements :as chromedriver-moving-elements]
-            [frontend.components.docs.clojure-12 :as clojure-12]
-            [frontend.components.docs.composer-api-rate-limit :as composer-api-rate-limit]
-            [frontend.components.docs.config-sample :as config-sample]
-            [frontend.components.docs.configuration :as configuration]
-            [frontend.components.docs.continuous-deployment :as continuous-deployment]
-            [frontend.components.docs.deploy-google-app-engine :as deploy-google-app-engine]
-            [frontend.components.docs.dont-run :as dont-run]
-            [frontend.components.docs.ec2ip-and-security-group :as ec2ip-and-security-group]
-            [frontend.components.docs.environment :as environment]
-            [frontend.components.docs.environment-variables :as environment-variables]
-            [frontend.components.docs.external-resources :as external-resources]
-            [frontend.components.docs.file-ordering :as file-ordering]
-            [frontend.components.docs.filesystem :as filesystem]
-            [frontend.components.docs.getting-started :as getting-started]
-            [frontend.components.docs.git-bundle-install :as git-bundle-install]
-            [frontend.components.docs.git-npm-install :as git-npm-install]
-            [frontend.components.docs.git-pip-install :as git-pip-install]
-            [frontend.components.docs.github-permissions :as github-permissions]
-            [frontend.components.docs.github-privacy :as github-privacy]
-            [frontend.components.docs.github-security-ssh-keys :as github-security-ssh-keys]
-            [frontend.components.docs.how-parallelism-works :as how-parallelism-works]
-            [frontend.components.docs.how-to :as how-to]
-            [frontend.components.docs.installing-custom-software :as installing-custom-software]
-            [frontend.components.docs.installing-elasticsearch :as installing-elasticsearch]
-            [frontend.components.docs.introduction-to-continuous-deployment :as introduction-to-continuous-deployment]
-            [frontend.components.docs.language-haskell :as language-haskell]
-            [frontend.components.docs.language-nodejs :as language-nodejs]
-            [frontend.components.docs.language-php :as language-php]
-            [frontend.components.docs.language-python :as language-python]
-            [frontend.components.docs.language-ruby-on-rails :as language-ruby-on-rails]
-            [frontend.components.docs.languages :as languages]
-            [frontend.components.docs.look-at-code :as look-at-code]
-            [frontend.components.docs.manually :as manually]
-            [frontend.components.docs.missing-dir :as missing-dir]
-            [frontend.components.docs.missing-file :as missing-file]
-            [frontend.components.docs.oom :as oom]
-            [frontend.components.docs.parallel-manual-setup :as parallel-manual-setup]
-            [frontend.components.docs.permissions-and-access-during-deployment :as permissions-and-access-during-deployment]
-            [frontend.components.docs.php-memcached-compile-error :as php-memcached-compile-error]
-            [frontend.components.docs.polling-project-status :as polling-project-status]
-            [frontend.components.docs.privacy-security :as privacy-security]
-            [frontend.components.docs.reference :as reference]
-            [frontend.components.docs.requires-admin :as requires-admin]
-            [frontend.components.docs.rspec-wrong-exit-code :as rspec-wrong-exit-code]
-            [frontend.components.docs.ruby-debugger-problems :as ruby-debugger-problems]
-            [frontend.components.docs.ruby-exception-during-schema-load :as ruby-exception-during-schema-load]
-            [frontend.components.docs.skip-a-build :as skip-a-build]
-            [frontend.components.docs.ssh-build :as ssh-build]
-            [frontend.components.docs.status-badges :as status-badges]
-            [frontend.components.docs.test-with-solr :as test-with-solr]
-            [frontend.components.docs.time-date :as time-date]
-            [frontend.components.docs.time-day :as time-day]
-            [frontend.components.docs.time-seconds :as time-seconds]
-            [frontend.components.docs.troubleshooting :as troubleshooting]
-            [frontend.components.docs.troubleshooting-browsers :as troubleshooting-browsers]
-            [frontend.components.docs.troubleshooting-clojure :as troubleshooting-clojure]
-            [frontend.components.docs.troubleshooting-nodejs :as troubleshooting-nodejs]
-            [frontend.components.docs.troubleshooting-php :as troubleshooting-php]
-            [frontend.components.docs.troubleshooting-python :as troubleshooting-python]
-            [frontend.components.docs.troubleshooting-ruby :as troubleshooting-ruby]
-            [frontend.components.docs.unusual :as unusual]
-            [frontend.components.docs.what-happens :as what-happens]
-            [frontend.components.docs.wrong-ruby-commands :as wrong-ruby-commands]
-            [frontend.components.docs.wrong-ruby-version :as wrong-ruby-version]
-            [frontend.utils :refer [mlog]]
+            [frontend.utils :as utils :include-macros true]
+            [frontend.utils.docs :as doc-utils]
+            [goog.string :as gstring]
             [sablono.core :as html :refer-macros [html]])
-  (:require-macros [frontend.utils :refer [defrender]]))
-
-(defn docmap
-  [docs]
-  (zipmap (map :url docs) docs))
-
-(def documentation-pages
-  (docmap [android/article
-           api/article
-           background-process/article
-           browser-debugging/article
-           build-artifacts/article
-           bundler-latest/article
-           cant-follow/article
-           capybara-timeout/article
-           chromedriver-moving-elements/article
-           clojure-12/article
-           composer-api-rate-limit/article
-           config-sample/article
-           configuration/article
-           continuous-deployment/article
-           deploy-google-app-engine/article
-           dont-run/article
-           ec2ip-and-security-group/article
-           environment/article
-           environment-variables/article
-           external-resources/article
-           file-ordering/article
-           filesystem/article
-           getting-started/article
-           git-bundle-install/article
-           git-npm-install/article
-           git-pip-install/article
-           github-permissions/article
-           github-privacy/article
-           github-security-ssh-keys/article
-           how-parallelism-works/article
-           how-to/article
-           installing-custom-software/article
-           installing-elasticsearch/article
-           introduction-to-continuous-deployment/article
-           language-haskell/article
-           language-nodejs/article
-           language-php/article
-           language-python/article
-           language-ruby-on-rails/article
-           languages/article
-           look-at-code/article
-           manually/article
-           missing-dir/article
-           missing-file/article
-           oom/article
-           parallel-manual-setup/article
-           permissions-and-access-during-deployment/article
-           php-memcached-compile-error/article
-           polling-project-status/article
-           privacy-security/article
-           reference/article
-           requires-admin/article
-           rspec-wrong-exit-code/article
-           ruby-debugger-problems/article
-           ruby-exception-during-schema-load/article
-           skip-a-build/article
-           ssh-build/article
-           status-badges/article
-           test-with-solr/article
-           time-date/article
-           time-day/article
-           time-seconds/article
-           troubleshooting/article
-           troubleshooting-browsers/article
-           troubleshooting-clojure/article
-           troubleshooting-nodejs/article
-           troubleshooting-php/article
-           troubleshooting-python/article
-           troubleshooting-ruby/article
-           unusual/article
-           what-happens/article
-           wrong-ruby-commands/article
-           wrong-ruby-version/article]))
-
-(def getting-started
-  [:getting-started
-   :manually
-   :unusual
-   :configuration])
-
-(def how-to
-  [:installing-custom-software
-   :background-process
-   :code-coverage
-   :external-resources
-   :dont-run
-   :skip-a-build
-   :nightly-builds
-   :test-with-solr
-   :android
-   :continuous-deployment-with-heroku
-   :deploy-google-app-engine])
-
-(def languages
-  [:language-ruby-on-rails
-   :language-python
-   :language-nodejs
-   :language-php
-   :language-java
-   :language-haskell])
-
-(def troubleshooting
-  [:ssh-build
-   :troubleshooting-browsers
-   :troubleshooting-ruby
-   :troubleshooting-python
-   :troubleshooting-nodejs
-   :troubleshooting-php
-   :troubleshooting-clojure
-   :troubleshooting-haskell
-   :oom
-   :file-ordering
-   :filesystem
-   :time-date])
-
-(def reference
-  [:configuration
-   :config-sample
-   :environment
-   :environment-variables
-   :permissions-and-access-during-deployment
-   :status-badges
-   :polling-project-status
-   :api
-   :build-artifacts
-   :ec2ip-and-security-group])
-
-(def parallelism
-  [:how-parallelism-works
-   :parallel-manual-setup])
-
-(def privacy-and-security
-  [:github-privacy
-   :look-at-code])
-
-(def sidebar-menu
-  [{:name "Getting Started"
-    :ref :getting-started
-    :docs getting-started}
-   {:name "Languages"
-    :ref :languages
-    :docs languages}
-   {:name "How-to"
-    :ref :how-to
-    :docs how-to}
-   {:name "Troubleshooting"
-    :ref :troubleshooting
-    :docs troubleshooting}
-   {:name "Reference"
-    :ref :reference
-    :docs reference}
-   {:name "Parallelism"
-    :ref :parallelism
-    :docs parallelism}
-   {:name "Privacy and Security"
-    :ref :privacy-and-security
-    :docs privacy-and-security}])
-
-(defn article-list-item [article-ref & [title-key]]
-  (if-let [article (get documentation-pages article-ref)]
-    (let [article-name (:url article)
-          article-href (str "/docs/" (name article-name))
-          article-children (:children article)
-          title (or
-                  ((or title-key :title) article)
-                  ;; if no short title exists, fall back to using :title
-                  (:title article))
-          formatted-title (if (seq article-children)
-                            (str title " (" (count article-children) ")")
-                            title)]
-      [:li
-       [:a {:href article-href} formatted-title]])
-    (mlog "No article found for " article-ref)))
-
-(defn sidebar-category [category]
-  [:ul.articles
-   [:li
-    [:h4
-     [:a {:href (:ref category)} (:name category)]]]
-   (map #(article-list-item % :short-title) (:docs category))])
-
-(def sidebar (map #(sidebar-category %) sidebar-menu))
-
-(defn doc-section
-  [inner]
-  [:div.docs.page
-   [:div.banner
-    [:div.container
-     [:h1 "Documentation"]]]
-   [:div.container.content
-    [:div.row
-     [:aside.span3 sidebar]
-     [:div.span8.offset1
-      [:article
-       inner]]]]])
-
-(defn doc-search
-  []
-  [:form.clearfix.form-search#searchDocs
-   [:input#searchQuery {:name "query"
-                        :placeholder "What can we help you find?"
-                        :type "search"}]
-   [:button {:type "submit"}
-    [:i.fa.fa-search]]])
+  (:require-macros [frontend.utils :refer [defrender]]
+                   [dommy.macros :refer [sel sel1]]))

-(defrender docpage [app owner opts]
-  (let [article (-> app :current-documentation-page keyword documentation-pages)]
-    (html (doc-section
-            [:article
-             (doc-search)
-             [:h1 (:title article)]
-             (when-let [last-updated (:last-updated article)]
-               [:p.meta
-                [:strong "Last Updated "]
-                last-updated])
-             (when-let [children (-> article :children seq)]
-               [:ul.article_list
-                (map article-list-item children)])
-             (:content article)]))))
+(defn front-page [docs]
+  [:div.row
+   [:h4 "Having problems? Check these sections"]
+   [:ul.articles.span4
+    [:h4 "Getting started"]
+    (doc-utils/render-haml-template "article_list" {:article (:gettingstarted docs) :slug true})]
+   [:ul.articles.span4
+    [:h4 "Troubleshooting"]
+    (doc-utils/render-haml-template "article_list" {:article (:troubleshooting docs) :slug true})]])
+
+(defn render-subpage [doc]
+  [:div
+   (doc-utils/render-haml-template "docs_title" {:article doc})
+   (if (:category doc)
+     (doc-utils/render-haml-template "article_list" {:article doc :slug true})
+     (doc-utils/render-haml-template (:slug doc) doc))])
+
+(defn add-link-targets [node]
+  (doseq [heading (sel node
+                       ".content h2, .content h3, .content h4, .content h5, .content h6")]
+    (let [title (dommy/text heading)
+          id (if-not (string/blank? (.-id heading))
+               (.-id heading)
+               (-> title
+                   string/lower-case
+                   string/trim
+                   (string/replace \' "")     ; heroku's -> herokus
+                   (string/replace #"[^a-z0-9]+" "-") ; dashes
+                   (string/replace #"^-" "") ; don't let first or last be dashes
+                   (string/replace #"-$" "")))]
+      (dommy/set-html! heading
+                       (goog.string/format "%s" id id title)))))
+
+(defn docs-subpage [doc owner]
+  (reify
+    om/IDidMount
+    (did-mount [_] (add-link-targets (om/get-node owner)))
+    om/IDidUpdate
+    (did-update [_ _ _] (add-link-targets (om/get-node owner)))
+    om/IRender
+    (render [_]
+      (html
+       [:div
+        (doc-utils/render-haml-template "docs_title" {:article doc})
+        (if (:category doc)
+          (doc-utils/render-haml-template "article_list" {:article doc :slug true})
+          (doc-utils/render-haml-template (:slug doc) doc))]))))
+

 (defrender documentation [app owner opts]
-  (html (doc-section
-          [:article
-           [:h1 "What can we help you with?"]
-           (doc-search)
-           [:div.row
-            [:h4 "Having problems? Check these sections"]
-            [:div.articles.span4
-             [:h4 "Getting started"]
-             [:ul.articles_list
-              (map article-list-item getting-started)]]
-            [:div.articles.span4
-             [:h4 "Troubleshooting"]
-             [:ul.articles_list
-              (map article-list-item troubleshooting)]]]])))
-
+  (let [subpage (get-in app [:navigation-data :subpage])
+        docs (doc-utils/find-all-docs)
+        categories ((juxt :gettingstarted :languages :how-to :troubleshooting
+                          :reference :parallelism :privacy-security) docs)]
+    (html
+     [:div.docs.page
+      [:div.banner [:div.container [:h1 "Documentation"]]]
+      [:div.container.content
+       [:div.row
+        [:aside.span3
+         (doc-utils/render-haml-template "categories" {:categories categories})]
+        [:div.offset1.span8
+         (doc-utils/render-haml-template "docs_search_form")
+         [:article
+          (if-not subpage
+            (front-page docs)
+            (om/build docs-subpage (get docs subpage)))]]]]])))


cast string to int

cast string to int

--- src/neuseg/dpln.clj
+++ src/neuseg/dpln.clj
@@ -40,6 +40,7 @@
   (with-open [rdr (clojure.java.io/reader train-file-name)]
     (let [data (line-seq rdr)
           [total idm odm] (clojure.string/split (first data) #" ")
+          total (Integer. total)
           idm (Integer. idm)
           odm (Integer. odm)
           train-label (double-array (flatten (map labelize (flatten (partition 1 2 (nthrest data 2))))))]


Minor fix for checking config

Minor fix for checking config

Signed-off-by: Tom Marble <b248307e886b80bf9cb4014595572a835b049bf4@info9.net>

--- src/planviz/cli.clj
+++ src/planviz/cli.clj
@@ -112,7 +112,7 @@
 (defn config-parse-opts [cwd args cli-options]
   (let [arg0 (first args)
         arg0 (if (and (= 1 (count args)) (re-find #".edn$" arg0)) arg0)
-        config-file (if (fs/exists? arg0)
+        config-file (if (and arg0 (fs/exists? arg0))
                       arg0
                       (if (fs/exists? (str cwd "/config/" arg0))
                         (str cwd "/config/" arg0)))]