added more contract tests

added more contract tests

--- test/fogus/me/contract_tests.clj
+++ test/fogus/me/contract_tests.clj
@@ -15,7 +15,7 @@
   (:use [fogus.me.trammel :only [contract]])
   (:use [clojure.test :only [deftest is]]))

-(def doubler-contract
+(def doubler-contract-full
      (contract doubler
        [x]
        :requires
@@ -31,11 +31,54 @@
        (= (* 2 (+ x y)) %)))

 (deftest doubler-contract-test
-  (is (= 10 ((partial doubler-contract #(* 2 (+ %1 %2))) 2 3)))
-  (is (= 10 ((partial doubler-contract #(+ %1 %1 %2 %2)) 2 3)))
-  (is (= 10 ((partial doubler-contract #(* 2 %)) 5)))
-  (is (thrown? Error ((partial doubler-contract #(* 3 (+ %1 %2))) 2 3))))
+  (is (= 10 ((partial doubler-contract-full #(* 2 (+ %1 %2))) 2 3)))
+  (is (= 10 ((partial doubler-contract-full #(+ %1 %1 %2 %2)) 2 3)))
+  (is (= 10 ((partial doubler-contract-full #(* 2 %)) 5)))
+  (is (thrown? Error ((partial doubler-contract-full #(* 3 (+ %1 %2))) 2 3))))
+
+
+(def doubler-contract-arity1
+     (contract doubler
+       [x]
+       :requires
+       (pos? x)
+       :ensures
+       (= (* 2 x) %)))
+
+(deftest doubler-contract-arity1-test
+  (is (= 10 ((partial doubler-contract-arity1 #(* 2 %)) 5)))
+  (is (= 10 ((partial doubler-contract-arity1 #(* 2 %)) 5)))
+  (is (thrown? Error ((partial doubler-contract-arity1 #(* 3 %)) 5)))
+  (is (thrown? Error ((partial doubler-contract-arity1 #(* 2 %)) -5))))
+
+
+(def doubler-contract-no-requires
+     (contract doubler
+       [x]
+       :ensures
+       (= (* 2 x) %)))
+
+(deftest doubler-contract-no-requires-test
+  (is (= 10 ((partial doubler-contract-no-requires #(* 2 %)) 5)))
+  (is (= -10 ((partial doubler-contract-no-requires #(* 2 %)) -5)))
+  (is (thrown? Error ((partial doubler-contract-no-requires #(* 3 %)) 5))))
+
+
+(def doubler-contract-no-ensures
+     (contract doubler
+       [x]
+       :requires
+       (pos? x)))
+
+(deftest doubler-contract-no-ensures-test
+  (is (= 10 ((partial doubler-contract-no-ensures #(* 2 %)) 5)))
+  (is (= 15 ((partial doubler-contract-no-ensures #(* 3 %)) 5)))
+  (is (thrown? Error ((partial doubler-contract-no-ensures #(* 2 %)) -5))))
+

 (deftest contract-test
-  (doubler-contract-test))
+  (doubler-contract-test)
+  (doubler-contract-arity1-test)
+  (doubler-contract-no-requires-test)
+  (doubler-contract-no-ensures-test))


Changed atom to var to avoid clashes - atoms are not sufficiently unique as they cannot exist within a namespace, unlike vars.

--- src/plugboard/plugboard.clj
+++ src/plugboard/plugboard.clj
@@ -1,11 +1,13 @@
 (ns plugboard.plugboard)
+
+(def ^{:private true} _path)

 (def
  ^{:doc "The relative path of the web resource. Web resources are identified
  by URIs. Web applications are usually responsible for a number of web
  resources, so the path given by the client must often be decoded from the
  URI."}
- path (atom :path))
+ path (var _path))

 (def transition-map


WIP remote tests

WIP remote tests

--- test/runbld/test/system_test.clj
+++ test/runbld/test/system_test.clj
@@ -11,4 +11,4 @@
 (deftest basic
   ;; schema does most of the work here, just want to see if it returns
   ;; a map that matches it
-  (is (system/inspect-system {:process {:cwd "."}})))
+  (is (system/inspect-system ".")))


Changed validation error message back.

Changed validation error message back.

--- src/qu/query/validation.clj
+++ src/qu/query/validation.clj
@@ -142,7 +142,7 @@
                     :default (Integer/parseInt val))]
             query)
           (catch NumberFormatException e;
-           (add-error query clause "Please enter a number."))))))
+           (add-error query clause "Please use an integer."))))))

 (defn- validate-max-offset
   [query]


try catch for executors

try catch for executors

--- src/riak_mesos/executor.clj
+++ src/riak_mesos/executor.clj
@@ -9,12 +9,17 @@
                                               (println "Framework Registered"))
                  (launchTask [driver task-info]
                              (println "[launchTask] Sending status Update")
-                             (exec/send-status-update driver {:task-id (:task-id task-info)
-                                                              :task-state 1
-                                                              :message "Riak Task is running" } ))
+                             (try
+                               (exec/send-status-update driver {:task-id (:task-id task-info)
+                                                               :task-state 1
+                                                                :message "Riak Task is running" } )
+                               (catch Exception e (.printStackTrace e))))
                  (frameworkMessage [driver bytes] (let [command-string (read-string (String. bytes "UTF-8"))]
                                                     (println "[frameworkMessage] Running command " command-string )
-                                                    (future (apply clojure.java.shell/sh  (clojure.string/split command-string #"\s+") ))))))
+                                                    (future (try
+                                                              (apply clojure.java.shell/sh  (clojure.string/split command-string #"\s+") ))
+                                                            (catch Exception e (.printStackTrace e))
+                                                            )))))


Throw an exception if a snippet resource is not found.

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -371,7 +371,10 @@
   (mustache/render-file template-name vars))

 (defn snippet [path]
-  (slurp (clojure.java.io/resource path)))
+  (let [snippet-file (clojure.java.io/resource path)]
+    (if (nil? snippet-file)
+      (throw (Exception. (str "No resource found: " path)))
+      (slurp snippet-file))))

 (defn database [{:keys [name subnet] :as spec}]
   (merge-in


Checkpoint trivial debug tweaks in clojurifier.

--- src/skylark/clojurifier.clj
+++ src/skylark/clojurifier.clj
@@ -34,6 +34,7 @@

 (defn do-conj [a r] (match [r] [(['do & s] :seq)] `(~'do ~a ~@s) :else `(~'do ~a ~r)))

+;; TODO: support changing set of bindings and effects
 (defn &Csuite [x]
   (letfn [(&let-form [s n a b r]
             (&let [a (&C a) r (&Csuite r)]
@@ -63,8 +64,8 @@
     :else `(~'if ~test ~then ~else)))

 (defn sort-effects [fx]
-  {:pre [(do (DBG :sort-effects fx) true)]
-   :post [(do (DBG :sort-effects=> %) true)]}
+  {:pre [(do (DBG "sort-effects <=" fx) true)]
+   :post [(do (DBG "sort-effects =>" %) true)]}
   (concat (filter (let [e (:effects fx)] #(get e %)) [:return :raise :break :continue :yield])
           (sort (map first (filter second (:vars fx))))))

@@ -83,7 +84,7 @@
   ;;   IF there are no escaping bindings in the test, THEN we can use cond,
   ;;   and merge with the other things with cond-conj
   (fn [E]
-    (DBG :&Ccond test-thens else meta E)
+    ;;(DBG :&Ccond test-thens else meta E)
     (let [effects-that-matter-after-cond
           ;; merge local result from continuation-analysis with accumulated context
           (ka/env-both (get meta :capturing) (get E :capturing))
@@ -126,13 +127,13 @@
         (&let [sym (&resolve-id s)
                status (fn [E] [(lookup-var s x E) E])
                info (&return (source-info x))
-               * (do (DBG :&C-id sym status info)
+               * (do ;; (DBG :&C-id sym status info)
                      (&r (case status
                            (:linear :required) sym
                            (true :affine) `(~'$ensure-not-nil ~sym ~info)
                            (nil false) `(~'$unbound-variable ~sym ~info))))])
         [[:suite & as]] (&Csuite as)
-        [[:bind [:id s] :as n a]] (do (DBG :bind s a) (&C a)) ;; no suite to consume the binding
+        [[:bind [:id s] :as n a]] (&C a) ;; no suite to consume the binding
         [[:unbind [:id s]]] &nil
         [[:constant c]] (&resolve-constant c)
         [[:builtin b & as]]
@@ -145,6 +146,7 @@
         ;; handles argument in the *outer* scope where the function is defined,
         ;; *NOT* in the inner scope that the function defines (see :function for that)
         (&m (&into [:argument id] (&C type) (&C default)))
+        [[:return a]] (&m (&tag :return (&C a)))
         [[:function args return-type body]]
         (&m (&let [args (&Cargs args) ; handle type and default
                    return-type (&C return-type)]
@@ -153,7 +155,6 @@
                         [body innerE] ((&C body) innerE)]
                     (M (check-effects x innerE true)
                        :function args return-type body))))
-        [[:return a]] (&m (&tag :return (&C a)))
         [[(:or ':from ':import ':break ':continue) & _]] (&x)
         [[:unwind-protect body protection]]
         (&m (&tag :unwind-protect (&C body) (&C protection)))


catch only map exceptions

catch only map exceptions

--- src/vindinium/core.clj
+++ src/vindinium/core.clj
@@ -29,7 +29,7 @@
   "makes a POST request and returns a parsed input"
   (try+
     (parse-input (:body (http/post url {:form-params params :as :json})))
-    (catch [] {:keys [status body]}
+    (catch map? {:keys [status body]}
       (println (str "[" status "] " body))
       (throw+))))


Repair errors in sequence

Repair errors in sequence

--- src/test_utils/sandbox.cljs
+++ src/test_utils/sandbox.cljs
@@ -107,17 +107,17 @@
          start-duration-min (int (* 60 (- start-duration start-duration-h)))
          start-duration-s (rand-nth (range 60))
          start [start-a start-mo start-d
-                (+ start-h start-duration-h)
-                (+ start-min start-duration-min)
-                (+ start-s start-duration-s)]
+                (rem (+ start-h start-duration-h) 24)
+                (rem (+ start-min start-duration-min) 60)
+                start-duration-h]
          stop-duration (tuc/draw-normal 2.52 0.17)
          stop-duration-h (int stop-duration)
          stop-duration-min (int (* 60 (- stop-duration stop-duration-h)))
          stop-duration-s (rand-nth (range 60))
          stop [start-a start-mo start-d
-               (+ (nth start 3) stop-duration-h)
-               (+ (nth start 4) stop-duration-min)
-               (+ (nth start 5) stop-duration-s)]]
+               (rem (+ (nth start 3) stop-duration-h) 24)
+               (rem (+ (nth start 4) stop-duration-min) 60)
+               stop-duration-s]]
      [start stop])))

 (defn treatment-times []


* handler.clj (backend): Tiny refactoring.

--- src/wlmmap/handler.clj
+++ src/wlmmap/handler.clj
@@ -201,7 +201,7 @@
                rep (str (wcar* (car/hget stats "rep")))
                cont (wcar* (car/hget stats "continue"))
                updt (wcar* (car/hget stats "updated"))
-               size (wcar* (car/hget (str "s" fval lval) "size"))]
+               size (wcar* (car/hget stats "size"))]
            [:tr {:style (str "background-color: white")}
             [:form {:method "POST" :action "/process"}
             [:td {:style "width: 100px;"} size]


Don't need to test this primitive

Don't need to test this primitive

--- src/useful/experimental.clj
+++ src/useful/experimental.clj
@@ -130,7 +130,8 @@
          (extend ~name
            ~@(apply concat proto-fns))))))

-(defn wrap-with [f wrapper-var & [name]]
+(defn wrap-with ^{:dont-test "Tested by make-wrappable!, wrap-multiple"}
+  [f wrapper-var & [name]]
   (with-meta
     (fn [& args]
       (let [wrappers (not-empty @wrapper-var)]


HTML phonebook entries

HTML phonebook entries

--- dev/src/yada/dev/phonebook.clj
+++ dev/src/yada/dev/phonebook.clj
@@ -113,8 +113,14 @@
   m/Get
   (GET [_ ctx]
     (let [id (get-in ctx [:parameters :path :entry])
-          entry (get @(:phonebook db) id)]
-      entry)))
+          {:keys [firstname surname phone] :as entry} (get @(:phonebook db) id)]
+      (case (yada/content-type ctx)
+        "text/html"
+        (html [:body
+               [:h2 (format "%s %s" firstname surname)]
+               [:p "Phone: " phone]
+               [:p [:a {:href (path-for (:routes @*router) ::phonebook)} "Index"]]])
+        entry))))

 (defn phonebook-api [db *router]
   ["/phonebook" {"" (yada (->Phonebook db *router) {:id ::phonebook})


Tests for firsts.

Tests for firsts.

--- test/little_clojurer/chapter3_test.clj
+++ test/little_clojurer/chapter3_test.clj
@@ -11,37 +11,48 @@
     (is (= '(2 1 3 4 1) (rember 1 '(1 2 1 3 4 1))))))

-(deftest firsts
-  (testing))
+(deftest firsts-test
+  (testing
+    (is (= '(1 2 3 4) (firsts '((1 2) (2 3) (3 4) (4 5)))))
+    (is (= '() (firsts '())))
+    (is (= '(()) (firsts '((())))))))

-(deftest insertR
-  (testing))
+(deftest insertR-test
+  (testing
+    (is true)))

-(deftest insertL
-  (testing))
+(deftest insertL-test
+  (testing
+    (is true)))

-(deftest subst
-  (testing))
+(deftest subst-test
+  (testing
+    (is true)))

-(deftest subst2
-  (testing))
+(deftest subst2-test
+  (testing
+    (is true)))

-(deftest multirember
-  (testing))
+(deftest multirember-test
+  (testing
+    (is true)))

-(deftest multiinsertR
-  (testing))
+(deftest multiinsertR-test
+  (testing
+    (is true)))

-(deftest multiinsertL
-  (testing))
+(deftest multiinsertL-test
+  (testing
+    (is true)))

-(deftest multisubst
-  (testing))
+(deftest multisubst-test
+  (testing
+    (is true)))


delaney.clj: added core algorithm of minimal image computation

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -1,6 +1,7 @@
 (ns org.gavrog.clojure.delaney
   (:require (clojure [string :as s]))
   (:use (clojure test)
+        (org.gavrog.clojure partition)
         (org.gavrog.clojure util))
   (:import (org.gavrog.joss.dsyms.basic DelaneySymbol DSMorphism)
            (java.io Writer)))
@@ -166,6 +167,30 @@
               (/ (s D) (v D)))))
   ([ds]
     (curvature ds 0)))
+
+(defn- type-map [ds]
+  (reduce (fn [m [D x]] (assoc m D (conj (or (m D) []) x)))
+          {}
+          (for [[i j] (map vector (indices ds) (rest (indices ds)))
+                D (orbit-reps ds [i j])
+                :let [x (m ds i j D)]
+                E (orbit ds [i j] D)]
+            [E x])))
+
+(defn- type-partition [ds]
+  (let [D0 (first (elements ds))
+        tm (type-map ds)
+        spread (fn [D E] (for [i (indices ds)] [(s ds i D), (s ds i E)]))
+        unite (fn [p A B]
+                (loop [p p, q (conj empty-queue [A B])]
+                  (if-let [[D E] (first q)]
+                    (cond
+                      (= (pfind p D) (pfind p E))
+                      (recur p (pop q))
+                      (= (tm D) (tm E))
+                      (recur (punion p D E) (apply conj (pop q) (spread D E))))
+                    p)))]
+    (reduce (fn [p D] (or (unite p D0 D) p)) pempty (rest (elements ds)))))

 ;; === Persistent Clojure implementation of IDSymbol with some common


Refactor middleware tests.

Refactor middleware tests.

--- test/webdev/common/middleware_test.clj
+++ test/webdev/common/middleware_test.clj
@@ -13,29 +13,26 @@
             response)))))

 (deftest wrap-simulated-methods-middleware
-  (testing "POST request with a DELETE param"
-    (let [middleware (wrap-simulated-methods identity)
-          request {:request-method :post
-                   :params {"_method" "DELETE"}}
-          response (middleware request)]
-      (is (= :delete (:request-method response)))))
+  (let [middleware (wrap-simulated-methods identity)]
+    (testing "POST request with a DELETE param"
+      (let [request {:request-method :post
+                     :params {"_method" "DELETE"}}
+            response (middleware request)]
+        (is (= :delete (:request-method response)))))

-  (testing "POST request with a PUT param"
-    (let [middleware (wrap-simulated-methods identity)
-          request {:request-method :post
-                   :params {"_method" "PUT"}}
-          response (middleware request)]
-      (is (= :put (:request-method response)))))
+    (testing "POST request with a PUT param"
+      (let [request {:request-method :post
+                     :params {"_method" "PUT"}}
+            response (middleware request)]
+        (is (= :put (:request-method response)))))

-  (testing "POST request without a _method"
-    (let [middleware (wrap-simulated-methods identity)
-          request {:request-method :post}
-          response (middleware request)]
-      (is (= :post (:request-method response)))))
+    (testing "POST request without a _method"
+      (let [request {:request-method :post}
+            response (middleware request)]
+        (is (= :post (:request-method response)))))

-  (testing "POST request with an unknown param"
-    (let [middleware (wrap-simulated-methods identity)
-          request {:request-method :post
-                   :params {"_method" "foo"}}
-          response (middleware request)]
-      (is (= :post (:request-method response))))))
+    (testing "POST request with an unknown param"
+      (let [request {:request-method :post
+                     :params {"_method" "foo"}}
+            response (middleware request)]
+        (is (= :post (:request-method response)))))))


Implement type checking.

Implement type checking.

--- src/smallex/grammar_checks.clj
+++ src/smallex/grammar_checks.clj
@@ -22,7 +22,7 @@

 (defn- check-expr-arity
   "Recursively checks that an expression uses correct arity, and returns a
-  lazy seq of the erroneous calls as maps."
+  lazy seq of the erroneous calls as ExceptionInfos."
   [expr-name expr]
   (cond (not= :op (:type expr)) ()
         (-> expr meta :alias-expansion) () ;; Should be handled in resp. aliases
@@ -46,3 +46,41 @@
    (mapcat (fn [[r-name r-expr]]
              (check-expr-arity r-name r-expr))
            (:rules grammar))))
+
+(defn- check-expr-arg-type
+  "Recursively checks that an expression has correct input arg types, and
+  returns a lazy seq of the erroneous calls as ExceptionInfos."
+  [expr]
+  (if (and (= :op (:type expr))
+           (not (-> expr meta :alias-expansion)))
+    (concat
+     (case (:value expr)
+       (:cat :opt :plus :star) nil
+       :or (if (some #(not= :char-set (-> % meta :result))
+                     (:args expr))
+             (let [unexpected-arg-results
+                   (->> (:args expr)
+                        (map-indexed vector)
+                        (filter (fn [[_ e]]
+                                  (not= :char-set (-> e meta :result))))
+                        (into {}))]
+               (list
+                (ex-info "`or` requires all arguments to evaluate to char-sets."
+                         {:type :arg-type, :expr expr,
+                          :culprits unexpected-arg-results}))))
+       :not (if (-> expr :args first meta :value (not= :char-set))
+              (list
+               (ex-info "`not` requires its argument to evaluate to a char-set."
+                        {:type :arg-type, :expr expr,
+                         :culprits {0 (first (:args expr))}}))))
+     (mapcat check-expr-arg-type (:args expr)))))
+
+(defn check-arg-type
+  "Checks that all operations are given the correct argument type. Requires that
+  the :result metadata key is attached to all expressions, e.g. by invoking
+  `smallex.reductions/add-arg-results`. Returns a lazy seq of the erroneous
+  calls as ExceptionInfos."
+  [grammar]
+  (mapcat check-expr-arg-type
+          (concat (vals (:aliases grammar))
+                  (vals (:rules grammar)))))


Only treat proper functions as ContentReaders.

--- src/blocks/data.clj
+++ src/blocks/data.clj
@@ -208,7 +208,7 @@
     (bounded-input-stream (.open this) start end))

-  clojure.lang.IFn
+  clojure.lang.Fn

   (read-all
     [this]


pass port in the main

pass port in the main

--- src/casper/core.clj
+++ src/casper/core.clj
@@ -82,9 +82,8 @@

 (def app (handler/site casper-routes))

-(defn -main [& m]
-  ;(run-jetty app {:port 8080 })
-  (run-jetty app )
+(defn -main [& port]
+  (run-jetty app {:port (Integer/parseInt (first port)) })
 )

 ;(run-jetty app {:port 8080})


Improve alt scrolling by removing global mutable state.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -31,8 +31,6 @@
 (def ^:dynamic *jline-output-stream* System/out)

 (def ^:dynamic *line-sep* (System/getProperty "line.separator"))
-
-(def __cli4clj_options__ (atom nil))

 (defn cli-repl-print
   "The default repl print function of cli4clj only prints non-nil values."
@@ -374,8 +372,8 @@
   [opts]
   (add-args-info opts))

-(defmacro with-alt-scroll-out
-  [& body]
+(defmacro wrap-alt-scroll-writer
+  [options & body]
   `(let [stdout# *out*
          new-line# (atom true)
          term# (TerminalFactory/create)
@@ -391,7 +389,7 @@
                                java.lang.Integer (str (char obj#))
                                (str obj#))
                            term-height# (.getHeight term#)
-                           alternate-height# (@__cli4clj_options__ :alternate-height)]
+                           alternate-height# (~options :alternate-height)]
                        (binding [*out* stdout#]
                          (when @new-line#
                            (reset! x# 1)
@@ -408,7 +406,7 @@
                          (print "\u001B[u")
                          (flush))))))]
      (fn []
-       (binding [*out* (if (@__cli4clj_options__ :alternate-scrolling)
+       (binding [*out* (if (~options :alternate-scrolling)
                          wrtr#
                          stdout#)]
          ~@body))))
@@ -418,17 +416,22 @@
    Please note that the configuration options can also be defined in a global or local var.
    However, in order to lookup arguments defined in anonymous functions, the configuration options have to be defined directly in the macro call."
   [user-options]
-  (let [options-with-args-info (add-args-info user-options)]
-  (reset! __cli4clj_options__ options-with-args-info)
-    `(let [options# (assoc
-                      (get-cli-opts ~options-with-args-info)
+  (let []
+    `(let [_tmp_options# (atom {})
+           ~'with-alt-scroll-out (fn [& body#] (wrap-alt-scroll-writer @_tmp_options# body#))
+           user-options# ~user-options
+           options-with-args-info# (add-args-info user-options#)
+           options# (assoc
+                      (get-cli-opts options-with-args-info#)
                       :calling-ns ~*ns*)]
-       ((with-alt-scroll-out
-         (main/repl
-           :eval ((options# :eval-factory) options#)
-           :print (options# :print)
-           :prompt (options# :prompt-fn)
-           :read (*read-factory* options#)))))))
+       (swap! _tmp_options# into options#)
+       ((wrap-alt-scroll-writer
+          options#
+          (main/repl
+            :eval ((options# :eval-factory) options#)
+            :print (options# :print)
+            :prompt (options# :prompt-fn)
+            :read (*read-factory* options#)))))))

 (defn create-embedded-read-fn
   "This creates a read fn intended for use in the embedded CLI."


[#5] Remove old ClojureScript SPA veiw layer

--- src/kmg/client.cljs
+++ src/kmg/client.cljs
@@ -1,193 +0,0 @@
-(ns kmg.client
-  (:require [enfocus.core :as ef :refer (set-attr from at get-prop do-> after
-                                                  remove-node content substitute)]
-            [enfocus.events :as events :refer (listen)]
-            [ajax.core :refer [GET POST]])
-  (:require-macros [enfocus.macros :as em]))
-
-;; DEPRECATED. From now on application will be SPA less. Remain it here just for convinience of migration.
-;; FIXME: Delete this after migration to Enlive will be finished
-
-(declare try-mark-as-completed try-change-goal try-load-recommendations try-load-recommendations-completed start media-title)
-
-(enable-console-print!)
-
-(def user (atom {:username "user2"}))
-(def user-data (atom {}))
-
-(def tmpl "/html/kmg.html")
-
-(em/defsnippet kmg-header tmpl ".kmg-header" [])
-(em/defsnippet kmg-content tmpl "#content" [])
-(em/defsnippet kmg-sidebar tmpl "#sidebar" [])
-
-(em/defsnippet user-choose-elem tmpl ".user-option-id" [user]
-  ".user-option-id" (ef/do-> (ef/content user)
-                             (ef/set-attr :value user)))
-
-(em/defsnippet background-media tmpl "#recommendation-background" [{:keys [media completed]}]
-  "#background-media-title" (ef/content (str (media-title media)))
-  "#background-media-status" (ef/content (str "Is completed: " completed)))
-
-(em/defsnippet translation-media tmpl "#recommendation-translation" [{:keys [media]}]
-  "#translation-media-title" (ef/content (str (media-title media)))
-  "#translation-media-language" (ef/content (str (:media/locale media))))
-
-(em/defsnippet domain-title tmpl "#domain-title" [domain]
-  "#domain-title" (ef/content (str (:domain/title domain))))
-
-(defn not-all-backgrounds-completed? [backgrounds]
-  (some false? (for [b backgrounds] (:completed b))))
-
-(defn authors-string [authors]
-  (->> (map :author authors)
-     (map :author/name)
-     (clojure.string/join ", ")))
-
-(def type->icon {:media.type/book "book"
-                 :media.type/article "file"
-                 :media.type/video "film"
-                 :media.type/podcast "headphones"
-                 :media.type/course "book"
-                 :media.type/blog "file"})
-
-(defn media-icon-span [media]
-  (str "icon (:media/type media)) "\"> "))
-
-(defn media-title [media]
-  (str (media-icon-span media) (:media/title media) " " ))
-
-(defn media-url [media]
-  (if (:media/url media)
-    (str "" (:media/url media) "
 ")
-    ""))
-
-(em/defsnippet recommendation tmpl ".recommendation" [{:keys [recommendation media backgrounds translations authors]}]
-  "#recommendation-title" (ef/content (media-title media))
-  "#recommendation-subtitle" (ef/content (str (:media/subtitle media) " " ))
-  "#recommendation-authors" (ef/content (authors-string authors))
-  "#recommendation-description" (ef/content
-     (str (media-url media)
-          (:recommendation/description recommendation) "
 "
-          (:media/isbn media)
-          " Year of issue: " (:media/year media)
-          " Necessary: " (:recommendation/necessary recommendation) " Priority: " (:recommendation/priority recommendation)
-          " Type: " (:media/type media)))
-
-  "#complete" (events/listen :click #(try-mark-as-completed recommendation))
-  "#complete" (if (not-all-backgrounds-completed? backgrounds) (ef/set-attr :disabled "disabled"))
-  "#recommendation-backgrounds-title" (if (empty? backgrounds) (ef/set-attr :hidden "hidden"))
-  "#recommendation-translations-title" (if (empty? translations) (ef/set-attr :hidden "hidden"))
-
-  ".recommendation-backgrounds" (ef/content (map background-media backgrounds))
-  ".recommendation-translations" (ef/content (map translation-media translations)))
-
-(em/defsnippet recommendation-completed tmpl ".recommendation-completed" [{:keys [media]}]
-  ".recommendation-completed-title" (ef/content (media-title media)))
-
-(em/defsnippet specialization-available tmpl ".specialization-available" [specialization]
-  ".specialization-available-title" (ef/content (:specialization/title specialization))
-  "#choose" (events/listen :click #(try-change-goal specialization)))
-
-(em/defsnippet specialization-comleted tmpl ".specialization-completed" [specialization]
-  ".specialization-completed-title"
-  (ef/content (:specialization/title specialization))
-  "#show-recommendations" (events/listen :click #(try-load-recommendations specialization)))
-
-(defn error-handler [{:keys [status status-text response]}]
-  (js/alert (str "something bad happened: " status " " status-text))
-  (println  (str "Something bad happened: " status "; Status text: " status-text "; Response: " response)))
-
-(defn recommendation-list [data]
-  (ef/at "#inner-content"
-         (ef/content (map recommendation data))))
-
-(defn recommendation-completed-list [data]
-  (ef/at "#recommendations-completed"
-         (ef/content (map recommendation-completed data))))
-
-(defn specialization-available-list [data]
-  (ef/at "#specializations-available"
-         (ef/content (map specialization-available data))))
-
-(defn specialization-completed-list [data]
-  (ef/at "#specializations-completed"
-         (ef/content (map specialization-comleted data))))
-
-(defn data-changed? [data data-part]
-  (if (= {} @user-data) true
-      (not= (data-part data) (data-part @user-data))))
-
-(defn render-if-changed [render-function data data-part]
-  (if (data-changed? data data-part) (render-function (data-part data))))
-
-(defn render-whole-user-data [data]
-  #_(recommendation-list (:recommendations data))
-  (render-if-changed recommendation-list data :recommendations)
-  (render-if-changed recommendation-completed-list data :recommendations-completed)
-  (render-if-changed specialization-available-list data :specializations-available)
-  (render-if-changed specialization-completed-list data :specializations-completed)
-  (reset! user-data data))
-
-(defn try-load-recommendations
-  ([]
-  (GET (str "/recommendation/list/" (:username @user))
-       {:handler recommendation-list
-        :error-handler error-handler}))
-  ([specialization] (GET (str "/recommendation/list/" (:username @user) "/" (:specialization/id specialization))
-       {:handler recommendation-list
-        :error-handler error-handler})))
-
-(defn try-load-whole-user-data []
-  (GET (str "/data/" (:username @user))
-       {:handler render-whole-user-data
-        :error-handler error-handler}))
-
-(defn refresh []
-  (try-load-whole-user-data))
-
-(defn try-mark-as-completed [recommendation]
-  (POST (str "/recommendation/mark-as-completed/" (:username @user) "/" (:recommendation/id recommendation))
-        {:handler refresh
-         :error-handler error-handler}))
-
-(defn try-change-goal [specialization]
-  (POST (str "/specialization/change-goal/" (:username @user) "/" (:specialization/id specialization))
-        {:handler refresh
-         :error-handler error-handler}))
-;; TODO: How to avoid blinking of sample value for select?
-;; May be make it hide by-default and make it shown after transformation
-(defn show-user-choose [users]
-  (ef/at "#users-id" (ef/content (map user-choose-elem users))))
-
-(defn show-domain [domain]
-  (ef/at "#domain-title" (ef/content (:domain/title domain))))
-
-(defn try-load-domain []
-  (GET "/domain" {:handler show-domain
-                  :error-handler error-handler}))
-
-(defn try-get-users []
-  (GET "/user/list" {:handler show-user-choose
-                     :error-handler error-handler}))
-
-(em/defaction observe-change-user []
-  ["#users-id"]
-  (events/listen :change
-                 #((do (reset! user
-                               {:username (ef/from "#users-id" (get-prop :value))})
-                       (refresh)))))
-
-(defn start []
-  (ef/at ".container"
-         (ef/do-> (ef/content (kmg-header))
-                  (ef/append (kmg-content))
-                  (ef/append (kmg-sidebar))))
-  (try-load-domain)
-  (refresh)
-  (try-get-users)
-  (observe-change-user))
-
-(set! (.-onload js/window) #(em/wait-for-load (start)))
-
-;;(set! (.-onload js/window) (js/alert "Hello, world"))


Add transform point function.

Add transform point function.

Will be used for path edition.

--- src/uxbox/main/geom/point.cljs
+++ src/uxbox/main/geom/point.cljs
@@ -158,3 +158,11 @@
   [{:keys [x y]} decimanls]
   (Point. (mth/precision x decimanls)
           (mth/precision y decimanls)))
+
+
+(defn transform
+  "Transform a point applying a matrix transfomation."
+  [{:keys [x y] :as p} {:keys [a b c d tx ty] :as m}]
+  (Point. (+ (* x a) (* y c) tx)
+          (+ (* x b) (* y d) ty)))
+


lein-release plugin: bumped version from 0.3.28 to 0.3.29-SNAPSHOT for next development cycle

--- re_view/project.clj
+++ re_view/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view "0.3.28"
+(defproject re-view "0.3.29-SNAPSHOT"
   :description "Tiny React wrapper"
   :url "https://www.github.com/braintripping/re-view/tree/master/re_view"
   :license {:name "Eclipse Public License"


Small improvements to saving test code.

Small improvements to saving test code.

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

--- acqEngine/src/org/micromanager/test/saving.clj
+++ acqEngine/src/org/micromanager/test/saving.clj
@@ -51,8 +51,9 @@
   [num-images image-queue]
   (run-sequence-acquisition num-images false)
   (dotimes [i num-images]
-        (when-let [image (pop-next-image)]
-          (.put image-queue image))))
+    (when-let [image (pop-next-image)]
+      (when image-queue
+        (.put image-queue image)))))

 (defn byte-buffer-queue
   "Run a sequence acquisition, convert the incoming
@@ -62,13 +63,14 @@
   (let [image-queue (LinkedBlockingQueue. 1)]
     (future (single-thread-pop-test num-images image-queue))
     (let [queue (LinkedBlockingQueue. 1)]
-      (future (dotimes [_ num-images]
+      (future (dotimes [i num-images]
                 (let [img (.take image-queue)
                       n (count img)]
                   (.put queue
                         (image-to-byte-buffer
                           img
-                          (byte-buffer (* n 2)))))))
+                          (byte-buffer (* n 2))))
+                  )))
       queue)))

 (defmacro dotimes-timed [bindings interval & body]
@@ -76,14 +78,19 @@
      (println '~(first bindings) "time (ms)")
      (dotimes ~bindings
        (when (zero? (mod ~(first bindings) ~interval))
-         (println ~(first bindings) (- (System/currentTimeMillis) t0#)))
+         (println ~(first bindings) (- (System/currentTimeMillis) t0#)
+                  (core getRemainingImageCount)))
        ~@body)))
+
+(defn write-buf [channel buffer]
+  (.write channel buffer)
+  )

 (defn acquire-and-save
   "Simulate running a sequence acquisition, and save the
    images to a file using the direct byte buffer method."
   [num-images]
-    (let [filename (str "E:/acquisition/test" (rand-int 100000) ".dat")
+    (let [filename (str "D:/AcquisitionData/test" (rand-int 100000) ".dat")
           file (RandomAccessFile. filename "rw")
           channel (.getChannel file)]
       (try
@@ -91,7 +98,8 @@
           (println filename)
           (dotimes-timed [i num-images] 100
             (let [buffer (.take buffer-queue)]
-              (.write channel buffer))))
+              (write-buf channel buffer)
+              )))
         (catch Exception e (println e))
         (finally (.close file)))
       filename))


added a test for checking with-meta and meta

--- test/clj_http/test/headers.clj
+++ test/clj_http/test/headers.clj
@@ -64,7 +64,9 @@
     (is (= "eggs" (m2 "ham")))
     (is (= "nope" (get m2 "absent" "nope")))
     (is (= "baz" (:foo (merge (header-map :foo "bar")
-                              {"Foo" "baz"}))))))
+                              {"Foo" "baz"}))))
+    (let [m-with-meta (with-meta m {:withmeta-test true})]
+      (is (= (:withmeta-test (meta m-with-meta)) true)))))

 (deftest test-empty
   (testing "an empty header-map is a header-map"


CMR-2507 Refactor code to be more stylish.

--- umm-lib/src/cmr/umm/start_end_date.clj
+++ umm-lib/src/cmr/umm/start_end_date.clj
@@ -38,10 +38,9 @@
   "Returns the latest end-date of the list of range date times"
   [range-date-times]
   (let [ending-dates (map #(:ending-date-time %) range-date-times)]
-    (when-not (some #(nil? %) ending-dates)
-      (->> ending-dates
-      (sort t/after?)
-           first))))
+    (when-not (some nil? ending-dates)
+    ;; If some are nil, we will return nil instead of an end-date to indicate an open range.
+      (first (sort t/after? ending-dates)))))

 (defmulti start-date
   "Returns start-date of the temporal coverage"


Removed hard-coding of path in AMON test

--- test/kixi/hecuba/amon_test.clj
+++ test/kixi/hecuba/amon_test.clj
@@ -29,19 +29,16 @@
   {:commander (->RefCommander r :hecuba/id)
    :querier (->RefQuerier r)})

-(defn make-handler [r]
-  (let [routes (-> r  make-mock-records amon/make-handlers amon/make-routes)]
-    (-> routes bidi/make-handler (wrap-routes routes))))
-
 (deftest amon-api-tests
   (testing "Create a new entity"
     (let [r (ref {})
-          handler (make-handler r)
+          handlers (-> r make-mock-records amon/make-handlers)
+          routes (-> handlers amon/make-routes)
+          handler (-> routes bidi/make-handler (wrap-routes routes))
           response (-> (make-entity)
                        (add-devices (uuid))
-                       (as-json-body-request "/entities")
-                       handler)
-          ]
+                       (as-json-body-request (bidi/path-for routes (:entities-index handlers)))
+                       handler)]
       (is (not (nil? response)))
       (is (= (:status response) 201))
       (is (= (count @r) 1)))))


DRY up test code with helpers

DRY up test code with helpers

--- test/lt/plugins/sync_test.cljs
+++ test/lt/plugins/sync_test.cljs
@@ -2,6 +2,7 @@
   (:require-macros [cemerick.cljs.test :refer [is deftest testing use-fixtures]])
   (:require [lt.plugins.kukui.sync :as sync]
             [lt.plugins.kukui.db :as db]
+            [lt.plugins.kukui.core :as kc]
             [cemerick.cljs.test :as t]))

 (defn reset-sync! []
@@ -10,9 +11,18 @@

 (use-fixtures :each reset-sync!)

+(defn ->nodes [nodes]
+  (->> nodes
+       kc/add-attributes-to-nodes
+       (mapv
+        #(assoc % :indent (count (re-find #"^\s*" (:text %)))))))
+
+(defn sync [nodes]
+  (sync/sync (->nodes nodes) "/some/path"))
+
 (deftest add-on-first-edit
-  (let [new-node {:text "drink coffee #type:td #food" :line 0 :indent 0 :type "td" :tags #{"food"}}]
-    (sync/sync [new-node] "/some/path")
+  (let [new-node {:text "drink coffee #type:td #food" :line 0}]
+    (sync [new-node])
     (is (seq (db/q '[:find ?e
                      :in $ ?text
                      :where
@@ -23,36 +33,36 @@

 (deftest add-on-second-edit
-  (let [nodes [{:text "drink chocolate #type:td" :line 0 :indent 0 :type "td"}]]
-    (sync/sync nodes "/some/path")
-    (sync/sync (conj nodes {:text "drink coffee #type:td" :line 1 :indent 0 :type "td"}) "/some/path"))
+  (let [nodes [{:text "drink chocolate #type:td" :line 0}]]
+    (sync nodes)
+    (sync (conj nodes {:text "drink coffee #type:td" :line 1})))
   (is (= 2
          (count (db/q '[:find ?e
                         :where [?e :text]])))))

 (deftest add-with-tag-from-other-node
-  (sync/sync [{:name "some?" :type "fn" :text "#name:some? #type:fn" :indent 0 :line 0}
-              {:text "such a great name #some? #type:td" :tags #{"some?"} :type "td" :indent 0 :line 1}] "/some/path")
+  (sync [{:text "#name:some? #type:fn" :line 0}
+         {:text "such a great name #some? #type:td" :line 1}])
   (is (seq (db/q '[:find ?e
                    :where
                    [?e :tags ?tag]
-                   [?tag :name "some?"]])))
+                   [?tag :name "some?"]]))))

 (deftest delete-text-line
-  (sync/sync [{:text "drink chocolate #type:td" :line 0 :indent 0 :type "td"}] "/some/path")
-  (sync/sync [{:text "drink coffee #type:td" :line 1 :indent 0 :type "td"}] "/some/path")
+  (sync [{:text "drink chocolate #type:td" :line 0}])
+  (sync [{:text "drink coffee #type:td" :line 1}])
   (is (= '(1)
          (db/qf '[:find ?line
                   :where [?e :line ?line]]))))

 (deftest update-line
-  (let [node {:text "drink coffee #type:td" :line 0 :indent 0 :type "td"}
-        updated-nodes [{:text "drink chocolate #type:td" :line 0 :indent 0 :type "td"}
+  (let [node {:text "drink coffee #type:td" :line 0}
+        updated-nodes [{:text "drink chocolate #type:td" :line 0}
                        (assoc node :line 1)]]
-    (sync/sync [node]  "/some/path")
-    (sync/sync updated-nodes "/some/path")
+    (sync [node])
+    (sync updated-nodes)
     (is (= updated-nodes (map
-                          #(dissoc % :db/id)
+                          #(select-keys % [:text :line])
                           (db/qe '[:find ?e
                                    :where [?e :text]]))))))


Added a factorial test case.

Added a factorial test case.

--- test/minijava/test_compile.clj
+++ test/minijava/test_compile.clj
@@ -3,9 +3,40 @@
         clojure.contrib.def
         (minijava compile)))

+(comment
 (deftest tests-files-convert-without-exception
   (let [filter (proxy [java.io.FilenameFilter] []
                  (accept [_ name] (not (nil? (re-find #"java$" name)))))
         files (-> "resources/sample" java.io.File. (.listFiles filter))]
     (doseq [f files]
-      (compile-program f))))
+   (println (compile-program f)))))
+
+)
+
+
+
+(deftest test-factorial
+	(let [prog
+
+"class Factorial{
+	public static void main(String[] a){
+		System.out.println(new Fac().ComputeFac(10));
+	}
+}
+
+class Fac {
+
+	public int ComputeFac(int num){
+		int num_aux ;
+		if (num < 1)
+			num_aux = 1 ;
+		else
+			num_aux = num * (this.ComputeFac(num-1)) ;
+		return num_aux ;
+	}
+
+}" ]
+
+ (println (compile-program prog))
+
+))


add tests for urls and move phantom driver to before/after hooks

--- pedestal-app/test/semtag_web/integration_test.clj
+++ pedestal-app/test/semtag_web/integration_test.clj
@@ -1,24 +1,47 @@
 (ns semtag-web.integration-test
   (:require [clojure.test :refer :all]
             [clj-webdriver.driver :refer [init-driver]]
+            [clj-webdriver.core :as core]
             [clj-webdriver.taxi :as taxi])
   (:import [org.openqa.selenium.phantomjs PhantomJSDriver]
            [org.openqa.selenium.remote DesiredCapabilities]))

-(deftest submit-test
-  (taxi/set-driver! (init-driver {:webdriver (PhantomJSDriver. (DesiredCapabilities. ))}))
-  (taxi/to "out/public/semtag-web-test.html")
-  (Thread/sleep 1000)
+(use-fixtures :each
+              (fn [f]
+                (taxi/set-driver! (init-driver {:webdriver (PhantomJSDriver. (DesiredCapabilities. ))}))
+                (taxi/to "out/public/semtag-web-test.html")
+                (Thread/sleep 1000)
+
+                (f)
+                (taxi/quit)))
+
+(defn click [text]
+  (core/click (taxi/find-element {:tag :a :text text}))
+  (Thread/sleep 500))
+
+(deftest ursl-get-updated-correctly
+  (is (.endsWith (taxi/current-url) "/semtag-web-test.html"))
+  (click "Tag Stats")
+  (is (.endsWith (taxi/current-url) "/semtag-web-test.html#/tag-stats"))
+
+  (click "Type Stats")
+  (is (.endsWith (taxi/current-url) "/semtag-web-test.html#/types"))
+
+  (click "All The Things")
+  (is (.endsWith (taxi/current-url) "/semtag-web-test.html#/all"))
+
+  (click "Home")
+  (is (.endsWith (taxi/current-url) "/semtag-web-test.html#/")))
+
+(deftest search-submit-works
   (taxi/input-text "#url_search_text" "feynman")
   (is (= "feynman" (taxi/attribute "#url_search_text" :value)))
+
   (taxi/click "#url_search_button")
   (Thread/sleep 1000)
-
-  (is (= "Search results for 'feynman'" (taxi/text "#search_title")))
-  (taxi/quit))
+  (is (= "Search results for 'feynman'" (taxi/text "#search_title"))))

 (comment
-  (clj-webdriver.core/click  (find-element  {:tag :a :text "Tag Stats"}))
   (taxi/take-screenshot :file "out.png")
   (println "LOGS: ")
   (doseq [log (taxi/execute-script "return logs;")] (println log)))


added output example of bar with unknow content-length


Removing knife windows

Removing knife windows

--- config/software/chef.clj
+++ config/software/chef.clj
@@ -25,7 +25,7 @@
                           "--" "--with-xml2-include=/opt/opscode/embedded/include/libxml2"
                           "--with-xml2-lib=/opt/opscode/embedded/lib"]}
                   {:command "/opt/opscode/embedded/bin/gem"
-                   :args ["install" "highline" "net-ssh-multi" "knife-ec2" "knife-rackspace" "knife-windows" "knife-openstack" "-n" "/opt/opscode/bin"
+                   :args ["install" "highline" "net-ssh-multi" "knife-ec2" "knife-rackspace" "knife-openstack" "-n" "/opt/opscode/bin"
                           "--no-rdoc" "--no-ri"
                           "--" "--with-xml2-include=/opt/opscode/embedded/include/libxml2"
                           "--with-xml2-lib=/opt/opscode/embedded/lib"]}


Fixed the bug which always make the map.

--- web/src/sound_effector/models/user.clj
+++ web/src/sound_effector/models/user.clj
@@ -25,8 +25,8 @@

 (defn read
   ([id]
-   (let [user (first (sql/query db-spec ["SELECT * FROM users WHERE id = ?" id]))]
+   (if-let [user (first (sql/query db-spec ["SELECT * FROM users WHERE id = ?" id]))]
      (assoc user :providers (make-providers (:id user)))))
   ([provider-id provider-user-id]
-   (let [user (first (sql/query db-spec ["SELECT a.* FROM users a JOIN user_providers b ON (b.provider_id = ? AND b.provider_user_id = ? AND b.user_id = a.id)" provider-id provider-user-id]))]
+   (if-let [user (first (sql/query db-spec ["SELECT a.* FROM users a JOIN user_providers b ON (b.provider_id = ? AND b.provider_user_id = ? AND b.user_id = a.id)" provider-id provider-user-id]))]
      (assoc user :providers (make-providers (:id user))))))


fixed typo in core.clj

fixed typo in core.clj

--- kuzushi/resources/gaeshi/kuzushi/templates/src/app/core.clj
+++ kuzushi/resources/gaeshi/kuzushi/templates/src/app/core.clj
@@ -8,7 +8,7 @@

 (defroutes !-APP_NAME-!-routes
   (GET "/" [] (render-template "index"))
-  (controller-router 'cleancoders.controller)
+  (controller-router '!-APP_NAME-!.controller)
   (not-found (render-template "not_found" :template-root "!-APP_NAME-!/view" :ns `!-APP_NAME-!.view.view-helpers)))

 (def app-handler


add tests for coercions

add tests for coercions

--- test/clj_json/core_test.clj
+++ test/clj_json/core_test.clj
@@ -11,7 +11,7 @@

 (deftest test-generate-accepts-float
   (is (= "3.14" (json/generate-string (float 3.14)))))
-
+
 (deftest test-key-coercion
   (is (= {"foo" "bar" "1" "bat" "2" "bang" "3" "biz"}
          (json/parse-string
@@ -22,8 +22,23 @@
   (is (= {:foo "bar" :bat 1}
          (json/parse-string
            (json/generate-string {:foo "bar" :bat 1})
-           true))))
+           true)))
+  (is (= {:clj-json.core-test/foo "bar"}
+         (json/parse-string (json/generate-string {::foo "bar"}) true))))

 (deftest test-parsed-seq
   (let [br (BufferedReader. (StringReader. "1\n2\n3\n"))]
     (is (= (list 1 2 3) (json/parsed-seq br)))))
+
+(deftest test-set-coercion
+  (is (= {:foo ["bar" "bang"]}
+         (json/parse-string
+          (json/generate-string {:foo #{"bar" "bang"}})
+          true))))
+
+(deftest test-redefine-coercions
+  (binding [clj-json.core/*coercions* {clojure.lang.IPersistentSet
+                                       (fn [x] (reduce (fn [acc x] (assoc acc x true)) {} x))}]
+    (is (= {"foo" {"bang" true, "bar" true}}
+           (json/parse-string
+            (json/generate-string {"foo" #{"bar" "bang"}}))))))


Dangling parens are gross. #cosmetic

Dangling parens are gross. #cosmetic

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -202,8 +202,7 @@
                     :on-change #(raise! owner [:project-feature-flag-checked {:project-id project-id
                                                                               :flag :trusty-beta
                                                                               :value true}])}]
-                  " Ubuntu 14.04 (Trusty)"]]]]]
-               ]]])))))
+                  " Ubuntu 14.04 (Trusty)"]]]]]]]])))))

 (defn parallel-label-classes [{:keys [plan project] :as project-data} parallelism]
   (concat


Test allegedly better error reporting

Test allegedly better error reporting

Refs #1.

--- test/icecap/schema_test.clj
+++ test/icecap/schema_test.clj
@@ -14,5 +14,5 @@
          simple-https-request
          #{simple-http-request simple-https-request}))
   (testing "Request specs with unknown/unsupported schemes don't validate"
-    (are [example] (thrown? Throwable (s/validate RequestSpec example))
-         simple-ftp-request)))
+    (are [example reason] (= (s/check RequestSpec example) reason)
+         simple-ftp-request {:target (not ("supported-scheme?" "ftp://example.test"))})))


whitespace

whitespace

--- test/riemann/query_test.clj
+++ test/riemann/query_test.clj
@@ -25,7 +25,7 @@
               "state = 0"  '(= state 0)
               "state = 1"  '(= state 1)
               "state = -1" '(= state -1)
-
+
               ; Floats
               "state = 1."      '(= state 1.)
               "state = 0.0"     '(= state 0.0)
@@ -59,7 +59,7 @@
               "not host = 1"                '(not (= host 1))
               "host = 1 and state = 2"      '(and (= host 1) (= state 2))
               "host = 1 or state = 2"       '(or (= host 1) (= state 2))
-
+
               ; Grouping
               "(host = 1)"                  '(= host 1)
               "((host = 1))"                '(= host 1)


Test that non-existent sessions 404.

Test that non-existent sessions 404.

--- test/shale/test/handler.clj
+++ test/shale/test/handler.clj
@@ -3,6 +3,7 @@
             [cheshire [core :as json]]
             [ring.mock.request :as mock]
             [com.stuartsierra.component :as component]
+            [shale.utils :refer [gen-uuid]]
             [shale.test.utils :refer [with-selenium-servers
                                       with-clean-redis]]
             [shale.core :refer [get-app-system]]))
@@ -35,6 +36,9 @@
 (defn is-200 [resp]
   (is-status resp 200))

+(defn is-404 [resp]
+  (is-status resp 404))
+
 (defn is-body [resp body]
   (is (= (:body resp) body)))

@@ -65,7 +69,11 @@
     (let [app (:ring-app (:app system))
           response (app (mock/request :get "/nodes"))]
       (is-200 response)
-      (is-body response "[]\n"))))
+      (is-body response "[]\n")))
+  (testing "non-existent sessions 404"
+    (let [app (:ring-app (:app system))
+          response (app (mock/request :get (str "/sessions/" (gen-uuid))))])
+    (is-404 response)))

 (defn refresh-nodes [app]
   (app (mock/request :post "/nodes/refresh")))


don't need alts! with a single channel

don't need alts! with a single channel

--- frontend/components/forms.cljs
+++ frontend/components/forms.cljs
@@ -14,24 +14,23 @@
   [api-mult api-tap uuid {:keys [success-fn failure-fn]}]
   (async/tap api-mult api-tap)
   (go-loop []
-           (alt! api-tap
-                 ([v]
-                    (let [message-uuid (:uuid (meta v))
-                          status (second v)]
-                      (cond
-                       (and (= uuid message-uuid)
-                            (#{:success :failed} status))
-                       (do (if (= :success status)
-                             (success-fn)
-                             (failure-fn))
-                           ;; There's a chance of a race if the button gets clicked twice.
-                           ;; No good ideas on how to fix it, and it shouldn't happen,
-                           ;; so punting for now
-                           (async/untap api-mult api-tap))
+           (let [v (<! api-tap)]
+             (let [message-uuid (:uuid (meta v))
+                   status (second v)]
+               (cond
+                (and (= uuid message-uuid)
+                     (#{:success :failed} status))
+                (do (if (= :success status)
+                      (success-fn)
+                      (failure-fn))
+                    ;; There's a chance of a race if the button gets clicked twice.
+                    ;; No good ideas on how to fix it, and it shouldn't happen,
+                    ;; so punting for now
+                    (async/untap api-mult api-tap))

-                       (nil? v) nil ;; don't recur on closed channel
+                (nil? v) nil ;; don't recur on closed channel

-                       :else (recur)))))))
+                :else (recur))))))

 (defn append-cycle
   "Adds the button-state to the end of the lifecycle"


fix namespace and add test

fix namespace and add test

--- test/babel/test/es.clj
+++ test/babel/test/es.clj
@@ -1,6 +1,7 @@
 (ns babel.test.es
   (:refer-clojure :exclude [get-in])
   (:require [babel.engine :as engine]
+            [babel.espanol.grammar :as esg]
             [babel.espanol.writer :as es]
             [babel.espanol.morphology :refer [fo]]
             [babel.writer :as writer]
@@ -15,12 +16,15 @@
                                           :sem {:pred :sleep
                                                 :subj {:pred :I}
                                                 :tense :conditional}}}
-                                es/small
+                                esg/small
                                 :enrich true)]
     (is (= :1st (get-in result [:comp :synsem :agr :person])))
     (is (= :sing (get-in result [:comp :synsem :agr :number])))
     (is (= "yo dormiría" (fo result)))))

+(deftest llamarse
+  (let [result (es/expression {:synsem {:sem {:pred :be-called}}})]
+    (not (empty? (fo result)))))


Convert msg-controller to defmethod

Convert msg-controller to defmethod

--- src/cljs/onyx_dashboard/controllers/websocket.cljs
+++ src/cljs/onyx_dashboard/controllers/websocket.cljs
@@ -1,30 +1,64 @@
 (ns onyx-dashboard.controllers.websocket)

-(defn msg-controller [[type msg] state]
-  ; success notification currently notifies about bad tracking ids
-  ; probably going to need a better session management check
-  ; Disable for now as it's a bit distracting during dev
-  ;(success-notification type)
-  (if-let [tracking-id (:tracking-id msg)]
-    (cond (= tracking-id (get-in state [:deployment :tracking-id]))
-          (case type
-            ;:deployment/replica
-            ;(assoc-in state [:deployment :replica] recv-msg)
-            :job/completed-task
-            (do (println "Task completed: " msg)
-                state)
-            :job/submitted-job
-            (assoc-in state [:deployment :jobs (:id msg)] msg)
-            :job/entry
-            (update-in state
-                       [:deployment]
-                       (fn [deployment]
-                         (-> deployment
-                             (assoc :message-id-max (max (:message-id msg)
-                                                         (:message-id-max deployment)))
-                             (assoc-in [:entries (:message-id msg)] msg))))
-            state)
-          :else state)
-    (if (= :deployment/listing type)
-      (assoc-in state [:deployments] msg)
-      state)))
+(defmulti msg-controller (fn [[type _] _] type))
+
+(defmethod msg-controller :deployment/listing [[_ msg] state]
+  (assoc-in state [:deployments] msg))
+
+(defn is-tracking? [msg state]
+  (= (:tracking-id msg)
+     (get-in state [:deployment :tracking-id])))
+
+(defmethod msg-controller :job/completed-task [[_ msg] state]
+  (when (is-tracking? msg state)
+    (println "Task completed: " msg))
+  state)
+
+(defmethod msg-controller :job/submitted-job [[_ msg] state]
+  (if (is-tracking? msg state)
+    (assoc-in state [:deployment :jobs (:id msg)] msg)
+    state))
+
+(defmethod msg-controller :job/entry [[_ msg] state]
+  (if (is-tracking? msg state)
+    (update-in state
+               [:deployment]
+               (fn [deployment]
+                 (-> deployment
+                     (assoc :message-id-max (max (:message-id msg)
+                                                 (:message-id-max deployment)))
+                     (assoc-in [:entries (:message-id msg)] msg))))
+    state))
+
+(defmethod msg-controller :default [[type msg] state]
+  (println "Unhandled msg type:" type "msg:" msg)
+  state)
+
+; (defn msg-controller [[type msg] state]
+;   ; success notification currently notifies about bad tracking ids
+;   ; probably going to need a better session management check
+;   ; Disable for now as it's a bit distracting during dev
+;   ;(success-notification type)
+;   (if-let [tracking-id (:tracking-id msg)]
+;     (cond (= tracking-id (get-in state [:deployment :tracking-id]))
+;           (case type
+;             ;:deployment/replica
+;             ;(assoc-in state [:deployment :replica] recv-msg)
+;             :job/completed-task
+;             (do (println "Task completed: " msg)
+;                 state)
+;             :job/submitted-job
+;             (assoc-in state [:deployment :jobs (:id msg)] msg)
+;             :job/entry
+;             (update-in state
+;                        [:deployment]
+;                        (fn [deployment]
+;                          (-> deployment
+;                              (assoc :message-id-max (max (:message-id msg)
+;                                                          (:message-id-max deployment)))
+;                              (assoc-in [:entries (:message-id msg)] msg))))
+;             state)
+;           :else state)
+;     (if (= :deployment/listing type)
+;       (assoc-in state [:deployments] msg)
+;       state)))


Revert "Fix broken link dispatching"

Revert "Fix broken link dispatching"

--- src-cljs/frontend/history.cljs
+++ src-cljs/frontend/history.cljs
@@ -98,29 +98,31 @@
                 "svg" nil
                 (recur (.-parentElement e)))))))))

+(defn dispatch-link [e]
+  (let [a (closest-tag (.-target e) "A")
+        attributes (.-attributes a)
+        href (some-> attributes .-href .-value)
+        target (some-> attributes .-target .-value)
+        uri (Uri/parse href)
+        new-token (subs (.getPath uri) 1)]
+    (when (and (not (.hasHost uri))
+               (not (or (new-window-click? e)
+                        (= target "_blank"))))
+      (.preventDefault e)
+      (if (and (route-fragment href)
+               (path-matches? (.getToken history-imp) new-token))
+
+        (do (utils/mlog "scrolling to hash for" href)
+            ;; don't break the back button
+            (.replaceToken history-imp new-token))
+
+        (do (utils/mlog "navigating to" href)
+            (.setToken history-imp new-token))))))
+
 (defn setup-link-dispatcher! [history-imp top-level-node]
   (events/listen
    top-level-node "click"
-   (fn [e]
-     (let [a (closest-tag (.-target e) "A")
-           attributes (.-attributes a)
-           href (some-> attributes .-href .-value)
-           target (some-> attributes .-target .-value)
-           uri (Uri. href)
-           new-token (subs (.getPath uri) 1)]
-       (when (and (not (.hasDomain uri))
-                  (not (or (new-window-click? e)
-                           (= target "_blank"))))
-         (.preventDefault e)
-         (if (and (route-fragment href)
-                  (path-matches? (.getToken history-imp) new-token))
-
-           (do (utils/mlog "scrolling to hash for" href)
-               ;; don't break the back button
-               (.replaceToken history-imp new-token))
-
-           (do (utils/mlog "navigating to" href)
-               (.setToken history-imp new-token))))))))
+   dispatch-link))

 (defn new-history-imp [top-level-node]
   ;; need a history element, or goog will overwrite the entire dom


add eftest (#916)

add eftest (#916)

--- waiter/project.clj
+++ waiter/project.clj
@@ -111,12 +111,13 @@
                  [slingshot "0.12.2"]
                  [try-let "1.3.1"
                   :exclusions [org.clojure/clojure]]]
-
+  :eftest {:report clojure.test/report}
   :resource-paths ["resources"]
   :main waiter.main
   :plugins [[com.holychao/parallel-test "0.3.2"]
             [lein-exec "0.3.7"]
-            [test2junit "1.2.2"]]
+            [test2junit "1.2.2"]
+            [lein-eftest "0.5.8"]]
   ; In case of kerberos problems, export KRB5_KTNAME=/var/spool/keytabs/$(id -un)
   :jvm-opts ["-server"
              "-Dsun.security.jgss.lib=/opt/mitkrb5/lib/libgssapi_krb5.so"


formatting

formatting

--- src/overtone/sc/machinery/server/osc_validator.clj
+++ src/overtone/sc/machinery/server/osc_validator.clj
@@ -10,99 +10,99 @@

 (def TYPES
   {
-   :anything         {:desc "any type"
+   :anything         {:desc      "any type"
                       :validator (fn [val] true)}

-   :int              {:desc "an integer"
+   :int              {:desc      "an integer"
                       :validator (fn [val] (instance? Integer val))}

-   :sample-idx       {:desc "an integer 0 or greater representing the index of a sample"
+   :sample-idx       {:desc      "an integer 0 or greater representing the index of a sample"
                       :validator (fn [val] (and (instance? Integer val)
                                                (>= val 0)))}

-   :sample-val       {:desc "a float representing the value of a sample"
+   :sample-val       {:desc      "a float representing the value of a sample"
                       :validator (fn [val] (instance? Float val))}

-   :frame-start      {:desc "an integer 0 or greater representing the starting frame"
+   :frame-start      {:desc      "an integer 0 or greater representing the starting frame"
                       :validator (fn [val] (and (instance? Integer val)
                                                (>=  val 0)))}

-   :chan-idx         {:desc "an integer 0 or greater representing a channel index"
+   :chan-idx         {:desc      "an integer 0 or greater representing a channel index"
                       :validator (fn [val] (and (instance? Integer val)
                                                (>=  val 0)))}

-   :num-frames       {:desc "an integer -1 or greater representing the number of frames"
+   :num-frames       {:desc      "an integer -1 or greater representing the number of frames"
                       :validator (fn [val] (and (instance? Integer val)
                                                (>=  val -1)))}

-   :buf-num          {:desc "an integer representing a buffer number"
+   :buf-num          {:desc      "an integer representing a buffer number"
                       :validator (fn [val] (instance? Integer val))}

-   :ugen-idx         {:desc "an integer representing the index of a ugen"
+   :ugen-idx         {:desc      "an integer representing the index of a ugen"
                       :validator (fn [val] (instance? Integer val))}

-   :count            {:desc "a positive integer representing the cardinality of elements"
+   :count            {:desc      "a positive integer representing the cardinality of elements"
                       :validator (fn [val] (and (instance? Integer val)
                                                (> val 0)))}

-   :node-id          {:desc "an integer (-1 upwards) representing a node id."
-                      :validator (fn [val] (and (instance? Integer val)
-                                               (>= val -1)))}
-
-   :group-id          {:desc "an integer (-1 upwards) representing a group id."
-                      :validator (fn [val] (and (instance? Integer val)
-                                               (>= val -1)))}
-
-   :synth-id         {:desc "an integer (-1 upwards) representing a synth id."
-                      :validator (fn [val] (and (instance? Integer val)
-                                               (>= val -1)))}
-
-   :ctl-val          {:desc "a float representing a control value"
+   :node-id          {:desc      "an integer (-1 upwards) representing a node id."
+                      :validator (fn [val] (and (instance? Integer val)
+                                               (>= val -1)))}
+
+   :group-id         {:desc      "an integer (-1 upwards) representing a group id."
+                      :validator (fn [val] (and (instance? Integer val)
+                                               (>= val -1)))}
+
+   :synth-id         {:desc      "an integer (-1 upwards) representing a synth id."
+                      :validator (fn [val] (and (instance? Integer val)
+                                               (>= val -1)))}
+
+   :ctl-val          {:desc      "a float representing a control value"
                       :validator (fn [val] (instance? Float val ))}

-   :string           {:desc "a string"
-                      :validator (fn [val] (string? val))}
-
-   :cmd-name         {:desc "a string representing a command name"
-                      :validator (fn [val] (string? val))}
-
-   :ctl-handle       {:desc "an integer or a string representing a control"
+   :string           {:desc      "a string"
+                      :validator (fn [val] (string? val))}
+
+   :cmd-name         {:desc      "a string representing a command name"
+                      :validator (fn [val] (string? val))}
+
+   :ctl-handle       {:desc      "an integer or a string representing a control"
                       :validator (fn [val] (or (instance? Integer val)
                                               (string? val)))}

-   :ctl-bus-idx      {:desc "an integer (-1 or greater) representing a control bus index"
-                      :validator (fn [val] (and (instance? Integer val)
-                                               (>= val -1)))}
-
-   :pathname         {:desc "a string representing a pathname"
-                      :validator (fn [val] (string? val))}
-
-   :synthdef-name    {:desc "a string representing the name of a synthdef"
-                      :validator (fn [val] (string? val))}
-
-   :bytes            {:desc "a buffer of bytes"
+   :ctl-bus-idx      {:desc      "an integer (-1 or greater) representing a control bus index"
+                      :validator (fn [val] (and (instance? Integer val)
+                                               (>= val -1)))}
+
+   :pathname         {:desc      "a string representing a pathname"
+                      :validator (fn [val] (string? val))}
+
+   :synthdef-name    {:desc      "a string representing the name of a synthdef"
+                      :validator (fn [val] (string? val))}
+
+   :bytes            {:desc      "a buffer of bytes"
                       :validator (fn [val] (= (type (byte-array 0)) (type val)))}

-   :zero-to-three    {:desc "an integer in the range 0 -> 3 inclusive"
+   :zero-to-three    {:desc      "an integer in the range 0 -> 3 inclusive"
                       :validator (fn [val] (and (instance? Integer val)
                                                (>= val 0)
                                                (<= val 3)))}

-   :zero-to-four     {:desc "an integer in the range 0 -> 4 inclusive"
+   :zero-to-four     {:desc      "an integer in the range 0 -> 4 inclusive"
                       :validator (fn [val] (and (instance? Integer val)
                                                (>= val 0)
                                                (<= val 4)))}

-   :minus-two-to-one {:desc "an integer in the range -2 -> 1 inclusive"
+   :minus-two-to-one {:desc      "an integer in the range -2 -> 1 inclusive"
                       :validator (fn [val] (and (instance? Integer val)
                                                (>= val -2)
                                                (<= val 1)))}

-   :zero-or-one      {:desc "an integer that's either 0 or 1"
+   :zero-or-one      {:desc      "an integer that's either 0 or 1"
                       :validator (fn [val] (or (= 0 val)
                                               (= 1 val)))}

-   :header-format    {:desc "a string representing the sound header format - one of \"aiff\", \"next\", \"wav\", \"ircam\"\", \"raw\""
+   :header-format    {:desc      "a string representing the sound header format - one of \"aiff\", \"next\", \"wav\", \"ircam\"\", \"raw\""
                       :validator (fn [val] (or (= val "aiff")
                                               (= val "next")
                                               (= val "wav")
@@ -110,7 +110,7 @@
                                               (= val "raw")
                                               (= val "flac")))}

-   :sample-format    {:desc "a string representing the sound sample format - one of \"int8\", \"int16\", \"int24\", \"int32\", \"float\", \"double\", \"mulaw\", \"alaw\""
+   :sample-format    {:desc      "a string representing the sound sample format - one of \"int8\", \"int16\", \"int24\", \"int32\", \"float\", \"double\", \"mulaw\", \"alaw\""
                       :validator (fn [val] (or (= val "int8")
                                               (= val "int16")
                                               (= val "int24")
@@ -235,8 +235,8 @@
   [type]
   (cond
    (alternating? type) (expand-alternating type)
-   (many-type? type) (expand-many type)
-   :else type))
+   (many-type? type)   (expand-many type)
+   :else               type))

 (defn- expand-type-sig
   [sig]
@@ -251,13 +251,11 @@

 (defn- arity-mismatch?
   [s-arity a-arity]
-
   (and (not (= Float/POSITIVE_INFINITY s-arity))
        (not (= s-arity a-arity))))

 (defn- error-args
   [sig args]
-
   (some (fn [[type arg]] (if (not (valid? type arg))
                           [type arg]
                           false))
@@ -282,9 +280,9 @@

 (defn validated-snd
-  "Send an scsynth osc message. Validates message. Raises an exception if the
-  message is unknown or is not well formed according to the message's type
-OP  signature."
+  "Send an scsynth osc message. Validates message. Raises an exception
+  if the message is unknown or is not well formed according to the
+  message's type OP signature."
   [host path & args]
   (if-let [sig (OSC-TYPE-SIGNATURES path)]
     (apply checked-snd sig host path args)


GAWB-1818: adding call caching message/blog post link to create method

--- src/cljs/main/broadfcui/page/method_repo/create_method.cljs
+++ src/cljs/main/broadfcui/page/method_repo/create_method.cljs
@@ -7,6 +7,7 @@
     [broadfcui.common.input :as input]
     [broadfcui.common.modal :as modal]
     [broadfcui.common.style :as style]
+    [broadfcui.config :as config]
     [broadfcui.endpoints :as endpoints]
     [broadfcui.utils :as utils]
     ))
@@ -43,6 +44,8 @@
          (style/create-form-label "Documentation (optional)")
          (style/create-text-area {:ref "documentation" :style {:width "100%"} :rows 5})

+         [:div {:style {:marginBottom "0.8em"}} "WDL must use Docker image digests to allow call caching"
+          (common/question-icon-link "Guide to Call Caching" (config/call-caching-guide-url))]
          [:input {:type "file" :ref "wdl-uploader" :style {:display "none"}
                   :onChange (fn [e]
                               (let [file (-> e .-target .-files (aget 0))


Zap nested lets.

Zap nested lets.

--- src/active/clojure/record.cljc
+++ src/active/clojure/record.cljc
@@ -70,65 +70,64 @@
         name-doc (fn [field]
                     (if-let [doc (:doc (meta field))]
                       (str " (" doc ")")
-                      ""))]
+                      ""))
+
+        ?field-names (map first ?field-triples)
+        reference (fn [name]
+                    (str "[[" (ns-name *ns*) "/" name "]]"))
+        ?docref (str "See " (reference ?constructor) ".")]
+    (let [?field-names-set (set ?field-names)]
+      (doseq [?constructor-arg ?constructor-args]
+        (when-not (contains? ?field-names-set ?constructor-arg)
+          (throw (IllegalArgumentException. (str "constructor argument " ?constructor-arg " is not a field in " *ns* " " (meta &form)))))))
+

-
-    (let [?field-names (map first ?field-triples)
-          reference (fn [name]
-                      (str "[[" (ns-name *ns*) "/" name "]]"))
-          ?docref (str "See " (reference ?constructor) ".")]
-      (let [?field-names-set (set ?field-names)]
-        (doseq [?constructor-arg ?constructor-args]
-          (when-not (contains? ?field-names-set ?constructor-arg)
-            (throw (IllegalArgumentException. (str "constructor argument " ?constructor-arg " is not a field in " *ns* " " (meta &form)))))))
-
-
-      `(do
-         (defrecord ~?type
-             [~@(map first ?field-triples)]
-           ~@?opt+specs)
-         (def ~(document-with-arglist ?predicate '[thing] (str "Is object a `" ?type "` record? " ?docref))
-           (fn [x#]
-             (instance? ~?type x#)))
-         (def ~(document ?constructor (str "Construct a [[" ?type "]]"
-                                           (name-doc ?type)
-                                           " record.\n"
-                                           (apply str
-                                                  (map (fn [[?field ?accessor ?lens]]
-                                                         (str "\n`" ?field "`" (name-doc ?field) ": access via " (reference ?accessor)
-                                                              (if ?lens
-                                                                (str ", lens " (reference ?lens))
-                                                                "")))
-                                                       ?field-triples))))
-           (fn [~@?constructor-args]
-             (new ~?type
-                  ~@(map (fn [[?field _]]
-                           (if (contains? ?constructor-args-set ?field)
-                             `~?field
-                             `nil))
-                         ?field-triples))))
-         (declare ~@(map (fn [[?field ?accessor ?lens]] ?accessor) ?field-triples))
-         ~@(mapcat (fn [[?field ?accessor ?lens]]
-                     (let [?rec (with-meta `rec# {:tag ?type})]
-                       `((def ~(document-with-arglist ?accessor (vector ?type)  (str "Access `" ?field "` field"
-                                                                                (name-doc ?field)
-                                                                                " from a [[" ?type "]] record. " ?docref))
-                           (fn [~?rec]
-                             (check-type ~?type ~?rec ~?accessor)
-                             (. ~?rec ~(symbol (str "-" ?field)))))
-                         ~@(if ?lens
-                             (let [?data `data#
-                                   ?v `v#]
-                               `((def ~(document ?lens (str "Lens for the `" ?field "` field"
-                                                            (name-doc ?field)
-                                                            " from a [[" ?type "]] record." ?docref))
-                                   (active.clojure.lens/lens ~?accessor
-                                                             (fn [~?data ~?v]
-                                                               (~?constructor ~@(map
-                                                                                (fn [[?shove-field ?shove-accessor]]
-                                                                                (if (= ?field ?shove-field)
-                                                                                ?v
-                                                                                `(~?shove-accessor ~?data)))
-                                                                                ?field-triples)))))))
-                             '()))))
-                   ?field-triples))))))+    `(do
+       (defrecord ~?type
+           [~@(map first ?field-triples)]
+         ~@?opt+specs)
+       (def ~(document-with-arglist ?predicate '[thing] (str "Is object a `" ?type "` record? " ?docref))
+         (fn [x#]
+           (instance? ~?type x#)))
+       (def ~(document ?constructor (str "Construct a [[" ?type "]]"
+                                         (name-doc ?type)
+                                         " record.\n"
+                                         (apply str
+                                                (map (fn [[?field ?accessor ?lens]]
+                                                       (str "\n`" ?field "`" (name-doc ?field) ": access via " (reference ?accessor)
+                                                            (if ?lens
+                                                              (str ", lens " (reference ?lens))
+                                                              "")))
+                                                     ?field-triples))))
+         (fn [~@?constructor-args]
+           (new ~?type
+                ~@(map (fn [[?field _]]
+                         (if (contains? ?constructor-args-set ?field)
+                           `~?field
+                           `nil))
+                       ?field-triples))))
+       (declare ~@(map (fn [[?field ?accessor ?lens]] ?accessor) ?field-triples))
+       ~@(mapcat (fn [[?field ?accessor ?lens]]
+                   (let [?rec (with-meta `rec# {:tag ?type})]
+                     `((def ~(document-with-arglist ?accessor (vector ?type)  (str "Access `" ?field "` field"
+                                                                                (name-doc ?field)
+                                                                                " from a [[" ?type "]] record. " ?docref))
+                         (fn [~?rec]
+                           (check-type ~?type ~?rec ~?accessor)
+                           (. ~?rec ~(symbol (str "-" ?field)))))
+                       ~@(if ?lens
+                           (let [?data `data#
+                                 ?v `v#]
+                             `((def ~(document ?lens (str "Lens for the `" ?field "` field"
+                                                          (name-doc ?field)
+                                                          " from a [[" ?type "]] record." ?docref))
+                                 (active.clojure.lens/lens ~?accessor
+                                                           (fn [~?data ~?v]
+                                                             (~?constructor ~@(map
+                                                                               (fn [[?shove-field ?shove-accessor]]
+                                                                                (if (= ?field ?shove-field)
+                                                                                ?v
+                                                                                `(~?shove-accessor ~?data)))
+                                                                               ?field-triples)))))))
+                           '()))))
+                 ?field-triples)))))


Creating tribes

Creating tribes

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -9,6 +9,48 @@
     (. com.github.lands.PickleSerialization loadWorld f)))

 (def world (load-world "worlds/seed_13038.world"))
+
+; --------------------------------------
+; Records
+; --------------------------------------
+
+(defrecord Tribe [id name language settlements])
+(defrecord Game [next-id tribes settlements])
+
+; --------------------------------------
+; Global state
+; --------------------------------------
+
+(def world (atom (load-world "worlds/seed_13038.world")))
+
+(defn create-game []
+  (Game. 1 {} {}))
+
+(def game  (atom (create-game)))
+
+; --------------------------------------
+; Tribe functions
+; --------------------------------------
+
+(defn- create-tribe-in-game [game]
+  (let [next-id (.next-id game)
+        game (assoc game :next-id (inc next-id))
+        language nil
+        name nil
+        tribe (Tribe. next-id nil nil [])
+        game (assoc-in game [:tribes next-id] tribe)]
+      (println "Creating tribe [id " next-id "] name: " name)
+    game))
+
+(defn create-tribe []
+  (swap! game create-tribe-in-game))
+
+; --------------------------------------
+; Game functions
+; --------------------------------------
+
+(defn total-pop []
+  0)

 (defn pop-balancer []
   (println "Balancing population"))


cleanup whitespace

cleanup whitespace

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -231,229 +231,230 @@
 (def modified {:modified true})
 (def unmodified {:modified false})

-(def grammar (list (unify-check h21
-                                {:rule "adjective-phrase"
-                                 :synsem {:cat :adjective}})
-
-                   (unify-check h21
-                                (let [head-synsem {:cat :intensifier}]
-                                  {:rule "intensifier-phrase"
-                                   :synsem head-synsem}))
-
-                   (unify-check h10
-                                (let [semantics (atom :top)
-                                      comp-type (atom :top)]
-                                  {:rule "complementizer-phrase"
-                                   :synsem {:cat :comp
-                                            :comp-type comp-type
-                                            :sem semantics}
-                                   :head {:synsem {:comp-type comp-type
-                                                   :sem semantics}}}))
-                   (unify-check c10
-                           {:rule "determiner-phrase"
-                            :synsem {:cat :det}})
-
-                   (unify-check c11-comp-subcat-1
-                           (let [propernoun (atom :top)
-                                 head-sem (atom :top)
-                                 mod-sem (atom {:subj head-sem})
-                                 rest-mod '()]
-                             {:rule "nbar1"
-                              :synsem {:reflexive false
-                                       :propernoun propernoun
-                                       :mod {:first mod-sem
-                                             :rest rest-mod}}
-                              :comp {:synsem {:cat :adjective
-                                              :sem mod-sem}}
-                              :head {:phrasal false
-                                     :synsem {:cat :noun
-                                              :mod rest-mod
-                                              :propernoun propernoun
-                                              :sem head-sem}}}))
-
-                   (unify-check c11-comp-subcat-1
-                           (let [propernoun (atom :top)
-                                 head-sem (atom :top)
-                                 mod-sem (atom {:subj head-sem})
-                                 rest-mod (atom :top)]
-                             {:rule "nbar2"
-                              :synsem {:reflexive false
-                                       :propernoun propernoun
-                                       :mod {:first mod-sem
-                                             :rest rest-mod}}
-                              :comp {:synsem {:cat :adjective
-                                              :sem mod-sem}}
-                              :head {:phrasal true
-                                     :synsem {:cat :noun
-                                              :mod rest-mod
-                                              :propernoun propernoun
-                                              :sem head-sem}}}))
-
-                   ;; np1 -> det nbar
-                   (unify-check c10
-                           comp-specs-head
-                           (let [number-agreement (atom :top)
-                                 propernoun (atom :top)
-                                 mod (atom :top)]
-                             {:rule "noun-phrase1"
-                              :aliases (list "np1")
-                              :synsem {:agr {:number number-agreement}
-                                       :reflexive false
-                                       :cat :noun
-                                       :mod mod
-                                       :propernoun propernoun
-                                       :sem {:number number-agreement}}
-                              :head {:phrasal true
-                                     :synsem {:mod mod
-                                              :propernoun propernoun}}}))
-                   ;; np2 -> det noun
-                   (unify-check c10
-                           comp-specs-head
-                           (let [number-agreement (atom :top)
-                                 propernoun (atom :top)]
-                             {:rule "noun-phrase2"
-                              :aliases (list "np2")
-                              :synsem {:agr {:number number-agreement}
-                                       :reflexive false
-                                       :cat :noun
-                                       :mod '()
-                                       :propernoun propernoun
-                                       :sem {:number number-agreement}}
-                              :head {:phrasal false
-                                     :synsem {:propernoun propernoun}}}))
-
-                   (let [sem (atom :top)
-                         agr (atom :top)
-                         reflexive (atom :top)]
-                     (unify-check h10
-                      subcat-1-principle
-                      head-first
-                      {:comment "h10"
-                       :schema-symbol 'h10
-                       :first :head
-                       :rule "prepositional-phrase"
-                       :synsem {:agr agr
-                                :cat :prep
-                                :reflexive reflexive
-                                :sem sem}
-                       :head {:synsem {:sem sem
-                                       :subcat {:1 {:agr agr
-                                                    :reflexive reflexive}}}}}))
-                   (unify-check c10
-                                unmodified
-                                root-is-head
-                                {:rule "sentence-nonphrasal-head"
-                                 :synsem {:cat :verb}
-                                 :head {:phrasal false
-                                        :slash false
-                                        :synsem {:participle false}}})
-                   (unify-check c10
-                                unmodified
-                                root-is-head-root
-                                {:head {:phrasal true
-                                        :slash false}
-                                 :rule "sentence-phrasal-head"
-                                 :synsem {:cat :verb}})
-
-                   (unify-check h21
-                                root-is-head
-                                {:rule "transitive-vp-nonphrasal-head"
-                                 :synsem {:aux false
-                                          :cat :verb}})
-                   (unify-check h21
-                                root-is-head-root
-                                {:rule "transitive-vp-phrasal-head"
-                                 :head {:phrasal true}
-                                 :synsem {:aux false
-                                          :cat :verb}})
-
-                   ;; TODO: enforce the facts that:
-                   ;; 1. {:head {:phrasal true}} => root-is-head-root
-                   ;; 2. {:head {:phrasal false}} => root-is-head
-                   (unify-check h32
-                           root-is-head
-                           {:rule "vp32"
-                            :head {:phrasal false
-                                   :phrasal-verb true}
-                            :synsem {:aux false
-                                     :cat :verb}})
-
-                   (unify-check h10
-                           {:head {:phrasal false
-                                   :synsem {:cat :sent-modifier}}
-                            :rule "s-modifier"})
-
-                   ;;      noun-phrase3      ->  noun-phrase[1,2] relative-clause-complement
-                   ;; e.g. "the man you saw" ->  "the man"        "you saw"
-                   (unify-check
-                    {:rule "noun-phrase3"
-                     :synsem {:cat :noun
-                              :subcat '()}}
-                    head-principle
-                    head-first
-                    (let [head-sem (atom :top)
-                          agr (atom :top)
-                          cat (atom :noun)
-                          comp-sem (atom {:obj head-sem})
-                          head-mod (atom :top)]
-                      {:phrasal true
-                       :synsem {:cat cat
-                                :agr agr
-                                :sem head-sem
-                                :mod {:first comp-sem
-                                      :rest head-mod}}
-                       :head {:rule "noun-phrase2"
-                              :phrasal true
-                              :synsem {:agr agr
-                                       :cat cat
-                                       :subcat '()
-                                       :mod head-mod
-                                       :sem head-sem}}
-                       :comp {:phrasal true
-                              :rule "relative-clause-complement"
-                              :synsem {:cat :verb
-                                       :sem comp-sem}}})
-
-                    (let [head-modified-by-comp (atom :top)]
-                      {:comp {:synsem {:subcat {:1 head-modified-by-comp}}}
-                       :head {:synsem head-modified-by-comp}}))
-
-                   (unify-check
-                    (let [first-arg (atom :top)
-                          second-arg (atom {:reflexive false})]
-                      {:rule "relative-clause-complement"
-                       :phrasal true
-                       :slash true
-                       :synsem {:cat :verb
-                                :subcat {:1 second-arg
-                                         :2 '()}}
-                       :comp {:synsem first-arg}
-                       :head {:synsem {:subcat {:1 first-arg
-                                                :2 second-arg}}}})
-                    (let [head-sem (atom :top)]
-                      {:synsem {:sem head-sem}
-                       :head {:synsem {:sem head-sem}}})
-
-                    (let [cat (atom :verb)]
-                      {:synsem {:cat cat
-                                :aux false}
-                       :head {:synsem {:aux false
-                                       :cat cat}}})
-
-                    head-last
-
-                    {:comp {:phrasal false}}
-
-                    {:comp {:synsem {:pronoun true
-                                     :case :nom
-                                     :cat :noun}}}
-
-                    (let [infl (atom :top)
-                          participle (atom false)]
-                      {:synsem {:infl infl
-                                :participle participle}
-                       :head {:synsem {:infl infl
-                                       :participle participle}}}))))
+(def grammar
+  [(unify-check h21
+                {:rule "adjective-phrase"
+                 :synsem {:cat :adjective}})
+
+   (unify-check h21
+                (let [head-synsem {:cat :intensifier}]
+                  {:rule "intensifier-phrase"
+                   :synsem head-synsem}))
+
+   (unify-check h10
+                (let [semantics (atom :top)
+                      comp-type (atom :top)]
+                  {:rule "complementizer-phrase"
+                   :synsem {:cat :comp
+                            :comp-type comp-type
+                            :sem semantics}
+                   :head {:synsem {:comp-type comp-type
+                                   :sem semantics}}}))
+   (unify-check c10
+                {:rule "determiner-phrase"
+                 :synsem {:cat :det}})
+
+   (unify-check c11-comp-subcat-1
+                (let [propernoun (atom :top)
+                      head-sem (atom :top)
+                      mod-sem (atom {:subj head-sem})
+                      rest-mod '()]
+                  {:rule "nbar1"
+                   :synsem {:reflexive false
+                            :propernoun propernoun
+                            :mod {:first mod-sem
+                                  :rest rest-mod}}
+                   :comp {:synsem {:cat :adjective
+                                   :sem mod-sem}}
+                   :head {:phrasal false
+                          :synsem {:cat :noun
+                                   :mod rest-mod
+                                   :propernoun propernoun
+                                   :sem head-sem}}}))
+
+   (unify-check c11-comp-subcat-1
+                (let [propernoun (atom :top)
+                      head-sem (atom :top)
+                      mod-sem (atom {:subj head-sem})
+                      rest-mod (atom :top)]
+                  {:rule "nbar2"
+                   :synsem {:reflexive false
+                            :propernoun propernoun
+                            :mod {:first mod-sem
+                                  :rest rest-mod}}
+                   :comp {:synsem {:cat :adjective
+                                   :sem mod-sem}}
+                   :head {:phrasal true
+                          :synsem {:cat :noun
+                                   :mod rest-mod
+                                   :propernoun propernoun
+                                   :sem head-sem}}}))
+
+   ;; np1 -> det nbar
+   (unify-check c10
+                comp-specs-head
+                (let [number-agreement (atom :top)
+                      propernoun (atom :top)
+                      mod (atom :top)]
+                  {:rule "noun-phrase1"
+                   :aliases (list "np1")
+                   :synsem {:agr {:number number-agreement}
+                            :reflexive false
+                            :cat :noun
+                            :mod mod
+                            :propernoun propernoun
+                            :sem {:number number-agreement}}
+                   :head {:phrasal true
+                          :synsem {:mod mod
+                                   :propernoun propernoun}}}))
+   ;; np2 -> det noun
+   (unify-check c10
+                comp-specs-head
+                (let [number-agreement (atom :top)
+                      propernoun (atom :top)]
+                  {:rule "noun-phrase2"
+                   :aliases (list "np2")
+                   :synsem {:agr {:number number-agreement}
+                            :reflexive false
+                            :cat :noun
+                            :mod '()
+                            :propernoun propernoun
+                            :sem {:number number-agreement}}
+                   :head {:phrasal false
+                          :synsem {:propernoun propernoun}}}))
+
+   (let [sem (atom :top)
+         agr (atom :top)
+         reflexive (atom :top)]
+     (unify-check h10
+                  subcat-1-principle
+                  head-first
+                  {:comment "h10"
+                   :schema-symbol 'h10
+                   :first :head
+                   :rule "prepositional-phrase"
+                   :synsem {:agr agr
+                            :cat :prep
+                            :reflexive reflexive
+                            :sem sem}
+                   :head {:synsem {:sem sem
+                                   :subcat {:1 {:agr agr
+                                                :reflexive reflexive}}}}}))
+   (unify-check c10
+                unmodified
+                root-is-head
+                {:rule "sentence-nonphrasal-head"
+                 :synsem {:cat :verb}
+                 :head {:phrasal false
+                        :slash false
+                        :synsem {:participle false}}})
+   (unify-check c10
+                unmodified
+                root-is-head-root
+                {:head {:phrasal true
+                        :slash false}
+                 :rule "sentence-phrasal-head"
+                 :synsem {:cat :verb}})
+
+   (unify-check h21
+                root-is-head
+                {:rule "transitive-vp-nonphrasal-head"
+                 :synsem {:aux false
+                          :cat :verb}})
+   (unify-check h21
+                root-is-head-root
+                {:rule "transitive-vp-phrasal-head"
+                 :head {:phrasal true}
+                 :synsem {:aux false
+                          :cat :verb}})
+
+   ;; TODO: enforce the facts that:
+   ;; 1. {:head {:phrasal true}} => root-is-head-root
+   ;; 2. {:head {:phrasal false}} => root-is-head
+   (unify-check h32
+                root-is-head
+                {:rule "vp32"
+                 :head {:phrasal false
+                        :phrasal-verb true}
+                 :synsem {:aux false
+                          :cat :verb}})
+
+   (unify-check h10
+                {:head {:phrasal false
+                        :synsem {:cat :sent-modifier}}
+                 :rule "s-modifier"})
+
+   ;;      noun-phrase3      ->  noun-phrase[1,2] relative-clause-complement
+   ;; e.g. "the man you saw" ->  "the man"        "you saw"
+   (unify-check
+    {:rule "noun-phrase3"
+     :synsem {:cat :noun
+              :subcat '()}}
+    head-principle
+    head-first
+    (let [head-sem (atom :top)
+          agr (atom :top)
+          cat (atom :noun)
+          comp-sem (atom {:obj head-sem})
+          head-mod (atom :top)]
+      {:phrasal true
+       :synsem {:cat cat
+                :agr agr
+                :sem head-sem
+                :mod {:first comp-sem
+                      :rest head-mod}}
+       :head {:rule "noun-phrase2"
+              :phrasal true
+              :synsem {:agr agr
+                       :cat cat
+                       :subcat '()
+                       :mod head-mod
+                       :sem head-sem}}
+       :comp {:phrasal true
+              :rule "relative-clause-complement"
+              :synsem {:cat :verb
+                       :sem comp-sem}}})
+
+    (let [head-modified-by-comp (atom :top)]
+      {:comp {:synsem {:subcat {:1 head-modified-by-comp}}}
+       :head {:synsem head-modified-by-comp}}))
+
+   (unify-check
+    (let [first-arg (atom :top)
+          second-arg (atom {:reflexive false})]
+      {:rule "relative-clause-complement"
+       :phrasal true
+       :slash true
+       :synsem {:cat :verb
+                :subcat {:1 second-arg
+                         :2 '()}}
+       :comp {:synsem first-arg}
+       :head {:synsem {:subcat {:1 first-arg
+                                :2 second-arg}}}})
+    (let [head-sem (atom :top)]
+      {:synsem {:sem head-sem}
+       :head {:synsem {:sem head-sem}}})
+
+    (let [cat (atom :verb)]
+      {:synsem {:cat cat
+                :aux false}
+       :head {:synsem {:aux false
+                       :cat cat}}})
+
+    head-last
+
+    {:comp {:phrasal false}}
+
+    {:comp {:synsem {:pronoun true
+                     :case :nom
+                     :cat :noun}}}
+
+    (let [infl (atom :top)
+          participle (atom false)]
+      {:synsem {:infl infl
+                :participle participle}
+       :head {:synsem {:infl infl
+                       :participle participle}}}))])

 (defn aux-is-head-feature [phrase]
   (cond (= :verb (get-in phrase '(:synsem :cat)))