fix race condition where outer app starts before compiler/sandbox

--- src-app/swirl/app/repl.cljs
+++ src-app/swirl/app/repl.cljs
@@ -13,8 +13,9 @@
       (when-let [[msg port] (a/alts! [text-in stop-ch])]
         (when (= port text-in)
           (pm/post! other-window :text msg)
-          (let [result (a/<! result-in)]
-            (a/put! result-out result)
+          (let [[result port] (a/alts! [result-in (a/timeout 1000)])]
+            (when (= port result-in)
+              (a/put! result-out result))
             (recur)))))
     (fn stop-comms
       []


Get directions

Get directions

--- src-cljs/flatride/core.cljs
+++ src-cljs/flatride/core.cljs
@@ -8,9 +8,11 @@
 (defn directions-config-obj [from to]
   (js-obj "origin" from
           "destination" to
-          "travelMode" window/google.maps.DirectionsTravelMode.BICYCLING))
+          "travelMode" window/google.maps.DirectionsTravelMode.WALKING))

 (defn compute-routes [from to]
   (let [req-obj (directions-config-obj from to)]
-    (log req-obj)))
+    (log req-obj)
+    (.route (window/google.maps.DirectionsService.) req-obj log)
+    ))


Get WF project info from run vcs-url

Get WF project info from run vcs-url

--- src-cljs/frontend/send.cljs
+++ src-cljs/frontend/send.cljs
@@ -95,11 +95,10 @@
         jobs-by-id (into {} (map (juxt :job/id identity) jobs))
         jobs-with-normalized-required (mapv #(denormalize-required % jobs-by-id)
                                             jobs)
-        {:keys [build/vcs-type build/org build/repo]} (get-in response
-                                                              [:workflow/jobs
-                                                               0
-                                                               :job/build])]
-
+        vcs-url (:workflow/vcs-url response)
+        vcs-type (vcs-url/vcs-type vcs-url)
+        org (vcs-url/org-name vcs-url)
+        repo (vcs-url/repo-name vcs-url)]
     {:run/id run-id
      :run/name (:workflow/name response)
      :run/status status


minor styling

minor styling

--- src/quick_chess/core.cljs
+++ src/quick_chess/core.cljs
@@ -174,7 +174,9 @@
     (reduce
      (fn [hmap [row col]]
        (let [color (get-in init-colors [row col])]
-         (update-in hmap [:board row col] assoc :color color :text "")))
+         (update-in hmap
+                    [:board row col]
+                    assoc :color color :text "")))
      state
      positions)))

@@ -241,7 +243,8 @@
          assoc
          :move-to (zipmap
                    default-keybindings
-                   (vec (possible-placements pos turn)))
+                   (vec
+                    (possible-placements pos turn)))
          :piece-str str)
   (swap! app-state (handle-selection pos turn)))

@@ -289,8 +292,15 @@
           positions (vals (:move-to @text-state))]
       (swap! text-state assoc :text str)
       (cond
-        (move-command? @text-state) (handle-move state text-state positions)
-        piece-pos (select-piece state text-state piece-pos str)
+        (move-command? @text-state) (handle-move
+                                     state
+                                     text-state
+                                     positions)
+        piece-pos (select-piece
+                   state text-
+                   state
+                   piece-pos
+                   str)
         (deselected? state @text-state str) (deselect-piece
                                              state
                                              text-state


--- src/sicp/chapter1/1_5.clj
+++ src/sicp/chapter1/1_5.clj
@@ -1,5 +1,23 @@
-(ns sicp.chapter1.1-5)
+(ns sicp.chapter1.1-5
+  (:require [sicp.chapter1.1-4 :refer [f square sum-of-squares]]))

 ;;;; 1.1  The Elements of Programming

 ;;; 1.1.5  The Substitution Model for Procedure Application
+
+;; applicative-order evaluation
+(f 5)
+(sum-of-squares (+ 5 1) (* 5 2))
+(+ (square 6) (square 10))
+(+ (* 6 6) (* 10 10))
+(+ 36 100)
+136
+
+;; normal-order evaluation
+(f 5)
+(sum-of-squares (+ 5 1) (* 5 2))
+(+ (square (+ 5 1)) (square (* 5 2)))
+(+ (* (+ 5 1) (+ 5 1)) (* (* 5 2) (* 5 2)))
+(+ (* 6 6) (* 10 10))
+(+ 36 100)
+136


Allow watchers to modify state

Allow watchers to modify state

--- src/aurora/interpreter.cljs
+++ src/aurora/interpreter.cljs
@@ -204,11 +204,24 @@
       (catch :default exception
         [exception @next-state (aget stack 0)]))))

-(defn step-example [example watchers input]
-  (let [[_ output _] (run-example example input)]
-    (doseq [watcher watchers]
-      (watcher (:output output)))
-    (dissoc output :output)))
+(defn step-example [example watchers this-state]
+  (let [[_ next-state _] (run-example example this-state)]
+    (dissoc
+     (reduce
+      (fn [state watcher] (watcher state))
+      next-state
+      watchers))
+    :output))
+
+(defn watch-timeout* [buffer state]
+  (doseq [{:keys [cursor timeout]} (get-in state :output :timeout)]
+    (js/setTimeout (fn [] (swap! buffer conj cursor)) timeout))
+  (let [cursors @buffer] ;; this is only valid because js is single-threaded
+    (reduce #(assoc-in %1 %2 "timeout") state cursors)))
+
+(def watch-timeout
+  (let [buffer (atom [])]
+    #(watch-timeout* buffer %)))

 (run-example example-b {"a" 1 "b" 2})
 (run-example example-b {"a" 1 "c" 2})


consistent variable naming

consistent variable naming

--- test/caesium/crypto/scalarmult_test.clj
+++ test/caesium/crypto/scalarmult_test.clj
@@ -18,10 +18,10 @@

 (deftest scalarmult-tests
   (testing "-to-buf! and regular API work identically"
-    (let [out (byte-array s/bytes)
+    (let [q (byte-array s/bytes)
           r (s/scalarmult scalar-1)]
-      (s/scalarmult-to-buf! scalar-1 out)
-      (is (u/array-eq r out))))
+      (s/scalarmult-to-buf! scalar-1 q)
+      (is (u/array-eq r q))))
   (testing "base point mult uses the base point"
     (is (u/array-eq
          (s/scalarmult scalar-1)


Fix whitespace

Fix whitespace

--- src/braid/notices/core.cljc
+++ src/braid/notices/core.cljc
@@ -17,8 +17,6 @@
 (defn init! []
   #?(:cljs
      (do
-
-
        (core/register-state!
          {::state {}}
          {::state {keyword? ErrorSpec}})


Fix permission checking in search

Fix permission checking in search

--- src/braid/server/search.clj
+++ src/braid/server/search.clj
@@ -89,7 +89,7 @@
     (->> (if (every? some? [text-search tag-search])
            (intersection text-search tag-search)
            (first (remove nil? [text-search tag-search])))
-         (filter (partial db/user-can-see-thread? user-id))
+         (filter (comp (partial db/user-can-see-thread? user-id) first))
          ; sorting the ids so we can have a consistent order of results
          (sort-by second)
          (map first))))


Fix being unable to upload same file twice

--- src/braid/uploads/core.cljc
+++ src/braid/uploads/core.cljc
@@ -43,7 +43,10 @@
                                   (s3/upload
                                     (aget (.. e -target -files) 0)
                                     (fn [url]
-                                      (dispatch [::create-upload! url]))))}]]))
+                                      (dispatch [::create-upload! url])))
+                                  ;; clear the value of this input field
+                                  ;; so that it can be re-used with the same file if need be
+                                  (set! (.. e -target -value) nil))}]]))

        (core/register-new-message-action-menu-item!
          {:body "Add File"


correct account test expectation

correct account test expectation

alphabetize account names
simplify the comparison for easier resolution

--- test/clj_money/models/accounts_test.clj
+++ test/clj_money/models/accounts_test.clj
@@ -92,21 +92,29 @@
                                           :type :expense
                                           :parent-id (:id taxes)
                                           :entity-id (:id entity)})
-        result (accounts/select-nested-by-entity-id storage-spec (:id entity))
+        result (simplify-account-groups (accounts/select-nested-by-entity-id storage-spec (:id entity)))
         expected [{:type :asset
-             :accounts [(assoc checking :children [])
-                        (assoc savings :children [(assoc car-savings :children [(assoc doug-car :children [])
-                                                                                (assoc eli-car :children [])])
-                                                  (assoc reserve-savings :children [])])]}
-            {:type :liability
-             :accounts []}
-            {:type :equity
-             :accounts []}
-            {:type :income
-             :accounts []}
-            {:type :expense
-             :accounts [(assoc taxes :children [(assoc fit :children [])
-                                                (assoc ss  :children [])])]}]]
+                   :accounts [{:name "Checking"}
+                              {:name "Savings"
+                               :children [{:name "Car"
+                                           :children [{:name "Doug"}
+                                                      {:name "Eli"}]}
+                                          {:name "Reserve"}]}]}
+                  {:type :liability
+                   :accounts []}
+                  {:type :equity
+                   :accounts []}
+                  {:type :income
+                   :accounts []}
+                  {:type :expense
+                   :accounts [{:name "Taxes"
+                               :children [{:name "Federal Income Tax"}
+                                          {:name "Social Security"}]}]}]]
+    (when-not (= expected result)
+      (pprint {:expected expected
+               :actual result
+               :diff (diff expected result)}))
+
     (is (= expected result) "The accounts should be returned in the correct hierarchy")))

 (deftest create-an-account


using local hostname for base

using local hostname for base

--- src/celestial/hosts_api.clj
+++ src/celestial/hosts_api.clj
@@ -61,7 +61,7 @@

 (defc [:env] (keyword v))

-(set-base "https://localhost:8443/")
+(set-base (<<  "https://~{(:hostName (bean (java.net.InetAddress/getLocalHost)))}:8443/"))

 (defroutes- hosts {:path "/host" :description "Operations on hosts"}


Adding updated-system and running! not-running! fixing reload to grab updated system

--- src/celestial/workflows.clj
+++ src/celestial/workflows.clj
@@ -62,6 +62,23 @@
            (run-hooks ~hook-args ~(keyword name*) :error)
            (throw t#))))))

+(defn updated-system
+   "grabs system and associates system id"
+   [system-id]
+   (assoc (s/get-system system-id) :system-id system-id))
+
+(defn running!
+  "Asserts that a VM is running"
+  [vm]
+  (assert (= (.status vm) "running")) ; might not match all providers
+  )
+
+(defn not-running!
+  "Assert that a vm is not running"
+   [vm]
+  (assert (not (= (.status vm) "running"))) ; might not match all providers
+  )
+
 (deflow reload
   "Reloads a machine if one already exists, will distroy the old one"
   [{:keys [machine system-id] :as spec}]
@@ -71,10 +88,9 @@
       (info "clearing previous" machine)
       (.stop vm)
       (.delete vm))
-    (let [reload-spec (assoc (s/get-system system-id) :system-id system-id)
-           vm* (.create (vconstruct reload-spec))]
+    (let [vm* (.create (vconstruct (updated-system system-id)))]
       (.start vm*)
-      (assert (= (.status vm*) "running")) ; might not match all providers
+      (running! vm*)
       (info "done system setup"))))

 (deflow stop
@@ -83,17 +99,17 @@
   (let [vm (vconstruct spec)]
     (info "stopping" machine)
     (.stop vm)
-    (assert (not (= (.status vm) "running"))) ; might not match all providers
+    (not-running! vm)
     ))

 (deflow start
   "Start a vm instance"
   [{:keys [machine] :as spec}]
   (let [vm (vconstruct spec)]
-    (assert (not (= (.status vm) "running"))) ; might not match all providers
+    (not-running! vm)
     (info "starting" machine)
     (.start vm)
-    (assert (= (.status vm) "running")) ; might not match all providers
+    (running! vm)
     ))

 (deflow create
@@ -105,7 +121,7 @@
        (throw+ {:type ::machine-exists :msg "can't create an existing machine"}))
     (let [vm* (.create vm)]
       (.start vm*)
-      (assert (= (.status vm*) "running")) ; might not match all providers
+      (running! vm*)
       (info "done system setup"))))

 (deflow destroy
@@ -123,17 +139,19 @@
   [type {:keys [machine] :as spec}]
     (info "starting to provision")
     (trace type spec)
-    (assert (= (.status (vconstruct spec)) "running")) ; might not match all providers
+    (running! (vconstruct spec))
     (.apply- (pconstruct type spec))
     (info "done provisioning"))
