Some microoptimizations for DL boxes

Some microoptimizations for DL boxes

which, as expected, don't affect the overall performance in a measurable
way.

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

--- src/conexp/contrib/dl/framework/boxes.clj
+++ src/conexp/contrib/dl/framework/boxes.clj
@@ -54,14 +54,14 @@
   [tbox]
   (apply union #{}
 	 (map #(role-names-in-expression (definition-expression %))
-	      (tbox-definitions tbox))))
+	      (vals (tbox-definition-map tbox)))))

 (defn used-concept-names
   "Returns all used concept names in tbox."
   [tbox]
   (apply union #{}
 	 (map #(concept-names-in-expression (definition-expression %))
-	      (tbox-definitions tbox))))
+              (vals (tbox-definition-map tbox)))))

 ;;;

@@ -78,7 +78,8 @@
 	 (and (vector? expr)
 	      (= 2 (count expr))
 	      (tbox? (first expr))
-	      (contains? (defined-concepts (first expr)) (second expr))))))
+	      (contains? (defined-concepts (first expr))
+                         (second expr))))))

 ;;;

@@ -116,13 +117,13 @@
   (when-not (= (tbox-language tbox-1)
                (tbox-language tbox-2))
     (illegal-argument "Cannot unify tboxes of different description logics."))
-  (TBox. (tbox-language tbox-1)
-         (merge-with (fn [old new]
-                       (if-not (= old new)
-                         (illegal-state "Cannot unify tbox with different definitions for the same target.")
-                         new))
-                     (tbox-definition-map tbox-1)
-                     (tbox-definition-map tbox-2))))
+  (make-tbox (tbox-language tbox-1)
+             (merge-with (fn [old new]
+                           (if-not (= old new)
+                             (illegal-state "Cannot unify tbox with different definitions for the same target.")
+                             new))
+                         (tbox-definition-map tbox-1)
+                         (tbox-definition-map tbox-2))))

 ;;;

@@ -130,15 +131,19 @@
   "Substitutes for every defined concept name in tbox a new, globally
   unique, concept name and finally substitutes traget with its new name."
   [[tbox target]]
-  (let [symbols     (defined-concepts tbox)]
+  (let [symbols (defined-concepts tbox)]
     (when-not (some #(= target %) symbols)
       (illegal-argument "Target given to uniquify-ttp does not occur in the defined concepts of the given tbox."))
     (let [new-symbols (map-by-fn (fn [_] (gensym)) symbols)]
       [(make-tbox (tbox-language tbox)
-                  (into {} (for [[sym sym-def] (tbox-definition-map tbox)]
-                             [(new-symbols sym)
-                              (make-dl-definition (new-symbols sym)
-                                                  (substitute (definition-expression sym-def) new-symbols))])))
+                  (reduce! (fn [map [sym sym-def]]
+                             (assoc! map
+                                     (new-symbols sym)
+                                     (make-dl-definition (new-symbols sym)
+                                                         (substitute (definition-expression sym-def)
+                                                                     new-symbols))))
+                           {}
+                           (tbox-definition-map tbox)))
        (new-symbols target)])))

 (defn uniquify-tbox
@@ -157,7 +162,8 @@
   (make-directed-graph (defined-concepts tbox)
                        (fn [A]
                          (free-symbols-in-expression
-                          (definition-expression (find-definition tbox A))))))
+                          (definition-expression
+                            (find-definition tbox A))))))

 (defn acyclic?
   "Returns true iff tbox is acyclic."
@@ -171,26 +177,38 @@
   clarify-ttp (or reduce-ttp) afterwards to remove all unused
   definitions."
   [[tbox target]]
-  (let [reversed-map (reduce (fn [hash-map definition]
-			       (let [name (definition-target definition)]
-				 (update-in hash-map [(expression-term (definition-expression definition))]
-					    conj (definition-target definition))))
-			     {}
-			     (tbox-definitions tbox)),
-	rename-map (into {} (for [definition (tbox-definitions tbox)]
-			      [(definition-target definition),
-			       (first (sort (reversed-map (expression-term (definition-expression definition)))))])),
+  (let [reversed-map (reduce! (fn [map definition]
+                                (let [key (expression-term (definition-expression definition))]
+                                  (assoc! map key (conj (get map key)
+                                                        (definition-target definition)))))
+                              {}
+                              (tbox-definitions tbox)),
+	rename-map   (reduce! (fn [map definition]
+                                (assoc! map
+                                        (definition-target definition)
+                                        (-> definition
+                                            definition-expression
+                                            expression-term
+                                            reversed-map
+                                            ;sort
+                                            first)))
+                              {}
+                              (vals (tbox-definition-map tbox))),
 	new-tbox (make-tbox (tbox-language tbox)
-			    (into {} (for [definition (tbox-definitions tbox)]
-                                       [(definition-target definition)
-                                        (make-dl-definition (tbox-language tbox)
-                                                            (definition-target definition)
-                                                            (substitute (definition-expression definition) rename-map))])))]
+                            (reduce! (fn [map definition]
+                                       (assoc! map
+                                               (definition-target definition)
+                                               (make-dl-definition (tbox-language tbox)
+                                                                   (definition-target definition)
+                                                                   (substitute (definition-expression definition)
+                                                                               rename-map))))
+                                     {}
+                                     (vals (tbox-definition-map tbox))))]
     (if (not= tbox new-tbox)
-      (tidy-up-ttp [new-tbox target])
+      (recur [new-tbox target])
       [tbox target])))

-(defn collect-targets
+(defn- collect-targets
   "Collects all targets reachable in the usage graph of tbox, starting
   from targets."
   [tbox targets seen]
@@ -198,8 +216,10 @@
     seen
     (let [target  (first targets),
 	  seen    (conj seen target),
-	  targets (difference (into targets (free-symbols-in-expression
-					     (definition-expression (find-definition tbox target))))
+	  targets (difference (union targets
+                                     (set (free-symbols-in-expression
+                                           (definition-expression
+                                             (find-definition tbox target)))))
 			      seen)]
       (recur tbox targets seen))))

@@ -209,7 +229,8 @@
   [[tbox target]]
   (let [needed-targets (collect-targets tbox #{target} #{}),
 	new-tbox       (make-tbox (tbox-language tbox)
-                                  (select-keys (tbox-definition-map tbox) needed-targets))]
+                                  (select-keys (tbox-definition-map tbox)
+                                               needed-targets))]
     [new-tbox target]))

 (defn expand-ttp
@@ -221,8 +242,12 @@
     (if (empty? symbols)
       [tbox target]
       (let [target-definition     (find-definition tbox target),
-	    needed-definitions    (into {} (for [[_ sym-def] (select-keys (tbox-definition-map tbox) symbols)]
-                                             [(definition-target sym-def) (definition-expression sym-def)])),
+	    needed-definitions    (reduce! (fn [map [_ sym-def]]
+                                             (assoc! map
+                                                     (definition-target sym-def)
+                                                     (definition-expression sym-def)))
+                                           {}
+                                           (select-keys (tbox-definition-map tbox) symbols)),

 	    new-target-definition (make-dl-definition target
 						      (substitute (definition-expression target-definition)


Fixes test.

Fixes test.

--- test/onyx/log/greedy_multi_job_test.clj
+++ test/onyx/log/greedy_multi_job_test.clj
@@ -61,12 +61,12 @@
   (let [position (<!! ch)
         entry (extensions/read-log-entry (:log env) position)
         new-replica (extensions/apply-log-entry entry replica)]
-    (if-not (and (= (count (:b (get (:allocations replica) j1))) 40)
-                 (zero? (apply + (map count (vals (get (:allocations replica) j2))))))
-      (do (clojure.pprint/pprint entry)
-          (clojure.pprint/pprint new-replica)
-          (recur new-replica))
-      new-replica)))
+    (if (and (= (count (:b (get (:allocations new-replica) j1))) 40)
+             (zero? (apply + (map count (vals (get (:allocations new-replica) j2))))))
+      new-replica
+      (recur new-replica))))
+
+(fact "All peers were reallocated to job 1, task B" true => true)

 (doseq [v-peer v-peers]
   (try


Question concerning impl of cl-set

Question concerning impl of cl-set

--- src/logic/resolution.clj
+++ src/logic/resolution.clj
@@ -27,6 +27,7 @@
   "Returns the set of the distinct elements in the collection of clauses"
   [cl-coll]
   (set cl-coll))
+; better using a transient -> persistent! pattern?

 ; example
 (cl-set [(clause [1 2]) (clause [-1 2]) (clause [1 -2]) (clause [-1 -2])])


Speed up checksum computation

Speed up checksum computation

--- src/mavlink/checksum.clj
+++ src/mavlink/checksum.clj
@@ -15,17 +15,19 @@

 (defn- compute-checksum-bytes
   [^bytes the-bytes start-idx last-idx crc-seed]
-  (reduce
-    (fn [crc idx]
-        (update-crc crc (aget the-bytes idx)))
-    0xffff (range start-idx last-idx)))
+  (loop [crc 0xffff
+         idx start-idx]
+    (if (< idx last-idx)
+      (recur (update-crc crc (aget the-bytes idx)) (inc idx))
+      crc)))

 (defn- compute-checksum-byte-buffer
   [^ByteBuffer the-bytes start-idx last-idx crc-seed]
-  (reduce
-    (fn [crc idx]
-        (update-crc crc (.get the-bytes ^int idx)))
-    0xffff (range start-idx last-idx)))
+  (loop [crc 0xffff
+         idx start-idx]
+    (if (< idx last-idx)
+      (recur (update-crc crc (.get the-bytes ^int idx)) (inc idx))
+      crc)))

 (defn compute-checksum
   "Compute the checksum of a string and return it or of


updates help message

updates help message

--- src/nl_streamer/core.clj
+++ src/nl_streamer/core.clj
@@ -23,7 +23,7 @@
         "It connects to the EEG device and stream its data to the server."
         ""
         "Usage:"
-        "  $ java -jar nl-streamer command [options]"
+        "  $ nl-streamer [command] [options]"
         ""
         "Options:"
         opts-summary


Fix invite to company copy and spacing. Fix verify account instructions copy.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -26,8 +26,9 @@

 (def carrot-explainer "Carrot is the company digest that keeps everyone aligned around what matters most.")

-(def invite-message "invited you to his team on Carrot")
-(def invite-message-with-company "invited you to join the “%s” digest on Carrot")
+(def invite-message "Join your team on Carrot")
+(def invite-message-with-company "Join %s on Carrot")
+(def invite-instructions "%s has invited you to join the %s digest.")
 (def invite-button "Accept invitation")

 (def share-message "sent you a post")
@@ -42,7 +43,7 @@
 (def reset-button-text "Reset Password")

 (def verify-message "Please verify your email")
-(def verify-instructions "Click the link below to verify your account.")
+(def verify-instructions "Welcome to Carrot, your new company digest! Please click the link below to verify your account.")
 (def verify-button-text "Verify Email")

 ;; ----- HTML Fragments -----
@@ -331,13 +332,14 @@
                              :org-logo-url logo-url
                              :org-logo-width logo-width
                              :org-logo-height logo-height}))
-      (when logo? (spacer 35))
+      (when logo? (spacer 40))
       (h1 invite-message)
-      (spacer 20)
+      (spacer 40)
+      (paragraph (format invite-instructions from org-name))
       (when show-note? (note-author from-avatar from))
       (when show-note? (spacer 16))
       (when show-note? (paragraph note))
-      (spacer 35)
+      (spacer 20)
       (left-button invite-button (:token-link invite))
       (spacer 73)]))


add missing bracket (and other minor whitespace changes)

