RS | Refactoring user.clj requires

RS | Refactoring user.clj requires

--- test/stonecutter/test/controller/user.clj
+++ test/stonecutter/test/controller/user.clj
@@ -1,14 +1,13 @@
 (ns stonecutter.test.controller.user
   (:require [midje.sweet :refer :all]
+            [ring.mock.request :as mock]
+            [clauth.token :as cl-token]
+            [clauth.client :as cl-client]
+            [clauth.user :as cl-user]
+            [net.cgrand.enlive-html :as html]
             [stonecutter.controller.user :as c]
-            [ring.mock.request :as mock]
             [stonecutter.db.storage :as s]
-            [stonecutter.validation :as v]
-            [clauth.client :as client]
-            [clauth.token :as token]
-            [clauth.user :as user-store]
-            [clauth.store :as clauth-store]
-            [net.cgrand.enlive-html :as html]))
+            [stonecutter.validation :as v]))

 (def email "valid@email.com")
 (def password "password")
@@ -26,7 +25,7 @@
    :name     nil
    :url      nil})

-(background (before :facts (user-store/reset-user-store!)))
+(background (before :facts (cl-user/reset-user-store!)))

 (fact "user can sign in with valid credentials and is redirected to profile, with user and access_token added to session"
       (-> (create-request :post "/sign-in" sign-in-user-params)
@@ -35,7 +34,7 @@
                                              :access_token ...token...}})
       (provided
         (s/authenticate-and-retrieve-user email password) => ...user...
-        (token/create-token nil ...user...) => {:token ...token...}))
+        (cl-token/create-token nil ...user...) => {:token ...token...}))

 (fact "user can register with valid credentials and is redirected to profile-created page, with user added to session"
       (-> (create-request :post "/register" register-user-params)
@@ -45,7 +44,7 @@
       (provided
         (v/validate-registration register-user-params s/is-duplicate-user?) => {}
         (s/store-user! email password) => ...user...
-        (token/create-token nil ...user...) => {:token ...token...}))
+        (cl-token/create-token nil ...user...) => {:token ...token...}))

 (fact "signed-in? returns true only when user and access_token are in the session"
       (tabular
@@ -81,8 +80,8 @@
                                     :session {:access_token ...token... :user ...user...}})
         (provided
           (s/authenticate-and-retrieve-user email password) => ...user...
-          (client/fetch-client "client-id") => ...client...
-          (token/create-token ...client... ...user...) => {:token ...token...})))
+          (cl-client/fetch-client "client-id") => ...client...
+          (cl-token/create-token ...client... ...user...) => {:token ...token...})))

 (fact "if user logged out, access token and user email are removed from session"
       (let [return-to-url "/authorisation?client-id=whatever"]
@@ -94,8 +93,8 @@
             :session) => empty?
         (provided
           (s/authenticate-and-retrieve-user email password) => ...user...
-          (client/fetch-client "client-id") => ...client...
-          (token/create-token ...client... ...user...) => {:token ...token...})))
+          (cl-client/fetch-client "client-id") => ...client...
+          (cl-token/create-token ...client... ...user...) => {:token ...token...})))

 (fact "if user has client id but no return-to in session, throws an exception"
       (-> (create-request :post "/sign-in" sign-in-user-params)
@@ -112,7 +111,7 @@
             c/sign-in) => (throws Exception)
         (provided
           (s/authenticate-and-retrieve-user email password) => ...user...
-          (client/fetch-client "client-id") => nil)))
+          (cl-client/fetch-client "client-id") => nil)))

 (facts "about sign-in validation errors"
        (fact "user cannot sign in with blank password"
@@ -168,15 +167,15 @@
             :class)) => (contains "clj--registration-email")
       (provided
         (v/validate-registration register-user-params s/is-duplicate-user?) => {:email :duplicate}
-        (user-store/new-user anything anything) => anything :times 0
-        (user-store/store-user anything) => anything :times 0))
+        (cl-user/new-user anything anything) => anything :times 0
+        (cl-user/store-user anything) => anything :times 0))

 (facts "about registration validation errors"
        (fact "user isn't saved to the database if email is invalid"
              (-> (create-request :post "/register" {:email "invalid"}) c/register-user) => anything
              (provided
-               (user-store/new-user anything anything) => anything :times 0
-               (user-store/store-user anything) => anything :times 0))
+               (cl-user/new-user anything anything) => anything :times 0
+               (cl-user/store-user anything) => anything :times 0))
        (facts "registration page is rendered with errors"
               (let [html-response (-> (create-request :post "/register" {:email "invalid"})
                                       c/register-user


fix race condition during card install

fix race condition during card install

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -24,6 +24,10 @@
                (swap! state assoc-in [side :register :spent-click] true))
              (swap! state update-in [side (first c)] #(- % (last c)))))
       false)))
+
+(defn can-move? [state side {:keys [cid] :as card} to]
+  (let [dest (if (sequential? to) to [to])]
+    (not (some #(= (:cid %) cid) (get-in @state (cons side to))))))

 (defn move [state side {:keys [zone cid] :as card} to]
   (when card
@@ -277,20 +281,22 @@
   (doseq [e events]
     (swap! state update-in [side :events (first e)] #(conj % {:ability (last e) :card card}))))

-(defn runner-install [state side {:keys [title type memoryunits uniqueness] :as card}]
-  (when (and (or (not uniqueness) (not (in-play? state card)))
-             (pay state side :click 1 :credit (:cost card) :memory memoryunits))
-    (let [cdef (card-def card)
-          abilities (for [ab (split-lines (:text card))
-                          :let [matches (re-matches #".*: (.*)" ab)] :when (second matches)]
-                      (second matches))
-          c (merge card (:data cdef) {:abilities abilities})
-          moved-card (move state side c [:rig (keyword (.toLowerCase type))])]
-      (when-let [effect (:effect cdef)]
-        (effect state side moved-card))
-      (when-let [events (:events cdef)]
-        (register-events state side events moved-card)))
-    (system-msg state side (str "installs " title))))
+(defn runner-install [state side {:keys [title type cost memoryunits uniqueness] :as card}]
+  (let [dest [:rig (keyword (.toLowerCase type))]]
+    (when (and (can-move? state side card dest)
+               (or (not uniqueness) (not (in-play? state card)))
+               (pay state side :click 1 :credit cost :memory memoryunits))
+      (let [cdef (card-def card)
+            abilities (for [ab (split-lines (:text card))
+                            :let [matches (re-matches #".*: (.*)" ab)] :when (second matches)]
+                        (second matches))
+            c (merge card (:data cdef) {:abilities abilities})
+            moved-card (move state side c dest)]
+        (when-let [effect (:effect cdef)]
+          (effect state side moved-card))
+        (when-let [events (:events cdef)]
+          (register-events state side events moved-card)))
+      (system-msg state side (str "installs " title)))))

 (defn corp-install [state side card server]
   (let [dest (case server
@@ -304,15 +310,16 @@
         (when (pay state side :click 1 :credit (count (get-in @state (cons :corp slot))))
           (move state side card slot)
           (system-msg state side (str "install an ICE on " server))))
-      (when (pay state side :click 1)
-        (let [slot (conj dest :content)]
+      (let [slot (conj dest :content)]
+        (when (and (can-move? state side card slot)
+                   (pay state side :click 1))
           (when (#{"Asset" "Agenda"} (:type card))
             (doseq [c (get-in @state (cons :corp slot))]
               (when (#{"Asset" "Agenda"} (:type c))
                 (trash state side c)
                 (system-msg state side (str "trash a card in " server)))))
-          (move state side card slot))
-        (system-msg state side (str "installs a card in " server))))))
+          (move state side card slot)))
+      (system-msg state side (str "installs a card in " server)))))

 (defn play [state side {:keys [card server]}]
   (case (:type card)


Support new plugin interface.

Support new plugin interface.

--- src/onyx/plugin/sql.clj
+++ src/onyx/plugin/sql.clj
@@ -103,7 +103,7 @@
   (checkpointed! [this epoch])

   p/Input
-  (poll! [this segment]
+  (poll! [this segment _]
     (if-let [part (first @rst)]
       (do (vswap! rst rest)
           (read-rows pool table id columns part))


Log aborted exceptions, but don't throw

Log aborted exceptions, but don't throw

--- src/overseer/worker.clj
+++ src/overseer/worker.clj
@@ -33,28 +33,32 @@
   [config job]
   (fn [ex]
     (timbre/error ex)
-    (if-let [dsn (get-in config [:sentry :dsn])]
-      (sentry-capture dsn ex (select-keys job [:job/type :job/id])))
+    (when-not (= :aborted (:overseer/status (ex-data ex)))
+      (if-let [dsn (get-in config [:sentry :dsn])]
+        (sentry-capture dsn ex (select-keys job [:job/type :job/id]))))
     nil))

-(defn default-failure-info [ex]
-  {:overseer/status :failed
-   :overseer/failure {:reason :system/exception
-                      :exception (class ex)
-                      :message (.getMessage ex)}})
+(defn failure-info
+  "Construct a map of information about an exception, including
+   user-supplied ex-data if present"
+  [ex]
+  (let [m {:overseer/status :failed
+           :overseer/failure {:reason :system/exception
+                              :exception (class ex)
+                              :message (.getMessage ex)}}]
+    (if-let [exc-data (ex-data ex)]
+      (assoc-in m [:overseer/failure :data] exc-data)
+      m)))

 (defn ->job-exception-handler
   "Exception handler for job thunks; invokes the default handler,
-   then returns a status keyword. Attempts to parse special signal
-   status out of ex, else defaults to :failed"
+   then returns a map of failure info, using user-provided ex-data if present.
+   Attempts to parse special signal status out of ex, else defaults to :failed"
   [config job]
   (fn [ex]
-    (let [default-handler (->default-exception-handler config job)
-          exc-data (util/sanitized-ex-data ex)
-          failure-map (or exc-data (default-failure-info ex))]
-      (when-not (= :aborted (:overseer/status exc-data))
-        (default-handler ex))
-      failure-map)))
+    (let [default-handler (->default-exception-handler config job)]
+      (default-handler ex))
+      (failure-info ex)))

 (defn reserve-job
   "Attempt to reserve a job and return it, or return nil on failure"
@@ -104,7 +108,7 @@
         (->> (pre-process job)
              (process)
              (post-process job)))
-    (ifn? handler)
+    (fn? handler)
       (handler job)
     :else
       (throw (Exception. "Handlers must either be a function or a map"))))


Handle nil korks

Handle nil korks

--- src/pani/cljs/core.cljs
+++ src/pani/cljs/core.cljs
@@ -53,11 +53,10 @@
   "Takes korks and reduces it to a root on which we can perform direct actions"
   (let [p (if (sequential? korks)
             (apply str (interpose "/" (map clojure.core/name korks)))
-            (clojure.core/name korks))]
-    (if (= "" p)
+            (when korks (clojure.core/name korks)))]
+    (if-not (seq p)
       root
       (.child root p))))
-

 (defn name [r]
   "Get the name of the given root"


remove cruft

remove cruft

--- src/polismath/utils.clj
+++ src/polismath/utils.clj
@@ -153,13 +153,6 @@
           m))))

-(defn use-debuggers
-  "Handy debugging utility for loading in debugging namespaces - doesn't really always work. XXX - maybe
-  use Vinyasa?"
-  []
-  ;(require '[alex-and-georges.debug-repl :as dr])
-  (require '[clojure.tools.trace :as tr]))
-
 (defn clst-trace
   ([clsts] (clst-trace "" clsts))
   ([k clsts]


oops, wrong sort function

oops, wrong sort function

--- src/caws/core.clj
+++ src/caws/core.clj
@@ -162,7 +162,7 @@
 (defn route [mappings]
   "TODO: add regex support, too, cuz we should."
   (let [route** (fn route* [mappings full-path path in-chan out-chan]
-                  (loop [prefixes (sort (fn [x] (count (str x))) > (keys mappings))]
+                  (loop [prefixes (sort-by (fn [x] (count (str x))) > (keys mappings))]
                     (if (empty? prefixes)
                       (go (>! out-chan 404)
                           (>! out-chan :end))
@@ -220,15 +220,18 @@
            (write-error e)))))))

 (view home
-  (send-headers {:content-type "text"})
-  (send-body "This is the home page\n"))
+      (send-headers {:content-type "text"})
+      (send-body "This is the home page\n"))

 (view bing
-  (send-headers {:content-type "text"})
-  (send-body "This is the Bing\n"))
-
+      (send-headers {:content-type "text"})
+      (send-body "This is the Bing\n"))
+
+(view slow
+      (Thread/sleep 10000)
+      (send-body "Done sleeping"))

 (run (route {:get
              {"/foo" {"/bing" bing}
-              "/slow-thing"
+              "/slow-thing" slow
               "/" home}}))


Tidy up fire spreading

Tidy up fire spreading

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -1985,23 +1985,25 @@
     ;; update fire
     ((fn [state]
       (reduce (fn [state [cell x y]]
-              ;; chance of fire spreading
-              (condp = (uniform-int 0 10)
-                0
-                ;; make the fire spread and find an adjacent free cell to spread it into
-                (let [adj-xys (filter (fn [[x y]] (type->flammable?
-                                                    (get (get-cell-at-current-place state x y) :type)))
-                                      (adjacent-xys-ext x y))]
-                  (info "spreading fire at [" x y "]" adj-xys)
-                  (if (seq adj-xys)
-                    ;; spread fire into the cell
-                    (let [[x y] (dg/rand-nth adj-xys)]
-                      (assoc-cell-type state x y :fire))
-                    state))
-                1
-                ;; extinguish the fire
-                (assoc-cell-type state x y :dirt)
-                state))
+                (let [p (uniform-int 0 10)]
+                  ;; chance of fire spreading
+                  (cond
+                    (= p 0)
+                    ;; make the fire spread and find an adjacent free cell to spread it into
+                    (let [adj-xys (filter (fn [[x y]] (type->flammable?
+                                                        (get (get-cell-at-current-place state x y) :type)))
+                                          (adjacent-xys-ext x y))]
+                      (info "spreading fire at [" x y "]" adj-xys)
+                      (if (seq adj-xys)
+                        ;; spread fire into the cell
+                        (let [[x y] (dg/rand-nth adj-xys)]
+                          (assoc-cell state x y :type :fire :fire-time (get-time state)))
+                        state))
+                    (= p 1)
+                    ;; extinguish the fire
+                    (assoc-cell state x y :type :dirt)
+                    :else
+                    state)))
             state
             ;; [x y]s of fire cells in the current place
             (filter (fn filter-fruit-tree-cells


avoid issue where BQ queries fail trying to connect to a local postgres in order to build SQL.

--- src/metabase/driver/bigquery.clj
+++ src/metabase/driver/bigquery.clj
@@ -261,9 +261,14 @@
 (declare driver)

 ;; this is never actually connected to, just passed to korma so it applies appropriate delimiters when building SQL
-(def ^:private korma-db (-> (kdb/create-db (kdb/postgres {}))
-                            (update :options assoc :delimiters [\[ \]])))
-
+(def ^:private ^:const korma-db
+  {:pool {:subprotocol "sqlite"
+          :subname     ""}
+   :options {:naming          {:keys   identity
+                               :fields identity}
+             :delimiters      [\[ \]]
+             :alias-delimiter " AS "
+             :subprotocol     ""}})

 (defn- entity [dataset-id table-name]
   (-> (k/create-entity (k/raw (format "[%s.%s]" dataset-id table-name)))


test fix ?

test fix ?

--- src/metabase/models/database.clj
+++ src/metabase/models/database.clj
@@ -19,4 +19,5 @@
          :can_write    (delay (:is_superuser @*current-user*))))

 (defmethod pre-cascade-delete Database [_ {:keys [id] :as database}]
+  (println (format "DATABASE %d IS GOING TO BE DESTROYED..." id))
   (cascade-delete 'metabase.models.table/Table :db_id id))


rewrite with def

rewrite with def

--- src/sicp/chapter3_1.clj
+++ src/sicp/chapter3_1.clj
@@ -156,13 +156,14 @@
 (defn rand-update [n]
   (inc n))

-(defn rand' [m]
+(def rand'
   (let [r random-init]
-    (case m
-      :generate (swap! r rand-update)
-      :reset #(reset! r %)
-      (throw (IllegalArgumentException.
-              (str "Unknown request -- rand' "
-                   m))))))
+    (fn [m]
+      (case m
+        :generate (swap! r rand-update)
+        :reset #(reset! r %)
+        (throw (IllegalArgumentException.
+                (str "Unknown request -- rand' "
+                     m)))))))

 ;;; 3.1.3  The Costs of Introducing Assignment


first working version

first working version

--- src/http_users/core.clj
+++ src/http_users/core.clj
@@ -3,64 +3,16 @@

 (require '[org.httpkit.server :as http]
          '[clojure.data.json :as json]
-         '[clojure.java.io :as io]
-         '[clojure.data.csv :as csv]
-         '[clojure.java.io :as io]
          '[hiccup.core :as h])

-;(def user-data "/var/www/json/user-data.json")
-;(def user-data (.getFile (clojure.java.io/resource "user-data.json")))
+(def port 8080)
+(def users (atom {:tero "passu" :pasi "ppaswd" :harri "wdp"}))
+(def page-count (atom 0))

-;(def user-data (io/file (io/resource "user-data.json")))
-(def user-data 0)
-(def port 8080)
-
-(defn user-to-html [user]
-  (str "
" (get user "user") ":" (get user "password") "
\n"))
-
-(defn users-to-html [users-map]
-  (loop [my-users (get users-map "users")
-         html ""]
-    (if (empty? my-users)
-      (str "
" (clojure.string/join html) "
")
-      (let [ my-user (first my-users) ]
-        (recur (rest my-users) (concat html (user-to-html my-user)))))))
-
-(defn my-json-read [file]
-  (json/read (java.io.FileReader. file)))
-
-(defn json->html [json]
-  (let [ users-list (users-to-html json) ]
-    (str "<title>users</title>" users-list
-         "")))
-
-;; (defn handle-post [req]
-;;   (let [ req-data (slurp (:body req))
-;;          new-user (json/read-str req-data)
-;;          old-users (my-json-read user-data)
-;;          all-users (conj (get old-users "users") new-user)
-;;          all-as-json (json/write-str (assoc-in old-users ["users"] all-users)) ]
-;;     (spit user-data all-as-json)
-;;     (http-reply 200 {"Content-Type" "text/text"}
-;;                 (json->html (my-json-read user-data)))))
-
-; #######################################
-; # new implementation
-; #######################################
-
-(def users (atom {:tero "passu" :pasi "ppaswd" :harri "wdp"}))
-
-(defn add-user! [name pwd]
-  (swap! users assoc (keyword name) pwd))

 (defn print-users []
   (doseq [ user  @users ]
     (println (str (first user) " " (second user)))))
-
-(defn json->atom [users-map]
-  (for [user (get users-map "users")]
-    (add-user! (nth (first user) 1) (nth (second user) 1))))
-

 (defn users->table [users]
   [:table
@@ -72,11 +24,14 @@

 (defn header [title]
   [:head [:title title ]])
+
 (defn body [users]
   [:body
    [:h2 "known users"]
    (users->table users)
-   [:br]])
+   [:br]
+   [:p (str "Page accessed " (swap! page-count inc) " times") ]])
+
 (defn html-page [title users]
   [:html
    (header title)
@@ -87,19 +42,16 @@
    :headers headers
    :body body })

-(defn users-to-map [users-map]
-  (loop [my-users (get users-map "users")
-         html {}]
-    (if (empty? my-users)
-      (let [ my-user (first my-users) ]
-        (recur (rest my-users) (assoc html (keyword (first my-user))
-                                      (second my-user)))))))
-
-
+(defn add-users-to-atom! [new-users]
+  (doseq [user (get new-users "users")]
+    (swap! users assoc (keyword (nth (first user) 1)) (nth (second user) 1))))
+
+; json API:
+; "{\"users\":[{\"user\":\"aaafaska\",\"password\":\"aaapasswood\"}, {\"user\":\"aaayeeso\",\"password\":\"aaaenkerro\"}]}"
 (defn handle-post-new [req]
-  (let [ json-data (slurp (:body req)) ]
-    (json->atom (json/read-str json-data))
-    (print-users)
+  (let [ json-data (slurp (:body req))
+         new-users (json/read-str json-data) ]
+    (add-users-to-atom! new-users)
     (http-reply 200 {"Content-Type" "text/html"}
                 (h/html (html-page "System users" users)))))


New function process-add-new-chapter-page

--- src/hurvinek/server.clj
+++ src/hurvinek/server.clj
@@ -83,10 +83,10 @@
               (http-response/content-type "text/html"))))

 (defn finish-processing-chapter-list
-    [request title product-id product-name chapter-list]
-    (let [params        (:params request)
-          url-prefix    (get-url-prefix request)]
-          (-> (http-response/response (html-renderer/render-chapter-list url-prefix title product-id product-name chapter-list))
+    [request title product-id product-name chapter-list & {:keys [message-type message]}]
+    (let [params        (:params request)
+          url-prefix    (get-url-prefix request)]
+          (-> (http-response/response (html-renderer/render-chapter-list url-prefix title product-id product-name chapter-list :message-type message-type :message message))
               (http-response/content-type "text/html"))))

 (defn finish-processing-group-list
@@ -156,6 +156,22 @@
               insert-result         (finish-processing-product-list request title product-list :message-type "danger" :message (str insert-result))
               :else                 (finish-processing-product-list request title product-list :message-type "info" :message (str "Product " product-name " has been added into the database"))
           )))
+
+(defn process-add-new-chapter-page
+    [request title]
+    (let [params         (:params request)
+          product-id     (get params "product-id")
+          chapter-name   (get params "chapter-name")
+          product-name   (db-interface/read-product-name product-id)
+          insert-result  (db-interface/add-new-chapter product-id chapter-name)
+          chapter-list   (db-interface/read-chapters product-id)]
+          (if (not chapter-name)
+              (finish-processing-chapter-list request title product-id product-name chapter-list)
+              (cond
+                  (empty? chapter-name) (finish-processing-chapter-list request title product-id product-name chapter-list :message-type "danger" :message "Chapter name is not specified")
+                  insert-result         (finish-processing-chapter-list request title product-id product-name chapter-list :message-type "danger" :message (str insert-result))
+                  :else                 (finish-processing-chapter-list request title product-id product-name chapter-list :message-type "info" :message (str "Chapter " chapter-name " has been added into the database"))
+              ))))

 (defn process-edit-product-page
     [request title]
@@ -229,6 +245,7 @@
             "/select-product"             (process-select-product-page  request title)
             "/product"                    (process-product-page         request title)
             "/add-new-product"            (process-add-new-product-page request title)
+            "/add-new-chapter"            (process-add-new-chapter-page request title)
             "/edit-product"               (process-edit-product-page    request title)
             "/chapter"                    (process-chapter-page         request title)
             "/group"                      (process-group-page           request title)


set-position works as expected

set-position works as expected

--- src/spacetime/core.cljs
+++ src/spacetime/core.cljs
@@ -110,7 +110,7 @@
   "Set the position with [x y z] vector"
   [controls position]
   (let [object (.getObject controls)]
-    (.position.set (clj->js position))))
+    (apply  #(.position.set object %1 %2 %3) position)))

 ;; (do
 ;;   ;; requestPointLock can not be called automatically. Must be called from


Starts impl for greedy.

Starts impl for greedy.

--- src/onyx/log/commands/common.clj
+++ src/onyx/log/commands/common.clj
@@ -315,3 +315,13 @@
   (and (reallocate-from-job? (:job-scheduler old) old new state)
        (anticipating-coverage? old new job-id)))

+(defmulti volunteer-via-new-job?
+  (fn [scheduler old new diff]
+    scheduler))
+
+(defmethod volunteer-via-new-job? :onyx.job-scheduler/greedy
+  [scheduler old new diff]
+  (when (zero? (count (incomplete-jobs old)))
+    (let [tasks (get-in new [:tasks (:job diff)])]
+      (>= (count (get-in [new :peers])) (count tasks)))))
+


Hint bit-xor.

Hint bit-xor.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -136,7 +136,7 @@
                                   leaf** (assoc leaf* :ack-val ack-val)
                                   grp (get hash-group route)]
                               (->AccumAckSegments
-                                (bit-xor (:ack-val accum2) ack-val)
+                                (bit-xor ^long (:ack-val accum2) ^long ack-val)
                                 (update-in2 (:segments accum2)
                                             route
                                             grp


No need to create retry counter in generator

--- src/onyx/plugin/bench_plugin.clj
+++ src/onyx/plugin/bench_plugin.clj
@@ -71,6 +71,5 @@
 (defn generator [pipeline-data]
   (let [task-map (:onyx.core/task-map pipeline-data)
         max-pending (or (:onyx/max-pending task-map) (:onyx/max-pending defaults))
-        batch-size (:onyx/batch-size task-map)
-        retry-counter (atom 0)]
+        batch-size (:onyx/batch-size task-map)]
     (->BenchmarkInput (atom {}) (atom []) max-pending batch-size)))


commit to pull

commit to pull

--- src/logic/sat-solve.clj
+++ src/logic/sat-solve.clj
@@ -23,12 +23,25 @@
     (when (.isSatisfiable solver)
       (.decode reader (.model solver)))))

-(defn sat-solve
-  "Returns one result as vector. The vector is epmty if the formula is unsatisfiable."
+(defn sat-solve-dimacs
+  "Returns one result as vector like the dimace clauses in the dimacs-map.
+   The first number is 0 or 1:
+   0: the formula is unsatisfiable
+   1: the formula is satisfiable"
   [dimacs-map]
   (let [res-str (sat4j-solve dimacs-map)]
     (if (nil? res-str)
-              []
-              (vec (filter #(not= 0 %) (map #(Integer. %) (clojure.string/split res-str #" ")))))))
-
-
+              [0]
+              (cons 1 (vec (filter #(not= 0 %) (map #(Integer. %) (clojure.string/split res-str #" "))))))))
+
+(defn sat-sovle
+  "Returns one result as vector with litereals.
+   The first number is 0 or 1:
+   0: the formula is unsatisfiable
+   1: the formula is satisfiable"
+  [dimacs-map]
+  (let [res-str (sat4j-solve dimacs-map)]
+    (if (nil? res-str)
+              [0]
+              (let [numvec  (vec (filter #(not= 0 %) (map #(Integer. %) (clojure.string/split res-str #" "))))]
+


fixed uberjar build

fixed uberjar build

--- src/mail_query/core.clj
+++ src/mail_query/core.clj
@@ -10,11 +10,11 @@
             [compojure.route :refer [not-found]]
             [ring.handler.dump :refer [handle-dump]]
             [org.httpkit.client :as http]
-            [cheshire.core :refer [parse-string]]))
+            [cheshire.core :refer [parse-string]])
+  (:gen-class))

 (def mailgun-domain (System/getenv "MAILGUN_DOMAIN"))
 (def mailgun-api-key (System/getenv "MAILGUN_API_KEY"))
-(def app-port (System/getenv "APP_PORT"))

 (def resource (str "https://api.mailgun.net/v3/" mailgun-domain "/events"))


do not show bpm when metronome is stopped

--- src/metronome/core.cljs
+++ src/metronome/core.cljs
@@ -163,7 +163,7 @@
   (reify
     om/IRender
     (render [_]
-      (dom/div nil (str (.round js/Math (* 60 (/ 1000 (:interval bpm)))) " bpm")))))
+      (dom/div nil (when-let [interval (:interval bpm)] (str (.round js/Math (* 60 (/ 1000 interval))) " bpm"))))))

 (defn skip-warning [bpm owner]
   (reify


warnings fixes

warnings fixes

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -26,6 +26,10 @@
                (swap! state assoc-in [side :register :spent-click] true))
              (swap! state update-in [side (first c)] #(- % (last c)))))
       false)))
+
+(defn gain [state side & args]
+  (doseq [r (partition 2 args)]
+    (swap! state update-in [side (first r)] #(+ % (last r)))))

 (defn desactivate [state side card]
   (let [c (dissoc card :counter :advance-counter :current-strength :abilities)
@@ -108,7 +112,7 @@
         (when msg
           (let [desc (if (string? msg) msg (msg state side card targets))]
             (system-msg state side (str "uses " title (when desc (str " to " desc))))))
-        (when effect (effect state side c targets)))
+        (when effect (effect state side c nil)))
       (when once (swap! state assoc-in [once (or once-key cid)] true)))))

 (defn prompt! [state side card msg choices ability]
@@ -287,10 +291,6 @@
   (swap! state assoc-in [side :keep] true)
   (system-msg state side "keeps his or her hand"))

-(defn gain [state side & args]
-  (doseq [r (partition 2 args)]
-    (swap! state update-in [side (first r)] #(+ % (last r)))))
-
 (defn lose [state side & args]
   (doseq [r (partition 2 args)]
     (if (= (last r) :all)


minor improvements

minor improvements

--- src/notehub/storage.clj
+++ src/notehub/storage.clj
@@ -139,8 +139,9 @@
           all-notes (map first (partition 2 (redis :hgetall :note)))
           old-notes (filter #(< (Long/parseLong (redis :hget :published %)) timestamp) all-notes)
           unpopular-notes (filter #(< (try (Long/parseLong (redis :hget :views %))
-                                          (catch Exception a 0)) N) old-notes)]
+                                           (catch Exception a 0)) N) old-notes)]
       (println "timestamp:" (str (java.util.Date. timestamp)))
-      (println (count unpopular-notes) "deleted")
       (doseq [note-id unpopular-notes]
-        (delete-note note-id)))))
+        (do (println "deleting" note-id)
+            (delete-note note-id)))
+      (println (count unpopular-notes) "deleted"))))


use duckstreams spit specifically to fix a problem that appears to rear its head with OpenJDK on Linux

--- src/overtone/config.clj
+++ src/overtone/config.clj
@@ -1,5 +1,6 @@
 (ns overtone.config
   (:use [clojure.contrib.io :only (slurp*)])
+  (:require [clojure.contrib.duck-streams :as ds])
   (:import (java.io FileOutputStream FileInputStream)))

 ;; Provides a simple key/value configuration system with support for automatically
@@ -22,7 +23,7 @@
 (defmethod save-config :file
   [path data]
   (locking F-LOCK
-      (spit path data)))
+      (ds/spit path data)))

 (defmethod restore-config :file
   [path]


Make the brushes bigger

Make the brushes bigger

--- src/paint/extra/gui.clj
+++ src/paint/extra/gui.clj
@@ -6,13 +6,13 @@

 (def substrate-state (atom {}))
-(def brush-state (atom [{:width 3 :height 3
+(def brush-state (atom [{:width 10 :height 10
                          :fn (brush/block [0 0 0])}
-                        {:width 3 :height 3
+                        {:width 10 :height 10
                          :fn (brush/block [255 0 0])}
-                        {:width 3 :height 3
+                        {:width 10 :height 10
                          :fn (brush/block [0 255 0])}
-                        {:width 3 :height 3
+                        {:width 10 :height 10
                          :fn (brush/block [0 0 255])}]))
 (def selected-brush (atom 0))


Add request-response debug logging

Add request-response debug logging

--- src/time_tracker/web/service.clj
+++ src/time_tracker/web/service.clj
@@ -7,9 +7,31 @@
             [time-tracker.web.routes :refer [routes]]
             [time-tracker.db :as db]
             [time-tracker.config :as config]
-            [time-tracker.util :as util]))
+            [time-tracker.util :as util]
+            [cheshire.generate :refer [add-encoder encode-str]])
+  (:import org.httpkit.server.AsyncChannel))

 (def handler (make-handler routes))
+
+;; This is neccessary because http-kit adds some AsyncChannel
+;; to the request map if it is a websockets connection upgrade,
+;; which can't be JSON serialized.
+(def standard-ring-request-keys
+  [:server-port :server-name :remote-addr :uri :query-string :scheme
+   :headers :request-method :body])
+
+;; Define a custom JSON encoder for the AsyncChannel
+(add-encoder AsyncChannel encode-str)
+
+(defn- wrap-log-request-response
+  [handler]
+  (fn [request]
+    (let [response (handler request)]
+      (log/debug {:event    ::request-response
+                  :request  (select-keys request
+                                         standard-ring-request-keys)
+                  :response response})
+      response)))

 (defn- wrap-error-logging
   [handler]
@@ -28,6 +50,7 @@

 (def app
   (-> handler
+      (wrap-log-request-response)
       (wrap-json-body {:keywords? true})
       (wrap-json-response)
       (wrap-defaults api-defaults)


better landscape formatting for bars

better landscape formatting for bars

--- src/unspun/screens/rum_bars.cljs
+++ src/unspun/screens/rum_bars.cljs
@@ -139,6 +139,8 @@
          palette (get-palette (rum/react palette-index))
          page-style {:flex            1
                      :backgroundColor (:primary palette)}
+         {w :width h :height} (rum/react dimensions)
+         portrait (> h w)

          ;scale 1.9
          ub (/ 100 (rum/react (:scale state)))
@@ -155,8 +157,8 @@
      (view
        {:style {:flex 1}}

-       (view {:style page-style}
-             (view {:style {:flex            0.4
+       (view {:style (merge page-style {:flexDirection (if portrait "column" "row")})}
+             (view {:style {:flex            (if portrait 0.4 0.5)
                             :position        "relative"
                             :justifyContent  "flex-start"
                             :alignItems      "stretch"
@@ -212,7 +214,7 @@
                    )

              (view {:key   2
-                    :style {:flex 0.6}}
+                    :style {:flex (if portrait 0.6 0.5)}}
                    ;;;
                    ;; top and bottom buttons
                    ;;;


get-wishlist for code and for id

get-wishlist for code and for id

--- src/wishlistd/models/queries.clj
+++ src/wishlistd/models/queries.clj
@@ -2,14 +2,14 @@
   (:require [clojure.java.jdbc :as sql]))

 (def db {:classname "org.postgresql.Driver"
-		 :subprotocol "postgresql"
-		 :subname "//localhost:5432/cwl"
-		 :user "cwl"
-		 :password "wish"})
+         :subprotocol "postgresql"
+         :subname "//localhost:5432/cwl"
+         :user "cwl"
+         :password "wish"})
 ;wishlist
 ;[:id :serial "PRIMARY KEY"]
 ;[:title :varchar "NOT NULL"]
-;[:code :varchar :unique "NOT NULL"]
+;[:code :varchar :unique]
 ;[:created_at :timestamp "NOT NULL" "DEFAULT CURRENT_TIMESTAMP"])))

 ;wish
@@ -20,15 +20,21 @@
 ;[:wishlist :int]
 ;["constraint fk_wish_wishlist foreign key(wishlist) references Wishlist(id) on delete cascade"])))

-(defn get-wishlist [{:keys [code]}] ; code is unique not null
+(defn get-wishlist-by-code [{:keys [code]}] ; code is unique not null
   (sql/with-connection db
-	(sql/with-query-results results
+    (sql/with-query-results results
       ["select * from wishlist where code=?" code]
+      (first (into [] results)))))
+
+(defn get-wishlist-by-id [{:keys [id]}]
+  (sql/with-connection db
+    (sql/with-query-results results
+      ["select * from wishlist where id=?" id]
       (first (into [] results)))))

 (defn insert-wishlist [wishlist]
   (sql/with-connection db
-	(sql/insert-records :wishlist wishlist)))
+    (sql/insert-records :wishlist wishlist)))

 (defn delete-wishlist [{:keys [code]}] ; code is unique not null
   (sql/with-connection db
@@ -37,13 +43,13 @@
 (defn update-wishlist [wishlist]
   (let [{:keys [id]} wishlist]
     (sql/with-connection db
-	  (sql/update-values :wishlist ["id=?" id] wishlist))))
+      (sql/update-values :wishlist ["id=?" id] wishlist))))

 (defn get-wishes-for-wishlist [{:keys [id]}]
   (sql/with-connection db
     (sql/with-query-results results
-	  ["select * from wish where wishlist=?" id]
-	  (into [] results))))
+      ["select * from wish where wishlist=?" id]
+      (into [] results))))

 (defn insert-wish [wish {:keys [id]}]
   (sql/with-connection db
@@ -56,4 +62,4 @@
 (defn update-wishlist [wish]
   (let [{:keys [id]} wish]
     (sql/with-connection db
-	  (sql/update-values :wish ["id=?" id] wish))))+      (sql/update-values :wish ["id=?" id] wish))))


Place holder default wishlist

Place holder default wishlist

--- src/wishlistd/views/wishlist.clj
+++ src/wishlistd/views/wishlist.clj
@@ -10,7 +10,7 @@
   (common/layout ""))

 (defn create-wishlist-json []
-  (let [wishlist (create-wishlist)]
+  (let [wishlist (create-wishlist {:title "Default"})] ; will in the future get a wishlist from the client
     (response/json wishlist)))

 (defn get-wishlist-json [code]


Remove streams/stdout

Remove streams/stdout

--- src/reimann/streams.clj
+++ src/reimann/streams.clj
@@ -298,12 +298,6 @@
   (fn [event]
     (dosync (ref-set reference event))))

-(defn stdout
-  "Prints an event to stdout"
-  [event]
-  (fn [event]
-    (prn event)))
-
 (defn fwd
   "Sends a map to a client, coerced to state"
   [client]


more funcs

more funcs

--- src/functions.clj
+++ src/functions.clj
@@ -24,12 +24,7 @@
 (def hundred-times
   (partial * 100))

-(defn total2 [price & qty]
+(defn total-price [price & qty]
   (apply * price qty))

-(total2 10 2 3)
-
-(def books {})
-
-(some
- (fn [b] :books > 5) books)
+(total-price 10 2 3)


adds help

adds help

--- src/gecf/core.clj
+++ src/gecf/core.clj
@@ -89,7 +89,7 @@
     (-> g min-max-flow first prn)))

 (defn prn-help []
-  (println "Gecf : compute k-edge conectedness of given graph
+  (println "Gecf : compute k-edge-conectedness of given graph

   --bidirectional  -b         consider input to be an undirected graph (default)
   --directed       -d         consider input to be a directed graph


Wrong formatting of ETH value at transactions screen on Android (#783)

--- src/status_im/i18n.cljs
+++ src/status_im/i18n.cljs
@@ -78,9 +78,13 @@
 (def delimeters
   "This function is a hack: mobile Safari doesn't support toLocaleString(), so we need to pass
   this map to WKWebView to make number formatting work."
-  (let [n (.toLocaleString (js/Number 1000.1))]
-    {:delimiter (subs n 1 2)
-     :separator (subs n 5 6)}))
+  (let [n          (.toLocaleString (js/Number 1000.1))
+        delimiter? (= (count n) 7)]
+    (if delimiter?
+      {:delimiter (subs n 1 2)
+       :separator (subs n 5 6)}
+      {:delimiter ""
+       :separator (subs n 4 5)})))

 (defn label-number [number]
   (when number


Renamed some ch vars.

Renamed some ch vars.

--- src/cbfg/fence.cljs
+++ src/cbfg/fence.cljs
@@ -79,13 +79,13 @@
        (+ x 2)))

 (defn test-range-to [actx s e delay]
-  (let [c (achan actx)]
+  (let [out (achan actx)]
     (ago test-range-to actx
          (doseq [n (range s e)]
            (<! (timeout delay))
-           (aput test-range-to c n))
-         (aclose test-range-to c))
-    c))
+           (aput test-range-to out n))
+         (aclose test-range-to out))
+    out))

 (defn test-helper [actx
                    in-ch-size
@@ -122,14 +122,14 @@
                        "FAIL")
                      %)
               [["test with 2 max-inflight-chs"
-                (let [ch (test-helper test 100 1 2 reqs)
-                      res (atake test ch)]
-                  (atake test ch)
+                (let [test-helper-out (test-helper test 100 1 2 reqs)
+                      res (atake test test-helper-out)]
+                  (atake test test-helper-out)
                   res)
                 '(6 3 12 40 41 42 43 44 11 11 6 7 8 0 1 9 32)]
                ["test with 200 max-inflight-chs"
-                (let [ch (test-helper test 100 1 200 reqs)
-                      res (atake test ch)]
-                  (atake test ch)
+                (let [test-helper-out (test-helper test 100 1 200 reqs)
+                      res (atake test test-helper-out)]
+                  (atake test test-helper-out)
                   res)
                 '(6 3 12 40 41 42 43 44 6 7 8 0 1 11 11 9 32)]]))))


syntax tweaks

syntax tweaks

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -139,7 +139,7 @@
   (om/component
     (apply dom/div #js {
       :className (str "grid" (when show-nums " show-nums"))
-      :style #js {:width grid-px :height grid-px}}
+      :style     #js {:width grid-px :height grid-px}}

       (map (partial cell app) cells))))

@@ -149,7 +149,7 @@
   (new-game! app size (:tick-ms @app)))

 (defn set-tick-ms! [app ms]
-  (om/update! app [:tick-ms] ms))
+  (om/update! app :tick-ms ms))

 (defn get-max-grid-px []
   (min (- js/innerWidth (* capture-size 1.2)) js/innerHeight))


upcoming-movies

upcoming-movies

Upcoming movies are saved as a map

--- src/cine/server.clj
+++ src/cine/server.clj
@@ -12,6 +12,11 @@
             [cine.core :as cine])
   (:gen-class))

+(defn http-get [url]
+  (let [c (a/chan)]
+    (http/get url #(a/put! c %))
+    c))
+
 (defn add-3d-info [mov]
   (if (.contains (str/lower-case (:name mov)) "3d")
     (assoc mov :3d true)
@@ -22,8 +27,10 @@
   [string x]
   (str/replace string x ""))

-(defn list-movies []
-  (->> (cine/mapify-current-movies)
+(defn list-movies
+  "Takes a list of current of upcoming movies and organizes them in a map."
+  [lst]
+  (->> lst
        (map add-3d-info)
        (map #(assoc % :name (-> (:name %)
                                 (strip-x "(3D)")
@@ -34,25 +41,30 @@
                                      (str/replace "  " " ")
                                      (str/replace " " "+"))))))

-(defn http-get [url]
-  (let [c (a/chan)]
-    (http/get url #(a/put! c %))
-    c))
+(defn list-current-movies []
+  (list-movies (cine/mapify-current-movies)))

-(time (let [chans (doall (for [x (list-movies)]
-                           (http-get (str "http://www.omdbapi.com/?t=" (:imdb-name x)))))]
-        (for [c chans]
-          (get (cheshire/parse-string (:body (<!! c))) "Title"))))
+(defn list-upcoming-movies []
+  (list-movies (cine/mapify-upcoming-movies)))
+
+(defn get-imdb-info [mov-name]
+  (http-get (str "http://www.omdbapi.com/?t=" mov-name)))

 (defn current-movie-list-handler [req]
   {:status 200
    :headers {"Content-type" "text"}
-   :body (cheshire/generate-string (cine/mapify-current-movies))})
+   :body (let [mov-list-chan (map #(assoc % :imdb-chan (get-imdb-info (:imdb-name %))) (list-current-movies))
+               mov-list (map #(do
+                                (assoc % :imdb-info (cheshire/parse-string (:body (<!! (:imdb-chan %)))))
+                                (dissoc % :imdb-chan)) mov-list-chan)]
+           (cheshire/generate-string mov-list))})
+

 (defn upcoming-movie-list-handler [req]
   {:status 200
    :headers {"Content-type" "text"}
-   :body (cheshire/generate-string (cine/get-upcoming-movies))})
+   :body (cheshire/generate-string (let [mov-list (list-upcoming-movies)]
+                                     (assoc mov-list :imdb-info (get-imdb-info mov-list))))})

 (defn cine-schedule-handler [req]
   {:status 200
@@ -74,5 +86,6 @@
   "Starting the immutant server"
   []
   (let [PORT (Integer/parseInt (or (System/getenv "PORT") "9003"))]  ;; getting PORT number form env-variable $PORT for deploying to heroku
-    (run app {:host "0.0.0.0" :port PORT})))
+    (run-dmc app {:host "0.0.0.0" :port PORT})))

+(-main)


Add factories for jline-based and repl-based read fns.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -25,34 +25,36 @@
   []
   (print "cli# "))

-(defn create-cli-repl-read-fn
+(defn create-jline-read-fn
   []
   (let [rdr (doto (ConsoleReader.))]
     (fn [request-prompt request-exit]
       (let [in-line (.readLine rdr)]
         (if (not (blank? in-line))
-          (let [split-in (split in-line #"\s")]
-            (if (symbol? (read-string (first split-in)))
-              (reduce (fn [v in-part] (conj v (read-string in-part))) [] split-in)
-              (read-string in-line))))))))
+          (reduce (fn [v in-part] (conj v (read-string in-part)))
+                  []
+                  (split in-line #"\s")))))))

-;  "The created read function is largely based on the exisiting repl read function:
-;   http://clojure.github.io/clojure/clojure.main-api.html#clojure.main/repl-read
-;   The main difference is that if the first argument on a line is a keyword,
-;   all elements on that line will be forwarded in a vector instead of being
-;   forwarded seperately."
-;  (fn [request-prompt request-exit]
-;    (or ({:line-start request-prompt :stream-end request-exit}
-;         (skip-whitespace *in*))
-;        (loop [v []]
-;          (let [input (read {:read-cond :allow} *in*)]
-;            (if (and (not (symbol? input)) (empty? v))
-;              (do
-;                (skip-if-eol *in*)
-;                input)
-;              (if (= :line-start (skip-whitespace *in*))
-;                (conj v input)
-;                (recur (conj v input)))))))))
+
+(defn create-repl-read-fn
+  []
+  "The created read function is largely based on the exisiting repl read function:
+   http://clojure.github.io/clojure/clojure.main-api.html#clojure.main/repl-read
+   The main difference is that if the first argument on a line is a keyword,
+   all elements on that line will be forwarded in a vector instead of being
+   forwarded seperately."
+  (fn [request-prompt request-exit]
+    (or ({:line-start request-prompt :stream-end request-exit}
+         (skip-whitespace *in*))
+        (loop [v []]
+          (let [input (read {:read-cond :allow} *in*)]
+            (if (and (not (symbol? input)) (empty? v))
+              (do
+                (skip-if-eol *in*)
+                input)
+              (if (= :line-start (skip-whitespace *in*))
+                (conj v input)
+                (recur (conj v input)))))))))

 (defn resolve-cmd-alias
   [input-cmd cmds]
@@ -63,7 +65,6 @@
 (defn create-cli-eval-fn
   [cmds allow-eval print-err]
   (fn [arg]
-;    (println "Eval arg:" arg)
     (if (and (vector? arg) (contains? cmds (keyword (first arg))))
       (let [cmd (resolve-cmd-alias (keyword (first arg)) cmds)]
         (try
@@ -113,7 +114,7 @@
    :print cli-repl-print
    :print-err print-err-fn
    :prompt cli-repl-prompt
-   :read-factory create-cli-repl-read-fn})
+   :read-factory create-jline-read-fn})

 (defn merge-options
   [defaults user-options mandatory-defaults]


Experimentally add gradle utils to detect-environment

--- src/cljast/core.clj
+++ src/cljast/core.clj
@@ -4,7 +4,7 @@
           (java.io File))
   (:require [clojure.string :as str]
             [clojure.java.io :refer [file]]
-             ))
+            [cljast.gradle :as gradle]))

 (def type-method "m")
 (def type-var "v")
@@ -39,6 +39,20 @@
         [(.getAbsolutePath java-home-jar)]
       (.exists (File. osx-java-core))
         [osx-java-core])))
+
+(defn detect-gradle-jars
+  "Attempt to locate jar dependencies from a gradle project"
+  [root-dir]
+  (let [gradle-file (file root-dir "build.gradle")]
+    (if (.exists gradle-file)
+      (if (= -1 (-> (slurp gradle-file) (.indexOf "android")))
+        ; not an android project; use the normal way
+        (->> root-dir
+             (gradle/project)
+             (gradle/get-dependencies))
+        ; android project... use the wacky fallback
+        (gradle/classpath root-dir)))
+    [])) ;; nothing

 (defn detect-project-root
   "Detect project root given a File"
@@ -81,11 +95,11 @@
   "Detect the classpath and sourcepath
   for a given file"
   [path]
-  (let [file (File. path)
-        unit (.getName file)
-        root (detect-project-root file)
+  (let [fpath (file path)
+        unit (.getName fpath)
+        root (detect-project-root fpath)
         srcs (detect-source-dirs root)]
-    [(concat (detect-java-core)) ; TODO add other jars
+    [(concat (detect-java-core) (detect-gradle-jars root)) ; TODO add other jars
      (map #(str % File/separator) srcs)
      (str/join (drop-last 5 unit))
      root]))


Fix error in batch tests

Fix error in batch tests

--- test/com/wsscode/pathom/connect_test.cljc
+++ test/com/wsscode/pathom/connect_test.cljc
@@ -1943,7 +1943,7 @@

          (is (= @errors {[:list
                           0
-                          :error-batch] "class clojure.lang.ExceptionInfo: Error - {}"
+                          :error-batch] "class clojure.lang.ExceptionInfo: Insufficient resolver output - {:com.wsscode.pathom.parser/response-value {:error-batch :com.wsscode.pathom.core/reader-error}, :key :error-batch}"
                          [:list
                           1
                           :error-batch] "class clojure.lang.ExceptionInfo: Error - {}"
@@ -2032,9 +2032,13 @@
                    :com.wsscode.pathom.trace/direction    :com.wsscode.pathom.trace/leave
                    :com.wsscode.pathom.trace/event        :com.wsscode.pathom.connect/call-resolver-batch
                    :key                                   :error-batch}
-                  {:com.wsscode.pathom.connect/sym error-batch
-                   :com.wsscode.pathom.core/path   [:list
-                                                    0
-                                                    :error-batch]
-                   :com.wsscode.pathom.trace/event :com.wsscode.pathom.connect/merge-resolver-response
-                   :key                            :error-batch}]))))))
+                  {:com.wsscode.pathom.core/path       [:list
+                                                        0
+                                                        :error-batch]
+                   :com.wsscode.pathom.trace/direction :com.wsscode.pathom.trace/enter
+                   :com.wsscode.pathom.trace/event     :com.wsscode.pathom.connect/compute-plan}
+                  {:com.wsscode.pathom.core/path       [:list
+                                                        0
+                                                        :error-batch]
+                   :com.wsscode.pathom.trace/direction :com.wsscode.pathom.trace/leave
+                   :com.wsscode.pathom.trace/event     :com.wsscode.pathom.connect/compute-plan}]))))))


checking in some comments that were made

--- src/irmgard/core.clj
+++ src/irmgard/core.clj
@@ -98,6 +98,13 @@
              (recur (exec-sql "SELECT * FROM irmgard.row_changes ORDER BY event_id LIMIT 100" [])))))
        (log/infof "did not get lock on irmgard.process_log, another process is working with the table."))
      :ok)))
