variable checks

variable checks

--- src/clojee/core.clj
+++ src/clojee/core.clj
@@ -1,24 +1,26 @@
 (ns clojee.core)

 ; syntax
-;   (let* [a v1 b v2 c v3] form)
-;   (do form1 form2 form3)
-;   (fn* [a b c] form)
-;   (def q form)
-;   (set! x form)
-;   (loop* [x v1 y v2] form_including_recur)
+;   {let* [a v1 b v2 c v3] form}
+;       warning: shadowing outer variable
+;       error: duplicate names
+;       error: in values of bindings, form
+;   {def q form}
+;       error: q already defined
+;   q
+;       error: q not resolvable
+;   (f x y)
+;   {do form1 form2 form3}
+;   {fn* [a b c] form}
+;       error: duplicate names
+;   {set! x form}
+;   {loop* [x v1 y v2] form_including_recur}
 ;       - no recur: warning, suggest let*
 ;       - nested loops: warning, recur may not work as expected
 ;       - duplicate var names: error
-;   (if pred then else)
-;     (if true  a b) -> a
-;     (if false a b) -> b
-
-(defn make-let
-  [bindings body]
-  {:type "let*"
-   :bindings bindings
-   :body body})
+;   {if pred then else}
+;     {if true  a b} -> a
+;     {if false a b} -> b

 (defn make-do
   [forms]
@@ -30,12 +32,6 @@
   {:type "fn*"
    :params symbols
    :body body})
-
-(defn make-def
-  [symbol value]
-  {:type "def"
-   :symbol symbol
-   :value value})

 (defn make-set!
   [symbol value]
@@ -56,6 +52,18 @@
    :bindings bindings
    :form form})