--- src/overtone/sc/ugen.clj
+++ src/overtone/sc/ugen.clj
@@ -145,7 +145,7 @@
   [spec ugen]
   (let [args (:args ugen)
         args-specs (args-with-specs args spec :map)
-        mapped-args (map (fn [[arg map-val]] (if (and (map? map-val)
+        mapped-args (map (fn [[arg map-val]] (if (and (map? map-val)
                                                       (keyword? arg))
                                                (arg map-val)
                                                arg))
@@ -207,12 +207,12 @@
         appender  (partial append-seq-args spec)]
     (assoc spec :init
            (fn [ugen]
-             (-> ugen
-               defaulter
-               mapper
-               initer
-               n-outputer
-               floater
+             (-> ugen
+               defaulter
+               mapper
+               initer
+               n-outputer
+               floater
                appender)))))

 (defn- decorate-ugen-spec
@@ -277,7 +277,7 @@
     (println (apply str (interpose " -> " cat)))))

 (def UGEN-RATE-SORT-FN
-  (zipmap UGEN-RATE-PRECEDENCE (range (count UGEN-RATE-PRECEDENCE)))
+  (zipmap UGEN-RATE-PRECEDENCE (range (count UGEN-RATE-PRECEDENCE))))

 (defn- print-ugen-rates [rates]
   (let [rates (sort-by UGEN-RATE-SORT-FN rates)]


Update docstrings for REPL specials

Update docstrings for REPL specials

Former-commit-id: 17814dcd04f338c1c3f785847222201ffebf0c34

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -157,17 +157,71 @@
   '{in-ns          {:arglists ([name])
                     :doc      "Sets *cljs-ns* to the namespace named by the symbol, creating it if needed."}
     require        {:arglists ([& args])
-                    :doc      "Loads libs, skipping any that are already loaded."}
+                    :doc      "  Loads libs, skipping any that are already loaded. Each argument is
+  either a libspec that identifies a lib or a flag that modifies how all the identified
+  libs are loaded. Use :require in the ns macro in preference to calling this
+  directly.
+
+  Libs
+
+  A 'lib' is a named set of resources in classpath whose contents define a
+  library of ClojureScript code. Lib names are symbols and each lib is associated
+  with a ClojureScript namespace. A lib's name also locates its root directory
+  within classpath using Java's package name to classpath-relative path mapping.
+  All resources in a lib should be contained in the directory structure under its
+  root directory. All definitions a lib makes should be in its associated namespace.
+
+  'require loads a lib by loading its root resource. The root resource path
+  is derived from the lib name in the following manner:
+  Consider a lib named by the symbol 'x.y.z; it has the root directory
+  <classpath>/x/y/, and its root resource is <classpath>/x/y/z.clj. The root
+  resource should contain code to create the lib's namespace (usually by using
+  the ns macro) and load any additional lib resources.
+
+  Libspecs
+
+  A libspec is a lib name or a vector containing a lib name followed by
+  options expressed as sequential keywords and arguments.
+
+  Recognized options:
+  :as takes a symbol as its argument and makes that symbol an alias to the
+    lib's namespace in the current namespace.
+  :refer takes a list of symbols to refer from the namespace..
+  :refer-macros takes a list of macro symbols to refer from the namespace.
+  :include-macros true causes macros from the namespace to be required.
+
+  Flags
+
+  A flag is a keyword.
+  Recognized flags: :reload, :reload-all, :verbose
+  :reload forces loading of all the identified libs even if they are
+    already loaded
+  :reload-all implies :reload and also forces loading of all libs that the
+    identified libs directly or indirectly load via require or use
+  :verbose triggers printing information about each load, alias, and refer
+
+  Example:
+
+  The following would load the library clojure.string :as string.
+
+  (require '[clojure/string :as string])"}
     require-macros {:arglists ([& args])
-                    :doc      "Similar to the require REPL special function but\n  only for macros."}
+                    :doc      "Similar to the require REPL special function but
+    only for macros."}
+    import         {:arglists ([& import-symbols-or-lists])
+                    :doc      "import-list => (closure-namespace constructor-name-symbols*)
+
+  For each name in constructor-name-symbols, adds a mapping from name to the
+  constructor named by closure-namespace to the current namespace. Use :import in the ns
+  macro in preference to calling this directly."}
+    load-file      {:arglists ([name])
+                    :doc     "Sequentially read and evaluate the set of forms contained in the file."}
     doc            {:arglists ([name])
                     :doc      "Prints documentation for a var or special form given its name"}
-    source            {:arglists ([name])
+    source         {:arglists ([name])
                     :doc      "Prints the source code for the given symbol, if it can find it.\n  This requires that the symbol resolve to a Var defined in a\n  namespace for which the source is available.\n\n  Example: (source filter)"}
     pst            {:arglists ([] [e])
-                    :doc      "Prints a stack trace of the exception.\n  If none supplied, uses the root cause of the most recent repl exception (*e)"}
-    load-file      {:arglists ([filename])
-                    :doc      "Loads a file"}})
+                    :doc      "Prints a stack trace of the exception.\n  If none supplied, uses the root cause of the most recent repl exception (*e)"}})

 (defn repl-special? [form]
   (and (seq? form) (repl-special-doc-map (first form))))


Retrieve and render template

Retrieve and render template

--- src/salvador/handler.clj
+++ src/salvador/handler.clj
@@ -7,8 +7,11 @@
             [ring.util.http-response :refer :all]
             [schema.core :as s]
             [clojure.java.io :as io]
+            [org.httpkit.client :as http]
             [ring-aws-lambda-adapter.core :refer [defhandler]]
             [salvador.core :as env]
+            [clostache.parser :refer [render]]
+            [clojure.walk :refer [keywordize-keys]]
             [plumbing.core :refer [fnk]]))

 (def aws-gateway-options
@@ -30,8 +33,14 @@
                     500 {:schema {:code String} :description "Horror"}}
         :parameters {:query-params {:template String}}
         :summary "Render template with request map"
-        :handler (fnk [[:query-params template]]
-                    (ok [template]))})}))
+        :handler (fn [request]
+                   (let [template (-> request :query-params :template)
+                         parameters (dissoc (keywordize-keys (:query-params request)) :template)
+                         {:keys [status headers body error] :as string} @(http/get template)]
+                     (ok {:template-source template
+                          :parameters parameters
+                          :template-body body
+                          :template-expanded (render body parameters)})))})}))

 (def app
   (api


Allow read-line with URL

Allow read-line with URL

Fixes #280

--- planck-cljs/src/planck/http.cljs
+++ planck-cljs/src/planck/http.cljs
@@ -202,9 +202,10 @@
       (letfn [(read [] (let [return @content]
                          (reset! content nil)
                          return))]
-        (planck.core/Reader.
+        (planck.core/BufferedReader.
          read
-         (fn [])))))
+         (fn [])
+         (atom nil)))))
   (make-writer [url opts]
     (planck.core/Writer.
      (fn [s]


Add more logs on error

Add more logs on error

--- backend/src/akvo/lumen/lib/import/flow.clj
+++ backend/src/akvo/lumen/lib/import/flow.clj
@@ -5,7 +5,8 @@
             [akvo.lumen.protocols :as p]
             [akvo.lumen.lib.import.flow-common :as flow-common]
             [akvo.lumen.lib.import.flow-v2 :as v2]
-            [akvo.lumen.lib.import.flow-v3 :as v3]))
+            [akvo.lumen.lib.import.flow-v3 :as v3]
+            [clojure.tools.logging :as log]))

 (defmethod import/dataset-importer "AKVO_FLOW"
@@ -28,8 +29,10 @@
             (<= version 3) (v3/dataset-columns (flow-common/form @survey formId)))
           (catch Throwable e
             (if-let [ex-d (ex-data e)]
-              (throw (ex-info (or (:cause e) (str "Null cause from instance: " instance))
-                              (assoc ex-d :instance instance)))
+              (do
+                (log/error e)
+                (throw (ex-info (or (:cause e) (str "Null cause from instance: " instance))
+                                (assoc ex-d :instance instance))))
               (throw e)))))
       (records [this]
         (try


Join bucket not found tests into a single one

--- test/silly_image_store/handler_test.clj
+++ test/silly_image_store/handler_test.clj
@@ -23,9 +23,10 @@
                           "random" "http://localhost/buckets/some-bucket/random"}))))

   (testing "bucket not found"
-    (let [response (do-get "/buckets/no-such-bucket")]
-      (is (= (:status response) 404))
-      (is (= (:body response) "No thing 'no-such-bucket' found"))))
+    (let [is-not-found (fn [resp] (is (and (= (:status resp) 404)
+                                           (= (:body resp) "No thing 'no-such-bucket' found")))) ]
+      (is-not-found (do-get "/buckets/no-such-bucket"))
+      (is-not-found (do-get "/buckets/no-such-bucket/images"))))

   (testing "view image route"
     (testing "serve image"
@@ -86,11 +87,7 @@
                 {"name" "shed.jpg",
                  "url" "http://localhost/buckets/some-bucket/images/shed.jpg"}
                 ]))))