+
+;; get lock, nowait
+;;   determine block SIZE=N
+;;   min id, max id in the block
+;;   group by table/schema
+;;   dispatch to all registerd listeners
+

 (defn dispatch-notifications [conf conn force-check-table?]
   ;; this select is purely for side-effect


support for $ via karras.sugar/matched

support for $ via karras.sugar/matched

--- src/karras/sugar.clj
+++ src/karras/sugar.clj
@@ -93,6 +93,9 @@
     {:$addToSet {field {:$each (cons value values)}}}
     {:$addToSet {field value}}))

+(defn matched "" [array-name & [field]]
+  (str (name array-name) ".$" (when field (str "." (name field)))))
+
 (defn sort-by-keys [keys maps]
   (sort (fn [x y]
           (first (remove #(= 0 %)


Open file at location with cli #1549

Open file at location with cli #1549

--- src/lt/objs/cli.cljs
+++ src/lt/objs/cli.cljs
@@ -3,6 +3,7 @@
             [lt.objs.app :as app]
             [lt.objs.files :as files]
             [lt.objs.workspace :as workspace]
+            [lt.objs.command :as cmd]
             [lt.util.load :refer [node-module]]
             [lt.util.cljs :refer [js->clj]]
             [clojure.string :as string]
@@ -26,13 +27,15 @@
       (js->clj :keywordize-keys true)))

 (defn open-paths [paths add?]
-  (doseq [path paths
+  (doseq [[path line] paths
           :when (not= path (.-execPath js/process))]
     (if (files/exists? path)
       (if (files/dir? path)
         (object/raise workspace/current-ws :add.folder! path)
         (do
           (object/raise opener/opener :open! path)
+          (when line
+            (cmd/exec! :goto-line line))
           (when add?
             (object/raise workspace/current-ws :add.file! path))))
       (object/raise opener/opener :new! path))))
@@ -57,28 +60,32 @@
 ;;*********************************************************

 (behavior ::open-on-args
-                  :triggers #{:post-init}
+                  :triggers #{:show}
                   :reaction (fn [this]
                               (when (args)
                                 (let [args-str (or (app/extract! (args-key (app/window-number)))
                                                    (first (app/args)))
                                       args (parse-args (rebuild-argv args-str))
-                                      paths (map #(files/resolve (:dir args) %) (filter valid-path? (:_ args)))
+                                      paths-line-no (map #(string/split (files/resolve (:dir args) %) #":")
+                                                         (filter valid-path? (:_ args)))
+                                      paths (map first paths-line-no)
                                       open-dir? (some files/dir? paths)]
                                   (when open-dir?
                                     (object/merge! workspace/current-ws {:initialized? true}))
-                                  (open-paths paths (:add args))))))
+                                  (open-paths paths-line-no (:add args))))))

 (behavior ::open!
                   :triggers #{:open!}
                   :reaction (fn [this path]
                               (when (= (app/fetch :focusedWindow) (app/window-number))
                                 (let [args (parse-args (rebuild-argv path))
-                                      paths (map #(files/resolve (:dir args) %) (filter valid-path? (:_ args)))
+                                      paths-line-no (map #(string/split (files/resolve (:dir args) %) #":")
+                                                         (filter valid-path? (:_ args)))
+                                      paths (map first paths-line-no)
                                       open-dir? (some files/dir? paths)]
                                   (if (or (:new args)
                                           (and open-dir? (not (:add args))))
                                     (let [winid (inc (app/fetch :window-id))]
                                       (app/store! (args-key winid) path)
                                       (app/open-window))
-                                    (open-paths paths (:add args)))))))
+                                    (open-paths paths-line-no (:add args)))))))


