Reorganize site's requires

Reorganize site's requires

--- src/clj/comic_reader/sites.clj
+++ src/clj/comic_reader/sites.clj
@@ -1,12 +1,13 @@
 (ns comic-reader.sites
-  (:require [comic-reader.sites.protocol :refer :all]
+  (:require [clojure.java.io :as io]
+            [clojure.string :as s]
+            [clojure.string :as str]
+            [comic-reader.scrape :as scrape]
+            [comic-reader.sites.protocol :refer :all]
             [comic-reader.sites.read :as site-read]
             [comic-reader.sites.util :as util]
-            [comic-reader.scrape :as scrape]
             [comic-reader.util :refer [safe-read-string]]
-            [com.stuartsierra.component :as component]
-            [clojure.java.io :as io]
-            [clojure.string :as s]))
+            [com.stuartsierra.component :as component]))

 ;; TODO: Remove this dynamic var.  Pass the options through all of the
 ;; function calls explicitly.


Nil-proof a few jline reader operations

Nil-proof a few jline reader operations

--- src/clj/reply/reader/jline.clj
+++ src/clj/reply/reader/jline.clj
@@ -44,16 +44,19 @@
       1)))

 (defn reset-reader []
-  (-> (.getCursorBuffer @jline-reader)
-      (.clear)))
+  (when @jline-reader
+    (-> (.getCursorBuffer @jline-reader)
+        (.clear))))

 (defn resume-reader []
-  (.init (.getTerminal @jline-reader))
-  (.redrawLine @jline-reader)
-  (.flush @jline-reader))
+  (when @jline-reader
+    (.init (.getTerminal @jline-reader))
+    (.redrawLine @jline-reader)
+    (.flush @jline-reader)))

 (defn shutdown-reader []
-  (.restore (.getTerminal @jline-reader)))
+  (when @jline-reader
+    (.restore (.getTerminal @jline-reader))))

 (defmacro with-jline-in [& body]
   `(do


Added handling in get-dimensions when min_x and min_y are lesser that 0.Added identity matrix wrapper function

--- src/clj/stitch/util/opencv.clj
+++ src/clj/stitch/util/opencv.clj
@@ -26,6 +26,12 @@
 (defn clone [mat]
   (.clone mat))

+(defn inverse [mat]
+  (.inv mat))
+
+(defn identity-mat [rows cols type]
+  (Mat/eye rows cols type))
+
 (defn size
   [img]
   (.size img))
@@ -285,16 +291,21 @@
     (if (< x 0)
       base-atom
        (let [m (matrix-multiplication h (.t (.row base-points x)))]
-        (if (> (first (.get m 0 0)) (:max_x @base-atom))
-          (swap! base-atom  merge {:max_x (first (.get m 0 0))}))
-        (if (> (first (.get m 1 0)) (:max_y @base-atom))
-          (swap! base-atom  merge {:max_y (first (.get m 1 0))}))
-        (if (< (first (.get m 0 0)) (:min_x @base-atom))
-          (swap! base-atom  merge {:min_x (first (.get m 0 0))}))
-        (if (< (first (.get m 1 0)) (:min_y @base-atom))
-          (swap! base-atom  merge {:min_y (first (.get m 1 0))}))
-            (recur (dec x) ))))
+          (if (> (first (.get m 0 0)) (:max_x @base-atom))
+            (swap! base-atom  merge {:max_x (first (.get m 0 0))}))
+          (if (> (first (.get m 1 0)) (:max_y @base-atom))
+            (swap! base-atom  merge {:max_y (first (.get m 1 0))}))
+          (if (< (first (.get m 0 0)) (:min_x @base-atom))
+            (swap! base-atom  merge {:min_x (first (.get m 0 0))}))
+          (if (< (first (.get m 1 0)) (:min_y @base-atom))
+            (swap! base-atom  merge {:min_y (first (.get m 1 0))}))
+              (recur (dec x) ))))
+      (if (< (:min_x @base-atom) 0)
+        (swap! base-atom  merge {:max_x (- (:max_x @base-atom) (:min_x @base-atom))}))
+      (if (< (:min_y @base-atom) 0)
+        (swap! base-atom  merge {:max_y (- (:max_y @base-atom) (:min_y @base-atom))}))
     @base-atom))
+

 (defn stitch [img-a img-b]
   (let [res (Mat.)
@@ -346,29 +357,9 @@
   (def row (.rows keyImage))

   (def keyImage (first rsiv))
-  (def h (calculate-homography (first rsiv) (second rsiv)))
-  (def base-points (create-base-points keyImage))
-  (def base-p-calc
-     (for [x (range 0 (.rows base-points))]
-      (matrix-multiplication h (.t (.row base-points x)))))
-
-
-
-  (loop [x (dec (.rows base-points))
-         base-atom (atom {:min_x Integer/MAX_VALUE :min_y Integer/MAX_VALUE
-            :max_x Integer/MIN_VALUE :max_y Integer/MIN_VALUE })]
-    (if (< x 0)
-      base-atom
-       (let [m (matrix-multiplication h (.t (.row base-points x)))]
-        (if (> (first (.get m 0 0)) (:max_x @base-atom))
-          (swap! base-atom  merge {:max_x (first (.get m 0 0))}) (println "NO"))
-        (if (> (first (.get m 1 0)) (:max_y @base-atom))
-          (swap! base-atom  merge {:max_y (first (.get m 1 0))}) (println "NO"))
-        (if (< (first (.get m 0 0)) (:min_x @base-atom))
-          (swap! base-atom  merge {:min_x (first (.get m 0 0))}) (println "NO"))
-        (if (< (first (.get m 1 0)) (:min_y @base-atom))
-          (swap! base-atom  merge {:min_y (first (.get m 1 0))}) (println "NO"))
-            (recur (dec x) base-atom))))
+  (def h (calculate-homography (second rsiv) (first rsiv)))
+  (def inv-h (.inv h))
+  (find-dimensions inv-h keyImage)


Remove blank lines

Remove blank lines

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -159,5 +159,3 @@
                                                        options))
                  (weighted-scenarios (range concurrency) scenarios)
                  false))
-
-


remove debug logging

remove debug logging

--- src/cljs_api_gen/repo_cljs.clj
+++ src/cljs_api_gen/repo_cljs.clj
@@ -111,7 +111,6 @@
 (defmacro with-checkout!
   [cljs-tag & body]
   `(let [[cljs-tag# clj-tag#] (checkout-cljs-tag! ~cljs-tag)]
-     (println cljs-tag# clj-tag#)
      (with-versions cljs-tag# clj-tag#
        ~@body)))


memoize rootpath

memoize rootpath

--- src/clojure/confgraph/core.clj
+++ src/clojure/confgraph/core.clj
@@ -4,26 +4,25 @@
   (:import java.io.File)
   (:import org.yaml.snakeyaml.Yaml))

-(def confs (for [x (.listFiles (File. "conf/runs")) :when (.isFile x)] x))
-(def nodes (for [x confs] (.getName x)))
-(def yaml  (Yaml. (ExtendedConstructor.)))
+(def confs    (for [x (.listFiles (File. "conf/runs")) :when (.isFile x)] x))
+(def nodes    (for [x confs] (.getName x)))
+(def yaml     (Yaml. (ExtendedConstructor.)))

 (defn extends [conf]
   (.get (.load yaml (slurp (.getPath conf))) "extends"))

 (def edges (zipmap nodes (for [x confs] (extends x))))

-;; memoize path-to-root
-(defn path-to-root [src]
-  (let [dst (edges src)]
-    (if (nil? dst)
-      {}
-      (conj {src dst} (path-to-root dst)))))
+(def rootpath
+  (memoize (fn [src]
+             (let [dst (edges src)]
+               (if (nil? dst)
+                 {}
+                 (conj {src dst} (rootpath dst)))))))

 (defn filtered-edges [prefix]
   (let [re (re-pattern (str prefix ".*"))]
-    (into {} (for [[src dst] edges :when (re-matches re src)]
-               (path-to-root src)))))
+    (into {} (for [[src dst] edges :when (re-matches re src)] (rootpath src)))))

 (defn edge-str [[src dst]] (str "  " src " -> " dst ";"))


http-kit/clojure: Define initial helper stuff.

--- src/clojure/src/dnsresolvh.clj
+++ src/clojure/src/dnsresolvh.clj
@@ -12,6 +12,18 @@
 ; (See the LICENSE file at the top of the source tree.)
 ;

-(ns dnsresolvd)
+(ns dnsresolvh)
+
+; Helper constants.
+(defmacro EXIT-FAILURE     []    1) ;    Failing exit status.
+(defmacro EXIT-SUCCESS     []    0) ; Successful exit status.
+(defmacro EMPTY-STRING     []   "")
+(defmacro COLON-SPACE-SEP  [] ": ")
+(defmacro COMMA-SPACE-SEP  [] ", ")
+(defmacro NEW-LINE         [] "\n")
+(defmacro ONE-SPACE-STRING []  " ")
+(defmacro PRINT-BANNER-OPT [] "-V")
+
+; TODO: Implement further helper stuff.

 ; vim:set nu et ts=4 sw=4:


use default timezone for date-formatting

