brave new REPL world

brave new REPL world

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -25,7 +25,7 @@
   (:import [java.io File PushbackReader FileWriter]
            [java.net URL]
            [javax.xml.bind DatatypeConverter]
-           [clojure.lang LineNumberingPushbackReader]))
+           [clojure.lang IExceptionInfo]))

 (def ^:dynamic *cljs-verbose* false)
 (def ^:dynamic *repl-opts* nil)
@@ -41,11 +41,11 @@
   its behavior of both supporting .unread and collapsing all of CR, LF, and
   CRLF to a single \\newline."
   [s]
-  (let [c (.read s)]
+  (let [c (readers/read-char s)]
     (case c
       \newline :line-start
       nil :stream-end
-      (do (.unread s c) :body))))
+      (do (readers/unread s c) :body))))

 (defn skip-whitespace
   "Skips whitespace characters on stream s. Returns :line-start, :stream-end,
@@ -57,14 +57,14 @@
   supporting .unread and collapsing all of CR, LF, and CRLF to a single
   \\newline."
   [s]
-  (loop [c (.read s)]
+  (loop [c (readers/read-char s)]
     (case c
       \newline :line-start
       nil :stream-end
-      \; (do (.readLine s) :line-start)
+      \; (do (readers/read-line s) :line-start)
       (if (or (Character/isWhitespace c) (identical? c \,))
-        (recur (.read s))
-        (do (.unread s c) :body)))))
+        (recur (readers/read-char s))
+        (do (readers/unread s c) :body)))))

 (defn repl-read
   "Default :read hook for repl. Reads from *in* which must either be an
@@ -77,19 +77,17 @@
       - reads an object from the input stream, then
         - skips the next input character if it's end of line, then
         - returns the object."
-  [request-prompt request-exit]
-  (or ({:line-start request-prompt :stream-end request-exit}
-        (skip-whitespace *in*))
-    (let [input (read)]
-      (skip-if-eol *in*)
-      input)))
-
-(defmacro with-read-known
-  "Evaluates body with *read-eval* set to a \"known\" value,
-   i.e. substituting true for :unknown if necessary."
-  [& body]
-  `(binding [*read-eval* (if (= :unknown *read-eval*) true *read-eval*)]
-     ~@body))
+  ([request-prompt request-exit]
+   (repl-read request-prompt request-exit *repl-opts*))
+  ([request-prompt request-exit opts]
+   (binding [*in* (if (true? (:source-map-inline opts))
+                    ((:reader opts))
+                    *in*)]
+     (or ({:line-start request-prompt :stream-end request-exit}
+          (skip-whitespace *in*))
+        (let [input (reader/read)]
+          (skip-if-eol *in*)
+          input)))))

 ;; =============================================================================
 ;; CLJS Specifics
@@ -341,55 +339,57 @@
   ([repl-env env filename form wrap]
     (evaluate-form repl-env env filename form wrap *repl-opts*))
   ([repl-env env filename form wrap opts]
-    (try
-      (binding [ana/*cljs-file* filename]
-        (let [ast (ana/analyze env form opts)
-              js (comp/emit-str ast)
-              wrap-js
-              ;; TODO: check opts as well - David
-              (if (:source-map repl-env)
-                (binding [comp/*source-map-data*
-                          (atom {:source-map (sorted-map)
-                                 :gen-col 0
-                                 :gen-line 0})]
-                  (let [js (comp/emit-str (ana/no-warn (ana/analyze env (wrap form) opts)))
-                        t (System/currentTimeMillis)]
-                    (str js
-                      "\n//# sourceURL=repl-" t ".js"
-                      "\n//# sourceMappingURL=data:application/json;base64,"
-                      (DatatypeConverter/printBase64Binary
-                        (.getBytes
-                          (sm/encode
-                            {(str "repl-" t ".cljs")
-                             (:source-map @comp/*source-map-data*)}
-                            {:lines (+ (:gen-line @comp/*source-map-data*) 3)
-                             :file  (str "repl-" t ".js")
-                             :sources-content
-                                    [(or (:source (meta form))
-                                       ;; handle strings / primitives without metadata
-                                       (with-out-str (pr form)))]})
-                          "UTF-8")))))
-                (comp/emit-str (ana/no-warn (ana/analyze env (wrap form) opts))))]
-          (when (= (:op ast) :ns)
-            (load-dependencies repl-env
-              (into (vals (:requires ast))
-                (distinct (vals (:uses ast))))
-              opts))
-          (when *cljs-verbose*
-            ((:print opts) js))
-          (let [ret (-evaluate repl-env filename (:line (meta form)) wrap-js)]
-            (case (:status ret)
-              :error (display-error repl-env ret form opts)
-              :exception (display-error repl-env ret form
-                           (if (:repl-verbose opts)
-                             #(prn "Error evaluating:" form :as js)
-                             (constantly nil))
-                           opts)
-              :success (:value ret)))))
-      (catch Throwable ex
-        (.printStackTrace ex)
-        ((:print opts) (str ex))
-        ((:flush opts))))))
+   (binding [ana/*cljs-file* filename]
+     (let [ast (ana/analyze env form opts)
+           js (comp/emit-str ast)
+           wrap-js
+           ;; TODO: check opts as well - David
+           (if (:source-map repl-env)
+             (binding [comp/*source-map-data*
+                       (atom {:source-map (sorted-map)
+                              :gen-col 0
+                              :gen-line 0})]
+               (let [js (comp/emit-str (ana/no-warn (ana/analyze env (wrap form) opts)))
+                     t (System/currentTimeMillis)]
+                 (str js
+                   "\n//# sourceURL=repl-" t ".js"
+                   "\n//# sourceMappingURL=data:application/json;base64,"
+                   (DatatypeConverter/printBase64Binary
+                     (.getBytes
+                       (sm/encode
+                         {(str "repl-" t ".cljs")
+                          (:source-map @comp/*source-map-data*)}
+                         {:lines (+ (:gen-line @comp/*source-map-data*) 3)
+                          :file (str "repl-" t ".js")
+                          :sources-content
+                          [(or (:source (meta form))
+                             ;; handle strings / primitives without metadata
+                             (with-out-str (pr form)))]})
+                       "UTF-8")))))
+             (comp/emit-str (ana/no-warn (ana/analyze env (wrap form) opts))))]
+       (when (= (:op ast) :ns)
+         (load-dependencies repl-env
+           (into (vals (:requires ast))
+             (distinct (vals (:uses ast))))
+           opts))
+       (when *cljs-verbose*
+         ((:print opts) js))
+       (let [ret (-evaluate repl-env filename (:line (meta form)) wrap-js)]
+         (case (:status ret)
+           :error (throw
+                    (ex-info (:value ret)
+                      {:type :js-eval-error
+                       :error ret
+                       :repl-env repl-env
+                       :form form}))
+           :exception (throw
+                        (ex-info (:value ret)
+                          {:type :js-eval-exception
+                           :error ret
+                           :repl-env repl-env
+                           :form form
+                           :js js}))
+           :success (:value ret)))))))

 (defn load-stream [repl-env filename res]
   (let [env (ana/empty-env)]
@@ -416,18 +416,21 @@
           (load-stream repl-env f res))))))

 (defn- wrap-fn [form]
-  (cond (and (seq? form) (= 'ns (first form))) identity
-        ('#{*1 *2 *3 *e} form) (fn [x] `(cljs.core.pr-str ~x))
-        :else (fn [x] `(cljs.core.pr-str
-                         (try
-                           (let [ret# ~x]
-                             (set! *3 *2)
-                             (set! *2 *1)
-                             (set! *1 ret#)
-                             ret#)
-                           (catch :default e#
-                             (set! *e e#)
-                             (throw e#)))))))
+  (cond
+    (and (seq? form) (= 'ns (first form))) identity
+    ('#{*1 *2 *3 *e} form) (fn [x] `(cljs.core.pr-str ~x))
+    :else
+    (fn [x]
+      `(cljs.core.pr-str
+         (try
+           (let [ret# ~x]
+             (set! *3 *2)
+             (set! *2 *1)
+             (set! *1 ret#)
+             ret#)
+           (catch :default e#
+             (set! *e e#)
+             (throw e#)))))))

 (defn- eval-cljs
   "Given a REPL evaluation environment, an analysis environment, and a
@@ -534,42 +537,67 @@
 (defn repl-prompt []
   (print (str "ClojureScript:" ana/*cljs-ns* "> ")))

-(defn repl-caught [e]
-  )
+(defn repl-caught [e opts]
+  (if (and (instance? IExceptionInfo e)
+           (#{:js-eval-error :js-eval-exception} (:type (ex-data e))))
+    (let [{:keys [type repl-env error form js]} (ex-data e)]
+      (case type
+        :js-eval-error
+        (display-error repl-env error form opts)
+
+        :js-eval-exception
+        (display-error repl-env error form
+          (if (:repl-verbose opts)
+            #(prn "Error evaluating:" form :as js)
+            (constantly nil))
+          opts)))
+    (binding [*out* *err*]
+      (.printStackTrace e))))

 (defn repl*
-  [repl-env {:keys [init need-prompt prompt flush read eval print print-no-newline caught]
-             :or {init        #()
-                  need-prompt (if (instance? LineNumberingPushbackReader *in*)
-                                #(.atLineStart ^LineNumberingPushbackReader *in*)
-                                #(identity true))
-                  prompt      repl-prompt
-                  flush       flush
-                  read        repl-read
-                  eval        eval-cljs
-                  print       println
-                  caught      repl-caught
-                  print-no-newline print}
+  [repl-env {:keys [init need-prompt prompt flush read eval print caught reader print-no-newline source-map-inline]
+             :or {init #()
+                  need-prompt #(if (readers/indexing-reader? *in*)
+                                 (== (readers/get-column-number *in*) 1)
+                                 (identity true))
+                  prompt repl-prompt
+                  flush flush
+                  read repl-read
+                  eval eval-cljs
+                  print println
+                  caught repl-caught
+                  reader #(readers/source-logging-push-back-reader
+                           (PushbackReader. (io/reader *in*))
+                           1 "NO_SOURCE_FILE")
+                  print-no-newline print
+                  source-map-inline true}
              :as opts}]
   (print "To quit, type: " :cljs/quit)
   (let [ups-deps (cljsc/get-upstream-deps)
         {:keys [analyze-path repl-verbose warn-on-undeclared special-fns static-fns] :as opts
          :or   {warn-on-undeclared true}}
         (assoc (merge (-repl-options repl-env) opts)
+          :init init
+          :need-prompt prompt
+          :flush flush
+          :read read
           :print print
+          :caught caught
+          :reader reader
           :print-no-newline print-no-newline
-          :flush flush
+          :source-map-inline source-map-inline
           :ups-libs (:libs ups-deps)
           :ups-foreign-libs (:foreign-libs ups-deps))]
     (env/with-compiler-env
      (or (::env/compiler repl-env) (env/default-compiler-env opts))
      (binding [ana/*cljs-ns* 'cljs.user
                *cljs-verbose* repl-verbose
-               ana/*cljs-warnings* (assoc ana/*cljs-warnings*
-                                     :unprovided warn-on-undeclared
-                                     :undeclared-var warn-on-undeclared
-                                     :undeclared-ns warn-on-undeclared
-                                     :undeclared-ns-form warn-on-undeclared)
+               ana/*cljs-warnings*
+               (assoc ana/*cljs-warnings*
+                 :unprovided warn-on-undeclared
+                 :undeclared-var warn-on-undeclared
+                 :undeclared-ns warn-on-undeclared
+                 :undeclared-ns-form warn-on-undeclared)
                ana/*cljs-static-fns* static-fns
                *repl-opts* opts]
        ;; TODO: the follow should become dead code when the REPL is
@@ -579,10 +607,27 @@
              is-special-fn? (set (keys special-fns))
              request-prompt (Object.)
              request-exit (Object.)
-             read-error (Object.)
              opts (if-let [merge-opts (:merge-opts (-setup repl-env opts))]
                     (merge opts merge-opts)
-                    opts)]
+                    opts)
+             read-eval-print
+             (fn []
+               (let [input (binding [*ns* (create-ns ana/*cljs-ns*)
+                                     reader/*data-readers* tags/*cljs-data-readers*
+                                     reader/*alias-map*
+                                     (apply merge
+                                       ((juxt :requires :require-macros)
+                                         (ana/get-namespace ana/*cljs-ns*)))]
+                             (repl-read request-prompt request-exit))]
+                 (or ({request-exit request-exit
+                       :cljs/quit request-exit
+                       request-prompt request-prompt} input)
+                   (if (and (seq? input) (is-special-fn? (first input)))
+                     (do
+                       ((get special-fns (first input)) repl-env env input opts)
+                       (print nil))
+                     (let [value (eval repl-env env input opts)]
+                       (print value))))))]
          (comp/with-core-cljs opts
            (fn []
              (when analyze-path
@@ -599,48 +644,27 @@
                    (print "Watch compilation log available at:" (str log-file))
                    (binding [*out* (FileWriter. log-file)]
                      (cljsc/watch src (dissoc opts :watch))))))
-             (loop []
-               ;; try to let things flush before printing prompt
-               (Thread/sleep 10)
+             (binding [*in* (if (true? (:source-map-inline opts))
+                              *in*
+                              (reader))]
+               (try
+                 (init)
+                 (catch Throwable e
+                   (caught e opts)))
                (prompt)
                (flush)
-               (let [rdr (readers/source-logging-push-back-reader
-                           (PushbackReader. (io/reader *in*))
-                           1
-                           "NO_SOURCE_FILE")
-                     form (try
-                            (binding [*ns* (create-ns ana/*cljs-ns*)
-                                      reader/*data-readers* tags/*cljs-data-readers*
-                                      reader/*alias-map*
-                                      (apply merge
-                                        ((juxt :requires :require-macros)
-                                          (ana/get-namespace ana/*cljs-ns*)))]
-                              (reader/read rdr nil read-error))
-                            (catch Exception e
-                              (print (.getMessage e))
-                              read-error))]
-                 ;; TODO: need to catch errors here too - David
-                 (cond
-                   (identical? form read-error) (recur)
-                   (= form :cljs/quit) :quit
-
-                   (and (seq? form) (is-special-fn? (first form)))
-                   (do
-                     (try
-                       ((get special-fns (first form)) repl-env env form opts)
-                       (catch Throwable ex
-                         (print "Failed to execute special function:" (pr-str (first form)))
-                         (trace/print-cause-trace ex 12)))
-                     ;; flush output which could include stack traces
-                     (flush)
-                     (print)
-                     (recur))
-
-                   :else
-                   (let [value (eval repl-env env form opts)]
-                     (print value)
-                     (recur)))))))
-         (-tear-down repl-env))))))
+               (loop []
+                 (when-not
+                   (try
+                     (identical? (read-eval-print) request-exit)
+                     (catch Throwable e
+                       (caught e opts)
+                       nil))
+                   (when (need-prompt)
+                     (prompt)
+                     (flush))
+                   (recur)))))))
+         (-tear-down repl-env)))))

 (defn repl
   "Note - repl will reload core.cljs every time, even if supplied old repl-env"


Support for cards that modify their own rez cost when unrezzed.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -441,7 +441,9 @@
 (defn rez-cost [state side {:keys [cost] :as card}]
   (if (nil? cost)
     nil
-    (-> cost
+    (-> (if-let [rezfun (:rez-cost-bonus (card-def card))]
+          (+ cost (rezfun state side card nil))
+          cost)
         (+ (or (get-in @state [:bonus :cost]) 0))
         (max 0))))


Simplify agent code.

Simplify agent code.

--- metlog-agent/src/metlog_agent/core.clj
+++ metlog-agent/src/metlog_agent/core.clj
@@ -11,51 +11,44 @@

 (def sensor-result-queue (java.util.concurrent.LinkedBlockingQueue.))

-(defn sensor-reading [ series-name val ]
-  {:t (java.util.Date.)
-   :series_name series-name
-   :val val})
-
-(defn enqueue-sensor-reading [ reading ]
-  (log/info "enquing sensor reading" reading)
-  (.add sensor-result-queue reading))
+(defn enqueue-sensor-reading [ series-name val ]
+  (let [ reading {:t (java.util.Date.)
+                  :series_name series-name
+                  :val val}]
+    (log/info "enquing sensor reading" reading)
+    (.add sensor-result-queue  reading)))

 (defn poll-sensor-1 []
-  (enqueue-sensor-reading
-   (sensor-reading "sine" (Math/sin (/ (- (System/currentTimeMillis) start-t) 60000.0)))))
+  (enqueue-sensor-reading "sine" (Math/sin (/ (- (System/currentTimeMillis) start-t) 60000.0))))

 (defn poll-sensor-2 []
-  (enqueue-sensor-reading
-   (sensor-reading "cosine" (Math/cos (/ (- (System/currentTimeMillis) start-t) 60000.0)))))
+  (enqueue-sensor-reading "cosine" (Math/cos (/ (- (System/currentTimeMillis) start-t) 60000.0))))

-(defn poll-w1-sensor [ path]
+(defn poll-w1-sensor [ path ]
   (with-open [rdr (clojure.java.io/reader path)]
-  (let [ line (second (line-seq rdr)) ]
-    (if (not (nil? line))
-      (enqueue-sensor-reading
-       (sensor-reading "basement-temp"
-        (/ (Double/valueOf (.substring line 29)) 1000.0)))))))
+    (let [ line (second (line-seq rdr)) ]
+      (if (not (nil? line))
+        (enqueue-sensor-reading "basement-temp" (/ (Double/valueOf (.substring line 29)) 1000.0))))))

 (defn poll-sensors []
   (log/debug "poll-sensors")
-  (locking sensor-result-queue
-    (poll-sensor-1)
-    (poll-sensor-2)
-    (if-let [ sensor-path (config-property "sensor.path") ]
-      (poll-w1-sensor sensor-path))))
+  (poll-sensor-1)
+  (poll-sensor-2)
+  (if-let [ sensor-path (config-property "sensor.path") ]
+    (poll-w1-sensor sensor-path)))

-(defn do-update [ snapshot ]
-  (let [url (config-property "vault.url" "http://localhost:8080/data")
-        data { :body (pr-str snapshot)}]
-    (log/info "Posting" data " to " url)
-    (client/post url data)))
+(defn take-result-queue-snapshot []
+  (let [ snapshot (java.util.concurrent.LinkedBlockingQueue.) ]
+    (locking sensor-result-queue
+      (.drainTo sensor-result-queue snapshot))
+    (seq snapshot)))

 (defn update-vault []
   (log/debug "update-vault")
-  (let [ snapshot (java.util.concurrent.LinkedBlockingQueue.) ]
-    (locking sensor-result-queue
-      (.drainTo sensor-result-queue snapshot))
-    (do-update (seq snapshot))))
+  (let [url (config-property "vault.url" "http://localhost:8080/data")
+        data { :body (pr-str (take-result-queue-snapshot))}]
+    (log/info "Posting" data " to " url)
+    (client/post url data)))

 (defn -main
   "I don't do a whole lot ... yet."


add build function to rebuild dom tree from a snapshot structure

--- src/domshot/core.cljs
+++ src/domshot/core.cljs
@@ -58,6 +58,22 @@
                               :when (include-node? child)]
                           (snapshot child))))))))

+;; ---- Building the dom ---- ;;
+
+(defn build
+  "Takes a structure produced by `snapshot` as its only arg.
+  Returns a dom tree reflecting the given structure."
+  [structure]
+  (let [node-name (:node-name structure)]
+    (if (= "#text" node-name)
+      (goog.dom/createTextNode (:text structure))
+      (goog.dom/createDom node-name
+                          (clj->js (:attributes structure))
+                          (when (< 0 (count (:children structure)))
+                            (clj->js (for [i (range (count (:children structure)))
+                                           :let [child (nth (:children structure) i)]]
+                                       (build child))))))))
+

 ;; ---- Testing the api... TODO: delete these and test like a pro, not a noob D: ---- ;;
@@ -65,3 +81,5 @@
 (add-invalidator #(not= "SCRIPT" (.-nodeName %)))

 (.log js/console "snapshot result" (clj->js (snapshot)))
+
+(.log js/console "build result" (build (snapshot)))


trying to clean up

trying to clean up

--- src/evalback/core.clj
+++ src/evalback/core.clj
@@ -9,7 +9,7 @@
             [hiccup.page :as hp]
             [hiccup.element :as he]
             [clojure.data.json :as json]
-            [clojure.core.async :as a :refer [alts!! chan <!! >!! timeout]])
+            [clojure.core.async :as a :refer [alts!! close! chan <!! >!! timeout]])
   (:use ring.server.standalone
         [ring.middleware file-info file])
   (:import de.prob.animator.command.CbcSolveCommand
@@ -81,8 +81,10 @@

 (defn solve [request]
-  (let [[solver _] (alts!! [@worker (timeout request-timeout)])]
-    (if solver
+  (let [ toc (timeout request-timeout)
+        [solver c] (alts!! [@worker toc])]
+    (if-not (= c toc)
+      (close! toc)
       (let [result (solver request)]
         (>!! @worker solver)
         result)
@@ -194,7 +196,6 @@
 (defn destroy []
   (doseq [_ (range instances)] (<!! @worker))
   (reset! worker nil)
-  (println :destroy)
-  (System/exit 0))
-
-
+  (println :destroy))
+
+


More discovery data

More discovery data

--- src/clj_simple_chart/ncs/discovery.clj
+++ src/clj_simple_chart/ncs/discovery.clj
@@ -1,6 +1,7 @@
 (ns clj-simple-chart.ncs.discovery
   (:require [clj-simple-chart.csv.csvmap :as csv]
             [clj-http.client :as client]
+            [clojure.set :refer [rename-keys]]
             [clj-simple-chart.ncs.resource :as resource]
             [clj-simple-chart.ncs.reserve :as reserve]
             [clojure.test :as test]))
@@ -50,6 +51,13 @@
                  (distinct)
                  (vec))))

+(def status-map {"Approved for production" :pdo-approved
+                 "Producing" :producing
+                 "Production in clarification phase" :clarification
+                 "Production likely, but unclarified" :likely
+                 "Production not evaluated" :not-evaluated
+                 "Shut down" :shut-down})
+
 (defn recoverable [{fld-name :fldName dsc-name :dscName} kind]
   (if (and (some? fld-name) (some #{fld-name} reserve/field-names-all))
       (reserve/get-reserve fld-name kind)
@@ -57,14 +65,17 @@

 (def parsed (->> data
                  (remove #(= "Included in other discovery" (:dscCurrentActivityStatus %)))
-                 (map #(select-keys % [:dscName :fldName :dscDiscoveryYear :dscCurrentActivityStatus]))
-                 (csv/read-number-or-throw-columns [:dscDiscoveryYear])
+                 (map #(rename-keys % {:dscCurrentActivityStatus :status
+                                       :dscDiscoveryYear :year}))
+                 (map #(update % :status status-map))
+                 (map #(select-keys % [:dscName :fldName :year :status]))
+                 (csv/read-number-or-throw-columns [:year])
                  (map #(update % :fldName (fn [x] (if (empty? x) nil x))))
                  (map #(update % :dscName (fn [x] (if (empty? x) nil x))))
                  (map #(assoc % :name (or (:fldName %) (:dscName %))))
                  (group-by :name)
                  (vals)
-                 (map #(sort-by (fn [x] (:dscDiscoveryYear x)) %))
+                 (map #(sort-by (fn [x] (:year x)) %))
                  (map #(first %))
                  (flatten)
                  (map #(assoc % :fldRecoverableLiquids (recoverable % :fldRecoverableLiquids)))
@@ -75,3 +86,17 @@
                  (csv/number-or-throw-columns [:fldRecoverableLiquids :fldRecoverableGas])
                  (sort-by :name)
                  (vec)))
+
+(def producing-field-names (->> parsed
+                                (filter #(= :producing (:status %)))
+                                (map :name)
+                                (distinct)
+                                (sort)
+                                (vec)))
+
+(def shut-down-field-names (->> parsed
+                                (filter #(= :shut-down (:status %)))
+                                (map :name)
+                                (distinct)
+                                (sort)
+                                (vec)))


add endorsements to badge settings

add endorsements to badge settings

--- src/cljs/salava/badge/ui/settings.cljs
+++ src/cljs/salava/badge/ui/settings.cljs
@@ -13,7 +13,8 @@
             [salava.core.ui.rate-it :as r]
             [salava.badge.ui.my :as my]
             [salava.core.ui.modal :as mo]
-            [salava.badge.ui.evidence :as evidence]))
+            [salava.badge.ui.evidence :as evidence]
+            [salava.badge.ui.endorsement :as endorsement]))

 (defn set-visibility [visibility state]
@@ -505,15 +506,9 @@
                                                    [:div {:class "row"}
                                                     [:label {:class "col-md-12 sub-heading" :for "evidence"}
                                                      (t :badge/Evidences)]]
-                                                   #_(when-not (empty? @(cursor state [:badge-settings :evidences]))
-                                                       [:div.form-group[:fieldset {:class "col-md-9 checkbox"}
-                                                                        [:div.col-md-12 [:label {:for "show-evidence"}
-                                                                                [:input {:type      "checkbox"
-                                                                                :id        "show-evidence"
-                                                                                :on-change #(toggle-evidence state)
-                                                                                :checked   (get-in @state [:badge-settings :show_evidence])}]
-                                                                                (t :badge/Evidencevisibility)]]]])
-                                                   [:div [evidenceblock data state init-data]]]]
+                                                   [:div [evidenceblock data state init-data]]
+
+                                                   [:div [endorsement/endorsement-list (:id @state)]]]]
                                             [:div.modal-footer]])]]))

 (defn download-tab-content [{:keys [name image_file obf_url assertion_url]} state]


More work on attributes code draft.

More work on attributes code draft.

--- src/continuo/postgresql/attributes.clj
+++ src/continuo/postgresql/attributes.clj
@@ -34,60 +34,52 @@
   [attr]
   (instance? Attribute attr))

+(defn schema-attribute?
+  [attr]
+  (and (attribute? attr)
+       (= (namespace attr) "db")))
+
 (defn attribute
-  [name type opts]
-  (with-meta (Attribute. name type opts)
-    {::type ::standard}))
-
-;; (defprotocol IAttribute
-;;   (-create-table-sql [_] "Generate a sql for create table ddl.")
-;;   (-table-name [_] "Generate a normalized table name for attribute."))
-
-(declare attribute?)
-
-(defn- get-table-name
-  [attr]
-  {:pre [(attribute?? attr)]}
-  (let [ns (namespace attr)
-        nm (name attr)]
-    (str prefix "_" ns "__" nm)))
-
-(defn- get-create-table-sql
-  [attr]
-  {:pre [(attr? attr)]}
-  (let [tablename (get-table-name attr)
-        typename (types/-sql-typename (.-type attr))
-        template (str "CREATE TABLE {{ name }} ("
-                      "  eid uuid PRIMARY KEY,"
-                      "  txid bigint,"
-                      "  created_at timestamptz default now(),"
-                      "  modified_at timestamptz,"
-                      "  content {{ type }}"
-                      ") WITH (OIDS=FALSE);")]
-    (tmpl/render-string template {:name tablename
-                                  :type typename})))
-(defn special-attrname?
-  [attrname]
-  {:pre [(keyword? attrname)]}
-  (= (namespace attrname) "db"))
+  ([name type]
+   (attribute name type {}))
+  ([name type opts]
+   (Attribute. name type opts)))

 (def ^:private
   +builtin-attributes+
-  {:db/ident (Attribute. "db" :db/ident :continuo/string {:unique true})})
+  {:db/ident (attribute :db/ident :string {:unique true})
+   :db/unique (attribute :db/unique :boolean {})})

 (defn resolve-attr
   "Given a context and the attribute name
   return the attribute definition."
   [context attrname]
   {:pre [(keyword? attrname)]}
-  (let [schema (.-schema context)]
-    ;; TODO: do stuff
-    ))
+  (if (schema-attribute? attrname)
+    (get +builtin-attributes+ attrname)
+    (let [schema (.-schema context)]
+      ;; TODO: do stuff
+      )))

-(defn generate-drop-sql
-  "Generate a valid DDL operation for create the attribute
-  table depending on the attribute type."
-  [attr]
-  (let [sql (str "DROP TABLE {{ attr }};")]
-    (tmpl/render-string sql {:attr attr})))
+;; (defn- get-create-table-sql
+;;   [attr]
+;;   {:pre [(attr? attr)]}
+;;   (let [tablename (get-table-name attr)
+;;         typename (types/-sql-typename (.-type attr))
+;;         template (str "CREATE TABLE {{ name }} ("
+;;                       "  eid uuid PRIMARY KEY,"
+;;                       "  txid bigint,"
+;;                       "  created_at timestamptz default now(),"
+;;                       "  modified_at timestamptz,"
+;;                       "  content {{ type }}"
+;;                       ") WITH (OIDS=FALSE);")]
+;;     (tmpl/render-string template {:name tablename
+;;                                   :type typename})))

+;; (defn generate-drop-sql
+;;   "Generate a valid DDL operation for create the attribute
+;;   table depending on the attribute type."
+;;   [attr]
+;;   (let [sql (str "DROP TABLE {{ attr }};")]
+;;     (tmpl/render-string sql {:attr attr})))
+


This (and a previous commit - 217a765) fixes #157

--- src/day8/re_frame_10x/view/app_db.cljs
+++ src/day8/re_frame_10x/view/app_db.cljs
@@ -27,7 +27,7 @@
 (def pod-border-edge (str "1px solid " pod-border-color))
 (def border-radius "3px")

-(def *finished-animation? (r/atom false))
+(def *finished-animation? (r/atom true))
 (def animation-duration 150)

@@ -272,15 +272,15 @@

 (defn no-pods []
   [rc/h-box
-   :margin (css-join "0px 0px 0px" common/gs-19s)
-   :gap common/gs-7s
+   :margin (css-join common/gs-19s " 0px 0px 50px")
+   :gap common/gs-12s
    :align :start
    :align-self :start
    :children [[:img {:src (str "data:image/svg+xml;utf8," round-arrow)}]
               [rc/label
-               :style {:width      "150px"
+               :style {:width      "160px"
                        :margin-top "22px"}
-               :label "add inspectors to show what happened to app-db"]]])
+               :label "see the values in app-db by adding one or more inspectors"]]])

 (defn pod-header-column-titles


fix failing devcards test (regression of OMCSS-20)

--- src/devcards/om_css/devcards/core.cljs
+++ src/devcards/om_css/devcards/core.cljs
@@ -70,6 +70,7 @@
   NotStaticStyleComponent)

 (defcomponent defcomponent-example [props children]
+  [[:.defcomponent-class {:color "green"}]]
   (dom/div {:class :defcomponent-class}
     "`defcomponent` example with class `:defcomponent-class`"))


Only refresh the document once when opening it.

--- src-cljs/pepa/workflows/document.cljs
+++ src-cljs/pepa/workflows/document.cljs
@@ -186,8 +186,6 @@
        :tag-changes (async/chan)})
     om/IWillMount
     (will-mount [_]
-      ;; Refresh document from server
-      (api/fetch-documents! [(-> document om/value :id)])
       ;; Start handling tag change events etc.
       (go-loop []
         (let [pages (om/get-state owner :pages)


update function name for fs-extra

update function name for fs-extra

--- src-cljs/cuttle/exec.cljs
+++ src-cljs/cuttle/exec.cljs
@@ -463,10 +463,10 @@
         output-to-full (str cwd output-to)]
     (when (and output-dir
                (file-exists? output-dir-full))
-      (.rmrfSync fs output-dir-full))
+      (.removeSync fs output-dir-full))
     (when (and output-to
                (file-exists? output-to-full))
-      (.unlinkSync fs output-to-full))))
+      (.removeSync fs output-to-full))))

 (defn new-project [folder-name project-name callback-fn]
   (log-info "creating a new project" project-name "at" project-name)


move blocks around

move blocks around

--- test/nha/boot_uglify/uglifyjs_test.clj
+++ test/nha/boot_uglify/uglifyjs_test.clj
@@ -79,12 +79,6 @@

 (deftest test-js-minification

-  ;; (testing "produces the same output as the expected files"
-  ;;   ;; use the common interface
-  ;;   (sut/minify-js js-input-path js-output-path)
-  ;;   (for [exp-f js-expected-files]
-  ;;     (is (= (slurp exp-f) (slurp (str js-output-path (.getName exp-f)))))))
-

   (testing "can escape js code"
     (is (= (sut/escape-js "a = 'test'; // 'test' used here \n print(\"a is\",  a); ")
@@ -105,6 +99,13 @@
               {:out "if(foo?bar&&baz():stuff(),foo)for(var i=0;5>i;++i)bar&&baz();else stuff();", :error nil}))))

+
+  ;; (testing "produces the same output as the expected files"
+  ;;   ;; use the common interface
+  ;;   (sut/minify-js js-input-path js-output-path)
+  ;;   (for [exp-f js-expected-files]
+  ;;     (is (= (slurp exp-f) (slurp (str js-output-path (.getName exp-f)))))))
+
   (comment
     (testing "output is the same as the locally installed UglifyJS2"
       (for [in-f js-input-files]
@@ -116,15 +117,8 @@

 (comment
-  (=
-   (:out (shell/sh "uglifyjs" (str js-input-path "blocks.js"))) ;; "if(foo){{{{}}}if(bar){baz()}{{}}}else{stuff()}if(foo){for(var i=0;i<5;++i)if(bar)baz()}else{stuff()}\n"
-   (:out (sut/uglify-str (slurp  (str js-input-path "blocks.js")))) ;; "if(foo?bar&&baz():stuff(),foo)for(var i=0;5>i;++i)bar&&baz();else stuff();"
-   )

+  (count (:out (shell/sh "uglifyjs" (str js-input-path "blocks.js"))))
+  (count (:out (sut/uglify-str (slurp  (str js-input-path "blocks.js")))))

-  (=
-   (count (:out (shell/sh "uglifyjs" (str js-input-path "blocks.js")))) ;; "if(foo){{{{}}}if(bar){baz()}{{}}}else{stuff()}if(foo){for(var i=0;i<5;++i)if(bar)baz()}else{stuff()}\n"
-   (count (:out (sut/uglify-str (slurp  (str js-input-path "blocks.js"))))) ;; "if(foo?bar&&baz():stuff(),foo)for(var i=0;5>i;++i)bar&&baz();else stuff();"
-
-   )
   )


design spike cleanup

design spike cleanup

--- test/push/design_spikes/dsl_macros.clj
+++ test/push/design_spikes/dsl_macros.clj
@@ -11,40 +11,51 @@

 ;; The DSL for Push instructions could be a series of simple steps.
 ;; Everything would be assumed to happen inside one interpreter, and the interpreter
-;; (and some store of local scratch vars) would be passed step-to-step.
+;; (and some store of scratch vars) would be passed step-to-step.
 ;;
 ; - `count-of [stackname :as local]`
 ;    store the number of items in `stackname` under key `local`
 ;    raise an Exception if the stack doesn't exist
-; - `consume [stackname]`
+
+; + `consume [stackname]`
 ;    pop an item (and discard it) from `stackname`
 ;    raise an Exception if it's empty or undefined
-; - `consume [stackname :as local]`
+
+; + `consume [stackname :as local]`
 ;    pop an item from `stackname` and store under key `local`
 ;    raise an Exception if it's empty or undefined
+
 ; - `consume [stackname :at where :as local]`
 ;    delete an item from `stackname` at position `where` and store under key `local`
 ;    raise an Exception if it's empty or undefined
+
 ; - `consume-stack [stackname]`
 ;    clear the named stack
 ;    raise an Exception if it's undefined
+
 ; - `consume-stack [stackname :as local]`
 ;    save the entire stack into `local` and clear it
 ;    raise an Exception if it's undefined
-; - `remember [args fn :as local]
+
+; + `remember [args fn :as local]
 ;    save the result of applying `fn` to the named `args` under key `local`
+
 ; - `remember [stackname :as local]`
 ;    store top item from `stackname` under key `local`
 ;    raise an Exception if it's empty or undefined
+
 ; - `remember [stackname :at where :as local]`
 ;    store item in `stackname` at position `where` under key `local`
 ;    raise an Exception if it's empty or undefined
+
 ; - `remember-stack [stackname :as local]`
 ;    save the entire stack to the `local`
 ;    raise an Exception if it's undefined
+
 ; - `place [stackname args kwd]`
 ;    push the local `kwd` on the named stack
 ;    raise an Exception if it's undefined
+
 ; - `replace-stack [stackname new-stack]`
 ;    replace the indicated stack with a new list
 ;    raise an exception if it's undefined
@@ -67,7 +78,8 @@
 (defn store-local
   "stores a local kv pair"
   [[interpreter locals] k v]
-  (into [] (list interpreter (assoc locals k v))))
+  (vector interpreter (assoc locals k v)))
+

 (fact "store-local saves thing to the locals hashmap"
@@ -138,14 +150,63 @@

 (fact "`place` will push the saved local value to the indicated stack in the interpreter"
   (let [integer-added (-> [six-ints {}]
+                          (consume :integer :as :int1)
+                          (consume :integer :as :int2)
+                          (place :boolean :int1))]
+    (get-stack-from-dslblob integer-added :boolean) => '(6)))
+
+
+(defn remember-calc
+  [[interpreter locals] args function & {:keys [as]}]
+  (if (nil? as)
+    (vector interpreter locals)
+    (let [result (apply function (map locals args))]
+      (vector interpreter (assoc locals as result)))))
+
+
+(fact "remember-calc stores the result of a calculation in a named local"
+  (let [integer-added (-> [six-ints {}]
+                          (consume :integer :as :int1)
+                          (consume :integer :as :int2)
+                          (remember-calc [:int1 :int2] #(+ %1 %2) :as :sum))]
+  (second integer-added) => {:int1 6, :int2 5, :sum 11}))
+
+
+(fact "remember-calc has no effect if :as is not specified"
+  (let [integer-added (-> [six-ints {}]
                         (consume :integer :as :int1)
                         (consume :integer :as :int2)
-                        (place :boolean :int1))]
-    (get-stack-from-dslblob integer-added :boolean) => '(6)))
-
-
-
-;; counting arguments
+                        (remember-calc [:int1 :int2] #(+ %1 %2)))]
+  (second integer-added) => {:int1 6, :int2 5}))
+
+
+;; check for nil :as key
+
+
+(defn remember-top
+  [[interpreter locals] stackname & {:keys [as]}]
+  (if (nil? as)
+    (vector interpreter locals)
+    (let [result (first (get-stack interpreter stackname))]
+      (into [] (list interpreter (assoc locals as result))))))
+
+
+(fact "remember-top stores the top item of a named stack"
+  (let [integer-added (-> [six-ints {}]
+                          (consume :integer :as :int1)
+                          (consume :integer :as :int2)
+                          (remember-top :integer :as :third))]
+  (second integer-added) => {:int1 6, :int2 5, :third 4}))
+
+
+(fact "remember-top has no effect if :as is not specified"
+  (let [integer-added (-> [six-ints {}]
+                        (consume :integer :as :int1)
+                        (consume :integer :as :int2)
+                        (remember-top :integer))]
+  (second integer-added) => {:int1 6, :int2 5}))
+
+

 ; (def-pushinstruction
 ;   integer-add


quick fix--edit mock config was broken

quick fix--edit mock config was broken

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_config_editor.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_config_editor.cljs
@@ -77,7 +77,8 @@
                          :on-done (fn [{:keys [success? xhr]}]
                                     (if success?
                                       (complete state props new-conf)
-                                      (js/alert (str "Exception:\n" (.-statusText xhr)))))}))))
+                                      (js/alert (str "Exception:\n" (.-statusText xhr)))))
+                         :canned-response {:status 200 :delay-ms (rand-int 2000)}}))))
        :canned-response {:status 200 :delay-ms (rand-int 2000)}})))

 (defn- render-top-bar [config]


Added edn files, date examples, better keyword examples

--- test/exemplar.clj
+++ test/exemplar.clj
@@ -8,8 +8,9 @@

 (import [java.io File FileOutputStream ByteArrayInputStream ByteArrayOutputStream OutputStreamWriter])

-(defn range-centered-on [n]
-  (vec (range (- n 5) (+ n 6))))
+(defn range-centered-on
+  ([n] (range-centered-on n 5))
+  ([n m] (vec (range (- n m) (+ n m 1)))))

 (defn vmap [f s]
   (vec (map f s)))
@@ -27,21 +28,30 @@

 (defn write-description [file-name description vals]
   (println "##" description)
-  (println "* Files:" (str file-name ".json") (str file-name ".mp"))
+  (println "* Files:" (str file-name ".edn") (str file-name ".json") (str file-name ".mp"))
   (println "* Value (EDN)")
   (println)
   (doseq [item vals] (println "    " (pr-str item)))
   (println))

-(defn write-exemplar [file-name description & vals]
-  (write-description file-name description vals)
+(defn write-transit [file-name & vals]
   (doseq [format [{:type :json, :suffix ".json"} {:type :msgpack :suffix ".mp"}]]
     (with-open [os (io/output-stream (str file-name (:suffix format)))]
       (let [jsw (w/writer os (:type format))]
         (doseq [item vals] (w/write jsw item))))))

+(defn write-exemplar [file-name description & vals]
+  (write-description file-name description vals)
+  (with-open [w (io/writer (str file-name ".edn"))]
+    (binding [*out* w] (apply pr vals)))
+  (apply write-transit file-name vals))
+
 (binding [*out* (io/writer "README.md")]
   (println "# Example transit files.\n\n")
+  (println "There are three files for each value: An EDN file and two transit files,")
+  (println "one encoded in JSON and one in MessagePack\n\n")
+  (println "Note: The example transit files in this directory are *generated*.")
+  (println "See https://github.com/cognitect/transit-clj/blob/master/test/exemplar.clj\n\n")

   (write-exemplar "nil" "The nil/null/ain't there value" nil)
   (write-exemplar "true" "True" true)
@@ -51,6 +61,7 @@
   (write-exemplar "one_string" "A single string" "hello")
   (write-exemplar "one_keyword" "A single keyword" :hello)
   (write-exemplar "one_symbol" "A single symbol" 'hello)
+  (write-exemplar "one_date" "A single date" (java.util.Date. 946728000000))

   (def vector-simple  [1 2 3])
   (def vector-mixed  [0 1 2.0 true false "five" :six 'seven "~eight" nil])
@@ -73,18 +84,27 @@

   (write-exemplar "small_ints" "A vector of eleven small integers" (range-centered-on 0))

-  (write-exemplar "ints", "vector of ints" (range 128))
-
+  (write-exemplar "ints", "vector of ints" (vec (range 128)))
+
+  (def powers-two
+       [1 2 4 8 16 32 64 128 256 512 1024 2048 4096 8192 16384
+        32768 65536 131072 262144 524288 1048576 2097152 4194304
+        8388608 16777216 33554432 67108864 134217728 268435456
+        536870912 1073741824 2147483648 4294967296 8589934592
+        17179869184 34359738368 68719476736 137438953472
+        274877906944 549755813888 1099511627776 2199023255552
+        4398046511104 8796093022208 17592186044416 35184372088832
+        70368744177664 140737488355328 281474976710656
+        562949953421312 1125899906842624 2251799813685248
+        4503599627370496 9007199254740992 18014398509481984
+        36028797018963968 72057594037927936 144115188075855872
+        288230376151711744 576460752303423488 1152921504606846976
+        2305843009213693952 4611686018427387904 9223372036854775808
+        18446744073709551616 36893488147419103232])
+
   (def interesting-ints
-    (vec
-      (concat
-       (range-centered-on 32768)
-       (range-centered-on 65536)
-       (range-centered-on 2147483648)
-       (range-centered-on 4294967296)
-       (range-centered-on 2305843009213693952)
-       (range-centered-on 4611686018427387904))))
-
+    (vec (apply concat (map #(range-centered-on % 2) powers-two))))
+
   (write-exemplar
     "ints_interesting"
     "A vector of possibly interesting positive integers"
@@ -105,7 +125,14 @@
     "A vector of interesting doubles"
     [-3.14159 3.14159 4E11 2.998E8 6.626E-34])

-
+
+  (def dates (vmap #(java.util.Date. %) [-6106017600000 0 946728000000 1396909037000]))
+
+  (write-exemplar
+    "dates_interesting"
+    "A vector of interesting dates: 1776-07-04, 1970-01-01, 2000-01-01, 2014-04-07"
+    dates)
+
   (def symbols ['a 'ab 'abc 'abcd 'abcde 'a1 'b2 'c3 'a_b])

   (write-exemplar "symbols" "A vector of symbols" symbols)
@@ -184,5 +211,9 @@
   (write-exemplar
     "vector_94_keywords_repeated_twice"
     "Vector of 94 keywords, repeated twice"
-    (vector-of-keywords 94 188)))
-
+    (vector-of-keywords 94 188))
+
+  (write-exemplar
+    "vector_95_keywords_repeated_twice"
+    "Vector of 95 keywords, repeated twice"
+    (vector-of-keywords 95 190)))


RS | 8 | Add registering and deleting stonecutter account and refactor

--- test/stonecutter_journey_test/test.clj
+++ test/stonecutter_journey_test/test.clj
@@ -13,13 +13,23 @@
       (prn (str "Actual: " (wd/title)))
       (throw e))))

+(defn wait-for-selector [selector]
+  (try
+    (wd/wait-until #(not (empty? (wd/css-finder selector))) 5000)
+    (catch Exception e
+      (prn (str ">>>>>>>>>> Selector could not be found: " selector))
+      (prn "==========  PAGE SOURCE ==========")
+      (prn (wd/page-source))
+      (prn "==========  END PAGE SOURCE ==========")
+      (throw e))))
+
 (def screenshot-directory "test/stonecutter_journey_test/screenshots")
 (def screenshot-number (atom 0))
-(defn screenshot [filename]
-  (prn (str "Screenshot: " filename))
-  (wd/take-screenshot :file (str screenshot-directory "/"
-                                 (format "%02d" (swap! screenshot-number + 1))
-                                 "_" filename ".png")))
+(defn screenshot [page]
+  (let [filename (str (format "%02d" (swap! screenshot-number + 1)) "_" page ".png")
+        filepath (io/file screenshot-directory filename)]
+    (prn (str "Screenshot: " filepath))
+    (wd/take-screenshot :file filepath)))

 (defn clear-screenshots []
   (doall (->> (io/file screenshot-directory)
@@ -27,44 +37,138 @@
               (filter #(re-matches #".*\.png$" (.getName %)))
               (map io/delete-file))))

+(def stonecutter-url "stonecutter.herokuapp.com")
+(def stonecutter-sign-in-page-body ".func--sign-in-page")
+(def stonecutter-sign-in-page-register-link ".func--register__link")
+(def stonecutter-sign-in-email-input ".func--email__input")
+(def stonecutter-sign-in-password-input ".func--password__input")
+(def stonecutter-sign-in-button ".func--sign-in__button")
+(def stonecutter-register-page-body ".func--register-page")
+(def stonecutter-register-email-input ".func--email__input")
+(def stonecutter-register-password-input ".func--password__input")
+(def stonecutter-register-confirm-password-input ".func--confirm-password__input")
+(def stonecutter-register-create-profile-button ".func--create-profile__button")
+(def stonecutter-profile-created-page-body ".func--profile-created-page")
+(def stonecutter-authorise-page-body ".func--authorise-page")
+(def stonecutter-authorise-share-profile-button ".func--authorise-share-profile__button")
+(def stonecutter-delete-account-page-body ".func--delete-account-page")
+(def stonecutter-delete-account-button ".func--delete-account__button")
+(def stonecutter-profile-deleted-page-body ".func--profile-deleted-page")
+
+(def client-home-page-body ".func--home-page")
+(def client-poll-page-body ".func--poll-page")
+(def client-logout-link ".func--logout__link")
+
+(defn input-sign-in-credentials-and-submit []
+  (wd/input-text stonecutter-sign-in-email-input "stonecutter-journey-test@tw.com")
+  (wd/input-text stonecutter-sign-in-password-input "password")
+  (wd/click stonecutter-sign-in-button))
+
+(defn attempt-sign-in []
+  (wd/to (str "https://" stonecutter-url "/sign-in"))
+  (wait-for-selector stonecutter-sign-in-page-body)
+  (input-sign-in-credentials-and-submit))
+
+(defn go-to-delete-account []
+  (wd/to (str "https://" stonecutter-url "/delete-account"))
+  (wait-for-selector stonecutter-delete-account-page-body))
+
+(defn confirm-delete-account []
+  (wd/click stonecutter-delete-account-button)
+  (wait-for-selector stonecutter-profile-deleted-page-body))
+
+(defn delete-stale-account []
+  (attempt-sign-in)
+  (wait-for-selector "body")
+  (when-not (re-find #"/sign-in" (wd/current-url))
+    (go-to-delete-account)
+    (confirm-delete-account)))
+
+(defn logout-of-client-and-go-through-auth-flow-again-without-having-to-sign-in-again []
+  (wd/click client-logout-link)
+  (wait-for-selector client-home-page-body)
+  (wd/click "button")
+  (wait-for-selector stonecutter-authorise-page-body)
+  (wd/click stonecutter-authorise-share-profile-button)
+  (wait-for-selector client-poll-page-body))
+
 (against-background
   [(before :contents (do (wd/set-driver! {:browser :firefox})
-                         (clear-screenshots)))
+                         (clear-screenshots)
+                         (delete-stale-account)))
    (after  :contents (do (wd/quit)))]

-  (fact "can go to client page"
-        (wd/to "https://stonecutter-client.herokuapp.com")
-        (wait-for-title "Home")
-        (screenshot "client_home_page")
-        (wd/current-url) => (contains "stonecutter-client.herokuapp.com/login"))
+  (try
+    (fact "can register a stonecutter account"
+          ;; Go to home page and get redirected to sign-in
+          (wd/to (str "https://" stonecutter-url))
+          (wait-for-selector stonecutter-sign-in-page-body)
+          (wd/current-url) => (contains "stonecutter.herokuapp.com/sign-in")

-  (fact "'sign in to vote' redirects to stonecutter"
-        (wd/click "button")
-        (wait-for-title "Sign in")
-        (screenshot "stonecutter_sign_in")
-        (wd/current-url) => (contains "stonecutter.herokuapp.com/sign-in"))
+          ;; Click through to register page
+          (wd/click stonecutter-sign-in-page-register-link)
+          (wait-for-selector stonecutter-register-page-body)
+          (screenshot "stonecutter_register_page")
+          (wd/current-url) => (contains "stonecutter.herokuapp.com/register")

-  (fact "can sign in with existing user credentials and redirects to authorisation form page"
-        (wd/input-text ".func--email__input" "stonecutter-journey-test@tw.com")
-        (wd/input-text ".func--password__input" "password")
-        (wd/click ".func--sign-in__button")
-        (wait-for-title "Authorise")
-        (screenshot "stonecutter_authorisation_form")
-        (wd/current-url) => (contains "stonecutter.herokuapp.com/authorisation"))
+          ;; Enter user details to register
+          (wd/input-text stonecutter-register-email-input "stonecutter-journey-test@tw.com")
+          (wd/input-text stonecutter-register-password-input "password")
+          (wd/input-text stonecutter-register-confirm-password-input "password")
+          (wd/click stonecutter-register-create-profile-button)

-  (fact "authorising app redirects to voting page"
-        (wd/click ".func--authorise-share-profile__button")
-        (wait-for-title "Poll: Soho requires safer cycle lanes?")
-        (screenshot "client_voting_page")
-        (wd/current-url) => (contains "stonecutter-client.herokuapp.com/voting")
-        (wd/page-source) => (contains "stonecutter-journey-test@tw.com"))
+          ;; View profile created page
+          (wait-for-selector stonecutter-profile-created-page-body)
+          (screenshot "stonecutter_profile_created_page")
+          (wd/current-url) => (contains "stonecutter.herokuapp.com/profile-created"))

-  (fact "logging out in client app and logging in again will skip sign in page"
-        (wd/click ".func--logout__link")
-        (wait-for-title "Home")
-        (wd/click "button")
-        (wait-for-title "Authorise")
-        (wd/click ".func--authorise-share-profile__button")
-        (wait-for-title "Poll: Soho requires safer cycle lanes?")
-        (wd/current-url) => (contains "stonecutter-client.herokuapp.com/voting")
-        (wd/page-source) => (contains "stonecutter-journey-test@tw.com")))
+    (fact "can sign out of stonecutter"
+          (wd/to (str "https://" stonecutter-url "/sign-out"))
+          (wait-for-selector stonecutter-sign-in-page-body)
+          (wd/current-url) => (contains "stonecutter.herokuapp.com/sign-in"))
+
+    (fact "can go to client page"
+          (wd/to "https://stonecutter-client.herokuapp.com")
+          (wait-for-selector client-home-page-body)
+          (screenshot "client_home_page")
+          (wd/current-url) => (contains "stonecutter-client.herokuapp.com/login"))
+
+    (fact "'sign in to vote' redirects to stonecutter"
+          (wd/click "button")
+          (wait-for-selector stonecutter-sign-in-page-body)
+          (screenshot "stonecutter_sign_in")
+          (wd/current-url) => (contains "stonecutter.herokuapp.com/sign-in"))
+
+    (fact "can sign in with existing user credentials and redirects to authorisation form page"
+          (input-sign-in-credentials-and-submit)
+          (wait-for-selector stonecutter-authorise-page-body)
+          (screenshot "stonecutter_authorisation_form")
+          (wd/current-url) => (contains "stonecutter.herokuapp.com/authorisation"))
+
+    (fact "authorising app redirects to voting page"
+          (wd/click stonecutter-authorise-share-profile-button)
+          (wait-for-selector client-poll-page-body)
+          (screenshot "client_voting_page")
+          (wd/current-url) => (contains "stonecutter-client.herokuapp.com/voting")
+          (wd/page-source) => (contains "stonecutter-journey-test@tw.com"))
+
+    (fact "logging out in client app and logging in again will skip sign in page (repeats twice as there was a bug)"
+          (logout-of-client-and-go-through-auth-flow-again-without-having-to-sign-in-again)
+          (wd/current-url) => (contains "stonecutter-client.herokuapp.com/voting")
+          (wd/page-source) => (contains "stonecutter-journey-test@tw.com")
+
+          (logout-of-client-and-go-through-auth-flow-again-without-having-to-sign-in-again)
+          (wd/current-url) => (contains "stonecutter-client.herokuapp.com/voting")
+          (wd/page-source) => (contains "stonecutter-journey-test@tw.com"))
+
+    (fact "can delete account from stonecutter"
+          (go-to-delete-account)
+          (screenshot "stonecutter_delete_account")
+          (wd/current-url) => (contains "stonecutter.herokuapp.com/delete-account")
+
+          (confirm-delete-account)
+          (screenshot "stonecutter_profile-deleted")
+          (wd/current-url) => (contains "stonecutter.herokuapp.com/profile-deleted"))
+
+    (catch Exception e
+      (screenshot "ERROR"))))


Added fn properties to fdef

Added fn properties to fdef

Adding properties to the transformation, showed up a mistake.

Perhaps writing everything twice is worth while!

--- src/kixi/datastore/transport_specs.clj
+++ src/kixi/datastore/transport_specs.clj
@@ -16,7 +16,7 @@
   (s/keys :req [::ms/id ::ms/size-bytes ::ms/provenance]))

 (def file-type->default-metadata
-  {"csv" {::ms/headers true}})
+  {"csv" {::ms/header true}})

 (def default-primary-metadata
   {::ms/type "csv"})
@@ -24,6 +24,25 @@
 (s/fdef filemetadata-transport->internal
         :args (s/cat :meta ::filemetadata-transport
                      :details ::file-details)
+        :fn #(let [{:keys [meta details]} (get % :args)
+                   file-metadata (get % :ret)]
+               (and (= (::ms/id details)
+                       (::ms/id file-metadata))
+                    (= (::ms/size-bytes details)
+                       (::ms/size-bytes file-metadata))
+                    (= (::ms/provenance details)
+                       (::ms/provenance file-metadata))
+                    (= (:schema-id meta)
+                       (::ss/id file-metadata))
+                    (= (:name meta)
+                       (::ms/name file-metadata))
+                    (case (or (:type meta)
+                              (::ms/type file-metadata))
+                      "csv" (if-not (nil? (:header meta))
+                              (= (:header meta)
+                                 (::ms/header file-metadata))
+                              (true? (::ms/header file-metadata)))
+                      true)))
         :ret ::ms/file-metadata)

 (def key-mapping


Upgrade ring to 1.7.1

Upgrade ring to 1.7.1

--- src/leiningen/new/re_frame/project.clj
+++ src/leiningen/new/re_frame/project.clj
@@ -9,7 +9,7 @@
                  [ns-tracker "0.4.0"]{{/garden?}}{{#handler?}}
                  [compojure "1.6.1"]
                  [yogthos/config "0.8"]
-                 [ring "1.4.0"]{{/handler?}}{{#re-pressed?}}
+                 [ring "1.7.1"]{{/handler?}}{{#re-pressed?}}
                  [re-pressed "0.3.0"]{{/re-pressed?}}{{#breaking-point?}}
                  [breaking-point "0.1.2"]{{/breaking-point?}}]


Loading conexp.io when using conexp

Loading conexp.io when using conexp

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

--- conexp.clj
+++ conexp.clj
@@ -14,4 +14,5 @@

 (immigrate 'conexp.base
 	   'conexp.fca
+	   'conexp.io
 	   'conexp.gui)


use latest onyx

use latest onyx

--- src/leiningen/new/onyx_app.clj
+++ src/leiningen/new/onyx_app.clj
@@ -37,7 +37,7 @@
         data {:name name
               ;; The formatting here matters
               :onyx-version "0.9"
-              :onyx-version-post ".7-SNAPSHOT"
+              :onyx-version-post ".9"
               :lib-onyx-minor "0.1"
               :app-name name
               :app-name-underscore (clojure.string/replace name #"-" "_")


acqEngine: Remove rogue references to the gui's position list

In particular, when null is passes as the position list argument to
run(), the gui's position list should never be consulted.

Also removed functions that modify the position list but are never
called.

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

--- acqEngine/src/org/micromanager/mm.clj
+++ acqEngine/src/org/micromanager/mm.clj
@@ -258,13 +258,6 @@
    property are grouped together in a vector: [[dev prop] value]."
   [dev prop]
   [[dev prop] (get-property-value dev prop)])
-
-(defn get-positions
-  "Get the position list as a vector of MultiStagePositions."
-  ([position-list]
-    (vec (.getPositions (or position-list (.getPositionList gui)))))
-  ([]
-    (get-positions nil)))

 (defn get-allowed-property-values
   "Returns a sequence of the allowed property values
@@ -377,30 +370,11 @@
    index number."
   ([position-list idx]
     (when idx
-      (let [position-list (or position-list (.getPositionList gui))]
+      (when position-list
         (when (pos? (.getNumberOfPositions position-list))
           (.getPosition position-list idx)))))
   ([idx]
     (get-msp nil idx)))
-
-
-(defn add-msp
-  "Add a MultiStagePosition object to the position list."
-  ([position-list label x y z]
-    (.addPosition position-list
-                  (doto
-                    (MultiStagePosition.
-                      (core getXYStageDevice) x y
-                      (core getFocusDevice) z)
-                    (.setLabel label))))
-  ([label x y z]
-    (add-msp (.getPositionList gui) label x y z)))
-
-(defn remove-msp
-  ([position-list idx]
-    (.removePosition position-list idx))
-  ([idx]
-    (remove-msp (.getPositionList gui) idx)))

 (defn get-msp-z-position
   "Get the z position for a given z-stage from the MultiStagePosition
@@ -422,12 +396,6 @@
   ([idx z-stage z]
     (set-msp-z-position nil idx z-stage z)))

-(defn positions-map [position-list]
-  (let [position (map MultiStagePosition-to-map (get-positions))]
-    (zipmap
-      (map :label position)
-      (map :axes position))))
-
 (defn swig-vector-contents
   "Returns a string containing all values in a swig vector
    with spaces in between."


Refactoring a loop away.

Refactoring a loop away.

--- ClojureScript/hello.cljs
+++ ClojureScript/hello.cljs
@@ -88,18 +88,15 @@
             force))

 (defn calculate-spring-forces [nodes springs]
-    (loop [forces {} springs springs]
-        (if (empty? springs) forces
-            (let [
-                [s & r] springs
-                node-a-id (s :node-a)
-                node-b-id (s :node-b)
-                force (calculate-force (:pos (nodes node-a-id)) (:pos (nodes node-b-id)) (:rest-length s) (:strength s))]
-                (recur
-                    (assoc forces
-                        node-a-id (vec+ (get forces node-a-id [0 0]) force)
-                        node-b-id (vec- (get forces node-b-id [0 0]) force))
-                    r)))))
+    (apply merge-with vec+
+        (map
+            (fn [{:keys [node-a node-b rest-length strength]}] (let [
+                force (calculate-force (:pos (nodes node-a)) (:pos (nodes node-b)) rest-length strength)]
+                {
+                    node-a force
+                    node-b (vec- force)
+                }))
+            springs)))

 (defn calculate-hinge-force [a b c rest-angle strength]
     (let [
@@ -113,18 +110,16 @@
             result))

 (defn calculate-hinge-forces [nodes hinges]
-    (loop [forces {} hinges hinges]
-        (if (empty? hinges) forces
-            (let [
-                [h & r] hinges
-                {:keys [node-a node-b node-c rest-angle strength]} h
+    (apply merge-with vec+
+        (map
+            (fn [{:keys [node-a node-b node-c rest-angle strength]}] (let [
                 [force-a force-c] (calculate-hinge-force (:pos (nodes node-a)) (:pos (nodes node-b)) (:pos (nodes node-c)) rest-angle strength)]
-                    (recur
-                        (assoc forces
-                            node-a (vec+ (get forces node-a [0 0]) force-a)
-                            node-b (vec+ (get forces node-b [0 0]) (vec* (vec+ force-a force-c) -1.0))
-                            node-c (vec+ (get forces node-c [0 0]) force-c))
-                        r)))))
+                {
+                    node-a force-a
+                    node-b (vec- [0 0] force-a force-c)
+                    node-c force-c
+                }))
+            hinges)))

 (defn calculate-gravity-forces [nodes]
     (zipmap (keys nodes) (repeat [0 (- gravity-strength)])))


Work in progress - refactoring.

Work in progress - refactoring.

--- ClojureScript/hello.cljs
+++ ClojureScript/hello.cljs
@@ -9,9 +9,8 @@

 (def pos (atom 0))

-(defn ^:export foobar []
-    (let [canvas (goog.dom/getElement "my-canvas")
-        ctx (.getContext canvas "2d")
+(defn foobar [canvas]
+    (let [ctx (.getContext canvas "2d")
         x (swap! pos inc)]
         (do
             (. ctx (save))
@@ -22,20 +21,15 @@
             )))

 (defn ^:export main []
-    (let [body document.body ;(goog.dom/getElement "my-body")
-        f (partial goog.dom/appendChild body)] (do
-        (f
-            (goog.dom/createDom "h1" {} "Hello!"))
-        (f
-            (goog.dom/createDom "canvas" (.strobj {
-                "id" "my-canvas"
-                "width" 600
-                "height" 600
-                "style" "border: 1px solid #000000"
-                }) ""))
-        (let [button (goog.dom/createDom "button" {} "Click!")] (do
-            (goog.events/listen button goog.events.EventType/CLICK foobar)
-            (f button)
-            button))
-)))
+    (let [
+        canvas (goog.dom/createDom "canvas" (.strobj {
+            "width" 600
+            "height" 600
+            "style" "border: 1px solid #000000"
+            }) "")
+        button (goog.dom/createDom "button" {} "Click!")]
+        (do
+            (goog.events/listen button goog.events.EventType/CLICK (partial foobar canvas))
+            (dorun (map (partial goog.dom/appendChild document.body)
+                [(goog.dom/createDom "h1" {} "Hello!") canvas button])))))


give killing a bit of time, even if it was already killed from the start (#85)

--- test/clj/lambdacd/steps/shell_test.clj
+++ test/clj/lambdacd/steps/shell_test.clj
@@ -85,6 +85,7 @@
               :out    ""
               :status :killed}
              (bash (some-ctx-with :is-killed is-killed) "/"
+                   "sleep 5"
                    "echo foo")))))
   (testing "that we inform the user about trying to kill the process"
     (let [is-killed (atom true)


correct test expectations

correct test expectations

--- test/clj_money/models/reports_test.clj
+++ test/clj_money/models/reports_test.clj
@@ -542,15 +542,13 @@
                            :actual-per-period 0M}
                           {:caption "Net"
                            :style :summary
-                           :budget 178M
+                           :budget 172M
                            :actual 875M
-                           :difference 697M
-                           :percent-difference 3.91573033M
+                           :difference 703M
+                           :percent-difference 4.087209302M
                            :actual-per-period 437.50M}]}]
-
     (when (not= expected actual)
       (pprint {:diff (diff expected actual)}))
-
     (is (= expected actual) "The function products the correct data")))

 ; TODO


fix interceptor tests

fix interceptor tests

--- test/cljc/reitit/interceptor_test.cljc
+++ test/cljc/reitit/interceptor_test.cljc
@@ -111,21 +111,21 @@
           (let [app (create [[i1 :value]])]
             (dotimes [_ 10]
               (is (= [:data :value :ok] (app ctx)))
-              (is (= 2 @calls)))))
+              (is (= 1 @calls)))))

         (testing "as interceptor"
           (reset! calls 0)
           (let [app (create [(i1 :value)])]
             (dotimes [_ 10]
               (is (= [:data :value :ok] (app ctx)))
-              (is (= 2 @calls)))))
+              (is (= 1 @calls)))))

         (testing "deeply compiled interceptor"
           (reset! calls 0)
           (let [app (create [[i3 :value]])]
             (dotimes [_ 10]
               (is (= [:data :value :ok] (app ctx)))
-              (is (= 4 @calls)))))
+              (is (= 3 @calls)))))

         (testing "too deeply compiled interceptor fails"
           (binding [interceptor/*max-compile-depth* 2]


Fixing formating

Fixing formating

--- test/little_monster_simulation/core_test.clj
+++ test/little_monster_simulation/core_test.clj
@@ -14,17 +14,17 @@
   (testing "a monster with no stats is dead"
     (let [monster (c/monster)]
       (is (not (c/alive? monster)))))
-
+
   (testing "a monster with life some life is alive"
     (let [monster (c/monster)
           monster' (assoc monster :life [100 identity-behaviour])]
       (is (c/alive? monster'))))
-
+
   (testing "can get value of a stat"
     (let [monster (c/monster)
           monster' (assoc monster :life [100 identity-behaviour])]
       (is (= 100 (c/value-of monster' :life)))))
-
+
   (testing "life can change with time"
     (let [monster (c/monster)
           monster' (assoc monster :life [100 halvit-behaviour])


Testing that if we follow the qrcode link we get to the correct transaction form

--- test/freecoin/test/handlers/qrcode.clj
+++ test/freecoin/test/handlers/qrcode.clj
@@ -28,7 +28,9 @@
              [mongo :as fm]
              [wallet :as w]]
             [freecoin.blockchain :as fb]
-            [freecoin.handlers.qrcode :as handler]
+            [freecoin.handlers
+             [qrcode :as handler]
+             [transaction-form :as transaction-handler]]
             [net.cgrand.enlive-html :as html]
             [freecoin.test.test-helper :as th]
             [taoensso.timbre :as log])
@@ -65,6 +67,16 @@
                (fact "Retrieves the URL from the QRCODE input stream"
                      (let [url (qrcode->text (:body response))]
                        (.contains url user-email) => truthy
-                       (.contains url "send/to") => truthy))
+                       (.contains url "send/to") => truthy

-               (fact "Performs a send to transaction based on the qrcode"))))
+                       (fact "Performs a send to transaction based on the qrcode"
+                             (let [transaction-handler (transaction-handler/get-transaction-to wallet-store)
+                                   uri (java.net.URI. url)
+                                   transaction-response (-> (rmr/request :get "/send/to/")
+                                                            (assoc-in [:params] {:email user-email})
+                                                            (assoc-in [:session :signed-in-email] user-email)
+                                                            (transaction-handler))]
+                               (:status transaction-response) => 200
+                               (-> (:body transaction-response) (html/html-snippet [:body])) => (th/has-form-method? "POST")
+                               (-> (:body transaction-response) (html/html-snippet [:body])) => (th/has-form-action? (freecoin.routes/absolute-path :post-transaction-form))
+                               (-> (:body transaction-response) (html/html-snippet [:body])) => (th/text-is? [:title] (str "Make a transaction -> " user-email)))))))))


fix the last remaining unit test failure.

--- test/metabase/models/revision_test.clj
+++ test/metabase/models/revision_test.clj
@@ -38,9 +38,8 @@
     (assoc obj :serialized true))
   (revert-to-revision [_ _ serialized-instance]
     (reset! reverted-to (dissoc serialized-instance :serialized)))
-  (describe-diff [_ _ o1 o2]
-    {:before o1
-     :after o2}))
+  (describe-diff [_ o1 o2]
+    (str "BEFORE=" o1 ",AFTER=" o2)))

 (defn- push-fake-revision [card-id & {:as object}]
   (push-revision :entity FakedCard, :id card-id, :user-id (user->id :rasta), :object object))
@@ -100,8 +99,7 @@
 ;; Check that revisions properly defer to describe-diff
 (expect [{:is_reversion false,
           :user         {:id (user->id :rasta), :common_name "Rasta Toucan", :first_name "Rasta", :last_name "Toucan"},
-          :description  {:before {:name "Tips Created by Day", :serialized true}
-                         :after  {:name "Spots Created by Day", :serialized true}}}
+          :description  "BEFORE={:name \"Tips Created by Day\", :serialized true},AFTER={:name \"Spots Created by Day\", :serialized true}"}
          {:is_reversion false,
           :user         {:id (user->id :rasta), :common_name "Rasta Toucan", :first_name "Rasta", :last_name "Toucan"},
           :description  "First revision."}]


core: take-while

core: take-while

--- data/core.clj
+++ data/core.clj
@@ -1401,3 +1401,13 @@
    (when (pos? n)
      (when-let [s (seq coll)]
        (cons (first s) (take (dec n) (rest s)))))))
+
+(defn take-while
+  "Returns a lazy sequence of successive items from coll while
+  (pred item) returns true. pred must be free of side-effects."
+  {:added "1.0"}
+  [pred coll]
+  (lazy-seq
+   (when-let [s (seq coll)]
+     (when (pred (first s))
+       (cons (first s) (take-while pred (rest s)))))))


[#85] Coerce flow question types to proper dash types

--- backend/src/org/akvo/dash/import/flow.clj
+++ backend/src/org/akvo/dash/import/flow.clj
@@ -3,9 +3,7 @@
             [clojure.java.jdbc :as jdbc]
             [akvo.commons.psql-util :as pg]
             [hugsql.core :as hugsql]
-            [cheshire.core :as json]
-            [org.akvo.dash.import.common :refer (make-dataset-data-table)])
-  (:import [org.postgresql.util PGobject]))
+            [org.akvo.dash.import.common :refer (make-dataset-data-table)]))

 (hugsql/def-db-fns "org/akvo/dash/import/flow.sql")

@@ -27,6 +25,17 @@
 (defn questions [form]
   (mapcat :questions (:question-groups form)))

+(defn question-type->dash-type [question-type]
+  ;; A lot of this is TBD.
+  (condp = question-type
+    "FREE_TEXT" "string"
+    "CASCADE" "string"
+    "OPTION" "string"
+    "GEO" "string"
+    "DATE" "date"
+    "NUMBER" "number"
+    "object"))
+
 (defn dataset-columns [form]
   (let [common [{:title "Identifier" :type "string"}
                 {:title "Latitude" :type "number"}
@@ -34,7 +43,7 @@
                 {:title "Submitter" :type "string"}
                 {:title "Submitted at" :type "date"}]
         qs (map (fn [q]
-                  {:type "string"
+                  {:type (question-type->dash-type (:type q))
                    :title (:display_text q)})
                 (questions form))]
     (map-indexed (fn [idx col]


Method and operation now created. Missing refs and updates

--- src/ardoq/swagger/update_swagger2.clj
+++ src/ardoq/swagger/update_swagger2.clj
@@ -12,12 +12,10 @@
                :schema schema))
       (common/save-models client)))

-;;This function might not be possible as a single function. If so split into many and use partial
 (defn update-component [client component template data]
   (-> (assoc data :description (template component))
       (api/map->Component)
-      (api/update client))
-  "random return")
+      (api/update client)))

 (defn update-components [client components definitions workspace {_id :_id :as model} model-type template]
   (doseq [{def-name :name :as component} components]
@@ -31,21 +29,41 @@
           {}
           definitions))

-(defn update-methods [client]
-  "random return"
-  )

-(defn add-new-operation [client method workspace]
-  (println (str "adding " method))
-  "random return"
-  )
+(defn update-references [client operations]
+  "random return")
+
+(defn create-operation [client parent {_id :_id :as model} wid path methods tags]
+  (map (fn [method]
+         (-> (api/map->Component {:name (str path "/" (:name method))
+                                  :description (:description method)
+                                  :model _id
+                                  :parent parent
+                                  :method method
+                                  :typeId (api/type-id-by-name model "Operation")})
+             (api/create client))
+         methods)))
+
+(defn create-method [client [path {description :description :as methods}] {wid :_id :as workspace} params {_id :_id :as model} tags]
+  (let [parent (-> (api/->Component path description (str wid) _id (api/type-id-by-name model "Resource") nil)
+                   (api/create client))]
+    (create-operation client parent model wid path methods tags)
+    ;;Should create the sub operations straight away. We know they don't exist anyway
+    ;;And all references we need seeing how they all come from within or parameters
+    ;;Those that don't get created seperately
+    parent))

 (defn update-operation [client method resource]
-  (clojure.pprint/pprint method)
   ;;The path/resource operation itself has no true values, we just keep it as is
   ;;But the internal are different in regards to methods it has.
   ;;However these are connected by parent in the resource
   ;;Only question remaining is if the consume or produces need changing
+
+  ;;Things that might change - responses, parameters, produces, tags, references
+
+
+  ;(common/update-comp client resource spec)
+
   "Random return")

 (defn update-operations [client resources {paths :paths :as spec} workspace model defs params securs tags]
@@ -53,10 +71,14 @@
   (doseq [{path :name :as resource} resources]
     (when-not (first (filter #(= (name %) path) (keys paths)))
       (api/delete (api/map->Component resource) client)))
-  (doseq [[path :as method] paths]
-    (or (some->> (first (filter #(= (name path) (:name %)) resources))
-                 (update-operation client (first (rest method))))
-        (add-new-operation client method workspace))))
+  (-> (reduce (fn [acc [def-name data :as component]]
+                (assoc acc (keyword def-name)
+                       (or (some->> (first (filter #(= (name def-name) (:name %)) resources))
+                                    (update-operation client (first (rest component))))
+                           (first (vals (create-method client component workspace params model tags))))))
+              {}
+              paths)
+      (update-references client)))

 (defn update-workspace [workspace client spec]
   ;;Workspace exists, we will just update values in it.


Abstract construction of the load test invoker.

--- src/frmr/dstt.clj
+++ src/frmr/dstt.clj
@@ -73,20 +73,28 @@
      "Maximums" max-per-category
      "StandardDeviations" stddev-per-category}))

+(defn- select-function-for-http-method
+ [http-method]
+ (cond
+   (= "POST" http-method)
+   client/post
+
+   :else
+   client/get))
+
+(defn- build-request-invoker
+  "Builds a request invoker function given the name of the HTTP function you want to invoke, the url
+  you want to execute requests against, and a map of options you want to provide to the underlying
+  HTTP library."
+  [http-method url request-options]
+  (let [client-request-method (select-function-for-http-method http-method)]
+    (fn [] (client-request-method url request-options))))
+
 (defn- parse-header
   "Parse a header string from the command line into a map for the http library."
   [header]
   (let [[header-name header-value] (split header #": ")]
     {header-name header-value}))
-
-(defn- select-function-for-http-method
-  [http-method]
-  (cond
-    (= "POST" http-method)
-    client/post
-
-    :else
-    client/get))

 (defn- parse-body
   "Parse a body string from the command line into a map for the http library."
@@ -161,11 +169,10 @@
             milliseconds (* seconds 1000)
             pause-between-requests (/ milliseconds requests)

-            client-request-method (select-function-for-http-method http-method)
             request-options (merge {:headers http-headers}
                                    (some-> http-body parse-body)
                                    {:follow-redirects false})
-            request-invoker (fn [] (client-request-method url request-options))
+            request-invoker (build-request-invoker http-method url request-options)

             [parsed-handler custom-handler-name] (if-not (nil? handler)
                                                    [(eval (read (PushbackReader. (io/reader handler))))


Using return helper func in delete cmd.

Using return helper func in delete cmd.

--- src/cbfg/world-storage.cljs
+++ src/cbfg/world-storage.cljs
@@ -76,28 +76,26 @@
        (let [res (atom nil)]
          (swap! storage
                 #(let [old-sq (get-in % [:keys key])
+                       new-sq (:next-sq %)
                        cas-check (and old-cas (not (zero? old-cas)))
                        prev-change (when cas-check
                                      (get-in % [:changes old-sq]))]
                    (if (not old-sq)
-                     (do (reset! res {:opaque opaque :status :not-found
-                                      :key key})
-                         %)
+                     (return % res
+                             {:opaque opaque :status :not-found :key key})
                      (if (and cas-check (not= old-cas (:cas prev-change)))
-                       (do (reset! res {:opaque opaque :status :wrong-cas
-                                        :key key})
-                           %)
-                       (let [new-sq (:next-sq %)]
-                         (reset! res {:opaque opaque :status :wrong-cas
-                                      :key key :sq new-sq})
-                         (-> %
-                             (assoc :max-deleted-sq (max old-sq
-                                                         (:max-deleted-sq %)))
-                             (dissoc-in [:changes old-sq])
-                             (dissoc-in [:keys key])
-                             (assoc-in [:changes new-sq]
-                                       {:key key :sq new-sq :deleted true})
-                             (update-in [:next-sq] inc)))))))
+                       (return % res
+                               {:opaque opaque :status :wrong-cas :key key})
+                       (return (-> %
+                                   (assoc :max-deleted-sq (max old-sq
+                                                               (:max-deleted-sq %)))
+                                   (dissoc-in [:changes old-sq])
+                                   (dissoc-in [:keys key])
+                                   (assoc-in [:changes new-sq]
+                                             {:key key :sq new-sq :deleted true})
+                                   (update-in [:next-sq] inc))
+                               res {:opaque opaque :status :ok
+                                    :key key :sq new-sq})))))
          @res)))

 (defn storage-scan [actx storage opaque from to]


host is also given automaticly

host is also given automaticly

--- src/celestial/persistency/actions.clj
+++ src/celestial/persistency/actions.clj
@@ -22,7 +22,7 @@

 (defn add-provided [action]
   "appends action expected arguments drived from args strings"
-   (assoc action :provided (remove #{"target"} (args-of (join " " ((remoter action) :args))))))
+   (assoc action :provided (remove #{"target" "hostname"} (args-of (join " " ((remoter action) :args))))))

 (defn with-provided [f & [a1 a2 & r :as args]]
   (cond


Add loading indicator to the app-state

Add loading indicator to the app-state

--- src/cljs/db_quiz/model.cljs
+++ src/cljs/db_quiz/model.cljs
@@ -2,6 +2,7 @@
   (:refer-clojure :exclude [replace])
   (:require-macros [cljs.core.async.macros :refer [go go-loop]])
   (:require [db-quiz.config :refer [config]]
+            [db-quiz.state :refer [app-state]]
             [cljs-http.client :as http]
             [reagent.core :as reagent :refer [atom]]
             [cljs.core.async :refer [<! >! chan sliding-buffer]]
@@ -34,10 +35,6 @@
   }
   ORDER BY DESC(?order)
   LIMIT 10")
-
-; ----- Public vars -----
-
-(def loading? (atom false))

 ; ----- Public functions -----

@@ -143,9 +140,9 @@
 (defn wrap-load
   [input-channel output-channel]
   (go
-    (reset! loading? true)
+    (swap! app-state #(assoc % :loading? true))
     (>! output-channel (<! input-channel))
-    (reset! loading? false))
+    (swap! app-state #(assoc % :loading? false)))
   output-channel)

 (defn sparql-query
@@ -154,11 +151,11 @@
   (let [query-channel (http/get query-path {:channel (chan 1 (map :body))})
         sparql-results (sparql-results-channel)]
     (go
-      (reset! loading? true)
+      (swap! app-state #(assoc % :loading? true))
       (let [query (render-template (<! query-channel) :data data)]
         ;(.log js/console query)
         (>! sparql-results (<! (sparql-query-channel query))))
-      (reset! loading? false))
+      (swap! app-state #(assoc % :loading? false)))
     sparql-results))

 (defn sparql-autocomplete


use the cljs analyzer api instead of poking around env/*compiler*

--- src/main/om_css/output_css.clj
+++ src/main/om_css/output_css.clj
@@ -1,26 +1,23 @@
 (ns om-css.output-css
-  (:require [cljs.env :as env]
+  (:require [cljs.analyzer.api :as ana-api]
             [clojure.java.io :as io]
             [clojure.string :as string]))

 (defn setup-io! []
-     (let [opts (some-> env/*compiler*
-                  deref
-                  :options)
-           default-fname "out.css"
-           fname (or (:css-output-to opts)
-                   (str (:output-dir opts) default-fname)
-                   (string/join "/"
-                     (-> (:output-to opts)
-                       (string/split #"/")
-                       butlast
-                       vec
-                       (conj default-fname))))]
-       (add-watch om-css.core/css :watcher
-         (fn [k atom old-state new-state]
-           (with-open [out ^java.io.Writer (io/make-writer fname {})]
-             (binding [*out* out]
-               (println (string/join "\n" (vals new-state)))
-               (println)))))))
+  (let [{:keys [css-output-to output-dir output-to]} (ana-api/get-options)
+        default-fname "out.css"
+        fname (or css-output-to
+                (str output-dir default-fname)
+                (string/join "/"
+                  (-> output-to
+                    (string/split  #"/")
+                    pop
+                    (conj default-fname))))]
+    (add-watch om-css.core/css :watcher
+      (fn [k atom old-state new-state]
+        (with-open [out ^java.io.Writer (io/make-writer fname {})]
+          (binding [*out* out]
+            (println (string/join "\n" (vals new-state)))
+            (println)))))))

 (setup-io!)


Bump user-agent version number.

Bump user-agent version number.

--- src/clj/http/async/client/request.clj
+++ src/clj/http/async/client/request.clj
@@ -35,7 +35,7 @@
                     ByteArrayInputStream
                     ByteArrayOutputStream)))

-(def *user-agent* "http.async.client/0.2.1-dev")
+(def *user-agent* "http.async.client/0.2.2")

 (def *client*
      (AsyncHttpClient.


refactor referenced account handling

refactor referenced account handling

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -307,21 +307,26 @@
        (map before-save-item)
        (mapv #(update-item storage %))))

-(defn- dereferenced-accounts
-  "Given an existing transaction and an update of the
-  same transaction, returns the IDs of the accounts
-  that were referenced in the original but are not
-  referenced now"
-  [existing updated]
-  (apply difference (map #(->> (:items %)
-                               (map :account-id)
-                               (into #{}))
-                         [existing updated])))
-
 (defn reload
   "Returns an updated copy of the transaction"
   [storage-spec transaction]
   (find-by-id storage-spec (:id transaction)))
+
+(defn- base-items-for-dereferenced-accounts
+  "Given a transaction being updated, returns a list of base
+  items to be used to propagate updates for accounts there were
+  referenced in the transaction but no longer are"
+  [storage-spec transaction]
+  (let [existing-trans (reload storage-spec transaction)
+        dereferenced-account-ids (apply difference
+                                        (map #(->> (:items %)
+                                                   (map :account-id)
+                                                   (into #{}))
+                                             [existing-trans transaction]))]
+    (->> dereferenced-account-ids
+         ; fake out an item because that's what get-previous-item expects
+         (map #(hash-map :account-id % :id -1))
+         (map #(get-previous-item storage-spec % (:transaction-date transaction))))))

 (defn update
   "Updates the specified transaction"
@@ -330,16 +335,13 @@
         validated (validate Transaction transaction)]
     (if (validation/has-error? validated)
       validated
-      (let [existing-trans (reload storage transaction)
-            dereferenced-account-ids (dereferenced-accounts
-                                       existing-trans
-                                       validated)
-            dereferenced-base-items (->> dereferenced-account-ids
-                                         (map #(hash-map :account-id % :id -1)) ; fake out an item because that's what get-previous-item expects
-                                         (map #(get-previous-item storage-spec % (:transaction-date transaction))))
-            items-with-balances (calculate-balances-and-indexes storage
-                                                                (:transaction-date validated)
-                                                                (:items validated))]
+      (let [dereferenced-base-items (base-items-for-dereferenced-accounts
+                                      storage
+                                      validated)
+            items-with-balances (calculate-balances-and-indexes
+                                  storage
+                                  (:transaction-date validated)
+                                  (:items validated))]
         (process-item-updates storage items-with-balances)
         (update-affected-balances storage
                                   (concat items-with-balances


better font trigger anchor style

better font trigger anchor style

--- src/cljs/infinitelives/pixi/font.cljs
+++ src/cljs/infinitelives/pixi/font.cljs
@@ -153,12 +153,16 @@
          (dom/set-attr! :href url))
      (aget (.getElementsByTagName js/document "link") 0))))

-(defn install-google-font-dom-anchor! [url]
+(defn install-google-font-dom-anchor! [font-family]
   (let [elem (dom/create-element :p)]
     (dom/append! js/document.body
                  (-> elem
-                     (dom/set-attr! :style "font-family: '...'")
-                     (dom/set-text! " ")))))
+                     (dom/set-style! :font-family font-family
+                                     :position "absolute"
+                                     :left "-250px"
+                                     :top "0px")
+                     (dom/set-html! " ")))
+    elem))

 (defn install-force-loading-font-div! [fontname]
   (let [el (dom/create-element :div)]


fix advert event in stream

fix advert event in stream

--- src/cljs/salava/social/ui/stream.cljs
+++ src/cljs/salava/social/ui/stream.cljs
@@ -437,7 +437,7 @@
                (and (= "user" (:type event)) (= "follow" (:verb event))) (follow-event-user event state)
                (and (= "badge" (:type event)) (= "publish" (:verb event))) (publish-event-badge event state)
                (and (= "page" (:type event)) (= "publish" (:verb event))) (publish-event-page event state)
-               (and (= "advert" (:type event)) (= "advertise" (:verb event))) (badge-advert-event event state)
+               (= "advert" (:type event)) (badge-advert-event event state)
                (= "message" (:verb event)) [message-event event state]
                :else "")))]))


Add support use authorization middleware with function as backend.

That automatically wrapps it in a generic backend instance.

--- src/clojure/buddy/auth/middleware.clj
+++ src/clojure/buddy/auth/middleware.clj
@@ -20,6 +20,10 @@
             [slingshot.slingshot :refer [throw+ try+]])
   (:import buddy.exceptions.UnauthorizedAccessException))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Authentication
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn wrap-authentication
   "Ring middleware that enables authentication
   for your ring handler."
@@ -34,21 +38,44 @@
             (if (response? rsq) rsq
               (handler (or rsq request)))))))))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Authorization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- fn->authorization-backend
+  "Given a function that receives two parameters
+  return an anonymous object that implements
+  IAuthorization protocol."
+  [callable]
+  {:pre [(fn? callable)]}
+  (reify
+    proto/IAuthentication
+    (handle-unauthorized [_ request errordata]
+      (callable request errordata))))
+
 (defn wrap-authorization
   "Ring middleware that enables authorization
-  workflow for your ring handler."
-  [handler & [backend]]
-  (fn [request]
-    (let [backend (or backend (:auth-backend request))]
-      (if (nil? backend)
-        (throw (IllegalAccessError. "no backend found"))
-        (try+
-         (handler request)
-         (catch Object e
-           (if (satisfies? proto/IAuthorizationdError e)
-             (let [errordata (proto/get-error-data e)]
-               (proto/handle-unauthorized backend request errordata))
-             (throw+))))))))
+  workflow for your ring handler.
+
+  The `backend` parameter should be a plain function
+  that accepts two paramerts: request and errordata
+  hashmap, or an instance that satisfies IAuthorization
+  protocol."
+  [handler backend]
+  (let [backend (cond
+                  (fn? backend)
+                  (fn->authorization-backend backend)
+
+                  (satisfies? proto/IAuthentication backend)
+                  backend)]
+    (fn [request]
+      (try+
+       (handler request)
+       (catch Object e
+         (if (satisfies? proto/IAuthorizationdError e)
+           (let [errordata (proto/get-error-data e)]
+             (proto/handle-unauthorized backend request errordata))
+           (throw+)))))))

 (extend-protocol proto/IAuthorizationdError
   buddy.exceptions.UnauthorizedAccessException


should not accept nil as a valid flag seq

--- src/insn/util.clj
+++ src/insn/util.clj
@@ -150,8 +150,10 @@
   "Return opcode bit flags for asm class, method, or field."
   [x]
   (let [flag #(check-valid "flag" flag-keyword? %)]
-    (if (or (nil? x) (sequential? x) (set? x))
-      (apply bit-or 0 (map flag x))
+    (if (or (sequential? x) (set? x))
+      (if (seq x)
+        (apply bit-or 0 (map flag x))
+        0)
       (flag x))))

 (defn ^:no-doc intern-symbol?


Added another nine tests into results-test module

--- test/emender_jenkins/results_test.clj
+++ test/emender_jenkins/results_test.clj
@@ -120,3 +120,56 @@
         (is (callable? 'emender-jenkins.results/all-products))))

+(deftest test-versions-per-products-existence
+    "Check that the emender-jenkins.results/versions-per-products definition exists."
+    (testing "if the emender-jenkins.results/versions-per-products definition exists."
+        (is (callable? 'emender-jenkins.results/versions-per-products))))
+
+
+(deftest test-books-for-product-version-existence
+    "Check that the emender-jenkins.results/books-for-product-version definition exists."
+    (testing "if the emender-jenkins.results/books-for-product-version definition exists."
+        (is (callable? 'emender-jenkins.results/books-for-product-version))))
+
+
+(deftest test-job-for-environment-existence
+    "Check that the emender-jenkins.results/job-for-environment definition exists."
+    (testing "if the emender-jenkins.results/job-for-environment definition exists."
+        (is (callable? 'emender-jenkins.results/job-for-environment))))
+
+
+(deftest test-select-results-for-book-existence
+    "Check that the emender-jenkins.results/select-results-for-book definition exists."
+    (testing "if the emender-jenkins.results/select-results-for-book definition exists."
+        (is (callable? 'emender-jenkins.results/select-results-for-book))))
+
+
+(deftest test-select-results-for-product-version-existence
+    "Check that the emender-jenkins.results/select-results-for-product-version definition exists."
+    (testing "if the emender-jenkins.results/select-results-for-product-version definition exists."
+        (is (callable? 'emender-jenkins.results/select-results-for-product-version))))
+
+
+(deftest test-select-results-for-product-existence
+    "Check that the emender-jenkins.results/select-results-for-product definition exists."
+    (testing "if the emender-jenkins.results/select-results-for-product definition exists."
+        (is (callable? 'emender-jenkins.results/select-results-for-product))))
+
+
+(deftest test-get-job-results-existence
+    "Check that the emender-jenkins.results/get-job-results definition exists."
+    (testing "if the emender-jenkins.results/get-job-results definition exists."
+        (is (callable? 'emender-jenkins.results/get-job-results))))
+
+
+(deftest test-find-job-with-name-existence
+    "Check that the emender-jenkins.results/find-job-with-name definition exists."
+    (testing "if the emender-jenkins.results/find-job-with-name definition exists."
+        (is (callable? 'emender-jenkins.results/find-job-with-name))))
+
+
+(deftest test-job-exists?-existence
+    "Check that the emender-jenkins.results/job-exists? definition exists."
+    (testing "if the emender-jenkins.results/job-exists? definition exists."
+        (is (callable? 'emender-jenkins.results/job-exists?))))
+


fixing a couple new references to @org-id which were missed in the `orgless` branch.

--- test/metabase/api/meta/table_test.clj
+++ test/metabase/api/meta/table_test.clj
@@ -174,7 +174,7 @@
               :details $
               :updated_at $
               :name "Test Database"
-              :organization_id @org-id
+              :organization_id nil
               :description nil})
        :name "USERS"
        :fields [(match-$ (sel :one Field :id (field->id :users :id))
@@ -274,7 +274,7 @@
               :details $
               :updated_at $
               :name "Test Database"
-              :organization_id @org-id
+              :organization_id nil
               :description nil})
        :name "USERS"
        :fields [(match-$ (sel :one Field :id (field->id :users :id))


Reduce n-messages and disable riemann for CI

--- test/onyx/metrics/throughput_test.clj
+++ test/onyx/metrics/throughput_test.clj
@@ -28,7 +28,7 @@

 (def peer-group (onyx.api/start-peer-group peer-config))

-(def n-messages 1000000)
+(def n-messages 100000)

 (def batch-size 20)

@@ -81,7 +81,7 @@
    {:lifecycle/task :in
     :lifecycle/calls :onyx.plugin.core-async/reader-calls}

-   {:lifecycle/task :all
+   #_{:lifecycle/task :all
     :lifecycle/calls :onyx.lifecycle.metrics.riemann/calls
     :riemann/address "192.168.99.100"
     :riemann/port 5555