remove trailing whitespace

remove trailing whitespace

--- ring-core/test/ring/util/response_test.clj
+++ ring-core/test/ring/util/response_test.clj
@@ -13,9 +13,9 @@
      (try
         (.setContextClassLoader current-thread# new-loader#)
         ~@forms
-        (finally
+        (finally
           (.setContextClassLoader current-thread# original-loader#)))))
-
+
 (deftest test-redirect
   (is (= {:status 302 :headers {"Location" "http://google.com"} :body ""}
          (redirect "http://google.com"))))
@@ -42,14 +42,14 @@
   (let [resp (resource-response "response_test.clj" {:root "/ring/util"})]
     (is (.startsWith (slurp (resp :body))
                      "(ns ring.util.response-test"))))
-
+
 (deftest test-resource-with-child-classloader
   (let [resource (java.io.File/createTempFile "response_test" nil)]
-    (org.apache.commons.io.FileUtils/writeStringToFile resource "just testing")
+    (org.apache.commons.io.FileUtils/writeStringToFile resource "just testing")
     (with-classloader [(.getParentFile resource)]
       (let [resp (resource-response (.getName resource))]
         (is (= (slurp (resp :body))
               "just testing"))))))
-
+
 (deftest test-missing-resource
   (is (nil? (resource-response "/missing/resource.clj"))))


[CIRCLE-4417] Only display warning for current org (#1954)

* Only display warning for current org

* Change variable names for improved clarity

--- src-cljs/frontend/components/add_projects.cljs
+++ src-cljs/frontend/components/add_projects.cljs
@@ -10,6 +10,7 @@
             [frontend.components.pieces.org-picker :as org-picker]
             [frontend.components.pieces.tabs :as tabs]
             [frontend.components.pieces.spinner :refer [spinner]]
+            [frontend.models.organization :as org]
             [frontend.models.plan :as pm]
             [frontend.models.repo :as repo-model]
             [frontend.models.user :as user-model]
@@ -422,20 +423,32 @@
              (map (fn [repo] (om/build inaccessible-repo-item {:repo repo :settings settings}))
                   repos)])])))))