+
+

 (defn stage
   "create and provision"
   [type {:keys [system-id] :as spec}]
   (create spec)
-  (when-not (= (.status (vconstruct spec)) "running"); some providers already start the vm (AWS, vCenter)
-    (start spec))
-  (puppetize type (assoc (s/get-system system-id) :system-id system-id)))
+  (when-not (= (.status (vconstruct (updated-system system-id))) "running"); some providers already start the vm (AWS, vCenter)
+    (start (updated-system system-id)))
+  (puppetize type (updated-system system-id)))

 (deflow ^{:hook-args :run-info} run-action
   "Runs an action"


adjusted line in documentation.

adjusted line in documentation.

--- src/clj/forma/hadoop/io.clj
+++ src/clj/forma/hadoop/io.clj
@@ -1,7 +1,8 @@
 ;; This file isolates all direct interaction with Hadoop, and provides
 ;; access to any custom schemes used by FORMA. Any new schemes, or
 ;; low-level additions to our hadoop interaction capabilities should
-;; go here, allowing our other components to work at a high level of abstraction.
+;; go here, allowing our other components to work at a high level of
+;; abstraction.

 (ns forma.hadoop.io
   (:use cascalog.api


Return a failjure if the directories cannot be removed

--- src/clj/mdr2/production.clj
+++ src/clj/mdr2/production.clj
@@ -13,7 +13,8 @@
             [mdr2.pipeline1 :as pipeline]
             [clojure.tools.logging :as log]
             [medley.core :as medley]
-            [failjure.core :as fail]))
+            [failjure.core :as fail]
+            [mdr2.utils :as utils]))

 (defn library-signature?
   "Return true if `id` is a valid library signature"
@@ -252,8 +253,8 @@
   (if (obi/directory-valid? production)
     ;; only delete if nothing is fishy with the directories
     (doseq [dir (path/all production)] (fs/delete-tree dir))
-    (log/errorf "Obi directory for production %s is not valid. Not removing."
-                (:id production))))
+    (utils/log-and-fail
+     (format "Failed to remove %s as the Obi directory is not valid" (:id production)))))

 (defn set-state-archived! [production]
   (delete-all-dirs! production)


set reitit ring router #377

set reitit ring router
#377

--- src/clj/swarmpit/server.clj
+++ src/clj/swarmpit/server.clj
@@ -7,18 +7,13 @@
             [ring.middleware.gzip :refer [wrap-gzip]]
             [swarmpit.authentication :refer [wrap-authentication]]
             [swarmpit.authorization :refer [wrap-authorization]]
-            ;[swarmpit.handler :as handler :refer :all]
             [swarmpit.event.handler :refer :all]
             [org.httpkit.server :refer [run-server]]
-            ;[bidi.ring :refer [make-handler]]
-            ;[bidi.bidi :refer [match-pair match-route*]]
             [clojure.tools.logging :as log]
             [swarmpit.routes :as routes]
             [swarmpit.setup :as setup]
             [swarmpit.database :as db]
             [swarmpit.agent :as agent]
-
-
             [reitit.ring :as ring]
             [reitit.coercion.spec]
             [reitit.swagger :as swagger]
@@ -26,11 +21,8 @@
             [reitit.ring.coercion :as coercion]
             [reitit.dev.pretty :as pretty]
             [reitit.ring.middleware.muuntaja :as muuntaja]
-            [reitit.ring.middleware.exception :as exception]
             [reitit.ring.middleware.parameters :as parameters]
-            [muuntaja.core :as m]
-
-            ))
+            [muuntaja.core :as m]))

 (defn wrap-client-exception
   [handler]
@@ -49,49 +41,35 @@
         {:status 500
          :body   (Throwable->map e)}))))

-;(defn wrap-path-params
-;  [handler]
-;  (fn [{:keys [uri] :as request}]
-;    (let [{:keys [route-params]} (match-route* routes/backend uri request)]
-;      (handler
-;        (assoc request :path-params route-params)))))
-
-;(def app
-;  (-> (make-handler routes/backend handler/dispatch)
-;      (wrap-resource "public")
-;      wrap-authorization
-;      wrap-client-exception
-;      wrap-fallback-exception
-;      wrap-authentication
-;      wrap-path-params
-;      wrap-json-params
-;      wrap-json-response
-;      (wrap-defaults (assoc-in site-defaults [:security :anti-forgery] false))
-;      wrap-gzip))
-
 (def app
   (ring/ring-handler
     (ring/router
-      routes/table
+      routes/backend
       {:exception pretty/exception
-       :data {:coercion reitit.coercion.spec/coercion
-              :muuntaja m/instance
-              :middleware [;; negotiation, request decoding and response encoding
-                           muuntaja/format-middleware
-                           ;; swagger feature
-                           swagger/swagger-feature
-                           ;; query-params & form-params
-                           parameters/parameters-middleware
-                           ;; exception handling
-                           exception/exception-middleware
-                           ;; coercing response bodys
-                           coercion/coerce-response-middleware
-                           ;; coercing request parameters
-                           coercion/coerce-request-middleware]}})
+       :conflicts nil
+       :data      {:coercion   reitit.coercion.spec/coercion
+                   :muuntaja   m/instance
+                   :middleware [;; authentication
+                                wrap-authentication
+                                ;; authorization
+                                wrap-authorization
+                                ;; negotiation, request decoding and response encoding
+                                muuntaja/format-middleware
+                                ;; swagger feature
+                                swagger/swagger-feature
+                                ;; query-params & form-params
+                                parameters/parameters-middleware
+                                ;; exception handling
+                                wrap-client-exception
+                                wrap-fallback-exception
+                                ;; coercing response bodys
+                                coercion/coerce-response-middleware
+                                ;; coercing request parameters
+                                coercion/coerce-request-middleware]}})
     (ring/routes
       (swagger-ui/create-swagger-ui-handler
-        {:path "/"
-         :config {:validatorUrl nil
+        {:path   "/"
+         :config {:validatorUrl     nil
                   :operationsSorter "alpha"}})
       (ring/create-default-handler))))


cleanup

cleanup

--- src/cljs/dato/lib/core.cljs
+++ src/cljs/dato/lib/core.cljs
@@ -292,14 +292,6 @@
                                                   {:tx/transient? true})
                                                 (update-in [:tx/intent] (fn [intent]
                                                                           (or intent event))))]