+(defn make-let
+  [bindings body]
+  {:type "let*"
+   :bindings bindings
+   :body body})
+
+(defn make-def
+  [symbol value]
+  {:type "def"
+   :symbol symbol
+   :value value})
+
 (defn make-app
   [f args]
   {:type "application"
@@ -64,20 +72,29 @@

 (def eg1
-  [(make-def 'id (make-fn '(x) 'x))
+  [;(make-def 'id (make-fn '(x) 'x))
+;   (make-def 'a 'True)
+;   (make-def 'b 'False)
+;   (make-def 'z (make-app 'a '[a b c]))
+   (make-def 'f 'True)
    (make-app 'f '[x y])
-   (make-let '[[f g] [x z]] (make-app 'f '[x y]))
-   (make-def '. (make-fn '(f g x) '(f (g x))))
-   (make-def 'd (make-fn '(x) '(x x)))
-   (make-def 't (make-fn '(f x) '(. f f x)))])
+   (make-let '[[f g]] (make-let '[[f h]] 'q))
+;   (make-let '[[f g] [f h]] 'f)
+;   (make-let '[[f g] [x z]] (make-app 'f '[x y]))])
+;   (make-def '. (make-fn '(f g x) '(f (g x))))
+;   (make-def 'd (make-fn '(x) '(x x)))
+;   (make-def 't (make-fn '(f x) '(. f f x)))])
+  ])

 (defn my-resolve
-  [sym env]
+  [sym env state]
   (cond
-    (nil? env) nil
+    (nil? env)
+      (if (contains? (state :bindings) sym)
+          "root state")
     (contains? (env :bindings) sym) (env :depth)
-    :else (recur sym (env :parent))))
+    :else (recur sym (env :parent) state)))

 (defn new-env
   [bindings old-env]
@@ -90,37 +107,61 @@

 (defn f-symbol
-  [node log env]
-  (cons {:symbol node,
-         :type "symbol",
-         :resolution (my-resolve node env)}
-        log))
+  [node log env state]
+  [(cons {:symbol node,
+          :type "symbol",
+          :resolution (my-resolve node env state)}
+         log)
+   state])
+
+(defn is-deffed
+  [symbol log bindings]
+  (cons {:type "def-check" :symbol symbol
+         :is-deffed (contains? bindings symbol)} log))

 (defn f-def
-  [node log env]
-  ; todo: ... everything! ...
-  log)
-
+  [node log env state]
+  (let [log-2 (is-deffed (node :symbol) log (state :bindings))
+        state-2 {:bindings (conj (state :bindings) (node :symbol))}] ; TODO is there a better way to copy most of a table, changing only 1 key?
+    (f-node (node :value) log-2 env state-2)))
+
 (defn m-seq
-  [nodes log env]
-  (loop [log-n log node-n nodes]
-    (if (empty? node-n)
-        log-n
-        (recur (f-node (first node-n) log-n env) (rest node-n)))))
+  ([nodes log env state] (m-seq f-node nodes log env state))
+  ([f nodes log env state]
+   (loop [log-n log node-n nodes state-n state]
+     (if (empty? node-n)
+         [log-n state-n]
+         (let [[log-z state-z] (f (first node-n) log-n env state-n)]
+           (recur log-z (rest node-n) state-z))))))
+
+(defn shadowing?
+  [sym log env state]
+  (let [r (my-resolve sym env state)]
+    (if (nil? r)
+        [log state]
+        [(cons {:type "shadowing" :symbol sym :location r} log)
+         state])))

 (defn f-let
   "recurs on: value of each binding, form"
   ; todo: unique symbols?
-  [node log env]
-  (let [log-2 (m-seq (map second (node :bindings)) log env)]
-    (f-node (node :body)
-            log-2
-            (new-env (apply hash-set (map first (node :bindings))) env))))
+  [node log env state]
+  (let [syms (map first (node :bindings))
+        [log-1 state-1] (m-seq shadowing? syms log env state)]
+    (let [[log-2 state-2] (m-seq (map second (node :bindings)) log-1 env state-1)]
+      (let [sym-set (apply hash-set syms)
+            log-3 (if (not (= (count syms) (count sym-set)))
+                      (cons {:type "duplicate symbol in let", :symbols syms} log-2)
+                      log-2)]
+        (f-node (node :body)
+                log-3
+                (new-env sym-set env)
+                state-2)))))

 (defn f-app
-  [node log env]
-  (let [log2 (f-node (node :function) log env)]
-    (m-seq (node :arguments) log2 env)))
+  [node log env state]
+  (let [[log-2 state-2] (f-node (node :function) log env state)]
+    (m-seq (node :arguments) log-2 env state-2)))

 (def actions
  {"symbol"      f-symbol
@@ -136,20 +177,29 @@
     :else (throw (new Exception (str "unrecognized node -- " (if (nil? node) "nil" node))))))

 (defn f-node
-  [node log env]
-  (do (prn (str "checking ..." node " in " env)))
+  [node log env state]
+;  (do (prn (str "checking ..." node " in " env)))
   (let [type (my-type node)]
     (if (contains? actions type)
-        ((actions type) node log env)
+        ((actions type) node log env state)
         (throw (new Exception (str "unrecognized node type -- " node))))))

-(def root-env (new-env #{'z} {:depth 0}))
+(def root-env (new-env #{} {:depth 0}))
+(def root-state {:bindings '#{True False}})

 (defn run-eg
   ([] (run-eg (second eg1)))
-  ([node] (run-eg node '() root-env))
-  ([node log env]
-   (doseq [x (f-node node log env)]
-     (prn x))))
-
+  ([node] (run-eg node '() root-env root-state))
+  ([log env state]
+    (m-seq eg1 log env state))
+  ([node log env state]
+    (f-node node log env state)))
+
+(defn prn-eg
+  [& args]
+   (let [[l s] (apply run-eg args)]
+     (doseq [x l]
+       (prn x))
+     (prn s)))
+


n-ary variant of implicit, or less strict macro parsing ?

--- src/latte/equal.clj
+++ src/latte/equal.clj
@@ -7,6 +7,7 @@
    [latte-kernel.syntax :as stx]
    [latte-kernel.norm :as norm]
    [latte-kernel.typing :as ty]
+   [latte.utils :refer [decomposer]]
    [latte.core :as latte :refer [definition defthm defimplicit
                                           assume have qed proof]]
    [latte.prop :as p :refer [<=> and or not]]))
@@ -18,7 +19,6 @@
   (forall [P (==> T :type)]
     (<=> (P x) (P y))))

-
 (defimplicit equal
   "Equality of `x` and `y` (which must be of the same type `T`).
 This is an implicit version of [[equal%]]."
@@ -26,21 +26,17 @@
   (list #'equal% x-ty x y))

 (defn decompose-equal-type [def-env ctx t]
-  (if (clojure.core/and (seq t)
-                        (= (count t) 4)
-                        (= (first t) #'latte.equal/equal%))
-    [(second t) (nth t 2) (nth t 3)]
-    (let [[t ok?] (norm/delta-step def-env t)]
-      ;; (println "[decompose-equal-type] delta-term=" t " (reduced ? " ok? ")")
-      (if ok?
-        (recur def-env ctx t)
-        (let [[t ok?] (norm/beta-step t)]
-          (if ok?
-            (recur def-env ctx t)
-            ;; XXX: cannot decompose further because
-            ;; we cannot retrieve the x and y of the
-            ;; definition ... add dummy witnesses ?
-            (throw (ex-info "Cannot infer an equal-type" {:type t}))))))))
+  (decomposer
+   (fn [t]
+     (if (clojure.core/and (seq t)
+                           (= (count t) 4)
+                           (= (first t) #'latte.equal/equal%))
+       [(second t) (nth t 2) (nth t 3)]
+       ;; XXX: cannot decompose further because
+       ;; we cannot retrieve the x and y of the
+       ;; definition ... add dummy witnesses ?
+       (throw (ex-info "Cannot infer an equal-type" {:type t}))))
+   def-env ctx t))

 (defthm eq-refl%
   "The reflexivity property of equality."
@@ -54,8 +50,8 @@

 (defimplicit eq-refl
   "Equality is reflexive."
-  [def-env ctx [x x-ty] [y y-ty]]
-  (list #'eq-refl% x-ty x y))
+  [def-env ctx [x x-ty]]
+  (list #'eq-refl% x-ty x x))

 (defthm eq-sym%
   "The symmetry property of equality."
@@ -70,91 +66,62 @@
     (have <b> (<=> (P y) (P x)) :by (p/iff-sym <a>)))
   (qed <b>))

-(defspecial eq-sym%
-  "Symmetry of equality, a special version of [[eq-sym]]."
-  [def-env ctx eq-term]
-  (let [[status ty] (ty/type-of-term def-env ctx eq-term)]
-    (if (= status :ko)
-      (throw (ex-info "Cannot type term." {:special 'latte.prop/eq-sym%
-                                           :term eq-term
-                                           :from ty}))
-      (do
-        (let [[status T x y] (decompose-equal-type def-env ctx ty)]
-          (if (= status :ko)
-            (throw (ex-info "Cannot infer an `equal`-type." {:special 'latte.prop/eq-sym%
-                                                             :term eq-term
-                                                             :type ty}))
-            [(list #'eq-sym T x y) eq-term]))))))
-
-(defthm eq-trans
+(defimplicit eq-sym
+  "Symmetry of equality, an implicit version of [[eq-sym%]]."
+  [def-env ctx [eq-term eq-ty]]
+  (let [[T x y] (decompose-equal-type def-env ctx eq-ty)]
+    [(list #'eq-sym% T x y) eq-term]))
+
+(defthm eq-trans%
   "The transitivity property of equality."
   [[T :type] [x T] [y T] [z T]]
-  (==> (equal T x y)
-       (equal T y z)
-       (equal T x z)))
-
-(proof eq-trans :script
-  (assume [H1 (equal T x y)
-           H2 (equal T y z)
+  (==> (equal% T x y)
+       (equal% T y z)
+       (equal% T x z)))
+
+(proof 'eq-trans% :script
+  (assume [H1 (equal x y)
+           H2 (equal y z)
            P (==> T :type)]
-    (have a (<=> (P x) (P y)) :by (H1 P))
-    (have b (<=> (P y) (P z)) :by (H2 P))
-    (have c (<=> (P x) (P z))
-          :by ((p/iff-trans (P x) (P y) (P z)) a b))
-    (qed c)))
-
-
-(defspecial eq-trans%
-  "Transitivity of `equal`, a special version of [[eq-trans]]."
-  [def-env ctx eq-term1 eq-term2]
-  (let [[status ty1] (ty/type-of-term def-env ctx eq-term1)]
-    (when (= status :ko)
-      (throw (ex-info "Cannot type term." {:special 'latte.prop/eq-trans%
-                                           :term eq-term1
-                                           :from ty1})))
-    (let [[status ty2] (ty/type-of-term def-env ctx eq-term2)]
-      (when (= status :ko)
-        (throw (ex-info "Cannot type term." {:special 'latte.prop/eq-trans%
-                                             :term eq-term2
-                                             :from ty2})))
-      (let [[status T1 x1 y1] (decompose-equal-type def-env ctx ty1)]
-        (when (= status :ko)
-          (throw (ex-info "Cannot infer an `equal`-type." {:special 'latte.prop/eq-trans%
-                                                           :term eq-term1
-                                                           :type ty1})))
-        (let [[status T2 x2 y2] (decompose-equal-type def-env ctx ty2)]
-          (when (= status :ko)
-            (throw (ex-info "Cannot infer an `equal`-type." {:special 'latte.prop/eq-trans%
-                                                             :term eq-term2
-                                                             :type ty2})))
-          ;; XXX: these are redundant and probably take time ...
-          #_(when-not (norm/beta-eq? def-env ctx T1 T2)
-            (throw (ex-info "Equal type mismatch"
-                            {:special 'latte.prop/eq-trans%
-                             :left-type T1
-                             :right-type T2})))
-          #_(when-not (norm/beta-eq? def-env ctx y1 x2)
-            (throw (ex-info "Term in the middle mismatch"
-                            {:special 'latte.prop/eq-trans%
-                             :left-rhs-term y1
-                             :right-lhs-term x2})))
-          [[(list #'eq-trans T1 x1 y1 y2) eq-term1] eq-term2])))))
-
-(defspecial eq-trans*
-  "Transitivity of `equal`, a n-ary version of [[eq-trans%]].
+    (have <a> (<=> (P x) (P y)) :by (H1 P))
+    (have <b> (<=> (P y) (P z)) :by (H2 P))
+    (have <c> (<=> (P x) (P z))
+          :by (p/iff-trans <a> <b>)))
+  (qed <c>))
+
+(defimplicit eq-trans
+  "Transitivity of `equal`, an implicit version of [[eq-trans%]]."
+  [def-env ctx [eq-term1 ty1] [eq-term2 ty2]]
+  (let [[T1 x1 y1] (decompose-equal-type def-env ctx ty1)
+        [T2 x2 y2] (decompose-equal-type def-env ctx ty2)]
+    ;; XXX: these are redundant and probably take time ...
+      #_(when-not (norm/beta-eq? def-env ctx T1 T2)
+          (throw (ex-info "Equal type mismatch"
+                          {:special 'latte.prop/eq-trans%
+                           :left-type T1
+                           :right-type T2})))
+      #_(when-not (norm/beta-eq? def-env ctx y1 x2)
+          (throw (ex-info "Term in the middle mismatch"
+                          {:special 'latte.prop/eq-trans%
+                           :left-rhs-term y1
+                           :right-lhs-term x2})))
+      [[(list #'eq-trans% T1 x1 y1 y2) eq-term1] eq-term2]))
+
+(defimplicit eq-trans*
+  "Transitivity of `equal`, a n-ary version of [[eq-trans]].
 The parameter `eq-terms` is a vector of at least two equalities.

 For example:

 ```
 (eq-trans* eq1 eq2)
-==> (eq-trans% eq1 eq2)
+==> (eq-trans eq1 eq2)

 (eq-trans* eq1 eq2 eq3)
-==> (eq-trans% (eq-trans% eq1 eq2) eq3)
+==> (eq-trans (eq-trans eq1 eq2) eq3)

 (eq-trans* eq1 eq2 eq3 eq4)
-==> (eq-trans% (eq-trans% (eq-trans% eq1 eq2) eq3) eq4)
+==> (eq-trans (eq-trans (eq-trans eq1 eq2) eq3) eq4)
 ````
 etc.
 `"
@@ -165,34 +132,16 @@
   ;;   (throw (ex-info "There must be at least two arguments."
   ;;                   {:special 'latte.prop/eq-trans*
   ;;                    :arg eq-terms})))
-  (let [[status ty1] (ty/type-of-term def-env ctx (first eq-terms))]
-    (when (= status :ko)
-      (throw (ex-info "Cannot type term." {:special 'latte.prop/eq-trans*
-                                           :term (first eq-terms)
-                                           :from ty1})))
-    (let [[status T x1 y1] (decompose-equal-type def-env ctx ty1)]
-      (when (= status :ko)
-        (throw (ex-info "Cannot infer an `equal`-type." {:special 'latte.prop/eq-trans*
-                                                         :term (first eq-terms)
-                                                         :type ty1})))
-      (loop [eq-terms' (rest eq-terms), x1 x1, y1 y1, ret (first eq-terms)]
-        (if (seq eq-terms')
-          (let [[status ty2] (ty/type-of-term def-env ctx (first eq-terms'))]
-            (when (= status :ko)
-              (throw (ex-info "Cannot type term." {:special 'latte.prop/eq-trans*
-                                                   :term (first eq-terms')
-                                                   :from ty2})))
-            (let [[status _ x2 y2] (decompose-equal-type def-env ctx ty2)]
-              (when (= status :ko)
-                (throw (ex-info "Cannot infer an `equal`-type." {:special 'latte.prop/eq-trans*
-                                                                 :term (first eq-terms')
-                                                                 :type ty2})))
-              (recur (rest eq-terms') x1 y2
-                     [[(list #'eq-trans T x1 y1 y2) ret] (first eq-terms')])))
-          ;; we're done
-          (do
-            ;; (println "  ==> ret=" ret)
-            ret))))))
+  (let [[T x1 y1] (decompose-equal-type def-env ctx (second (first eq-terms)))]
+    (loop [eq-terms' (rest eq-terms), x1 x1, y1 y1, ret (ffirst eq-terms)]
+      (if (seq eq-terms')
+        (let [[_ x2 y2] (decompose-equal-type def-env ctx (second (first eq-terms')))]
+          (recur (rest eq-terms') x1 y2
+                 [[(list #'eq-trans% T x1 y1 y2) ret] (ffirst eq-terms')]))
+        ;; we're done
+        (do
+          ;; (println "  ==> ret=" ret)
+          ret)))))

 ;; (defthm test-eq-trans
 ;;   [[T :type] [a T] [b T] [c T] [d T]]


added canonicalise-column-names to grafter.rdf and commented old graphify

--- src/grafter/rdf.clj
+++ src/grafter/rdf.clj
@@ -12,9 +12,10 @@
    [grafter.rdf.ontologies.sdmx-measure]
    [grafter.rdf.ontologies.sdmx-attribute]
    [grafter.rdf.ontologies.sdmx-concept])
-  (:require [clojure.java.io :as io])
-  (:require [grafter.rdf.protocols :as pr])
-  (:require [grafter.rdf.sesame :as ses])
+  (:require [clojure.java.io :as io]
+            [grafter.rdf.protocols :as pr]
+            [grafter.rdf.sesame :as ses]
+            [grafter.tabular :refer [make-dataset column-names]])
   (:import [grafter.rdf.protocols Triple Quad]
            [grafter.rdf.sesame ISesameRDFConverter])
   (:import [org.openrdf.model Statement Value Resource Literal URI BNode ValueFactory]
@@ -84,17 +85,23 @@
   (reduce conj triple-template
           (mapcat vector hash-map)))

-(defmacro graphify [row-bindings & forms]
-  "Takes a vector in fn binding form (where destructuring is
-supported) followed by a series of graph or triplify forms and
-concatenates them all together."
-  `(fn graphify-rows-fn [rs#]
-     (mapcat (fn graphify-row [row-sym#]
-               (let [~@row-bindings row-sym#]
-                 (->> (concat
-                       ~@forms)
-                      (map (fn [triple#] (with-meta triple# {:row row-sym#}))))))
-             rs#)))
+(defn canonicalise-column-names
+  [dataset]
+  (make-dataset dataset (map name (column-names dataset))))
+
+
+(comment
+  (defmacro graphify [row-bindings & forms]
+    "Takes a vector in fn binding form (where destructuring is
+    supported) followed by a series of graph or triplify forms and
+    concatenates them all together."
+    `(fn graphify-rows-fn [rs#]
+       (mapcat (fn graphify-row [row-sym#]
+                 (let [~@row-bindings row-sym#]
+                   (->> (concat
+                         ~@forms)
+                        (map (fn [triple#] (with-meta triple# {:row row-sym#}))))))
+               rs#))))

 (defn load-triples [my-repo triple-seq]
   (doseq [triple triple-seq]


Remove pointless logging message

Remove pointless logging message

--- src/icecap/core.clj
+++ src/icecap/core.clj
@@ -18,7 +18,6 @@
                     :kdf (crypto/blake2b-kdf seed-key salt)
                     :scheme (crypto/secretbox-scheme)}
         handler (rest/build-site components)]
-    (info "Initializing libsodium")
     (sodium-init)
     (info (str "Running icecap on port " port))
     (start-server handler {:port port


Add keep identity to threading macro in once to remove nils.

--- src/incise/once.clj
+++ src/incise/once.clj
@@ -28,4 +28,5 @@
            (file)
            (file-seq)
            (map parse)
+           (keep identity)
            (doall)))))


+decir +hacer

+decir
+hacer

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -212,24 +212,24 @@
   "decidir" {:synsem {:cat :verb
                        :sem {:pred :decide}}}

-  "decir" (let [shared-part-of-dire
-          {:espanol {:future-stem "dir"
-                   :present {:1sing "digo"
-                             :2sing "dices"
-                             :3sing "dice"
-                             :1plur "decimos"
-                             :2plur "decís"
-                             :3plur "dicen"}
-                   :preterito {:1sing "dije"
-                               :2sing "dijiste"
-                               :3sing "dije"
-                               :1plur "dijimos"
-                               :2plur "dijisteis"
-                               :3plur "dijeron"}}
-         [(merge shared-part-of-dire
-                       {:synsem {:pred :say}})
-                (merge shared-part-of-dire
-                       {:synsem {:pred :tell}})])
+  "decir" (let [common
+                {:espanol {:future-stem "dir"
+                           :present {:1sing "digo"
+                                     :2sing "dices"
+                                     :3sing "dice"
+                                     :1plur "decimos"
+                                     :2plur "decís"
+                                     :3plur "dicen"}
+                           :preterito {:1sing "dije"
+                                       :2sing "dijiste"
+                                       :3sing "dije"
+                                       :1plur "dijimos"
+                                       :2plur "dijisteis"
+                                       :3plur "dijeron"}}}]
+            [(unify common
+                    {:synsem {:pred :say}})
+             (unify common
+                    {:synsem {:pred :tell}})])

    "dejar" {:synsem {:cat :verb
                      :sem {:pred :leave-behind}}}
@@ -426,25 +426,24 @@
              {:synsem {:cat :verb
                        :sem {:pred :talk
                              :subj {:human true}}}}]
-
-   "hacer" (let [shared-part-of-hacer
-                 {:espanol {:future-stem "har"
-                            :present {:1sing "hago"
-                                      :2sing "haces"
-                                      :3sing "hace"
-                                :1plur "hacemos"
-                                      :2plur "hacéis"
-                                      :3plur "hacen"}
-                            :preterito {:1sing "hize"
-                                        :2sing "hiciste"
-                                        :3sing "hize"
-                                        :1plur "hicimos"
-                                        :2plur "hicisteis"
-                                        :3plur "hicieron"}}}]
-             [(unify shared-part-of-hacer
-                     {:synsem {:pred :do}})
-              (unify shared-part-of-hacer
-                     {:synsem {:pred :make}})])
+   "hacer"
+   (let [common {:espanol {:future-stem "har"
+                           :present {:1sing "hago"
+                                     :2sing "haces"
+                                     :3sing "hace"
+                                     :1plur "hacemos"
+                                     :2plur "hacéis"
+                                     :3plur "hacen"}
+                           :preterito {:1sing "hize"
+                                       :2sing "hiciste"
+                                       :3sing "hize"
+                                       :1plur "hicimos"
+                                       :2plur "hicisteis"
+                                       :3plur "hicieron"}}}]
+     [(unify common
+             {:synsem {:pred :do}})
+      (unify common
+             {:synsem {:pred :make}})])

    "hervir" {:espanol {:boot-stem "hierv"}
              :synsem {:cat :verb


add assertion for breaking change

add assertion for breaking change

--- modules/reitit-ring/src/reitit/ring.cljc
+++ modules/reitit-ring/src/reitit/ring.cljc
@@ -99,6 +99,8 @@
                       :compile compile-result
                       ::default-options-endpoint default-options-endpoint}
                      opts)]
+     (assert (not (contains? opts ::default-options-handler))
+             "Option `::default-options-handler` is deprecated. Use `::default-options-endpoint` instead.")
      (r/router data opts))))

 (defn routes


Test restoring snapshot in the 'future'.

--- test/ago/test.cljs
+++ test/ago/test.cljs
@@ -530,22 +530,33 @@
           (>! cc1 true)
           (assert (= (<! ch1) 1))

-          (close! cc0) ; Now close the channels.
-          (close! cc1)
-          (assert (= (<! ch0) nil))
-          (assert (= (<! ch1) nil))
-
-          (ago-restore agw ss) ; Restore after channel closures.
-          (>! cc0 true)
-          (assert (= (<! ch0) 2))
-          (>! cc1 true)
-          (assert (= (<! ch1) 1))
-          (close! cc0)
-          (close! cc1)
-          (assert (= (<! ch0) nil))
-          (assert (= (<! ch1) nil))
-
-          (reset! all-done true)))
+          (let [ss2 (ago-snapshot agw)]
+            (close! cc0) ; Now close the channels.
+            (close! cc1)
+            (assert (= (<! ch0) nil))
+            (assert (= (<! ch1) nil))
+
+            (ago-restore agw ss) ; Restore after channel closures.
+            (>! cc0 true)
+            (assert (= (<! ch0) 2))
+            (>! cc1 true)
+            (assert (= (<! ch1) 1))
+            (close! cc0)
+            (close! cc1)
+            (assert (= (<! ch0) nil))
+            (assert (= (<! ch1) nil))
+
+            (ago-restore agw ss2) ; Restore something ss2, or a future snapshot.
+            (>! cc0 true)
+            (assert (= (<! ch0) 5))
+            (>! cc0 true)
+            (assert (= (<! ch0) 6))
+            (>! cc0 true)
+            (assert (= (<! ch0) 7))
+            (>! cc1 true)
+            (assert (= (<! ch1) 2))
+
+            (reset! all-done true))))
     (loop []
       (when (not @all-done)
         (cljs.core.async.impl.dispatch/process-messages)


[ECS][TAGS] partial tags support

[ECS][TAGS] partial tags support

--- src/clj/aliyuncs/ecs/tags.clj
+++ src/clj/aliyuncs/ecs/tags.clj
@@ -1,12 +1,88 @@
 (ns aliyuncs.ecs.tags
   (:import [com.aliyuncs.ecs.model.v20140526
             AddTagsRequest
-            AddTagsResponse
             DescribeTagsRequest
             DescribeTagsResponse
             RemoveTagsRequest
-            RemoveTagsResponse
             DescribeResourceByTagsRequest
             DescribeResourceByTagsResponse])
     (:require [aliyuncs.core :as acs])
     (:use [clojure.java.data]))
+
+(def res-type
+  {:instance "instance"
+   :image "image"
+   :snapshot "snapshot"
+   :disk "disk"
+   :security-group "securitygroup"})
+
+(defn set-tag
+  [^AddTagsRequest add-req i key value]
+  (condp = i
+    1 (do
+        (.setTag1Key add-req key)
+        (.setTag1Value add-req value))
+    2  (do
+        (.setTag2Key add-req key)
+        (.setTag2Value add-req value))
+    3  (do
+        (.setTag3Key add-req key)
+        (.setTag3Value add-req value))
+    4  (do
+        (.setTag4Key add-req key)
+        (.setTag4Value add-req value))
+    5  (do
+        (.setTag5Key add-req key)
+        (.setTag5Value add-req value))
+    nil))
+
+;;OK it's the same function
+(defn set-rm-tag
+  [^RemoveTagsRequest rm-req i key value]
+  (condp = i
+    1 (do
+        (.setTag1Key rm-req key)
+        (.setTag1Value rm-req value))
+    2  (do
+        (.setTag2Key rm-req key)
+        (.setTag2Value rm-req value))
+    3  (do
+        (.setTag3Key rm-req key)
+        (.setTag3Value rm-req value))
+    4  (do
+        (.setTag4Key rm-req key)
+        (.setTag4Value rm-req value))
+    5  (do
+        (.setTag5Key rm-req key)
+        (.setTag5Value rm-req value))
+    nil))
+
+(defn set-tags
+  [add-req tags]
+  (loop [tgs tags
+         tn 1]
+    (when-let [tag (first tgs)]
+      (let [[k v] tag]
+        (set-tag add-req tn (name k) v)
+        (recur (rest tgs) (inc tn))))))
+
+(defn add-tags
+  "Add Tags"
+  [client {:keys [resource-type resource-id tags]}]
+  (let [^AddTagsRequest add-req (AddTagsRequest.)]
+    (when (and resource-type resource-id)
+      (.setResourceType add-req (res-type resource-type))
+      (.setResourceId add-req resource-id)
+      (when tags
+        (set-tags add-req tags))
+      (acs/do-action client add-req))))
+
+(defn remove-tag
+  "remove a tag with specified index and k v"
+  [client {:keys [resource-type resource-id tag-index key value]}]
+  (let [^RemoveTagsRequest rm-req (RemoveTagsRequest.)]
+    (when (and resource-type resource-id)
+      (.setResourceType rm-req (res-type resource-type))
+      (.setResourceId rm-req resource-id)
+      (set-rm-tag rm-req tag-index key value)
+      (acs/do-action client rm-req))))


change cljs.analyzer.api/resolve so that it returns nil if var not found

--- src/clj/cljs/analyzer/api.clj
+++ src/clj/cljs/analyzer/api.clj
@@ -16,7 +16,10 @@
    clojure.core/resolve"
   [env sym]
   {:pre [(map? env) (symbol? sym)]}
-  (ana/resolve-var env sym))
+  (try
+    (ana/resolve-var env sym
+      (ana/confirm-var-exists-throw))
+    (catch Exception e)))

 (defn all-ns
   "Return all the namespace analysis maps. Analagous to clojure.core/all-ns but


browser REPL source mapping for Firefox

browser REPL source mapping for Firefox

--- src/clj/cljs/repl/browser.clj
+++ src/clj/cljs/repl/browser.clj
@@ -199,6 +199,9 @@

 (defmulti parse-stacktrace (fn [repl-env st err opts] (:ua-product err)))

+(defmethod parse-stacktrace :default
+  [repl-env st err opts] st)
+
 (defn parse-file-line-column [flc]
   (let [xs (string/split flc #":")
         [pre [line column]]
@@ -350,6 +353,100 @@
 handleBrowserEvent_@http://localhost:9000/out/goog/events/events.js:862:34
 http://localhost:9000/out/goog/events/events.js:276:42"
     {:ua-product :safari}
+    nil)
+  )
+
+;; -----------------------------------------------------------------------------
+;; Firefox Stacktrace
+
+(defn firefox-clean-function [f]
+  (as-> f f
+    (cond
+      (string/blank? f) nil
+      (not= (.indexOf f "</") -1)
+      (let [idx (.indexOf f "</")]
+        (.substring f (+ idx 2)))
+      :else f)
+    (-> f
+      (string/replace #"<" "")
+      (string/replace #"\/" ""))))
+
+(defn firefox-st-el->frame
+  [st-el opts]
+  (let [[function flc] (if (re-find #"@" st-el)
+                         (string/split st-el #"@")
+                         [nil st-el])
+        [file line column] (parse-file-line-column flc)]
+    (if (and file function line column)
+      {:file (parse-file file opts)
+       :function (firefox-clean-function function)
+       :line line
+       :column column}
+      (when-not (string/blank? function)
+        {:file nil
+         :function (firefox-clean-function function)
+         :line nil
+         :column nil}))))
+
+(comment
+  (firefox-st-el->frame
+    "cljs$core$seq@http://localhost:9000/out/cljs/core.js:4258:8" {})
+
+  (firefox-st-el->frame
+    "cljs.core.map</cljs$core$map__2/</<@http://localhost:9000/out/cljs/core.js:16971:87" {})
+
+  (firefox-st-el->frame
+    "cljs.core.map</cljs$core$map__2/</<@http://localhost:9000/out/cljs/core.js:16971:87" {})
+
+  (firefox-st-el->frame
+    "cljs.core.pr_str</cljs$core$pr_str@http://localhost:9000/out/cljs/core.js:29138:8" {})
+
+  (firefox-st-el->frame
+    "cljs.core.pr_str</cljs$core$pr_str__delegate@http://localhost:9000/out/cljs/core.js:29129:8" {})
+  )
+
+(defmethod parse-stacktrace :firefox
+  [repl-env st err opts]
+  (->> st
+    string/split-lines
+    (take-while #(= (.indexOf % "> eval") -1))
+    (remove string/blank?)
+    (map #(firefox-st-el->frame % opts))
+    (remove nil?)
+    vec))
+
+(comment
+  (parse-stacktrace nil
+    "cljs$core$seq@http://localhost:9000/out/cljs/core.js:4258:8
+cljs$core$first@http://localhost:9000/out/cljs/core.js:4288:9
+cljs$core$ffirst@http://localhost:9000/out/cljs/core.js:5356:24
+cljs.core.map</cljs$core$map__2/</<@http://localhost:9000/out/cljs/core.js:16971:87
+cljs.core.map</cljs$core$map__2/<@http://localhost:9000/out/cljs/core.js:16970:1
+cljs.core.LazySeq.prototype.sval/self__.s<@http://localhost:9000/out/cljs/core.js:10981:119
+cljs.core.LazySeq.prototype.sval@http://localhost:9000/out/cljs/core.js:10981:13
+cljs.core.LazySeq.prototype.cljs$core$ISeqable$_seq$arity$1@http://localhost:9000/out/cljs/core.js:11073:1
+cljs$core$seq@http://localhost:9000/out/cljs/core.js:4239:8
+cljs$core$pr_sequential_writer@http://localhost:9000/out/cljs/core.js:28706:4
+cljs.core.LazySeq.prototype.cljs$core$IPrintWithWriter$_pr_writer$arity$3@http://localhost:9000/out/cljs/core.js:29385:8
+cljs$core$pr_writer_impl@http://localhost:9000/out/cljs/core.js:28911:8
+cljs$core$pr_writer@http://localhost:9000/out/cljs/core.js:29010:8
+cljs$core$pr_seq_writer@http://localhost:9000/out/cljs/core.js:29014:1
+cljs$core$pr_sb_with_opts@http://localhost:9000/out/cljs/core.js:29077:1
+cljs$core$pr_str_with_opts@http://localhost:9000/out/cljs/core.js:29091:23
+cljs.core.pr_str</cljs$core$pr_str__delegate@http://localhost:9000/out/cljs/core.js:29129:8
+cljs.core.pr_str</cljs$core$pr_str@http://localhost:9000/out/cljs/core.js:29138:8
+@http://localhost:9000/out/clojure/browser/repl.js line 23 > eval:1:25
+@http://localhost:9000/out/clojure/browser/repl.js line 23 > eval:1:2
+clojure$browser$repl$evaluate_javascript/result<@http://localhost:9000/out/clojure/browser/repl.js:23:267
+clojure$browser$repl$evaluate_javascript@http://localhost:9000/out/clojure/browser/repl.js:23:15
+clojure$browser$repl$connect/</<@http://localhost:9000/out/clojure/browser/repl.js:121:128
+goog.messaging.AbstractChannel.prototype.deliver@http://localhost:9000/out/goog/messaging/abstractchannel.js:142:5
+goog.net.xpc.CrossPageChannel.prototype.xpcDeliver@http://localhost:9000/out/goog/net/xpc/crosspagechannel.js:733:7
+goog.net.xpc.NativeMessagingTransport.messageReceived_@http://localhost:9000/out/goog/net/xpc/nativemessagingtransport.js:321:1
+goog.events.fireListener@http://localhost:9000/out/goog/events/events.js:741:10
+goog.events.handleBrowserEvent_@http://localhost:9000/out/goog/events/events.js:862:1
+goog.events.getProxy/f<@http://localhost:9000/out/goog/events/events.js:276:16"
+    {:ua-product :firefox}
     nil)
   )


Refactor parse-double

Refactor parse-double

--- src/clj/rumahsewa141/math.clj
+++ src/clj/rumahsewa141/math.clj
@@ -8,7 +8,7 @@
     :else n))

 (defn parse-double [num]
-  ;; if num string does not match decimal regex with a precision of 2
-  (if (nil? (re-find #"^[0-9]+(\.[0-9]{1,2})?$" num))
-    0.00
-    (Double/parseDouble num)))
+  ;; if num string match decimal regex with a precision of 2
+  (if (re-find #"^[0-9]+(\.[0-9]{1,2})?$" num)
+    (Double/parseDouble num)
+    0.00))


add regression test for blackmail and tmi interaction

--- src/clj/test/cards-events.clj
+++ src/clj/test/cards-events.clj
@@ -114,3 +114,24 @@
       (core/rez state :corp iwall1)
       (is (get-in (refresh iwall1) [:rezzed]))
     )))
+
+(deftest blackmail-tmi-interaction
+  "Regression test for a rezzed tmi breaking game state on a blackmail run"
+  (do-game
+    (new-game (default-corp [(qty "TMI" 3)])
+              (make-deck "Valencia Estevez: The Angel of Cayambe" [(qty "Blackmail" 3)]))
+    (is 1 (get-in @state [:corp :bad-publicity]))
+    (play-from-hand state :corp "TMI" "HQ")
+    (let [tmi (get-in @state [:corp :servers :hq :ices 0])]
+      (core/rez state :corp tmi)
+      (prompt-choice :corp 0)
+      (prompt-choice :runner 0)
+      (is (get-in (refresh tmi) [:rezzed]))
+      (take-credits state :corp)
+      (play-from-hand state :runner "Blackmail")
+      (prompt-choice :runner "HQ")
+      (core/no-action state :corp nil)
+      (core/continue state :runner nil)
+      (core/jack-out state :runner nil)
+      (core/click-run state :runner {:server "Archives"})
+      )))


stupid vm commit dates were bad

stupid vm commit dates were bad

--- src/clj_beautify/beautify.clj
+++ src/clj_beautify/beautify.clj
@@ -3,7 +3,6 @@
             [clojure.tools.reader.reader-types :as rt]
             [clojure.pprint :refer :all]))

-;; Map containing the dispatch modes for various beautifying
 (def dispatch-mode
   {"clj"     code-dispatch
    "edn"     simple-dispatch})


Improve documentation in `quil.middleware`.

--- src/cljc/quil/middleware.cljc
+++ src/cljc/quil/middleware.cljc
@@ -11,9 +11,11 @@
         :ns "quil.middleware"
         :added "2.1.0"}
   fun-mode
-  "Introduces function mode. Adds 'update' function which takes current
-  state and returns new state. Makes all other functions (setup, draw,
-  mouse-click, etc) state-aware. See wiki for more details."
+  "Introduces `function mode`. Adds `update` function which takes current state
+  and returns new state. Makes all other functions (`setup`, `draw`,
+  `mouse-click`, etc) state-aware.
+  See [wiki](https://github.com/quil/quil/wiki/Functional-mode-%28fun-mode%29)
+  for more details."
   [options]
   (fun-mode/fun-mode options))

@@ -24,7 +26,7 @@
            :ns "quil.middleware"
            :added "2.2.0"}
      pause-on-error
-     "Pauses sketch if any of user-provided handlers throws error.
+     "Pauses sketch if any of the user-provided handlers throws an error.
   It allows to fix the error on the fly and continue sketch.
   May be good alternative to default '500ms pause if exception'
   behaviour."
@@ -39,8 +41,7 @@
   navigation-3d
   "Enables navigation in 3D space. Similar to how it is done in
   shooters: WASD navigation, space is go up, drag mouse to look around.
-  This middleware requires fun-mode.
-
+  This middleware requires [[fun-mode]].

   Navigation

@@ -49,55 +50,54 @@
     customization info below.

   * Keyboard:
-    * w - go forward
-    * s - go backward
-    * a - strafe left
-    * d - strafe right
-    * space - go up
-    * z - go down, can't bind to ctrl, limitation of Processing
-
+    * `w` - go forward
+    * `s` - go backward
+    * `a` - strafe left
+    * `d` - strafe right
+    * `space` - go up
+    * `z` - go down, can't bind to `ctrl`, limitation of Processing

   Customization

-  You can customize this middleware by providing map as
-  :navigation-3d option in defsketch/sketch. Map can have following
-  optional keys:
+  You can customize this middleware by providing a map as
+  `:navigation-3d` option in [[quil.sketch/defsketch]]/[[quil.sketch/sketch]].
+  The map can have the following optional keys:

-  :position - vector of 3 numbers, initial camera position. Default
-              is the same as in 'camera' function.
+  * `:position` - vector of 3 numbers, initial camera position. Default
+                  is the same as in [[quil.core/camera]] function.

-  :straight - vector of 3 numbers, direction you'll be looking at.
-              Default is [0 0 -1] (looking down).
+  * `:straight` - vector of 3 numbers, direction you'll be looking at.
+                  Default is `[0 0 -1]` (looking down).

-  :up - vector of 3 numbers, 'up' direction. Default is [0 1 0].
+  * `:up` - vector of 3 numbers, 'up' direction. Default is `[0 1 0]`.

-  :pixels-in-360 - number, mouse sensitivity. Defines how many pixels
-                   you need to move/drag you mouse to rotate 360 degrees.
-                   The less the number the more sensitive is mouse.
-                   Default is 1000.
+  * `:pixels-in-360` - number, mouse sensitivity. Defines how many pixels
+                       you need to move/drag your mouse to rotate 360 degrees.
+                       The less the number the more sensitive the mouse.
+                       Default is `1000`.

-  :step-size - number, number of pixels you move on each key event (wasd).
-               Default is 20.
+  * `:step-size` - number, number of pixels you move on each key event (wasd).
+                   Default is `20`.

-  :rotate-on - keyword, either :mouse-dragged or :mouse-moved. Specifies
-               on which mouse event camera should rotate. Default is
-               :mouse-dragged.
+  * `:rotate-on` - keyword, either `:mouse-dragged` or `:mouse-moved`. Specifies
+                   on which mouse event camera should rotate. Default is
+                   `:mouse-dragged`.

+  Accessing position information from a sketch

-  Accessing position information from sketch
-
-  navigation-3d uses fun-mode under the hood  so all position-related
+  [[navigation-3d]] uses [[fun-mode]] under the hood so all position-related
   information is stored in the state map. It means that you can access in
   draw/update/any handler and modify it if you need to. Position
-  information is a map which is stored under :navigation-3d key in the
-  state map. Position consists of 3 values: :position, :straight and :up.
+  information is a map which is stored under `:navigation-3d` key in the
+  state map. Position consists of 3 values: `:position`, `:straight` and `:up`.
   See \"Customization\" section above for more details.

-  Usage example:
-
+  Example:
+  ```
   (q/defsketch my-sketch
     ...
     :middleware [m/fun-mode m/navigation-3d])
+  ```

   See wiki article for more(?) details:
   https://github.com/quil/quil/wiki/Navigation-3D"
@@ -111,33 +111,33 @@
         :added "2.2.6"}
   navigation-2d
   "Enables navigation over 2D sketch. Drag mouse to change the center of the
-  sketch and mouse wheel controls zoom. This middleware requires fun-mode.
+  sketch and mouse wheel controls zoom. This middleware requires [[fun-mode]].

   Customization

-  You can customize this middleware by providing map as
-  :navigation-2d option in defsketch/sketch. Map can have following
-  optional keys:
+  You can customize this middleware by providing a map as
+  `:navigation-2d` option in [[quil.sketch/defsketch]]/[[quil.sketch/sketch]].
+  The map can have the following optional keys:

-  :position - vector of 2 numbers, x and y - center of the screen.
-              Default is width/2, height/2.
+  * `:position` - vector of 2 numbers, x and y - center of the screen.
+                  Default is `width/2`, `height/2`.

-  :zoom - number indicating current zoom level. Default is 1.
+  * `:zoom` - number indicating current zoom level. Default is `1`.

-  Accessing position information from sketch
+  Accessing position information from a sketch

-  navigation-2d uses fun-mode under the hood so all position-related
+  [[navigation-2d]] uses [[fun-mode]] under the hood so all position-related
   information is stored in the state map. It means that you can access in
   draw/update/any handler and modify it if you need to. Position
-  information is a map which is stored under :navigation-2d key in the
-  state map. Position consists of 2 values: :position and :zoom.
+  information is a map which is stored under `:navigation-2d` key in the
+  state map. Position consists of 2 values: `:position` and `:zoom`.
   See \"Customization\" section above for more details.

-  Usage example:
-
+  Example:
+  ```
   (q/defsketch my-sketch
     ...
     :middleware [m/fun-mode m/navigation-2d])
-"
+  ```"
   [options]
   (navigation-2d/navigation-2d options))


Fix no abilities message

Fix no abilities message

--- src/cljc/robinson/render.cljc
+++ src/cljc/robinson/render.cljc
@@ -600,7 +600,9 @@
   [state]
   (let [screen (get state :screen)
         abilities (rp/player-abilities state)
-        height (+ 3 (count abilities))]
+        height (if (seq abilities)
+                 (+ 3 (count abilities))
+                 4)]
     (render-list screen 17 4 43 height
       (if (seq abilities)
         (concat
@@ -615,7 +617,7 @@
            {:s "Select hotkey or press <color fg=\"highlight\">Esc</color> to exit." :fg :black :bg :white :style #{}}])
         [{:s "No abilities." :fg :black :bg :white :style #{}}
          {:s "" :fg :black :bg :white :style #{}}
-         {:s "Select hotkey or press <color fg=\"highlight\">Esc</color> to exit." :fg :black :bg :white :style #{}}]))
+         {:s "Press <color fg=\"highlight\">Esc</color> to exit." :fg :black :bg :white :style #{}}]))

     (render-rect-double-border screen 16 3 43 height :black :white)
     (put-string screen 33 3 "Abilities" :black :white)))


constants

constants

--- src/cljs/tictactoe/board.cljs
+++ src/cljs/tictactoe/board.cljs
@@ -4,6 +4,8 @@
     [tictactoe.logic :as logic]
     ))

+
+(def board-pixel-size 500)

 (defn render-board-cell
   "Render a cell on the board"
@@ -18,7 +20,7 @@
   (into
     [:svg.board
      {:view-box (str "0 0 " logic/board-size " " logic/board-size)
-      :style {:max-height "500px"}}]
+      :style {:max-height (str board-pixel-size "px")}}]
     (for [[x y] logic/coordinates]
       [render-board-cell board x y on-move])
     ))


[n.resource] Fix bug with passing non-string object to get-string

--- src/clojure/neko/resource.clj
+++ src/clojure/neko/resource.clj
@@ -30,7 +30,7 @@
                                   [(first args) (rest args)]
                                   [App/instance args])
         [res-id & format-args] args]
-    (cond (string? res-id) res-id
+    (cond (not (number? res-id)) res-id
           format-args      (.getString context res-id (to-array format-args))
           :else            (.getString context res-id))))

@@ -41,6 +41,6 @@
    (get-drawable App/instance res-id))

   ([^Context context, res-id]
-   (if (instance? Drawable res-id)
+   (if-not (number? res-id)
      res-id
      (.getDrawable (.getResources context) res-id))))


First draft: Nested contexts with lazy execution.

Includes self-tests with assert.

--- lazytest.clj
+++ lazytest.clj
@@ -1,4 +1,71 @@
+;;; lazytest.clj
+
+;; by Stuart Sierra, http://stuartsierra.com/
+
+;; Copyright (c) 2010 Stuart Sierra. All rights reserved.  The use and
+;; distribution terms for this software are covered by the Eclipse
+;; Public License 1.0, which can be found at
+;; http://opensource.org/licenses/eclipse-1.0.php
+;;
+;; By using this software in any fashion, you are agreeing to be bound
+;; by the terms of this license.  You must not remove this notice, or
+;; any other, from this software.
+
+
+;;; PROTOCOLS
+
+(defprotocol TestSuccess
+  (success? [r] "Returns true if r is a 100% successful result."))
+
+(defprotocol Testable
+  (run-tests [x] "Runs tests defined for the Namespace, Var, or TestCase."))
+
+
+;;; DATATYPES
+
 (deftype Context [parents before after])
+
+(deftype TestCase [contexts children])
+
+(deftype Assertion [locals form])
+
+(deftype TestResult [source children]
+  TestSuccess (success? [] (every? success? children)))
+
+(deftype TestThrown [source error]
+  TestSuccess (success? [] false))
+
+(deftype AssertionPassed [source]
+  TestSuccess (success? [] true))
+
+(deftype AssertionFailed [source]
+  TestSuccess (success? [] false))
+
+(deftype AssertionThrown [source error]
+  TestSuccess (success? [] false))
+
+
+;;; ASSERTION HANDLING
+
+(defn- format-assertion [a]
+  {:pre [(= ::Assertion (type a))
+         (vector? (:locals a))]}
+  (let [form (:form a)]
+    `(fn ~(:locals a)
+       (try (if ~form
+              (AssertionPassed '~form)
+              (AssertionFailed '~form))
+            (catch Throwable t#
+              (AssertionThrown '~form t#))))))
+
+(defn compile-assertion [a]
+  (eval (format-assertion a)))
+
+(defmacro assertion [locals & body]
+  (format-assertion (Assertion locals `(do ~@body))))
+
+
+;;; CONTEXT HANDLING

 (defn open-context
   "Opens context c, and all its parents, unless it is already active."
@@ -18,6 +85,97 @@
     (let [active (reduce close-context active (:parents c))]
       (dissoc active c))))

+
+;;; TEST CASE HANDLING
+
+(defn- unchunked-map
+  "Like map but does not chunk results; slower but lazier than map."
+  [f coll]
+  (lazy-seq
+   (when (seq coll)
+     (cons (f (first coll))
+           (unchunked-map f (next coll))))))
+
+(defn- has-after?
+  "True if Context c or any of its parents has an :after function."
+  [c]
+  (or (:after c)
+      (some has-after? (:parents c))))
+
+(defn run-test-case
+  "Executes a test case in context."
+  ([t] (run-test-case t {}))
+  ([t active]
+     {:pre [(= ::TestCase (type t))
+            (every? #(= ::Context (type %)) (:contexts t))]}
+     (try
+      (let [merged (reduce open-context active (:contexts t))
+            states (map merged (:contexts t))
+            ;; Prevent chunking for truly lazy execution:
+            results (unchunked-map (fn [c] (if (fn? c)
+                                             (apply c states)
+                                             (run-test-case c merged)))
+                                   (:children t))]
+        ;; Force non-lazy execution to handle shutdown properly:
+        (when (some has-after? (:contexts t))
+          (dorun results)
+          (dorun (reduce close-context merged
+                         ;; Only close contexts that weren't active at start:
+                         (filter #(not (contains? active %))
+                                 (reverse (:contexts t))))))
+        (TestResult t results))
+      (catch Throwable e (TestThrown t e)))))
+
+
+;;; TEST RESULT HANDLING
+
+(defn result-seq
+  "Given a single TestResult, returns a depth-first sequence of that
+  TestResult and all its children."
+  [r]
+  (tree-seq :children :children r))
+
+
+;;; TESTABLE IMPLEMENTATIONS
+
+(defn var-test-case
+  "Creates a TestCase for a Var, using clojure.core/test."
+  [v]
+   #^{:name (:name (meta v))}
+   (TestCase [] [(assertion [] (clojure.core/test v))]))
+
+(defn test-var
+  "Creates and runs a TestCase for the Var."
+  [v]
+  (run-test-case (var-test-case v)))
+
+(defn ns-test-case
+  "Creates a TestCase for the namespace that tests all its Vars."
+  [n]
+  #^{:name (ns-name n)}
+  (TestCase [] (map var-test-case (ns-interns n))))
+
+(defn test-ns
+  "Creates and runs a TestCase for the namespace."
+  [n]
+  (run-test-case (ns-test-case n)))
+
+(extend ::TestCase Testable {:run-tests run-test-case})
+(extend clojure.lang.Var Testable {:run-tests test-var})
+(extend clojure.lang.Namespace Testable {:run-tests test-ns})
+
+
+
+;;; SELF-TESTS
+
+;; Assertions
+(def a1 (assertion [a] (pos? a)))
+
+(assert (= ::AssertionPassed (type (a1 1))))
+(assert (= ::AssertionFailed (type (a1 -1))))
+(assert (= ::AssertionThrown (type (a1 "string"))))
+
+;; Contexts
 (def c1 (Context nil nil nil))

 (assert (= {} (open-context {} c1)))
@@ -35,5 +193,79 @@
 (assert (= {c2 2, c3 3} (open-context {} c3)))
 (assert (= {} (close-context {c2 2, c3 3} c3)))

-(deftype TestCase [contexts children])
-
+;; Simple TestCase
+(def t1 (TestCase [c2] [a1 a1 a1]))
+
+(assert (= ::TestResult (type (run-test-case t1))))
+(assert (every? #(= ::AssertionPassed (type %))
+                (:children (run-test-case t1))))
+
+;; TestCase with nested Context
+(def c4 (Context [c2] (fn [s2] (assert (= s2 2)) 4)
+                 (fn [s4 s2] (assert (= s4 4)) (assert (= s2 2)))))
+
+(def t2 (TestCase [c4] [a1]))
+
+(assert (= ::AssertionPassed
+           (type (first (:children (run-test-case t2))))))
+
+;; TestCase with multiple Contexts
+(def a2 (assertion [x y] (< x y)))
+
+(def t3 (TestCase [c2 c4] [a2 a2]))
+
+(assert (every? #(= ::AssertionPassed (type %))
+                (:children (run-test-case t3))))
+
+;; Context Ordering
+(declare *log*)
+
+(defn log [event]
+  (swap! *log* conj event))
+
+(defmacro with-log [& body]
+  `(binding [*log* (atom [])]
+     ~@body))
+
+(def a3 (assertion [x] (log :a3) (pos? x)))
+
+(def a4 (assertion [x] (log :a4) (pos? x)))
+
+(def c5 (Context [] (fn [] (log :c5-open) 5)
+                 (fn [x] (assert (= x 5)) (log :c5-close))))
+
+(def t4 (TestCase [c5] [a3 a4]))
+
+(with-log
+  (run-test-case t4)
+  (assert (= @*log* [:c5-open :a3 :a4 :c5-close])))
+
+;; Lazy Evaluation
+(def c6 (Context [] (fn [] (log :c6-open) 6) nil))
+
+(def t5 (TestCase [c6] [a3 a4]))
+
+(with-log
+  (let [results (run-test-case t5)]
+    (assert (= @*log* [:c6-open]))
+    (dorun (result-seq results))
+    (assert (= @*log* [:c6-open :a3 :a4]))))
+
+;; Nested Lazy Evaluation
+(def t6 (TestCase [] [t5 t5]))
+
+(with-log
+  (let [results (run-test-case t6)]
+    (assert (= @*log* []))
+    (dorun (:children (first (:children results))))
+    (assert (= @*log* [:c6-open :a3 :a4]))
+    (dorun (result-seq results))
+    (assert (= @*log* [:c6-open :a3 :a4 :c6-open :a3 :a4]))))
+
+(def t7 (TestCase [c6] [t5 t5]))
+
+(with-log
+  (let [results (run-test-case t7)]
+    (assert (= @*log* [:c6-open]))
+    (dorun (result-seq results))
+    (assert (= @*log* [:c6-open :a3 :a4 :a3 :a4]))))


Un-lazy list of hosts a job has run on as a perf optimization (#1645)

Co-authored-by: Scott Crosby <23e8f75489aff47cf2cd5a529e9a769a24e9501c@twosigma.com>

--- scheduler/src/cook/scheduler/constraints.clj
+++ scheduler/src/cook/scheduler/constraints.clj
@@ -81,7 +81,8 @@
   (->> (:job/instance job)
        (remove #(true? (:instance/preempted? %)))
        (mapv :instance/hostname)
-       distinct))
+       distinct
+       doall))

 (defn build-novel-host-constraint
   "Constructs a novel-host-constraint.


make field name as string

make field name as string

--- src/graphql_clj/execution.clj
+++ src/graphql_clj/execution.clj
@@ -175,18 +175,18 @@
 (defn- execute-fields
   "Implements the 'Executing selection sets' section of the spec for 'read' mode."
   [fields state parent-type-name parent-value]
-  (prn "execute-fields: fields:" fields)
+  ;; (prn "execute-fields: fields:" fields)
   (reduce (fn execute-fields-field [{:keys [errors data] :as result} [response-key response-fields]]
-            (prn "execute-fields-field:" response-key)
-            (prn "parent-type-name:" parent-type-name)
+            ;; (prn "execute-fields-field:" response-key)
+            ;; (prn "parent-type-name:" parent-type-name)
             (let [field-name (:name (first response-fields))
                   schema (:schema state)
                   field-type (get-field-type schema parent-type-name field-name)
                   response-value (execute-field parent-type-name parent-value response-fields field-type state)]
               (if (not (error? response-value))
-                (update result :data assoc response-key response-value)
+                (update result :data assoc (str response-key) response-value)
                 {:errors (rollup-errors (:errors result) response-value)
-                 :data (assoc (:data result) response-key (:data (ex-data response-value)))})))
+                 :data (assoc (:data result) (str response-key) (:data (ex-data response-value)))})))
           {}
           fields))


Added comments for each function

Added comments for each function

--- src/life/matrix.clj
+++ src/life/matrix.clj
@@ -1,9 +1,19 @@
 (ns life.matrix
+  "Implements functionality to duplicate APL operations used in Life"
   (:use [clojure.core.matrix]))

-(defn nbool [f] (fn [v] (if (f v) 1 0)))
+(defn nbool
+  "Create a function from a boolean function, mapping a truthy value to 1 or 0.
+   e.g. ((nbool not) false) => 1
+        ((nbool not) true) => 0"
+  [f] (fn [v] (if (f v) 1 0)))

 (defn takeof
+  "Creates a matrix of a given shape that contains a given matrix 'a'.
+   If the new matrix is smaller than the source matrix, then the source
+   matrix is truncated.
+   If the new matrix is larger than the source matrix in any dimension,
+   then it is padded out using the 'default' value, or 0 if not provided."
   ([sh a] (takeof sh a 0))
   ([sh a default]
    (let [src-shape (shape a)]
@@ -13,25 +23,47 @@
                          (apply mget a idx)
                          default))))))

-(defn and* [a b] (emap (nbool #(= 2 %)) (add a b)))
+(defn and*
+  "Performs an element-wise boolean AND operation on matrices
+   using numerical boolean values (0/1)"
+  [a b] (emap (nbool #(= 2 %)) (add a b)))

-(defn or* [a b] (emap (nbool #(not (zero? %))) (add a b)))
+(defn or*
+  "Performs an element-wise boolean OR operation on matrices
+   using numerical boolean values (0/1)"
+  [a b] (emap (nbool #(not (zero? %))) (add a b)))

-(defn outer [a b]
+(defn outer
+  "Creates an outer product of 2 sequences. The elements of the product
+   are stored in a record with keys :a :b. Ideally these would be a
+   2-element vector, but matrix operations treat such vectors as a new
+   dimension."
+  [a b]
   (array
     (for [x a]
       (for [y b]
         {:a x :b y}))))

-(defn outer-fn [f x y]
+(defn outer-fn
+  "Creates a function based on applying f bound to a single argument,
+   across remaining arguments that are the outer product of x and y."
+  [f x y]
   (fn [m]
     (emap (fn [{:keys [a b]}] (f (f m 0 a) 1 b))
           (outer x y))))

-(defn =x [a]
+(defn =x
+  "Creates a function from a matrix, that when a applied to a scalar will
+   return a boolean matrix where every matrix element that matches the
+   scalar will be true (1) in the result.
+   e.g. ((=x [1 2 3]) 2) => [0 1 0]
+        ((=x [1 2 3]) 3) => [0 0 1]"
+  [a]
   (fn [x] (emap (nbool #(= x %)) a)))

 (defn power [f n]
+  "Returns a function that applies f n times.
+   e.g. ((power inc 3) 2) => 5"
   (case n
     0 identity
     1 f
@@ -41,7 +73,12 @@
           r
           (recur (f r) (dec i)))))))

-(defn power-limit [f a]
+(defn power-limit
+  "Finds the fixpoint of a function starting at a given argument.
+   The function is repeatedly applied to the result of the previous application
+   until the result from the function is the same as the argument that led to it.
+   e.g. (power-limit #(min (inc %) 10) 1) => 10"
+  [f a]
   (loop [a a]
     (let [r (f a)]
       (if (= r a)


Add more examples from splicing macro example

--- src/clojure/clojure_walkthrough/cjia/ch07_xx.clj
+++ src/clojure/clojure_walkthrough/cjia/ch07_xx.clj
@@ -66,3 +66,11 @@

 ;; Other useful functions are
 ; `macroexpand-1`, `macroexpand-all` from `clojure.walk`
+
+(macroexpand '(unless (even? x) (println "Very odd, indeed!"))) ;; (unless (even? x) (println "Very odd, indeed!"))
+
+(defn exhibits-oddity? [x]
+  (unless (even? x)
+          (do
+            (println "Odd!")
+            (println "Very odd!"))))


CMR-1308 Adds docstring explaining GML

CMR-1308 Adds docstring explaining GML

--- spatial-lib/src/cmr/spatial/encoding/gml.clj
+++ spatial-lib/src/cmr/spatial/encoding/gml.clj
@@ -1,7 +1,15 @@
 (ns cmr.spatial.encoding.gml
   "Functions for dealing with spatial data in the GML XML format.
   Spatial objects parsed from GML default to a :cartesian coordinate
-  system."
+  system.
+
+  The OpenGIS Geography Markup Language Encoding Standard (GML) The
+  Geography Markup Language (GML) is an XML grammar for expressing
+  geographical features. GML serves as a modeling language for
+  geographic systems as well as an open interchange format for
+  geographic transactions on the Internet.
+
+  http://www.opengeospatial.org/standards/gml"
   (:require [clojure.data.xml :as x]
             [clojure.string :as string]
             [cmr.common.util :as util]


Remove Chris Bird. No strings. No stdin? Man's gotta have standards.


Version 0.3.5-SNAPSHOT

Version 0.3.5-SNAPSHOT

--- metlog-vault/project.clj
+++ metlog-vault/project.clj
@@ -1,4 +1,4 @@
-(defproject metlog-vault "0.3.4"
+(defproject metlog-vault "0.3.5-SNAPSHOT"
   :description "Repository for long term storage of series data."

   :license {:name "Eclipse Public License"


Invite modal: Only store modal-related state in modal state

--- src-cljs/frontend/components/pages/team.cljs
+++ src-cljs/frontend/components/pages/team.cljs
@@ -69,27 +69,29 @@
                            :project project}))]]
     (assoc user ::follow-count (count (get followings user)))))

-(defn invitees [users-by-login]
-  (->> users-by-login
-       vals
-       (filter (fn [user]
-                 (and (:selected user)
-                      (:email user))))))
+(defn invitees [component-users-by-handle vcs-users-by-handle]
+  (keep (fn [[handle vcs-user]]
+          (let [{:keys [selected?] :as component-user} (get component-users-by-handle handle)]
+            (when selected?
+              (-> vcs-user
+                  (assoc :email (:entered-email component-user))
+                  (select-keys [:id :login :email])))))
+        vcs-users-by-handle))

 (defn invite-teammates-modal [{:keys [selected-org close-fn show-modal?]} owner]
-  (letfn [(select-user! [{:keys [handle] :as user}]
-            (om/set-state! owner [:org-members-by-handle handle :selected] true))
-          (deselect-user! [{:keys [handle] :as user}]
-            (om/set-state! owner [:org-members-by-handle handle :selected] false))
+  (letfn [(select! [{:keys [handle] :as user}]
+            (om/set-state! owner [:org-members-by-handle handle :selected?] true))
+          (deselect! [{:keys [handle] :as user}]
+            (om/set-state! owner [:org-members-by-handle handle :selected?] false))
           (selected? [{:keys [handle] :as user}]
-            (om/get-state owner [:org-members-by-handle handle :selected]))
-          (set-email! [{:keys [handle] :as user} value]
-            (om/set-state! owner [:org-members-by-handle handle :email] value))
-          (get-email [{:keys [handle] :as user}]
-            (om/get-state owner [:org-members-by-handle handle :email]))]
-    (let [users (when show-modal?
-                  (->> selected-org
-                       :vcs-users-by-handle
+            (om/get-state owner [:org-members-by-handle handle :selected?]))
+          (set-entered-email! [{:keys [handle] :as user} value]
+            (om/set-state! owner [:org-members-by-handle handle :entered-email] value))
+          (get-entered-email [{:keys [handle] :as user}]
+            (om/get-state owner [:org-members-by-handle handle :entered-email]))]
+    (let [{:keys [vcs-users-by-handle]} selected-org
+          users (when show-modal?
+                  (->> vcs-users-by-handle
                        vals
                        (remove :is_user)
                        (sort-by :handle)))
@@ -108,25 +110,24 @@
               (om/set-state! owner
                              :org-members-by-handle
                              (into {}
-                                   (for [[handle {:keys [is_user email provider_id]
+                                   (for [[handle {:keys [is_user email]
                                                   :as user}] new-vcs-users
                                          :when (not is_user)
                                          :let [trimmed-email (some-> email gstr/trim)]]
-                                     [handle {:email trimmed-email
-                                              :login handle
-                                              :id provider_id
-                                              :selected (valid-email? trimmed-email)}]))))))
+                                     [handle {:entered-email trimmed-email
+                                              :selected? (valid-email? trimmed-email)}]))))))

         om/IRenderState
         (render-state [_ {:keys [org-members-by-handle]}]
           (component
            (if show-modal?
              (let [count-with-email (count (filter (fn [[_ user]]
-                                                     (-> user :email valid-email?))
+                                                     (-> user :entered-email valid-email?))
                                                    org-members-by-handle))
                    count-selected (count (filter (fn [[_ user]]
-                                                   (:selected user))
-                                                 org-members-by-handle))]
+                                                   (:selected? user))
+                                                 org-members-by-handle))
+                   selected-members (invitees org-members-by-handle vcs-users-by-handle)]
                (modal/modal-dialog {:title "Invite Teammates"
                                     :body
                                     (element :body
@@ -158,49 +159,49 @@
                                                                                (str "  " handle)])))}
                                                                         {:header "Email"
                                                                          :cell-fn (fn [user]
-                                                                                (let [is-selected (selected? user)
-                                                                                email (get-email user)]
+                                                                                (let [selected? (selected? user)
+                                                                                entered-email (get-entered-email user)]
                                                                                (om/build form/text-field
                                                                                {:on-change (fn [event]
                                                                                (let [trimmed-input (gstr/trim (.. event -currentTarget -value))
                                                                                is-valid (valid-email? trimmed-input)]
-                                                                                (set-email! user trimmed-input)
+                                                                                (set-entered-email! user trimmed-input)
                                                                                (cond
-                                                                                (and (not is-selected)
+                                                                                (and (not selected?)
                                                                                is-valid)
-                                                                                (select-user! user)
-                                                                                (and is-selected
+                                                                                (select! user)
+                                                                                (and selected?
                                                                                (not is-valid))
-                                                                                (deselect-user! user))))
-                                                                                :value email
+                                                                                (deselect! user))))
+                                                                                :value entered-email
                                                                                :size :medium
-                                                                                :validation-error (when (and (or is-selected
-                                                                                (not (empty? email)))
-                                                                                (not (valid-email? email)))
-                                                                                (str email " is not a valid email"))})))}
+                                                                                :validation-error (when (and (or selected?
+                                                                                (not (empty? entered-email)))
+                                                                                (not (valid-email? entered-email)))
+                                                                                (str entered-email " is not a valid email"))})))}
                                                                         {:type :shrink
                                                                          :cell-fn (fn [user]
-                                                                                (let [email (get-email user)
-                                                                                is-valid (valid-email? email)]
+                                                                                (let [entered-email (get-entered-email user)
+                                                                                valid? (valid-email? entered-email)]
                                                                                [:input {:type "checkbox"
-                                                                                :disabled (and (not is-valid)
-                                                                                (not (empty? email)))
+                                                                                :disabled (and (not valid?)
+                                                                                (not (empty? entered-email)))
                                                                                :checked (selected? user)
-                                                                                :on-click #(if-let [is-checked (.. % -currentTarget -checked)]
-                                                                                (when is-valid
-                                                                                (select-user! user))
-                                                                                (deselect-user! user))}]))}]
+                                                                                :on-click #(if-let [checked? (.. % -currentTarget -checked)]
+                                                                                (when valid?
+                                                                                (select! user))
+                                                                                (deselect! user))}]))}]
                                                               :striped? true})]))]))
                                     :actions [(button/button {:on-click close-fn} "Cancel")
                                               (forms/managed-button
                                                [:button.btn.btn-success {:data-success-text "Sent"
                                                                          :on-click #(do
-                                                                                (raise! owner [:invited-github-users {:invitees (invitees org-members-by-handle)
+                                                                                (raise! owner [:invited-github-users {:invitees selected-members
                                                                                :vcs_type (:vcs_type selected-org)
                                                                                :org-name (:name selected-org)}])
                                                                                (close-fn))
-                                                                         :disabled (or (empty? (invitees org-members-by-handle))
-                                                                                (not (every? (comp valid-email? :email) (invitees org-members-by-handle))))}
+                                                                         :disabled (or (empty? selected-members)
+                                                                                (not (every? (comp valid-email? :email) selected-members)))}
                                                 "Send Invites "
                                                 [:i.fa.fa-envelope-o]])]
                                     :close-fn close-fn}))


update misaki.core/update-config

update misaki.core/update-config

--- src/misaki/core.clj
+++ src/misaki/core.clj
@@ -90,15 +90,16 @@
 ; =update-config
 (defn update-config
   "Update basic config with plugin's -config function."
-  [& [compiler]]
-   (let [config (make-basic-config-map)
-         res    (if compiler
-                  (call-compiler-fn compiler :-config config)
-                  (let [compilers (flatten (list (:compiler *config*)))]
-                    (if (= 1 (count compilers))
-                      (call-compiler-fn (first compilers) :-config config)
-                      (map #(call-compiler-fn % :-config config) compilers))))]
-     (or res config)))
+  ([]
+   (let [compilers (-> *config* :compiler list flatten)
+         configs   (map update-config compilers)]
+     (if (next configs)
+       configs
+       (first configs))))
+  ([compiler]
+   (let [config (make-basic-config-map)]
+     (or (call-compiler-fn compiler :-config config) config))))
+

 ; =process-compile-result
 (defn process-compile-result


Update to latest bidi

Update to latest bidi

--- modules/bidi/project.clj
+++ modules/bidi/project.clj
@@ -1,12 +1,12 @@
 ;; Copyright © 2014 JUXT LTD.

-(defproject juxt.modular/bidi "0.9.0"
+(defproject juxt.modular/bidi "0.9.1"
   :description "A modular extension that provides support for bidi routing"
   :url "https://github.com/juxt/modular/tree/master/modules/bidi"
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}
-  :dependencies [[com.stuartsierra/component "0.2.1"]
-                 [bidi "1.18.3"]
+  :dependencies [[com.stuartsierra/component "0.2.2"]
+                 [bidi "1.18.7"]
                  [juxt.modular/ring "0.5.2"]
                  [prismatic/schema "0.3.5"]]
   :profiles {:dev


bidi version prepared for release

bidi version prepared for release

--- modules/bidi/project.clj
+++ modules/bidi/project.clj
@@ -12,7 +12,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.

-(defproject juxt.modular/bidi "0.2.1-SNAPSHOT"
+(defproject juxt.modular/bidi "0.2.1"
   :description "A modular extension that provides support for bidi routing"
   :url "https://github.com/juxt/modular/tree/master/modules/bidi"
   :license {:name "Apache License, Version 2.0"


Refactoring a loop away.

Refactoring a loop away.

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

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

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

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

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


Flesh out metronome adjustment UI.

Flesh out metronome adjustment UI.

Add a monospace font so the numbers stay stable as their values cycle.
Fix the way that string widths are being calculated to work with custom
fonts. Add highlights to indicate the portion of the BPM or beat value
which is beign adjusted. Pass the display frame snapshot into the
interface overlays so they can all work with the same notion of the
current time.

--- src/afterglow/controllers/ableton_push_2.clj
+++ src/afterglow/controllers/ableton_push_2.clj
@@ -42,7 +42,8 @@
                            "/public/fonts/Roboto/Roboto-Regular.ttf"
                            "/public/fonts/Roboto/Roboto-Bold.ttf"
                            "/public/fonts/Roboto/Roboto-Italic.ttf"
-                           "/public/fonts/Roboto/Roboto-BoldItalic.ttf"]]
+                           "/public/fonts/Roboto/Roboto-BoldItalic.ttf"
+                           "/public/fonts/Lekton/Lekton-Regular.ttf"]]
             (.registerFont ge (java.awt.Font/createFont
                                java.awt.Font/TRUETYPE_FONT
                                (.getResourceAsStream Effect font-file))))
@@ -61,6 +62,7 @@
   (case k
     :condensed       (Font. "Open Sans Condensed" Font/BOLD size)
     :condensed-light (Font. "Open Sans Condensed Light" style size)
+    :monospace       (Font. "Lekton" style size)
     :roboto          (Font. "Roboto" style size)
     :roboto-medium   (Font. "Roboto Medium" style size)))

@@ -575,16 +577,18 @@

 (defn draw-cue-variable-value
   "Draw a label under an encoder at the top of the graphical display."
-  [controller index encoder-count text color]
-  (let [graphics (create-graphics controller)
-        space (space-for-encoder-button-label encoder-count)
-        context (.getFontRenderContext graphics)
-        label (fit-string text font-for-cue-variable-values context space)
-        width (string-width label font-for-cue-variable-values context)]
-    (set-graphics-color graphics color)
-    (.setFont graphics font-for-cue-variable-values)
-    (.drawString graphics label
-                 (int (math/round (- (* (+ index (/ encoder-count 2)) button-cell-width) (/ width 2)))) 40)))
+  ([controller index encoder-count text color]
+   (draw-cue-variable-value controller index encoder-count text color font-for-cue-variable-values))
+  ([controller index encoder-count text color font]
+   (let [graphics (create-graphics controller)
+         space (space-for-encoder-button-label encoder-count)
+         context (.getFontRenderContext graphics)
+         label (fit-string text font context space)
+         width (string-width label font context)]
+     (set-graphics-color graphics color)
+     (.setFont graphics font)
+     (.drawString graphics label
+                  (int (math/round (- (* (+ index (/ encoder-count 2)) button-cell-width) (/ width 2)))) 40))))

 (defn draw-attributed-variable-value
   "Draw a label under an encoder at the top of the graphical display,
@@ -694,10 +698,14 @@
   "The color for content in the metronome section, to mark it as such."
   (colors/desaturate (colors/create-color :aqua) 30))

+(def font-for-metronome-values
+  "The font used when drawing metronome values."
+  (get-display-font :monospace Font/PLAIN 22))
+
 (defn- bpm-adjusting-interface
-  "Bold the section of the BPM that is being adjusted, and draw the
-  gauge in a brighter color, or indicate that it is being synced and
-  can't be adjusted."
+  "Brighten the section of the BPM that is being adjusted, and draw
+  the gauge in a brighter color, or indicate that it is being synced
+  and can't be adjusted."
   [controller snapshot]
   (if (= (:type (show/sync-status)) :manual)
     (let [graphics (create-graphics controller)
@@ -706,16 +714,12 @@
           label (java.text.AttributedString. bpm-string)]
       (set-graphics-color graphics metronome-background)
       (.fillRect graphics button-cell-width 21 button-cell-width 20)
-      (.addAttribute label java.awt.font.TextAttribute/FONT font-for-cue-variable-values)
+      (.addAttribute label java.awt.font.TextAttribute/FONT font-for-metronome-values)
       (if (in-mode? controller :shift)
-        (do (.addAttribute label java.awt.font.TextAttribute/FONT font-for-cue-variable-emphasis
-                           0 (- (count bpm-string) 2))
-            (.addAttribute label java.awt.font.TextAttribute/FOREGROUND (java.awt.Color/WHITE)
-                           0 (- (count bpm-string) 2)))
-        (do (.addAttribute label java.awt.font.TextAttribute/FONT font-for-cue-variable-emphasis
-                           (dec (count bpm-string)) (count bpm-string))
-            (.addAttribute label java.awt.font.TextAttribute/FOREGROUND (java.awt.Color/WHITE)
-                           (dec (count bpm-string)) (count bpm-string))))
+        (.addAttribute label java.awt.font.TextAttribute/FOREGROUND (java.awt.Color/WHITE)
+                       0 (- (count bpm-string) 2))
+        (.addAttribute label java.awt.font.TextAttribute/FOREGROUND (java.awt.Color/WHITE)
+                       (dec (count bpm-string)) (count bpm-string)))
       (draw-attributed-variable-value controller 1 1 label metronome-content)
       (draw-gauge controller 1 1 bpm :lowest controllers/minimum-bpm :highest controllers/maximum-bpm
                   :track-color metronome-content :active-color white-color))
@@ -772,13 +776,22 @@
                  (handle-pitch-bend [this message]))))

 (defn- beat-adjusting-interface
-  "Add an arrow showing the beat is being adjusted."
-  [controller]
-  (let [marker (rhythm/metro-marker (:metronome (:show controller)))
-                         arrow-pos (if (in-mode? controller :shift)
-                                     (dec (.indexOf marker "." (inc (.indexOf marker "."))))
-                                     (dec (count marker)))]
-    #_(aset (get (:next-display controller) 2) arrow-pos 0))
+  "Brighten the section of the beat which is being adjusted."
+  [controller snapshot]
+  (let [graphics (create-graphics controller)
+        marker (rhythm/snapshot-marker snapshot)
+        label (java.text.AttributedString. marker)
+        first-dot (.indexOf marker ".")
+        second-dot (.indexOf marker "." (inc first-dot))]
+      (set-graphics-color graphics metronome-background)
+      (.fillRect graphics 0 21 button-cell-width 20)
+      (.addAttribute label java.awt.font.TextAttribute/FONT font-for-metronome-values)
+      (if (in-mode? controller :shift)
+        (.addAttribute label java.awt.font.TextAttribute/FOREGROUND (java.awt.Color/WHITE)
+                       (inc first-dot) second-dot)
+        (.addAttribute label java.awt.font.TextAttribute/FOREGROUND (java.awt.Color/WHITE)
+                       (inc second-dot) (count marker)))
+      (draw-attributed-variable-value controller 0 1 label metronome-content))
   true)

 (defn- adjust-beat-from-encoder
@@ -804,8 +817,8 @@
                (reify controllers/IOverlay
                  (captured-controls [this] #{71})
                  (captured-notes [this] #{0 10})
-                 (adjust-interface [this _]
-                   (beat-adjusting-interface controller))
+                 (adjust-interface [this snapshot]
+                   (beat-adjusting-interface controller snapshot))
                  (handle-control-change [this message]
                    (adjust-beat-from-encoder controller message))
                  (handle-note-on [this message]
@@ -896,7 +909,8 @@
     (if (seq metronome-mode)
       (let [graphics (create-graphics controller)
             bpm (:bpm snapshot)
-            bpm-string (format "%.1f" (double bpm))]
+            bpm-label (java.text.AttributedString. (format "%.1f" (double bpm)))]
+
         ;; Draw the background that makes the metronome section distinctive.
         (set-graphics-color graphics metronome-background)
         (.fillRect graphics 0 0 (* 2 button-cell-width) Wayang/DISPLAY_HEIGHT)
@@ -904,9 +918,10 @@
         ;; Draw the beat and BPM information
         (set-graphics-color graphics metronome-content)
         (draw-encoder-button-label controller 0 1 "Beat" metronome-content)
-        (draw-cue-variable-value controller 0 1 marker metronome-content)
+        (draw-cue-variable-value controller 0 1 marker metronome-content font-for-metronome-values)
         (draw-encoder-button-label controller 1 1 "BPM" metronome-content)
-        (draw-cue-variable-value controller 1 1 bpm-string metronome-content)
+        (.addAttribute bpm-label java.awt.font.TextAttribute/FONT font-for-metronome-values)
+        (draw-attributed-variable-value controller 1 1 bpm-label metronome-content)
         (draw-gauge controller 1 1 bpm :lowest controllers/minimum-bpm :highest controllers/maximum-bpm
                     :track-color metronome-content)

@@ -1476,8 +1491,8 @@
                            (reify controllers/IOverlay
                              (captured-controls [this] #{14})
                              (captured-notes [this] #{10 0})
-                             (adjust-interface [this _]
-                               (beat-adjusting-interface controller))
+                             (adjust-interface [this snapshot]
+                               (beat-adjusting-interface controller snapshot))
                              (handle-control-change [this message]
                                (adjust-beat-from-encoder controller message))
                              (handle-note-on [this message]


Fixes for cider 17 broken nrepl middle ware

--- src/aerobio/core.clj
+++ src/aerobio/core.clj
@@ -50,7 +50,7 @@

             ;; Tunneling Cider nREPL support
             [clojure.tools.nrepl.server :as nrs]
-            [cider.nrepl :refer [cider-middleware]]
+            ;;[cider.nrepl :refer [cider-middleware]] cider.nrepl f*k up
             [refactor-nrepl.middleware :refer [wrap-refactor]]

             [cpath-clj.core :as cp] ; Extract Jar resources
@@ -90,7 +90,7 @@
     :default true]])

 ;; Incorporate correct cider middleware for tunneling nREPL support
-(apply nrs/default-handler (map resolve cider-middleware))
+#_(apply nrs/default-handler (map resolve cider-middleware))

@@ -206,6 +206,23 @@
   (svr/start! port))

+
+(defn nrepl-handler-hack []
+  (require 'cider.nrepl)
+  (let [cm (var-get (ns-resolve 'cider.nrepl 'cider-middleware))
+        ;;cm (filter #(not= % 'cider.nrepl/wrap-pprint-fn) cm)
+        resolve-or-fail (fn[sym] (println :sym sym)
+                          (or (ns-resolve 'cider.nrepl sym)
+                              (throw (IllegalArgumentException.
+                                      (format "Cannot resolve %s" sym)))))]
+    (clojure.pprint/pprint cm)
+    (apply nrs/default-handler
+           (concat (mapv resolve-or-fail cm)
+                   [#'wrap-refactor]))))
+#_(apply nrs/default-handler
+       (concat (map resolve cider-middleware)
+               [#'wrap-refactor]))
+
 (defn -main
   "Self installation and web server"
   [& args]
@@ -218,9 +235,7 @@
         http-port (options :port)
         rpl-port (options :repl-port)
         install? (options :install)
-        nrepl-handler (apply nrs/default-handler
-                             (concat (map resolve cider-middleware)
-                                     [#'wrap-refactor]))]
+        nrepl-handler (nrepl-handler-hack)]
     (if errors
       (do (println "Error(s): " errors)
           (System/exit 1))


use encyclopedic defaults for verbs

use encyclopedic defaults for verbs

--- src/babel/latin.cljc
+++ src/babel/latin.cljc
@@ -1,7 +1,9 @@
 (ns babel.latin
   (:refer-clojure :exclude [get-in])
   (:require [babel.latin.morphology :as morph]
-            [babel.lexiconfn :refer [default listify map-function-on-map-vals]]
+            [babel.lexiconfn :refer [default listify map-function-on-map-vals
+                                     verb-pred-defaults]]
+            [babel.encyclopedia :as encyc]
             [clojure.java.io :refer [resource]]
             [clojure.repl :refer [doc]]
             [dag_unify.core :refer [fail? get-in unifyc]]))
@@ -19,7 +21,8 @@
        {:phrasal false})))

 (def lexicon
-  (edn2lexicon (resource "babel/latin/lexicon.edn")))
+  (-> (edn2lexicon (resource "babel/latin/lexicon.edn"))
+      (verb-pred-defaults encyc/verb-pred-defaults)))

 (defn parse [surface]
   [{:parses (morph/analyze surface lexicon)}])


Simplify enumerator protocol.

Simplify enumerator protocol.

--- src/blocks/store.clj
+++ src/blocks/store.clj
@@ -64,16 +64,8 @@
   "An enumerator provides a way to efficiently iterate over all the stored
   blocks."

-  (-enumerate
-    [store marker]
+  (enumerate
+    [store]
     "Returns a lazy sequence of stored blocks. Blocks are expliticly **not**
     returned in any defined order; it is assumed that the store will enumerate
-    them in the most efficient order available.
-
-    If `marker` is nil, all blocks should be returned in the sequence.
-    Otherwise, it is up to the implementation to resume the enumeration at the
-    marked block.
-
-    The returned blocks should have attached metadata giving a _marker_ for the
-    stream under the key `:block/marker`. This value is implementation-dependent,
-    and can be used to resume the stream from a particular position."))
+    them in the most efficient order available."))


Remove leftover println

Remove leftover println

--- src/braid/client/gateway/user_auth/subs.cljs
+++ src/braid/client/gateway/user_auth/subs.cljs
@@ -25,5 +25,4 @@
 (reg-sub
   :gateway.user-auth/error
   (fn [state _]
-    (println (get-in state [:user-auth :error]))
     (get-in state [:user-auth :error])))


make timestamp-handling in pipeline-state more robust

--- src/clj/lambdacd/internal/pipeline_state.clj
+++ src/clj/lambdacd/internal/pipeline_state.clj
@@ -16,9 +16,10 @@

 (defn- update-current-run [step-id step-result current-state]
   (let [current-step-result (get current-state step-id)
+        now (t/now)
         new-step-result (-> current-step-result
-                            (assoc :most-recent-update-at (t/now))
-                            (put-if-not-present :first-updated-at (t/now))
+                            (assoc :most-recent-update-at now)
+                            (put-if-not-present :first-updated-at now)
                             (merge step-result))]
     (assoc current-state step-id new-step-result)))


Remove more cruft remaining from old collapsible dropdowns.

--- src/cljs/onyx_dashboard/controllers/api.cljs
+++ src/cljs/onyx_dashboard/controllers/api.cljs
@@ -2,9 +2,6 @@
   (:require [cljs-uuid.core :as uuid]))

 (defmulti api-controller (fn [[cmd] _ _] cmd))
-
-(defmethod api-controller :visibility [[_ type visible?] _ state]
-  (assoc-in state [:visible type] visible?))

 (defmethod api-controller :select-job [[_ id] _ state]
   (assoc-in state [:deployment :selected-job] id))


Ephemeral random constants, local shuffles.

--- src/clojush/problems/classification/penn.clj
+++ src/clojush/problems/classification/penn.clj
@@ -44,15 +44,15 @@
                  (vec (concat (take target-column row)
                               (drop (inc target-column) row))))
         target (fn [row] (str (nth row target-column))) ;; target classes are strings
-        fitness-cases-shuffled (shuffle (mapv (fn [row]
-                                                {:inputs (inputs row)
-                                                 :target (target row)})
-                                              (rest raw-data)))
+        fitness-cases-shuffled (lshuffle (mapv (fn [row]
+                                                 {:inputs (inputs row)
+                                                  :target (target row)})
+                                               (rest raw-data)))
         train-num (int (* 0.5 (count fitness-cases-shuffled)))
         all-training-cases (subvec fitness-cases-shuffled 0 train-num)
         all-testing-cases (subvec fitness-cases-shuffled train-num)]
     {:all-train all-training-cases
-     :train (vec (take (int (* training-proportion train-num)) (shuffle all-training-cases)))
+     :train (vec (take (int (* training-proportion train-num)) (lshuffle all-training-cases)))
      :test all-testing-cases}))

 ;; Define the fitness cases once per run, so that train and test
@@ -96,7 +96,7 @@
       (println "Resampling training cases...")
       (swap! penn-fitness-cases
              #(assoc % :train (vec (take (count (:train %))
-                                         (shuffle (:all-train %))))))
+                                         (lshuffle (:all-train %))))))
       (println "New training cases:")
       (println (:train @penn-fitness-cases)))
     ))
@@ -110,7 +110,9 @@
 (def penn-atom-generators
   (vec (concat (distinct (mapv :target (:all-train @penn-fitness-cases))) ;; classes, for output
                (list (tag-instruction-erc [:exec :integer :float :boolean :string] 1000)
-                     (tagged-instruction-erc 1000))
+                     (tagged-instruction-erc 1000)
+                     (fn [] (lrand-int 1000))
+                     (fn [] (lrand 1)))
                (for [n (map inc
                             (range (count (:inputs (first (:train @penn-fitness-cases))))))]
                  (symbol (str "in" n)))


Added debug logging of the elasticsearch query and how long it took.

--- src/cmr/search/data/elastic_search_index.clj
+++ src/cmr/search/data/elastic_search_index.clj
@@ -99,6 +99,7 @@
         sort-params (q2e/query->sort-params query)
         {:keys [index-name type-name fields]} (concept-type->index-info context concept-type query)
         conn (context->conn context)]
+    (debug "Executing elastic query:" (pr-str elastic-query))
     (if (= :unlimited page-size)
       (esd/search conn
                   index-name
@@ -125,6 +126,7 @@
         page-num (:page-num query)
         e-results (send-query-to-elastic context query page-size page-num)
         results (rc/elastic-results->query-results context (:concept-type query) e-results)]
+    (debug "Elastic query took" (:took e-results) "ms")
     (when (and (= :unlimited page-size) (> (:hits results) (count (:references results)))
                (e/internal-error! "Failed to retrieve all hits.")))
     results))


only return active Tables/Fields in autocomplete suggestions.

--- src/metabase/api/database.clj
+++ src/metabase/api/database.clj
@@ -154,7 +154,7 @@
   [id prefix] ; TODO - should prefix be Required/NonEmptyString ?
   (read-check Database id)
   (let [prefix-len (count prefix)
-        table-id->name (->> (sel :many [Table :id :name] :db_id id)                                             ; fetch all name + ID of all Tables for this DB
+        table-id->name (->> (sel :many [Table :id :name] :db_id id :active true)                                             ; fetch all name + ID of all Tables for this DB
                             (map (fn [{:keys [id name]}]                                                         ; make a map of Table ID -> Table Name
                                    {id name}))
                             (into {}))
@@ -166,7 +166,8 @@
                                     [table-name "Table"])))
         fields (->> (sel :many [Field :name :base_type :special_type :table_id]                                 ; get all Fields with names that start with PREFIX
                          :table_id [in (keys table-id->name)]                                                   ; whose Table is in this DB
-                         :name [like (str prefix "%")])
+                         :name [like (str prefix "%")]
+                         :active true)
                     (map (fn [{:keys [name base_type special_type table_id]}]                                    ; return them in the format
                            [name (str (table-id->name table_id) " " base_type (when special_type                ; [field_name "table_name base_type special_type"]
                                                                                (str " " special_type)))])))]


add piece and position to state, and draw on state change

--- src/client/core.cljs
+++ src/client/core.cljs
@@ -48,7 +48,17 @@
                   [0 0 0 0 0 0 0 0 0 0]
                   [0 0 0 0 0 0 0 0 0 0]])

-(def state (atom {:board empty-board}))
+(defn get-rand-piece
+  "Return a random piece."
+  []
+  (pieces (rand-nth (keys pieces))))
+
+; The starting position of all pieces.
+(def start-position [4 2])
+
+(def state (atom {:piece (get-rand-piece)
+                  :position start-position
+                  :board empty-board}))

 (defn get-cell-color
   [cell]
@@ -145,6 +155,27 @@
       (draw-cell ctx x y board))
     nil))

+(defn create-drawable-board
+  "Creates a new drawable board, by combining the current piece with the current board."
+  []
+  (let [piece (:piece @state)
+        [x y] (:position @state)
+        board (:board @state)]
+  (write-piece-to-board piece x y board)))
+
+(defn draw-state
+  "Draw the current state of the board."
+  []
+  (draw-board (create-drawable-board)))
+
+(add-watch state :draw draw-state)
+
+(defn spawn-piece!
+  "Spawns a random piece at the starting position."
+  []
+  (swap! state assoc :piece (get-rand-piece)
+                     :position start-position))
+
 (defn auto-refresh
   "Automatically refresh the page whenever a cljs file is compiled."
   []
@@ -155,7 +186,7 @@
 (defn init []
   (connect-repl)
   (size-canvas)
-  (draw-board (:board @state))
+  (spawn-piece!)

   (auto-refresh)
   )


replaced a `loop` with `reduce` - code reduced!

--- src/midje/checkers/chatty.clj
+++ src/midje/checkers/chatty.clj
@@ -41,30 +41,24 @@
        (not (quoted? arg))))

 (defn chatty-untease [result-symbol arglist]
-  (loop [ [current-arg & remainder :as arglist] arglist
-          complex-forms []
-          substituted-arglist []]
-    (cond (empty? arglist)
-          [complex-forms substituted-arglist]
-
-          (chatty-worth-reporting-on? current-arg)
-          (recur remainder (conj complex-forms current-arg)
-                 (conj substituted-arglist `(~result-symbol ~(count complex-forms))))
-
-          :else
-          (recur remainder complex-forms (conj substituted-arglist current-arg)))))
+  (reduce (fn [[complex-forms substituted-args] current-arg]
+              (if (chatty-worth-reporting-on? current-arg)
+                [ (conj complex-forms current-arg),
+                  (conj substituted-args `(~result-symbol ~(count complex-forms))) ]
+                [complex-forms, (conj substituted-args current-arg)]))
+      [[] []]
+      arglist))

 (defmacro chatty-checker
   "Create a function that returns either true or a detailed description of a failure."
-  [ [binding-var] [function & arglist] ]
+  [ [binding-var] [f & args] ]
   (let [result-symbol (gensym "chatty-intermediate-results-")
-        [complex-forms substituted-arglist] (chatty-untease result-symbol arglist)]
+        [complex-forms substituted-args] (chatty-untease result-symbol args)]
     `(as-chatty-checker
       (fn [~binding-var]
         (let [~result-symbol (vector ~@complex-forms)]
-          (if (chattily-false? (~function ~@substituted-arglist))
+          (if (chattily-false? (~f ~@substituted-args))
             (let [pairs# (pairs '~complex-forms ~result-symbol)]
               (as-chatty-falsehood {:actual ~binding-var,
                                     :intermediate-results pairs#}))
-            true))))))
-
+            true))))))