-(defn inaccessible-orgs-notice [follows settings]
-  (let [inaccessible-orgs (set (map :username follows))
-        follows-by-orgs (group-by :username follows)]
-    [:div.inaccessible-notice.card
-     [:h2 "Warning: Access Problems"]
-     [:p.missing-org-info
-      "You are following projects owned by GitHub organizations to which you don't currently have access. If an admin for the org recently enabled the new GitHub Third Party Application Access Restrictions for these organizations, you may need to enable CircleCI access for the orgs at "
-      [:a {:href (gh-utils/third-party-app-restrictions-url) :target "_blank"}
-       "GitHub's application permissions"]
-      "."]
-     [:div.inaccessible-org-wrapper
-      (map (fn [org-follows] (om/build inaccessible-org-item
-                                       {:org-name (:username (first org-follows)) :repos org-follows :settings settings}))
-           (vals follows-by-orgs))]]))
+(defn- inaccessible-orgs-notice-body
+  [inaccessible-orgs follows-by-orgs settings]
+  [:div.inaccessible-notice.card
+   [:h2 "Warning: Access Problems"]
+   [:p.missing-org-info
+    "You are following projects owned by GitHub organizations to which you don't currently have access. If an admin for the org recently enabled the new GitHub Third Party Application Access Restrictions for these organizations, you may need to enable CircleCI access for the orgs at "
+    [:a {:href (gh-utils/third-party-app-restrictions-url) :target "_blank"}
+     "GitHub's application permissions"]
+    "."]
+   [:div.inaccessible-org-wrapper
+    (for [follows-by-org (vals follows-by-orgs)]
+      (let [org-name (->> follows-by-org first :username)]
+        (when (contains? inaccessible-orgs org-name)
+          (om/build inaccessible-org-item
+            {:org-name org-name :repos follows-by-org :settings settings}))))]])
+
+(defn inaccessible-orgs-notice [inaccessible-followed-projects settings selected-org-name]
+  "Note: These functions historically do not take vcs-type into account
+         This may become an issue in future as users have the same
+         name organization under different vcs-providers"
+  (let [inaccessible-orgs (set (map :username inaccessible-followed-projects))
+        followed-projects-by-org (group-by :username inaccessible-followed-projects)]
+    (if (ld/feature-on? "top-bar-ui-v-1")
+      (when (contains? inaccessible-orgs selected-org-name)
+        (inaccessible-orgs-notice-body #{selected-org-name} followed-projects-by-org settings))
+      (inaccessible-orgs-notice-body inaccessible-orgs followed-projects-by-org settings))))

 (defn- org-picker [{:keys [orgs user selected-org tab]} owner]
   (reify
@@ -517,17 +530,19 @@
         settings (:settings data)
         {{tab :tab} :navigation-data} data
         selected-org (get-in settings [:add-projects :selected-org])
-        followed-inaccessible (inaccessible-follows user
-                                                    (get-in data state/projects-path))]
+        inaccessible-followed-projects (inaccessible-follows user
+                                                             (get-in data state/projects-path))]
     (html
      [:div#add-projects
       (when (seq (user-model/missing-scopes user))
         (missing-scopes-notice (user-model/current-scopes user)
                                (user-model/missing-scopes user)))
-      (when (and (seq followed-inaccessible)
+      (when (and (seq inaccessible-followed-projects)
                  (not (loading-repos-for-vcs-type? user :github))
                  (not (loading-repos-for-vcs-type? user :bitbucket)))
-        (inaccessible-orgs-notice followed-inaccessible settings))
+        (inaccessible-orgs-notice inaccessible-followed-projects settings (-> data
+                                                                              (get-in state/selected-org-path)
+                                                                              org/name)))
       [:.text-card
        (card/titled
          {:title "CircleCI helps you ship better code, faster. Let's add some projects on CircleCI."}


Hide notice while submitting.

Hide notice while submitting.

--- src-cljs/frontend/components/contact_form.cljs
+++ src-cljs/frontend/components/contact_form.cljs
@@ -134,19 +134,19 @@
                                   filtered-params (params-filter params)
                                   valid? (fn [f] (every? #(.checkValidity %) (.-elements f)))]
                               (if (not (valid? form))
-                                (om/set-state! owner [:show-validations?] true)
+                                (om/set-state! owner :show-validations? true)
                                 (do
-                                  (om/set-state! owner [:show-validations?] false)
-                                  (om/set-state! owner [:loading?] true)
+                                  (om/update-state! owner #(merge % {:notice nil
+                                                                     :show-validations? false
+                                                                     :loading? false}))
                                   (go (let [resp (<! (ajax/managed-form-post
                                                        action
                                                        :params filtered-params))]
-                                        (om/set-state! owner [:loading?] false)
+                                        (om/set-state! owner :loading? false)
                                         (if (= (:status resp) :success)
                                           (do
-                                            (om/set-state! owner [:notice] nil)
                                             (.reset form))
-                                          (om/set-state! owner [:notice] {:type "error" :message "Sorry! There was an error sending your message."}))))))))})
+                                          (om/set-state! owner :notice {:type "error" :message "Sorry! There was an error sending your message."}))))))))})

             (let [control
                   (fn [constructor props]


Adding commas to build minute usage numbers.

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -970,8 +970,8 @@
           [:div.usage-label
            (when (>= percent 100) {:class "over-usage"})
            [:div.percent-label (str percent "%")]
-           [:div usage]
-           [:div (str "/" max " minutes")]]])))))
+           [:div (.toLocaleString usage)]
+           [:div (str "/" (.toLocaleString max) " minutes")]]])))))

 (defn usage-key->date [usage-key]
   (time-format/parse (time-format/formatter "yyyy_MM") (name usage-key)))