-                         (when-not (:tx/transient? full-tx-meta)
-                           (js/console.log "\tevent: " (pr-str event))
-                           (js/console.log "\ttx-data: " (pr-str tx-data))
-                           (js/console.log "\ttx-meta: " (pr-str full-tx-meta)))
-                         (cljs.pprint/pprint tx-data)
-                         (cljs.pprint/pprint full-tx-meta)
-                         (cljs.pprint/pprint (or (:tx/broadcast? full-tx-meta)
-                                                 (:tx/persist? full-tx-meta)))
                          (if tx-data
                            (if (or (:tx/broadcast? full-tx-meta)
                                    (:tx/persist? full-tx-meta))


Fix basic-conj-test expected ordering (now in a vec)


All primitives required to implement state machine

I don't like how some of them are implemented, but we'll get to that later.

--- src/computer_build/vhdl.clj
+++ src/computer_build/vhdl.clj
@@ -60,6 +60,28 @@
 (defmethod to-vhdl :<= [[type target expression]]
   (spaces (keyword-to-str target) "<=" (keyword-to-str expression)))

+(defmethod to-vhdl :signal [[type name type]]
+  (str "signal " name " : " type ";"))
+
+(defmethod to-vhdl :deftype [[type name values]]
+  (let [valuelist (str-join ", " values)]
+    (spaces "type" name "is" "(" valuelist ");")))
+
+(defmethod to-vhdl :if [[type condition & body]]
+  (list
+    (spaces "if" (to-vhdl condition) "then")
+    (map to-vhdl body)))
+
+(defmethod to-vhdl :and [[type condA condB]]
+  (spaces (to-vhdl condA) "and" (to-vhdl condB)))
+
+(defmethod to-vhdl :event [[type target]]
+  (str (keyword-to-str target) "'EVENT"))
+
+(defmethod to-vhdl := [[type condA condB]]
+  (spaces (name condA) "=" condB))
+
+
 (defn generate-vhdl [& entities]
   (do
     (println "library ieee;")


prefer string paths

prefer string paths

--- src/corpus_utils/kokken.clj
+++ src/corpus_utils/kokken.clj
@@ -127,7 +127,7 @@

 (sm/defn document-seq
   [data-dir :- s/Str]
-  (->> (fs/glob data-dir "/*.xml")
+  (->> (fs/glob (str data-dir "/*.xml"))
        (map parse)))

 ;;(parse "/data/taiyo-corpus/XML/t189506.xml")


Log 500 errors

Log 500 errors

--- backend/src/akvo/lumen/component/handler.clj
+++ backend/src/akvo/lumen/component/handler.clj
@@ -2,6 +2,7 @@
   (:require [compojure.core :as compojure.core]
             [compojure.response :as compojure.res]
             [integrant.core :as ig]
+            [clojure.tools.logging :as log]
             [akvo.lumen.specs.components :refer [integrant-key]]
             [clojure.spec.alpha :as s]
             [ring.middleware.defaults]
@@ -97,7 +98,9 @@
     (fn [request]
       (try
         (handler request)
-        (catch Throwable _
+        (catch Throwable t
+          (log/error t "500 App Error")
+          (log/info :request-on-500 request)
           (-> (compojure.res/render error-response request)
               (ring.response/content-type "text/html")
               (ring.response/status 500)))))))


Update tools-deps to 1.10.3.1058

Update tools-deps to 1.10.3.1058


Improve my playing with Ian Rumford's reducer examples.

--- test/com/nomistech/clojure_the_language/reducers_rumford_test.clj
+++ test/com/nomistech/clojure_the_language/reducers_rumford_test.clj
@@ -352,12 +352,21 @@
 ;;;; nomis stuff

 #_
-(do
-  (time (reduce + 0
-                (map #(if (= :child (:role %)) 1 0)
-                     (filter #(= "brown" (string/lower-case (:family %))) ex7-visitors))))
-  (time (r/reduce + 0 (ex2-pipeline ex7-visitors)))
-  (time (r/fold + (ex2-pipeline ex7-visitors))))
+[(time (reduce + 0
+               ((comp (partial map person--child?->1)
+                      (partial filter person--brown-family-member?))
+                ex7-visitors)))
+ (time (r/reduce + 0
+                 ((comp (r/map person--child?->1)
+                        (r/filter person--brown-family-member?))
+                  ex7-visitors)))
+ (time (r/fold + ((comp (r/map person--child?->1)
+                        (r/filter person--brown-family-member?))
+                  ex7-visitors)))]
+
+;; "Elapsed time: 214.727 msecs"
+;; "Elapsed time: 181.938 msecs"
+;; "Elapsed time: 97.075 msecs"

 ;;;; ___________________________________________________________________________


First, superficial cleanup

First, superficial cleanup

--- src/exp/sahucs_inverted.clj
+++ src/exp/sahucs_inverted.clj
@@ -20,12 +20,12 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   Helpers       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn assoc-safe [m pred k v]
-  (if (contains? m k)
-      (do (assert (pred (get m k) v)) m)
-    (assoc m k v)))
+(defn assoc-new [m k v]
+  (assert (not (contains? m k)))
+  (assoc m k v))

-(defn spos [s]  (try  (map #(env/get-var s %) '[[atx] [aty]]) (catch Exception e)))
+;(defn spos [s]  (try  (map #(env/get-var s %) '[[atx] [aty]]) (catch Exception e)))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Data Structures ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -73,7 +73,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Core Algorithm  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-;; TODO: sort out rewards.

 (defn get-sa-node [#^HashMap cache a parent-entry pre-reward]
   "Create a new sa-node, or returned the cached copy if it exists."
@@ -81,64 +80,46 @@
         context (env/precondition-context a s)
         cache-key [(env/action-name a) (env/extract-context s context)]
         cache-val (.get cache cache-key)]
-;    (println "get-sa" (env/action-name a) (when cache-val "t") (when (and cache-val (.contains (:parent-set cache-val) parent-entry)) "t") pre-reward (:reward-to-state parent-entry))
     (when cache-val (assert (<= pre-reward (second (last @(:parent-vec-atom cache-val))))))
-    (cond (and cache-val (.contains (:parent-set cache-val) parent-entry))
+    (cond (and cache-val (.contains #^HashSet (:parent-set cache-val) parent-entry))
             []
           cache-val
             (do (swap! (:parent-vec-atom cache-val) conj [parent-entry pre-reward])
-                (.add  (:parent-set cache-val) parent-entry)
-;                (println "REHIT" (env/action-name (:action cache-val)) "in service of" (env/action-name (:action (:sanode parent-entry))) (count @(:result-map-atom cache-val)))
+                (.add  #^HashSet (:parent-set cache-val) parent-entry)
                 (for [[ss sr] @(:result-map-atom cache-val)]
-                  (do ;(println "re-adding for result" (spos ss) pre-reward sr)
-                      [(GQEntry ss sr cache-val [[parent-entry pre-reward]])
-                       (- 0 pre-reward sr)])))
+                  [(GQEntry ss sr cache-val [[parent-entry pre-reward]]) (- 0 pre-reward sr)]))
           :else
-            (let [s      (env/get-logger s)]
+            (let [s      (env/get-logger s)
+                  nd     (make-sa-node context a parent-entry pre-reward)]
+              (.put cache cache-key nd)
               (if (env/primitive? a)
-                  (if (env/applicable? a s)
-                      (let [[ss sr] (env/successor a (env/get-logger s ))
-                            nd      (make-sa-node context a parent-entry pre-reward)]
-;                  (println "app")
-                        (.put cache cache-key nd)
-                        [[(GQEntry ss sr nd :fresh)
-                          (- 0 pre-reward sr)]])
-                    (do ;(println "NA")
-                      (.put cache cache-key (make-sa-node context a parent-entry pre-reward))
-                      nil))
-                (let [nd (make-sa-node context a parent-entry pre-reward)]
-                  (.put cache cache-key nd)
-                  (doall
-                   (mapcat
-                    (fn [ref]
-                      (if (empty? ref)
+                  (when (env/applicable? a s)
+                    (let [[ss sr] (env/successor a (env/get-logger s ))]
+                      [[(GQEntry ss sr nd :fresh) (- 0 pre-reward sr)]]))
+                (apply concat
+                  (for [ref (hierarchy/immediate-refinements a s)]
+                    (if (empty? ref)
                         [[(GQEntry s 0 nd :fresh) (- pre-reward)]]
-                        (get-sa-node cache (first ref) (ParentEntry s 0 (next ref) nd) pre-reward)))
-                    (hierarchy/immediate-refinements a s)))))))))
+                      (get-sa-node cache (first ref) (ParentEntry s 0 (next ref) nd) pre-reward)))))))))

 (defn update-parent [cache parent-entry parent-pre-reward new-state new-reward child-sanode]
   (let [new-effects (env/extract-effects new-state (:context child-sanode))
         final-state  (env/apply-effects (:state parent-entry) new-effects)
-        actions      (:remaining-actions parent-entry)]
-;    (println "parent with" (map env/action-name actions) "for" (env/action-name (:action (:sanode parent-entry))) "from" (spos (:state (first (:parent-set (:sanode parent-entry))))))
+        actions      (:remaining-actions parent-entry)
+        rts          (:reward-to-state parent-entry)
+        ]
     (if (empty? actions)
-       [[(GQEntry final-state
-                  (+ (:reward-to-state parent-entry) new-reward)
-                  (:sanode parent-entry) :fresh)
+       [[(GQEntry final-state (+ rts new-reward) (:sanode parent-entry) :fresh)
          (- 0 parent-pre-reward new-reward)]]
       (get-sa-node cache (first actions)
-                   (ParentEntry final-state
-                                (+ (:reward-to-state parent-entry) new-reward)
-                                (next actions) (:sanode parent-entry))
-                   (+ parent-pre-reward new-reward)))))
+        (ParentEntry final-state (+ rts new-reward) (next actions) (:sanode parent-entry))
+        (+ parent-pre-reward new-reward)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    Top-level    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn pp [q xs]
-  ;(println "adding" (count xs))
-  (queues/pq-add-all! q xs))
+

 (defn sahucs-inverted [henv]
   (let [e     (hierarchy/env henv)
@@ -149,43 +130,25 @@
                    (ParentEntry (env/initial-state e) 0 nil nil) 0))
     (loop []
       (if (queues/pq-empty? queue) nil
-        (let [[best neg-rew] (queues/pq-remove-min-with-cost! queue)
-;              fresh?         (= :fresh @(:remaining-parents-atom best))
-;              rma            (:result-map-atom (:sanode best))
-;              old-rew        (get @rma best)
-
-              ]
-;            (assert (<= neg-rew 10))
- ;           (println neg-rew (queues/pq-size queue) (env/action-name (:action (:sanode best))) (spos (:state best)) (spos (:state (first (:parent-set (:sanode best))))) #_ (:state best))
-            (if (nil? (:sanode (first (:parent-set (:sanode best)))))
-                (- neg-rew)
-              (let [init-hash   (hash best)
-                    cpa-val     (:remaining-parents best)
-;                    old-results @(:result-map-atom (:sanode best))
-                    cur-parents (if (= :fresh cpa-val)
-                                  (do (swap! (:result-map-atom (:sanode best)) assoc-safe >=
-                                             (:state best) (:reward-to-state best))
-                                      @(:parent-vec-atom (:sanode best)))
-                                  cpa-val)
-                    best-rew    (- 0 neg-rew (:reward-to-state best))
-                    [good-parents bad-parents] (split-with #(= (second %) best-rew) cur-parents)]
-;                (println (map second bad-parentsc))
-                (util/assert-is (seq good-parents)  "%s" [(keyword? cpa-val) neg-rew (:reward-to-state best) best-rew (map second cur-parents) (env/action-name (:action (:sanode best))) (count cur-parents) (count (:parent-vec-atom (:sanode best)))])
-;                (reset! (:remaining-parents-atom best) bad-parents)
-;                (assert (not (= init-hash (hash best))))
-                (when (seq bad-parents)
-                  (let [nxt (GQEntry (:state best) (:reward-to-state best) (:sanode best) bad-parents)]
-;                  (when-not (nil? (queues/g-pq-priority queue best))
-;                    (let [on (queues/g-pq-key queue best)]
-;                      (dr/debug-repl)))
-                    (util/assert-is (nil? (queues/g-pq-priority queue nxt)) "%s" [(:reward-to-state best) (second (first bad-parents))  (count cur-parents) (count bad-parents) (map second cur-parents) (count @(:parent-vec-atom (:sanode best)))])
-                    (queues/pq-replace! queue nxt
-                                        (- 0 (:reward-to-state best) (second (first bad-parents))))))
-                (doseq [[parent parent-reward] good-parents]
-                  (pp #_ queues/pq-add-all! queue
-                    (update-parent cache parent parent-reward
-                                   (:state best) (:reward-to-state best) (:sanode best))))
-                (recur))))))))
+        (let [[best neg-rew] (queues/pq-remove-min-with-cost! queue)]
+          (if (nil? (:sanode (first (:parent-set (:sanode best))))) ; solution state
+              (- neg-rew)
+            (let [b-s  (:state best), b-rts (:reward-to-state best), b-sa (:sanode best)
+                  [b-gp b-bp] (split-with #(= (second %) (- 0 neg-rew b-rts))
+                                (if (= :fresh (:remaining-parents best))
+                                    (do (swap! (:result-map-atom b-sa) assoc-new b-s b-rts)
+                                        @(:parent-vec-atom b-sa))
+                                  (:remaining-parents best)))]
+              (assert (seq b-gp))
+              (when (seq b-bp)
+                (queues/pq-replace! queue (GQEntry b-s b-rts b-sa b-bp)
+                                    (- 0 b-rts (second (first b-bp)))))
+              (doseq [[p p-r] b-gp]
+                (queues/pq-add-all! queue (update-parent cache p p-r b-s b-rts b-sa)))
+              (recur))))))))

+;                (util/assert-is (seq good-parents)  "%s" [(keyword? cpa-val) neg-rew (:reward-to-state best) best-rew (map second cur-parents) (env/action-name (:action (:sanode best))) (count cur-parents) (count (:parent-vec-atom (:sanode best)))])
+
+;                    (util/assert-is (nil? (queues/g-pq-priority queue nxt)) "%s" [(:reward-to-state best) (second (first bad-parents))  (count cur-parents) (count bad-parents) (map second cur-parents) (count @(:parent-vec-atom (:sanode best)))])


remove /unread URL, use / instead

remove /unread URL, use / instead

--- src/instapapure/servlet.clj
+++ src/instapapure/servlet.clj
@@ -29,7 +29,7 @@
   (html
     [:h1 title]
     [:p
-      [:a {:href "/unread"}  "Unread"]
+      [:a {:href "/"}  "Unread"]
       " ♢ "
       [:a {:href "/starred"}  "Starred"]
       " ♢ "
@@ -167,8 +167,6 @@
     (or (serve-file (params :*)) :next))
   (GET "/"
     (show-unread-articles))
-  (GET "/unread"
-    (show-unread-articles))
   (GET "/archive"
     (show-read-articles))
   (GET "/starred"


Fix the alphabetical order of the glossary.

--- src/klangmeister/views.cljs
+++ src/klangmeister/views.cljs
@@ -23,11 +23,12 @@
       (row "[..]" "Build a sequence." "[1 2 3]")
       (row "->>" "Thread together multiple expressions." "(->> (range) (take 4))")
       (row "A..G" "Translate a relative midi into the specified key." "(A 3) => 72")
+      (row "bpm" "Build a function that converts beats into seconds." "((bpm 120) 3) => 1.5")
+      (row "def" "Define a value with a name. Used outside the `->>`." "(def pi 3.14)")
       (row "flat" "Translate a midi down one semitone." "(flat 72) => 71")
-      (row "phrase" "Build a melody from a sequence of durations and a sequence of pitches." "(phrase [1 1 2] [0 2 4])")
-      (row "bpm" "Build a function that converts beats into seconds." "((bpm 120) 3) => 1.5")
       (row "major" "Convert a rank of a minor scale into a midi pitch." "(major 2) => 4")
       (row "minor" "Convert a rank of a minor scale into a midi pitch." "(minor 2) => 3")
+      (row "phrase" "Build a melody from a sequence of durations and a sequence of pitches." "(phrase [1 1 2] [0 2 4])")
       (row "sharp" "Translate a midi up one semitone." "(sharp 70) => 71")
       (row "where" "Transform a specified key using a specified function." "(where :pitch inc notes)")
       (row "with" "Combines two melodies." "(with notes bass-notes)")]]))


mess around

mess around

--- src/lolteambuilder/core.clj
+++ src/lolteambuilder/core.clj
@@ -130,8 +130,8 @@
     (insert-matches
       (filter seq
         (for [{id :matchId} (take 50 (:matches history))]
+          (Thread/sleep 1000)
           (try
-            (Thread/sleep 1000) ; maybe rate-limited
             (match region id)
             (catch clojure.lang.ExceptionInfo e
               (println e)


decent progress on figwheel-main

decent progress on figwheel-main

--- figwheel-main/src/figwheel/main.clj
+++ figwheel-main/src/figwheel/main.clj
@@ -13,13 +13,17 @@
    [cljs.build.api :as bapi]
    [hawk.core :as hawk])
   (:import
-   [java.io StringReader]))
+   [java.io StringReader]
+   [java.net.URI]
+   [java.nio.file.Paths]))

 ;; ------------------------------------------------------------
 ;; Watching
 ;; ------------------------------------------------------------

 (def ^:dynamic *watcher* (atom {:watcher nil :watches {}}))
+
+(defonce process-unique (subs (str (java.util.UUID/randomUUID)) 0 6))

 (defn alter-watches [{:keys [watcher watches]} f]
   (when watcher (hawk/stop! watcher))
@@ -92,13 +96,63 @@
         (ex-info
           (str "Watch path " path " does not exist")
           {:cljs.main/error :invalid-arg}))))
-  (update-in cfg [:options :watch] (fnil conj []) path))
+  (update-in cfg [::options-meta :watch] (fnil conj []) path))

 (defn figwheel-opt [cfg bl]
   (assoc-in cfg [::options-meta :figwheel] (not= bl "false")))

+(defn get-build [bn]
+  (try (read-string (slurp (str bn ".cljs.edn")))
+             (catch Throwable t
+               (throw
+                (ex-info (str "Couldn't read the build file: " (str bn ".cljs.edn"))
+                         {:cljs.main/error :invalid-arg})))))
+
+(defn path-parts [uri]
+  (map str (java.nio.file.Paths/get uri)))
+
+(defn watch-dir-from-ns [main-ns]
+  (let [source (bapi/ns->location main-ns)
+        local-dir (System/getProperty "user.dir")]
+    (when-let [f (:uri source)]
+      (let [parts (path-parts (.toURI f))
+            local-dir-parts (path-parts (java.net.URI/create (str "file:" (System/getProperty "user.dir"))))]
+        (when (and (= local-dir-parts (take (count local-dir-parts) parts))
+                   (:relative-path source))
+          (let [res (drop (count local-dir-parts) parts)
+                end-parts (path-parts (java.net.URI/create (str "file:/" (:relative-path source))))]
+            (when (= end-parts (take-last (count end-parts) res))
+              (string/join (System/getProperty "file.separator") (drop-last (count end-parts) res)))))))))
+
+(defn watch-dirs-from-build [{:keys [main] :as build-options}]
+  (let [watch-dirs (-> build-options meta :watch-dirs)
+        main-ns-dir (and main (watch-dir-from-ns (symbol main)))]
+    (cons main-ns-dir watch-dirs)))
+
 (defn build-opt [cfg bn]
-  (assoc-in cfg [::options-meta :build-name] bn))
+  (when-not (.exists (io/file (str bn ".cljs.edn")))
+    (if (or (string/starts-with? bn "-")
+            (string/blank? bn))
+      (throw
+        (ex-info
+          (str "Missing build name")
+          {:cljs.main/error :invalid-arg}))
+      (throw
+        (ex-info
+          (str "Build " (str bn ".cljs.edn") " does not exist")
+          {:cljs.main/error :invalid-arg}))))
+  (let [options (get-build bn)
+        watch-dirs (watch-dirs-from-build options)]
+    (-> cfg
+        (update :options merge options)
+        (update-in [::options-meta :watch] concat watch-dirs)
+        (assoc-in [::options-meta :build-id] bn)
+        (assoc-in [::options-meta :build-options]
+                  options))))
+
+(defn build-once-opt [cfg bn]
+  (let [cfg (build-opt cfg bn)]
+    (assoc-in cfg [::options-meta :build-once] true)))

 (def figwheel-commands
   {:init {["-w" "--watch"]
@@ -111,7 +165,15 @@
            :doc (str "Use Figwheel to auto reload and report compile info.\n"
                      "Only takes effect when watching is happening and the\n"
                      "optimizations level is :none or nil.\n"
-                     "Defaults to true.")}}})
+                     "Defaults to true.")}
+          ["-b" "--build"]
+          {:group :cljs.cli/compile :fn build-opt
+           :arg "build-name"
+           :doc (str "The name of a build config to build.")}
+          ["-bo" "--build-once"]
+          {:group :cljs.cli/compile :fn build-once-opt
+           :arg "build-name"
+           :doc (str "The name of a build config to build once.")}}})

 (alter-var-root #'cli/default-commands cli/add-commands
                 figwheel-commands)