--- src/crison/core.clj
+++ src/crison/core.clj
@@ -23,10 +23,9 @@

 (defn int [x] (if (string? x) (Integer. (re-find  #"\d+" x)) x))

-(defn date []
-  (let [nlocal (t/to-time-zone (t/now) (t/time-zone-for-offset -0))]
-    (f/unparse (f/formatter-local "yyyy-MM-dd_hh:mm")
-               nlocal)))
+(def custom-time-formatter (f/with-zone (f/formatter "yyyy-MM-dd_HH:mm:ss")
+                                        (t/default-time-zone)))
+(defn date [] (f/unparse custom-time-formatter (t/now)))

 (defn render-pause [pause-ms]
   (when-not (= pause-ms 0)


Cosmetics in incomplete exploration

Cosmetics in incomplete exploration

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

--- src/conexp/fca/exploration.clj
+++ src/conexp/fca/exploration.clj
@@ -209,6 +209,7 @@
                                      [possible-context certain-context]),
         background-knowledge       (or background-knowledge #{}),
         handler                    (or handler default-handler-for-incomplete-counterexamples)]
+    ;; check arguments
     (assert (set? background-knowledge))
     (assert (= (attributes certain-ctx)
                (attributes possible-ctx))
@@ -216,12 +217,13 @@
     (assert (= (objects certain-ctx)
                (objects possible-ctx))
             "Given contexts must coincide on the set of objects")
+    ;; actual exploration
     (loop [implications background-knowledge,
            last         (close-under-implications implications #{}),
            possible-ctx possible-ctx
            certain-ctx  certain-ctx]
       (if (not last)
-        {:implications (difference implications background-knowledge),
+        {:implications     (difference implications background-knowledge),
          :possible-context possible-ctx
          :certain-context  certain-ctx}
         (let [conclusion-from-last (oprime possible-ctx (aprime certain-ctx last))] ; ?
@@ -239,10 +241,10 @@
                                       :abort))]

               (cond
-               (= counterexamples :abort)
-               (recur implications nil possible-ctx certain-ctx) ; abort exploration
+               (= counterexamples :abort) ; abort exploration
+               (recur implications nil possible-ctx certain-ctx)
                ;;
-               counterexamples         ; add counterexample
+               counterexamples          ; add counterexample
                (let [new-objs (map first counterexamples)]
                  ;; check that new names are not there already
                  (when (exists [g new-objs] (contains? (objects possible-ctx) g))
@@ -264,7 +266,7 @@
                                              (set-of [g m] [[g pos _] counterexamples,
                                                             m pos])))))
                ;;
-               true                    ; add implication
+               true                     ; add implication
                (let [new-implications (conj implications new-impl)]
                  (recur new-implications
                         (next-closed-set (attributes possible-ctx)


Demo an expression filter for custom state of the world times

--- src/deltalog/mr.clj
+++ src/deltalog/mr.clj
@@ -4,6 +4,7 @@
            [cascading.tap.hadoop Hfs]
            [cascading.scheme.hadoop TextDelimited TextLine]
            [cascading.tuple Fields]
+           [cascading.operation.expression ExpressionFilter]
            [cascading.pipe Pipe Each GroupBy Every]
            [cascading.operation.aggregator Last] ; for learning
            [cascading.flow Flow FlowDef]
@@ -30,7 +31,12 @@

         splitter (make-splitter json-paths)
         splitter-pipe (Each. "json_split" splitter)
-        group-pipe (GroupBy. splitter-pipe (make-fields ["id"]) (make-fields ["timestamp"]))
+        filter-pipe (Each. splitter-pipe
+                           (make-fields ["timestamp"])
+                           (ExpressionFilter. "timestamp >= 1393542318" Long/TYPE))
+        group-pipe (GroupBy. filter-pipe
+                             (make-fields ["id"])
+                             (make-fields ["timestamp"]))
         max-pipe (Every. group-pipe Fields/ALL (Last.) Fields/RESULTS)

         flow-def (-> (FlowDef/flowDef)


Bikeshed on name and organization in scrape

--- src/mars_ogler/scrape.clj
+++ src/mars_ogler/scrape.clj
@@ -8,14 +8,6 @@
             [mars-ogler.times :as times]
             [net.cgrand.enlive-html :as html]))
   (def % partial)
-
-;;
-;; Images Atom
-;;
-
-(def ^{:doc "If you just want to grab the most recent images pre-sorted by all
-            three orderings, then deref this atom."}
-  sorted-images (atom nil))

 ;;
 ;; Scrapin'
@@ -227,22 +219,26 @@
   (println "I found" (count new-images) "new photos, so now we have"
              (count all-images) "total")))

-(defn fetch-tick!
+(defn fetch-tick
   [old-imgs]
   (let [last-id (-> old-imgs first :id)
         new-imgs (parse-dates (fetch-images-since last-id))
         all-imgs (concat new-imgs old-imgs)]
     {:all all-imgs, :new new-imgs, :old old-imgs}))

+(def ^{:doc "If you just want to grab the most recent images pre-sorted by all
+            three orderings, then deref this atom."}
+  sorted-images (atom nil))
+
 (defn update-states!
   [imgs]
   (cache-images! imgs)
   (reset! sorted-images (sort-images imgs)))

-(defn -main
-  [& _]
+(defn scrape-loop
+  []
   (loop [imgs (get-cached-images)]
-    (let [{:keys [new old all]} (fetch-tick! imgs)]
+    (let [{:keys [new old all]} (fetch-tick imgs)]
       (print-summary new all)
       (when-not (empty? new)
         (update-states! all))


available-formats does not show default-write anymore

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

--- src/conexp/io.clj
+++ src/conexp/io.clj
@@ -24,6 +24,8 @@
 	   'conexp.io.layouts
            'conexp.io.many-valued-contexts)

+;;;
+
 (defn available-formats
   "Returns for a given type (as string, i.e. \"context\") all
   available output methods."
@@ -31,7 +33,8 @@
   (let [writer (resolve (symbol "conexp.io" (str "write-" type)))]
     (when (nil? writer)
       (illegal-argument "Unknown type " type " given to available-formats."))
-    (remove #(= :default %)
+    (remove #(or (= :default %)
+                 (= :conexp.io.util/default-write %))
             (keys (methods @writer)))))

 ;;;


Add test of the new closeability of WebSocket conns

--- test/clj_chrome_devtools/impl/connection_test.clj
+++ test/clj_chrome_devtools/impl/connection_test.clj
@@ -1,12 +1,15 @@
 (ns clj-chrome-devtools.impl.connection-test
-  (:require [clj-chrome-devtools.automation :refer [create-automation current-automation evaluate]]
+  (:require [clj-chrome-devtools.automation :refer [create-automation current-automation evaluate
+                                                    sel text-of to]]
             [clj-chrome-devtools.automation.fixture :refer [create-chrome-fixture]]
             [clj-chrome-devtools.impl.connection :as c]
             [clj-chrome-devtools.impl.util :as util]
+            [clojure.java.io :as io]
             [clojure.spec.test.alpha :as stest]
             [clojure.string :refer [includes? join]]
             [clojure.test :as t :refer [deftest is testing]]
-            [taoensso.timbre :as log]))
+            [taoensso.timbre :as log])
+  (:import [org.eclipse.jetty.websocket.api WebSocketException]))

 (stest/instrument)

@@ -30,11 +33,14 @@
                                                    (swap! log conj formatted-output-str)))}}})
     log))

-(defn- make-automation [client-config]
-  (let [client (c/make-ws-client client-config)
-        max-wait-time-ms 1000
-        conn (c/connect "localhost" port max-wait-time-ms client)]
-    (create-automation conn)))
+(defn- make-conn
+  "The main reason we need this is so it’ll use the value of the port var. See the comment on that
+  var above."
+  ([] (make-conn {}))
+  ([client-config]
+   (let [client (c/make-ws-client client-config)
+         max-wait-time-ms 1000]
+     (c/connect "localhost" port max-wait-time-ms client))))

 (deftest logging
   (testing "messages that are larger than the max should cause an error to be logged"
@@ -54,7 +60,8 @@
           (is (re-seq #".+WARN.+WebSocket connection closed with status code 1009 \(Too large\) and reason: Text message size.+exceeds maximum size.+"
                       output)))))
     (testing "specified limit (2MB)"
-      (let [automation (make-automation {:max-msg-size-mb (* 1024 1024 2)})
+      (let [conn (make-conn {:max-msg-size-mb (* 1024 1024 2)})
+            automation (create-automation conn)
             eval-timeout-ms 1000 ; Specify a short timeout because this error case would otherwise
                                  ; cause evaluate to hang until its default timeout of 60 seconds
                                  ; elapses, which would just be too slow.
@@ -69,3 +76,18 @@
                       output))
           (is (re-seq #".+WARN.+WebSocket connection closed with status code 1009 \(Too large\) and reason: Text message size.+exceeds maximum size.+"
                       output)))))))
+
+(def test-page
+  (io/resource "test-page.html"))
+
+(deftest closeable
+  (testing "Connection objects should work with (be closed by) with-open"
+    (let [conn (make-conn)
+          auto (create-automation conn)]
+      (with-open [conn conn]
+        ; Simple validation that the connection works
+        (to auto test-page)
+        (is (= (map #(text-of auto %)
+                    (sel auto "ul#thelist li"))
+               '("foo" "bar" "baz"))))
+      (is (thrown-with-msg? WebSocketException #"current state \[CLOSED\]" (to auto test-page))))))


Join multiple rooms

Join multiple rooms

--- src/grooming/chat/chatroom.clj
+++ src/grooming/chat/chatroom.clj
@@ -2,12 +2,18 @@

 (def ^{:private true} chatrooms (atom {}))

+(defn- new-room
+  [id]
+  {:members #{id}
+   :created-by id})
+
 (defn- create
   "Create a chat room with only the user that crated it."
   [id room-name]
-  (swap! chatrooms assoc room-name
-         {:members #{id}
-          :created-by id}))
+  (let [new-room {:members #{id}
+                  :created-by id}]
+    (swap! chatrooms assoc room-name new-room)
+    new-room))

 (defn list-rooms
   ([]
@@ -20,13 +26,17 @@
         coll))
     '() @chatrooms)))

+(defn- join-or-create
+  [id]
+  (fn [rooms room-name]
+    (if (room-name rooms)
+      (update-in rooms [room-name :members] conj id)
+      (assoc rooms room-name (new-room id)))))
+
 (defn join
   "Join a chat room with the name room-name."
-  [id room-name]
-  (if-let [chatroom (room-name @chatrooms)]
-    (let [members (conj (:members chatroom) id)]
-      (swap! chatrooms assoc-in [room-name :members] members))
-    (create id room-name)))
+  [id & room-names]
+  (swap! chatrooms #(reduce (join-or-create id) % room-names)))

 (defn leave
   "Leave chat room with name room-name. Returns nil if


Update process_lisp.clj

Update process_lisp.clj

--- src/iyye/bios/process_lisp.clj
+++ src/iyye/bios/process_lisp.clj
@@ -17,16 +17,26 @@
 (ns iyye.bios.process-lisp
    (:require [clojure.string :as str]
              [iyye.bios.parse-lisp :as parse]
-             [iyye.bios.ioframes :as ioframes]))
+             [iyye.bios.ioframes :as ioframes]
+             [iyye.bios.words :as words]))
+
+(defn process-control [tree input IO]
+  (let [cmd (first tree)
+        params (for [cur (rest tree)] (if (seq? cur) (process-control cur "substr" IO) cur))]
+    ;    (println "processing" cmd)
+    (if cmd
+      (dorun (words/action cmd params IO))
+      (ioframes/process-output IO (str "failed to parse: " input)))))

 (defn process-lispy-ctrl-input [IO input]
-  (let [tree (parse/make-syntax-tree input)]
-    (future (Thread/sleep 1000) (ioframes/process-output IO "deal with a tree"))))
+  (let [tree (parse/get-syntax-tree input)]
+    (future (Thread/sleep 1000)
+            (process-control tree input IO))))

 (defn process-lispy-input [IO input]
   (if (= \# (first input))
     (process-lispy-ctrl-input IO (subs input 1))
-    (future (Thread/sleep 1000) (ioframes/process-output IO "parsing lispy sentences not implemented"))))
+    (future (Thread/sleep 1000) (ioframes/process-output IO "parsing lispy sentences not implemented yet"))))

 (defn process-input [IO input]
    (if (= input "What is answer to life, the universe and everything?")


[#1077] Use a tag with only alphanumerics

--- backend/src/akvo/lumen/lib/aggregation/filter.clj
+++ backend/src/akvo/lumen/lib/aggregation/filter.clj
@@ -1,6 +1,5 @@
 (ns akvo.lumen.lib.aggregation.filter
-  (:require [akvo.lumen.lib.share-impl :refer [random-url-safe-string]]
-            [clojure.string :as str])
+  (:require [clojure.string :as str])
   (:import [java.sql.Timestamp]))

 (defn invalid-filter [msg map]
@@ -9,8 +8,21 @@
 (defmulti filter-sql (fn [filter]
                        (get filter "strategy")))

+(defn- char-range [start end]
+  (map char (range (int start) (inc (int end)))))
+
+(def alphanumerics (concat (char-range \a \z)
+                           (char-range \A \Z)
+                           (take 10 (range))))
+
+(defn random-tag []
+  (format "tag_%s" (->> #(rand-nth alphanumerics)
+                        repeatedly
+                        (take 10)
+                        (apply str))))
+
 (defn $ize [v]
-  (let [tag (format "tag_%s" (random-url-safe-string))]
+  (let [tag (random-tag)]
     (format "$%s$%s$%s$" tag v tag)))

 (defn parse-number [s]


seems to be running without issue

seems to be running without issue

--- src/bitsplit_cli/client.cljs
+++ src/bitsplit_cli/client.cljs
@@ -27,8 +27,6 @@
 (defn- send? [fee amount]
     (< (* 5 fee) amount))

-(def doall-async (comp chans->chan doall map))
-
 (defprotocol Shutdown
     (shutdown! [this]))

@@ -53,11 +51,12 @@
     Operations
     (send-amounts! [this amounts]
         (println amounts)
-        (doall-async
-          (fn [[from [to amount]]]
-            (let [account (aget (.-aacounts coin) from)]
-                (call-method coin "sendFrom" account to amount)))
-          amounts))
+        (chans->chan
+          (for [[from splits] amounts
+                [to amount] splits
+                 :when (send? (.-fee coin) amount)]
+            (let [account (aget (.-aaccounts coin) from)]
+              (call-method coin "sendFrom" account to amount)))))
     (new-address! [this]
         (-> coin
             .createAccount


no need for double  update!

no need for double  update!

--- src-cljs/core.cljs
+++ src-cljs/core.cljs
@@ -173,7 +173,6 @@
       (let [search-chan (om/get-shared owner :search-channel)
             send-search (fn [e]
                           (let [str (.. e -target -value)]
-                            (om/update! term [:_content] str)
                             (put! search-chan {:_content str})))]
         (dom/div nil
                  (dom/h1


GAWB-1139: Change call caching checkbox message

--- src/cljs/main/broadfcui/page/workspace/method_configs/launch_analysis.cljs
+++ src/cljs/main/broadfcui/page/workspace/method_configs/launch_analysis.cljs
@@ -81,7 +81,7 @@
    [:div {:style {:marginTop "1em"}}
     [comps/Checkbox
     {:ref "callCache-check"
-     :label "Use Call Caching with this submission"
+     :label "Use Call Caching"
      :initial-checked? true
      :disabled-text (case (:protected-option @state)
                       :not-loaded "Call Caching status has not finished loading."


remove expectations

remove expectations

--- ssclj/jar/test/com/sixsq/slipstream/ssclj/resources/common/schema_test.clj
+++ ssclj/jar/test/com/sixsq/slipstream/ssclj/resources/common/schema_test.clj
@@ -1,245 +1,213 @@
 (ns com.sixsq.slipstream.ssclj.resources.common.schema-test
   (:require
+    [clojure.test :refer [deftest are is]]
     [com.sixsq.slipstream.ssclj.resources.common.schema :refer :all]
     [schema.core :as s]
-    [expectations :refer :all]
     [clojure.set :as set]))

-;;
-;; actions
-;;
-
-(expect (set/union core-actions prefixed-actions impl-prefixed-actions) (set (keys action-uri)))
-(expect (set (map name core-actions)) (set (vals (select-keys action-uri core-actions))))
-
-;;
-;; PosInt
-;;
-
-(expect nil? (s/check PosInt 1))
-(expect nil? (s/check PosInt 2))
-(expect nil? (s/check PosInt 3))
-(expect (s/check PosInt 0))
-(expect (s/check PosInt -1))
-(expect (s/check PosInt 1.0))
-(expect (s/check PosInt "bad"))
-
-;;
-;; NonNegInt
-;;
-
-(expect nil? (s/check NonNegInt 0))
-(expect nil? (s/check NonNegInt 1))
-(expect nil? (s/check NonNegInt 2))
-(expect nil? (s/check NonNegInt 3))
-(expect (s/check NonNegInt -1))
-(expect (s/check NonNegInt 1.0))
-(expect (s/check NonNegInt "bad"))
-
-;;
-;; NonBlankString
-;;
-
-(expect nil? (s/check NonBlankString "ok"))
-(expect nil? (s/check NonBlankString " ok"))
-(expect nil? (s/check NonBlankString "ok "))
-(expect nil? (s/check NonBlankString " ok "))
-(expect (s/check NonBlankString ""))
-(expect (s/check NonBlankString " "))
-(expect (s/check NonBlankString "\t"))
-(expect (s/check NonBlankString "\f"))
-(expect (s/check NonBlankString " \t\f"))
-
-;;
-;; NonEmptyStrlist
-;;
-
-(expect nil? (s/check NonEmptyStrList ["ok"]))
-(expect nil? (s/check NonEmptyStrList ["ok" "ok"]))
-(expect (s/check NonEmptyStrList []))
-(expect (s/check NonEmptyStrList [1]))
-(expect (s/check NonEmptyStrList ["ok" 1]))
-
-;;
-;; Timestamp
-;;
-
-(expect nil? (s/check Timestamp "2012-01-01T01:23:45.678Z"))
-(expect (s/check Timestamp "2012-01-01T01:23:45.678Q"))
-
-;;
-;; ResourceLink
-;;
-
-(expect nil? (s/check ResourceLink {:href "uri"}))
-(expect (s/check ResourceLink {}))
-(expect (s/check ResourceLink {:bad "value"}))
-(expect (s/check ResourceLink {:href ""}))
-(expect (s/check ResourceLink {:href "uri" :bad "value"}))
-
-;;
-;; ResourceLinks
-;;
-
-(expect nil? (s/check ResourceLinks [{:href "uri"}]))
-(expect nil? (s/check ResourceLinks [{:href "uri"} {:href "uri"}]))
-(expect (s/check ResourceLinks []))
-
-;;
-;; Operation
-;;
-
-(expect nil? (s/check Operation {:href "uri" :rel "add"}))
-(expect (s/check Operation {:href "uri"}))
-(expect (s/check Operation {:rel "add"}))
-(expect (s/check Operation {}))
-
-;;
-;; Operations
-;;
-
-(expect nil? (s/check Operations [{:href "uri" :rel "add"}]))
-(expect nil? (s/check Operations [{:href "uri" :rel "add"} {:href "uri" :rel "delete"}]))
-(expect (s/check Operations []))
-
-;;
-;; Properties
-;;
-
-(expect nil? (s/check Properties {:a "ok"}))
-(expect nil? (s/check Properties {:a "ok" :b "ok"}))
-(expect nil? (s/check Properties {"a" "ok"}))
-(expect nil? (s/check Properties {"a" "ok" "b" "ok"}))
-(expect (s/check Properties {}))
-(expect (s/check Properties {1 "ok"}))
-(expect (s/check Properties {"ok" 1}))
-(expect (s/check Properties [:bad "bad"]))
-
-;;
-;; Access control schemas
-;;
+(def non-nil? (complement nil?))
+
+(is (= (set/union core-actions prefixed-actions impl-prefixed-actions) (set (keys action-uri))))
+(is (= (set (map name core-actions)) (set (vals (select-keys action-uri core-actions)))))
+
+(deftest check-PosInt
+  (are [expect-fn arg] (expect-fn (s/check PosInt arg))
+                       nil? 1
+                       nil? 2
+                       nil? 3
+                       non-nil? 0
+                       non-nil? -1
+                       non-nil? 1.0
+                       non-nil? "bad"))
+
+(deftest check-NonNegInt
+  (are [expect-fn arg] (expect-fn (s/check NonNegInt arg))
+                       nil? 0
+                       nil? 1
+                       nil? 2
+                       nil? 3
+                       non-nil? -1
+                       non-nil? 1.0
+                       non-nil? "bad"))
+
+(deftest check-NonBlankString
+  (are [expect-fn arg] (expect-fn (s/check NonBlankString arg))
+                       nil? "ok"
+                       nil? " ok"
+                       nil? "ok "
+                       nil? " ok "
+                       non-nil? ""
+                       non-nil? " "
+                       non-nil? "\t"
+                       non-nil? "\f"
+                       non-nil? "\t\f"))
+
+(deftest check-NonEmptyStrList
+  (are [expect-fn arg] (expect-fn (s/check NonEmptyStrList arg))
+                       nil? ["ok"]
+                       nil? ["ok" "ok"]
+                       non-nil? []
+                       non-nil? [1]
+                       non-nil? ["ok" 1]))
+
+(deftest check-Timestamp
+  (are [expect-fn arg] (expect-fn (s/check Timestamp arg))
+                       nil? "2012-01-01T01:23:45.678Z"
+                       non-nil? "2012-01-01T01:23:45.678Q"))
+
+(deftest check-ResourceLink
+  (are [expect-fn arg] (expect-fn (s/check ResourceLink arg))
+                       nil? {:href "uri"}
+                       non-nil? {}
+                       non-nil? {:bad "value"}
+                       non-nil? {:href ""}
+                       non-nil? {:href "uri" :bad "value"}))
+
+(deftest check-ResourceLinks
+  (are [expect-fn arg] (expect-fn (s/check ResourceLinks arg))
+                       nil? [{:href "uri"}]
+                       nil? [{:href "uri"} {:href "uri"}]
+                       non-nil? []))
+
+(deftest check-Operation
+  (are [expect-fn arg] (expect-fn (s/check Operation arg))
+                       nil? {:href "uri" :rel "add"}
+                       non-nil? {:href "uri"}
+                       non-nil? {:rel "add"}
+                       non-nil? {}))
+
+(deftest check-Operations
+  (are [expect-fn arg] (expect-fn (s/check Operations arg))
+                       nil? [{:href "uri" :rel "add"}]
+                       nil? [{:href "uri" :rel "add"} {:href "uri" :rel "delete"}]
+                       non-nil? []))
+
+(deftest check-Properties
+  (are [expect-fn arg] (expect-fn (s/check Properties arg))
+                       nil? {:a "ok"}
+                       nil? {:a "ok" :b "ok"}
+                       nil? {"a" "ok"}
+                       nil? {"a" "ok" "b" "ok"}
+                       non-nil? {}
+                       non-nil? {1 "ok"}
+                       non-nil? {"ok" 1}
+                       non-nil? [:bad "bad"]))

 (def valid-acl {:owner {:principal "me" :type "USER"}})

-(let [id {:principal "::ADMIN"
-          :type      "ROLE"}]
-  (expect nil? (s/check AccessControlId id))
-  (expect (s/check AccessControlId (assoc id :bad "MODIFY")))
-  (expect (s/check AccessControlId (dissoc id :principal)))
-  (expect (s/check AccessControlId (dissoc id :type)))
-  (expect (s/check AccessControlId (assoc id :type "BAD"))))
-
-(let [rule {:principal "::ADMIN"
-            :type      "ROLE"
-            :right     "VIEW"}]
-  (expect nil? (s/check AccessControlRule rule))
-  (expect nil? (s/check AccessControlRule (assoc rule :right "MODIFY")))
-  (expect nil? (s/check AccessControlRule (assoc rule :right "ALL")))
-  (expect (s/check AccessControlRule (assoc rule :right "BAD")))
-  (expect (s/check AccessControlRule (dissoc rule :right))))
-
-(let [rules [{:principal "::ADMIN"
-              :type      "ROLE"
-              :right     "VIEW"}
-
-             {:principal "ALPHA"
-              :type      "USER"
-              :right     "ALL"}]]
-  (expect nil? (s/check AccessControlRules rules))
-  (expect nil? (s/check AccessControlRules (next rules)))
-  (expect (s/check AccessControlRules (nnext rules)))
-  (expect (s/check AccessControlRules (cons 1 rules))))
-
-(let [acl {:owner {:principal "::ADMIN"
-                   :type      "ROLE"}
-           :rules [{:principal ":group1"
-                    :type      "ROLE"
-                    :right     "VIEW"}
-                   {:principal "group2"
-                    :type      "ROLE"
-                    :right     "MODIFY"}]}]
-  (expect nil? (s/check AccessControlList acl))
-  (expect nil? (s/check AccessControlList (dissoc acl :rules)))
-  (expect (s/check AccessControlList (assoc acl :rules [])))
-  (expect (s/check AccessControlList (assoc acl :owner "")))
-  (expect (s/check AccessControlList (assoc acl :bad "BAD"))))
-
-(expect nil? (s/check AclAttr {:acl valid-acl}))
-(expect (s/check AclAttr {}))
-
-;;
-;; Common CIMI attributes
-;;
-
-(let [date "2012-01-01T01:23:45.678Z"
-      minimal {:id          "a"
-               :resourceURI "http://example.org/data"
-               :created     date
-               :updated     date}
-      maximal (assoc minimal
-                :name "name"
-                :description "description"
-                :properties {"a" "b"}
-                :operations [{:rel "add" :href "/add"}])]
-  (expect nil? (s/check CommonAttrs minimal))
-  (expect (s/check CommonAttrs (dissoc minimal :id)))
-  (expect (s/check CommonAttrs (dissoc minimal :resourceURI)))
-  (expect (s/check CommonAttrs (dissoc minimal :created)))
-  (expect (s/check CommonAttrs (dissoc minimal :updated)))
-
-  (expect nil? (s/check CommonAttrs maximal))
-  (expect nil? (s/check CommonAttrs (dissoc maximal :name)))
-  (expect nil? (s/check CommonAttrs (dissoc maximal :description)))
-  (expect nil? (s/check CommonAttrs (dissoc maximal :properties)))
-  (expect (s/check CommonAttrs (assoc maximal :bad "BAD"))))
-
-;;
-;; parameter description types
-;;
-(expect nil? (s/check ParameterTypes "string"))
-(expect nil? (s/check ParameterTypes "boolean"))
-(expect nil? (s/check ParameterTypes "int"))
-(expect nil? (s/check ParameterTypes "float"))
-(expect nil? (s/check ParameterTypes "timestamp"))
-(expect nil? (s/check ParameterTypes "enum"))
-(expect nil? (s/check ParameterTypes "map"))
-(expect nil? (s/check ParameterTypes "list"))
-
-(expect (s/check ParameterTypes "unknown"))
-
-;;
-;; parameter descriptions
-;;
-(let [valid-description {:displayName "ID"
-                         :category    "common"
-                         :description "unique resource identifier"
-                         :type        "enum"
-                         :mandatory   true
-                         :readOnly    true
-                         :order       0
-                         :enum        ["a" "b" "c"]}
-      resource-desc {:identifier valid-description
-                     :other      valid-description
-                     :acl        valid-acl}]
-  (expect nil? (s/check ParameterDescription valid-description))
-  (expect nil? (s/check ParameterDescription (dissoc valid-description :category)))
-  (expect nil? (s/check ParameterDescription (dissoc valid-description :description)))
-  (expect nil? (s/check ParameterDescription (dissoc valid-description :mandatory)))
-  (expect nil? (s/check ParameterDescription (dissoc valid-description :readOnly)))
-  (expect nil? (s/check ParameterDescription (dissoc valid-description :order)))
-  (expect nil? (s/check ParameterDescription (dissoc valid-description :enum)))
-
-  (expect (s/check ParameterDescription (assoc valid-description :displayName 1)))
-  (expect (s/check ParameterDescription (assoc valid-description :category 1)))
-  (expect (s/check ParameterDescription (assoc valid-description :description 1)))
-  (expect (s/check ParameterDescription (assoc valid-description :type "unknown")))
-  (expect (s/check ParameterDescription (assoc valid-description :mandatory 1)))
-  (expect (s/check ParameterDescription (assoc valid-description :readOnly 1)))
-  (expect (s/check ParameterDescription (assoc valid-description :readOnly "1")))
-  (expect (s/check ParameterDescription (assoc valid-description :enum "1")))
-  (expect (s/check ParameterDescription (assoc valid-description :enum ["a" 1])))
-
-  (expect nil? (s/check ResourceDescription resource-desc))
-  (expect (s/check ResourceDescription (assoc resource-desc :another 1)))
-
-  (expect nil? (s/check ResourceDescription (assoc CommonParameterDescription :acl valid-acl))))
+(deftest check-AccessControlId
+  (let [id {:principal "ADMIN", :type "ROLE"}]
+    (are [expect-fn arg] (expect-fn (s/check AccessControlId arg))
+                         nil? id
+                         non-nil? (assoc id :bad "MODIFY")
+                         non-nil? (dissoc id :principal)
+                         non-nil? (dissoc id :type)
+                         non-nil? (assoc id :type "BAD"))))
+
+(deftest check-AccessControlRule
+  (let [rule {:principal "ADMIN", :type "ROLE", :right "VIEW"}]
+    (are [expect-fn arg] (expect-fn (s/check AccessControlRule arg))
+                         nil? rule
+                         nil? (assoc rule :right "MODIFY")
+                         nil? (assoc rule :right "ALL")
+                         non-nil? (assoc rule :right "BAD")
+                         non-nil? (dissoc rule :right))))
+
+(deftest check-AccessControlRules
+  (let [rules [{:principal "ADMIN", :type "ROLE", :right "VIEW"}
+               {:principal "ALPHA", :type "USER", :right "ALL"}]]
+    (are [expect-fn arg] (expect-fn (s/check AccessControlRules arg))
+                         nil? rules
+                         nil? (next rules)
+                         non-nil? (nnext rules)
+                         non-nil? (cons 1 rules))))
+
+(deftest check-AccessControlList
+  (let [acl {:owner {:principal "::ADMIN"
+                     :type      "ROLE"}
+             :rules [{:principal ":group1"
+                      :type      "ROLE"
+                      :right     "VIEW"}
+                     {:principal "group2"
+                      :type      "ROLE"
+                      :right     "MODIFY"}]}]
+    (are [expect-fn arg] (expect-fn (s/check AccessControlList arg))
+                         nil? acl
+                         nil? (dissoc acl :rules)
+                         non-nil? (assoc acl :rules [])
+                         non-nil? (assoc acl :owner "")
+                         non-nil? (assoc acl :bad "BAD"))))
+
+(is (nil? (s/check AclAttr {:acl valid-acl})))
+(is (s/check AclAttr {}))
+
+(deftest check-CommonAttrs
+  (let [date "2012-01-01T01:23:45.678Z"
+        minimal {:id          "a"
+                 :resourceURI "http://example.org/data"
+                 :created     date
+                 :updated     date}
+        maximal (assoc minimal
+                  :name "name"
+                  :description "description"
+                  :properties {"a" "b"}
+                  :operations [{:rel "add" :href "/add"}])]
+    (are [expect-fn arg] (expect-fn (s/check CommonAttrs arg))
+                         nil? minimal
+                         non-nil? (dissoc minimal :id)
+                         non-nil? (dissoc minimal :resourceURI)
+                         non-nil? (dissoc minimal :created)
+                         non-nil? (dissoc minimal :updated)
+                         nil? maximal
+                         nil? (dissoc maximal :name)
+                         nil? (dissoc maximal :description)
+                         nil? (dissoc maximal :properties)
+                         non-nil? (assoc maximal :bad "BAD"))))
+
+(deftest check-ParameterTypes
+  (are [expect-fn arg] (expect-fn (s/check ParameterTypes arg))
+                       nil? "string"
+                       nil? "boolean"
+                       nil? "int"
+                       nil? "float"
+                       nil? "timestamp"
+                       nil? "enum"
+                       nil? "map"
+                       nil? "list"
+                       non-nil? "unknown"))
+
+(deftest check-ParameterDescription-and-ResourceDescription
+  (let [valid-description {:displayName "ID"
+                           :category    "common"
+                           :description "unique resource identifier"
+                           :type        "enum"
+                           :mandatory   true
+                           :readOnly    true
+                           :order       0
+                           :enum        ["a" "b" "c"]}
+        resource-desc {:identifier valid-description
+                       :other      valid-description
+                       :acl        valid-acl}]
+
+    (are [expect-fn arg] (expect-fn (s/check ParameterDescription arg))
+                         nil? valid-description
+                         nil? (dissoc valid-description :category)
+                         nil? (dissoc valid-description :description)
+                         nil? (dissoc valid-description :mandatory)
+                         nil? (dissoc valid-description :readOnly)
+                         nil? (dissoc valid-description :order)
+                         nil? (dissoc valid-description :enum)
+                         non-nil? (assoc valid-description :displayName 1)
+                         non-nil? (assoc valid-description :category 1)
+                         non-nil? (assoc valid-description :description 1)
+                         non-nil? (assoc valid-description :type "unknown")
+                         non-nil? (assoc valid-description :mandatory 1)
+                         non-nil? (assoc valid-description :readOnly 1)
+                         non-nil? (assoc valid-description :readOnly "1")
+                         non-nil? (assoc valid-description :enum "1")
+                         non-nil? (assoc valid-description :enum ["a" 1]))
+
+    (are [expect-fn arg] (expect-fn (s/check ResourceDescription arg))
+                         nil? resource-desc
+                         non-nil? (assoc resource-desc :another 1)
+                         nil? (assoc CommonParameterDescription :acl valid-acl))))


Validate that input/output tasks have :onyx/plugin

--- src/onyx/static/validation.clj
+++ src/onyx/static/validation.clj
@@ -24,7 +24,8 @@

 (def catalog-entry-validator
   (schema/conditional #(or (= (:onyx/type %) :input) (= (:onyx/type %) :output))
-                      (merge base-catalog-entry-validator {:onyx/medium schema/Keyword})
+                      (merge base-catalog-entry-validator {:onyx/plugin schema/Keyword
+                                                           :onyx/medium schema/Keyword})
                       :else
                       (merge base-catalog-entry-validator {:onyx/fn schema/Keyword})))


Render parts of UI only if data changed

Render parts of UI only if data changed

--- src/kmg/client.cljs
+++ src/kmg/client.cljs
@@ -9,6 +9,7 @@

 (def user (atom {:username "user2"}))
+(def user-data (atom {}))

 (def tmpl "/html/kmg.html")

@@ -60,11 +61,19 @@
   (ef/at "#specializations-completed"
          (ef/content (map specialization-comleted data))))

+(defn data-changed? [data data-part]
+  (if (= {} @user-data) true
+      (not= (data-part data) (data-part @user-data))))
+
+(defn render-if-changed [render-function data data-part]
+  (if (data-changed? data data-part) (render-function (data-part data))))
+
 (defn render-whole-user-data [data]
-  (recommendation-list (:recommendations data))
-  (recommendation-completed-list (:recommendations-completed data))
-  (specialization-available-list (:specializations-available data))
-  (specialization-completed-list (:specializations-completed data)))
+  (render-if-changed recommendation-list data :recommendations)
+  (render-if-changed recommendation-completed-list data :recommendations-completed)
+  (render-if-changed specialization-available-list data :specializations-available)
+  (render-if-changed specialization-completed-list data :specializations-completed)
+  (reset! user-data data))

 (defn try-load-recommendations
   ([]
@@ -75,17 +84,17 @@
        {:handler recommendation-list
         :error-handler error-handler})))

-(defn try-load-recommendations-completed []
+#_(defn try-load-recommendations-completed []
   (GET (str "/recommendation/completed/" (:username @user))
        {:handler recommendation-completed-list
         :error-handler error-handler}))

-(defn try-load-specializations-available []
+#_(defn try-load-specializations-available []
   (GET (str "/specialization/available/" (:username @user))
        {:handler specialization-available-list
         :error-hadler error-handler}))

-(defn try-load-specializations-completed []
+#_(defn try-load-specializations-completed []
   (GET (str "/specialization/completed/" (:username @user))
        {:handler specialization-completed-list
         :error-handler error-handler}))
@@ -120,11 +129,9 @@
 (em/defaction observe-change-user []
   ["#users-id"]
   (events/listen :change
-                 #((do (reset! user {:username (ef/from "#users-id" (get-prop :value))})
-                       #_(js/alert (str "Before try load recommendations for user: " @user))
-                       (refresh)
-
-                       #_(js/alert (str "User changed. Current user: " @user))))))
+                 #((do (reset! user
+                               {:username (ef/from "#users-id" (get-prop :value))})
+                       (refresh)))))

 (defn start []
   (ef/at ".container"


Solves #63 - Include first 15 people as in-conv regardless of # of votes

--- src/polismath/conversation.clj
+++ src/polismath/conversation.clj
@@ -104,11 +104,11 @@
                             ; least 7 if there are more than 7
                             (>= cnt (min 7 n-cmts)))
                           user-vote-counts)))
-                    ; If you are left with nothing, just take the 7 ptps with the largest number of votes.
-                    ; Silly, but...
-                    (if (empty? in-conv)
+                    ; If you are left with fewer than 15 participants, take the top most contributing
+                    ; participants
+                    (if (< (count in-conv) 15)
                       (map first
-                        (take 7
+                        (take 15
                           (sort-by (comp - second) user-vote-counts)))
                       in-conv)))
   ; End of base conv update


Cleaning up some profiling junk from named matrix

--- src/polismath/named_matrix.clj
+++ src/polismath/named_matrix.clj
@@ -85,9 +85,6 @@
   [row-index col-index ^java.util.Vector matrix]
   PNamedMatrix
     (update-nmat [this values]
-      ; A bunch of profiling shit
-      (let [values (into [] values)]
-      (p :update-nmat
       ; First find the row and column names that aren't yet in the data
       (let [[missing-rows missing-cols]
               (reduce
@@ -126,7 +123,7 @@
                       col-i (index new-col-index col)]
                   (assoc-in mat' [row-i col-i] value)))
               mat
-              values)))))))
+              values)))))
     (rownames [this] (get-names (.row-index this)))
     (colnames [this] (get-names (.col-index this)))
     (get-matrix [this] (.matrix this))
@@ -174,7 +171,7 @@

 ; Put in interface? ...

-(defnp safe-rowname-subset
+(defn safe-rowname-subset
   "This version of rowname-subset filters out negative indices, so that if not all names in row-names
   are in nmat, it just subsets to the rownames that are. Should scrap other one?"
   [nmat names]


don't attempt to late bind fns in applet fn - only in defapplet

--- src/processing/core/applet.clj
+++ src/processing/core/applet.clj
@@ -79,7 +79,6 @@
         fns               (dissoc options :name :title :size :key-pressed
                                   :key-released :mouse-pressed :mouse-released
                                   :mouse-moved :mouse-dragged :setup)
-        fns               (into {} (map (fn [[k v]] [k (if (symbol? v) `(var ~v) v)]) fns))
         fns               (merge {:draw (fn [] nil)} fns)
         key-pressed-fn    (or (:key-pressed options) (fn [] nil))
         key-released-fn   (or (:key-released options) (fn [] nil))
@@ -157,7 +156,8 @@
 (defmacro defapplet
   "Define an applet. Takes an app-name and a map of options."
   [app-name & opts]
-  `(def ~app-name (applet ~@opts)))
+  (let [opts  (mapcat (fn [[k v]] [k (if (symbol? v) `(var ~v) v)]) (partition 2 opts))]
+    `(def ~app-name (applet ~@opts))))

 (comment ;; Usage:
   (defapplet growing-triangle


Refactor auth code

Refactor auth code

--- src/time_tracker/auth/core.clj
+++ src/time_tracker/auth/core.clj
@@ -1,37 +1,52 @@
 (ns time-tracker.auth.core
-  (:gen-class)
   (:require [ring.util.response :as res]
             [org.httpkit.client :as http]
-            [cheshire.core :as cheshire]))
+            [cheshire.core :as json]

-(defn is-valid?
-  "Validates a JWT token by calling Google's API and by checking the client ID."
+            [time-tracker.config :as config]))
+
+(defn- munge-keyword
+  "In: \"key_string\"
+  Out: :key-string"
+  [key-string]
+  (keyword (clojure.string/replace key-string #"_" "-")))
+
+(defn- call-google-tokeninfo-api
+  [token]
+  (let [{body :body :as response} @(http/get config/google-tokeninfo-url
+                                             {:as :text
+                                              :query-params {"id_token" token}})]
+    (assoc response :body (json/parse-string body munge-keyword))))
+
+(defn token->credentials
+  "Validates a JWT by calling Google's API and by checking the client ID."
   [client-ids token]
-  (let [url (str "https://www.googleapis.com/oauth2/v3/tokeninfo?id_token="
-                 token)
-        response (http/get url {:as :text})]
-    (if (= 200 (:status @response))
-      (let [response-data (cheshire/parse-string (:body @response)
-                                                 #(keyword (clojure.string/replace % #"_" "-")))]
-        (and (some #{(:aud response-data)} client-ids)
-             response-data)))))
+  (let [{:keys [status body]} (call-google-tokeninfo-api token)]
+    (if (and (= 200 status)
+             (some #{(:aud body)} client-ids))
+      body)))

-(defn authenticated?
-  "Is the request Google authenticated? Performs a GET request.
-  There must be a header of the form Authorization: Bearer <token>
-  The token must then be verified using Google's verification endpoint."
+(defn token-from-headers
+  "Extracts the token from a Ring header map, if present.
+  See: https://tools.ietf.org/html/rfc6750#section-2.1"
+  [ring-headers]
+  (if-let [header-value (get ring-headers "authorization")]
+    (let [[scheme token] (clojure.string/split header-value #" ")]
+      (if (= "Bearer" scheme)
+        token))))
+
+(defn auth-credentials
+  "Gets a map of credentials from a Ring request.
+  A list of client-ids is needed to validate the JWT."
   [client-ids request]
-  (if-let [token (-> (get-in request [:headers "authorization"])
-                     (clojure.string/split #" ")
-                     (#(and (= "Bearer" (first %))
-                            (second %))))]
-    (is-valid? token)))
+  (if-let [token (token-from-headers (:headers request))]
+    (token->credentials client-ids token)))

 (defn wrap-google-authenticated
   "Middleware to verify Google authentication"
   [client-ids handler]
   (fn [request]
-    (if-let [user-information (authenticated? client-ids request)]
+    (if-let [user-information (auth-credentials client-ids request)]
       (handler (assoc request :credentials user-information))
       (-> (res/response "Access Denied")
           (res/status 403)))))


New line at end of file

New line at end of file

--- src/wishlistd/views/routes.clj
+++ src/wishlistd/views/routes.clj
@@ -6,4 +6,4 @@
   (main-page))

 (defpage "/:ajax" [] ; catchall! kinda...
-  (main-page))+  (main-page))


Adds .fade.in to bootstrap alert helper function.

--- src/cadence/views/common.clj
+++ src/cadence/views/common.clj
@@ -46,7 +46,7 @@

 (defn alert
   "Displays an alert box."
-  ([class type message] [:div {:id "flash" :class (str "alert alert-" (name class))}
+  ([class type message] [:div {:id "flash" :class (str "alert fade in alert-" (name class))}
                    [:a.close {:data-dismiss "alert"} "×"]
                    [:strong (string/capitalize (name type)) " "] (html message)])
   ([type message] (alert type type message)))


with-hellhound-system added to system ns as shortcut for a ready to use system

--- src/clj/hellhound/system.clj
+++ src/clj/hellhound/system.clj
@@ -40,10 +40,11 @@
      (-> hellhound.component.core/default-system-structure
          ~@body)))

-(defmacro hellhound-system
+(defmacro with-hellhound-system
   "Define a system map with some pre defined components."
   [system-name & body]
   `(-> hellhound.core/default-system-structure
        ;; TODO: Pass the options from config file
        (hellhound.component.websocket/make-websocket-component {})
-       (hellhound.component.pedestal/make-pedestal-component {})))
+       (hellhound.component.pedestal/make-pedestal-component {})
+       ~@body))


add gen-class to get the uberjar

add gen-class to get the uberjar

--- src/clj/just_married/api.clj
+++ src/clj/just_married/api.clj
@@ -1,4 +1,5 @@
 (ns just-married.api
+  (:gen-class)
   (:require
    [compojure
     [core :refer [GET POST defroutes]]


export-to-pdf update

export-to-pdf update

--- src/clj/salava/page/main.clj
+++ src/clj/salava/page/main.clj
@@ -123,8 +123,11 @@
                                                             [:line {:dotted true}]
                                                             [:spacer 2]
                                                             (if (= "heading"  (:type %))
-                                                                 [:paragraph {:align :center}
-                                                                   [:heading (:content %)]] " ")
+                                                              (case (:size %)
+                                                                 "h1" [:paragraph {:align :center}
+                                                                   [:heading (:content %)]]
+                                                                 "h2" [:paragraph {:align :center}
+                                                                        [:heading {:style {:size 10 :align :center}}  (:content %)]] )" ")
                                                             (if (= "badge" (:type %))
                                                             [:pdf-table {:width-percent 100 :cell-border false }
                                                              [25 75]
@@ -152,6 +155,9 @@
                                                                  [:phrase (str (t :badge/Criteria)": ")] [:spacer 0]
                                                                  [:anchor {:target (:criteria_url %) :style{:family :times-roman :color [66 100 162]}} (:criteria_url %)]]] " ")]]
                                                              ] " ")
+                                                            (if (= "html" (:type %))
+                                                              [:paragraph {:align :center}
+                                                               (:content %)] "")

                                                             [:spacer 0]])

@@ -159,9 +165,9 @@
                               ]
                          (reduce into [[:paragraph {:align :center} [:heading {:size :15 :align :center} $name][:spacer 0] [:paragraph {:align :center}
                                                              [:chunk (str $first_name " " $last_name)]]]] content)))]
+
     (dump page)
-;;     (dump badge-block-with-markdown)
-   (pdf/pdf (into [{:right-margin 50 :left-margin 50 }] (page-template page)) "out")
+    (pdf/pdf (into [{:right-margin 50 :left-margin 50 }] (page-template page)) "out")

     ))


JS interop: try out onreadystate

JS interop: try out onreadystate

--- src/cljs/cljs_game/core.cljs
+++ src/cljs/cljs_game/core.cljs
@@ -1,3 +1,12 @@
 (ns cljs-game.core)

-(js/alert "Welcome! From Clojurescript")
+(set! (.-onreadystatechange js/document)
+      (fn []
+        (when (= (.-readyState js/document) "complete")
+          (js/alert "Welcome!")
+          (let [element (js/document.getElementById "front-buffer")
+                context (.getContext element "2d")]
+            (js/console.log context)
+            (set! (.-fillStyle context) "green")
+            (.fillRect context 10 10 100 100)
+            ))))


Add a navbar and remove the welcome message

--- src/cljs/decktouch/core.cljs
+++ src/cljs/decktouch/core.cljs
@@ -45,19 +45,29 @@
   [:h3 (count cards) " cards"])

 (defn home-page []
-  [:div [:h2 "Welcome to decktouch"]
-   [:div [card-input/component card-data/card-list]
-         [card-counter @card-data/card-list]
-         [mana-cost-widget @card-data/card-list]]
-   [:div [card-list @card-data/card-list]]
-   [:div [:a {:href "#/about"} "go to about page"]]])
+  [:div.container-fluid
+   [:div.row
+   [:div.col-md-offset-3.col-md-3
+     [:br] [:br] [:br] [:br] [:br]
+     [:div [card-input/component card-data/card-list]
+           [card-counter @card-data/card-list]
+           [mana-cost-widget @card-data/card-list]]
+     [:div [card-list @card-data/card-list]]
+     [:div [:a {:href "#/about"} "go to about page"]]]]])

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

+(defn navbar []
+  [:nav.navbar.navbar-fixed-top.navbar-inverse.text-center
+    [:a.navbar-brand {:href "#"}
+      "Decktouch"]])
+
 (defn current-page []
-  [:div [(session/get :current-page)]])
+  [:div
+    [navbar]
+    [:div [(session/get :current-page)]]])

 ;; -------------------------
 ;; Routes


Refactor card input component

Refactor card input component

--- src/cljs/decktouch/core.cljs
+++ src/cljs/decktouch/core.cljs
@@ -9,8 +9,7 @@

 (def the-cards (atom card-data/cards))

-(defn get-card-input-value []
-  (.-value (.getElementById js/document "the-input")))
+
 ;; -------------------------
 ;; Views
 (defn card-in-list [card]
@@ -18,12 +17,20 @@
    (str card)])

 (defn card-input []
-  [:form {:onSubmit #(do
-                       (swap! the-cards conj
-                                             {:name (get-card-input-value)})
-                       (.log js/console (str @the-cards))
-                       false)}
-   [:input#the-input {:type "text"}]])
+  (let [get-val #(.-value (.getElementById js/document "the-input"))
+        reset-input #(set! (.-value (.getElementById js/document
+                                                       "the-input"))
+                           "")
+        save #(let [v (-> (get-val) str clojure.string/trim)]
+                (do
+                  (if-not (empty? v)
+                    (do
+                      (swap! the-cards conj {:name v})
+                      (reset-input)))
+                  false))]
+    [:form {:onSubmit #(do
+                         (save))}
+     [:input#the-input {:type "text"}]]))

 (defn card-list [cards]
   [:ul


fixed log screen

fixed log screen

--- src/cljs/dice/pages/log.cljs
+++ src/cljs/dice/pages/log.cljs
@@ -1,5 +1,6 @@
 (ns dice.pages.log
-  (:require [dice.store :refer [get-log clear-log]]))
+  (:require [dice.store :refer [get-log clear-log]]
+            [dice.state :refer [state]]))

 (defn clear-button [e &r]
   (.preventDefault e)
@@ -16,11 +17,13 @@
    (doall (map die-item (:roll re)))])

 (defn page []
-  [:div.main-content.log
-   [:div.content-wrapper
-    [:h2.main-title "Throws"]
-    (doall (map result-item (get-log)))]
-   [:div.footer-actions.c2-col
-    [:a.btn.btn-primary {:href "#/roll"} [:span.fa.fa-angle-left] [:span "Back"]]
-    " "
-    [:a.btn.btn-secondary {:href "#" :on-click clear-button} [:span "Clear"]]]])
+  (fn []
+    (js/console.log "rendering")
+    [:div.main-content.log
+     [:div.content-wrapper
+      [:h2.main-title "Throws"]
+      (doall (map result-item (get-log)))]
+     [:div.footer-actions.c2-col
+      [:a.btn.btn-primary {:href "#/roll"} [:span "Back"]]
+      " "
+      [:a.btn.btn-secondary {:href "#" :on-click clear-button} [:span "Clear"]]]]))


Minor changes and improvements to codecs module/ns.

--- src/clojure/buddy/codecs.clj
+++ src/clojure/buddy/codecs.clj
@@ -38,16 +38,21 @@
   (Hex/decodeHex (.toCharArray data)))

 (defn bytes->base64
-  "Encode a bytes array to base64."
+  "Encode a bytes array to base64
+and return utf8 string."
   [#^bytes data]
-  (trim (Base64/encodeBase64URLSafeString data)))
+  (Base64/encodeBase64URLSafeString data))
+
+(defn bytes->bbase64
+  "Encode a bytes array to base64 and
+return bytearray."
+  [#^bytes data]
+  (Base64/encodeBase64URLSafe data))

 (defn base64->bytes
   "Decode from base64 to bytes."
-  [^String s]
-  (let [codec (Base64. true)
-        data  (.decode codec s)]
-    data))
+  [s]
+  (Base64/decodeBase64 s))

 (defn str->base64
   "Encode to urlsafe base64."
@@ -59,7 +64,4 @@
 (defn base64->str
   "Decode from base64 to string."
   [^String s]
-  (let [codec (Base64. true)
-        data  (.decode codec s)]
-    (bytes->str data)))
-
+  (String. (base64->bytes s) "UTF8"))


function to create the complement of a sampler

--- src/clojure/flambo/utils.clj
+++ src/clojure/flambo/utils.clj
@@ -31,6 +31,9 @@

 (defn bernoulli-sampler [lower-bound upper-bound complement?]
   (BernoulliSampler. lower-bound upper-bound complement? (XORShiftRandom.)))
+
+(defn sampler-complement [sampler]
+  (.cloneComplement sampler))

 (defn bootstrap-emacs []
   (-> (Logger/getRootLogger)


Add dynamic var for default base configurations.

--- src/clojure/parkour/conf.clj
+++ src/clojure/parkour/conf.clj
@@ -6,6 +6,10 @@
   (:import [java.util List Map Set]
            [org.apache.hadoop.conf Configuration Configurable]
            [org.apache.hadoop.mapreduce Job JobContext]))
+
+(def ^:dynamic ^:private *default*
+  "Base configuration, used as template for fresh configurations."
+  (Configuration.))

 (defmulti ^:private configuration*
   "Internal implementation multimethod for extracting a `Configuration`."
@@ -23,9 +27,10 @@
 (defn configuration
   "Extract or produce a Hadoop `Configuration`.  If provided a `conf`
 argument, coerce it to be a `Configuration` which if possible shares
-mutable state with that original argument."
+mutable state with that original argument.  If not, return a fresh
+configuration copied from the current default."
   {:tag `Configuration}
-  ([] (Configuration.))
+  ([] (Configuration. *default*))
   ([conf] (configuration* conf)))

 (def ^{:tag `Configuration} iguration
@@ -35,6 +40,17 @@
 (def ^{:tag `Configuration} ig
   "Alias for `configuration`."
   configuration)
+
+(defn clone
+  "Return new Hadoop `Configuration`, cloning `conf`."
+  [conf] (Configuration. (configuration conf)))
+
+(defmacro with-default
+  "Set new default configuration `conf` within the dynamic scope of
+the `body` expressions."
+  [conf & body]
+  `(binding [*default* (clone ~conf)]
+     ~@body))

 (defn get
   "Get string value of `conf` parameter `key`"
@@ -76,10 +92,6 @@
   "Merge key-value pairs `kvs` into Hadoop configuration `conf`."
   [conf & kvs] (merge! conf (partition 2 kvs)))

-(defn clone
-  "Return new Hadoop `Configuration`, cloning `conf`."
-  [conf] (Configuration. (configuration conf)))
-
 (defmethod configuration* Configuration [conf] conf)
 (defmethod configuration* Configurable
   [cable] (.getConf ^Configurable cable))


Add map-vals

Add map-vals

--- src/clojure_fabric/utils.clj
+++ src/clojure_fabric/utils.clj
@@ -43,3 +43,9 @@
       (throw (Exception. "Invalid gRPC URL! Must be 'grpc|grpcs://<hostname>:<port>'")))
     (->gRpcUrl (clojure.string/lower-case protocol) host port)))

+(defn map-vals
+  [f m]
+  (reduce (fn [m [k v]]
+               (assoc m k (f v)))
+          {}
+          m))


add example REPL interactions

add example REPL interactions

--- dev/user.clj
+++ dev/user.clj
@@ -49,4 +49,8 @@
   [query & data-sources]
   (pprint (apply touch-that query data-sources)))

+(comment
+  (navigator/create-competency (:db-conn galleon/system) "comp1" "v1" :comp.status/active)
+  (ptouch-that '[:find ?e :where [?e :comp/name]])
+  )


Add directional keys to user input

Add directional keys to user input

--- src/cljs/chocolatier/entities/player.cljs
+++ src/cljs/chocolatier/entities/player.cljs
@@ -52,11 +52,7 @@

       ;; FIX If we are colliding we must still be able to move away
       (if (some true? results)
-        (do (debug "Player collision detected, stopping movement" (vals (assoc this :offset-x 0 :offset-y 0)) )
-            ;; Stop the player's movement
-
-            (assoc this :offset-x 0 :offset-y 0))
-
+        (assoc this :offset-x 0 :offset-y 0)
         ;; Do nothing
         this)))

@@ -72,6 +68,12 @@
                   :S (assoc %1 :offset-y (* -1 move-rate) :direction :s)
                   :D (assoc %1 :offset-x (* -1 move-rate) :direction :e)
                   :A (assoc %1 :offset-x (* 1 move-rate) :direction :w)
+
+                  :& (assoc %1 :offset-y (* 1 move-rate) :direction :n)
+                  ;; Use keyword here since paranths are reserved
+                  (keyword "(") (assoc %1 :offset-y (* -1 move-rate) :direction :s)
+                  :' (assoc %1 :offset-x (* -1 move-rate) :direction :e)
+                  :% (assoc %1 :offset-x (* 1 move-rate) :direction :w)
                   ;; Otherwise set the offset to 0 to denote the
                   ;; player is standing still
                   (assoc %1 :offset-x 0 :offset-y 0))]


WIP including popover mock

WIP including popover mock

--- src/re_demo/popovers.cljs
+++ src/re_demo/popovers.cljs
@@ -63,6 +63,20 @@
                    :children []]]])))

+[popover
+  :direction   XXXX
+  :anchor      [button XXXX]
+  :showing?     XXXX             ;; optional, if supplied use it otherwise create one
+
+  :popover  {:title  XXXXX
+             :body }
+  :pop-title    XXXXXX
+  :pop-body      XXXX
+  :pop-close-button?
+  :pop-width
+  :pop-height
+ ]
+

 (defn panel


started to add doc-strings to each publicly accessible macro

--- src/midje/sweet.clj
+++ src/midje/sweet.clj
@@ -12,6 +12,7 @@
         [midje.internal-ideas.wrapping :only [put-wrappers-into-effect]]
         [midje.internal-ideas.file-position :only [set-fallback-line-number-from]]
         [midje.ideas.tabular :only [tabular*]]
+        [utilize.macro :only [macro-do]]
         [midje.ideas.facts :only [midjcoexpand
                                   complete-fact-transformation]])
   (:require [midje.ideas.background :as background])
@@ -28,16 +29,22 @@
 (intern *ns* 'after #'background/after)
 (intern *ns* 'around #'background/around)

-(defmacro background [& forms]
+(defmacro background
+  ""
+  [& forms]
   (when (user-desires-checking?)
     (put-wrappers-into-effect (background/background-wrappers forms))))

-(defmacro against-background [background-forms & foreground-forms]
+(defmacro against-background
+  "Runs facts against setup code whch is run before :contents, :facts or :checks."
+  [background-forms & foreground-forms]
   (if (user-desires-checking?)
     (midjcoexpand `(against-background ~background-forms ~@foreground-forms))
     `(do ~@foreground-forms)))

-(defmacro fact [& forms]
+(defmacro fact
+  ""
+  [& forms]
   (when (user-desires-checking?)
     (try
       (set-fallback-line-number-from &form)
@@ -53,10 +60,12 @@
                                  :position (midje.internal-ideas.file-position/line-number-known ~(:line (meta &form)))})
            false)))))

-(defmacro facts [& forms]
+(defmacro facts
+  "Alias for fact."
+  [& forms]
   (with-meta `(fact ~@forms) (meta &form)))

-(defn- future-fact-1 [forms]
+(defn- future-fact* [forms]
   (let [lineno (reader-line-number forms)
         description (if (string? (second forms))
                       (str (second forms) " ")
@@ -65,14 +74,24 @@
                            :description ~description
                            :position (midje.internal-ideas.file-position/line-number-known ~lineno)})))

-(defmacro future-fact [& forms] (future-fact-1 &form))
-(defmacro future-facts [& forms] (future-fact-1 &form))
-(defmacro pending-fact [& forms] (future-fact-1 &form))
-(defmacro pending-facts [& forms] (future-fact-1 &form))
-(defmacro incipient-fact [& forms] (future-fact-1 &form))
-(defmacro incipient-facts [& forms] (future-fact-1 &form))
-(defmacro antiterminologicaldisintactitudinarian-fact [& forms] (future-fact-1 &form))
-(defmacro antiterminologicaldisintactitudinarian-facts [& forms] (future-fact-1 &form))
+(defn- generate-future-fact-variants []
+  (macro-do [name]
+    `(defmacro ~(symbol name)
+       "Fact that will not be run. Generates 'WORK TO DO' report output as a reminder."
+       [& forms#]
+       (future-fact* ~'&form))
+    "future-fact"
+    "future-facts"
+    "pending-fact"
+    "pending-facts"
+    "incipient-fact"
+    "incipient-facts"
+    "antiterminologicaldisintactitudinarian-fact"
+    "antiterminologicaldisintactitudinarian-facts" ))

-(defmacro tabular [& _]
+(generate-future-fact-variants)
+
+(defmacro tabular
+  "Generate a table of related facts."
+  [& _]
   (tabular* (keys &env) &form))


Use common threadpool in the 'remove-obsolete-data'

--- src/cyanite_remover/core.clj
+++ src/cyanite_remover/core.clj
@@ -499,7 +499,7 @@
                                 (filter #(:leaf (get @paths-info %)))
                                 (sort))]
         (process-paths tenant obsolete-paths pstore options
-                       remove-obsolete-paths-processor)))
+                       remove-obsolete-paths-processor tpool)))
     (catch Exception e
       (clog/unhandled-error e))))


renamte compile task to build to avoid confloct when generating

--- src/meta/boot.clj
+++ src/meta/boot.clj
@@ -102,8 +102,8 @@
   (util/warn "TODO: Running Tests...")
   identity)

-(boot/deftask compile
-  "Compile project for release."
+(boot/deftask build
+  "Build project for release."
   []
   (boot/task-options!
     impl/info  {:message "Running Workflow...: compile"}


minor fixes

minor fixes

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -37,7 +37,7 @@
                           "sec" Calendar/SECOND "secs" Calendar/SECOND})

 (defn- eval-date-exp [cal [num name]]
-  (.roll cal (date-fields name Calendar/DATE) num))
+  (.add cal (date-fields name Calendar/DATE) num))

 (defn- date-from-name [name]
   (let [cal (Calendar/getInstance)]
@@ -88,7 +88,7 @@
                            :else %)
         format-headers (fn [headers]
                          (->> headers (map #(str/join ":" %)) (str/join "\n")))]
-    (format "\n%s %s\n%s\nparams:%s\npayload:\n%s\nresponse status:%d\n%s\nbody:\n%s"
+    (format "\n%s %s\n%s\nparams:\n%s\npayload:\n%s\nresponse status:%d\n%s\nbody:\n%s"
             (:verb req) (:url req)
             (format-headers (:headers req))
             (format-headers (:params req))


tmpdir -> tmp-dir

tmpdir -> tmp-dir

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -21,7 +21,7 @@
     [java.lang.management ManagementFactory]
     [java.util.concurrent LinkedBlockingQueue TimeUnit Semaphore]))

-(declare watch-dirs sync! post-env! get-env set-env! tmpfile tmpdir ls)
+(declare watch-dirs sync! post-env! get-env set-env! tmpfile tmp-dir ls)

 (declare ^{:dynamic true :doc "The running version of boot app."}        *app-version*)
 (declare ^{:dynamic true :doc "The script's name (when run as script)."} *boot-script*)
@@ -63,7 +63,7 @@

 (defn- get-files [this masks+]
   (let [dirs (get-dirs this masks+)]
-    (->> this ls (filter (comp dirs tmpdir)) set)))
+    (->> this ls (filter (comp dirs tmp-dir)) set)))

 (defn- tmp-dir*
   [key]
@@ -406,7 +406,7 @@
   "Given a fileset and a dest-tmpfile from that fileset, overwrites the dest
   tmpfile with the contents of the java.io.File src-file."
   [fileset ^File src-file dest-tmpfile]
-  (->> (tmpdir dest-tmpfile)
+  (->> (tmp-dir dest-tmpfile)
        (non-user-dir-for fileset)
        (assoc dest-tmpfile :dir)
        (tmpd/cp fileset src-file)))


Main class should be compilable

Main class should be compilable

--- src/emender_jenkins/core.clj
+++ src/emender_jenkins/core.clj
@@ -11,7 +11,8 @@
 ;

 (ns emender-jenkins.core
-    "Core module that contains -main function called by Leiningen to start the application.")
+    "Core module that contains -main function called by Leiningen to start the application."
+    (:gen-class))

 (require '[ring.adapter.jetty      :as jetty])
 (require '[ring.middleware.params  :as http-params])


Changed type to reading-type to avoid shadowing.

Be careful about what you shadow @maxdh :smile:

--- test/kixi/hecuba/amon_test.clj
+++ test/kixi/hecuba/amon_test.clj
@@ -26,7 +26,7 @@
 (def ^:private entity-loc (atom ""))
 (def ^:private device-loc (atom ""))
 (def ^:private measurement-loc (atom ""))
-(def ^:private type (atom ""))
+(def ^:private reading-type (atom ""))

 (def ^:private gen-date-time
   (gen/fmap (partial apply t/date-time)
@@ -49,7 +49,7 @@
 ;; -------------------

 (defn- post-programme []
-  (reset! programme-loc
+  (reset! programme-loc
           (get-in (:headers
                    (let [sample (last (sg/generate-examples amon/BaseProgramme))]
                      (reset! poster-map (assoc-in @poster-map [:programme-name] (:name sample)))
@@ -58,8 +58,8 @@
   (log/info "Programmes: " @programme-loc))

 (defn- post-project []
-  (reset! project-loc
-          (get-in (:headers
+  (reset! project-loc
+          (get-in (:headers
                    (let [sample (last (sg/generate-examples amon/BaseProject))]
                      (reset! poster-map (assoc-in @poster-map [:project-name] (:name sample)))
                      (client/post (apply str "http://127.0.0.1:8010" @programme-loc "/projects/") {:accept :json :content-type :json :basic-auth ["support@mastodonc.com" "password"] :body (json/write-str (assoc-in sample [:programme_id]  (clojure.string/replace @programme-loc  #"/4/programmes/(.*?)" "$1")))})))
@@ -67,7 +67,7 @@
   (log/info "Project: " @project-loc))

 (defn- post-entity []
-  (reset! entity-loc
+  (reset! entity-loc
           (get-in (:headers
                    (let [sample (last (sg/generate-examples amon/BaseEntity))]
                       (reset! poster-map (assoc-in @poster-map [:entity-property-code] (:property_code sample)))
@@ -76,18 +76,17 @@
   (log/info "Entity: " @entity-loc))

 (defn- post-device []
-  (reset! device-loc
-          (get-in (:headers
-                   (let [sample (last (sg/generate-examples amon/BaseDevice))
-                         reading-type (:type (first (:readings sample)))]
-                     (reset! type reading-type)
+  (reset! device-loc
+          (get-in (:headers
+                   (let [sample (last (sg/generate-examples amon/BaseDevice))]
+                     (reset! reading-type (:type (first (:readings sample))))
                      (reset! poster-map (assoc-in @poster-map [:device-description] (:description sample)))
                      (client/post (apply str "http://127.0.0.1:8010" @entity-loc "/devices/") {:accept :json :content-type :json :basic-auth ["support@mastodonc.com" "password"] :body (json/write-str (assoc-in sample [:entity_id]  (clojure.string/replace @entity-loc  #"/4/entities/(.*?)" "$1")))})))
                   ["Location"]))
   (log/info "Devices: " @device-loc))

 (defn- post-measurement []
-  (client/post (apply str "http://127.0.0.1:8010" @device-loc "/measurements/") {:accept :json :content-type :json :basic-auth ["support@mastodonc.com" "password"] :body (json/write-str (assoc-in (sample-Measurement) [:measurements 0 :type] @type))})
+  (client/post (apply str "http://127.0.0.1:8010" @device-loc "/measurements/") {:accept :json :content-type :json :basic-auth ["support@mastodonc.com" "password"] :body (json/write-str (assoc-in (sample-Measurement) [:measurements 0 :type] @reading-type))})
   (log/info "Posting Measurements"))

                                         ;using a specific example -- schema for this may be too hard


Make the tests pass

Make the tests pass

--- src/icecap/handlers/http.clj
+++ src/icecap/handlers/http.clj
@@ -8,6 +8,14 @@
             [taoensso.timbre :refer [info spy]])
   (:import [java.net URI]))

+
+(defn valid-url?
+  [^String s]
+  (try
+    (URI. s) true
+
+    (catch Exception _
+      false)))

 (defn scheme
   "Get the scheme of a (string) URL."
@@ -20,7 +28,11 @@
   (#{"http" "https"} (scheme s)))

 (defstep :http
-  {:url (s/conditional valid-scheme? sc/URI)
+  {:url (s/conditional
+         valid-url? (s/conditional
+                     valid-scheme? sc/URI
+                     'valid-scheme?)
+         'valid-url?)
    :method (s/enum :GET :POST :DELETE :PUT :PATCH :HEAD)}
   [step]
   (let [req (spy (request step))]


Fix typo

Fix typo

--- src/io/aviso/rook/client.clj
+++ src/io/aviso/rook/client.clj
@@ -185,7 +185,7 @@
                remaining-clauses)))))

 (defmacro then*
-  "A macro that provide the underpinnings of the [[then]] macro; it extracts the status from the response
+  "A macro that provides the underpinnings of the [[then]] macro; it extracts the status from the response
   and dispatches to the first matching clause."
   [response & clauses]
   (let [local-response (gensym "response")


remove java Color reference

remove java Color reference

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

--- plugins/SlideExplorer2/src/slide_explorer/canvas.clj
+++ plugins/SlideExplorer2/src/slide_explorer/canvas.clj
@@ -278,7 +278,7 @@
    [:primitive-round-rect
     {:l 20 :t 10 :w 300 :h 300
      :arc-radius 100 :rotate 50
-     :filled false :color (Color. 0xE06060)
+     :filled false :color 0xE06060
      :stroke {:width 5
               :cap :round
               :dashes [10 10] :dash-phase 0}}]


Exercise 2.59, 2.60, 2.61, 2.62

Exercise 2.59, 2.60, 2.61, 2.62

--- src/sicp/chapter2/3_3.clj
+++ src/sicp/chapter2/3_3.clj
@@ -17,7 +17,7 @@

 (defn intersection-set [set1 set2]
   (cond
-    (or (empty? set1) (empty? set2)) []
+    (or (empty? set1) (empty? set2)) ()
     (element-of-set? (first set1) set2) (cons (first set1)
                                               (intersection-set (rest set1) set2))
     :else (intersection-set (rest set1) set2)))
@@ -33,3 +33,54 @@

 ;; Exercise 2.60
 ;; TODO
+
+(defn element-of-set?' [x set]
+  (cond
+    (empty? set) false
+    (= x (first set)) true
+    (< x (first set)) false
+    :else (recur x (rest set))))
+
+(defn intersection-set' [set1 set2]
+  (if (or (empty? set1) (empty? set2))
+    ()
+    (let [x1 (first set1)
+          x2 (first set2)]
+      (cond
+        (= x1 x2)
+        (cons x1
+              (intersection-set' (rest set1)
+                                 (rest set2)))
+        (< x1 x2)
+        (intersection-set' (rest set1) set2)
+        (< x2 x1)
+        (intersection-set' set1 (rest set2))))))
+
+;; Exercise 2.61
+(defn adjoin-set' [x set]
+  (cond
+    (empty? set) (list x)
+    (= x (first set)) set
+    (< x (first set)) (cons x set)
+    :else (cons (first set)
+                (adjoin-set' x (rest set)))))
+
+;; Exercise 2.62
+(defn union-set' [set1 set2]
+  (cond
+    (empty? set1) set2
+    (empty? set2) set1
+    :else
+    (let [x1 (first set1)
+          x2 (first set2)]
+      (cond
+        (= x1 x2)
+        (cons x1
+              (union-set' (rest set1)
+                          (rest set2)))
+        (< x1 x2)
+        (cons x1
+              (union-set' (rest set1) set2))
+        (< x2 x1)
+        (cons x2
+              (union-set' set1 (rest set2)))))))


internal-lb is an internal ELB

internal-lb is an internal ELB

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -312,6 +312,7 @@
                                          :timeout 5
                                          :interval 30}
                           :subnets public-subnets
+                          :internal true
                           :sgs (mapv cluster-unique ["lb-security-group"
                                                      "admin-security-group"
                                                      "slave-security-group"


instance types passed into the auto scaling groups

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -232,12 +232,15 @@
            min-number-of-masters
            max-number-of-masters
            master-disk-allocation
+           master-instance-type
            min-number-of-slaves
            max-number-of-slaves
            slave-disk-allocation
+           slave-instance-type
            min-number-of-public-slaves
            max-number-of-public-slaves
            public-slave-disk-allocation
+           public-slave-instance-type
            subnet-cidr-blocks
            mesos-ami
            public-slave-elb-listeners
@@ -378,7 +381,7 @@
              (asg "masters"
                   cluster-unique
                   {:image_id mesos-ami
-                   :instance_type "m4.large"
+                   :instance_type master-instance-type
                    :sgs (concat [(cluster-id-of "aws_security_group" "master-security-group")
                                  (cluster-id-of "aws_security_group" "admin-security-group")
                                  (remote-output-of "vpc" "sg-sends-influx")
@@ -447,7 +450,7 @@
              (asg "public-slaves"
                   cluster-unique
                   {:image_id mesos-ami
-                   :instance_type "m4.xlarge"
+                   :instance_type public-slave-instance-type
                    :sgs [(cluster-id-of "aws_security_group" "public-slave-security-group")
                          (remote-output-of "vpc" "sg-sends-influx")
                          (remote-output-of "vpc" "sg-sends-gelf")
@@ -503,7 +506,7 @@
              (asg "slaves"
                   cluster-unique
                   {:image_id mesos-ami
-                   :instance_type "m4.xlarge"
+                   :instance_type slave-instance-type
                    :sgs (concat [(cluster-id-of "aws_security_group" "slave-security-group")
                                  (remote-output-of "vpc" "sg-all-servers")
                                  (remote-output-of "vpc" "sg-sends-influx")


drop mapping support from Namespace, drop related fns. Var resolution must happen through the analyzer, already the case for reading. Only findInternedVar Namespace method actually used by the analyzer itself.

--- src/main/cljs/cljs/core.cljs
+++ src/main/cljs/cljs/core.cljs
@@ -9836,19 +9836,13 @@
   ((if (symbol? name) symbol str)
     (demunge-str (str name))))

-(deftype Namespace [obj name mappings]
+(deftype Namespace [obj name]
   Object
-  (find [this sym]
-    (when (contains? @mappings sym)
-      (Var. #(get @mappings sym)
-        (symbol (str name) (str sym)) {:ns this})))
   (findInternedVar [this sym]
     (let [k (munge (str sym))]
       (when (gobject/containsKey obj k)
         (Var. #(gobject/get obj k)
           (symbol (str name) (str sym)) {:ns this}))))
-  (getMappings [_]
-    @mappings)
   (getName [_] name)
   (toString [_]
     (str name))
@@ -9878,24 +9872,11 @@
         (js/Error.
           "find-ns-obj not supported when Closure optimization applied")))))

-(defn ns-interns* [sym]
-  (let [ns-obj (find-ns-obj sym)
-        ns (Namespace. ns-obj sym (atom nil))]
-    (letfn [(step [ret k]
-              (let [var-sym (symbol (demunge k))]
-                (assoc ret
-                  var-sym (Var. #(gobject/get ns-obj k)
-                            (symbol (str sym) (str var-sym)) {:ns ns}))))]
-      (reduce step {} (js-keys ns-obj)))))
-
 (defn create-ns
   ([sym]
    (create-ns sym (find-ns-obj sym)))
   ([sym ns-obj]
-   (create-ns sym (find-ns-obj sym)
-     (merge (ns-interns* 'cljs.core) (ns-interns* sym))))
-  ([sym ns-obj mappings]
-   (Namespace. ns-obj sym (atom mappings))))
+   (Namespace. sym ns-obj)))

 (defn find-ns [ns]
   (create-ns ns (find-ns-obj ns)))
@@ -9908,14 +9889,3 @@

 (defn ns-name [ns-obj]
   (.-name ns-obj))
-
-(defn ns-map [ns-obj]
-  (.getMappings ns-obj))
-
-(defn ns-resolve
-  ([ns sym] (ns-resolve ns nil sym))
-  ([ns env sym]
-   (when-not (contains? env sym)
-     (when-let [ns-obj (find-ns ns)]
-       (Var. #(.find ns-obj (str sym))
-         (symbol (str ns) (str sym)) {:ns ns-obj})))))


Capture the fn to stop server in an atom;

- and add util fn's to stop/restart server

--- src/time_tracker/core.clj
+++ src/time_tracker/core.clj
@@ -6,6 +6,8 @@
             [time-tracker.logging :as log]
             [time-tracker.util :as util]
             [time-tracker.web.service :as web-service]))
+
+(defonce server (atom nil))

 (defn init! []
   (log/configure-logging!)
@@ -18,17 +20,26 @@
   ([] (start-server! (web-service/app)))
   ([app-handler]
    (log/info {:event ::server-start})
-   (let [stop-fn (httpkit/run-server app-handler
-                                     {:port (Integer/parseInt (util/from-config :port))})]
-     (fn []
-       (stop-fn)
-       (log/info {:event ::server-stop})
-       (teardown!)))))
+   (reset! server (httpkit/run-server app-handler
+                                      {:port (Integer/parseInt (util/from-config :port))}))))
+
+(defn stop-server!
+  []
+  (when-not (nil? @server)
+    (@server :timeout 100)
+    (log/info {:event ::server-stop})
+    (teardown!)
+    (reset! server nil)))
+
+(defn restart-server!
+  []
+  (stop-server!)
+  (start-server!))

 (defn -main
   [& args]
   (init!)
-  (condp = (first args)
+  (case (first args)
     "migrate"  (migrate-db)
     "rollback" (rollback-db)
     (start-server!)))


Added :color? option to console stacktrace

--- ring-devel/src/ring/middleware/stacktrace.clj
+++ ring-devel/src/ring/middleware/stacktrace.clj
@@ -9,12 +9,12 @@

 (defn wrap-stacktrace-log
   "Wrap a handler such that exceptions are logged to *err* and then rethrown."
-  [handler]
+  [handler & [{color? :color?}]]
   (fn [request]
     (try
       (handler request)
       (catch Exception ex
-        (pst-on *err* false ex)
+        (pst-on *err* color? ex)
         (throw ex)))))

 (defn- style-resource [path]
@@ -82,7 +82,7 @@
 (defn wrap-stacktrace
   "Wrap a handler such that exceptions are caught, a corresponding stacktrace is
   logged to *err*, and a helpful debugging web response is returned."
-  [handler]
+  [handler & [{:as options}]]
   (-> handler
-      wrap-stacktrace-log
-      wrap-stacktrace-web))
+      (wrap-stacktrace-log options)
+      (wrap-stacktrace-web)))


some thro tests and pass params to getUnique...

--- src/runtime/q.clj
+++ src/runtime/q.clj
@@ -235,6 +235,8 @@
      )
   )

+
+
 (defmacro priv_whenAssumptions_Execute [dynVar & executeForms]
   (when dynVar
     (cond (empty? executeForms)
@@ -384,7 +386,19 @@

   )

-
+
+(def ^:private rte java.lang.RuntimeException)
+(def ^:private rte2 (newClass rte "12"))
+
+(deftest test_thro1
+  (isthrown? java.lang.RuntimeException (thro rte))
+  (isthrown? rte (thro rte))
+  (isthrown? rte (thro rte2))
+  ;FIXME: won't work: (isthrown? rte2 (thro rte2));due to compiletime/runtime macro crap; let's just say I wanna transcend this level of programming and get up there into a graph-like based system in 3D, asap ffs!
+  (isthrown? java.lang.RuntimeException (thro java.lang.RuntimeException))
+  (isthrown? rte (thro java.lang.RuntimeException))
+  )
+
 ;(macroexpand-1
 ;  '(isthrown? a (throw (RuntimeException. "1")))
 ;)
@@ -394,10 +408,7 @@

-(def ^:private rte java.lang.RuntimeException)
-(deftest test_thro
-  (isthrown? java.lang.RuntimeException (thro rte))
-  )
+

 ;(thro 2)

@@ -1024,7 +1035,7 @@
   [& [in-path prefix suffix]]
   ;(delay
     (try
-      (let [uniqueFile (getUniqueFile)
+      (let [uniqueFile (getUniqueFile in-path prefix suffix)
             ]
         (assumedTrue (.exists uniqueFile) (.isFile uniqueFile))
         (assumedFalse (.isDirectory uniqueFile))
@@ -1036,7 +1047,7 @@
         )
       (catch Throwable t
         (do
-          (rethro t)
+          (throw t);(rethro t)
           )
         )
       )


feat: add footer and its styles

feat: add footer and its styles

--- src/site/core.clj
+++ src/site/core.clj
@@ -17,14 +17,36 @@
 (def strings
   {:title "Health Samurai"
    :products "Продукты"
-   :projects "Projects"
-   :services "Services"
-   :contacts "Contacts"})
-
-(def menu
+   :education "Обучение"
+   :projects "Проекты"
+   :services "Услуги"
+   :contacts "Контакты"})
+
+(def MENU
   [{:href "/products" :text (:products strings)}
    {:href "/projects" :text (:projects strings)}
    {:href "/contancts" :text (:contacts strings)}])
+
+(def SERVICES
+  [{:href "/services" :text "Запуск и обучение"}
+   {:href "/services" :text "Запуск и разработка"}
+   {:href "/services" :text "Коммерческая поддержка"}])
+
+(def PRODUCTS
+  [{:href "/products/fhirbase" :text "Fhirbase"}
+   {:href "/products/aidbox" :text "Aidbox"}
+   {:href "/products/hl7mapper" :text "HL7 Mapper"}
+   {:href "/products/formstamp" :text "FormStamp"}
+   {:href "/products/foodtaster" :text "FoodTaster"}])
+
+(def EDUCATION
+  [{:href "/education" :text "Введение в HL7 FHIR"}
+   {:href "/education" :text "HL7 FHIR для продвинутых"}])
+
+(def CONTACTS
+  [{:href "/" :text "USA: +1 (818) 731-12-79"}
+   {:href "/" :text "Russia: +7 (812) 919-00-25"}
+   {:href "mailto:hello@health-samurai.io" :text "mailto:hello@health-samurai.io"}])

 (defn style [cnt]
   [:style {:type "text/css"} (css cnt)])
@@ -46,16 +68,42 @@
       ;; :line-height "40px"
       :padding "15px 0 20px"
       :color (if (= :inverse color) "white" (s-var :color :main))}
-     [:.brand {:display "inline-block"}
-      [:a {:color "inherit" :display "inline-block" :padding 5}]]
-     [:.menu {:display "inline-block" :float "right"}
-      [:.menu-item {:display "inline-block"}
-       [:a {:color "inherit" :display "inline-block" :padding 5}]]]])
+     [:span.nav-title {:position "fixed"
+                       :top 0
+                       :width "80px"
+                       :height "68px"
+                       :background-color "#a23835"
+                       :text-align "center"}
+      [:i {:padding-top "15px"
+           :text-align "center"
+           :color "white"
+           :text-decoration "none"
+           :font-size "32px"
+           :margin-left "auto"
+           :margin-right "auto"}]]
+     [:ul {:display "inline-block"
+           :margin-bottom 0
+           :float "right"}]
+     [:li {:margin-right "20px"
+           :margin-top "8px"}
+      [:a {;;:color "#a23835" ;; TODO: uncomment me, remove next white color
+           :color "white"
+           :padding "10px 20px"
+           :border "1px solid transparent"
+           :background-color "transparent"}
+       [:&:hover {:color "#a23835"
+                  :text-decoration "none"
+                  :border "1px solid #a23835"}]]
+      [:&:last-child {:margin-right 0}]
+      [:&:hover {:color "#a23835"}
+       [:a {color "#a23835"}]]
+      ]
+     ])

    [:div.container
     [:span.nav-title
      [:a {:href="#/"}
-      [:i.hs-icon.icon-samurai] (:title strings)]]
+      [:i.hs-icon.icon-samurai] #_(:title strings)]]
     [:ul.list-inline
      (for [x menu]
        [:li [:a {:href (:href x)} (:text x)]])]]])
@@ -83,8 +131,39 @@

 (defn footer []
   [:div#footer
-   [:style {:type "text/css"}]
-   [:h4 (:services strings)]])
+   (style
+    [:div#footer {:padding-top "80px"
+                  :padding-bottom "80px"
+                  :background-color "rgba(46,48,58,0.96)"
+                  :color "white"}
+     [:a {:color "#ddd"}]])
+   [:div.container.footer
+    [:div.row
+     [:div.col-md-3
+      [:h4 (:services strings)]
+      [:ul.list-unstyled
+       (for [x SERVICES]
+         [:li
+          [:a {:href (:href x)} (:text x)]])]]
+     [:div.col-md-3
+      [:h4 (:products strings)]
+      [:ul.list-unstyled
+       (for [x PRODUCTS]
+         [:li
+          [:a {:href (:href x)} (:text x)]])]]
+     [:div.col-md-3
+      [:h4 (:education strings)]
+      [:ul.list-unstyled
+       (for [x EDUCATION]
+         [:li
+          [:a {:href (:href x)} (:text x)]])]]
+     [:div.col-md-3
+      [:h4 (:contacts strings)]
+      [:ul.list-unstyled
+       (for [x CONTACTS]
+         [:li
+          [:a {:href (:href x)} (:text x)]])]]
+     ]]])

 (defn layout [cnt]
   [:html


[#2620] Split OPTION value into array and unnnest them [bar][sql]

--- backend/src/akvo/lumen/lib/aggregation/bar.clj
+++ backend/src/akvo/lumen/lib/aggregation/bar.clj
@@ -13,6 +13,11 @@
     nil   "x ASC"
     "asc" (format "%s ASC NULLS FIRST" column)
     "dsc" (format "%s DESC NULLS LAST" column)))
+
+(defn- sql-option-bucket-column [bucket-column]
+  (if (= "option" (:type bucket-column))
+    (format "unnest(regexp_split_to_array(%1$s,'\\|'))" (:columnName bucket-column))
+    (:columnName bucket-column)))

 (defn- subbucket-sql [table-name bucket-column subbucket-column aggregation filter-sql sort-sql truncate-size]
   (format "
@@ -41,7 +46,7 @@
           ON
             sort_table.x = data_table.x
           ORDER BY %5$s, data_table.s"
-          (:columnName bucket-column)
+          (sql-option-bucket-column bucket-column)
           aggregation
           table-name
           filter-sql
@@ -54,7 +59,7 @@
            FROM (SELECT %1$s as x, %2$s FROM %3$s WHERE %4$s GROUP BY x)z
            ORDER BY %5$s
            LIMIT %6$s"
-          (:columnName bucket-column)
+          (sql-option-bucket-column bucket-column)
           aggregation
           table-name
           filter-sql


better mixpanel agent

better mixpanel agent

--- src/pc/mixpanel.clj
+++ src/pc/mixpanel.clj
@@ -2,13 +2,22 @@
   (:refer-clojure :exclude [alias])
   (:require [cheshire.core :as json]
             [clj-http.client :as http]
+            [clj-time.coerce]
             [clj-time.core :as time]
-            [clj-time.coerce]
-            [slingshot.slingshot :refer (throw+)]
+            [clojure.tools.logging :as log]
             [pc.profile :as profile]
-            [pc.util.base64 :as base64]))
+            [pc.rollbar :as rollbar]
+            [pc.util.base64 :as base64]
+            [slingshot.slingshot :refer (throw+)])
+  (:import [com.google.common.base Throwables]))

-(defonce mixpanel-agent (agent nil :error-mode :continue))
+(defonce mixpanel-agent (agent nil
+                               :error-mode :continue
+                               :error-handler (fn [a e]
+                                                (println (Throwables/getStackTraceAsString e))
+                                                (flush)
+                                                (log/error e)
+                                                (rollbar/report-exception e))))

 (def endpoint "http://api.mixpanel.com")

@@ -44,8 +53,9 @@
   (clj-time.format/unparse (clj-time.format/formatter "yyyy-MM-dd") datetime))

 (defn api-call* [_ uri data]
-  (let [resp (http/post (str endpoint uri) {:query-params {:data (encode data)}})
-        success? (-> resp :body (Integer/parseInt) (= 1))]
+  (let [resp (http/post (str endpoint uri) {:query-params {:data (encode data)
+                                                           :verbose 1}})
+        success? (-> resp :body json/decode (get "status") (= 1))]
     (when (or (-> resp :status (not= 200)) (not success?))
       (throw+ resp))
     resp))


async exec

async exec

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -5,7 +5,7 @@
             [clj-http.client :as client]
             [clj-http.conn-mgr :refer [make-reusable-conn-manager]]
             [clojure.core :refer [set-agent-send-executor!]]
-            [clojure.core.async :as async :refer [chan >! <!]]
+            [clojure.core.async :as async :refer [<! <!! >! chan go go-loop]]
             [clojure.data.xml :refer [emit-str indent parse-str sexp-as-element]]
             [clojure.java.io :as io :refer [make-parents writer]]
             [clojure.set :as set]
@@ -166,33 +166,60 @@
             (log/error e "failed executing test")
             (assoc test :error (str (or (.getMessage e) e))))))))

+(defn start-executors
+  "creates n threads that start waiting for tests in the async channel"
+  [result-ch n]
+  (let [test-ch (chan (* n 2))]
+    (dotimes [i n]
+      (-> (fn[]
+            (go-loop [t (<! test-ch)
+                      r (apply exec-test-case t)]
+              (>! result-ch r)) )
+          Thread.
+          .start))
+    result-ch))
+
+(defn topo-iter [tests]
+  (let [adjs (->> tests
+                  (mapcat #(for [d (:deps %)] [d (:id %)]))
+                  (reduce #(update %1 (first %2) conj (second %2)) {}))
+        nodes (atom (into {} (for [t tests]
+                               [(:id t) {:test t :in-degree (count (:deps t))}])))]
+    (fn
+      ([] (filter #(= 0 (:in-degree (second %))) @nodes))
+      ([t]
+       (let [[next-nodes next-ts]
+             (reduce
+              (fn [[nodes zero-degs] a]
+                (let [nodes (update nodes a update :in-degree dec)]
+                  (if (zero? (:in-degree (nodes a)))
+                    [nodes (conj zero-degs (nodes a))]
+                    [nodes zero-degs])))
+              [@nodes []]
+              (adjs (:id t)))]
+         (reset! nodes next-nodes)
+         next-ts)))))
+
 (defn exec-in-order [tests opts]
-  (let [exec-ch (chan (or (:concurrency opts) 4))]
-    (loop [adjs (->> tests
-                     (mapcat #(for [d (:deps %)] [d (:id %)]))
-                     (reduce #(update %1 (first %2) conj (second %2)) {}))
-           nodes (into {} (for [t tests]
-                            [(:id t) {:test t :in-degree (count (:deps t))}]))
-           ts (filter #(= 0 (:in-degree (second %))) nodes)
-           leftover (count tests)
-           result []]
-      (when (and (empty? ts) (pos? leftover))
-        (throw
-         (Exception. (str "Failed dependencies to execute test cases : ... " ))))
-      (if (empty? ts)
-        result
-        (doseq [t ts]
-          (>! exec-ch t)
-          (let [t (first ts)
-                t-adjs (adjs (:id t))
-                [nodes ts] (reduce
-                            (fn [[nodes zero-degs] a]
-                              (let [nodes (update nodes a update :in-degree dec)]
-                                (if (zero? (:in-degree (nodes a)))
-                                  [nodes (conj zero-degs (nodes a))]
-                                  [nodes zero-degs])))
-                            [nodes (rest ts)] t-adjs)]
-            (recur adjs nodes ts (conj result t))))))))
+  (let [concurrency (or (:concurrency opts) 4)
+        exec-ch (chan (* concurrency 2))
+        done-ch (start-executors exec-ch concurrency)
+        topo-iter! (topo-iter tests)
+        runnables (topo-iter!)
+        opts (atom opts)
+        num-tests (count tests)]
+    (when (empty? runnables)
+      (throw (Exception. "No tests ready for execution. Review dependencies")))
+    (go (doseq [t runnables] (>! exec-ch [t opts])))
+    (<!! (go-loop [r (<! done-ch)
+                   num-executed 1
+                   results []]
+           (log/infof "Test %i of %i executed" @num-executed num-tests)
+           (when-let [runnables (not-empty (topo-iter! r))]
+             (go (doseq [t runnables] (>! exec-ch [t opts]))))
+           (if (= num-executed num-tests)
+             results
+             (recur (<! done-ch) (inc num-executed) (conj results r)))))))

 (defn exec-tests [tests opts]
   (let [skip-tag (opts "skip")


Remove POST schedule from resources

Remove POST schedule from resources

--- src/shuppet/web.clj
+++ src/shuppet/web.clj
@@ -148,7 +148,7 @@
    (array-map
     "/1.x/apps/:app-name" "Create an application configuration, QS Parameter masteronly=true, just creates the master branch"
     "/1.x/validate/:name" "Validate the configuration passed in the body"
-    "/1.x/envs/env/schedule" "Schedules shuppet, default=10mins. QS Parameters interval=time in minutes, action=stop to stop scheduling" )})
+    )})

 (defroutes applications-routes