Fix action-button call in devcard

Fix action-button call in devcard

--- src-cljs/frontend/components/pieces/table.cljs
+++ src-cljs/frontend/components/pieces/table.cljs
@@ -83,8 +83,9 @@
                                    {:type :shrink
                                     :cell-fn (fn [beatle]
                                                (action-button
-                                                #(js/alert (str "You may not remove " (:name beatle) " from the band."))
-                                                "X"))}]})))
+                                                "Remove"
+                                                "X"
+                                                #(js/alert (str "You may not remove " (:name beatle) " from the band."))))}]})))

   (defcard-om table
     table-parent))


actually try the out the task

actually try the out the task

--- src/matross/core.clj
+++ src/matross/core.clj
@@ -3,6 +3,8 @@
             [me.raynes.fs :as fs]
             [matross.connections.default :refer [debug-process]]
             [matross.connections.core :refer [connect disconnect run sudo-runner]]
+            [matross.tasks.core :refer [get-module exec]]
+            [matross.tasks.command]
             [matross.model.core :as model])
   (:gen-class))

@@ -36,15 +38,14 @@
       (-> console (.readPassword padded-prompt nil) String/valueOf)
       (throw (Exception. "Could not find system console.")))))

-(defn test-run-connection! [conn test-command pass]
+(defn test-run-connection! [conn module conf pass]
   (connect conn)
   (let [conn (if pass (sudo-runner conn "root" pass) conn)]
-    (let [{exit :exit :as result} (run conn {:cmd test-command})]
+    (let [{exit :exit :as result} (exec module {:remote conn} conf)]
       (debug-process result)))
   (disconnect conn))

 (defn -main [& args]
-  (println "INVOKING MAIN")
   (load-plugins!)
   (let [opts (parse-opts args cli-opts)
         {:keys [connections]} (model/prepare config)
@@ -52,5 +53,7 @@
                    (get-sensitive-user-input "Sudo Password"))]
     (if (get-in opts [:options :help])
       (prn "matross!")
-      (doseq [c connections] (test-run-connection! c ["whoami"] password)))
+      (let [m (get-module :command)
+            cmd {:env {:HERP "value"} :command "echo $HERP"}]
+      (doseq [c connections] (test-run-connection! c m cmd password))))
     (shutdown-agents)))