@@ -135,10 +197,23 @@
       (last (string/split (or output-dir default-output-dir)
                           #"[\/\\]public[\/\\]")))))

+
+
 (defn default-compile
   [repl-env {:keys [ns args options ::options-meta] :as cfg}]
-  (println "Default compile")
-  (let [rfs      #{"-r" "--repl"}
+  (let [;; remember we have to fix this for the repl-opt as well
+        ;; so that it understands multiple watch directories
+        watch-dirs (distinct
+                    (cond-> (:watch options-meta)
+                      (:watch options) (conj (:watch options))))
+        build-once? (:build-once options-meta)
+        #_build-id    #_(str (:build-id options-meta (gensym 'dev_)) "_" process-unique)
+
+        #_cfg       #_(assoc-in cfg [:repl-env-options :connection-filter]
+                              (fn [{:keys [uri]}]
+                                ))
+
+        rfs      #{"-r" "--repl"}
         sfs      #{"-s" "--serve"}
         env-opts (cljs.repl/repl-options (repl-env))
         repl?    (boolean (or (rfs ns) (rfs (first args))))
@@ -147,9 +222,8 @@
                    (symbol ns)
                    (:main options))
         figwheel-mode? (and (:figwheel options-meta true)
-                            (:watch options)
+                            (not-empty watch-dirs)
                             (= :none (:optimizations options :none)))
-        _ (prn :figwheel-mode figwheel-mode?)
         cfg      (if figwheel-mode?
                    (#'cljs.cli/eval-opt cfg "(figwheel.core/start-from-repl)")
                    cfg)
@@ -160,17 +234,24 @@
                      (when main-ns
                        {:main main-ns})) opts
                    (cond-> opts
+                     (:watch opts)
+                     (dissoc opts :watch)
+
                      (not (:output-to opts))
                      (assoc :output-to default-output-to)
+
                      (and (not (:asset-path opts)) (figure-default-asset-path env-opts opts))
                      (assoc :asset-path (figure-default-asset-path env-opts opts))
+
                      (not (:output-dir opts))
                      (assoc :output-dir default-output-dir)
+
                      figwheel-mode?
                      (update :preloads
                              (fn [p]
                                (vec (distinct
                                      (concat p '[figwheel.repl.preload figwheel.core])))))
+
                      (not (contains? opts :aot-cache))
                      (assoc :aot-cache false)))
         convey   (into [:output-dir :output-to] cljs.repl/known-repl-opts)
@@ -180,22 +261,19 @@
         source   (when (and (= :none (:optimizations opts :none)) main-ns)
                    (:uri (bapi/ns->location main-ns)))
         cenv     (cljs.env/default-compiler-env)]
-
+    (assert (not (:watch opts)))
+    (assert (not (:watch (:options cfg))))
     (cljs.env/with-compiler-env cenv
-      (if-let [path (:watch opts)]
+      (if-let [paths (and (not build-once?)
+                          (not-empty watch-dirs))]
         (do
-          (bapi/build (if (coll? path)
-                        (apply bapi/inputs path)
-                        path)
-                      (dissoc opts :watch)
-                      cenv)
-          (watch path
-                 (dissoc opts :watch)
-                 cenv))
+          (bapi/build (apply bapi/inputs paths) opts cenv)
+          (watch paths opts cenv))
         (bapi/build source opts cenv))
-      (when repl?
+      (when (and repl?
+                 (not build-once?) (not serve?))
         (#'cli/repl-opt repl-env args cfg))
-      (when (or serve? figwheel-mode?)
+      (when (and (not build-once?) (or serve? figwheel-mode?))
         ;; what to do when the repl isn't a figwheel repl here?
         ;; in the case where it isn't the repl we will need to start the server
         ;; directly, so perhaps start the server directly regardless
@@ -222,16 +300,79 @@

 (def ^:dynamic *config*)

+;; we should add a compile directory option
+
+;; build option
+;; adds -c option if not available, and no other main options
+;; adds -c (:main build options) fail if no -c option and c main is not available
+;; when other main options merge with other -co options
+;; adds -c option if -r or -s option is present
+
+;; adds -c option
+;; and
+;; - (:main build options is present
+;; - -c option not present and -r or -s option and not other main option
+
+;; else option just adds options
+
+;; interesting case for handling when there is no main function but there is a watch
+
+;; in default compile
+;; takes care of default watch and default repl
+;; merges build-options with provided options
+
+(defn split-at-opt [opt-set args]
+    (split-with (complement opt-set) args))
+
+(defn split-at-main-opt [args]
+  (split-at-opt (set (keys (:main-dispatch cli/default-commands))) args))
+
+(defn get-init-opt [opt-set args]
+  (->> (split-at-main-opt args)
+       first
+       (split-at-opt opt-set)
+       last
+       second))
+
+(defn update-opt [args opt-set f]
+  (let [[mpre mpost] (split-at-main-opt args)
+        [opt-pre opt-post] (split-at-opt opt-set mpre)]
+    (if-not (empty? opt-post)
+      (concat opt-pre [(first opt-post)] [(f (second opt-post))]
+              (drop 2 opt-post) mpost)
+      (concat [(first opt-set) (f nil)] args))))
+
+(def get-build-opt (partial get-init-opt #{"-b" "--build"}))
+(def get-build-once-opt (partial get-init-opt #{"-bo" "--build-once"}))
+(defn get-main-opt-flag [args] (first (second (split-at-main-opt args))))
+
+(defn handle-build-opt [args]
+  (if-let [build-name (or (get-build-opt args) (get-build-once-opt args))]
+    (let [build-options (get-build build-name)
+          main-flag (get-main-opt-flag args)
+          main-ns (:main build-options)]
+      (cond
+        (#{"-c" "--compile" "-m" "--main" "-h" "--help" "-?"} main-flag)
+        args
+        main-ns
+        (let [[pre post] (split-at-main-opt args)]
+          (concat pre ["-c" (str main-ns)] post))
+        :else args))
+    args))
+
 ;; TODO figwheel.core start when not --repl
 (defn -main [& args]
   (let [[pre post] (split-with (complement #{"-re" "--repl-env"}) args)
-        args (if (empty? post) (concat ["-re" "figwheel" ] args) args)]
+        args (if (empty? post) (concat ["-re" "figwheel" ] args) args)
+        args (handle-build-opt args)]
     (with-redefs [cljs.cli/default-compile default-compile]
       (apply cljs.main/-main args))))

 (def args
-  (concat ["-co" "{:aot-cache false :asset-path \"out\"}" "-e" "(figwheel.core/start-from-repl)"]
+  (concat ["-co" "{:aot-cache false :asset-path \"out\"}" "-b" "dev" "-e" "(figwheel.core/start-from-repl)"]
           (string/split "-w src -d target/public/out -o target/public/out/mainer.js -c exproj.core -r" #"\s")))
+
+#_(handle-build-opt (concat (first (split-at-main-opt args)) ["-h"]))

 #_(apply -main args)
 #_(.stop @server)


fix misaki.test.tester

fix misaki.test.tester

--- test/misaki/test/tester.clj
+++ test/misaki/test/tester.clj
@@ -27,6 +27,6 @@
     (is (= "default title") (-> (get-base-config) :site :default-title)))

   (testing "sample dir"
-    (set-base-dir! "sample")
+    (set-base-dir! "samples/blog")
     (is (= "misaki demo page")
         (-> (get-base-config) :site :site-title))))


Update slack tests for new v2 API format

--- test/riemann/slack_test.clj
+++ test/riemann/slack_test.clj
@@ -51,13 +51,7 @@
           (slacker {:host "localhost", :service "mailer", :state "error",
                     :description "Mailer failed", :metric 42, :tags ["first", "second"]})
           (is (= (:body @post-request)
-                 (str "{\"text\":\"*Host:* localhost "
-                                  "*State:* error "
-                                  "*Description:* Mailer failed "
-                                  "*Metric:* 42\","
-                      "\"channel\":\"#test-channel\","
-                      "\"username\":\"test-user\","
-                      "\"icon_emoji\":\":warning:\"}")))))
+                 "{\"attachments\":[{\"fields\":[{\"title\":\"Riemann Event\",\"value\":\"Host:   localhost\\nService:   mailer\\nState:   error\\nDescription:   Mailer failed\\nMetric:   42\\nTag:   -\\n\",\"short\":true}]}],\"channel\":\"#test-channel\",\"username\":\"test-user\",\"icon_emoji\":\":warning:\"}"))))

       (testing "escapes formatting characters in main message text"
         (let [slacker (slack/slack any-account (with-formatter (fn [e] {:text (:host e)})))]
@@ -83,13 +77,15 @@
                       "\"icon_emoji\":\":ogre:\"}")))))

       (testing "formats multiple events with a custom formatter"
-        (let [slacker (slack/slack {:account "any", :token "any"}
-                                   {:username "test-user", :channel "#test-channel", :icon ":ogre:"
-                                    :formatter (fn [events] {:text (apply str (map #(str (:tags %)) events))
-                                                             :icon ":ship:"
-                                                             :username "another-user"
-                                                             :channel "#another-channel"
-                                                             :attachments [{:pretext "pretext"}]})})]
+        (let [slacker (slack/slack
+                        {:account "any", :token "any"}
+                        {:username "test-user", :channel "#test-channel", :icon ":ogre:"
+                         :formatter (fn [events]
+                                      {:text (apply str (map #(str (:tags %)) events))
+                                       :icon ":ship:"
+                                       :username "another-user"
+                                       :channel "#another-channel"
+                                       :attachments [{:pretext "pretext"}]})})]
           (slacker [{:host "localhost", :service "mailer", :tags ["first" "second"]}
                     {:host "localhost", :service "mailer", :tags ["third" "fourth"]}])
           (is (= (:body @post-request)


Updated the base proxy tests for tags.

Updated the base proxy tests for tags.

--- test/shale/test/proxies.clj
+++ test/shale/test/proxies.clj
@@ -25,6 +25,7 @@
                  :host "localhost"
                  :port 101010
                  :type :socks5
+                 :tags #{}
                  :public-ip nil})

 (deftest test-require->spec
@@ -38,7 +39,7 @@
                 [:host (:host base-proxy)]
                 [:port (:port base-proxy)]]]]
       (is (= (select-keys base-proxy
-                          [:shared :active :type :host :port])
+                          [:shared :active :type :host :port :tags])
              (proxies/require->spec req))))))

 (deftest ^:integration test-creation-and-deletion


refactoring serialisation to allow for single scene file export, adding support for material references, scene header comments, inclusion of scene partials (file refs), entity transforms (incl. matrix construction), implementing area-light mesh handling, adding shape-disc, material-null, adding luxvalue methods for :int-vec, :point-vec, :trimesh, :area-light, :shape, bug fix :float-vec

--- src/thi/ng/luxor/core.clj
+++ src/thi/ng/luxor/core.clj
@@ -9,9 +9,20 @@
    [java.io File Writer OutputStreamWriter StringWriter]
    [java.util Date]))

+;; References:
+;; http://www.luxrender.net/wiki/Scene_file_format_dev
+
 (def ^:const version "0.1.0-SNAPSHOT")

 (def ^:dynamic *indent* 2)
+
+(def ^:const mesh-types {:inline :trimesh :ply :ply-mesh :stl :stl-mesh})
+
+(def ^:dynamic *degrees* true)
+
+(defn convert-angle
+  [theta]
+  (if *degrees* (m/radians theta) theta))

 (defn scaled-absorption-at-depth
   [x scale d]
@@ -46,13 +57,18 @@

 (defn- luxattrib
   [id body]
-  (format "AttributeBegin # %s\n%sAttributeEnd\n\n" id body))
+  (let [sep (str "# -------- " id " --------\n")]
+    (format "AttributeBegin %s%sAttributeEnd   %s\n" sep body sep)))

 (defn- luxtransform
   [tx]
   (format "Transform [%s]\n"
           (apply str (interpose " " (map #(format "%1.8f" %) tx)))))

+(defn- material-ref
+  [id]
+  (format "NamedMaterial \"%s\"\n" id))
+
 (defmulti luxvalue (fn [type & _] type))

 (defmethod luxvalue :float
@@ -60,13 +76,25 @@

 (defmethod luxvalue :float-vec
   [_ id xs]
-  (format "\"float\" \"%s\" [%s]\n"
+  (format "\"float %s\" [%s]\n"
           (name id)
-          (apply str (interpose " " (map #(format "%1.8f" %) xs)))))
+          (apply str (interpose " " (map #(format "%1.8f" (float %)) xs)))))

 (defmethod luxvalue :int
   [_ id x] (format "\"integer %s\" [%d]\n" (name id) (int x)))

+(defmethod luxvalue :int-vec
+  [_ id xs]
+  (format "\"integer %s\" [%s]\n"
+          (name id)
+          (apply str (interpose " " (map #(format "%d" (int %)) xs)))))
+
+(defmethod luxvalue :point-vec
+  [_ id xs]
+  (format "\"point %s\" [%s]\n"
+          (name id)
+          (apply str (interpose " " (map #(format "%1.8f" (float %)) (mapcat identity xs))))))
+
 (defmethod luxvalue :bool
   [_ id x] (format "\"bool %s\" [\"%b\"]\n" (name id) x))

@@ -75,7 +103,7 @@

 (defmethod luxvalue :string-vec
   [_ id xs]
-  (format "\"string\" \"%s\" [%s]\n"
+  (format "\"string %s\" [%s]\n"
           (name id)
           (apply str (interpose " " (map #(format "\"%s\"" %) xs)))))

@@ -112,15 +140,22 @@
   [_ id opts]
   (luxentity "Film" id opts))

+(defmethod luxvalue :area-light
+  [_ id opts]
+  (let [[stype mesh] (:__shape opts)]
+    (str
+     (luxentity "AreaLightSource" "area" opts)
+     (luxvalue stype (str id "-mesh") mesh))))
+
 (defmethod luxvalue :light
   [_ id opts]
   (luxattrib
    id
    (str
-    (when (:__transform opts) (luxtransform (:__transform opts)))
-    (when-let [g (:__parent opts)]
-      (format "LightGroup \"%s\"\n" g))
-    (luxentity (:__type opts) id opts))))
+    (when-let [tx (:__transform opts)] (luxtransform tx))
+    (when-let [mat (:__material opts)] (material-ref mat))
+    (when-let [g (:__parent opts)] (format "LightGroup \"%s\"\n" g))
+    (luxvalue (:__type opts) id opts))))

 (defmethod luxvalue :camera
   [_ id opts]
@@ -141,25 +176,63 @@
    (luxvalues opts)
    "\n"))

+(defmethod luxvalue :trimesh
+  [_ id mesh]
+  (let [verts (vec (keys (:vertices mesh)))
+        vidx (zipmap verts (range))
+        indices (mapcat (fn [[a b c]] [(vidx a) (vidx b) (vidx c)]) (:faces mesh))]
+    (luxentity
+     "Shape" "trianglemesh"
+     {:indices [:int-vec (vec indices)]
+      :P [:point-vec verts]
+      :name [:string id]})))
+
+(defmethod luxvalue :shape
+  [_ id opts]
+  (luxattrib
+   id
+   (str
+    (when-let [tx (:__transform opts)] (luxtransform tx))
+    (when-let [mat (:__material opts)] (material-ref mat))
+    (luxentity "Shape" (:__type opts) opts))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; serialization
+
 (defn- lx-header
-  [path]
-  (format "# %s\n# generated %s by luxor v%s\n\n"
-          path (.toString (Date.)) version))
+  [path & comments]
+  (prn comments)
+  (format "# %s\n# generated %s by luxor v%s\n%s\n"
+          path (.toString (Date.)) version
+          (if (seq comments)
+            (reduce #(str % "# " %2 "\n") "#\n# Comments:\n" comments)
+            "")))

 (defn- path-filename
   [path] (.getName (File. path)))

-(defn- include-file
+(defn- include-file*
   [path]
   (format "Include \"%s\"\n\n" path))

+(defn- include-partials*
+  [partials]
+  (prn :partials partials)
+  (apply str (map include-file* partials)))
+
+(defn- inject-scene-partial
+  [partial path include?]
+  (when partial
+    (if include? (include-file* path) partial)))
+
 ;; TODO rename into export-scene & split out serialize part
 (defn serialize-lxs
-  [scene base-path]
+  [scene base-path separate-files?]
   (let [base-name (path-filename base-path)
         lxs-path (str base-path ".lxs")
         lxs (str
-             (lx-header lxs-path)
+             (apply lx-header lxs-path (:comments scene))
+             (include-partials* (get-in scene [:includes :headers]))
              (:renderer scene)
              (:accel scene)
              (:sampler scene)
@@ -168,9 +241,10 @@
              (:film scene)
              (:camera scene)
              "WorldBegin\n\n"
-             (when (:volumes scene) (include-file (str base-name ".lxv")))
-             (when (:materials scene) (include-file (str base-name ".lxm")))
-             (when (:geometry scene) (include-file (str base-name ".lxo")))
+             (include-partials* (get-in scene [:includes :partials]))
+             (inject-scene-partial (:volumes scene) (str base-name ".lxv") separate-files?)
+             (inject-scene-partial (:materials scene) (str base-name ".lxm") separate-files?)
+             (inject-scene-partial (:geometry scene) (str base-name ".lxo") separate-files?)
              (:lights scene)
              "\nWorldEnd\n")]
     (spit lxs-path lxs)
@@ -179,31 +253,38 @@
 (defn serialize-lxm
   [{:keys [materials]} base-path]
   (when materials
-    (let [lxm-path (str base-path ".lxm")
-          lxm (str (lx-header lxm-path) materials)]
-      (spit lxm-path lxm)
-      lxm)))
+    (let [path (str base-path ".lxm")
+          body (str (lx-header path) materials)]
+      (spit path body)
+      body)))

 (defn serialize-lxv
   [{:keys [volumes]} base-path]
   (when volumes
-    (let [lxm-path (str base-path ".lxv")
-          lxm (str (lx-header lxm-path) volumes)]
-      (spit lxm-path lxm)
-      lxm)))
+    (let [path (str base-path ".lxv")
+          body (str (lx-header path) volumes)]
+      (spit path body)
+      body)))

 (defn serialize-lxo
   [{:keys [geometry]} base-path]
   (when geometry
-    ;; TODO
-    ))
+    (let [path (str base-path ".lxo")
+          body (str (lx-header path) geometry)]
+      (spit path body)
+      body)))

 (defn serialize-scene
-  [scene base-path]
-  (let [scene* (reduce
-                (fn [s [k type]]
-                  (assoc s k (luxvalues-typed type (k scene))))
-                {} {:renderer :renderer
+  ([scene base-path]
+     (serialize-scene scene base-path true))
+  ([scene base-path separate?]
+     (let [scene* (reduce
+                   (fn [s [k type]]
+                     (if-let [ents (k scene)]
+                       (assoc s k (luxvalues-typed type ents))
+                       s))
+                   (select-keys scene [:comments :includes])
+                   {:renderer :renderer
                     :accel :accelerator
                     :sampler :sampler
                     :integrator :integrator
@@ -212,12 +293,15 @@
                     :camera :camera
                     :lights :light
                     :materials :material
-                    :volumes :volume})
-        lxs (serialize-lxs scene* base-path)
-        lxm (serialize-lxm scene* base-path)
-        lxo (serialize-lxo scene* base-path)
-        lxv (serialize-lxv scene* base-path)]
-    (apply str lxs lxm lxo lxv)))
+                    :volumes :volume
+                    :geometry :shape})
+           lxs (serialize-lxs scene* base-path separate?)]
+       (if separate?
+         (-> lxs
+             (str (serialize-lxm scene* base-path))
+             (str (serialize-lxo scene* base-path))
+             (str (serialize-lxv scene* base-path)))
+         lxs))))

 (defn- append
   ([scene group id opts]
@@ -225,6 +309,18 @@
   ([scene group id opts singleton?]
      (-> (if singleton? (dissoc scene group) scene)
          (assoc-in [group id] (or opts {})))))
+
+(defn scene-comments
+  [scene & comments]
+  (update-in scene [:comments] (fnil into []) comments))
+
+(defn include-headers
+  [scene & paths]
+  (update-in scene [:includes :headers] (fnil into []) paths))
+
+(defn include-partials
+  [scene & paths]
+  (update-in scene [:includes :partials] (fnil into []) paths))

 (defn material-null
   [scene id]
@@ -366,8 +462,8 @@
      :colorspace_green [:float-vec green]
      :colorspace_blue [:float-vec blue]
      :premultiplyalpha [:bool premultiply?]
-     :write_resume_film [:bool write-flm?]
-     :restart_resume_film [:bool restart-flm?]
+     :write_resume_flm [:bool write-flm?]
+     :restart_resume_flm [:bool restart-flm?]
      :write_exr [:bool write-exr?]
      :write_exr_channels [:string exr-channels]
      :write_exr_applyimaging [:bool exr-imaging?]
@@ -379,7 +475,7 @@
      :write_tga_channels [:string tga-channels]
      :ldr_clamp_method [:string ldr-method]
      :writeinterval [:int write-interval]
-     :filmwriteinterval [:int write-interval]
+     :flmwriteinterval [:int write-interval]
      :displayinterval [:int display-interval]
      :haltspp [:int halt-spp]
      :halttime [:int halt-time]
@@ -428,19 +524,37 @@
                  opts))]
     (append scene :camera type opts true)))

-(defn transform-common
-  [scene {:keys [matrix scale rotate translate] :as tx}]
-  {:__transform tx})
+(defn- make-transform-matrix
+  [{:keys [scale rx ry rz axis theta translate] :or {rx 0 ry 0 rz 0} :as tx}]
+  (let [mat (if translate
+              (g/translate g/IDENTITY44 (g/vec3 translate))
+              g/IDENTITY44)
+        mat (if axis
+              (g/rotate-around-axis mat axis theta)
+              (if (some (complement zero?) [rx ry rz])
+                (-> mat
+                    (g/rotate-x (convert-angle rx))
+                    (g/rotate-y (convert-angle ry))
+                    (g/rotate-z (convert-angle rz)))
+                mat))
+        mat (if scale (g/scale mat scale) mat)]
+    (vals (g/transpose mat))))
+
+;; TODO is scene needed as arg?
+(defn- transform-common
+  [scene {:keys [matrix] :as tx}]
+  {:__transform (if matrix matrix (make-transform-matrix tx))})

 (defn light-group
   [scene id & {:keys [gain] :or {gain 1.0}}]
   (append scene :light-groups id {:__gain [:float gain]}))

 (defn- light-common
-  [scene {:keys [group color gain power efficacy importance tx]
-          :or {group "default" color [1 1 1]
-               gain 1 efficacy 10 power 100 importance 1}}]
+  [scene {:keys [group color gain power efficacy importance tx material hidden?]
+          :or {group "default" color [1.0 1.0 1.0]
+               gain 1.0 efficacy 10.0 power 100.0 importance 1.0 hidden? false}}]
   {:__parent group
+   :__material (or material (when hidden? "__hidden__"))
    :L [:color color]
    :gain [:float (if group
                    (* (get-in scene [:light-groups group :__gain 1] 1.0) gain)
@@ -450,18 +564,34 @@
    :importance [:float importance]})

 (defn area-light
-  [scene id & {:keys [samples mesh p n size tx] :or {samples 1} :as opts}]
+  [scene id & {:keys [samples mesh mesh-type p n size tx]
+               :or {samples 1 mesh-type :inline} :as opts}]
   (let [mesh (if mesh
                mesh
-               (g/as-mesh (pl/plane (or p [0 0 10]) (or n [0 0 -1])) size))]
+               (g/as-mesh (pl/plane (or p [0 0 10]) (or n [0 0 -1])) {:size size}))]
     (append
      scene :lights id
      (merge
       (when tx (transform-common scene tx))
       (light-common scene opts)
-      {:__type "AreaLightSource"
-       :__shape mesh
+      {:__type :area-light
+       :__shape [(mesh-types mesh-type) mesh]
        :nsamples [:int samples]}))))
+
+(defn shape-disk
+  [scene id & {:keys [z radius inner-radius phi tx material]
+               :or {z 0 radius 1 inner-radius 0 phi 360}}]
+  (append
+   scene :geometry id
+   (merge
+    (when tx (transform-common scene tx))
+    {:__type :disk
+     :__material material
+     :name [:string id]
+     :height [:float z]
+     :radius [:float radius]
+     :innerradius [:float inner-radius]
+     :phimax [:float phi]})))

 (defn lux-scene
   []
@@ -472,4 +602,20 @@
       (volume-integrator :multi)
       (accelerator-qbvh)
       (film)
-      (light-group "default")))
+      (light-group "default")
+      (material-null "__hidden__")))
+
+(comment
+  (-> (lux-scene)
+      (camera :eye [10 -2 10] :target [0 0 0] :up [0 0 1])
+      (film :width 640 :height 360 :display-interval 5 :halt-spp 5)
+      (area-light "left" :p [0 0 5] :size 1 :gain 1 :tx {:translate [-5 0 0] :ry -20} :hidden? true)
+      (area-light "right" :p [0 0 5] :size 1 :gain 1 :tx {:translate [5 0 0] :ry 20} :hidden? true)
+      (shape-disk "floor" :radius 20 :material "white")
+      (shape-disk "d1" :radius 3 :inner-radius 2 :material "red" :tx {:rx -30})
+      (shape-disk "d2" :radius 3 :inner-radius 2 :material "orange" :tx {:rx 30})
+      (material-matte "white" :diffuse [0.8 0.8 0.8])
+      (material-matte "red" :diffuse [1.0 0 0])
+      (material-matte "orange" :diffuse [1.0 0.3 0])
+      (serialize-scene "foo"))
+  )


static texts adjusted

static texts adjusted

--- src-clj/acha/achievement_static.clj
+++ src-clj/acha/achievement_static.clj
@@ -6,10 +6,10 @@
         :description "Make a commit with no lines added, only deletions"}
     :massive
        {:name "Massive"
-        :description "Added more than a 1000 lines in a single commit"}
+        :description "Add more than 1000 lines in a single commit"}
     :scribbler
        {:name "Scribbler"
-        :description "Created a README"}
+        :description "Create a README"}
     :owl
        {:name "Owl"
         :description "Commit between 4am and 7am local time"}
@@ -21,25 +21,25 @@
         :description "Your commit was reverted completely by someone else"}
     :loneliness
        {:name "Loneliness"
-        :description "Being the only commiter for a week"}
+        :description "You are the only committer for a week"}
     :easy-fix
-       {:name "Easy fix"
+       {:name "Easy Fix"
         :description "Swap two lines"}
     :multilingua
-       {:name "Multilingua"
+       {:name "Multilingual"
         :description "Add/edit files in 5 different languages in a single commit"}
     :necromancer
        {:name "Necromancer"
-        :description "Make a commit to a repo that wasn’t touched for 1 month or more"}
+        :description "Make a commit to a repo that hasn’t been touched for 1 month or more"}
     :mover
        {:name "Mover"
-        :description "Move file from one place to another without changing it"}
+        :description "Move a file from one place to another without changing it"}
     :world-balance
-       {:name "World balance"
+       {:name "World Balance"
         :description "Number of lines added == number of lines deleted"}
     :get
        {:name "Get"
-        :description "Do commit #1000, or #1111, or #1234"}
+        :description "Make commit #1000, or #1111, or #1234"}
     :narcissist
        {:name "Narcissist"
         :description "Use your own name in a commit message"}
@@ -68,20 +68,20 @@
        {:name "OCD"
         :description "Commit with just trailing spaces removed"}
     :holy-war
-       {:name "Holy war"
-        :description "Changed tabs to spaces or vice versa"}
+       {:name "Holy War"
+        :description "Change tabs to spaces or vice versa"}
     :combo
        {:name "Combo"
         :description "10+ commits in a row"}
     :combo-breaker
-       {:name "Combo breaker"
+       {:name "Combo Breaker"
         :description "Make a commit after someone had N commits in a row"}
     :worker-bee
-       {:name "Worker bee"
+       {:name "Worker Bee"
         :description "Make 100+ non-merge commits"}
     :fat-ass
        {:name "Fat Ass"
-        :description "Commit 2 Mb file or bigger"}
+        :description "Commit 2Mb file or bigger"}
     :ooops
        {:name "Ooops"
         :description "Commit and revert commit within 1 minute"}
@@ -89,67 +89,67 @@
        {:name "Deal with it"
         :description "Update master branch with force mode"}
     :dangerous-game
-       {:name "Dangerous game"
+       {:name "Dangerous Game"
         :description "Commit after 6PM friday"}
     :empty-commit
        {:name "<empty title>"
-        :description "Do an empty commit"}
+        :description "Make an empty commit"}
     :time-get
        {:name "Get"
         :description "Commit exactly at 00:00"}
     :what-happened-here
-       {:name "What happened here?"
+       {:name "What Happened Here?"
         :description "Edit a file that hasn’t been touched for a year"}
     :all-things-die
-       {:name "All things die"
-        :description "Delete a file that has been added in initial commit (and at least a year has passed)"}
+       {:name "All Things Die"
+        :description "Delete a file that has been added in the initial commit (and at least a year has passed)"}
     :for-stallman
        {:name "For Stallman!"
         :description "Add GPL license file to the repo"}
     :change-of-mind
-       {:name "Change of mind"
-        :description "Change license type / edit license file"}
+       {:name "Change of Mind"
+        :description "Change license type or edit license file"}
     :munchkin
        {:name "Munchkin"
-        :description "Get 5 achivements with 1 commit"}
+        :description "Get 5 achievements with 1 commit"}
     :wrecking-ball
-       {:name "Wrecking ball"
+       {:name "Wrecking Ball"
         :description "Change more than 100 files in one commit"}
     :alzheimers
        {:name "Alzheimer's"
-        :description "Commit time overdue author time for 1 month or more"}
+        :description "Commit time is 1 month or more after the author time"}
     :unpretending
        {:name "Unpretending"
-        :description "Zero achivments after 100 your own commits"}
+        :description "Zero achievments after 100 your own commits"}
     :good-boy
-       {:name "Good boy"
-        :description "Create 'test' or 'doc' directory (not on first commit)"}
+       {:name "Good Boy"
+        :description "Create 'test' or 'doc' directory (not in the first commit)"}
     :gitignore
        {:name "Gitignore"
         :description "Add .gitignore"}
     :nothing-to-hide
-       {:name "Nothing to hide"
+       {:name "Nothing to Hide"
         :description "Commit id_rsa file"}
     :quest-complete
-       {:name "Quest complete"
+       {:name "Quest Complete"
         :description "Get all achievements"}
     :haskell
-       {:name "Ivory tower"
+       {:name "Ivory Tower"
         :description "First to commit Haskell file to a repo"}
     :perl
        {:name "Chmod 200"
         :description "First to commit Perl file to a repo"}
     :ruby
-       {:name "Back on the rails"
+       {:name "Back on the Rails"
         :description "First to commit Ruby file to a repo"}
     :clojure
-       {:name "Even lispers hate Lisp"
+       {:name "Even Lispers Hate Lisp"
         :description "First to commit Clojure file to a repo"}
     :clojurescript
-       {:name "Even lispers hate Lisp (in a browser)"
+       {:name "Even Lispers Hate Lisp (in a browser)"
         :description "First to commit ClojureScript file to a repo"}
     :javascript
-       {:name "Happily never after"
+       {:name "Happily Never After"
         :description "First to commit JS file to a repo"}
     :python
        {:name "Why not Ruby?"
@@ -176,7 +176,7 @@
        {:name "It’s like ObjC, but for Ericsson phones"
         :description "First to commit Erlang file to a repo"}
     :shell
-       {:name "We’ll rewrite that later"
+       {:name "We’ll Rewrite that Later"
         :description "First to commit Bash file to a repo"}
     :php
        {:name "New Facebook is born"
@@ -191,7 +191,7 @@
        {:name "Zed’s dead, baby"
         :description "First to commit XML file to a repo"}
     :css
-       {:name "You designer now?"
+       {:name "You are a designer now?"
         :description "First to commit CSS file to a repo"}
     :dart
        {:name "You work in Google?"
@@ -200,40 +200,40 @@
        {:name "You can't program on Windows, can you?"
         :description "First to commit Windows Shell file to a repo"}
     :basic
-       {:name "Cradle of civilization"
+       {:name "Cradle of Civilization"
         :description "First to commit Basic file to a repo"}
     :programmers-day
-       {:name "Professional pride"
-        :description "Commit at Programmer’s day"}
+       {:name "Professional Pride"
+        :description "Commit on Programmers' Day"}
     :christmas
-       {:name "Ruined christmas"
-        :description "Commit at Dec 25"}
+       {:name "Ruined Christmas"
+        :description "Commit on Dec 25"}
     :halloween
-       {:name "This code looks scary"
+       {:name "This Code Looks Scary"
         :description "Commit at Oct 31"}
     :new-year
-       {:name "New year, new bugs"
+       {:name "New Year, New Bugs"
         :description "Commit at Jan 1"}
     :anniversary
        {:name "Anniversary"
-        :description "Commit at project’s birthday"}
+        :description "Commit on the project’s birthday"}
     :valentine
-       {:name "In love with work"
-        :description "Commit at Feb 14"}
+       {:name "In Love with Work"
+        :description "Commit on Feb 14"}
     :leap-day
-       {:name "Rare occasion"
-        :description "Commit at Feb 29"}
+       {:name "Rare Occasion"
+        :description "Commit on Feb 29"}
     :russia-day
-       {:name "From Russia with love"
-        :description "Commit at Russia Day"}
+       {:name "From Russia with Love"
+        :description "Commit on Russia Day"}
     :thanksgiving
-       {:name "Turkey code"
-        :description "Commit at Thanksgiving"}
+       {:name "Turkey Code"
+        :description "Commit on Thanksgiving"}
     :fools-day
-       {:name "Fool’s code"
-        :description "Commit at Apr 1"}
+       {:name "Fool’s Code"
+        :description "Commit on Apr 1"}
     :impossible
-       {:name "Mission impossible"
+       {:name "Mission Impossible"
         :description "Use word “impossible” in a commit message"}
     :magic
        {:name "The Colour of Magic"
@@ -245,19 +245,19 @@
        {:name "I can sort it out myself"
         :description "Use word “google” in a commit message"}
     :forgot
-       {:name "Second thoughts"
+       {:name "Second Thoughts"
         :description "Use word “forgot” in a commit message"}
     :fix
-       {:name "Save the day"
+       {:name "Save the Day"
         :description "Use word “fix” in a commit message"}
     :secure
-       {:name "We’re safe now"
+       {:name "We’re Safe Now"
         :description "Use word “secure” in a commit message"}
     :catchphrase
        {:name "Catchphrase"
         :description "Make 10+ commits with the same message"}
     :bad-motherfucker
-       {:name "Bad motherfucker"
+       {:name "Bad Motherfucker"
         :description "Swear in a commit message"
         :level-description "One level for each swear word in a message"}
     :hello-linus
@@ -265,17 +265,17 @@
         :description "10+ swear words in a commit message"
         :level-description "One level for each 10 swear words in a message"}
     :man-of-few-words
-       {:name "A man of few words"
+       {:name "A Man of Few Words"
         :description "Commit message with 3 letters or less"}
     :leo-tolstoy
        {:name "Leo Tolstoy"
         :description "More than 10 lines in a commit message"}
     :citation-needed
-       {:name "Citation needed"
+       {:name "Citation Needed"
         :description "StackOverflow URL in a commit body or message"}
     :no-more-letters
-       {:name "No more letters"
-        :description "Write commit message without any letters"}
+       {:name "No More Letters"
+        :description "Write a commit message without any letters"}
     :emoji
        {:name "C00l kid"
         :description "Use emoji in a commit message"}
@@ -293,5 +293,5 @@
        {:name "Wow"
         :description "Use word “wow” in a commit message"}
     :never-probably
-       {:name "Never, probably"
+       {:name "Never, Probably"
         :description "Use word “later” in a commit message"}})


Swap arguments on contains? call.

Swap arguments on contains? call.

--- src/uuuurrrrllll/core.clj
+++ src/uuuurrrrllll/core.clj
@@ -66,6 +66,6 @@

 (defn -main [& args]
   (wc/connect!)
-  (if-not (contains? bucket (wb/list))
+  (if-not (contains? (wb/list) bucket)
     (wb/create bucket))
   (jetty/run-jetty wrapp {:port 8080}))


url not :url.

url not :url.

--- src/uuuurrrrllll/core.clj
+++ src/uuuurrrrllll/core.clj
@@ -18,5 +18,5 @@
   (GET "/:url/" request
        (fn [request]
          (if-let [url (get-in request [:params :url])]
-           {:status 301 :headers {"location" (@url-map :url)}}
+           {:status 301 :headers {"location" (@url-map url)}}
            {:status 404}))))


Add test for allow-eval.

Add test for allow-eval.

--- test/cli4clj/test/cli.clj
+++ test/cli4clj/test/cli.clj
@@ -87,6 +87,12 @@
         out-string (test-cli-stdout #(start-cli cli-opts) test-cmd-input)]
     (is (= "add\n\n\nhelp [? h]\n\tShow help.\n\tDisplay a help text that lists all available commands including further detailed information about these commands.\n\nquit [q]\n\tQuit the CLI.\n\tTerminate and close the command line interface."
            out-string))))
+
+(deftest allow-eval-cli-interaction-test
+  (let [cli-opts {:allow-eval true}
+        test-cmd-input ["(+ 1 2)"]
+        out-string (test-cli-stdout #(start-cli cli-opts) test-cmd-input)]
+    (is (= (expected-string ["3"]) out-string))))


Tyhjien seatingien lähettäminen poistaa seatingit

--- mtg-pairings-server/src/mtg_pairings_server/tournaments.clj
+++ mtg-pairings-server/src/mtg_pairings_server/tournaments.clj
@@ -226,12 +226,13 @@
   (let [tournament-id (sanctionid->id sanction-id)]
     (sql/delete db/seating
       (sql/where {:tournament tournament-id}))
-    (let [dci->id (teams-by-dci tournament-id)]
-      (sql/insert db/seating
-        (sql/values (for [seating seatings]
-                      {:team (dci->id (:team seating))
-                       :table_number (:table_number seating)
-                       :tournament tournament-id}))))))
+    (when (seq seatings)
+      (let [dci->id (teams-by-dci tournament-id)]
+        (sql/insert db/seating
+          (sql/values (for [seating seatings]
+                        {:team (dci->id (:team seating))
+                         :table_number (:table_number seating)
+                         :tournament tournament-id})))))))

 (defn ^:private delete-results [round-id]
   (sql/delete db/result


Filled in stubs for watcher component.

Filled in stubs for watcher component.


Disable short circuiting for this run

Disable short circuiting for this run

--- src/onyx_benchmark/peer.clj
+++ src/onyx_benchmark/peer.clj
@@ -94,6 +94,7 @@
                      :onyx.messaging.aeron/poll-idle-strategy :high-restart-latency
                      :onyx.messaging.aeron/embedded-driver? false
                      :onyx.messaging.aeron/subscriber-count 2
+                     :onyx.messaging/allow-short-circuit? false
                      :onyx.peer/join-failure-back-off 500
                      :onyx.peer/job-scheduler :onyx.job-scheduler/greedy
                      :onyx.messaging/impl (keyword messaging)}


stop buzz from destroying your speakers

stop buzz from destroying your speakers

--- src/overtone/inst/synth.clj
+++ src/overtone/inst/synth.clj
@@ -71,7 +71,8 @@
     (* amp dist (line:kr 1 0 t))))

 (definst buzz [pitch 40 cutoff 300 dur 200]
-  (let [a (lpf (saw (midicps pitch)) (* (lf-noise1 :control 10) 400))
+  (let [lpf-lev (* (+ 1 (lf-noise1:kr 10)) 400)
+        a (lpf (saw (midicps pitch)) lpf-lev)
         b (sin-osc (midicps (- pitch 12)))
         env (env-gen 1 1 0 1 2 (perc 0.01 (/ dur 1000)))]
     (* env (+ a b))))


Improve readability of accept-named-parameter.

--- src/fhofherr/clj_db_util/core/named_params.clj
+++ src/fhofherr/clj_db_util/core/named_params.clj
@@ -35,12 +35,14 @@
                               #(split-with (complement whitespace?) %)
                               #(when (seq %) accept-whitespace)))

-(def accept-named-parameter (accept :named-param
-                                    #(let [[res rest-in] (->> %
-                                                              (rest)
-                                                              (split-with (complement whitespace?)))]
-                                      [(cons \: res) rest-in])
-                                    #(when (seq %) accept-whitespace)))
+(def accept-named-parameter (letfn [(consume-named-param [input]
+                                      (let [[result rest-in] (->> input
+                                                                  (rest)
+                                                                  (split-with (complement whitespace?)))]
+                                        [(cons \: result) rest-in]))]
+                              (accept :named-param
+                                      consume-named-param
+                                      #(when (seq %) accept-whitespace))))

 (defn apply-accept-fn
   [{:keys [accept-fn] :as parse}]


Fixed timestamp update on stormspec

Fixed timestamp update on stormspec

--- src/polismath/stormspec.clj
+++ src/polismath/stormspec.clj
@@ -54,12 +54,9 @@
               grouped-votes (group-by :zid new-votes)]
           (doseq [[zid rxns] grouped-votes]
             (emit-spout! collector [zid @last-timestamp rxns]))
-          (if-let [last-vote (last new-votes)]
-            (do
-              (println "XXX last..." last-vote)
-              (swap! last-timestamp (fn [_] (:created last-vote))))
-            (println "XXX no votes")
-            )))
+          (swap! last-timestamp
+                 (fn [last-ts] (apply max 0 last-ts (map :created new-votes))))
+            ))
       (ack [id]))))


Not listing chrome-specific tabs, like settings and extensions

--- src/tabler/core.cljs
+++ src/tabler/core.cljs
@@ -1,6 +1,5 @@
 (ns tabler.core
   (:require [cljs.core.async :refer [>! <!]]
-            [clojure.walk :as walk]
             [khroma.runtime :as runtime]
             [khroma.log :as console]
             [khroma.storage :as storage]
@@ -79,6 +78,16 @@
     (assoc app-state :tabs (remove-tab (:tabs app-state) (:removed msg)))))

 ;;;;----------------------------
+;;;; Functions
+;;;;----------------------------
+
+(defn filter-tabs
+  "Filters out the tabs we will not show or manipulate, for instance, chrome extensions"
+  [tabs]
+  (remove #(.startsWith (:url %) "chrome") tabs))
+
+
+;;;;----------------------------
 ;;;; Components
 ;;;;----------------------------


correction?

correction?

--- clojureclass/src/clojureclass/exceptions.clj
+++ clojureclass/src/clojureclass/exceptions.clj
@@ -38,5 +38,4 @@
     (try
       (>!! c v)
       (catch Throwable ex
-        (println "Cant put nil on channel")))
-    ))
+        (println "Cant put nil on channel")))))


eval uglify inside js engine

eval uglify inside js engine

--- src/uglify2/core.clj
+++ src/uglify2/core.clj
@@ -64,6 +64,13 @@
   [context writer]
   (.setWriter context writer))

+(defn eval-uglify
+  "evaluate the Uglify JS inside the engine"
+  [engine]
+  (let [files ["resources/Uglify2/compress.js"
+               "resources/Uglify2/uglifyjs.self.js"]]
+    (doall (map #(eval-str engine (slurp %)) files))))
+
 (defn find-mainfiles
   "Stolen from https://github.com/Deraen/boot-less/blob/master/src/deraen/boot_less.clj"
   [fs]
@@ -89,8 +96,7 @@

 (let [engine  (create-engine)]
   (eval-str engine "print('hello JS');")
-
-  ;;(println "file " (slurp "Uglify2/uglifyjs.self.js"))
+  (eval-uglify engine)
   )


[search] fix search bar always showing "clear" action

Need to deref the query ratom and check that it isn't empty. Not just
doing string/blank? because we do want to give "clear" button if they
type some spaces

--- src/braid/search/ui/search_bar.cljs
+++ src/braid/search/ui/search_bar.cljs
@@ -16,7 +16,7 @@
               (fn [e]
                 (reset! search-query (.. e -target -value))
                 (dispatch [:braid.search/update-query! (.. e -target -value)]))}]
-     (if search-query
+     (if (and @search-query (not= "" @search-query))
        [:a.action.clear
         {:on-click (fn [] (reset! search-query ""))
          :href (routes/group-page-path {:group-id @(subscribe [:open-group-id])


add routing-key-string function

add routing-key-string function

it's a bit simpler to use and type!

--- src/brainbot/nozzle/routing_key.clj
+++ src/brainbot/nozzle/routing_key.clj
@@ -17,3 +17,10 @@
   "replace command part of routing key string with command"
   [rk-string command]
   (routing-key-string-from-map (assoc (map-from-routing-key-string rk-string) :command command)))
+
+(defn routing-key-string
+  "make routing key string from single map or parameters"
+  ([{:keys [id filesystem command]}]
+     (string/join "." [id filesystem command]))
+  ([id filesystem command]
+     (string/join "." [id filesystem command])))


Langohr 3.0.1

Langohr 3.0.1

--- clojure/project.clj
+++ clojure/project.clj
@@ -4,4 +4,4 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure     "1.6.0"]
-                 [com.novemberain/langohr "3.0.0"]])
+                 [com.novemberain/langohr "3.0.1"]])


Fixed broken authentication middleware

Fixed broken authentication middleware

--- src/clj/salava/core/restructure.clj
+++ src/clj/salava/core/restructure.clj
@@ -5,7 +5,7 @@

 (defmethod restructure-param :auth-rules
   [_ rule acc]
-  (update-in acc [:middleware] conj `(wrap-rule ~rule)))
+  (update-in acc [:middleware] conj [wrap-rule rule]))

 (defmethod restructure-param :current-user
   [_ binding acc]


Split line diff fixing into smaller functions

--- src/cljs/asciinema_player/core.cljs
+++ src/cljs/asciinema_player/core.cljs
@@ -97,11 +97,14 @@
         (dissoc :stop)
         (update-in [:play-from] + t))))

-(defn fix-line-diff-keys [frame]
-  (update-in frame [1 :lines] #(into {} (map (fn [[k v]] [(js/parseInt (name k) 10) v]) %))))
+(defn- fix-line-diff-keys [line]
+  (into {} (map (fn [[k v]] [(js/parseInt (name k) 10) v]) line)))
+
+(defn- fix-diff-keys [frame]
+  (update-in frame [1 :lines] fix-line-diff-keys))

 (defn frames-json->clj [frames]
-  (map fix-line-diff-keys (walk/keywordize-keys frames)))
+  (map fix-diff-keys (walk/keywordize-keys frames)))

 (defn fetch-frames [state dispatch]
   (let [url (:frames-url state)]


Remove unnecessary get-in call

Remove unnecessary get-in call

--- src/cljs/love_letter_cljs/subs.cljs
+++ src/cljs/love_letter_cljs/subs.cljs
@@ -6,28 +6,28 @@
 (register-sub
  :deck
  (fn [db]
-   (reaction (get-in @db [:deck]))))
+   (reaction (@db :deck))))

 (register-sub
  :burn-pile
  (fn [db]
-   (reaction (get-in @db [:burn-pile]))))
+   (reaction (@db :burn-pile))))

 (register-sub
  :discard-pile
  (fn [db]
-   (reaction (get-in @db [:discard-pile]))))
+   (reaction (@db :discard-pile))))

 (register-sub
  :current-player
  (fn [db]
-   (reaction (get-in @db [:current-player]))))
+   (reaction (@db :current-player))))

 (register-sub
  :players
  (fn [db]
    (reaction
-    (->> (get-in @db [:players])
+    (->> (@db :players)
          vals
          vec))))

@@ -44,7 +44,7 @@
 (register-sub
  :display-card
  (fn [db]
-   (reaction (get-in @db [:display-card]))))
+   (reaction (@db :display-card))))

 (register-sub
  :db
@@ -60,7 +60,7 @@
 (register-sub
  :current-phase
  (fn [db]
-   (reaction (get-in @db [:phase]))))
+   (reaction (@db :phase))))

 (register-sub
  :valid-targets
@@ -70,7 +70,7 @@
 (register-sub
  :debug-mode
  (fn [db]
-   (reaction (get-in @db [::debug-mode?]))))
+   (reaction (@db :debug-mode?))))

 (register-sub
  :log


graph-tour:: eulerian-path-graph implementation in 47 lines of clojure :)

--- src/clojure_learning/graph_tour.clj
+++ src/clojure_learning/graph_tour.clj
@@ -54,44 +54,21 @@

 ;; -> 1 {1}, 2 {3}, 3 {1}, 4 {2}, 5 {1} -> odd edges > 2 (is 4)

-(ns clojure-learning.graph-tour
-  (use (clojure repl test)))
-
-(= false (__ [[:a :b] [:a :b] [:a :c] [:c :a]
-               [:a :d] [:b :d] [:c :d]]))
-(= true (__ [[:a :b] [:a :c] [:c :b] [:a :e]
-              [:b :e] [:a :d] [:b :d] [:c :e]
-              [:d :e] [:c :f] [:d :f]]))
-
-(def tupless [[:a :b] [:a :b] [:a :c] [:c :a]
-               [:a :d] [:b :d] [:c :d]])
-
-;; 1. build a function which finds the edges of a graph::
+;; 1. build a function which finds the unique edges of a graph::
 (defn find-edges [tuples] (vec (set (flatten (concat tuples)))))
-(find-edges tupless) ;; [:c :b :d :a]
-
-(defn equal-by-content? [tuple1 tuple2]
-  (or (= tuple1 tuple2)
-      (= (sort tuple1) (sort tuple2))))
-
-(equal-by-content? [:a :b] [:b :a]) ;; true
-(equal-by-content? [:a :b] [:a :a]) ;; false
-(equal-by-content? [:a :b] [:a :A]) ;; false
-(equal-by-content? ["a" "b"] ["b" "a"]) ;; true
-
-;; 2
+
+;; 2. identify if some vertexes are duplicated? graph-cannot be eulerian : move on...
 (defn duplicate-vertexes? [tuples]
   (not= (count tuples)
      (count
        (apply hash-set (map sort tuples)))))

+;; in action:
 (duplicate-vertexes? [[:a :b] [:b :a]])    ;; true
 (duplicate-vertexes? [[:a :b] [:b :c]])    ;; false
-
 (#{2} 2) ;; 2
-(remove #(= :a %) [:a :b]) ;; (:b)
-
-;; 3.
+
+;; 3. find neighbours/adjacents for a given node
 (defn find-adjacents [node tuples]
   (reduce (fn [adjacents-map [from to :as tuple]]
             (if (get (set tuple) node)
@@ -102,50 +79,135 @@
 (find-adjacents :a [[:a :b] [:a :c]])   ;; {:a #{:c :b}}
 (find-adjacents :a [[:a :b] [:a :b]])   ;; {:a #{:b}}
 (find-adjacents :a [[:b :c] [:d :e]])   ;; {}
-(empty?  (find-adjacents :a [[:b :c] [:d :e]]))   ;; {}
-
-;; 4
+(empty? (find-adjacents :a [[:b :c] [:d :e]]))   ;; {}
+
+;; 4. function that identifies if a given graph is connected or not:: it uses DepthFirstSearch algo'
 (defn graph-connected? [tuples]
-  (letfn [(find-nodes-with-adjacents [tuples]
-            (reduce (fn [nodes-with-adjancents-map node]
-                      (conj nodes-with-adjancents-map (find-adjacents node tuples)))
+  (letfn [(vec-contains? [xs x] (some #(= % x) xs))
+          (depth-first-connected? [node tuples visited]
+            (cond (vec-contains? visited node) visited
+                  :else
+                  (reduce (fn [visited-nodes adjacent]
+                            (if ((comp not empty?) (find-adjacents adjacent tuples))
+                              (depth-first-connected? adjacent tuples visited-nodes)
+                              (conj visited-nodes adjacent :visited)
+                            )
+                          )
+                         (conj visited node) (last (vals (find-adjacents node tuples))))))
+          (find-edges [tuples] (vec (set (flatten (concat tuples)))))]
+    (-> tuples
+      find-edges
+      first
+      (depth-first-connected? tuples [])
+      count
+      (= (count (find-edges tuples)))
+    )))
+
+;; testing:: graph-connected?
+(deftest test-graph-connected?
+  "graph-connected? should return truthy/falsy if a given graph has all edges connected"
+  (let [connected-edges-1 [[:a :b] [:a :c] [:c :b] [:a :e]
+                           [:b :e] [:a :d] [:b :d] [:c :e]
+                           [:d :e] [:c :f] [:d :f]]
+        connected-edges-2 [[:a :b] [:a :b] [:a :c] [:c :a]
+                           [:a :d] [:b :d] [:c :d]]
+        not-connected-edges [[:a :b] [:b :d] [:b :c] [:e :f]]]
+    (is (= true (graph-connected? connected-edges-1)))
+    (is (= true (graph-connected? connected-edges-2)))
+    (is (= false (graph-connected? not-connected-edges)))
+ ))
+
+;; 5. final function:: find if a graph is - eulerian path type of graph
+(defn eulerian-path-graph? [tuples]
+  "a given graph is eulerian if the graph is connected and has at most 2 edges
+having odd degrees, and the rest of edges with even-degree"
+  (if (duplicate-vertexes? tuples) false
+    (if (graph-connected? tuples)
+      (let [nodes-with-adjacents (reduce (fn [nodes-with-adjacents node]
+                                           (conj nodes-with-adjacents (find-adjacents node tuples)))
+                                         {} (find-edges tuples))]
+        (->> (vals nodes-with-adjacents)
+          (filter (comp odd? count))
+          count
+          (>= 2))
+        ))))
+
+(def connected-edges-1 [[:a :b] [:a :c] [:c :b] [:a :e]
+                           [:b :e] [:a :d] [:b :d] [:c :e]
+                           [:d :e] [:c :f] [:d :f]])
+(def not-connected-edges [[:a :b] [:b :d] [:b :c] [:e :f]])
+
+(eulerian-path-graph? connected-edges-1)
+(eulerian-path-graph? not-connected-edges)
+
+;; 6. THAT's IT THAT's ALL:: wrapping all functions into one:: eulerian-path graph::
+(defn eulerian-path-graph? [tuples]
+  "a given graph is eulerian if the graph is connected and has at most 2 edges
+having odd degrees, and the rest of edges with even-degree"
+  (letfn [(duplicate-vertexes? [tuples]
+            (not= (count tuples)
+               (count
+                 (apply hash-set (map sort tuples)))))
+          (find-edges [tuples] (vec (set (flatten (concat tuples)))))
+          (find-adjacents [node tuples]
+            (reduce (fn [adjacents-map [from to :as tuple]]
+                      (if (get (set tuple) node)
+                        (assoc adjacents-map node (set (concat (remove #(= node %) tuple) (adjacents-map node))))
+                        adjacents-map))
+                    {} tuples))
+          (find-nodes-with-adjacents [graph]
+            (reduce (fn [nodes-with-adjacents node]
+                      (conj nodes-with-adjacents (find-adjacents node tuples)))
                     {} (find-edges tuples)))
-          (composite-edge? [edge])
-          ]
-  (let [nodes-with-adjacents-map (find-nodes-with-adjacents tuples)
-        root-node-with-adjacents (first nodes-with-adjacents-map)]
-    nodes-with-adjacents-map)))
-
-
-(graph-connected? [[:a :b] [:a :b] [:a :c] [:c :a]
-                   [:a :d] [:b :d] [:c :d]])
-;; {:a #{:c :b :d}, :d #{:c :b :a}, :b #{:d :a}, :c #{:d :a}}
-
-(first {:a [1 2] :b [3 4]})
-(contains? {:a :b} :c)
-
-(defn depth-first-connected? [node tuples visited-map]
-  (cond (contains? visited-map node)
-      visited-map
-  :else
-      (reduce (fn [visited-nodes adjacent]
-                (if ((comp not empty?) (find-adjacents adjacent tuples))
-                  (depth-first-connected? adjacent tuples visited-nodes)
-                  (assoc visited-nodes adjacent :visited)
-                )
-              )
-             (assoc visited-map node :visited) (last (vals (find-adjacents node tuples))))))
-
+          (graph-connected? [tuples]
+            (letfn [(vec-contains? [xs x] (some #(= % x) xs))
+                    (depth-first-connected? [node tuples visited]
+                      (cond (vec-contains? visited node) visited
+                            :else
+                            (reduce (fn [visited-nodes adjacent]
+                                      (if ((comp not empty?) (find-adjacents adjacent tuples))
+                                        (depth-first-connected? adjacent tuples visited-nodes)
+                                        (conj visited-nodes adjacent :visited)
+                                      )
+                                    )
+                                   (conj visited node) (last (vals (find-adjacents node tuples))))))
+                    (find-edges [tuples] (vec (set (flatten (concat tuples)))))]
+              (-> tuples
+                find-edges
+                first
+                (depth-first-connected? tuples [])
+                count
+                (= (count (find-edges tuples)))
+                )))]
+    (if (duplicate-vertexes? tuples) false
+      (if ((comp not graph-connected?) tuples) false
+          (->> tuples
+            find-nodes-with-adjacents
+            vals
+            (filter (comp odd? count))
+            count
+            (>= 2)
+          )))))
+
+;; test stubs::
 (def connected-edges-1 [[:a :b] [:a :c] [:c :b] [:a :e]
-                      [:b :e] [:a :d] [:b :d] [:c :e]
-                      [:d :e] [:c :f] [:d :f]])
-
-(def connected-edges-2 [[:a :b] [:a :b] [:a :c] [:c :a]
-                          [:a :d] [:b :d] [:c :d]])
-
-(def not-connected-edges [[:a :b] [:b :d] [:b :c] [:e :f]])
-
-(depth-first-connected? :a connected-edges-1 {})
-(depth-first-connected? :a connected-edges-2 {})
-(depth-first-connected? :a not-connected-edges {})
-
+                                [:b :e] [:a :d] [:b :d] [:c :e]
+                                [:d :e] [:c :f] [:d :f]])
+(def connected-edges-2 [[1 2] [2 3] [3 4] [4 1]])
+(def not-connected-edges-1 [[:a :b] [:a :b] [:a :c] [:c :a]
+                             [:a :d] [:b :d] [:c :d]])
+(def not-connected-edges-2 [[:a :b] [:b :d] [:b :c] [:e :f]])
+(def not-connected-edges-3 [[:a :a] [:b :b]])
+(def not-connected-edges-4 [[1 2] [2 3] [2 4] [2 5]])
+(def not-connected-edges-5 [[:a :a] [:b :b]])
+
+(deftest test-eulerian-path-graph?
+  "eulerian-path-graph? should tell if a graph is can be traversed by visiting each edge exactly once"
+    (is (= true (eulerian-path-graph? connected-edges-1)))
+    (is (= true (eulerian-path-graph? connected-edges-2)))
+    (is (= false (eulerian-path-graph? not-connected-edges-1)))
+    (is (= false (eulerian-path-graph? not-connected-edges-2)))
+    (is (= false (eulerian-path-graph? not-connected-edges-3)))
+    (is (= false (eulerian-path-graph? not-connected-edges-4)))
+    (is (= false (eulerian-path-graph? not-connected-edges-5)))
+ )


Update calls to random-plush-instruction-map

--- src/clojush/instructions/genome.clj
+++ src/clojush/instructions/genome.clj
@@ -52,7 +52,6 @@
                           index
                           (random-plush-instruction-map
                             @global-atom-generators
-                            true
                             {:epigenetic-markers @global-epigenetic-markers
                              :close-parens-probabilities @global-close-parens-probabilities
                              :silent-instruction-probability @global-silent-instruction-probability}))
@@ -76,7 +75,6 @@
                           index
                           (random-plush-instruction-map
                                     [(nth @global-atom-generators atom-gen)]
-                                    true
                                     {:epigenetic-markers @global-epigenetic-markers
                                      :close-parens-probabilities @global-close-parens-probabilities
                                      :silent-instruction-probability @global-silent-instruction-probability}))