Use constant alpha for triangles.

Use constant alpha for triangles.

--- src/videotest/tri_cv/motion_core.clj
+++ src/videotest/tri_cv/motion_core.clj
@@ -20,6 +20,8 @@
 (def PIX-CNT1 (* WIDTH HEIGHT 4))
 (def PIX-CNT2 (* WIDTH HEIGHT))

+(def ALPHA-STILL 125.0)
+

 (def MOSAIC-BIN-SIZE 12)
 (def MOSAIC-BIN-SIZE-X2  (* MOSAIC-BIN-SIZE 2.0))
@@ -102,10 +104,11 @@
         tri-glyphs (triangle-glyphs tri-pts tri-orients)]
    {:b-array (byte-array PIX-CNT1)
     :i-array (int-array PIX-CNT2)
-    :frame-mat (Mat. WIDTH HEIGHT CvType/CV_8UC3)
-    :output-mat (Mat. WIDTH HEIGHT CvType/CV_8UC4)
+    :frame-mat (Mat. HEIGHT WIDTH CvType/CV_8UC3)
+    :output-mat (Mat. HEIGHT WIDTH CvType/CV_8UC4)
     :gray-mat (Mat.)
     :rgba-mat (Mat.)
+    :drawn-mat (Mat. HEIGHT WIDTH CvType/CV_8UC4)
     :camera (cv/camera 0)
     :p-image (q/create-image WIDTH HEIGHT :rgb)
     :triangle-points tri-pts
@@ -119,17 +122,15 @@
                          color
                          glyph-pts]
   (let [poly (MatOfPoint.)
-        c (apply #(let [r %1
-                        g %2
-                        b %3
-                        a %4]
-                    (Scalar. b g r))
+        c (apply (fn [r g b _]
+                   (let [a ALPHA-STILL]
+                     (Scalar. r g b a)))
                  color)]
     (.fromList poly (ArrayList. glyph-pts))
     (Core/fillPoly img-mat (ArrayList. [poly]) c)))

 (defn draw-mosaic-pair
-  [triangle-glyphs frame-mat rgba-mat [pt1 pt2]]
+  [triangle-glyphs drawn-mat rgba-mat [pt1 pt2]]
   (let [color-fn (fn [mat-col mat-row]
                    (let [c (.get rgba-mat
                                  (+ mat-row MOSAIC-BIN-SIZE-2)
@@ -141,17 +142,28 @@
         [mat-col2 mat-row2] pt2
         c1 (color-fn mat-col1 mat-row1)
         c2 (color-fn mat-col2 mat-row2)]
-    (draw-mosaic-glyph frame-mat c1 (triangle-glyphs pt1))
-    (draw-mosaic-glyph frame-mat c2 (triangle-glyphs pt2))))
+    (draw-mosaic-glyph drawn-mat c1 (triangle-glyphs pt1))
+    (draw-mosaic-glyph drawn-mat c2 (triangle-glyphs pt2))))

 (defn overlay-triangles
-  [{:keys [frame-mat rgba-mat triangle-points triangle-glyphs] :as state}]
+  [{:keys [drawn-mat rgba-mat triangle-points triangle-glyphs] :as state}]
   (dorun
    (map (partial draw-mosaic-pair
                  triangle-glyphs
-                 frame-mat rgba-mat)
+                 drawn-mat
+                 rgba-mat)
         (partition 2 triangle-points)))
   state)
+
+(defn rgba-mat->p-img
+  "Input mat is really BGR, but we'll flip these bits in
+   any-mat->p-img. If you don't use that, swap blue and red."
+  [in-mat out-mat b-array i-array p-img]
+  (cv/any-mat->p-img in-mat out-mat Imgproc/COLOR_RGBA2BGRA b-array i-array p-img))
+
+(defn update-drawn-p-image [state]
+  (let [{:keys [drawn-mat output-mat b-array i-array]} state]
+    (update-in state [:p-image] #(cv/mat->p-img drawn-mat output-mat b-array i-array %))))

 (defn update [state]
   (-> state
@@ -159,7 +171,7 @@

       (update-rgba)
       (overlay-triangles)
-      (cv/update-p-image)))
+      (update-drawn-p-image)))

 (defn draw [state]
   (let [{:keys [p-image frame-mat]} state]


원문 처리 추가

원문 처리 추가

--- src/인스타파스/마크다운.clj
+++ src/인스타파스/마크다운.clj
@@ -4,7 +4,7 @@

 (def 파서
   (insta/parser
-   "문서         := (제목 / 목록 / 인용 / 문단)+
+   "문서         := (제목 / 목록 / 인용 / 원문 / 문단)+
     문단         := 평문? LF
     <제목>       := (작은제목 / 큰제목) LF
     <평문>       := (링크들 / 강조 / ANY)+
@@ -22,6 +22,9 @@
     (* 인용 *)
     인용         := (<'>' 공백?> (빈줄 / 평문) LF)+
     빈줄         := 공백*
+
+    (* 원문 *)
+    원문         := (<공백 공백 공백 공백> ANY* '\\n')+

     (* 링크 *)
     <링크들>     := 일반링크 / 자동링크
@@ -57,6 +60,14 @@
             (str 텍스트 "\n"))))

 (deftest 분석테스트
+  (testing "원문"
+    (are [시도 결과] (= 시도 결과)
+      (분석 "    원문 텍스트는 줄넘김\n    문자도 유지")
+      [:문서 [:원문 "원" "문" " " "텍" "스" "트" "는" " "
+              "줄" "넘" "김" "\n" "문" "자" "도" " " "유" "지" "\n"]]
+
+      (분석 "    원문 텍스트는 *강조*처리 제외")))
+
   (testing "인용"
     (are [시도 결과] (= 시도 결과)
       (분석 "> 짜라투스트라는 *이렇게* 말했다")


insert fast path when compiling in case of direct linking

--- src/java_time/impl/load.cljc
+++ src/java_time/impl/load.cljc
@@ -18,12 +18,19 @@

 (def slow-path-vars (volatile! []))

-(def slow-path
+(def slow-path*
   (fn [sym]
     (vswap! slow-path-vars conj sym)
     (fn [& args]
       (load-java-time)
       (apply (resolve sym) args))))
+
+(defmacro slow-path [vsym]
+  (if *compile-files*
+    `(do (vswap! slow-path-vars conj ~vsym)
+         (load-java-time)
+         @(resolve ~vsym))
+    `(slow-path* ~vsym)))

 (def ^Runnable async-load-fast-path
   (bound-fn []


unnecessary code

unnecessary code

--- src/latte_compiler/static_analysis.clj
+++ src/latte_compiler/static_analysis.clj
@@ -405,11 +405,6 @@
     )
   )

-(domonad phase-m
-  [[vars2 lalela] (m-result [13 23])
-   [vars22 lalele] (m-result [(+ vars2 1) (+ lalela 3)])]
-  vars22)
-
 (defn- annotate-evar
   [glob-state vars ident location an-expr]
   (domonad phase-m
@@ -418,41 +413,7 @@
      type (m-result (get-type nident))
      res (succ [vars2 (with-type [:evar nident] type)])]
     res
-    )
-  #_(match ident
-      [:vident [:ident name]]
-      (domonad phase-m
-        [[type num] (lookup-var vars [:ident name] location)]
-        [vars (with-type [:evar [:vident [:ident num]]] type)])
-      [:fident eident name]
-      (domonad phase-m
-        [[_ nident] (annotate-evar glob-state vars eident location)
-         [type offset] (lookup-clss-field glob-state (get-type nident) name location)]
-        (do #_(util/println-err [:evar [:fident (second nident) [:ident offset]]])
-            [vars (with-type [:evar [:fident (second nident) [:ident offset]]] type)])
-        )
-      [:ident name]
-      (domonad phase-m
-        [[type num] (lookup-var vars [:ident name] location)]
-        [vars (with-type [:evar [:ident num]] type)])
-      ;[:aident lvar expr] (domonad phase-m
-      ;                        [[nvars nident] (fn glob-state vars lvar)]
-      ;                        [vars (with-type [:aident nident expr] [:int])]
-      ;                        )
-      ;[:aident eident expr] (domonad phase-m
-      ;                        [[nvars nident] (annotate-evar glob-state vars eident location fn)
-      ;                         [nnvars ins-expr] (fn glob-state nvars expr)
-      ;                         _ (if (is-int ins-expr) (succ "")
-      ;                                                 (err (str "expr type invalid; expected int, found "
-      ;                                                             (print-type (get-type ins-expr)) " in: " location)))
-      ;                         etype (match (get-type nident)
-      ;                                [:atype t] (succ t)
-      ;                                 :else (err (str "type invalid; expected array type, found " (print-type (get-type nident))
-      ;                                                   " in: " location)))]
-      ;                        [nnvars (with-type [:aident nident ins-expr] etype)]
-      ;                        )
-      )
-  )
+    ))

 (defn- annotate-expr
   [glob-state vars expr]


Whitespace

Whitespace

--- src/kixi/hecuba/web/amon.clj
+++ src/kixi/hecuba/web/amon.clj
@@ -21,7 +21,7 @@
   [x]
   (postwalk
    #(cond
-     (instance?  java.util.UUID %) (str %)
+     (instance? java.util.UUID %) (str %)
      (keyword? %) (name %)
      (or (coll? %) (string? %)) %
      :otherwise (throw (ex-info (format "No JSON type for %s"


allow undertow file handler to follow links

fixes #399

--- src/main/shadow/undertow.clj
+++ src/main/shadow/undertow.clj
@@ -133,7 +133,13 @@
         (build state next)

         rc-manager
-        (PathResourceManager. (.toPath root-dir))
+        (-> (PathResourceManager/builder)
+            (.setBase (.toPath root-dir))
+            ;; FIXME: should probably make these configurable
+            (.setFollowLinks true)
+            ;; must not be nil, empty == followAll
+            (.setSafePaths (into-array String []))
+            (.build))

         handler
         (doto (ShadowResourceHandler. rc-manager next)


Improve exception report for Clojure

Improve exception report for Clojure

Convert stack frames for Clojure functions into a more presentable format
Hide all but the deepest exception

--- src/main/clojure/cascade/exception.clj
+++ src/main/clojure/cascade/exception.clj
@@ -15,8 +15,11 @@
 (ns #^{:doc "Exception reporting"}
   cascade.exception
   (:import (java.lang Throwable StackTraceElement))
+  (:require
+  	(clojure.contrib (str-utils2 :as s2)))
   (:use
   	cascade
+  	(cascade.internal utils)
   	(cascade config logging pipeline)))

 ;; Identifies the properties of Throwable that are excluded from each exception-map's set of properties
@@ -29,6 +32,22 @@
   (cond
   	(.startsWith (.getClassName element) "clojure.lang.") :c-omitted-frame))

+(defn convert-clojure-frame
+	"Converts a stack frame into DOM nodes representing the Clojure namespace and function name(s),
+	or returns nil if the stack frame is not for a Clojure call frame."
+	[class-name method-name]
+	(debug "Converting: %s.%s" class-name method-name)
+	(when (contains? #{"invoke" "doInvoke"} method-name)
+		(let [[namespace-name & raw-function-ids] (s2/split class-name #"\$")
+		_ (debug "Raw function ids: %s" (ppstring raw-function-ids))
+				  function-ids (map #(nth (first (re-seq #"(\w+)__\d+" %)) 1 nil) raw-function-ids)
+				  _ (debug "Function ids: %s" (ppstring function-ids))
+				  function-names (map #(s2/replace % \_ \-) function-ids)]
+		  (if-not (empty? raw-function-ids)
+		  	(template
+		  		namespace-name "/" (s2/join "/" function-names)
+		  	  :span { :class :c-omitted } [ " " class-name "." method-name])))))
+
 (defn transform-stack-frame
   [#^StackTraceElement element]
   ;; TODO: some regexp matching to identify Clojure stack frames and transform them into a better format.
@@ -36,17 +55,21 @@
   {
   	:element element
   	:method-name
-  	(let [file-name (.getFileName element)
-  			  line-number (.getLineNumber element)
-  			  extended-name (str (.getClassName element) "." (.getMethodName element))]
-  		(template
-  		  extended-name
-  		  (cond
-  		    (.isNativeMethod element) (template :em [ "(Native Method)" ])
-  		    (and (not (nil? file-name)) (< 0 line-number)) (str "(" file-name ":" line-number ")")
-  		    (not (nil? file-name)) (str "(" file-name ")")
-  		    true (template :em [ "(Unknown Source)" ]))))
-  	:class-name (class-name-for-element element)
+	  	(let [file-name (.getFileName element)
+	  			  line-number (.getLineNumber element)
+	  			  class-name (.getClassName element)
+	  			  method-name (.getMethodName element)]
+	  		(template
+	  		  (or
+	  		  	(convert-clojure-frame class-name method-name)
+	  		  	(str class-name "." method-name))
+	  		  " "
+	  		  (cond
+	  		    (.isNativeMethod element) (template :em [ "(Native Method)" ])
+	  		    (and (not (nil? file-name)) (< 0 line-number)) (str "(" file-name ":" line-number ")")
+	  		    (not (nil? file-name)) (str "(" file-name ")")
+	  		    true (template :em [ "(Unknown Source)" ]))))
+	  	:class-name (class-name-for-element element)
   })

 (defn transform-stack-trace
@@ -93,25 +116,31 @@
 (defn render-exception-map
   "Renders an individual exception map. "
   [{:keys [class-name message properties stack-trace]}]
-  (template
-    :span { :class :c-exception-class-name } [ class-name ]
-    (if-not (nil? message)
-      (template :div { :class :c-exception-message } [ message ]))
-    (when-not (and (nil? properties) (nil? stack-trace))
-      (template
-        :dl [
-          (template-for [k (sort (keys properties))]
-            :dt [ (name k)]
-            ;; TODO: Expand here to do more than just .toString!
-            :dd [ (.toString (get properties k)) ])
-          (when-not (nil? stack-trace)
-            (template
-              :dt [ "Stack Trace" ]
-              :ul { :class :c-stack-trace } [
-                (template-for [frame stack-trace]
-                  :li {:class (frame :class-name) } [ (frame :method-name) ])
-              ]))
-        ]))))
+  (let [deepest (not (nil? stack-trace))
+        has-properties (not (empty? properties))
+        render-dl (or has-properties deepest)]
+	  (template
+	    :span { :class :c-exception-class-name } [ class-name ]
+
+	    (if-not (nil? message)
+	      (template :div { :class :c-exception-message } [ message ]))
+
+	    (when render-dl
+	      (template
+	        :dl [
+	          (template-for [k (sort (keys properties))]
+	            :dt [ (name k)]
+	            ;; TODO: Expand here to do more than just .toString!
+	            :dd [ (.toString (get properties k)) ])
+	          (when deepest
+	            (template
+	              :dt [ "Stack Trace" ]
+	              :ul { :class :c-stack-trace } [
+	                (template-for [frame stack-trace]
+	                  :li {:class (frame :class-name) } [ (frame :method-name) ])
+	              ]))
+	        ])))))
+
 (defn include-js-library
   [env path]
   (template
@@ -139,7 +168,7 @@

       :ul { :class :c-exception-report } [
         (template-for [m (expand-exception-stack (-> env :cascade :exception))]
-          :li [ (render-exception-map m) ])
+          :li { :class (if (nil? (m :stack-trace)) :c-omitted) } [ (render-exception-map m) ])
       ]
       ;; TODO request details, session details? etc.
     ]


fix reflection introduced in prior patch

--- src/main/clojure/clojure/data/json.clj
+++ src/main/clojure/clojure/data/json.clj
@@ -17,6 +17,7 @@

 ;;; JSON READER

+(set! *warn-on-reflection* true)

 (defn- default-write-key-fn
   [x]
@@ -339,13 +340,13 @@

 (defn- write-string [^CharSequence s ^Appendable out options]
   (let [decoder codepoint-decoder]
-    (.append out (codepoint \"))
+    (.append out \")
     (dotimes [i (.length s)]
       (let [cp (int (.charAt s i))]
         (if (< cp 128)
           (case (aget decoder cp)
-            0 (.append out cp)
-            1 (do (.append out (codepoint \\)) (.append out cp))
+            0 (.append out (char cp))
+            1 (do (.append out (char (codepoint \\))) (.append out (char cp)))
             2 (.append out (if (get options :escape-slash) "\\/" "/"))
             3 (.append out "\\b")
             4 (.append out "\\f")
@@ -356,11 +357,11 @@
           (codepoint-case cp
             :js-separators (if (get options :escape-js-separators)
                              (->hex-string out cp)
-                             (.append out cp))
+                             (.append out (char cp)))
             (if (get options :escape-unicode)
               (->hex-string out cp) ; Hexadecimal-escaped
-              (.append out cp))))))
-    (.append out (codepoint \"))))
+              (.append out (char cp)))))))
+    (.append out \")))

 (defn- write-object [m ^Appendable out options]
   (let [key-fn (:key-fn options)
@@ -520,7 +521,7 @@
   "Converts x to a JSON-formatted string. Options are the same as
   write."
   [x & options]
-  (let [sw (StringBuilder.)]
+  (let [sw (StringWriter.)]
     (-write x sw (merge default-write-options (apply array-map options)))
     (.toString sw)))


Simplify 'describe' abstractions; try 'then' syntax

--- src/main/clojure/lazytest/describe.clj
+++ src/main/clojure/lazytest/describe.clj
@@ -3,9 +3,12 @@
 	[lazytest.runnable-test :only (RunnableTest run-tests
 				       skip-or-pending try-expectations)]
 	[lazytest.test-result :only (result-group)]
+	[lazytest.expect :only (expect)]
 	[lazytest.fixture :only (setup teardown)]))

-(defn get-arg
+;;; Utilities
+
+(defn- get-arg
   "Pops first argument from args if (pred arg) is true.
   Returns a vector [this-arg remaining-args] or [nil args]."
   [pred args]
@@ -13,7 +16,7 @@
     [(first args) (next args)]
     [nil args]))

-(defn get-options
+(defn- get-options
   "Extracts keyword-value pairs from head of args, until next arg is
   not a keyword.  Returns a vector [options-map remaining-args]"
   [args]
@@ -22,82 +25,58 @@
       (recur (assoc options (first args) (second args)) (nnext args))
       [options args])))

-(defn firsts [coll]
+(defn- firsts [coll]
   (take-nth 2 coll))

-(defn seconds [coll]
+(defn- seconds [coll]
   (take-nth 2 (drop 1 coll)))

-(defn wrap-in-fns [forms]
+(defn- thunk-forms [forms]
   (map (fn [f] `(fn [] ~f)) forms))

-(defn get-tests-with-parent [parent t]
+(defn- get-child-tests [parent t]
   (get-tests
    (assoc t
      :locals (vec (concat (:locals parent) (:locals t)))
      :fixtures (vec (concat (:fixtures parent) (:fixtures t))))))

-(defrecord DescribeRunnable [children]
+;;; Core
+
+(defrecord RunnableExample [fixtures f]
+  RunnableTest
+  (run-tests [this]
+	     (list (try-expectations this
+		    (apply f (map setup fixtures))
+		    (dorun (map teardown fixtures))))))
+
+(defrecord DescribeGroup [children]
+  Testable
+  (get-tests [this] (list this))
   RunnableTest
   (run-tests [this]
 	     (or (skip-or-pending this)
 		 (result-group this (mapcat run-tests children)))))

-(defrecord Describe [locals fixtures children-thunk]
-  Testable
-  (get-tests [this]
-	     (list
-	      (DescribeRunnable.
-	       (mapcat (partial get-tests-with-parent this)
-		       (children-thunk))
-	       (meta this)
-	       nil))))
-
 (defmacro describe [& decl]
   (let [[sym decl] (get-arg symbol? decl)
 	[doc decl] (get-arg string? decl)
 	[opts body] (get-options decl)
-	;; argument parsing done
-	givens (:given opts)
-	locals (vec (firsts givens))
-	Fixtures ( (wrap-in-fns (seconds givens)))
-	metadata (merge (meta &form)
-			(dissoc opts :given)
-			(when (empty? body) {:pending true}))
-	group-sym (gensym "describe-")]
-    `(Describe. '~locals ~fixtures (fn [] (vector ~@body)))))
+	children (vec body)
+	metadata (merge (meta &form) opts)]
+    `(DescribeGroup. ~body '~metadata nil)))

-(defn setup-fixture [thunk]
-  (let [value (thunk)]
-    (if (fixture? value)
-      (setup value)
-      value)))
-
-(defrecord ItRunnable [fixtures f]
+(defrecord ThenGroup [assertions]
+  Testable
+  (get-tests [this] (list this))
   RunnableTest
   (run-tests [this]
-	     (list (or (skip-or-pending this)
-		       (let [result (try-expectations
-				     (apply f (map setup (map #(%) fixtures))))]
-			 (dorun (map teardown fixtures))
-			 result)))))
+	     (or (skip-or-pending this)
+		 (try-expectations this (dorun (map #(%) assertions))))))

-(defrecord It [locals fixtures body]
-  Testable
-  (get-tests [this]
-	     (list (ItRunnable. fixtures
-				(eval `(fn ~locals ~@body))
-				(meta this)
-				nil))))
-
-(defmacro it [& decl]
+(defmacro then [& decl]
   (let [[doc decl] (get-arg string? decl)
 	[opts body] (get-options decl)
-	;; argument parsing done
-	givens (:given opts)
-	locals (vec (firsts givens))
-	fixtures (vec (wrap-in-fns (seconds givens)))
-	metadata (merge (meta &form)
-			(dissoc opts :given)
-			(when (empty? body) {:pending true}))]
-    `(It. '~locals ~fixtures '~body)))
+	metadata (merge (meta &form) opts)
+	assertions (map (fn [assertion] `(fn [] (expect ~assertion)))
+			body)]
+    `(ThenGroup. ~assertions '~metadata nil)))


stream-id is now dynamic based on number of subscribers

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -18,8 +18,6 @@
            [uk.co.real_logic.agrona.concurrent IdleStrategy BackoffIdleStrategy BusySpinIdleStrategy]
            [java.util.function Consumer]
            [java.util.concurrent TimeUnit]))
-
-(def send-stream-id 1)

 (defn aeron-channel [addr port]
   (format "udp://%s:%s" addr port))


Only retry if publication is in backpressure mode, not disconnected

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -382,6 +382,8 @@
   (doseq [segment batch]
     (>!! ch segment)))

+(def ^:const publication-backpressured? (long -2))
+
 (defmethod extensions/send-messages AeronConnection
   [messenger event {:keys [id channel] :as conn-info} batch]
   (if ((:short-circuitable? messenger) channel)
@@ -391,8 +393,8 @@
           offer-f (fn [] (.offer pub unsafe-buffer 0 len))
           idle-strategy (:send-idle-strategy messenger)]
       ;;; TODO: offer will return a particular code when the publisher is down
-      ;;; we should probably re-restablish the publication in this case
-      (while (neg? ^long (offer-f))
+      ;;; we should probably re-establish the publication in this case
+      (while (= ^long (offer-f) publication-backpressured?)
         (.idle ^IdleStrategy idle-strategy 0)))))

 (defn ack-messages-short-circuit [ch acks]
@@ -408,8 +410,8 @@
       (doseq [ack acks]
         (let [unsafe-buffer (protocol/build-acker-message id (:id ack) (:completion-id ack) (:ack-val ack))
               offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/ack-msg-length))]
-          (while (neg? ^long (offer-f))
-            (.idle ^IdleStrategy idle-strategy 0)))))))
+      (while (= ^long (offer-f) publication-backpressured?)
+        (.idle ^IdleStrategy idle-strategy 0)))))))

 (defn complete-message-short-circuit [ch completion-id]
   (>!! ch completion-id))
@@ -422,7 +424,7 @@
           pub ^Publication (get-publication messenger conn-info)
           unsafe-buffer (protocol/build-completion-msg-buf id completion-id)
           offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/completion-msg-length))]
-      (while (neg? ^long (offer-f))
+      (while (= ^long (offer-f) publication-backpressured?)
         (.idle ^IdleStrategy idle-strategy 0)))))

 (defn retry-message-short-circuit [ch retry-id]
@@ -436,7 +438,7 @@
           pub ^Publication (get-publication messenger conn-info)
           unsafe-buffer (protocol/build-retry-msg-buf id retry-id)
           offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/retry-msg-length))]
-      (while (neg? ^long (offer-f))
+      (while (= ^long (offer-f) publication-backpressured?)
         (.idle ^IdleStrategy idle-strategy 0)))))

 (defmethod extensions/close-peer-connection AeronConnection


drvs and react-drvs helper functions (#5)

* drvs and react-drvs helper functions

* Fix namespaced function calls

--- src/org/martinklepsch/derivatives.cljc
+++ src/org/martinklepsch/derivatives.cljc
@@ -3,6 +3,7 @@
             [org.martinklepsch.derived :as derived]
             [clojure.set :as s]
             [rum.core :as rum]
+            [rum.util :as rutil]
             #?(:cljs [goog.object :as gobj])))

 (defn depend'
@@ -167,6 +168,23 @@
   [state drv-k]
   (rum/react (get-ref state drv-k)))

+(defn drvs [& ks]
+  (let [ds (map drv ks)
+        will-mount (rutil/collect :will-mount ds)
+        will-unmount (rutil/collect :will-unmount ds)]
+    {:class-properties (:class-properties (first ds))
+     :will-mount (fn [s]
+                   (assoc
+                     (rutil/call-all s will-mount)
+                     ::drvs ks))
+     :will-unmount (fn [s] (rutil/call-all s will-unmount))}))
+
+(defn react-drvs [state]
+  (map
+    (partial react state)
+    (::drvs state)))
+
+
 (comment
   (def base (atom 0))


Remove status message from messages stream

--- src/status_im/chat/subs.cljs
+++ src/status_im/chat/subs.cljs
@@ -103,20 +103,15 @@
   "Transforms message-datemark-groups into flat sequence of messages interspersed with
   datemark messages.
   Additionaly enhances the messages in message sequence with derived stream context information,
-  like `:same-author?`, `:same-direction?`, `:last?` and `:last-outgoing?` flags + contact info/status
-  message for the last dategroup."
-  [[[last-datemark last-messages] :as message-datemark-groups]]
+  like `:same-author?`, `:same-direction?`, `:last?` and `:last-outgoing?` flags. "
+  [message-datemark-groups]
   (if (seq message-datemark-groups)
     (let [messages-seq (mapcat second message-datemark-groups)
           {last-message-id :message-id} (first messages-seq)
           {last-outgoing-message-id :message-id} (->> messages-seq
                                                       (filter :outgoing)
                                                       first)]
-      ;; TODO janherich: why the heck do we display contact user info/status in chat as a message in stream ?
-      ;; This makes no sense, user wants to have this information always available, not as something which
-      ;; scrolls with message stream
-      (->> (conj (rest message-datemark-groups)
-                 [last-datemark (conj (into [] last-messages) {:content-type constants/content-type-status})])
+      (->> message-datemark-groups
            (mapcat (fn [[datemark messages]]
                      (let [prepared-messages (into []
                                                    (map (fn [{:keys [message-id] :as message} previous-message]
@@ -133,14 +128,13 @@
                                                         (concat (rest messages) '(nil))))]
                        (conj prepared-messages {:type :datemark
                                                 :value datemark}))))))
-    ;; when no messages are in chat, we need to at least fake-out today datemark + status messages
-    (list {:content-type constants/content-type-status}
-          {:type  :datemark
+    ;; when no messages are in chat, we need to at least fake-out today's datemark
+    (list {:type  :datemark
            :value (i18n/label :t/datetime-today)})))

 (reg-sub
-  :get-chat-messages
-  (fn [[_ chat-id]]
+  :get-chat-messages
+  (fn [[_ chat-id]]
     (subscribe [:get-chat-message-datemark-groups chat-id]))
   (fn [message-datemark-groups]
     (messages-stream message-datemark-groups)))


Change login form to dispatch event to caching verion of login handler.

--- src/trustroots/shared/pages/login.cljs
+++ src/trustroots/shared/pages/login.cljs
@@ -51,7 +51,7 @@
                                          (swap! fields assoc :pwd (-> value
                                                                       .-nativeEvent
                                                                       .-text))
-                                         (dispatch [:login @fields]))
+                                         (dispatch [:auth/login @fields]))
                                         ;:on-change-text  (fn [value] (swap! fields assoc :pwd value))
                                         ;:value           (:pwd @fields)
                     :style             {:width 200}} ]


Move the shape initialization out of add-shape event.

--- src/uxbox/data/workspace.cljs
+++ src/uxbox/data/workspace.cljs
@@ -14,12 +14,6 @@
 ;; Schemas
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(def ^:static +shape-props-schema+
-  {:x [v/integer]
-   :y [v/integer]
-   :width [v/integer]
-   :height [v/integer]})
-
 (def ^:static +shape-schema+
   {:x [v/integer]
    :y [v/integer]
@@ -41,8 +35,10 @@
    :opacity [v/number]})

 (def ^:static +shape-update-position-schema+
-  {:x [v/integer]
-   :y [v/integer]})
+  {:x1 [v/integer]
+   :y1 [v/integer]
+   :x2 [v/integer]
+   :y2 [v/integer]})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Events (explicit)
@@ -125,16 +121,14 @@

 (defn add-shape
   "Create and add shape to the current selected page."
-  [shape props]
+  [shape]
   (sc/validate! +shape-schema+ shape)
-  (sc/validate! +shape-props-schema+ props)
   (reify
     rs/UpdateEvent
     (-apply-update [_ state]
       (let [sid (random-uuid)
             pid (get-in state [:workspace :page])
-            shape (merge (sh/-initialize shape props)
-                         shape {:id sid :page pid})]
+            shape (merge shape {:id sid :page pid})]
         (as-> state $
           (update-in $ [:pages-by-id pid :shapes] conj sid)
           (assoc-in $ [:shapes-by-id sid] shape))))))


updated clojure code to draft-farrel-decade-ni-06

--- clojure/test/ni/test/core.clj
+++ clojure/test/ni/test/core.clj
@@ -5,6 +5,8 @@
   )

+(def hwtxt "test/ni/test/hw.txt")
+(def tcd-spki "test/ni/test/tcd.spki")

 ;; the ni name for hw.txt according to the I-D
@@ -36,25 +38,17 @@

-;(.read (input-stream "filename.bin") buffer)
-
-(def hwtxt (input-stream "test/hw.txt"))
-
-;(def tcd-spki (into-array Byte/TYPE (input-stream "test/tcd.spki")))
-
-(def tcd-spki (input-stream "test/tcd.spki"))
-

 (defn mkni-string [input auth algo paras]
   (ni-toString (mkni input auth algo paras)))

 (def name-hw
-  (mkni-string hwtxt "" "sha-256" ""))
+  (mkni-string (input-stream hwtxt) "" "sha-256" ""))

 (def name-tcd-spki
-  (mkni-string tcd-spki "" "sha-256" ""))
+  (mkni-string (input-stream tcd-spki) "" "sha-256" ""))

@@ -68,35 +62,35 @@

 (deftest test-badres1
   (let [badni1 (ni badname1)]
-    (is (not (valid? badni1 (input-stream "test/hw.txt"))))))
+    (is (not (valid? badni1 (input-stream hwtxt))))))

 (deftest test-badres2
   (let [badni2 (ni badname2)]
-    (is (not (valid? badni2 (input-stream "test/hw.txt"))))))
+    (is (not (valid? badni2 (input-stream hwtxt))))))

 (deftest test-goodres1
   (let [goodni1 (ni hwname1)]
-    (is (valid? goodni1 (input-stream "test/hw.txt")))))
+    (is (valid? goodni1 (input-stream hwtxt)))))

 (deftest test-goodres2
   (let [goodni2 (ni hwname2)]
-    (is (valid? goodni2 (input-stream "test/tcd.spki")))))
+    (is (valid? goodni2 (input-stream tcd-spki)))))

 (deftest test-binname
   (let [binname
         (hexify-bytes (ni-toBin
-                 (mkni (input-stream "test/tcd.spki") "" "sha-256-120" "")))]
+                 (mkni (input-stream tcd-spki) "" "sha-256-120" "")))]
     (is (= binname bname1))))

 (deftest test-nihout1
-  (let [nihout1 (mkni (input-stream "test/hw.txt") "" "sha-256-96" "")]
+  (let [nihout1 (mkni (input-stream hwtxt) "" "sha-256-96" "")]
     (is (= nihname1 (ni-toNih nihout1)))))

 (deftest test-nihout2
-  (let [nihout2 (mkni (input-stream "test/hw.txt") "" "sha-256-120" "")]
+  (let [nihout2 (mkni (input-stream hwtxt) "" "sha-256-120" "")]
     (is (= nihname3 (ni-toNih nihout2)))))


Don't create stores on --disable-*-store

--- src/whisper2cyanite/core.clj
+++ src/whisper2cyanite/core.clj
@@ -22,9 +22,7 @@
         series (:series data)
         path-stored? (atom false)
         run (:run options false)
-        min-ttl (:min-ttl options default-min-ttl)
-        disable-metric-store (:disable-metric-store options false)
-        disable-path-store (:disable-path-store options false)]
+        min-ttl (:min-ttl options default-min-ttl)]
     (doseq [point series]
       (let [time (first point)
             value (last point)]
@@ -32,11 +30,11 @@
           (let [ttl (- time (- (utils/now) retention))]
             (when (> ttl min-ttl)
               (when run
-                (when-not disable-metric-store
+                (when mstore
                   (mstore/insert mstore tenant rollup period path time
                                  value ttl))
                 (when-not @path-stored?
-                  (when-not disable-path-store
+                  (when pstore
                     (pstore/insert pstore tenant path))
                   (swap! path-stored? (fn [_] true)))))))))))

@@ -69,8 +67,12 @@
         to (if to to utils/epoch-future)
         jobs (:jobs options default-jobs)
         pool (cp/threadpool jobs)
-        mstore (mstore/cassandra-metric-store cass-host options)
-        pstore (pstore/elasticsearch-metric-store es-url options)
+        mstore (if-not (:disable-metric-store options false)
+                 (mstore/cassandra-metric-store cass-host options)
+                 nil)
+        pstore (if-not (:disable-path-store options false)
+                 (pstore/elasticsearch-metric-store es-url options)
+                 nil)
         disable-progress (:disable-progress options false)
         progress-fn (if disable-progress #(println %) (fn [_] (prog/tick)))
         migrate-fn (fn [file]
@@ -88,8 +90,10 @@
       (when-not disable-progress
        (prog/done))
       (finally
-        (mstore/shutdown mstore)
-        (pstore/shutdown pstore)))))
+        (when mstore
+          (mstore/shutdown mstore))
+        (when pstore
+          (pstore/shutdown pstore))))))

 (defn list-paths
   "List paths."


concat's are not associative

concat's are not associative

--- src/wireframes/transform.clj
+++ src/wireframes/transform.clj
@@ -12,7 +12,7 @@
   (translate 0.0  0.0  0.0))

 (defn rotate
-  "Rotation aroiund the Z-axis"
+  "Rotation around the Z-axis"
   [theta]
   (let [s (Math/sin theta)
         c (Math/cos theta)]
@@ -37,9 +37,9 @@
   ([a b]
     (let [a (conj a [0.0  0.0  0.0  1.0])
           b (conj b [0.0  0.0  0.0  1.0])
-          transposed  (apply map vector b)
+          transposed  (apply mapv vector a)
           row-mult    (fn [x] (mapv (partial dot-product x) transposed))]
-      (subvec (mapv row-mult a) 0 3)))
+      (subvec (mapv row-mult b) 0 3)))
   ([a b & more]
     (let [initial (concat a b)]
       (reduce concat initial more))))


korma calls it wish

korma calls it wish

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -44,7 +44,7 @@
 (defn set-path! [code]
   (.pushState js/window.history nil "" code))

-(defn show-wishlist! [{:keys [wishes title code] :as wishlist}]
+(defn show-wishlist! [{:keys [wish title code] :as wishlist}]
   (empty $content)
   (empty $header)
   (append $content (wish-ul wishes))


title-from-html cljs

title-from-html cljs

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -46,6 +46,9 @@
   (append $content (wish-ul wishes))
   (append $header  (wishlist-title title)))

+(defn title-from-html []
+  (val wishlist-title))
+
 (defn wishlist-from-html []
   {:title  (title-from-html)
    :wishes (wishes-from-html)


More coverage to get the tests pass

More coverage to get the tests pass

--- test/cljc/spec_tools/visitor_test.cljc
+++ test/cljc/spec_tools/visitor_test.cljc
@@ -17,6 +17,7 @@
 (defn collect [dispatch _ children _] `[~dispatch ~@children])

 (deftest test-visit
+  (is (= (visitor/visit #(pos? %) collect) [::s/unknown]))
   (is (= (visitor/visit #{1 2 3} collect) [:spec-tools.visitor/set 1 3 2]))
   (is (= (visitor/visit int? collect) ['clojure.core/int?]))
   (is (= (visitor/visit ::map collect)


Remove tap

Remove tap

--- test/com/wsscode/pathom/core_test.cljc
+++ test/com/wsscode/pathom/core_test.cljc
@@ -272,7 +272,7 @@
 (comment
   (p/ast->query
     (p/transduce-children
-      (remove (fn [{:keys [params]}] #nu/tapd (:elide params)))
+      (remove (fn [{:keys [params]}] (:elide params)))
       (p/query->ast
         [:a '(:b {:elide true}) :c
          {:d [{'(:e {:elide true}) [:f :g]} :h]}]))


1st test for the function get-job-name-from-uri-or-param

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -384,6 +384,15 @@
     "Check the function emender-jenkins.rest-api/uri->job-name."
     (testing "the function emender-jenkins.rest-api/uri->job-name."
         (is (thrown? NullPointerException (uri->job-name nil "prefix")))))
+
+(deftest test-get-job-name-from-uri-or-param-1
+    "Check the function emender-jenkins.rest-api/get-job-name-from-uri-or-params."
+    (testing "the function emender-jenkins.rest-api/get-job-name-from-uri-or-params."
+        (are [result request uri-prefix uri] (= result (get-job-name-from-uri-or-params request uri-prefix uri))
+            nil   nil "prefix" "prefix"
+            "   " nil "prefix" "prefix%20%20%20"
+            "test-Product_Name-Product_Version-Book_Name-en-US (prod)" nil "http://10.20.30.40:8080/" "http://10.20.30.40:8080/test-Product_Name-Product_Version-Book_Name-en-US%20(prod)"
+            "test-Product_Name-Product_Version-Book_Name-en-US (prod)" nil "http://jenkins.server.com:8080/" "http://jenkins.server.com:8080/test-Product_Name-Product_Version-Book_Name-en-US%20(prod)")))

 (deftest test-body->results
     "Check the function emender-jenkins.rest-api/body->results."


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)))))))))


Add chapter3 test stubs.

Add chapter3 test stubs.

--- test/little_clojurer/chapter3_test.clj
+++ test/little_clojurer/chapter3_test.clj
@@ -9,3 +9,39 @@
     (is (= '() (rember 5 '())))
     (is (= '() (rember :a '())))
     (is (= '(2 1 3 4 1) (rember 1 '(1 2 1 3 4 1))))))
+
+
+(deftest firsts
+  (testing))
+
+
+(deftest insertR
+  (testing))
+
+
+(deftest insertL
+  (testing))
+
+
+(deftest subst
+  (testing))
+
+
+(deftest subst2
+  (testing))
+
+
+(deftest multirember
+  (testing))
+
+
+(deftest multiinsertR
+  (testing))
+
+
+(deftest multiinsertL
+  (testing))
+
+
+(deftest multisubst
+  (testing))


Tests for auth.handlers.failed-login

Tests for auth.handlers.failed-login

--- test/lunchlotto/auth/handlers_test.clj
+++ test/lunchlotto/auth/handlers_test.clj
@@ -20,6 +20,12 @@
     (let [resp (handlers/show-login-page {})]
       (is (= 200 (:status resp)))
       (is (contains (:body resp) "Login")))))
+
+(deftest failed-login
+  (testing "successfully render failed login page"
+    (let [resp (handlers/failed-login {})]
+      (is (= 400 (:status resp)))
+      (is (contains (:body resp) "Sorry, that email and password combination is incorrect.")))))

 (deftest register-user
   (testing "valid email format and email is not in database"


make sure test db is setup before we run our unit tests.

--- test/metabase/middleware/auth_test.clj
+++ test/metabase/middleware/auth_test.clj
@@ -4,9 +4,13 @@
             [metabase.api.common :refer [*current-user-id* *current-user*]]
             [metabase.middleware.auth :refer :all]
             [metabase.models.session :refer [Session]]
-            [metabase.test-data :as test-data]
+            [metabase.test-data :refer :all]
             [metabase.util :as util]
             [ring.mock.request :as mock]))
+
+
+;; make sure test db is setup
+@test-db

 ;;;;  ===========================  TEST wrap-sessionid middleware  ===========================
@@ -71,7 +75,7 @@

 ;; valid sessionid
 (let [sessionid (.toString (java.util.UUID/randomUUID))
-      user-id (test-data/user->id :rasta)]
+      user-id (user->id :rasta)]
   (assert sessionid)
   (assert user-id)
   ;; create a new session
@@ -85,7 +89,7 @@

 ;; expired sessionid
 (let [sessionid (.toString (java.util.UUID/randomUUID))
-      user-id (test-data/user->id :rasta)]
+      user-id (user->id :rasta)]
   (assert sessionid)
   (assert user-id)
   ;; create a new session (specifically created some time in the past so it's EXPIRED)
@@ -99,7 +103,7 @@

 ;; inactive user sessionid
 (let [sessionid (.toString (java.util.UUID/randomUUID))
-      user-id (test-data/user->id :trashbird)]              ; NOTE that :trashbird is our INACTIVE test user
+      user-id (user->id :trashbird)]              ; NOTE that :trashbird is our INACTIVE test user
   (assert sessionid)
   (assert user-id)
   ;; create a new session (specifically created some time in the past so it's EXPIRED)
@@ -128,7 +132,7 @@

 ;; with valid user-id
-(let [{:keys [id email] :as user} (test-data/fetch-user :rasta)]
+(let [{:keys [id email] :as user} (fetch-user :rasta)]
   (assert user)
   (expect
     {:userid id


AB + CW | 22 | add log out and re-sign in flow

--- test/stonecutter_journey_test/test.clj
+++ test/stonecutter_journey_test/test.clj
@@ -57,4 +57,14 @@
         (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"))
+
+  (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")))


store: add a fake store to benchmark index alone

--- src/io/cyanite/store.clj
+++ src/io/cyanite/store.clj
@@ -45,12 +45,26 @@
               (-> metric :time long)]
              {:consistency wrcty})))

+(defn empty-store
+  []
+  (reify
+    component/Lifecycle
+    (start [this] this)
+    (stop [this] this)
+    MetricStore
+    (fetch! [this from to paths])
+    (insert! [this metric])))
+
 (defmulti build-store (comp (fnil keyword "cassandra-v2") :type))

 (defmethod build-store :cassandra-v2
   [options]
   (map->CassandraV2Store {:options (dissoc options :type)}))

+(defmethod build-store :empty
+  [options]
+  (empty-store))
+
 (defn query! [store from to paths]
   (let [raw-series         (fetch! store from to paths)
         [precision series] (p/normalize raw-series)]


Deprecation messages

Deprecation messages

--- src/midje/semi_sweet.clj
+++ src/midje/semi_sweet.clj
@@ -73,12 +73,14 @@
    Example: (let [a 5] (fake (f a) => a))"
   {:arglists '([call-form arrow result & overrides])}
   [& _]
+  (deprecate "`fake` (and the entire midje.semi-sweet namespace) will be removed in 1.6.")
   (parse-fakes/to-lexical-map-form &form))

 (defmacro data-fake
   "Creates a fake map that's used to associate key/value pairs with a metaconstant"
   {:arglists '([metaconstant arrow contained & overrides])}
   [& _]
+  (deprecate "`data-fake` (and the entire midje.semi-sweet namespace) will be removed in 1.6.")
   (parse-data-fakes/to-lexical-map-form &form))

 (defmacro expect
@@ -91,8 +93,8 @@
    midje.semi-sweet/*include-midje-checks*, or midje.sweet/*include-midje-checks* to false."
   {:arglists '([call-form arrow expected-result & fakes+overrides])}
   [& _]
+  (deprecate "`expect` (and the entire midje.semi-sweet namespace) will be removed in 1.6.")
   (when (user-desires-checking?)
-    (prn "EXPECT MACRO SHOULD BE DEPRECATED")
     (parse-examples/to-lexical-map-form &form)))

@@ -103,7 +105,7 @@
   {:deprecated "1.3-alpha2"
    :arglists '([var-sym & overrides])}
   [var-sym & overrides]
-  (deprecate "`not-called` will be removed in 1.6. Use `(provided (f) => irrelevant :times 0)` instead.")
+  (deprecate "`not-called` (and the entire midje.semi-sweet namespace) will be removed in 1.6. Use `(provided (f) => irrelevant :times 0)` instead.")
   (let [fake-form `(fake (~var-sym) => "doesn't matter" ~@(concat overrides [:times 0]))]
     (with-meta fake-form {:line (meta &form)})))


update header function

update header function

--- src/misaki/html/core.clj
+++ src/misaki/html/core.clj
@@ -184,9 +184,14 @@
   [& s]
   [:p {:class "paragraph"} (map parse-string s)])

-(defn header
-  ([h] [:header [:h1 (link h "/")]])
-  ([h & p] [:header [:h1 (link h "/")] [:p p]]))
+(defn- header-decoration [[first-char & rest-chars]]
+  (list [:span {:class "first_char"} first-char]
+        rest-chars))
+
+(defn header [h & p]
+  [:header
+   [:h1 (link (header-decoration h) "/")]
+   (if p [:p p])])

 (defn container [& body]
   [:div {:class "container"} body])


Always validate test helper for now

Always validate test helper for now

--- src/onyx/test_helper.clj
+++ src/onyx/test_helper.clj
@@ -160,8 +160,7 @@
                                                           :peer-config ~peer-config
                                                           :monitoring-config ~monitoring-config}))]
      (try
-       ;s/with-fn-validation
-       ~@body
+       (s/with-fn-validation ~@body)
        (catch InterruptedException e#
          (Thread/interrupted))
        (catch ThreadDeath e#


agents for computing, ref for pending-votes

--- src/polismath/poller.clj
+++ src/polismath/poller.clj
@@ -83,19 +83,26 @@

 (def conversations (atom {})) ; Will contain zid -> agent(data)

-
-(defn make-math-updater [votes]
+(def pending-votes (ref {})) ; zid -> [votes]
+
+(defn make-math-updater [zid]
   (fn [conv]
-    (let [start (System/currentTimeMillis)]
-        (do
-          (println "starting zid: " (:zid conv))
-          (println conv)
-          (let [foo (conv-update conv votes)
-                end (System/currentTimeMillis)
-                duration (- end start)]
-            (metric "math.pca.compute.ok" duration)
-            (println foo)
-            foo)))))
+    (let [votes (dosync
+                 (let [votes ((deref pending-votes) zid)]
+                   (ref-set pending-votes (dissoc (deref pending-votes) zid))
+                   votes))]
+      (if (empty? votes)
+        conv ; No new votes to process, return conv as-is
+        (let [start (System/currentTimeMillis)
+              conv2 (conv-update conv votes)
+              end (System/currentTimeMillis)
+              duration (- end start)]
+          (metric "math.pca.compute.ok" duration)
+          (println conv2)
+
+          (if (> (:lastVoteTimestamp conv2) (:lastVoteTimestamp conv)) ; basic sanity check. else don't modify.
+            conv2
+            conv))))))

 (defn bid-to-pid-uploader [key iref old_conv conv]
   (println "bid-to-pid-uploader " (:zid conv))
@@ -174,6 +181,15 @@
                       (init-conv-agent zid))
                 ]

+            (dosync
+             (let [old (deref pending-votes)]
+               (ref-set
+                pending-votes
+                (assoc old
+                  zid (if (nil? (old zid))
+                        votes
+                        (concat (old zid) votes))))))
+
             ;; Clear old errors.
             (let [old-error  (agent-error a)]
               (if (not (nil? old-error))
@@ -183,7 +199,7 @@
                     (restart-agent a @a))))

             ;; Enqueue the votes on the agent for that conversation.
-            (send a (make-math-updater votes))
+            (send a (make-math-updater zid))

             (println "zid: " zid)


Change format of infrastructure data, update if already registered.

--- src/pz_discover/util.clj
+++ src/pz_discover/util.clj
@@ -15,9 +15,15 @@

 (defn register-kafka! [client kafka-config]
   (let [kafka-data {:type "infrastructure"
-                    :brokers (get-in kafka-config [:producer "bootstrap.servers"])}]
-    (sm/register-by-name client "kafka" kafka-data)))
+                    :host (get-in kafka-config [:producer "bootstrap.servers"])}]
+    (when-not (sm/register-by-name client "kafka" kafka-data)
+      (sm/update-by-name client "kafka" kafka-data))))

 (defn register-zookeeper! [client zookeeper-config]
-  (let [zk-data (assoc zookeeper-config :type "infrastructure")]
-    (sm/register-by-name client "zookeeper" zk-data)))
+  (let [zk-normalized {:host (format "%s:%s%s"
+                                     (:host zookeeper-config)
+                                     (:port zookeeper-config)
+                                     (:chroot zookeeper-config))}
+        zk-data (assoc zk-normalized :type "infrastructure")]
+    (when-not (sm/register-by-name client "zookeeper" zk-data)
+      (sm/update-by-name client "zookeeper" zk-data))))


Update comment for the new world

Update comment for the new world

--- src/re_frame/events.cljs
+++ src/re_frame/events.cljs
@@ -59,8 +59,8 @@

 (defn register-base
   "register a handler for an event.
-  This is low level and it is expected that \"re-frame.core/def-event\" would
-  generally be used."
+  This is low level and it is expected that a higher level function like
+  \"re-frame.core/def-event\" or  \"re-frame.core/def-event-fx\" would generally be used."
   ([event-id handler-fn]
    (when (contains? @id->fn event-id)
      (console :warn "re-frame: overwriting an event-handler for: " event-id))   ;; allow it, but warn.


fix missing require

fix missing require

--- test/mirthsync/apis_test.clj
+++ test/mirthsync/apis_test.clj
@@ -1,5 +1,5 @@
 (ns mirthsync.apis-test
-  (:require [clojure.data.xml :as cdx]
+  (:require [clojure.data :as cd]
             [clojure.data.zip.xml :as cdzx]
             [clojure.test :as ct]
             [clojure.zip :as cz]
@@ -167,19 +167,19 @@

 (ct/deftest test-add-update-child
   (ct/testing "Update results in identical codetemplate library xml"
-    (let [[a b] (clojure.data/diff
+    (let [[a b] (cd/diff
                  (cz/node codetemplate-libraries-loc)
                  (cz/node (ma/add-update-child codetemplate-libraries-loc codetemplate-library-loc)))]
       (ct/is (= [nil nil] [a b]))))

   (ct/testing "Update results in identical channel group xml"
-    (let [[a b] (clojure.data/diff
+    (let [[a b] (cd/diff
                  (cz/node channel-groups-loc)
                  (cz/node (ma/add-update-child channel-groups-loc channel-group-loc)))]
       (ct/is (= [nil nil] [a b]))))

   (ct/testing "Add results in addition to right side of diff and nothing on left"
-    (let [[a b] (clojure.data/diff
+    (let [[a b] (cd/diff
                  (cz/node channel-groups-loc)
                  (cz/node (ma/add-update-child channel-groups-loc updated-channel-group-loc)))]
       (ct/is (= nil a))


Minor refactor on core tests.

Minor refactor on core tests.

--- test/suricatta/core_test.clj
+++ test/suricatta/core_test.clj
@@ -1,7 +1,7 @@
 (ns suricatta.core-test
   (:require [clojure.test :refer :all]
             [clojure.core.async :refer [<!!]]
-            [suricatta.core :refer :all]
+            [suricatta.core :as sc]
             [suricatta.async :as sca]
             [suricatta.format :refer [get-sql get-bind-values sqlvec] :as fmt]
             [jdbc.core :as jdbc]
@@ -10,127 +10,135 @@
 (def dbspec {:subprotocol "h2"
              :subname "mem:"})

+(def pgdbspec {:subprotocol "postgresql"
+               :subname "//127.0.0.1/test"})
+
+(def ^:dynamic *ctx*)
+
+(defn database-fixture
+  [end]
+  (with-open [ctx (sc/context pgdbspec)]
+    (sc/atomic ctx
+      (binding [*ctx* ctx]
+        (end)
+        (sc/set-rollback! ctx)))))
+
+(use-fixtures :each database-fixture)
+
 (deftest query-execute
-  (with-open [conn (jdbc/make-connection dbspec)]
-    (jdbc/execute! conn "CREATE TABLE foo (n int)")
-    (let [ctx (context conn)]
-      (testing "Execute string directly"
-        (let [r (execute ctx "insert into foo (n) values (1), (2)")]
-          (is (= r 2))))
+  (sc/execute *ctx* "create temporary table foo (n int) on commit drop")

-      (testing "Execute sqlvec directly"
-        (let [r (execute ctx ["insert into foo (n) values (?), (?)" 1 2])]
-          (is (= r 2)))))))
+  (testing "Execute string directly"
+    (let [r (sc/execute *ctx* "insert into foo (n) values (1), (2)")]
+      (is (= r 2))))
+
+  (testing "Execute sqlvec directly"
+    (let [r (sc/execute *ctx* ["insert into foo (n) values (?), (?)" 1 2])]
+      (is (= r 2)))))

 (deftest query-fetch
-  (with-open [ctx (context dbspec)]
-    (testing "Fetch by default vector of records."
-      (let [sql "select x from system_range(1, 3)"
-            r   (fetch ctx sql)]
-        (is (= r [{:x 1} {:x 2} {:x 3}]))))
+  (testing "Fetch by default vector of records."
+    (let [sql "select x from generate_series(1, 3) as x"
+          r   (sc/fetch *ctx* sql)]
+      (is (= r [{:x 1} {:x 2} {:x 3}]))))

-    (testing "Fetch vector of rows"
-      (let [sql    "select x, x+1 as i from system_range(1, 3)"
-            result (fetch ctx sql {:format :row})]
-        (is (= result [[1 2] [2 3] [3 4]]))))
+  (testing "Fetch vector of rows"
+    (let [sql    "select x, x+1 as i from generate_series(1, 3) as x"
+          result (sc/fetch *ctx* sql {:format :row})]
+      (is (= result [[1 2] [2 3] [3 4]]))))

-    (testing "Reuse the statement"
-      (with-open [q (query ctx ["select ? \"x\" from dual" 1])]
-        (is (= (fetch q) [{:x 1}]))
-        (is (= (fetch q) [{:x 1}]))
-        (is (= (execute q) 1))
-        (is (= (execute q) 1))))
-))
+  (testing "Reuse the statement"
+    (with-open [q (sc/query *ctx* ["select ? \"x\"" 1])]
+      (is (= (sc/fetch q) [{:x 1}]))
+      (is (= (sc/fetch q) [{:x 1}]))
+      (is (= (sc/execute q) 1))
+      (is (= (sc/execute q) 1))))
+)
+
+(deftest lazy-fetch
+  (testing "Fetch by default vector of rows."
+    (sc/atomic *ctx*
+            (with-open [cursor (sc/fetch-lazy *ctx* "select x from generate_series(1, 300) as x")]
+              (let [res (take 3 (sc/cursor->lazyseq cursor {:rows true}))]
+                (is (= (mapcat identity (vec res)) [1 2 3]))))))
+
+  (testing "Fetch by default vector of records."
+    (sc/atomic *ctx*
+            (with-open [cursor (sc/fetch-lazy *ctx* "select x from generate_series(1, 300) as x")]
+              (let [res (take 3 (sc/cursor->lazyseq cursor))]
+                (is (= (vec res) [{:x 1} {:x 2} {:x 3}]))))))
+)
+
+(deftest fetch-format
+  (testing "Fetch in csv format"
+    (let [sql "select x, x+1 as i, 'a,b' as k from generate_series(1, 1) as x"
+          result (sc/fetch *ctx* sql {:format :csv})]
+      (is (= (str "x,i,k\n1,2,\"a,b\"\n") result))))
+
+  (testing "Fetch in json format"
+    (let [sql "select x, x+1 as i, 'a,b' as k from generate_series(1, 1) as x"
+          result (sc/fetch *ctx* sql {:format :json})]
+      (is (= (str "{\"fields\":[{\"name\":\"x\",\"type\":\"INT4\"},"
+                  "{\"name\":\"i\",\"type\":\"INT4\"},"
+                  "{\"name\":\"k\",\"type\":\"OTHER\"}],"
+                  "\"records\":[[1,2,\"a,b\"]]}")
+             result))))
+)
+
+(deftest async-support
+  (sc/execute *ctx* "create table foo (n int)")
+  (testing "Execute query asynchronously"
+    (let [result (<!! (sca/execute *ctx* "insert into foo (n) values (1), (2)"))]
+      (is (= result (exc/success 2)))
+      (is (= 1 (deref (.-act *ctx*))))))
+
+  (testing "Fetching query asynchronously"
+    (let [ch      (sca/fetch *ctx* "select * from foo order by n")
+          result1 (<!! ch)
+          result2 (<!! ch)]
+      (is (= result1 (exc/success {:n 1})))
+      (is (= result2 (exc/success {:n 2})))))
+)

 (deftest transactions
   (testing "Execute in a transaction"
-    (with-open [ctx (context dbspec)]
-      (execute ctx "create table foo (id int)")
-      (atomic ctx
-        (execute ctx ["insert into foo (id) values (?), (?)" 1 2])
+    (with-open [ctx (sc/context dbspec)]
+      (sc/execute ctx "create table foo (id int)")
+      (sc/atomic ctx
+        (sc/execute ctx ["insert into foo (id) values (?), (?)" 1 2])
         (try
-          (atomic ctx
-            (execute ctx ["insert into foo (id) values (?), (?)" 3 4])
-            (let [result (fetch ctx "select * from foo")]
+          (sc/atomic ctx
+            (sc/execute ctx ["insert into foo (id) values (?), (?)" 3 4])
+            (let [result (sc/fetch ctx "select * from foo")]
               (is (= 4 (count result))))
             (throw (RuntimeException. "test")))
           (catch RuntimeException e
-            (let [result (fetch ctx "select * from foo")]
+            (let [result (sc/fetch ctx "select * from foo")]
               (is (= 2 (count result)))))))))

   (testing "Execute in a transaction with explicit rollback"
-    (with-open [ctx (context dbspec)]
-      (execute ctx "create table foo (id int)")
-      (atomic ctx
-        (execute ctx ["insert into foo (id) values (?), (?)" 1 2])
-        (atomic ctx
-          (execute ctx ["insert into foo (id) values (?), (?)" 3 4])
-          (let [result (fetch ctx "select * from foo")]
+    (with-open [ctx (sc/context dbspec)]
+      (sc/execute ctx "create table foo (id int)")
+      (sc/atomic ctx
+        (sc/execute ctx ["insert into foo (id) values (?), (?)" 1 2])
+        (sc/atomic ctx
+          (sc/execute ctx ["insert into foo (id) values (?), (?)" 3 4])
+          (let [result (sc/fetch ctx "select * from foo")]
             (is (= 4 (count result))))
-          (set-rollback! ctx))
-        (let [result (fetch ctx "select * from foo")]
+          (sc/set-rollback! ctx))
+        (let [result (sc/fetch ctx "select * from foo")]
           (is (= 2 (count result)))))))

   (testing "Execute in a transaction with explicit rollback"
-    (with-open [ctx (context dbspec)]
-      (execute ctx "create table foo (id int)")
-      (atomic ctx
-        (execute ctx ["insert into foo (id) values (?), (?)" 1 2])
-        (atomic ctx
-          (execute ctx ["insert into foo (id) values (?), (?)" 3 4])
-          (let [result (fetch ctx "select * from foo")]
+    (with-open [ctx (sc/context dbspec)]
+      (sc/execute ctx "create table foo (id int)")
+      (sc/atomic ctx
+        (sc/execute ctx ["insert into foo (id) values (?), (?)" 1 2])
+        (sc/atomic ctx
+          (sc/execute ctx ["insert into foo (id) values (?), (?)" 3 4])
+          (let [result (sc/fetch ctx "select * from foo")]
             (is (= 4 (count result)))))
-        (set-rollback! ctx))
-      (let [result (fetch ctx "select * from foo")]
+        (sc/set-rollback! ctx))
+      (let [result (sc/fetch ctx "select * from foo")]
         (is (= 0 (count result))))))
 )
-
-(deftest lazy-fetch
-  (with-open [ctx (context dbspec)]
-    (testing "Fetch by default vector of rows."
-      (atomic ctx
-        (with-open [cursor (fetch-lazy ctx "select x from system_range(1, 300)")]
-          (let [res (take 3 (cursor->lazyseq cursor {:rows true}))]
-            (is (= (mapcat identity (vec res)) [1 2 3]))))))
-
-    (testing "Fetch by default vector of records."
-      (atomic ctx
-        (with-open [cursor (fetch-lazy ctx "select x from system_range(1, 300)")]
-          (let [res (take 3 (cursor->lazyseq cursor))]
-            (is (= (vec res) [{:x 1} {:x 2} {:x 3}]))))))
-))
-
-(deftest fetch-format
-  (testing "Fetch in csv format"
-    (with-open [ctx (context dbspec)]
-      (let [sql "select x, x+1 as i, 'a,b' as k from system_range(1, 1)"
-            result (fetch ctx sql {:format :csv})]
-        (is (= (str "X,I,K\n1,2,\"a,b\"\n") result)))))
-
-  (testing "Fetch in json format"
-    (with-open [ctx (context dbspec)]
-      (let [sql "select x, x+1 as i, 'a,b' as k from system_range(1, 1)"
-            result (fetch ctx sql {:format :json})]
-        (is (= (str "{\"fields\":[{\"name\":\"X\",\"type\":\"BIGINT\"},"
-                    "{\"name\":\"I\",\"type\":\"BIGINT\"},"
-                    "{\"name\":\"K\",\"type\":\"VARCHAR\"}],"
-                    "\"records\":[[1,2,\"a,b\"]]}")
-               result)))))
-)
-
-(deftest async-support
-  (with-open [ctx (context dbspec)]
-    (execute ctx "create table foo (n int)")
-    (testing "Execute query asynchronously"
-      (let [result (<!! (sca/execute ctx "insert into foo (n) values (1), (2)"))]
-        (is (= result (exc/success 2)))
-        (is (= 1 (deref (.-act ctx))))))
-
-    (testing "Fetching query asynchronously"
-      (let [ch      (sca/fetch ctx "select * from foo order by n")
-            result1 (<!! ch)
-            result2 (<!! ch)]
-        (is (= result1 (exc/success {:n 1})))
-        (is (= result2 (exc/success {:n 2})))))
-))
-


Parsers: fix bad `as-map` post condition (should allow nils)

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -76,7 +76,7 @@
 (defn as-map [coll & [kf vf]]
   {:pre  [(coll? coll) (or (nil? kf) (fn? kf) (identical? kf :keywordize))
                        (or (nil? vf) (fn? vf))]
-   :post [(map? %)]}
+   :post [(or (nil? %) (map? %))]}
   (when-let [s' (seq coll)]
     (let [kf (if-not (identical? kf :keywordize) kf
                      (fn [k _] (keyword k)))]


EXPERIMENTAL: don't attempt to thaw bin data w/o Nippy header

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -11,6 +11,7 @@
   {:author "Peter Taoussanis"}
   (:require [clojure.string         :as str]
             [taoensso.encore        :as encore :refer (doto-cond)]
+            [taoensso.nippy         :as nippy]
             [taoensso.nippy.tools   :as nippy-tools]
             [taoensso.faraday.utils :as utils :refer (coll?*)])
   (:import  [clojure.lang BigInt]
@@ -128,8 +129,18 @@

 ;;;; Coercion - values

-(def ^:private nt-freeze (comp #(ByteBuffer/wrap %) nippy-tools/freeze))
-(def ^:private nt-thaw   (comp nippy-tools/thaw #(.array ^ByteBuffer %)))
+(def ^:private nt-freeze  (comp #(ByteBuffer/wrap %) nippy-tools/freeze))
+;; (def ^:private nt-thaw (comp nippy-tools/thaw #(.array ^ByteBuffer %)))
+
+(defn- nt-thaw [bb]
+  (let [ba          (.array ^ByteBuffer bb)
+        serialized? (#'nippy/try-parse-header ba)]
+    (if-not serialized?
+      ba ; No Nippy header => assume non-serialized binary data (e.g. other client)
+      (try ; Header match _may_ have been a fluke (though v. unlikely)
+        (nippy-tools/thaw ba)
+        (catch Exception e
+          ba)))))

 (encore/defalias with-thaw-opts nippy-tools/with-thaw-opts)
 (encore/defalias freeze         nippy-tools/wrap-for-freezing


Rename construct-note to play-note

Rename construct-note to play-note

--- src/tenor/constructs.clj
+++ src/tenor/constructs.clj
@@ -162,15 +162,15 @@

 ;; --- Playback --- ;;

-(defmacro construct-note [time player entity]
+(defmacro play-note [time player entity]
   "Take time, instrument and note entity as arguments,
   and return overtone code that plays the note."
   `(list 'at ~time (list ~player ~entity)))

 (defmacro construct-piece [entity-maps base-time player pivot-time]
-  "Take an entity map and run construct-note on each
+  "Take an entity map and run play-note on each
   note, creating a list of overtone playback code components."
-  `(map #(construct-note (+ ~pivot-time (* (:pos %) ~base-time))
+  `(map #(play-note (+ ~pivot-time (* (:pos %) ~base-time))
                          ~player (:note %))
         ~entity-maps))


Ring 1.2.2

Ring 1.2.2

--- metrics-clojure-ring/project.clj
+++ metrics-clojure-ring/project.clj
@@ -2,4 +2,4 @@
   :description "Various things gluing together metrics-clojure and ring."
   :dependencies [[cheshire "5.3.1"]
                  [metrics-clojure "1.1.0-SNAPSHOT"]]
-  :profiles {:dev {:dependencies [[ring "1.2.0"]]}})
+  :profiles {:dev {:dependencies [[ring "1.2.2"]]}})


[scamp] Include references to sections of paper in functions

--- modules/scamp/src/scamp/core.clj
+++ modules/scamp/src/scamp/core.clj
@@ -177,6 +177,7 @@
   [downstream :- NodeNeighborsSchema]
   (/ 1 (+ 1 (count downstream))))

+;; TODO: fix function signature, different from every other 'receive-msg fn!
 (s/defn receive-msg-new-subscription :- [MessageEnvelopeSchema]
   "Forward the 'subscription to every :downstream node, duplicating
   the forwarded 'subscription to :connection-redundancy :downstream
@@ -259,7 +260,9 @@
   'envelope-id. Either accept the subscription into :downstream, or
   forward it to a :downstream node.

-  Return a vector matching 'CommUpdateSchema."
+  Return a vector matching 'CommUpdateSchema.
+
+  [1] 2.2.1 Subscription: Algorithm 2"
   [logging-config
    {:keys [downstream] :as node} :- NetworkedNodeSchema
    subscriber-contact-address :- NodeContactAddressSchema
@@ -325,7 +328,9 @@
   subscribing, and a 'node, forward subscription requests
   from 'node.

-  Return 'world with new messages."
+  Return 'world with new messages.
+
+  [1] 2.2.1 Subscription: Algorithm 1"
   [world :- WorldSchema
    new-node-contact-address :- NodeContactAddressSchema
    contact-node-address :- NodeContactAddressSchema]


lein-release plugin: bumped version from 0.76 to 0.77-SNAPSHOT for next development cycle


Version 0.1.7-SNAPSHOT

Version 0.1.7-SNAPSHOT


version 1.0.1

version 1.0.1


Version 0.1.0

Version 0.1.0


Exo draff1

Exo draff1

--- resources/workshop/do-things.clj
+++ resources/workshop/do-things.clj
@@ -126,6 +126,51 @@

 "Pour contourner cette limitation apparente, nous avons le do opérateur:"

+(exercice
+  "Vous ferez face à de nombreuses décisions"
+  [ (= __ (if (false? (= 4 5))
+            :a
+            :b))] :a)
+
+
+(exercice
+  "Certains d'entre eux vous laisse pas d'alternative"
+  [(= __ (if (> 4 3)
+           []))] [])
+
+
+(exercice
+  "Et dans une telle situation, vous pouvez ne rien avoir"
+  [(= __ (if (nil? 0)
+           [:a :b :c]))]nil)
+
+
+(exercice
+  "Dans d'autres cas  votre alternative peut être intéressant"
+  [(= :glory (if (not (empty? ()))
+               :doom
+               __))] :glory)
+
+
+(exercice
+  "Ou votre destin peut être scellé"
+  [(= 'doom (if-not (zero? __)
+              'doom
+              'more-doom))]1)
+
+
+(exercice
+  "En cas d'urgence,sonorez les alarmes "
+  [ (= :sirens
+      (explain-defcon-level __))]:cocked-pistol)
+
+
+(exercice
+  "Mais l'admettre quand vous ne savez pas quoi faire"
+  [(= __
+     (explain-defcon-level :yo-mama))] :say-what?)
+
+
 [[:subsection {:tag "do" :title "do"}]]

 "*do* vous permet de «boucler» des formes multiples. Essayez ce qui suit dans votre REPL:"
@@ -201,7 +246,7 @@
 [[:chapter {:tag "data_structure" :title "Structures de données"}]]

-"Clojure est livré avec une poignée de structures de données qui vous allez vous trouver en utilisant la majorité du temps. Si vous venez d'un milieu orienté objet, vous serez surpris de voir combien vous pouvez faire avec les types " de base " présentés ici.
+"Clojure est livré avec une poignée de structures de données qui vous allez vous trouver en utilisant la majorité du temps. Si vous venez d'un milieu orienté objet, vous serez surpris de voir combien vous pouvez faire avec les types \" de base \" présentés ici.

 Toutes les structures de données Clojure sont immuables, ce qui signifie que vous ne pouvez pas les changer en place. Il ya pas d'équivalent pour la Clojure Ruby suit:"
 (comment
@@ -225,7 +270,7 @@

 [[:section {:tags "nil_true_false_truthiness_equality" :title "nil, true, false,  Equality"}]]

-"Clojure a true et false valeurs. nil est utilisé pour indiquer "aucune valeur" dans Clojure. Vous pouvez vérifier si une valeur est nil avec le intelligemment nommé nil? fonction:"
+"Clojure a true et false valeurs. nil est utilisé pour indiquer \"aucune valeur\" dans Clojure. Vous pouvez vérifier si une valeur est nil avec le intelligemment nommé nil? fonction:"

 (comment
   (nil? 1)
@@ -249,7 +294,7 @@
   )

-"Certains autres langues vous obligent à utiliser différents opérateurs lorsque l'on compare les valeurs de différents types. Par exemple, vous pourriez avoir à utiliser une sorte de l'opérateur spécial "chaîne de l'égalité" particulièrement fait juste pour les chaînes. Vous ne avez pas besoin de quelque chose bizarre ou pénible comme ça pour tester l'égalité lors de l'utilisation des structures de données intégrées de Clojure."
+"Certains autres langues vous obligent à utiliser différents opérateurs lorsque l'on compare les valeurs de différents types. Par exemple, vous pourriez avoir à utiliser une sorte de l'opérateur spécial \"chaîne de l'égalité\" particulièrement fait juste pour les chaînes. Vous ne avez pas besoin de quelque chose bizarre ou pénible comme ça pour tester l'égalité lors de l'utilisation des structures de données intégrées de Clojure."

 [[:section {:tags "nombres" :title "Nombres"}]]

@@ -344,6 +389,66 @@
 "Les vrais Clojurists ne feront presque jamais cela. Cependant, Les vrais Clojurists  utilisent des mots clés pour rechercher les valeurs dans les maps:
 "

+
+(exercice
+  "Une valeur doit être fournie pour chaque clé"
+  [(= {:a 1} (hash-map :a __))] 1)
+
+
+(exercice
+  "La taille est le nombre d'entrées"
+  [(= __ (count {:a 1 :b 2}))] 2)
+
+(exercice
+  "Vous pouvez rechercher la valeur pour une clé donnée"
+  [(= __ (get {:a 1 :b 2} :b))] 2)
+
+
+(exercice
+  "Maps peut êtres utilisé comme une functions pour faire des lookups"
+  [(= __ ({:a 1 :b 2} :a))] 1)
+
+
+(exercice
+  "Et peut être utilisé comme un mot clés"
+  [(= __ (:a {:a 1 :b 2}))] 1)
+
+
+(exercice
+  "Mais les clés d'une map ne sont pas nécessairement des mots clés"
+  [(= __ ({2010 "Vancouver" 2014 "Sochi" 2018 "PyeongChang"} 2014))] "Sochi")
+
+
+(exercice
+  "Vous ne pouvez pas être en mesure de trouver une entrée pour une clé"
+  [(= __ (get {:a 1 :b 2} :c))] nil)
+
+
+(exercice
+  "Mais vous pouvez fournir votre propre valeur par défaut"
+  [(= __ (get {:a 1 :b 2} :c :key-not-found))] :key-not-found)
+
+
+(exercice
+  "Vous pouvez savoir si une clé est présente"
+  [(= __ (contains? {:a nil :b nil} :b))] true)
+
+
+(exercice
+  "Ou si elle est absente"
+  [(= __ (contains? {:a nil :b nil} :c))] false)
+
+
+(exercice
+  "Les maps sont immuables, mais vous pouvez créer une nouvelle version améliorée"
+  [(= {1 "January" 2 __} (assoc {1 "January"} 2 "February"))] "February")
+
+
+
+
+
+
+
 [[:section {:tags "keywords" :title "Mots Clés"}]]

 "Les mots-clés en Clojure sont mieux compris par la façon dont ils sont utilisés. Ils sont principalement utilisés comme clés dans les maps, comme vous pouvez le voir ci-dessus. Exemples de mots clés:"
@@ -420,6 +525,50 @@
   (conj [1 2 3] 4)
   ; => [1 2 3 4]
   )
+
+
+(exercice
+  "Vous pouvez utiliser des vecteurs dans clojure comme des structures de tableau "
+  [(= __ (count [42]))]1)
+
+(exercice
+  "Vous pouvez créer un vecteur à partir d'une liste"
+  [(= __ (vec '(1)))][1])
+
+(exercice
+  "Ou à partir de certains éléments"
+  [(= __ (vector nil nil))][nil nil])
+
+(exercice
+  "Mais vous pouvez le remplir avec n'importe quel nombre d'éléments"
+  [(= [1 __] (vec '(1 2)))] 2)
+
+(exercice
+  "Conjoindre à un vecteur est différent que de conjoindre à une liste"
+  [(= __ (conj [111 222] 333))][111 222 333])
+
+(exercice
+  "Vous pouvez obtenir le premier élément d'un vecteur comme ça"
+  [(= __ (first [:peanut :butter :and :jelly]))]:peanut)
+
+
+(exercice  "Et le dernier d'une façon similaire"
+  [(= __ (last [:peanut :butter :and :jelly]))]:jelly)
+
+(exercice
+  "Ou n'importe quel indice si vous le souhaitez"
+  [(= __ (nth [:peanut :butter :and :jelly] 3))]:jelly)
+
+(exercice
+  "Vous pouvez également découper un vecteur"
+  [(= __ (subvec [:peanut :butter :and :jelly] 1 3))] [:butter :and])
+
+(exercice
+  "L'égalité  des collections est une question de valeurs"
+  [(= (list 1 2 3) (vector 1 2 __))]3)
+
+
+
 [[:section {:tags "listes" :title "Listes"}]]

@@ -464,6 +613,77 @@
 "Quand devriez-vous utiliser une liste et quand faut-il utiliser un vecteur? Pour l'instant, vous êtes probablement mieux de simplement en utilisant des vecteurs. Comme vous en apprendre davantage, vous aurez une bonne idée de quand utiliser quel."

+
+
+(exercice
+
+  "On peut accèder au premier élément..."
+  [(= __ (first '(1 2 3 4 5)))]1)
+
+
+(exercice
+  "Ainsi que le reste"
+  [(= __ (rest '(1 2 3 4 5)))][2 3 4 5])
+
+
+(exercice
+  "Comptez vos bénédictions"
+  [(= __ (count '(dracula dooku chocula)))]3)
+
+
+(exercice
+  "Avant qu'ils ne disparaissent"
+  [(= __ (count '()))]0)
+
+
+(exercice
+
+  "Le reste, quand rien n'est laissé, est vide"
+  [(= __ (rest '(100)))]())
+
+
+(exercice
+
+  "Construction en ajoutant un élément à l'avant est facile"
+  [(= __ (cons :a '(:b :c :d :e)))][:a :b :c :d :e])
+
+
+(exercice
+
+  "Conjoindre un élément à une liste ne est pas difficile non plus"
+  [(= __ (conj '(:a :b :c :d) :e))] [:e :a :b :c :d])
+
+
+(exercice
+
+  "Vous pouvez utiliser une liste comme une pile pour obtenir le premier élément"
+  [(= __ (peek '(:a :b :c :d :e)))]:a)
+
+
+(exercice
+
+  "Ou les autres"
+  [(= __ (pop '(:a :b :c :d :e)))][:b :c :d :e])
+
+
+(exercice
+
+  "Mais attention si vous essayez de rien pop"
+  [(= __ (try
+           (pop '())
+           (catch IllegalStateException e
+             "No dice!")))]"No dice!")
+
+
+(exercice
+
+  "Le reste de rien n'est pas si stricte"
+  (= __ (try
+          (rest '())
+          (catch IllegalStateException e
+            "No dice!"))) ())
+
+
 [[:section {:tags "sets" :title "Sets"}]]

 "Les ensembles sont des collections de valeurs uniques:"
@@ -518,6 +738,32 @@

 "Clojure vous permet également de définir la façon dont un ensemble est trié en utilisant l' sorted-set-by fonction, mais ce livre ne couvre pas que."

+
+(exercice
+  "Vous pouvez créer un ensemble en convertissant une autre collection"
+  [(= #{3} (set __))][3])
+
+(exercice
+  "Compter, c'est comme compter les autres collections"
+  [(= __ (count #{1 2 3}))]3)
+
+(exercice
+  "Rappelez-vous qu'un set est un set * mathématique *"
+  [(= __ (set '(1 1 2 2 3 3 4 4 5 5)))]#{1 2 3 4 5})
+
+(exercice
+  "Vous pouvez demander à clojure l'union de deux ensembles"
+  [(= __ (clojure.set/union #{1 2 3 4} #{2 3 5}))] #{1 2 3 4 5})
+
+(exercice
+  "Et aussi l'intersection"
+  [(= __ (clojure.set/intersection #{1 2 3 4} #{2 3 5}))] #{2 3})
+
+(exercice
+  "Mais ne oubliez pas la différence"
+  [(= __ (clojure.set/difference #{1 2 3 4 5} #{2 3 5}))]#{1 4})
+
+
 [[:section {:tags "symboles_naming" :title "Symboles et Naming"}]]

 "Les symboles sont des identifiants qui sont normalement utilisés pour se référer à quelque chose. Regardons un def exemple:"
@@ -592,7 +838,7 @@

 [[:section {:tags "simplicity" :title "Simplicité"}]]

-"Vous avez peut-être remarqué que ce traitement de structures de données ne comprend pas une description de la façon de créer de nouveaux types ou classes. Ce est parce que l'accent mis sur la simplicité Clojure vous encourage à atteindre pour les structures de données "de base" intégrés dans le premier.
+"Vous avez peut-être remarqué que ce traitement de structures de données ne comprend pas une description de la façon de créer de nouveaux types ou classes. Ce est parce que l'accent mis sur la simplicité Clojure vous encourage à atteindre pour les structures de données \"de base\" intégrés dans le premier.

 Si vous venez d'un milieu orienté objet, vous pourriez penser que cette approche est bizarre et vers l'arrière. Ce que vous trouverez, cependant, ce est que vos données ne ont pas à être bien livré avec une classe pour qu'il soit utile et intelligible. Voici une épigramme aimé par Clojurists qui fait allusion à la philosophie Clojure:"

@@ -1175,13 +1421,17 @@

 "Woohoo!"

+
+
+
+
 [[:chapter {:tags "mise_en_commun" :title "Mise en commun"}]]

 "D'ACCORD! Disons tirer tout cela ensemble et utiliser nos connaissances pour un but noble: la fessée autour hobbits!

 Afin de frapper un hobbit, nous allons d'abord modéliser ses parties du corps. Chaque partie du corps comprendra sa taille par rapport à nous aider à déterminer quelle est la probabilité que cette partie sera frappé.

-Afin d'éviter les répétitions, ce modèle de hobbit ne inclure des entrées pour "pied gauche", "oreille gauche", etc. Par conséquent, nous aurons besoin d'une fonction pour symétriser complètement le modèle.
+Afin d'éviter les répétitions, ce modèle de hobbit ne inclure des entrées pour \"pied gauche\", \"oreille gauche\", etc. Par conséquent, nous aurons besoin d'une fonction pour symétriser complètement le modèle.

 Enfin, nous allons créer une fonction qui parcourt nos parties du corps et choisit au hasard l'un hit.

@@ -1341,8 +1591,8 @@

 Une façon de penser *let* formes, ce est qu'ils fournissent des paramètres et leurs arguments secondaires à côte. *let* formes ont deux utilisations principales:

-*Ils fournissent la clarté en vous permettant de nommer les choses
-*Ils vous permettent d'évaluer une expression qu'une seule fois et ré-utiliser le résultat. Ceci est particulièrement important lorsque vous avez besoin de réutiliser le résultat d'un appel de fonction coûteux, comme un appel d'API de réseau. Il est également important lorsque l'expression a des effets secondaires.
+* Ils fournissent la clarté en vous permettant de nommer les choses
+* Ils vous permettent d'évaluer une expression qu'une seule fois et ré-utiliser le résultat. Ceci est particulièrement important lorsque vous avez besoin de réutiliser le résultat d'un appel de fonction coûteux, comme un appel d'API de réseau. Il est également important lorsque l'expression a des effets secondaires.
 Ayons un autre regard sur  *let* forme dans notre fonction de symétrisation afin que nous puissions comprendre exactement ce qui se passe:"

@@ -1502,7 +1752,6 @@

 2. Commencez boucle sur les parties du corps. La \"queue\" de la séquence sera lié à *remaining-asym-parts* . Initialement, il est lié à la séquence complète passée à la fonction, *asym-body-parts* . Créer une séquence de résultats, *final-body-parts* ; sa valeur initiale est un vecteur vide.

-
 3. Si remaining-asym-parts est vide, cela signifie que nous avons traité la séquence entière et nous pouvons retourner le résultat, *final-body-parts*.

 4. Sinon, diviser la liste en tête, partie , et la queue, *remaining* . En outre, ajouter une *part* à *final-body-parts* de corps et re-lier le résultat du nom *final-body-parts* . Cela peut sembler bizarre, et il est intéressant de comprendre pourquoi cela fonctionne.


Catch up - refactor msg bodies, better job check support, data set validation, check command, etl

--- src/aerobio/server.clj
+++ src/aerobio/server.clj
@@ -84,6 +84,7 @@
    [aerobio.htseq.wgseq   :as htws]
    ;; Validation
    [aerobio.validate.all :as va]
+   [aerobio.validate.datasets :as vds]
    ;; Program graph construction, execution, delivery
    [aerobio.pgmgraph :as pg]
    ;; REST actions
@@ -265,12 +266,20 @@
 (defn job-exists? [jobname]
   (@job-configs jobname))

+(defn get-job-name [exp cmd work-item]
+  (if (= cmd :run)
+    (str (name exp) "-" work-item "-job-template")
+    (str (name exp) "-" (name cmd)"-job-template")))
+
 (defn validate-job [exp cmd work-item]
-  (let [jobname (str (name exp) "-" work-item "-job-template")]
+  (let [jobname (get-job-name exp cmd work-item)]
     (if (job-exists? jobname)
       ""
-      (format "No job for experiment type '%s' with cmd '%s' for '%s'"
-              (name exp) cmd work-item))))
+      (if (= cmd :run)
+        (format "No job for experiment type '%s' with cmd '%s' for phase '%s'"
+                (name exp) (name cmd) work-item)
+        (format "No job for experiment type '%s' with cmd '%s'"
+                (name exp) (name cmd))))))

 (defn get-jobinfo [jobname]
   (assert (@job-configs jobname)
@@ -318,6 +327,7 @@
    (fn[v]
      (cond
        (isa? (type v) clojure.lang.Atom) (recur (deref v))
+       (isa? (type v) clojure.core.async.impl.channels.ManyToManyChannel) :chan
        (coll? v) (valuefy v)
        (not (future? v)) v
        (future-done? v) (deref v)
@@ -362,14 +372,18 @@
 (defmulti user-msg :op)

 (defmethod user-msg :default [msg]
-  (infof "ERROR: unknown user message %s" msg)
-  #_(srv/send-msg
-     (msg :ws) {:op "error" :payload "ERROR: unknown user message"}))
+  (let [params (msg :params)
+        {:keys [ws user eid action]} params]
+    (infof "ERROR: unknown user message %s" msg)
+    (send-end-msg
+     ws {:op :error
+         :payload (format "unknown user-msg '%s'" (msg :op))})))

 (defmethod user-msg :status [msg]
   (let [params (msg :params)
         {:keys [ws user eid action]} params]
+    #_(infof "STATUS %s" params)
     (let [jinfo (hc/get-db (atom (valuefy @job-db)) [user eid action])
           result (if (seq jinfo)
                    (->> jinfo (sort-by #(-> % :request :timestamp))
@@ -391,13 +405,64 @@
                                          (with-out-str (pprint status)))
                                         (format
                                          "Finished:\n%s\nFinal result:\n%s"
-                                         (with-out-str (pprint status))
-                                         (with-out-str (pprint res))))]
+                                         (with-out-str
+                                           (pprint (status :DONE [])))
+                                         (with-out-str
+                                           (pprint res))))]
                              (with-out-str
                                (print (format "%s : %s started @ %s\n%s"
                                               eid action timestamp rstg))))
                           result)))]
       (send-end-msg ws {:op :status :payload retmsg}))))
+
+
+(defn user-msg-body [ws user eid action params]
+  (let [action (name action)
+        vmsg (va/validate-exp eid action)]
+    (if (not-empty vmsg)
+      (send-end-msg ws {:op :validate :payload vmsg})
+      (let [{:keys [cmd eid template]} params
+            dt (date-time-stg)
+            resmap (actions/action cmd eid params get-toolinfo template)
+            resfut (resmap :fut)
+            jobdb-info (or (get-jdb [user eid action]) [])]
+        (aerial.utils.misc/sleep 250)
+        (swap! dbg (fn[M] (assoc M eid resmap)))
+        (infof "%s : %s" cmd (prn-str resfut))
+        (update-jdb [user eid action]
+                    (conj jobdb-info
+                          {:request {:timestamp dt
+                                     :params (dissoc params :ws)}
+                           :status (resmap :status)
+                           :result resfut}))
+        (if (and (future-done? resfut) (map? @resfut) (@resfut :error))
+          (let [cause (->> (or (@resfut :msg) (prn-str (@resfut :error)))
+                           (str "Job Launch : "))]
+            (srv/send-msg ws {:op :error :payload cause}))
+          (srv/send-msg ws {:op :launch :payload "Successful"}))
+        (srv/send-msg ws {:op :stop :payload {}} :noenvelope true)))))
+
+
+(defmethod user-msg :aggregate [msg]
+  (let [params (msg :params)
+        {:keys [ws user eid compfile]} params]
+    (infof "AGGREGATE: %s" params)
+    (user-msg-body ws user eid (params :cmd) params)
+    #_(send-end-msg ws {:op :status :payload "Aggregating"})))
+
+(defmethod user-msg :xcompare [msg]
+  (let [params (msg :params)
+        {:keys [ws user eid compfile]} params]
+    (infof "XCOMPARE: %s" params)
+    (user-msg-body ws user eid (params :cmd) params)
+    #_(send-end-msg ws {:op :status :payload "Xcomparing"})))
+
+(defmethod user-msg :compare [msg]
+  (let [params (msg :params)
+        {:keys [ws user eid compfile]} params]
+    (infof "COMPARE: %s" params)
+    (user-msg-body ws user eid (params :cmd) params)
+    #_(send-end-msg ws {:op :status :payload "Comparing"})))

 (defmethod user-msg :run [msg]
@@ -429,14 +494,30 @@
           (srv/send-msg ws {:op :stop :payload {}} :noenvelope true))))))

+(defmethod user-msg :check [msg]
+  (let [params (msg :params)
+        {:keys [ws user eid]} params]
+    (infof "CHECK: %s" params)
+    (let [vmsg (vds/validate-expexists eid)
+          vmsg (if (empty? vmsg) (va/validate-sheets-exist eid) vmsg)]
+      (if (not-empty vmsg)
+        (send-end-msg ws {:op :validate :payload vmsg})
+        (let [_ (cmn/set-exp eid)
+              vmsg (va/validate-exp eid "all")]
+          (if (not-empty vmsg)
+            (send-end-msg ws {:op :validate :payload vmsg})
+            (send-end-msg ws {:op :validate :payload "All checks pass!"})))))))
+
+
 (defn msg-handler [msg]
   (let [{:keys [ws data]} msg
         {:keys [op data]} data
         {:keys [user cmd phase modifier compfile eid action]} data
         eid (if (str/ends-with? eid "/") (austr/butlast 1 eid) eid)
         eid (if (str/starts-with? eid "/") (austr/drop 1 eid) eid)
-        params {:user user, :cmd op, :modifier modifier
-                :phase phase, :action action :eid eid :ws ws}]
+        params {:user user, :cmd op, :eid eid
+                :phase phase, :action action :compfile compfile
+                :modifier modifier, :ws ws}]
     (infof "MSG-HANDLER: MSG %s" (msg :data))
     (try
       (case op
@@ -444,11 +525,12 @@
         (do (infof "WS: %s, sending stop msg" ws)
             (srv/send-msg ws {:op :stop :payload {}} :noenvelope true))

-        (:status "status")
+        (:status :check)
         (user-msg {:op op :params params})

-        ;;null for now
-        (let [vmsg (va/validate-sheets-exist eid)]
+        (:run :compare :xcompare :aggregate)
+        (let [vmsg (vds/validate-expexists eid)
+              vmsg (if (empty? vmsg) (va/validate-sheets-exist eid) vmsg)]
           (if (not-empty vmsg)
             (send-end-msg ws {:op :validate :payload vmsg})
             (let [_ (cmn/set-exp eid)
@@ -456,11 +538,13 @@
                   vmsg (validate-job exp op (or phase compfile))]
               (if (not-empty vmsg)
                 (send-end-msg ws {:op :validate :payload vmsg})
-                (let [work-item (or phase cmd)
-                      tempnm (str (name exp) "-" work-item "-job-template")
+                (let [tempnm (get-job-name exp op (or phase compfile))
                       template (get-jobinfo tempnm)
                       params (assoc params :template template)]
-                  (user-msg {:op op :params params})))))))
+                  (user-msg {:op op :params params}))))))
+
+        (send-end-msg
+         ws {:op :error :payload (format "No such cmd '%s'" (name op))}))
       (catch Error e
         (errorf "ERROR %s: %s, %s" eid op (or (.getMessage e) e))
         (send-end-msg ws {:op :validate :payload (.getMessage e)}))


Add get-jobinfo

Add get-jobinfo

--- src/aerobio/server.clj
+++ src/aerobio/server.clj
@@ -585,6 +585,11 @@
   (merge {:inputOption "" :options "" :args ""}
          (@tool-configs toolname)))

+(defn get-jobinfo [jobname]
+  (assert (@job-configs jobname)
+          (format "No such job %s" jobname))
+  (@job-configs jobname))
+

 (defn flow-program
   ""


Only consider clock sources for Traktor beat phase

CC values on controller zero were getting random controllers marked as
potential beat phase sources, leading to null pointer exceptions!

--- src/afterglow/midi.clj
+++ src/afterglow/midi.clj
@@ -240,7 +240,7 @@
   [msg device-key]
   (when (= (:command msg) :control-change)
     (let [controller (:note msg)]
-      (cond (and (zero? controller) (< (:velocity msg) 5))
+      (cond (and (get @clock-sources device-key) (zero? controller) (< (:velocity msg) 5))
             (swap! clock-sources assoc-in [device-key :master] (:velocity msg))

             (= controller (get-in @clock-sources [device-key :master]))


quieter bootstrapping

quieter bootstrapping

--- src/Makefile.boot
+++ src/Makefile.boot
@@ -21,8 +21,10 @@
 	typechecker \
 	tests

-FSTAR_C=$(FSTAR) $(OTHERFLAGS) --cache_checked_modules --eager_inference --lax --MLish --no_location_info \
-		   --odir ocaml-output $(addprefix --include , $(INCLUDE_PATHS))
+FSTAR_C=$(FSTAR) $(OTHERFLAGS) --cache_checked_modules	        	\
+        --eager_inference --lax --MLish --no_location_info              \
+	--odir ocaml-output $(addprefix --include , $(INCLUDE_PATHS))   \
+        --warn_error -271-240

 # Each "project" for the compiler is in its own namespace.  We want to
 # extract them all to OCaml.  Would be more convenient if all of them


Add Duplicate Question Query

Add Duplicate Question Query

--- dev/user.clj
+++ dev/user.clj
@@ -69,3 +69,51 @@
   (pst)
   )

+(defn same-item-group? [[i1 i2]]
+  (= (:item/item-group i1) (:item/item-group i2)))
+
+(defn a2? [[i1 i2]]
+  (and
+    (contains? (set (map :study/id (-> i1 :item/item-group :item-group/form :form/studies))) "A2")
+    (contains? (set (map :study/id (-> i2 :item/item-group :item-group/form :form/studies))) "A2")))
+
+(defn show-item-pair [[i1 i2]]
+  [(:item/question i1)
+   (:item/id i1)
+   (:item/id i2)])
+
+(defn common-question? [[q]]
+  (re-find #"Erfassender|Erfassungsdatum|Bemerkungen|Uhrzeit Ende" q))
+
+(comment
+  (def conn (connect))
+  (def db (d/db conn))
+  (def res1 (d/q '[:find ?i1 ?i2
+                   :where
+                   [?i1 :item/question ?q1]
+                   [?i2 :item/question ?q2]
+                   [(< ?i1 ?i2)]
+                   [(= ?q1 ?q2)]] db))
+  (count res)
+
+  (->> (d/q '[:find [?id ...]
+              :where
+              [?s :study/id "A2"]
+              [?f :form/studies ?s]
+              [?f :form/id ?id]] db)
+       (sort)
+       (last))
+
+  (->> res
+       (map #(mapv (partial d/entity db) %))
+       (remove same-item-group?)
+       (filter a2?)
+       (map show-item-pair)
+       (remove common-question?)
+       (group-by first)
+       (map-vals #(->> (map rest %) (flatten) (set) (sort)))
+       (sort-by first)
+       (map (fn [[q items]] (str/join "," (cons (str \" q \") items))))
+       (str/join "\n")
+       (spit "duplicates.csv"))
+  )


Add task name and package to deftask'ed functions

--- src/cake/core.clj
+++ src/cake/core.clj
@@ -39,10 +39,11 @@
      (do-something-else))"
   [name & forms]
   (verify (not (implicit-tasks name)) (str "Cannot redefine implicit task: " name))
-  (let [{:keys [deps docs actions destruct pred]} (parse-task-opts forms)]
+  (let [{:keys [deps docs actions destruct pred]} (parse-task-opts forms)
+        fn-name (symbol (str (ns-name *ns*) "_" name))]
     `(append-task! '~name ~(conj {:deps deps :docs docs}
                                  (when (seq actions)
-                                   `{:actions [(fn [~destruct]
+                                   `{:actions [(fn ~fn-name [~destruct]
                                                  (when ~pred ~@actions))]})))))

 (defn- in-ts [ts task-decl]


Use coll? instead of seq? function.

Use coll? instead of seq? function.

--- src/cbfg/vis.cljs
+++ src/cbfg/vis.cljs
@@ -82,10 +82,10 @@
                nil)}
    :aalts
    {:before (fn [vis actx [ch-names ch-bindings]]
-              (let [; The ch-actions will be [[ch :take] [ch :put] ...].
-                    ch-actions (map #(if (seq? %) [(first %) :put (second %)] [% :take])
+              (let [; The ch-actions will be [[ch :take] [ch :put msg] ...].
+                    ch-actions (map #(if (coll? %) [(first %) :put (second %)] [% :take])
                                     ch-bindings)
-                    use-names (and (seqable? ch-names)
+                    use-names (and (coll? ch-names)
                                    (= (count ch-names)
                                       (count ch-bindings)))]
                 (apply concat
@@ -103,9 +103,9 @@
                                            ch-actions)))))
     :after (fn [vis actx [ch-names ch-bindings [result-msg result-ch]]]
              (let [; The ch-actions will be [[ch :take] [ch :put] ...].
-                   ch-actions (map #(if (seq? %) [(first %) :put (second %)] [% :take])
+                   ch-actions (map #(if (coll? %) [(first %) :put (second %)] [% :take])
                                    ch-bindings)
-                   use-names (and (seqable? ch-names)
+                   use-names (and (coll? ch-names)
                                   (= (count ch-names)
                                      (count ch-bindings)))]
                (doall (map-indexed (fn [idx [ch action]]


generate rent transactions

generate rent transactions

--- src/clj_money/seed.clj
+++ src/clj_money/seed.clj
@@ -95,6 +95,7 @@
                          "FIT"
                          "Social Security"
                          "Medicare"
+                         "Rent"
                          "Checking"]
                         (map (fn [account-name]
                                [(keywordize account-name)
@@ -111,4 +112,19 @@
                   (map #(periodic-seq % Months/ONE))
                   (apply interleave)
                   (take 24)
-                  (map #(generate-salary-transaction s entity % accounts)))))))
+                  (map #(generate-salary-transaction s entity % accounts))))
+
+      ; Rent
+      (dorun (->> (periodic-seq (t/plus start-date Days/ONE) Months/ONE)
+                  (take 12)
+                  (map #(transactions/create
+                          s
+                          {:entity-id (:id entity)
+                           :transaction-date %
+                           :description "Landloard"
+                           :items [{:action :debit
+                                    :account-id (-> accounts :rent :id)
+                                    :amount 750M}
+                                   {:action :credit
+                                    :account-id (-> accounts :checking :id)
+                                    :amount 750M}]})))))))


Add support for HTTP POST, headers, and bodies.

--- src/frmr/dstt.clj
+++ src/frmr/dstt.clj
@@ -2,7 +2,8 @@
   (:import [java.io PushbackReader])
   (:require [clj-http.client :as client]
             [clojure.tools.cli :refer [parse-opts]]
-            [clojure.java.io :as io])
+            [clojure.java.io :as io]
+            [clojure.string :refer [split]])
   (:gen-class))

 (defn- basic-handler
@@ -18,19 +19,20 @@
   (int (/ (apply + numbers) (count numbers))))

 (defn- issue-timed-request
-  "Issue a timed request to a url within a future after sleeping the future for a specified amount
-  of time. Then pass the elapsed time and the content of the request through the `handler` to get
-  a vector of timing results - where each member of the vector represents one category timing."
-  [url pause handler]
+  "Issue a timed request by invoking request-invoker within a future after sleeping the future for a
+  specified amount of time. Then pass the elapsed time and the content of the request through the
+  `handler` to get a vector of timing results - where each member of the vector represents one
+  category timing."
+  [request-invoker pause handler]
   (future (let [slept (Thread/sleep pause)
                 start (System/nanoTime)
-                content (client/get url)
+                content (request-invoker)
                 stop (System/nanoTime)
                 elapsed-time-in-ms (int (/ (- stop start) 1000000))]
             (handler elapsed-time-in-ms content))))

 (defn- load-test-url
-  "Execute number-of-requests requests against the url with a pause-between-requests pause between
+  "Execute number-of-requests requests using the request-invoker with a pause-between-requests pause between
   them. This execution happens in futures so that if we're simulating a decent amount of load that
   load should be able to happen in parallel.

@@ -39,10 +41,10 @@
   member represents one timing category from the request. So, if you're querying a JSON API that
   surfaces a bit of timing information in the response, you might query that JSON and generate a
   vector from the information you find there in your handler."
-  [url number-of-requests pause-between-requests handler]
+  [request-invoker number-of-requests pause-between-requests handler]
   (let [request-indicies (range number-of-requests)
         request-delays (map #(* % pause-between-requests) request-indicies)
-        request-futures (map #(issue-timed-request url % handler) request-delays)
+        request-futures (map #(issue-timed-request request-invoker % handler) request-delays)
         result-timings (map #(deref %) request-futures)
         grouped-result-categories (partition (count result-timings) (apply interleave result-timings))
         average-timing-per-category (map #(-> % (average) (str "ms")) grouped-result-categories)]
@@ -74,8 +76,29 @@
     :id :handler
     :default nil]

-   ;; A boolean option defaulting to nil
-   ["-h" "--help"]])
+   ["-h" "--help"]
+
+   ["-v" "--verbose"]])
+
+(defn- select-function-for-http-method
+  [http-method]
+  (cond
+    (= "POST" http-method)
+    client/post
+
+    :else
+    client/get))
+
+(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 #": ")]
+    {:headers {header-name header-value}}))
+
+(defn- parse-body
+  "Parse a body string from the command line into a map for the http library."
+  [body]
+  {:body body})

 (defn -main
   "Main entry point.
@@ -98,10 +121,21 @@
       :else
       (let [{requests :requests
              seconds :time
-             handler :handler} (:options parsed-options)
+             handler :handler
+             http-method :method
+             http-header :header
+             http-body :body
+             verbose :verbose} (:options parsed-options)
             [url] (:arguments parsed-options)
             milliseconds (* seconds 1000)
             pause-between-requests (/ milliseconds requests)
+
+            client-request-method (select-function-for-http-method http-method)
+            request-options (merge (some-> http-header parse-header)
+                                   (some-> http-body parse-body)
+                                   {:follow-redirects false})
+            request-invoker (fn [] (client-request-method url request-options))
+
             [parsed-handler custom-handler-name] (if-not (nil? handler)
                                                    [(eval (read (PushbackReader. (io/reader handler))))
                                                     handler]
@@ -109,7 +143,8 @@
                                                     nil])]
         (println (str "Running a load test of " url))
         (println (str requests " requests spread over " seconds " seconds."))
+        (if verbose (println (str "Request options: " request-options)))
         (if custom-handler-name (println (str "Using custom handler: " custom-handler-name)))
         (println "")
-        (load-test-url url requests pause-between-requests parsed-handler)
+        (load-test-url request-invoker requests pause-between-requests parsed-handler)
         (System/exit 0)))))