Tests for following API calls: enable job, disable job, start job, stop job

--- test/emender_jenkins/jenkins_api_test.clj
+++ test/emender_jenkins/jenkins_api_test.clj
@@ -84,3 +84,27 @@
         (is (callable? 'emender-jenkins.jenkins-api/error-response-structure))))

+(deftest test-start-job-existence
+    "Check that the emender-jenkins.jenkins-api/start-job definition exists."
+    (testing "if the emender-jenkins.jenkins-api/start-job definition exists."
+        (is (callable? 'emender-jenkins.jenkins-api/start-job))))
+
+
+(deftest test-enable-job-existence
+    "Check that the emender-jenkins.jenkins-api/enable-job definition exists."
+    (testing "if the emender-jenkins.jenkins-api/enable-job definition exists."
+        (is (callable? 'emender-jenkins.jenkins-api/enable-job))))
+
+
+(deftest test-disable-job-existence
+    "Check that the emender-jenkins.jenkins-api/disable-job definition exists."
+    (testing "if the emender-jenkins.jenkins-api/disable-job definition exists."
+        (is (callable? 'emender-jenkins.jenkins-api/disable-job))))
+
+
+(deftest test-delete-job-existence
+    "Check that the emender-jenkins.jenkins-api/delete-job definition exists."
+    (testing "if the emender-jenkins.jenkins-api/delete-job definition exists."
+        (is (callable? 'emender-jenkins.jenkins-api/delete-job))))
+
+


Uncomment :android-common and :android-user profiles by default

--- res/templates/project.clj
+++ res/templates/project.clj
@@ -16,14 +16,14 @@
   :profiles {:default [:dev]

              :dev
-             [;; :android-common :android-user
+             [:android-common :android-user
               {:dependencies [[org.clojure-android/tools.nrepl "0.2.6"]]
                :target-path "target/debug"
                :android {:aot :all-with-unused
                          :rename-manifest-package "{{package-sanitized}}.debug"
                          :manifest-options {:app-name "{{app-name}} - debug"}}}]
              :release
-             [;; :android-common
+             [:android-common
               {:target-path "target/release"
                :android
                { ;; Specify the path to your private keystore


added docstring to vector->hash-map

added docstring to vector->hash-map

--- src/moomoo/utils.clj
+++ src/moomoo/utils.clj
@@ -3,6 +3,9 @@
 (defn uuid [] (str (java.util.UUID/randomUUID)))

 (defn vector->hash-map [v]
+  "Converts a vector to a hash-map like so:
+   [\"a\" \"b\" :c 1] -> {:a \"b\", :c 1}.
+   Assumes an even number of elements."
   (apply hash-map (map-indexed #(if (even? %1)
                                   (keyword %2)
                                   %2)


Scrubbed old hiccup generation route remnants, and (finally\!) solved the charset issue with the live development server. I was mistakenly trying to apply a response function rather than a handler (which wrapped the fn) to set the charset to UTF-8 by default. Now that that's done, the curly-quotes, ellipses and other characters smartypants swaps in are displayed properly in the live development workflow (they were working properly in the deployed content already).

--- src/omhome/ssgen.clj
+++ src/omhome/ssgen.clj
@@ -1,5 +1,6 @@
 (ns omhome.ssgen
   (:require [stasis.core :as stasis]
+            [ring.middleware.default-charset :refer [wrap-default-charset]]
             [hiccup.page :refer [html5]]
             [me.raynes.cegdown :as md]
             [omhome.highlight :refer [highlight-code-blocks]]
@@ -28,7 +29,7 @@
   ([req page options]
    (html5
      [:head
-      [:meta {:http-equiv "Content-Type" :content "text/html; charset=UTF-8"}]
+      [:meta {:charset "UTF-8"}]
       [:meta {:name    "viewport"
               :content "width=device-width, initial-scale=1.0"}]
       (if (:title options)
@@ -51,22 +52,13 @@
 (defn meta-post->page-loc
   "Convert a meta-post to a pair of a HTML page and a URI fragment. See omhome.meta-post/empty-post for a default post structure."
   [meta-post]
-  [(-> meta-post :post-url
-       ;; File. .getAbsolutePath
-       ;; (str/replace  #"\.clj$" "/")
-       ) ;; Stasis' page map requires absolute paths to files
+  [(meta-post :post-url)
    (fn [req] (layout-page req (read-string (slurp (:post-filepath meta-post))) meta-post))])

 (defn meta-posts->page-map
   "Convert a vector of meta-posts into a map of URI fragment and HTML page pairs, suitable for inclusion in Stasis' page map."
   [meta-posts]
   (into {} (map meta-post->page-loc meta-posts)))
-
-(defn hiccup->pages
-  "Generate HTML pages from the supplied Hiccup fragments."
-  [hiccup-content]
-  (zipmap (map  #(str/replace % #"\.clj$" "/") (keys hiccup-content))
-          (map #(fn [req] (layout-page req (-> % read-string ))) (vals hiccup-content))))

 ;; rework the stasis map of filenames to source content created using markdown to use paths and html
 (defn markdown->pages [markdown-content]
@@ -76,10 +68,9 @@

 (defn get-basic-pages []
   (stasis/merge-page-sources
-   {:templated-pages (content->pages (stasis/slurp-directory "resources/fragments" #".*\.html$"))
+   {:templated-pages (content->pages (stasis/slurp-directory "resources/fragments" #".*\.html$" :encoding "UTF-8"))
     :templated-hiccup (meta-posts->page-map posts)
-     ;; :templated-js-pages (js-content->pages (stasis/slurp-directory "resources/cljspages" #".*\.html$"))
-     :markdown-pages (markdown->pages (stasis/slurp-directory "resources/markdown" #".*\.md$"))}))
+    :markdown-pages (markdown->pages (stasis/slurp-directory "resources/markdown" #".*\.md$" :encoding "UTF-8"))}))

 (defn prepare-page [page req]
   (-> (if (string? page) page (page req))
@@ -93,10 +84,9 @@
   (prepare-pages (get-basic-pages)))

 (def app
-  (optimus/wrap (stasis/serve-pages final-pages)
-                get-assets
-                optimisations/all
-                serve-live-assets))
+  (-> (stasis/serve-pages final-pages)
+      (optimus/wrap get-assets optimisations/none serve-live-assets)
+      (wrap-default-charset "UTF-8")))

 (def export-dir "dist")


Fix directional madness

Fix directional madness

--- src/physim/core.cljs
+++ src/physim/core.cljs
@@ -140,19 +140,19 @@
     (let [pa (nth @particles a)
           pb (nth @particles b)]
       (when (and (not= a b) (collided? pa pb))
-        (let [dir (direction-from (:pos pb) (:pos pa))
+        (let [dir (direction-from (:pos pa) (:pos pb))
               dist (distance (:pos pa) (:pos pb))
               bounce (direction dir (- particle-diameter dist))]
           (swap! particles
                  assoc
                  a (assoc pa
-                     :pos (map + (:pos pa) bounce)
-                     :vel (map +
+                     :pos (map - (:pos pa) bounce)
+                     :vel (map -
                                (:vel pa)
                                (direction dir (magnitude (:vel pa)))))
                  b (assoc pb
-                     :pos (map - (:pos pb) bounce)
-                     :vel (map -
+                     :pos (map + (:pos pb) bounce)
+                     :vel (map +
                                (:vel pb)
                                (direction dir (magnitude (:vel pb)))))))))))


WIP user input, including fancy input interval stuff.

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -154,16 +154,18 @@
                 :gt [(.max js/Math (+ rhs time-unit) min-t) Infinity])))))

 (defn guard-interval [has ha g]
-  (case (first g)
-    :and (let [intervals (map #(guard-interval has ha %) (rest g))
-               interval (intersect-all intervals)]
-           #_(println "AND" g intervals "->" interval)
-           interval)
-    :or (let [intervals (map #(guard-interval has ha %) (rest g))
-              interval (union-all intervals)]
-          #_(println "OR" g intervals "->" interval)
-          interval)
-    (simple-interval has ha g)))
+  (if (not g)
+    [(:entry-time ha) Infinity]
+    (case (first g)
+      :and (let [intervals (map #(guard-interval has ha %) (rest g))
+                 interval (intersect-all intervals)]
+             #_(println "AND" g intervals "->" interval)
+             interval)
+      :or (let [intervals (map #(guard-interval has ha %) (rest g))
+                interval (union-all intervals)]
+            #_(println "OR" g intervals "->" interval)
+            interval)
+      (simple-interval has ha g))))

 (defn transition-interval [has ha transition]
   #_(println "Transition" (:id ha) "et" (:entry-time ha) (:target transition) (:guard transition))
@@ -204,11 +206,11 @@
         ha (assoc-in ha [:upcoming-transitions index] transition)]
     #_(println "recalc" (:id ha) index)
     #_(println "REQS" (:id ha) (:entry-time ha) #_transition
-             (sort compare-transition-start
-                   (filter #(and
-                             (contains? (get-in % [:transition :label]) :required)
-                             (not (iv/empty-interval? (:interval %))))
-                           (:upcoming-transitions ha))))
+               (sort compare-transition-start
+                     (filter #(and
+                               (contains? (get-in % [:transition :label]) :required)
+                               (not (iv/empty-interval? (:interval %))))
+                             (:upcoming-transitions ha))))
     (if (contains? (get-in transition [:transition :label]) :required)
       (assoc ha :required-transitions (sort compare-transition-start
                                             (filter #(and
@@ -259,10 +261,11 @@
          (zipmap (map :id states) states)))

 (defn guard? [g]
-  (and (vector? g)
-       (case (first g)
-         (:gt :geq :leq :lt) (or (= (count g) 3) (= (count g) 4))
-         (:and :or) (every? guard? (rest g)))))
+  (or (nil? g)
+      (and (vector? g)
+           (case (first g)
+             (:gt :geq :leq :lt) (or (= (count g) 3) (= (count g) 4))
+             (:and :or) (every? guard? (rest g))))))

 ; edge label is a set containing :required | button masks
 (defn make-edge [target guard label]
@@ -282,9 +285,19 @@
     ; invariant is a disjunction of negated guards
     {:id id :flows flows :edges edges}))

-(defn valid-for-inputs [transition inputs]
-  ;todo: some :inputs label in transition's label must be a subset of inputs
-  false)
+(defn intersect-input-intervals [transition inputs]
+  (let [label (get-in transition [:transition :label])
+        interval (:interval transition)
+        ; for each button, intersect its interval with the transition to find the intervals during which each
+        ; button is pressed. The result is an interval during which any of the given buttons is pressed.
+        ; then take the intersection of those per-button intervals to find the intervals during which
+        ; all the indicated buttons are pressed.
+        on (intersect-all (map #(iv/intersection (get inputs %) interval) (some #(= (first %) :on) label)))
+        ; for off, we want no buttons from off to be active during on. so we don't do the final intersection!
+        off (map #(iv/intersection (get inputs %) on) (some #(= (first %) :off) label))]
+    (if (iv/empty-interval? off)
+      (assoc transition :interval on)
+      [Infinity Infinity])))

 (defn next-transition [_has ha then inputs]
   (let [reqs (:required-transitions ha)
@@ -299,11 +312,12 @@
         ; opts on the other hand must be filtered and sliced into range
         ; todo: simplify
         [min-opt-t opts] (reduce (fn [[min-t trs] {intvl :interval :as trans}]
-                                   (let [intvl (iv/intersection intvl [then Infinity])
+                                   (let [intvl (iv/intersection (:interval trans) [then Infinity])
+                                         trans (intersect-input-intervals (assoc trans :interval intvl) inputs)
+                                         intvl (:interval trans)
                                          [start end] (iv/first-subinterval intvl)]
-                                     ; ignore invalid...
+                                     ; ignore impossible...
                                      (if (or (iv/empty-interval? intvl)
-                                             (not (valid-for-inputs trans inputs))
                                              ; already-past...
                                              (<= end then)
                                              ; and too-far-in-the-future transitions
@@ -538,6 +552,20 @@
                        [:gt :y (+ oy oh)]])))
                 (concat walls others)))))

+(defn negate-guard [g]
+  (case (first g)
+    :and (apply vector :or (map negate-guard (rest g)))
+    :or (apply vector :and (map negate-guard (rest g)))
+    :gt (apply vector :leq (rest g))
+    :geq (apply vector :lt (rest g))
+    :leq (apply vector :gt (rest g))
+    :lt (apply vector :geq (rest g))))
+
+(defn non-bumping-guard [dir walls others]
+  (negate-guard
+    (apply vector :or (map (fn [o] (bumping-guard dir o))
+                           (concat walls others)))))
+
 (defn goomba [id x y speed state others walls]
   (let [others (disj others id)
         fall-speed 16]
@@ -577,39 +605,159 @@
                (bumping-transitions id :right :falling-right nil walls others)
                (bumping-transitions id :top :left nil walls others)))))

-(defn make-scene-a [x] (let [ids #{:ga :gb :gc #_:gd :ge}
-                             walls #{[0 0 164 8]
-                                     [0 8 8 16]
-                                     [96 8 8 16]
-                                     [160 8 8 16]
-                                     ;todo: a "waterfall staircase" for goomba fall testing.
-                                     }
-                             objects [(goomba :ga x 8 16 :right ids walls)
-                                      (goomba :gb (+ x 24) 8 16 :left ids walls)
-                                      (goomba :gc 11 25 16 :falling-left ids walls)
-                                      #_(goomba :gd (+ x 58) 8 16 :left ids walls)
-                                      (goomba :ge (+ x 88) 32 16 :right ids walls)
-                                      ; TODO: goomba falling off of platforms. add a "staircase" to the right.
-                                      ; TODO: mario jumper
-                                      ]
-                             obj-ids (map :id objects)
-                             obj-dict (zipmap obj-ids objects)
-                             ; got to let every HA enter its current (initial) state to set up state invariants like
-                             ; pending required and optional transitions
-                             obj-dict (zipmap obj-ids (map #(enter-state obj-dict % (:state %) 0) objects))]
-                         {:now             0
-                          :then            0
-                          :playing         false
-                          :pause-on-change false
-                          :objects         obj-dict
-                          :walls           walls}))
-(defn reset-scene-a! []
-  (swap! scene-a (fn [_]
-                   (make-scene-a 8))))
+(defn mario [id x y others walls]
+  (let [others (disj others id)
+        fall-speed 16
+        move-speed 24]
+    (make-ha id
+             {:x     x :y y
+              :w     16 :h 16
+              :state :idle-right}
+             (make-state
+               :idle-right
+               {}
+               (make-edge
+                 :moving-right
+                 (non-bumping-guard :left walls others)
+                 #{[:on #{:right}]})
+               (make-edge
+                 :moving-left
+                 (non-bumping-guard :right walls others)
+                 #{[:on #{:left}]}))
+             (make-state
+               :idle-left
+               {}
+               (make-edge
+                 :moving-right
+                 (non-bumping-guard :left walls others)
+                 #{[:on #{:right}]})
+               (make-edge
+                 :moving-left
+                 (non-bumping-guard :right walls others)
+                 #{[:on #{:left}]}))
+             (make-state
+               :moving-right
+               {:x move-speed}
+               (make-edge
+                 :idle-right
+                 nil
+                 #{[:off #{:right}]}))
+             (make-state
+               :moving-left
+               {:x (- move-speed)}
+               (make-edge
+                 :idle-left
+                 nil
+                 #{[:off #{:left}]})))))
+
+(defn make-scene-a [] (let [ids #{:ga :gb :gc :gd :ge :m}
+                            walls #{[0 0 256 8]
+                                    [0 8 8 16]
+                                    [96 8 8 16]
+                                    [160 8 8 16]}
+                            objects [(goomba :ga 8 8 16 :right ids walls)
+                                     (goomba :gb 32 8 16 :left ids walls)
+                                     (goomba :gc 11 25 16 :falling-left ids walls)
+                                     (goomba :gd 64 8 16 :left ids walls)
+                                     (goomba :ge 96 32 16 :right ids walls)
+                                     (mario :m 200 8 ids walls)]
+                            obj-ids (map :id objects)
+                            obj-dict (zipmap obj-ids objects)
+                            ; got to let every HA enter its current (initial) state to set up state invariants like
+                            ; pending required and optional transitions
+                            obj-dict (zipmap obj-ids (map #(enter-state obj-dict % (:state %) 0) objects))]
+                        {:now             0
+                         :then            0
+                         :playing         false
+                         :pause-on-change false
+                         :objects         obj-dict
+                         :walls           walls}))

 (defn ha-states [scene]
   (let [has (sort-by :id (vals (:objects scene)))]
     (map (fn [ha] [(:id ha) (:state ha)]) has)))
+
+(def key-history (atom [{:time     0
+                         :on       #{}
+                         :pressed  #{}
+                         :released #{}}]))
+
+(def key-intervals (atom {}))
+
+(defn reset-scene-a! []
+  (swap! key-history (fn [_] [{:time 0 :on #{} :pressed #{} :released #{}}]))
+  (swap! key-intervals (fn [_] {}))
+  (swap! scene-a (fn [_]
+                   (make-scene-a))))
+
+(def keycode->keyname
+  {37 :left
+   39 :right
+   38 :up
+   40 :down
+   90 :run
+   88 :jump})
+
+#_(defn binary-search-posn-by [coll key val l r depth]
+    (assert (<= depth 1000))
+    (let [len (- r l)]
+      (if (= len 0)
+        l
+        (let [mid (+ l (.floor js/Math (/ len 2)))
+              mid-val (key (get coll mid))]
+          (cond
+            (= val mid-val) mid
+            (< val mid-val) (binary-search-posn-by coll key val l mid (inc depth))
+            (> val mid-val) (binary-search-posn-by coll key val (inc mid) r (inc depth))
+            :else (assert false))))))
+
+#_(defn key-status-at [history t]
+    (let [found-index (binary-search-posn-by history :time t 0 (dec (count history)) 0)
+          found (nth history found-index nil)]
+      (cond
+        (nil? found) (last history)
+        (> (:time found) t) nil
+        :else found)))
+
+(defn key-handler [evt]
+  (.preventDefault evt)
+  (.-stopPropagation evt)
+  (let [now (floor-time (:now @scene-a) time-unit)
+        key (keycode->keyname (.-keyCode evt))
+        down? (= (.-type evt) "keydown")]
+    #_(println "KH" (.-keyCode evt) key down?)
+    (swap! key-history (fn [ks]
+                         ; todo: clear the history sometimes?
+                         (let [prev-on (:on (last ks))
+                               prev-time (:time (last ks))
+                               ; add a new entry if necessary
+                               ks (if (> now prev-time)
+                                    (conj ks {:time now :on prev-on :pressed #{} :released #{}})
+                                    ks)]
+                           (assert (>= now prev-time))
+                           (update ks (dec (count ks))
+                                   (fn [{prev-on :on pressed :pressed released :released :as k}]
+                                     ; need the extra contains? check so key-repeat doesn't confuse things.
+                                     (let [just-pressed? (and down?
+                                                              (not (contains? prev-on key)))]
+                                       (when (or just-pressed?
+                                                 (not down?))
+                                         (swap! key-intervals update key
+                                                (if down?
+                                                  (fn [old-kis]
+                                                    (conj old-kis [now Infinity]))
+                                                  (fn [old-kis]
+                                                    (update-in old-kis [(dec (count old-kis)) 1]
+                                                               (fn [_] now))))))
+                                       (assoc k :on (if down? (conj prev-on key)
+                                                              (disj prev-on key))
+                                                :pressed (if just-pressed?
+                                                           (conj pressed key)
+                                                           pressed)
+                                                :released (if down? released (conj released key)))))))))))
+
+(set! (.-onkeydown js/window) key-handler)
+(set! (.-onkeyup js/window) key-handler)

 (defn tick-frame [t]
   (when-not last-time (set! last-time t))
@@ -619,9 +767,10 @@
     (.requestAnimationFrame js/window tick-frame)
     (when (:playing @scene-a)
       (swap! scene-a
-             (fn [s] (let [new-s (update-scene s
-                                               (+ (:now s) (/ (- t old-last-time) 1000))
-                                               #{[(floor-time (:now s) time-unit) #{}]}
+             (fn [s] (let [new-now (+ (:now s) (/ (- t old-last-time) 1000))
+                           new-s (update-scene s
+                                               new-now
+                                               key-intervals
                                                0)]
                        (if (and (:pause-on-change new-s)
                                 (not= (ha-states s) (ha-states new-s)))
@@ -706,7 +855,6 @@
                                                    :borderRadius    (str (* scale w) "px")
                                                    :backgroundColor "rgba(165,42,42,0.5)"
                                                    :position        "absolute"
-                                                   :color           "white"
                                                    :left            (str sx "px")
                                                    :bottom          (str sy "px")}}]))
                                 [(first (:required-transitions ha))])]))
@@ -724,7 +872,7 @@
                                       :borderRadius    (str (* scale w) "px")
                                       :backgroundColor "brown"
                                       :position        "absolute"
-                                      :color           "white"
+                                      :color           "lightgray"
                                       :left            (str (* scale x) "px")
                                       :bottom          (str (* scale y) "px")}}
                         (str (:id ha) " " (:state ha))]])


wording tweak for no orthologues returned error

--- src/cljs/gointermod/orthologresults/views.cljs
+++ src/cljs/gointermod/orthologresults/views.cljs
@@ -53,7 +53,7 @@
         (cond (empty? organism-details)
           [:tr {:class (clj->js organism)}
             [:td][:td (utils/get-abbrev organism)]
-            [:td {:col-span 6} "No orthologs returned"]]
+            [:td {:col-span 6} "No known orthologs for the provided gene(s)."]]
 )) @results))))

 (defn csv-body


test fn arity inference, add a few more lib cases

--- test/clj/cljs/analyzer_tests.clj
+++ test/clj/cljs/analyzer_tests.clj
@@ -77,7 +77,42 @@
            (:tag (a/analyze test-env '(if true "foo" 1))))
          '#{number string})))

+(deftest fn-inference
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env
+                   '(let [x (fn ([a] 1) ([a b] "foo") ([a b & r] ()))]
+                      (x :one)))))
+        'number))
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env
+                   '(let [x (fn ([a] 1) ([a b] "foo") ([a b & r] ()))]
+                      (x :one :two)))))
+        'string))
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env
+                   '(let [x (fn ([a] 1) ([a b] "foo") ([a b & r] ()))]
+                      (x :one :two :three)))))
+        'cljs.core/IList)))
+
 (deftest lib-inference
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env '(+ 1 2))))
+         'number))
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env '(alength (array)))))
+         'number))
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env '(aclone (array)))))
+         'array))
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env '(count [1 2 3]))))
+         'number))
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env '(into-array [1 2 3]))))
+         'array))
+  (is (= (e/with-compiler-env test-cenv
+           (:tag (a/analyze test-env '(js-obj))))
+         'object))
   (is (= (e/with-compiler-env test-cenv
            (:tag (a/analyze test-env '(-conj [] 1))))
          'clj))


Improve format-specifiers? tests and impl

--- test/comic_reader/sites_test.clj
+++ test/comic_reader/sites_test.clj
@@ -114,23 +114,35 @@
                    chapter-link-url-normalize))

 (defn format-specifiers? [fmt specs]
-  (loop [m (re-matcher (re-pattern (first specs)) fmt)
-         specs (rest specs)]
-    (if (.find m)
-      (if (seq specs)
-        (recur (.usePattern m (re-pattern (first specs)))
-               (rest specs))
-        true)
-      false)))
+  (let [intermediate-matcher (re-matcher #"%[^%]" fmt)]
+    (if (seq specs)
+      (loop [m (re-matcher (re-pattern (first specs)) fmt)
+             specs (rest specs)
+             start 0]
+        (if (.find m)
+          (let [end (.start m)]
+            (.region intermediate-matcher start end)
+            (if (.find intermediate-matcher)
+              false
+              (if (seq specs)
+                (recur (.usePattern m (re-pattern (first specs)))
+                       (rest specs)
+                       (.end m))
+                true)))
+          false))
+      (not (.find intermediate-matcher)))))

 (def #^{:macro true} has #'is)

 (deftest test-format-specifiers?
+  (has (format-specifiers? "abc euth123 ][908" []))
   (has (format-specifiers? "%s" ["%s"]))
   (has (format-specifiers? "abc%s %def %y" ["%s" "%d" "%y"]))

+  (has (not (format-specifiers? "%d" [])))
   (has (not (format-specifiers? "%d" ["%s"])))
   (has (not (format-specifiers? "%s%d" ["%s" "%f"])))
+  (has (not (format-specifiers? "%sabc%d" ["%d"])))
   (has (not (format-specifiers? "%sabc%d" ["%d" "%s"]))))

 (defn test-format-strings []


All Clojure demo at once

All Clojure demo at once

--- Clojure/src/com/yourtion/PatternDemo/example.clj
+++ Clojure/src/com/yourtion/PatternDemo/example.clj
@@ -1,7 +1,154 @@
 (ns com.yourtion.PatternDemo.example
+  (:require [com.yourtion.Pattern01.person-example-ex :as p011])
+  (:require [com.yourtion.Pattern01.person-example-ex :as p012])
+  (:require [com.yourtion.Pattern02.person-example-cc :as p02])
+  (:require [com.yourtion.Pattern03.cash-register :as p03])
+  (:require [com.yourtion.Pattern04.person :as p04])
+  (:require [com.yourtion.Pattern05.higher-order-functions :as p051])
+  (:require [com.yourtion.Pattern05.lambda-bar-and-grille :as p052])
+  (:require [com.yourtion.Pattern06.grade-reporter :as p06])
+  (:require [com.yourtion.Pattern07.people-collector-example :as p07])
+  (:require [com.yourtion.Pattern08.person-example :as p08])
+  (:require [com.yourtion.Pattern09.calculator-example :as p09])
+  (:require [com.yourtion.Pattern10.visitor-example :as p10])
+  (:require [com.yourtion.Pattern11.services :as p11])
+  (:require [com.yourtion.Pattern12.names :as p12])
+  (:require [com.yourtion.Pattern13.mutual-recursion-example :as p13])
+  (:require [com.yourtion.Pattern14.discount-example :as p14])
+  (:require [com.yourtion.Pattern15.chain-example :as p15])
+  (:require [com.yourtion.Pattern16.composition-examples :as p16])
+  (:require [com.yourtion.Pattern17.memoization-example :as p17])
+  (:require [com.yourtion.Pattern18.lazy-sequence-example :as p18])
+  (:require [com.yourtion.Pattern19.focused-mutation-example :as p19])
+  (:require [com.yourtion.Pattern20.flow-control-example :as p20])
   (:require [com.yourtion.Pattern21.dsl-example :as p21]))

-(println "DSL Example: ")
+
+(println)
+(println "Pattern01 Example: ")
+(println)
+(p011/run)
+(p012/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern02 Example: ")
+(println)
+(p02/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern03 Example: ")
+(println)
+(p03/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern04 Example: ")
+(println)
+(p04/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern05 Example: ")
+(println)
+(p051/run)
+(p052/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern06 Example: ")
+(println)
+(p06/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern07 Example: ")
+(println)
+(p07/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern08 Example: ")
+(println)
+(p08/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern09 Example: ")
+(println)
+(p09/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern10 Example: ")
+(println)
+(p10/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern11 Example: ")
+(println)
+(p11/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern12 Example: ")
+(println)
+(p12/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern13 Example: ")
+(println)
+(p13/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern14 Example: ")
+(println)
+(p14/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern15 Example: ")
+(println)
+(p15/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern16 Example: ")
+(println)
+(p16/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern17 Example: ")
+(println)
+(p17/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern18 Example: ")
+(println)
+(p18/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern19 Example: ")
+(println)
+(p19/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern20 Example: ")
+(println)
+(p20/run)
+(println "------------------------------------")
+
+(println)
+(println "Pattern01 Example: ")
 (println)
 (p21/run)
-(println)
+(println "------------------------------------")
+