-
-    (testing "bucket not found"
-      (let [response (do-get "/buckets/no-such-bucket/images")]
-        (is (= (:status response) 404))
-        (is (= (:body response) "No thing 'no-such-bucket' found")))))
+    )

   (testing "listing buckets"
     (let [response (do-get "/buckets")


defemit

defemit

--- proto-oct/src/proto_oct/core.clj
+++ proto-oct/src/proto_oct/core.clj
@@ -1,10 +1,17 @@
 (ns proto-oct.core)
+
+(def ^:dynamic *emit-newlines* true)

 (defmulti emit-code :type)

 ;; Pass-through version of emit-code for literals
 (defmethod emit-code nil [literal]
   literal)
+
+(defmacro defemit [type argvec body]
+  (if *emit-newlines*
+    `(defmethod emit-code ~type ~argvec (str ~body \newline))
+    `(defmethod emit-code ~type ~argvec ~body)))

 (defn define
   ([name value]
@@ -14,7 +21,7 @@
   ([name]
      (define name nil)))

-(defmethod emit-code :define [m]
+(defemit :define [m]
   (if (:value m)
     (str "#define " (:name m) " " (:value m))
     (str "#define " (:name m))))
@@ -27,7 +34,7 @@
   ([file]
      (include file nil)))

-(defmethod emit-code :include [m]
+(defemit :include [m]
   (if (:system m)
     (str "#include <" (:file m) ">")
     (str "#include \"" (:file m) "\"")))
@@ -41,7 +48,7 @@
   ([cond then]
      (ifdef cond then nil)))

-(defmethod emit-code :ifdef [m]
+(defemit :ifdef [m]
   (if (:else m)
     (str "#ifdef " (:cond m) \newline
          (emit-code (:then m)) \newline
@@ -62,7 +69,7 @@
   ([cond then]
      (ifndef cond then nil)))

-(defmethod emit-code :ifndef [m]
+(defemit :ifndef [m]
   (if (:else m)
     (str "#ifndef " (:cond m) \newline
          (emit-code (:then m)) \newline


filter out datoms that will result in a conflict due to doubles getting downgraded to floats

--- src/pc/http/datomic2.clj
+++ src/pc/http/datomic2.clj
@@ -75,6 +75,14 @@
 (defn whitelisted? [[type e a v :as transaction]]
   (contains? incoming-whitelist a))

+(defn remove-float-conflicts [txes]
+  (vals (reduce (fn [tx-index [type e a v :as tx]]
+                  (let [index-key [e a v]]
+                    (if (and (float? v) (contains? tx-index index-key))
+                      (dissoc tx-index index-key)
+                      (assoc tx-index index-key tx))))
+                {} txes)))
+
 ;; TODO: only let creators mark things as private
 ;; TODO: only let people on the white list make things as private

@@ -105,6 +113,7 @@
                             (map (partial coerce-server-timestamp server-timestamp))
                             (map (partial coerce-session-uuid session-uuid))
                             (filter whitelisted?)
+                            (remove-float-conflicts)
                             (concat [(merge {:db/id txid
                                              :document/id document-id
                                              :session/uuid session-uuid


Mention chomp in chop docstring

Mention chomp in chop docstring

--- src/superstring/core.clj
+++ src/superstring/core.clj
@@ -148,7 +148,10 @@

   If the string ends with \\r\\n, both characters are removed.

-  Applying chop to an empty string is a no-op."
+  Applying chop to an empty string is a no-op.
+
+  chomp is often a safer alternative, as it leaves the string
+  unchanged if it doesn’t end in a record separator."
   [^String s]
   {:pre [(string? s)]
    :post [(string? %)]}


A little cleanup (mostly env)

A little cleanup (mostly env)

--- src/polismath/server.clj
+++ src/polismath/server.clj
@@ -25,11 +25,10 @@
 ;; First we'll just set up some basic helpers and settings/variables we'll need.
 ;; We'll really want to move these to the configuration component when that exists. XXX

-(def tmp-dir "/tmp/")
+(def tmp-dir (or (:export-temp-dir env/env) "/tmp/")) ; XXX
 (defn full-path [filename] (str tmp-dir filename))

-(def app-url-base "https://localhost:3000")
-;(def app-url-base "https://polismath-aux.heroku.com")
+(def app-url-base (or (:export-server-url-base env/env) "http://localhost:3000"))
 (defn full-url
   [& path]
   (apply str app-url-base "/" path))
@@ -43,7 +42,6 @@
   [request]
   {:status  200
    :headers {"Content-Type" "text/plain"}
-   :params {:stuff "the x y"}
    :body (with-out-str (clojure.pprint/pprint request))})

@@ -210,7 +208,7 @@

 ;; Requests for exported files in aws.
-
+:
 (defn redirect-to-aws-url
   "Creates a redirection response, which redirects to the aws download link."
   [aws-cred filename]
@@ -333,14 +331,14 @@

 ;; securitay ;; move env variables to config component
 (defn authenticated? [name pass]
-  (and (= name (:server-auth-username env/env))
-       (= pass (:server-auth-pass env/env))))
+  (and (= name (:export-server-auth-username env/env))
+       (= pass (:export-server-auth-pass env/env))))

 ;; Again, base on config component  XXX
 (defn redirect-http-to-https-if-required
   [handler]
   ;; Can cast this as bool? XXX
-  ;(if (= (:server-require-ssl env/env) "true")
+  ;(if (= (:export-server-require-ssl env/env) "true")
   (if false
     (do
       ;; Should be using log
@@ -411,9 +409,7 @@
 ;; Main function; just start the component

 (defn main []
-  (start-server!)
-  (stop-server!)
-  )
+  (start-server!))

 ;; For sketching and REPLING

@@ -425,8 +421,8 @@
   (reset-server!)

   ;(client/request)
-  (let [params {:basic-auth [(:server-auth-username env/env)
-                             (:server-auth-pass env/env)]
+  (let [params {:basic-auth [(:export-server-auth-username env/env)
+                             (:export-server-auth-pass env/env)]
                 :query-params {:zinvite "6sc6vt"
                                ;:at-date
                                :format "csv"}}]
@@ -448,7 +444,7 @@
 ;; # Implement

 ;; Set up env variables in server: :export-aws-link-expiration, :export-expiry-days, :server-port,
-;; :server-auth-username, :server-auth-pass, :aws-access-key, :aws-secret-key
+;; :export-server-auth-username, :export-server-auth-pass, :aws-access-key, :aws-secret-key

 ;; Error handling on export fail...


zinvite -> conversation_id in export urls

--- src/polismath/server.clj
+++ src/polismath/server.clj
@@ -159,11 +159,11 @@
 ;; This will end up redirecting to the aws download link
 (defn private-datadump-url
   [filename zinvite]
-  (private-url (str "datadump/results?filename=" filename "&zinvite=" zinvite)))
+  (private-url (str "datadump/results?filename=" filename "&conversation_id=" zinvite)))

 (defn public-datadump-url
   [filename zinvite]
-  (public-url (str "dataExport/results?filename=" filename "&zinvite=" zinvite)))
+  (public-url (str "dataExport/results?filename=" filename "&conversation_id=" zinvite)))

 ;; Email notification of completion

@@ -329,7 +329,7 @@

 (defn get-status-location-url
   [filename zinvite]
-  (private-url (str "datadump/status?filename=" filename "&zinvite=" zinvite)))
+  (private-url (str "datadump/status?filename=" filename "&conversation_id=" zinvite)))

 (defn check-back-response
   ([filename zinvite status]


Added "How to use" in read-wiki.clj

Added "How to use" in read-wiki.clj

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

--- stuff/code/read-wiki.clj
+++ stuff/code/read-wiki.clj
@@ -221,6 +221,15 @@
      (concept-size A)
      (+ 1 (concept-support model A))))

+;;; How to use
+
+(comment
+
+  (defvar- mymodel (read-wiki-model '[child]))
+  (explore-wiki-model mymodel)
+
+  )
+
 ;;;

 nil


attempts to fix new white padding

attempts to fix new white padding

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -72,11 +72,11 @@
       [:table {:class (str "row  " (if css-class
                                      css-class
                                      " logo"))}
-        [:tr
-          [:th {:class "small-12 large-12 first last columns"}
+        [:tr {:class css-class}
+          [:th {:class (str "small-12 large-12 first last columns" (when css-class css-class))}
             [:table {:class css-class}
-              [:tr
-                [:th
+              [:tr {:class css-class}
+                [:th {:class css-class}
                   [:div
                     {:class "logo-container"}
                     [:img {:class (str "logo " (if (= align "center")
@@ -799,11 +799,12 @@
 ;; ----- General HTML, common to all emails -----

 (defn- body [data]
-  (let [type (:type data)]
+  (let [type (:type data)
+        digest? (= type :digest)]
     [:body
-      (when (= (:type data) :digest)
+      (when digest?
         (go-to-posts-script data))
-      (when (= type :digest)
+      (when digest?
         (digest-preheader data))
       [:table {:class "body"
                :with "100%"}
@@ -811,14 +812,16 @@
           [:td {:valign "middle"
                 :align "center"}
             [:center
-              (email-header (= type :digest))
+              (email-header digest?)
               [:table {:class "row email-content"
                        :valign "middle"
                        :align "center"}
                 [:tr
                   [:td
                     {:class "vertical-padding"}
-                    (spacer 40 "top-email-content")]]
+                   (spacer 40 (if digest?
+                                "digest-header"
+                                "top-email-content"))]]
                 [:tr
                   (case type
                     :reset (token-content "small-12 large-12 columns main-wrapper vertical-padding" type data)


Add initial item utility value

Add initial item utility value

--- src/robinson/itemgen.clj
+++ src/robinson/itemgen.clj
@@ -61,6 +61,10 @@
   [state item]
   (contains? (get-in state [:world :fruit :tongue-identifiable]) (get item :id)))

+(defn is-broken?
+  [item]
+  (not (pos? (get item :utility 1))))
+
 (defn arrow-poison-tipped?
   [state item]
   (and (contains? #{:red-tipped-arrow :orange-tipped-arrow :yellow-tipped-arrrow
@@ -72,9 +76,9 @@

 (def ^:private items
   [
-   {:id  :stick                   :name  "stick"                      :name-plural "sticks" :fuel 100}
+   {:id  :stick                   :name  "stick"                      :name-plural "sticks" :fuel 100 :utility 100}
    {:id  :log                     :name  "log"                        :name-plural "logs" :fuel 500}
-   {:id  :sharpened-stick         :name  "sharpened stick"            :name-plural "sharpened sticks" :attack :spear :fuel 100}
+   {:id  :sharpened-stick         :name  "sharpened stick"            :name-plural "sharpened sticks" :attack :spear :fuel 100 :utility 100}
    {:id  :arrow                   :name  "arrow"                      :name-plural "arrows" :attack :spear :fuel 10}
    {:id  :red-tipped-arrow        :name  "red-tipped arrow"           :name-plural "red-tipped arrows" :attack :spear :fuel 10}
    {:id  :orange-topped-arrow     :name  "orange-tipped arrow"        :name-plural "orange-tipped arrows" :attack :spear :fuel 10}
@@ -82,7 +86,7 @@
    {:id  :green-tipped-arrow      :name  "green-tipped arrow"         :name-plural "green-tipped arrows" :attack :spear :fuel 10}
    {:id  :blue-tipped-arrow       :name  "blue-tipped arrow"          :name-plural "blue-tipped arrows" :attack :spear :fuel 10}
    {:id  :purple-tipped-arrow     :name  "prurple-tipped arrow"       :name-plural "arrows" :attack :spear :fuel 10}
-   {:id  :bow                     :name  "bow"                        :name-plural "bow" :fuel 10}
+   {:id  :bow                     :name  "bow"                        :name-plural "bow" :fuel 10 :utility 100}
    {:id  :plant-fiber             :name  "plant fiber"                :name-plural "plant fibers" :fuel 50}
    {:id  :unhusked-coconut        :name  "unhusked coconut"           :name-plural "husked coconuts"}
    {:id  :coconut                 :name  "coconut"                    :name-plural "coconuts" :thirst 30}
@@ -104,13 +108,13 @@
    {:id  :obsidian-blade          :name  "obsidian blade"             :name-plural "obsidian blades"}
    {:id  :rope                    :name  "rope"                       :name-plural "ropes" :fuel 10}
    {:id  :bamboo                  :name  "bamboo"                     :name-plural "bamboo"}
-   {:id  :obsidian-spear          :name  "obsidian spear"             :name-plural "obsidian spears"       :attack :spear :fuel 50}
-   {:id  :obsidian-axe            :name  "obsidian axe"               :name-plural "obsidian axes"         :attack :axe :fuel 50}
-   {:id  :obsidian-knife          :name  "obsidian knife"             :name-plural "obsidian knives"       :attack :knife :fuel 10}
+   {:id  :obsidian-spear          :name  "obsidian spear"             :name-plural "obsidian spears"       :attack :spear :fuel 50 :utility 100}
+   {:id  :obsidian-axe            :name  "obsidian axe"               :name-plural "obsidian axes"         :attack :axe :fuel 50 :utility 100}
+   {:id  :obsidian-knife          :name  "obsidian knife"             :name-plural "obsidian knives"       :attack :knife :fuel 10 :utility 100}
    {:id  :bamboo-water-collector  :name  "bamboo water collector"     :name-plural "bamboo water collectors"}
    {:id  :fishing-pole            :name  "fishing pole"               :name-plural "fishing poles" :fuel 50}
    {:id  :match                   :name  "match"                      :name-plural "matches" :fuel 10}
-   {:id  :knife                   :name  "knife"                      :name-plural "knives"                :attack :knife}
+   {:id  :knife                   :name  "knife"                      :name-plural "knives"                :attack :knife :utility 100}
    {:id  :plant-guide             :name  "plant guide"                :name-plural "plant guides" :fuel 100}
    {:id  :bandage                 :name  "bandage"                    :name-plural "bandages" :fuel 30}
    {:id  :fishing-line-and-hook   :name  "fishing line and hook"      :name-plural "fishing lines and hooks"}


making dedup work with history

making dedup work with history

--- src/ophion/aggregate.clj
+++ src/ophion/aggregate.clj
@@ -19,7 +19,10 @@
   ([] (dedup "gid"))
   ([field]
    (let [path (dollar field)]
-     [{:$group {:_id path :dedup {:$first "$$ROOT"}}}
+     [{:$project {:_id false}}
+      ;; {:$group {:_id path :dedup {:$addToSet "$$ROOT"}}}
+      ;; {:$unwind "$dedup"}
+      {:$group {:_id {field path "_history" "$_history"} :dedup {:$first "$$ROOT"}}}
       {:$replaceRoot {:newRoot "$dedup"}}])))

     ;; {:$group {:_id dollar (keyword field) {:$first dollar} :_history {:$addToSet "$_history"}}}
@@ -466,3 +469,71 @@

+;; [[:fromUnique "callSetOf" "CallSet"] [:fromUnique "variantOf" "Variant"] [:toUnique "featureOf" "G2PAssociation"] [:toUnique "environmentFor" "Compound"] [:from "responseTo" "ResponseCurve"] [:toUnique "responseFor" "Biosample"] [:count]]
+
+
+
+
+
+;; (def possibles
+;;   (time
+;;    (aggregate/evaluate
+;;     db
+;;     "Individual"
+;;     [[:mark "individual"]
+;;      [:from "sampleOf" "Biosample"]
+;;      [:from "callSetOf" "CallSet" {"vertex.method" "MUTECT"}]
+;;      [:from "variantOf" "Variant"]
+;;      [:to "variantIn" "Gene"]
+;;      [:mark "gene"]
+;;      [:select ["individual" "gene"]]])))
+
+
+
+
+
+;; (time
+;;  (aggregate/evaluate
+;;   db
+;;   "G2PAssociation"
+;;   [[:toUnique "genotypeOf" "Gene"]
+;;    [:from "variantIn" "Variant"]
+;;    [:toUnique "variantOf" "CallSet" {:vertex.method "MUTECT"}]
+;;    [:to "callSetOf" "Biosample"]
+;;    [:toUnique "sampleOf" "Individual"]
+;;    [:count]]))
+
+
+;;   [[:toUnique "genotypeOf" "Gene"]
+;;    [:from "variantIn" "Variant"]
+;;    [:toUnique "variantOf" "CallSet" {:vertex.method "MUTECT"}]
+;;    [:to "callSetOf" "Biosample"]
+;;    [:to "sampleOf" "Individual"]
+;;    [:toUnique "drugTherapyFrom" "Compound"]
+;;    [:count]]
+
+
+;; [{:$lookup {:from "genotypeOf", :localField "gid", :foreignField "from", :as "edge"}}
+;;  {:$unwind "$edge"}
+;;  {:$match {}}
+;;  {:$addFields {"edge._history" "$_history"}}
+;;  {:$replaceRoot {:newRoot "$edge"}}
+;;  {:$group {:_id "$to", :dedup {:$first "$$ROOT"}}}
+;;  {:$replaceRoot {:newRoot "$dedup"}}
+;;  {:$lookup {:from "Gene", :localField "to", :foreignField "gid", :as "vertex"}}
+;;  {:$unwind "$vertex"}
+;;  {:$match {}}
+;;  {:$addFields {"vertex._history" "$_history"}}
+;;  {:$replaceRoot {:newRoot "$vertex"}}
+;;  {:$lookup {:from "variantIn", :localField "gid", :foreignField "to", :as "edge"}}
+;;  {:$unwind "$edge"}
+;;  {:$match {}}
+;;  {:$addFields {"edge._history" "$_history"}}
+;;  {:$replaceRoot {:newRoot "$edge"}}
+;;  {:$lookup {:from "Variant", :localField "from", :foreignField "gid", :as "vertex"}}
+;;  {:$unwind "$vertex"}
+;;  {:$match {}}
+;;  {:$addFields {"vertex._history" "$_history"}}
+;;  {:$replaceRoot {:newRoot "$vertex"}}
+;;  {:$count "count"}
+;;  {:$project {:_id false}}]


Fix (node-tree-seq) with no args

Fix (node-tree-seq) with no args

Fix typo, this should have been calling itself rather than
node-tree-zipper.

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -841,7 +841,7 @@
 (defn node-tree-seq
   "Returns a lazy seq of a depth-first traversal of the tree of the
   specified node defaulting to the current node tree"
-  ([] (node-tree-zipper (:root-group @foundation-groups*)))
+  ([] (node-tree-seq (:root-group @foundation-groups*)))
   ([root] (zipper-seq (node-tree-zipper root))))

 (defn node-tree-matching-synth-ids


Rendering of Use it Internal Copyright Source columns

--- src/zg/html_renderer.clj
+++ src/zg/html_renderer.clj
@@ -296,6 +296,7 @@
         ]
         [:br]
         [:br]
+        (comment
         (form/form-to [:post (str url-prefix "add-word-to-glossary")]
                 [:table {:style "border-collapse: separate; border-spacing: 10px;"}
                     [:tr [:td [:div {:class "_label _label-primary"} "New word:"]]
@@ -315,19 +316,34 @@
                          [:td (form/check-box "copyright")]]
                     [:tr [:td [:div {:class "_label _label-default"} "Source:"]]
                          [:td " "]
-                         [:td (form/drop-down "source" (map (fn [i] [(:source i)(:id i)]) sources) )]]
+                         [:td (form/drop-down "source" (map (fn [i] [(val i)(key i)]) sources) )]]
                     [:tr [:td " "]
                          [:td " "]
                          [:td (form/submit-button {:class "btn btn-primary"} "Add new word")]]]
-                [:br])
+                [:br]))
         [:br]])
+
+(defn yes-no
+    [key-name search-results]
+    (condp = (get search-results key-name)
+        1 "yes"
+        0 "no"
+          "N/A"))

 (defn yes-no-with-caution
     [key-name search-results]
     (condp = (get search-results key-name)
         1 "yes"
         0 "no"
-        2 "with caution"))
+        2 "with caution"
+          "N/A"))
+
+(defn get-source
+    [sources-map key-name search-results]
+    (let [source (get search-results key-name)]
+        (if source
+            (get sources-map (dec source))
+            "N/A")))

 (defn handle-null
     [key-name search-results]
@@ -335,11 +351,12 @@

 (defn render-front-page
     "Render front page of this application."
-    [word user-name search-results sources message url-prefix title emender-page mode]
+    [word user-name search-results sources-map message url-prefix title emender-page mode]
     (println user-name)
     (println url-prefix)
     (println title)
     (println mode)
+    (println (first search-results))
     (page/xhtml
         (render-html-header word url-prefix title)
         [:body
@@ -349,7 +366,7 @@
                 :whitelist    (render-front-page-for-whitelist word url-prefix emender-page mode)
                 :blacklist    (render-front-page-for-blacklist word url-prefix emender-page mode)
                 :atomic-typos (render-front-page-for-atomic-typos word url-prefix emender-page mode)
-                :glossary     (render-front-page-for-glossary word url-prefix emender-page mode sources)
+                :glossary     (render-front-page-for-glossary word url-prefix emender-page mode sources-map)
                 )

                 (if message
@@ -383,9 +400,9 @@
                                          [:td (:description search-result)])
                                      [:td (handle-null :class search-result)]
                                      [:td (yes-no-with-caution :use search-result)]
-                                     [:td (handle-null :internal search-result)]
-                                     [:td (handle-null :copyright search-result)]
-                                     [:td (handle-null :source search-result)]
+                                     [:td (yes-no :internal search-result)]
+                                     [:td (yes-no :copyrighted search-result)]
+                                     [:td (get-source sources-map :source search-result)]
                                      [:td {:style (if deleted "color:red" "color:green")} (if deleted "deleted" "active")]
                                      [:td (if deleted [:a {:href (str "?undelete=" word) :class "btn btn-default"} "undelete"]
                                                       [:a {:href (str "?delete="   word) :class "btn btn-default"}  "delete"])]


Ensure not to prefix a base part if url protocol already given

Change-Id: Ibb7d6300b42bb8fb733ef71a8175e7d514d8d3c0

--- src/qcast/infoq/site.clj
+++ src/qcast/infoq/site.clj
@@ -9,6 +9,8 @@

 ;;; Globals
+
+(def ^:private base-url-prefix "http://www.infoq.com")

 (def ^:private username "infoqcast@gmail.com")

@@ -60,8 +62,12 @@

 ;;; Interface

-(defn base-url [& s]
-  (apply str "http://www.infoq.com" s))
+(defn base-url
+  ([] base-url-prefix)
+  ([& paths]
+     (if (.startsWith (first paths) "http") ;; e.g. CDN links
+       (reduce str paths)
+       (reduce str base-url-prefix paths))))

 (defn poster-url [file-path]
   (when file-path (base-url file-path)))


Add paid license alerts for expiration.

Add paid license alerts for expiration.

--- src-cljs/frontend/components/license.cljs
+++ src-cljs/frontend/components/license.cljs
@@ -54,9 +54,18 @@
                            "Your trial period has expired."
                            {:count (days-until-api-time (:hard_expiry_date license))
                             :nouns ["day" "days"]
-                            :description "before suspension"})
+                            :description "until suspension"})
           ["trial" "expired"]
           (banner-contents "Trial Ended"
+                           "Your builds have been suspended. Contact Sales to reactivate your builds.")
+          ["paid" "in-violation"]
+          (banner-contents "License Expired"
+                           "Your license has expired. Contact Sales to renew."
+                           {:count (days-until-api-time (:hard_expiry_date license))
+                            :nouns ["day" "days"]
+                            :description "until suspension"})
+          ["paid" "expired"]
+          (banner-contents "License Suspended"
                            "Your builds have been suspended. Contact Sales to reactivate your builds.")
           nil)]
     (when contents


remove target for pricing link in about menu

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -337,7 +337,6 @@
              [:span "Home"]]
             [:a.vein.make
              {:href "/pricing"
-              :target "_self"
               :role "button"}
              [:span "Pricing"]]
             [:a.vein.make


Better progress notification on devices.

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -430,29 +430,46 @@
                                                       (keep identity)
                                                       (remove empty?))))))

+(defmulti devices-table-html (fn [devices owner] (:fetching devices)))
+(defmethod devices-table-html :fetching [devices owner]
+  (fetching-row devices))
+
+(defmethod devices-table-html :no-data [devices owner]
+  (no-data-row devices))
+
+(defmethod devices-table-html :error [devices owner]
+  (error-row devices))
+
+(defmethod devices-table-html :has-data [devices owner]
+  (let [table-id   "devices-table"
+        history    (om/get-shared owner :history)]
+    [:div.row
+     [:div.col-md-12
+      [:table {:className "table table-hover"}
+       [:thead
+        [:tr [:th "Name"] [:th "Description"] [:th "Privacy"]]]
+       [:tbody
+        (for [row (sort-by :name (:data devices))]
+          (let [{:keys [id location description privacy]} row
+                name (:name location)]
+            [:tr {:onClick (fn [_ _]
+                             (om/update! devices :selected id)
+                             (history/update-token-ids! history :devices id)
+                             (fixed-scroll-to-element "sensors-div"))
+                  :className (if (= id (:selected devices)) "success")
+                  :id (str table-id "-selected")}
+             [:td name]
+             [:td description]
+             [:td privacy]]))]]]]))
+
+(defmethod devices-table-html :default [devices owner]
+  [:div.row [:div.col-md-12]])
+
 (defn devices-table [devices owner]
   (reify
     om/IRender
     (render [_]
-      (let [table-id   "devices-table"
-            history    (om/get-shared owner :history)]
-        (html
-         [:table {:className "table table-hover"}
-          [:thead
-           [:tr [:th "Name"] [:th "Description"] [:th "Privacy"]]]
-          [:tbody
-           (for [row (sort-by :name (:data devices))]
-             (let [{:keys [id location description privacy]} row
-                   name (:name location)]
-               [:tr {:onClick (fn [_ _]
-                                (om/update! devices :selected id)
-                                (history/update-token-ids! history :devices id)
-                                (fixed-scroll-to-element "sensors-div"))
-                     :className (if (= id (:selected devices)) "success")
-                     :id (str table-id "-selected")}
-                [:td name]
-                [:td description]
-                [:td privacy]]))]])))))
+      (html (devices-table-html devices owner)))))

 (defn devices-div [data owner]
   (reify
@@ -469,15 +486,16 @@
         (if (and new-property-id
                  (not (= (:property-id devices) new-property-id)))
           (do
-            (om/update! devices :fetching true)
+            (om/update! devices :fetching :fetching)
             (GET (str "/4/entities/" new-property-id "/devices/")
                  {:handler  (fn [x]
                               (println "Fetching devices for property: " new-property-id)
                               (om/update! devices :fetching false)
                               (om/update! devices :data (mapv slugify-device x))
+                              (om/update! devices :fetching (if (empty? x) :no-data :has-data))
                               (om/update! devices :selected nil))
                   :error-handler (fn [{:keys [status status-text]}]
-                                   (om/update! devices :fetching false)
+                                   (om/update! devices :fetching :error)
                                    (om/update! devices :error-status status)
                                    (om/update! devices :error-text status-text))
                   ;; FIXME: This should be application/edn
@@ -505,8 +523,7 @@
                   (title-for projects)]]
             [:li [:a
                   {:onClick (back-to-properties history)}
-                  (title-for properties)]
-             " " (when (:fetching devices) [:span {:class "glyphicon glyphicon-cloud-download spinner"}])]]
+                  (title-for properties)]]]
            (om/build devices-table devices {:opts {:histkey :devices}})]])))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


nested-descriptions -> *nested-descriptions*

--- src/midje/internal_ideas/fact_context.clj
+++ src/midje/internal_ideas/fact_context.clj
@@ -3,14 +3,14 @@
   midje.internal-ideas.fact-context
   (:use [clojure.string :only [join]]))

-(def #^:private nested-descriptions (atom []))
+(def #^:private *nested-descriptions* (atom []))

 (defmacro within-fact-context [description & body]
   `(letfn [(enter-context# [description#]
-             (swap! nested-descriptions conj description#))
+             (swap! *nested-descriptions* conj description#))

            (leave-context# []
-             (swap! nested-descriptions #(vec (butlast %))))]
+             (swap! *nested-descriptions* #(vec (butlast %))))]
      (try
        (enter-context# ~description)
        ~@body
@@ -18,5 +18,5 @@
          (leave-context#)))))

 (defn nested-fact-description []
-  (when-let [non-nil (seq (remove nil? @nested-descriptions))]
+  (when-let [non-nil (seq (remove nil? @*nested-descriptions*))]
     (join " - " non-nil)))


Add Templater protocol

Add Templater protocol

--- modules/template/src/modular/template.clj
+++ modules/template/src/modular/template.clj
@@ -31,3 +31,6 @@

 (defn new-aggregate-template-model [& {:as static}]
   (->AggregateTemplateModel static))
+
+(defprotocol Templater
+  (render-template [_ template model]))


Also delete temp dir created for zip file

--- src/vip/data_processor/s3.clj
+++ src/vip/data_processor/s3.clj
@@ -65,4 +65,4 @@
     (put-object zip-name zip-file)
     (-> ctx
         (assoc :generated-xml-filename zip-name)
-        (update :to-be-cleaned conj zip-file))))
+        (update :to-be-cleaned concat [zip-file zip-dir]))))


Add tests for clamp macro

Add tests for clamp macro

--- cortex/test/cljc/cortex/optimise_test.cljc
+++ cortex/test/cljc/cortex/optimise_test.cljc
@@ -5,10 +5,22 @@
     [clojure.core.matrix :as m]
     [clojure.core.matrix.random :as rand-matrix]
     [cortex.nn.layers :as layers]
-    [cortex.optimise :refer [adadelta-optimiser sgd-optimiser newton-optimiser]]
+    [cortex.optimise :as opt :refer [adadelta-optimiser sgd-optimiser newton-optimiser]]
     [cortex.nn.core :refer [output forward backward parameter-count optimise stack-module calc-output]]))

 (defonce ^:dynamic *print-iterations* false)
+
+(deftest test-clamp
+  (testing "in-range values"
+    (is (== 0 (opt/clamp-double 0 -1 1)))
+    (is (== 0.1 (opt/clamp-double 0.1 -1 1)))
+    (is (== -1 (opt/clamp-double -1 -1 1))))
+  (testing "lower bound"
+    (is (== -1 (opt/clamp-double -1.1 -1 1)))
+    (is (== -1 (opt/clamp-double Double/NEGATIVE_INFINITY -1 1))))
+  (testing "upper bound"
+    (is (== 1 (opt/clamp-double 2.0 -1 1)))
+    (is (== 1 (opt/clamp-double Double/POSITIVE_INFINITY -1 1)))))

 ;; simple optimiser testing function: try to optimse a transformation
 (defn optimiser-test


make phantom tests happy

make phantom tests happy

--- test/etaoin/api_test.clj
+++ test/etaoin/api_test.clj
@@ -167,7 +167,7 @@
       (refresh)
       (wait-visible {:id :document-end})
       (click {:id :wait-button})
-      (wait-has-text "-secret-"))
+      (wait-has-text "-secret-" {:message "wait simiple"}))
     (is true "text found"))
   (testing "wait for text timeout"
     (doto *driver*
@@ -177,16 +177,16 @@
     (try+
      (wait-has-text *driver*
                     "-secret-"
-                    {:timeout 0.5
+                    {:timeout 1
                      :message "No -secret- text on the page"})
      (is false "should not be executd")
      (catch [:type :etaoin/timeout] data
        (is (= (-> data (dissoc :predicate :time-rest))
               {:type :etaoin/timeout
                :message "No -secret- text on the page"
-               :timeout 0.5
+               :timeout 1
                :interval 0.1
-               :times 6})))))
+               :times 11})))))
   (testing "wait for non-existing text"
     (doto *driver*
       (refresh)
@@ -194,15 +194,16 @@
     (try+
      (wait-has-text *driver*
                     "-dunno-whatever-foo-bar-"
-                    {:timeout 1})
+                    {:timeout 2
+                     :message "wait non-existing"})
      (is false "should not be executed")
      (catch [:type :etaoin/timeout] data
        (is (= (-> data (dissoc :predicate :time-rest))
               {:type :etaoin/timeout
-               :message nil
-               :timeout 1
+               :message "wait non-existing"
+               :timeout 2
                :interval 0.1
-               :times 11}))))))
+               :times 20}))))))

 (deftest test-wait-has-class
   (is 1)


update game creation spec to include min players

--- src/wombats/handlers/game.clj
+++ src/wombats/handlers/game.clj
@@ -124,7 +124,8 @@
 #_(s/def :game/players) ;; Add player specs

 (s/def :game/name string?)
-(s/def :game/max-players #(instance? Long %))
+(s/def :game/max-players #(and (instance? Long %)
+                               (not= 0 %)))
 (s/def :game/type #{:round})
 (s/def :game/num-rounds #(instance? Long %))
 (s/def :game/round-intermission #(instance? Long %))


fixed typo

fixed typo

--- src/statuses/routing.clj
+++ src/statuses/routing.clj
@@ -122,7 +122,7 @@

 (defn too-long [length request]
   (common/layout
-   (str "Sorry, the maximum lenght is " max-length " but you tried " length " characters")
+   (str "Sorry, the maximum length is " max-length " but you tried " length " characters")
    (nav-links request)))


fix namespase typo

fix namespase typo

--- src_patient/patient/subs.cljs
+++ src_patient/patient/subs.cljs
@@ -1,7 +1,7 @@
 (ns patient.subs
   (:require-macros [reagent.ratom :refer [reaction]])
-  (:require [re-frame.core :refer [subscribe reg-sub reg-sub-raw]])
-  (:require [mobile-patient.model.patient :as patient-model]))
+  (:require [re-frame.core :refer [subscribe reg-sub reg-sub-raw]]
+            [mobile-patient.model.patient :as patient-model]))

 (reg-sub


Wash mouth

Wash mouth

--- ingraph-engine/ingraph-engine-sre-clj/src/sre/constraint.clj
+++ ingraph-engine/ingraph-engine-sre-clj/src/sre/constraint.clj
@@ -10,7 +10,7 @@

 (defmacro defconstraint
   "
-  Let's you define a motherfuckin' constraint like a boss.
+  Let's you define a constraint like a boss.

   Usage:
     (defconstraint MyConstraint [& vars] :implies* constraint-argument-pairs*)


JC: Fix cc-units for batch responses

JC: Fix cc-units for batch responses

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -238,6 +238,13 @@

 (defn- cc-units [^ConsumedCapacity cc] (some-> cc (.getCapacityUnits)))

+(def ^:private batch-cc-units
+  (partial
+    reduce
+    (fn [m cc]
+      (assoc m (keyword (.getTableName cc)) (cc-units cc)))
+    {}))
+
 (defprotocol AsMap (as-map [x]))

 (defmacro ^:private am-item-result [result get-form]
@@ -283,12 +290,12 @@
   (as-map [r]
     {:items       (utils/keyword-map as-map (.getResponses r))
      :unprocessed (.getUnprocessedKeys r)
-     :cc-units    (cc-units (.getConsumedCapacity r))})
+     :cc-units    (batch-cc-units (.getConsumedCapacity r))})

   BatchWriteItemResult
   (as-map [r]
     {:unprocessed (.getUnprocessedItems r)
-     :cc-units    (cc-units (.getConsumedCapacity r))})
+     :cc-units    (batch-cc-units (.getConsumedCapacity r))})

   TableDescription
   (as-map [d]


Make member tables

Make member tables

So that we can have publishers, and users

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -589,30 +589,114 @@

+
+
+
+(defn make-publishers-table []
+  (let [sql-to-create-publishers-table
+        (cond
+          (= *database-type* "postgres" )
+          "
+          CREATE TABLE appshare_publishers
+          (
+          id                   serial NOT NULL,
+          publisher_name       character varying,
+          CONSTRAINT appshare_publishers_pkey PRIMARY KEY (id)
+          );
+          "
+
+          (= *database-type* "oracle" )
+          "
+          CREATE TABLE appshare_publishers
+          (
+          id                 NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          publisher_name     VARCHAR2(200 BYTE),
+          CONSTRAINT  APPSHARE_PUBLISHERS_PK PRIMARY KEY (ID)
+          )")
+        ]
+
+    (if (not (does-table-exist  "appshare_publishers"))
+      (korma.core/exec-raw   [sql-to-create-publishers-table []]   [])
+      nil)))
+
+
+
+
+
+
+
+
+
+
+
 (defn make-users-table []
   (let [sql-to-create-users-table
         (cond
           (= *database-type* "postgres" )
           "
-          CREATE TABLE coils_users
+          CREATE TABLE appshare_users
           (
-          id character varying NOT NULL,
-          user_name character varying,
-          CONSTRAINT coils_users_pkey PRIMARY KEY (id)
+          id                   serial NOT NULL,
+          user_name            character varying,
+          CONSTRAINT appshare_users_pkey PRIMARY KEY (id)
           );
           "

           (= *database-type* "oracle" )
           "
-          CREATE TABLE coils_users
-          (id                 NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
-          USER_NAME           VARCHAR2(200 BYTE),
-          CONSTRAINT  COILS_USERS_PK PRIMARY KEY (ID)
+          CREATE TABLE appshare_users
+          (
+          id            NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          user_name     VARCHAR2(200 BYTE),
+          CONSTRAINT  APPSHARE_USERS_PK PRIMARY KEY (ID)
           )")
         ]

-    (if (not (does-table-exist  "coils_users"))
+    (if (not (does-table-exist  "appshare_users"))
       (korma.core/exec-raw   [sql-to-create-users-table []]   [])
+      nil)))
+
+
+
+
+
+
+
+
+
+
+
+(defn make-logins-table []
+  (let [sql-to-create-logins-table
+        (cond
+          (= *database-type* "postgres" )
+          "
+          CREATE TABLE appshare_logins
+          (
+          id                   serial NOT NULL,
+          login_type           character varying,
+          login_user_name      character varying,
+          login_email          character varying,
+          login_password       character varying,
+          CONSTRAINT appshare_logins_pkey PRIMARY KEY (id)
+          );
+          "
+
+          (= *database-type* "oracle" )
+          "
+          CREATE TABLE appshare_logins
+          (
+          id                   NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          login_type           VARCHAR2(200 BYTE),
+          login_user_name      VARCHAR2(200 BYTE),
+          login_email          VARCHAR2(200 BYTE),
+          login_password       VARCHAR2(200 BYTE),
+          CONSTRAINT  APPSHARE_LOGINS_PK PRIMARY KEY (ID)
+          )")
+        ]
+
+    (if (not (does-table-exist  "appshare_logins"))
+      (korma.core/exec-raw   [sql-to-create-logins-table []]   [])
       nil)))

@@ -890,7 +974,9 @@

 (make-todo-table)
+(make-publishers-table)
 (make-users-table)
+(make-logins-table)
 (make-applications-table)
 (make-triggers-table)
 (make-log-table)


sort out issue with latest/earliest

sort out issue with latest/earliest

--- src/clj/clj_money/models/transactions.clj
+++ src/clj/clj_money/models/transactions.clj
@@ -516,12 +516,14 @@
   [d1 d2]
   (->> [d1 d2]
        sort
+       (filter identity)
        first))

 (defn- later
   [d1 d2]
   (->> [d1 d2]
        (sort #(compare %2 %1))
+       (filter identity)
        first))

 (defn recalculate-account-items
@@ -551,11 +553,9 @@
                            (assoc :quantity last-balance
                                   :value (to-entity-currency last-balance account))
                            (update-in [:earliest-transaction-date]
-                                      (fnil earlier transaction-date)
-                                      transaction-date)
+                                      #(earlier % transaction-date))
                            (update-in [:latest-transaction-date]
-                                      (fnil later transaction-date)
-                                      transaction-date))))))
+                                      #(later % transaction-date)))))))

 (defn- link-lots
   [storage transaction]


remove nrepl backlink, still using piggieback

--- src/clj/cljs_workspace/nrepl_backlink.clj
+++ src/clj/cljs_workspace/nrepl_backlink.clj
@@ -1,119 +0,0 @@
-(ns cljs-workspace.nrepl-backlink
-  (:require [clojure.tools.nrepl.server :as server]
-            [clojure.tools.nrepl :as nrepl]
-            [cemerick.piggieback]
-            [cljs.repl.browser]))
-
-; (defonce server (server/start-server :port 7888))
-
-(def default-env {:port 7889
-                  :client-port 9050
-                  :server nil
-                  :conn nil
-                  :session nil
-                  :browser-repl-enabled false
-                  :browser-repl-env nil})
-
-(defn- reset-env
-  [env]
-  (reset! env default-env))
-
-(defn running?
-  [env]
-  (let [{server :server} @env]
-    (not (or
-          (nil? server)
-          (.isClosed (:server-socket server))))))
-
-(defn start-server
-  [env]
-  (when (running? env) (throw (Exception. "Server already running")))
-  (let [{port :port} @env
-        server (server/start-server
-                :port port
-                :handler (apply server/default-handler
-                                #'cemerick.piggieback/wrap-cljs-repl
-                                ; (map resolve cider.nrepl/cider-middleware)
-                                server/default-middlewares))
-        conn (nrepl/connect :port port)
-        session (nrepl/client-session (nrepl/client conn Long/MAX_VALUE))]
-    (.setReuseAddress (:server-socket server) true)
-    (swap! env #(assoc % :server server :conn conn :session session))))
-
-(defn stop-server
-  [env]
-  (when-not (running? env) (throw (Exception. "Server not running")))
-  (let [{server :server conn :conn} @env]
-   (.close conn)
-   (server/stop-server server)))
-
-(defn cljs-eval
-  [env form]
-  (when-not (running? env) (throw (Exception. "Server not running")))
-  (let [{session :session} @env
-        {browser-repl-env :browser-repl-env} @env
-        ; result (doall (nrepl/message session {:op "eval" :code (str form)}))
-        result (cemerick.piggieback/cljs-eval browser-repl-env form :verbose true)]
-    result))
-
-(defn start-browser-repl-default
-  [env]
-  (let [port (:client-port @env)
-        browser-repl-env (cljs.repl.browser/repl-env :port port)]
-    (cemerick.piggieback/cljs-repl :repl-env browser-repl-env)
-    (swap! env #(assoc % :browser-repl-enabled true))
-    (swap! env #(assoc % :browser-repl-env browser-repl-env))))
-
-(defn start-browser-repl
-  [env]
-  (start-browser-repl-default env))
-
-(defn stop-browser-repl
-  [env]
-  (when (:browser-repl-enabled env)
-    (cljs-eval env :cljs/quit)
-    (swap! env #(assoc % :browser-repl-enabled false))))
-
-
-(defn stop
-  [env]
-  (try (stop-browser-repl env)
-       (catch Exception e
-         (println "Could not stop the browser repl: " e)))
-  (stop-server env)
-  @(future (loop []
-             (Thread/sleep 100)
-             (when-not (.isClosed (:server-socket (:server @env)))
-               (recur))))
-  env)
-
-(defn start-with-env
-  [env & {:keys [cljs-connect] :or {cljs-connect true} :as options}]
-  (when (running? env) (stop env))
-  (try
-   (start-server env)
-   (when cljs-connect (start-browser-repl env))
-   (catch Exception err
-     (do
-       (try (stop-server env) (catch Exception _))
-       (throw err))))
-  env)
-
-(defn start
-  [& options]
-  (apply start-with-env (atom default-env) options))
-
-(comment
-
-  (require '[clojure.tools.nrepl :as repl])
-  (require '[clojure.tools.nrepl.server :as server])
-  (require '[cljs-workspace.nrepl-backlink :as nrepl-local])
-  (server/stop-server nrepl-local/server)
-
-  ; (doc repl/client)
-
-  (with-open [conn (repl/connect :port 7888)]
-     (-> (repl/client conn 1000)
-       (repl/message {:op :eval :code "(+ 1 1)"})
-        repl/response-values))
-)


Add sortnum command

Add sortnum command

--- src/yetibot/core/commands/collections.clj
+++ src/yetibot/core/commands/collections.clj
@@ -206,6 +206,15 @@
 (cmd-hook #"sort"
           _ sort-cmd)

+; sortnum
+(defn sortnum-cmd
+  "sortnum <list> # numerically sort a list"
+  [{items :opts}]
+  (sort #(- (read-string %1) (read-string %2)) (ensure-items-collection items)))
+
+(cmd-hook #"sortnum"
+          _ sortnum-cmd)
+
 ; grep
 (defn slide-context [coll i n]
   (reduce


add thread blocking debug

add thread blocking debug

--- src/thread_load/core.clj
+++ src/thread_load/core.clj
@@ -1,5 +1,5 @@
 (ns thread-load.core
-  (:require [clojure.tools.logging :refer [error]])
+  (:require [clojure.tools.logging :refer [error debug info]])
   (:import
     [java.util ArrayList]
     [java.util.concurrent BlockingQueue ArrayBlockingQueue Executors ExecutorService TimeUnit ThreadPoolExecutor]
@@ -34,7 +34,14 @@
 (defn get-queue-data!
   "Blocks till data is available on the queue and returns the data, queue must be BlockingQueue"
   [^BlockingQueue queue]
-  (.take queue))
+  (if-let [v (.poll queue 5 TimeUnit/SECONDS)]
+    v
+    (do
+      (debug "No data from queue, blocking till data becomes available")
+      (try
+        (.take queue)
+        (finally
+          (debug "Unblocked"))))))

 (defn call-on-fail
   "Only calls init if the return of stop is not :terminate or :fail"
@@ -93,7 +100,11 @@
    by one of the consumer functions
    Returns the pool"
   [pool data]
-   (.put ^BlockingQueue (:queue pool) data)
+   (when-not (.offer ^BlockingQueue (:queue pool) data 5 TimeUnit/SECONDS)
+     (error "Thread load publish queue is full, blocking till a slot becomes available")
+     (.put ^BlockingQueue (:queue pool) data)
+     (info "Unblocked"))
+
    pool)

 (defn bulk-get!
@@ -117,11 +128,11 @@
   "Important: This function is not threadsafe and should only be called from a single producer
    The reason is that the .size of the queue is checked, and if enough space .addAll is called,
    otherwise .put is used"
-  [{:keys [^BlockingQueue queue limit]} data-coll]
+  [{:keys [^BlockingQueue queue limit] :as state} data-coll]
   (if (> (.size queue) limit)
     (.addAll queue data-coll)
     (doseq [data data-coll]
-      (.put queue data))))
+      (publish! state data))))

 (defn shutdown-pool
   "Shutdown the ExecutorService used and wait for termination timeout milliseconds, if the threads did not all terminate, the pool is shutdown forcefully"


Ensure nothing is executed after rollback.

--- src/fhofherr/clj_db_util/transactions.clj
+++ src/fhofherr/clj_db_util/transactions.clj
@@ -67,12 +67,13 @@
   - `f` a function expecting one argument and returning a transaction."
   [tx f]
   (Transaction. (fn [dialect con]
-                  {:pre [dialect con]}
-                  (let [{con* ::connection v ::value} ((:op tx) dialect con)
-                        tx* (f v)]
-                    (if-not (jdbc/db-is-rollback-only con*)
-                      ((:op tx*) dialect con*)
-                      {::connection con* ::value nil})))))
+                  (if-not (jdbc/db-is-rollback-only con)
+                    (let [{con* ::connection v ::value} ((:op tx) dialect con)
+                          tx* (f v)]
+                      (if-not (jdbc/db-is-rollback-only con*)
+                        ((:op tx*) dialect con*)
+                        {::connection con* ::value nil}))
+                    {::connection con ::value nil}))))

 (deftx tx-rollback
   "Rollback the transaction. Further steps won't be executed."


Solving 5.13 - solved via unfold - map, take and take-while (zip-with and zip-all pending)

--- src/fpinscala/strictness_and_laziness.clj
+++ src/fpinscala/strictness_and_laziness.clj
@@ -282,7 +282,7 @@
 ;conceptually - the same, just counting backwards and pattern matching on 1
 ;which I am awoiding as I am sticking to raw clojure without involving core.match

-;5.13 - takeWhile
+;5.13 - take-while
 ;mine
 (defn take-while-via-unfold
   "Take-while via unfold for exercise 5.13 of fpins"
@@ -291,4 +291,16 @@
                     (when (and h (f h))
                       [h t]))))
 ;fpins
-;conceptually - the same+;conceptually - the same
+
+;5.13 - zip-with
+;mine
+(defn zip-with-via-unfold
+  "Zip with for exercise 5.13 of fpins"
+  [f s1 s2]
+  (unfold-fpins [s1 s2] #(let [[[h1 & t1] [h2 & t2]] %]
+                          (when (and h1 h2)
+                            [(f h1 h2) [t1 t2]]))))
+;fpins
+;conceptually - the same :)
+


Fix karma runner for changed test namespace

(The namespace changed to follow the `-test` convention so that tooling
such as CIDER automatically understands it.)

--- test/day8/re_frame/test_reframe/runner.cljs
+++ test/day8/re_frame/test_reframe/runner.cljs
@@ -1,8 +1,8 @@
 (ns day8.re-frame.test-reframe.runner
   (:require [jx.reporter.karma :as karma :include-macros true]
-            [day8.re-frame.test-reframe.test]))
+            [day8.re-frame.test-reframe.test-test]))

 (defn ^:export run-karma [karma]
   (karma/run-tests
     karma
-    'day8.re-frame.test-reframe.test))
+    'day8.re-frame.test-reframe.test-test))


Since one-case is specialized to semi-sweet, added a more general after.

--- test/midje/test_util.clj
+++ test/midje/test_util.clj
@@ -10,6 +10,14 @@

 (def reported (atom []))

+(defn run-and-check [run-form check-forms]
+  `(do
+     (binding [report (fn [report-map#] (swap! reported conj report-map#))]
+       (reset! reported [])
+       ~run-form)
+     ~@check-forms))
+
+
 (defmacro one-case
   ([description]
    `(println "PENDING:"  ~description))
@@ -18,11 +26,15 @@
 					 (= (first form) 'expect)))]
      (assert (form-is-expect? expect-form))
      (assert (every? #(not (form-is-expect? %)) check-forms))
-     `(do
-	(binding [report (fn [report-map#] (swap! reported conj report-map#))]
-	  (reset! reported [])
-	  ~expect-form)
-	~@check-forms))))
+     (run-and-check expect-form check-forms))))
+
+
+(defmacro after
+  ([description]
+   `(println "PENDING:"  ~description))
+  ([example-form & check-forms]
+   (run-and-check example-form check-forms)))
+

 (defn last-type? [expected]
   (= (:type (last (deref reported))) expected))
@@ -32,3 +44,4 @@
   (= 1 (count (deref reported))))

 (defn raw-report [] (println @reported))
+


assoc-record, record-accessors

assoc-record, record-accessors

--- src/useful/datatypes.clj
+++ src/useful/datatypes.clj
@@ -1,5 +1,5 @@
 (ns useful.datatypes
-  (:use [useful :only [position into-map]])
+  (:use [useful :only [position into-map update]])
   (:require [clojure.string :as s]))

 (defn- normalize-field-name [field]
@@ -20,15 +20,33 @@
   "Construct a record given a pairs of lists and values. Mapping fields into constuctor arguments is
   done an compile time, so this is more efficient than creating an empty record and calling merge."
   [type & attrs]
-  (let [fields  (record-fields type)
+  (let [fields (record-fields type)
+        index  (position fields)
+        vals   (reduce (fn [vals [field val]]
+                         (if-let [i (index (normalize-field-name field))]
+                           (assoc vals i val)
+                           (assoc-in vals
+                             [(index '--extmap) (keyword field)] val)))
+                       (vec (repeat (count fields) nil))
+                       (into-map attrs))]
+    `(new ~type ~@vals)))
+
+(defmacro assoc-record
+  "Assoc attrs into a record. Mapping fields into constuctor arguments is done an compile time,
+   so this is more efficient than calling assoc on an existing record."
+  [record & attrs]
+  (let [binding (get &env record)
+        type    (or (and binding (.getJavaClass binding))
+                    (throw (Exception. "type hint required on record to use assoc-record")))
+        fields  (record-fields type)
         index   (position fields)
-        vals    (reduce
-                 (fn [vals [field val]]
-                   (if-let [i (index (normalize-field-name field))]
-                     (assoc vals i val)
-                     (throw (Exception. (format "invalid field name %s for record %s" field type)))))
-                 (vec (repeat (count fields) nil))
-                 (into-map attrs))]
+        vals    (reduce (fn [vals [field val]]
+                          (if-let [i (index (normalize-field-name field))]
+                            (assoc vals i val)
+                            (assoc-in vals
+                              [(index '--extmap) (keyword field)] val)))
+                        (vec (map #(list (symbol (str "." %)) record) fields))
+                        (into-map attrs))]
     `(new ~type ~@vals)))

 (defmacro update-record
@@ -41,12 +59,22 @@
                     (throw (Exception. "type hint required on record to use update-record")))
         fields  (record-fields type)
         index   (position fields)
-        vals    (reduce
-                 (fn [vals [f field & args]]
-                   (let [i (index (normalize-field-name field))]
-                     (assoc vals
-                       i (cons f (cons (get vals i) args)))))
+        vals    (reduce (fn [vals [f field & args]]
+                          (if-let [i (index (normalize-field-name field))]
+                            (assoc vals
+                              i (apply list f (get vals i) args))
+                            (let [i (index '--extmap)]
+                              (assoc vals
+                                i (apply list 'update (get vals i) (keyword field) args)))))
+                        (vec (map #(list (symbol (str "." %)) record) fields))
+                        forms)]
+    `(new ~type ~@vals)))

-                 (vec (map #(list (symbol (str "." %)) record) fields))
-                 forms)]
-    `(new ~type ~@vals)))
+(defmacro record-accessors
+  "Defines optimized macro accessors using interop and typehints for all fields in the given records."
+  [& types]
+  `(do ~@(for [type  types
+               field (record-fields type)]
+           `(defmacro ~field [~'record]
+              (list '~(symbol (str "." field))
+                    (with-meta ~'record {:tag '~(symbol (.getName (eval type)))}))))))


matching results to new subnet

matching results to new subnet

--- test/celestial/integration/networking.clj
+++ test/celestial/integration/networking.clj
@@ -8,18 +8,18 @@
 (with-conf
   (with-state-changes [(before :facts (do (clear-range :proxmox) (n/initialize-networking)))]
     (fact "used up ips marking" :integration :redis :ip
-      (n/gen-ip {} :proxmox :ip_address)  => {:ip_address "192.168.5.100"}
-      (count (n/list-free-ips :proxmox)) => 152
-      (n/list-used-ips :proxmox) => ["192.168.5.100" "192.168.5.170" "192.168.5.171" "192.168.5.173"]
-      (n/release-ip "192.168.5.100" :proxmox)
-      (n/list-used-ips :proxmox) => ["192.168.5.170" "192.168.5.171" "192.168.5.173"]
-      (count (n/list-free-ips :proxmox)) => 153)
+      (n/gen-ip {} :proxmox :ip_address)  => {:ip_address "192.168.3.200"}
+      (count (n/list-free-ips :proxmox)) => 52
+      (n/list-used-ips :proxmox) => ["192.168.3.200" "192.168.3.230" "192.168.3.231" "192.168.3.232"]
+      (n/release-ip "192.168.3.200" :proxmox)
+      (n/list-used-ips :proxmox) => ["192.168.3.230" "192.168.3.231" "192.168.3.232"]
+      (count (n/list-free-ips :proxmox)) => 53)

     (fact "multiple ips" :integration :redis :ip
       (dotimes [_ 5] (n/gen-ip {} :proxmox :ip_address))
-      (count (n/list-free-ips :proxmox)) => 148
-      (dotimes [i 5] (n/release-ip (str  "192.168.5.10" i) :proxmox))
-      (count (n/list-free-ips :proxmox)) => 153)
+      (count (n/list-free-ips :proxmox)) => 48
+      (dotimes [i 5] (n/release-ip (str  "192.168.3.20" i) :proxmox))
+      (count (n/list-free-ips :proxmox)) => 53)
     ))


Re-instated save to file system.

Re-instated save to file system.

--- src/kixi/hecuba/weather/metoffice_api.clj
+++ src/kixi/hecuba/weather/metoffice_api.clj
@@ -6,7 +6,7 @@
             [clojure.java.io :as io]
             [clj-http.client :as client]))

-(defn pull-data [querydate querytime]
+(defn pull-data [querydate querytime file-path]
   (->> (client/post "http://datagovuk.cloudapp.net/query"
                     {:form-params {
                                    :Type "Observation"
@@ -18,18 +18,18 @@
                      :follow-redirects true})
        :body
        (re-find #"https://datagovuk.blob.core.windows.net/csv/[a-z0-9]+.csv")
-       slurp))
+       slurp
+       (spit (str file-path (str/replace querydate #"/" "-") "-" querytime ".csv"))))

 (defn save-file [file-name file-content]
   (spit file-name file-content))

-(defn run-data-pull [startdate-str enddate-str]
+(defn run-data-pull [startdate-str enddate-str file-path]
   (let [fmt (f/formatter "dd/MM/YYYY")
         timefmt (f/formatter "HH00")
         start (f/parse fmt startdate-str)
         end (f/parse fmt enddate-str)]
     (->> (tp/periodic-seq start (t/hours 1))
          (take-while #(t/before? % (t/minus end (t/days 1))))
-         (map #(pull-data (f/unparse fmt %) (f/unparse timefmt %)))
-         doall)))
-
+         (map #(pull-data (f/unparse fmt %) (f/unparse timefmt %) file-path))
+         )))


[#2872] Fix test

[#2872] Fix test

--- backend/test/akvo/lumen/lib/auth_test.clj
+++ backend/test/akvo/lumen/lib/auth_test.clj
@@ -51,6 +51,7 @@
                 :spec
                 {:version 1,
                  :baseLayer "street",
+                 :centreOfTheWorld "greenwich"
                  :layers [{:aggregationMethod "avg",
                            :popup [],
                            :filters [],


Copy tweaks

Copy tweaks

--- frontend/components/language_landing.cljs
+++ frontend/components/language_landing.cljs
@@ -49,7 +49,7 @@
                            :author "Aaron Suggs"
                            :title "Operations Engineer @Kickstarter"}]}
    "python" {:language "Python"
-             :headline "CircleCI makes continuous Integration and Deployment for Python projects a breeze."
+             :headline "CircleCI makes Continuous Integration and Deployment for Python projects a breeze."
              :logo-path (utils/cdn-path "/img/outer/languages/python-logo.svg")
              :screenshot (stefon/asset-path "/img/outer/languages/build-screenshot-python.png")
              :features [{:feature "When CircleCI detects a Python project, it automatically uses 'virtualenv' and 'pip' to create an isolated Python environment with all of the dependencies specified in your requirements.txt file. This helps ensure that your Python projects can be set up quickly and easily and that your CircleCI enviroment is configured correctly."
@@ -58,7 +58,7 @@
                         {:feature "CircleCI intelligently determines the best way to run your tests using 'nosetests', 'tox', or Django. We also provide complete flexibility to override our inferred commands with your own custom commands via the circle.yml."
                          :title "Intelligent Test Running"
                          :icon (utils/cdn-path "/img/outer/languages/book-icon.svg")}
-                        {:feature "CircleCI makes setting up Continuous Delivery for your Python application simple and easy. We offer first-class support for deployment to platforms like with Heroku, Elastic Beanstalk, and Google App Engine as well as using tools like Fabric, Ansible, Salt, and others."
+                        {:feature "CircleCI makes setting up Continuous Delivery for your Python application simple and easy. We offer first-class support for deployment to platforms like Heroku, Elastic Beanstalk, and Google App Engine as well as using tools like Fabric, Ansible, Salt, and others."
                          :title "Easy Continuous Delivery"
                          :icon (utils/cdn-path "/img/outer/languages/cycle.svg")}]
              :docs-link "/docs/language-python"}


Join adjacent Save/Remove buttons

Join adjacent Save/Remove buttons

--- frontend/components/project_settings.cljs
+++ frontend/components/project_settings.cljs
@@ -1094,7 +1094,8 @@

             [:div.buttons
               (forms/managed-button
-               [:input {:data-failed-text "Failed"
+               [(if (and access_key_id secret_access_key) :input.save :input)
+                       {:data-failed-text "Failed"
                         :data-success-text "Saved"
                         :data-loading-text "Saving..."
                         :value "Save AWS keys"
@@ -1225,15 +1226,15 @@

           [:div.buttons
            (forms/managed-button
-            [:input {:data-failed-text "Failed",
-                     :data-success-text "Saved",
-                     :data-loading-text "Saving...",
-                     :value "Save app",
-                     :type "submit"
-                     :on-click #(do
-                                  (put! controls-ch [:saved-project-settings {:project-id project-id
-                                                                              :merge-paths [[:aws :services :codedeploy]]}])
-                                  false)}])
+            [:input.save {:data-failed-text "Failed",
+                          :data-success-text "Saved",
+                          :data-loading-text "Saving...",
+                          :value "Save app",
+                          :type "submit"
+                          :on-click #(do
+                                      (put! controls-ch [:saved-project-settings {:project-id project-id
+                                                                                :merge-paths [[:aws :services :codedeploy]]}])
+                                      false)}])
            (forms/managed-button
             [:input.remove {:data-failed-text "Failed",
                             :data-success-text "Removed",


Making tests work again Additional test to check if tenant recognized correctly

--- test/org/spootnik/cyanite/carbon_test.clj
+++ test/org/spootnik/cyanite/carbon_test.clj
@@ -13,7 +13,8 @@
                   :period 3600
                   :ttl    36000
                   :time   500
-                  :metric 2.0})
+                  :metric 2.0
+                  :tenant "NONE"})
            (formatter
                       (assoc-rollup-to  [{:rollup 10 :period 3600}])
                       "foo.bar 2.0 501")))
@@ -23,17 +24,50 @@
                   :period 3600
                   :ttl    36000
                   :time   600
-                  :metric 2.0}
+                  :metric 2.0
+                  :tenant "NONE"}
                  {:path "foo.bar"
                   :rollup 60
                   :period 7200
                   :ttl    432000
                   :time   600
-                  :metric 2.0})
+                  :metric 2.0
+                  :tenant "NONE"})
            (formatter
                       (assoc-rollup-to  [{:rollup 10 :period 3600}
                                          {:rollup 60 :period 7200}])
                       "foo.bar 2.0 601")))

+    )
+  (testing "rollup-transform-tenants"
+    (is (= (list {:path "foo.bar"
+                  :rollup 10
+                  :period 3600
+                  :ttl    36000
+                  :time   500
+                  :metric 2.0
+                  :tenant "example_tenant"})
+           (formatter
+             (assoc-rollup-to  [{:rollup 10 :period 3600}])
+             "foo.bar 2.0 501 example_tenant")))
+
+    (is (= (list {:path "foo.bar"
+                  :rollup 10
+                  :period 3600
+                  :ttl    36000
+                  :time   600
+                  :metric 2.0
+                  :tenant "example_tenant"}
+                 {:path "foo.bar"
+                  :rollup 60
+                  :period 7200
+                  :ttl    432000
+                  :time   600
+                  :metric 2.0
+                  :tenant "example_tenant"})
+           (formatter
+             (assoc-rollup-to  [{:rollup 10 :period 3600}
+                                {:rollup 60 :period 7200}])
+             "foo.bar 2.0 601 example_tenant")))
     ))


Add missing attributes on shape svg rendering.

--- src/uxbox/ui/shapes.cljs
+++ src/uxbox/ui/shapes.cljs
@@ -14,14 +14,14 @@
 (defn- extract-attrs
   "Extract predefinet attrs from shapes."
   [shape]
-  (select-keys shape [:rotation :width :height
-                      :x :y :opacity :fill :view-box]))
+  (select-keys shape [:fill :opacity]))

 (defn- make-debug-attrs
-  [attrs]
-  (let [xf (map (fn [[x v]]
-                  [(keyword (str "data-" (name x))) v]))]
-    (into {} xf attrs)))
+  [shape]
+  (let [attrs (select-keys shape [:rotation :width :height :x :y])
+        xf (map (fn [[x v]]
+                    [(keyword (str "data-" (name x))) v]))]
+      (into {} xf attrs)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation
@@ -32,10 +32,9 @@
   (let [key (str "use-" id)
         transform (-> (merge shape attrs)
                       (svg/calculate-transform))
-        attrs {:id key :key key :transform transform}
-        attrs (-> (extract-attrs shape)
-                  (make-debug-attrs)
-                  (merge attrs))]
+        attrs (merge {:id key :key key :transform transform}
+                     (extract-attrs shape)
+                     (make-debug-attrs shape))]
     (html
      [:g attrs data])))


Tweak an alias

Tweak an alias

--- test/refactor_nrepl/integration_tests.clj
+++ test/refactor_nrepl/integration_tests.clj
@@ -1,7 +1,7 @@
 (ns refactor-nrepl.integration-tests
   (:require [clojure.java.io :as io]
             [clojure.test :refer :all]
-            [nrepl.server :as nrserver]
+            [nrepl.server :as nrepl]
             [refactor-nrepl middleware
              [client :refer :all]
              [core :as core]]
@@ -11,15 +11,15 @@

 (defn start-up-repl-server []
   (let [server
-        (nrserver/start-server
+        (nrepl/start-server
          :bind "localhost"
          :port 7777
-         :handler (nrserver/default-handler
+         :handler (nrepl/default-handler
                    #'refactor-nrepl.middleware/wrap-refactor))]
     server))

 (defn stop-repl-server [server]
-  (nrserver/stop-server server))
+  (nrepl/stop-server server))

 (defn wrap-setup-once [f]
   (let [server (start-up-repl-server)]


Fixes ack builder.

Fixes ack builder.

--- test/onyx/messaging/protocol_aeron_test.clj
+++ test/onyx/messaging/protocol_aeron_test.clj
@@ -27,7 +27,6 @@
   (is (= (vector peer-id message)
          (read-buf (protocol/build-retry-msg-buf peer-id message)))))

-
 (let [peer-id 32000
       acks [(map->Ack {:id #uuid "e2ba38dd-b523-4e63-ba74-645fb91c231a"
                        :completion-id #uuid "b57f7be1-f2f9-4d0f-aa02-939b3d48dc23"
@@ -36,7 +35,7 @@
                        :completion-id #uuid "b57f7be1-f2f9-4d0f-aa02-939b3d48dc23"
                        :ack-val 3323130347050513529})]]
   (is (= (vector peer-id (reverse acks))
-         (read-buf (protocol/build-acker-messages peer-id acks)))))
+         (read-buf (second (protocol/build-acker-messages peer-id acks))))))

 (let [peer-id 32765
       message [(map->Leaf {:id #uuid "ac39bc62-8f06-46a0-945e-3a17642a619f"


[#183] Improve tests

[#183] Improve tests

--- priv/clojure/test_clojure/protocols.clj
+++ priv/clojure/test_clojure/protocols.clj
@@ -12,21 +12,46 @@
   (:use clojure.test clojure.test-clojure.protocols.examples)
   (:require [clojure.test-clojure.protocols.more-examples :as other]
             [clojure.set :as set]
+            [clojure.string :as str]
             clojure.test-helper)
   (:import [clojure.test-clojure.protocols.examples
             ExampleProtocol
             MarkerProtocol
             MarkerProtocol2]))

+(defn delete-module [module]
+  (doto module
+    code/purge.e
+    code/delete.e
+    (-> code/which.e file/delete.e)))
+
+(defn find-protocol-impls
+  [protocol]
+  (let [type->str #(subs (str %) 1)
+        prefix (type->str protocol)
+        f (fn [[module path]]
+            (str/starts-with? (type->str module) prefix))]
+    (->> (code/all_loaded.e)
+         (filter f)
+         (map first))))
+
+(defn clean-protocol [protocol]
+  (doseq [m (find-protocol-impls protocol)]
+    (delete-module m)))
+
 ;; temporary hack until I decide how to cleanly reload protocol
 ;; this no longer works
-#_(defn reload-example-protocols
+(defn reload-example-protocols
   []
-  (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol
-                  assoc :impls {})
-  (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol
-                  assoc :impls {})
-  (require :reload
+  ;; (clean-protocol ExampleProtocol)
+  ;; (clean-protocol other/SimpleProtocol)
+
+  ;; (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol
+  ;;                 assoc :impls {})
+  ;; (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol
+  ;;                 assoc :impls {})
+
+  #_(require :reload
            'clojure.test-clojure.protocols.examples
            'clojure.test-clojure.protocols.more-examples))

@@ -35,7 +60,9 @@
   [m]
   (->> (erlang/get_module_info.e m :functions)
        (map (comp str first))
-       (filter (comp not #{":$_clj_on_load" ":module_info" ":module_info"}))
+       (map #(subs % 1))
+       (filter (comp not #{"$_clj_on_load" "module_info" "module_info"}))
+       (filter #(not (str/ends-with? % "__val")))
        sort))

 (defrecord EmptyRecord [])
@@ -65,7 +92,7 @@
           #"No implementation of method: :foo of protocol: :clojure.test-clojure.protocols.examples.ExampleProtocol found for type: :clojerl.Integer"
           (foo 10))))
   (testing "protocols generate a corresponding interface using _ instead of - for method names"
-    (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test-clojure.protocols.examples.ExampleProtocol))))
+    (is (= ["bar" "baz" "baz" "foo" "with-quux"] (method-names :clojure.test-clojure.protocols.examples))))
   (testing "error conditions checked when defining protocols"
     (is (thrown-with-msg?
          :throw
@@ -113,9 +140,8 @@

 (deftype ExtendsTestWidget []
   ExampleProtocol)
-
 (deftest extends?-test
-  ;; (reload-example-protocols)
+  (reload-example-protocols)
   (testing "returns false if a type does not implement the protocol at all"
     (is (false? (extends? other/SimpleProtocol ExtendsTestWidget))))
   (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010
@@ -136,36 +162,33 @@

 (deftype SatisfiesTestWidget []
   ExampleProtocol)
-#_(deftest satisifies?-test
+(deftest satisifies?-test
   (reload-example-protocols)
-  (let [whatzit (SatisfiesTestWidget.)]
+  (let [whatzit (new SatisfiesTestWidget)]
     (testing "returns false if a type does not implement the protocol at all"
       (is (false? (satisfies? other/SimpleProtocol whatzit))))
     (testing "returns true if a type implements the protocol directly"
       (is (true? (satisfies? ExampleProtocol whatzit))))
     (testing "returns true if a type explicitly extends protocol"
-      (extend
-       SatisfiesTestWidget
-       other/SimpleProtocol
-       {:foo identity})
-      (is (true? (satisfies? other/SimpleProtocol whatzit)))))  )
+      (extend-type SatisfiesTestWidget
+        other/SimpleProtocol
+        (foo [this] this))
+      (is (true? (satisfies? other/SimpleProtocol whatzit))))))

 (deftype ReExtendingTestWidget [])
-#_(deftest re-extending-test
+(deftest re-extending-test
   (reload-example-protocols)
-  (extend
-   ReExtendingTestWidget
-   ExampleProtocol
-   {:foo (fn [_] "first foo")
-    :baz (fn [_] "first baz")})
+  (extend-type ReExtendingTestWidget
+    ExampleProtocol
+    (foo [_] "first foo")
+    (baz [_] "first baz"))
   (testing "if you re-extend, the old implementation is replaced (not merged!)"
-    (extend
-     ReExtendingTestWidget
-     ExampleProtocol
-     {:baz (fn [_] "second baz")
-      :bar (fn [_ _] "second bar")})
-    (let [whatzit (ReExtendingTestWidget.)]
-      (is (thrown? IllegalArgumentException (foo whatzit)))
+    (extend-type ReExtendingTestWidget
+      ExampleProtocol
+      (baz [_] "second baz")
+      (bar [_ _] "second bar"))
+    (let [whatzit (new ReExtendingTestWidget)]
+      (is (thrown? :error (foo whatzit)))
       (is (= "second bar" (bar whatzit nil)))
       (is (= "second baz" (baz whatzit))))))

@@ -468,16 +491,16 @@
 ;;           (read-string "#java.util.Locale[\"\" \"\" \"\" \"\"]")))
 ;;     (is (thrown? Exception (read-string "#java.util.Nachos(\"en\")")))))

-;; (defrecord RecordToTestPrinting [a b])
-;; (deftest defrecord-printing
-;;   (testing "that the default printer gives the proper representation"
-;;     (let [r   (RecordToTestPrinting. 1 2)]
-;;       (is (= "#clojure.test-clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
-;;              (pr-str r)))
-;;       (is (= "#clojure.test-clojure.protocols.RecordToTestPrinting[1, 2]"
-;;              (binding [*print-dup* true] (pr-str r))))
-;;       (is (= "#clojure.test-clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
-;;              (binding [*print-dup* true *verbose-defrecords* true] (pr-str r)))))))
+(defrecord RecordToTestPrinting [a b])
+(deftest defrecord-printing
+  (testing "that the default printer gives the proper representation"
+    (let [r   (new RecordToTestPrinting 1 2)]
+      (is (= "#clojure.test-clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
+             (pr-str r)))
+      (is (= "#clojure.test-clojure.protocols.RecordToTestPrinting[1, 2]"
+             (binding [*print-dup* true] (pr-str r))))
+      (is (= "#clojure.test-clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
+             (binding [*print-dup* true *verbose-defrecords* true] (pr-str r)))))))

 ;; (defrecord RecordToTest__ [__a ___b])
 ;; (defrecord TypeToTest__   [__a ___b])
@@ -606,34 +629,33 @@
 ;;         (is (= "xoxo" (.hinted r "xo")))))))

-;; ; see CLJ-845
-;; (defprotocol SyntaxQuoteTestProtocol
-;;   (sqtp [p]))
-
-;; (defmacro try-extend-type [c]
-;;   `(extend-type ~c
-;;      SyntaxQuoteTestProtocol
-;;      (sqtp [p#] p#)))
-
-;; (defmacro try-extend-protocol [c]
-;;   `(extend-protocol SyntaxQuoteTestProtocol
-;;      ~c
-;;      (sqtp [p#] p#)))
-
-;; (try-extend-type String)
-;; (try-extend-protocol clojure.lang.Keyword)
-
-;; (deftest test-no-ns-capture
-;;   (is (= "foo" (sqtp "foo")))
-;;   (is (= :foo (sqtp :foo))))
-
-
-;; (defprotocol Dasherizer
-;;   (-do-dashed [this]))
-;; (deftype Dashed []
-;;   Dasherizer
-;;   (-do-dashed [this] 10))
-
-;; (deftest test-leading-dashes
-;;   (is (= 10 (-do-dashed (Dashed.))))
-;;   (is (= [10] (map -do-dashed [(Dashed.)]))))
+; see CLJ-845
+(defprotocol SyntaxQuoteTestProtocol
+  (sqtp [p]))
+
+(defmacro try-extend-type [c]
+  `(extend-type ~c
+     SyntaxQuoteTestProtocol
+     (sqtp [p#] p#)))
+
+(defmacro try-extend-protocol [c]
+  `(extend-protocol SyntaxQuoteTestProtocol
+     ~c
+     (sqtp [p#] p#)))
+
+(try-extend-type clojerl.String)
+(try-extend-protocol clojerl.Keyword)
+
+(deftest test-no-ns-capture
+  (is (= "foo" (sqtp "foo")))
+  (is (= :foo (sqtp :foo))))
+
+(defprotocol Dasherizer
+  (-do-dashed [this]))
+(deftype Dashed []
+  Dasherizer
+  (-do-dashed [this] 10))
+
+(deftest test-leading-dashes
+  (is (= 10 (-do-dashed (new Dashed))))
+  (is (= [10] (map -do-dashed [(new Dashed)]))))