Learn wiki features weights.

Learn wiki features weights.

--- src/clojure/real_wsdm/galago_util.clj
+++ src/clojure/real_wsdm/galago_util.clj
@@ -87,28 +87,47 @@
   [index-path queries-file]
   (batch-search System/out wsdm-traversal index-path queries-file))

-(def features-config
+(defn features-config
+  [wiki-path wiki-titles-path]
   {:rwsdmFeatures
     [
-      ;{:name    "1-const"
-      ; :type    "const"
-      ; :unigram true}
+      {:name    "1-const"
+      :type    "const"
+      :unigram true}
       {:name    "1-lntf"
-       :type    "logtf"
-       :unigram true}
+      :type    "logtf"
+      :unigram true}
       {:name    "1-lndf"
-       :type    "logdf"
-       :unigram true}
+      :type    "logdf"
+      :unigram true}
+      {:name    "1-wiki"
+      :type    "external"
+      :path    wiki-path
+      :unigram true}
+      {:name    "1-wiki-titles"
+      :type    "external"
+      :path    wiki-titles-path
+      :unigram true}
       ;{:name    "2-const"
       ; :type    "const"
       ; :unigram false
       ; :bigram  true}
       {:name    "2-lntf"
-       :type    "logtf"
-       :unigram false
-       :bigram  true}
-      {:name    "2-lndf"
-       :type    "logdf"
+      :type    "logtf"
+      :unigram false
+      :bigram  true}
+      ;{:name    "2-lndf"
+      ;:type    "logdf"
+      ;:unigram false
+      ;:bigram  true}
+      ;{:name    "2-wiki"
+      ; :type    "external"
+      ; :path    wiki-path
+      ; :unigram false
+      ; :bigram  true}
+      {:name    "2-wiki-titles"
+       :type    "external"
+       :path    wiki-titles-path
        :unigram false
        :bigram  true}
       ;{:name    "3-const"
@@ -116,50 +135,50 @@
       ; :unigram false
       ; :bigram  false
       ; :trigram true}
-      {:name    "3-lntf"
-       :type    "logtf"
-       :unigram false
-       :bigram  false
-       :trigram true}
-      {:name    "3-lndf"
-       :type    "logdf"
-       :unigram false
-       :bigram  false
-       :trigram true}
+      ;{:name    "3-lntf"
+      ; :type    "logtf"
+      ; :unigram false
+      ; :bigram  false
+      ; :trigram true}
+      ;{:name    "3-lndf"
+      ; :type    "logdf"
+      ; :unigram false
+      ; :bigram  false
+      ; :trigram true}
+      ;{:name    "3-wiki"
+      ; :type    "external"
+      ; :path    wiki-path
+      ; :unigram false
+      ; :bigram  false
+      ; :trigram true}
+      {:name    "3-wiki-titles"
+      :type    "external"
+      :path    wiki-titles-path
+      :unigram false
+      :bigram  false
+      :trigram true}
       ]})

 (def learnable-config
   {:learnableParameters
-               [
-                 ;{:name "1-const"
-                 ; :max  3.0
-                 ; :min  0.0}
-                 {:name "1-lntf"
-                  :max  3.0
-                  :min  0.0}
-                 {:name "1-lndf"
-                  :max  3.0
-                  :min  0.0}
-                 ;{:name "2-const"
-                 ; :max  3.0
-                 ; :min  0.0}
-                 {:name "2-lntf"
-                  :max  3.0
-                  :min  0.0}
-                 {:name "2-lndf"
-                  :max  3.0
-                  :min  0.0}
-                 ;{:name "3-const"
-                 ; :max  3.0
-                 ; :min  0.0}
-                 {:name "3-lntf"
-                  :max  3.0
-                  :min  0.0}
-                 {:name "3-lndf"
-                  :max  3.0
-                  :min  0.0}
-                 ]
-   :learner    "coord"})
+            [
+              ; {:name "1-const"}
+              {:name "1-lntf"}
+              {:name "1-lndf"}
+              {:name "1-wiki"}
+              {:name "1-wiki-titles"}
+              ; {:name "2-const"}
+              {:name "2-lntf"}
+              ;{:name "2-lndf"}
+              ;{:name "2-wiki"}
+              {:name "2-wiki-titles"}
+              ; {:name "3-const"}
+              ; {:name "3-lntf"}
+              ; {:name "3-lndf"}
+              ; {:name "3-wiki"}
+              {:name "3-wiki-titles"}
+              ]
+   :learner "coord"})
 ;:initialParameters
 ; [(Parameters/parseString "{
 ; \"1-const\": 1,
@@ -183,12 +202,18 @@
                      ;"1-const"
                      "1-lntf"
                      "1-lndf"
+                     "1-wiki"
+                     "1-wiki-titles"
                      ;"2-const"
                      "2-lntf"
-                     "2-lndf"
+                     ;"2-lndf"
+                     ;"2-wiki"
+                     "2-wiki-titles"
                      ;"3-const"
-                     "3-lntf"
-                     "3-lndf"
+                     ;"3-lntf"
+                     ;"3-lndf"
+                     ;"3-wiki"
+                     "3-wiki-titles"
                      ])
     (.set "value" 1.0)))

@@ -199,13 +224,13 @@
 ;    file))

 (defn learn
-  [index-path queries-file judgements-filepath]
+  [index-path queries-file judgements-filepath wiki-path wiki-titles-path]
   (let [parameters (doto (Parameters/instance)
                      ;(.set "verboseRWSDM" true)
                      (.set "index" index-path)
                      (.set "qrels" judgements-filepath)
                      (.copyFrom (Parameters/parseString (queries-json wsdm-traversal queries-file)))
-                     (.copyFrom (Parameters/parseString (json/write-str features-config)))
+                     (.copyFrom (Parameters/parseString (json/write-str (features-config wiki-path wiki-titles-path))))
                      (.copyFrom (Parameters/parseString (json/write-str learnable-config)))
                      (.set "normalization" [normalization-parameters])
                      (.copyFrom (-> "traversal-config.json" io/resource io/file str Parameters/parseFile)))]


Updating dependency on leiningen/configuration when evaling the dalap_rules.clj file

--- src/dalap/leiningen/configuration.clj
+++ src/dalap/leiningen/configuration.clj
@@ -9,7 +9,7 @@
       (-> project
           (update-in [:dependencies]
                  conj
-                 ['lein-dalap-cljsbuild "0.1.0-SNAPSHOT"])
+                 ['lein-dalap "0.1.0-SNAPSHOT"])
           (assoc :eval-in :classloader))
       ;; body
       `(eval (read-string (slurp ~path)))


added helper methods to easily check realm and team of users

--- src/org/zalando/stups/friboo/user.clj
+++ src/org/zalando/stups/friboo/user.clj
@@ -40,3 +40,32 @@
                         {:user          user-id
                          :required-team team
                          :user-teams    in-team?})))))
+
+(defn require-realms
+  "Throws an exception if user is not in the given realms, else returns the user's realm"
+  [realms {:keys [tokeninfo]}]
+  (let [realm (get tokeninfo "realm")
+        user-id (get tokeninfo "uid")]
+    (if (contains? realms realm)
+      realm
+      (do
+        (log/warn "ACCESS DENIED (unauthorized) because user is not in realms %s." realms)
+        (api/throw-error 403 (str "user not in realms '" realms "'")
+                         {:user            user-id
+                          :required-realms realms
+                          :user-realm      realm})))))
+
+(defn require-internal-user
+  "Makes sure the user is either a service user, or an employee.
+   In the latter case the user must belong to at least one team."
+  [request]
+  (let [realm (require-realms #{"employees" "services"} request)]
+    (when (= realm "employees")
+      (require-teams request))))
+
+
+(defn require-internal-team
+  "Makes sure the user is an employee and belongs to the given team."
+  [team request]
+  (require-realms #{"employees"} request)
+  (require-team team request))


- (lazy-shuffle)

- (lazy-shuffle)

--- src/babel/cache.cljc
+++ src/babel/cache.cljc
@@ -8,7 +8,7 @@
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
    ;; TODO: be more specific in :refer than :all.
-   [dag_unify.core :refer [fail? get-in label-of lazy-shuffle show-spec unifyc]]
+   [dag_unify.core :refer [fail? get-in label-of show-spec unifyc]]

    [babel.over :as over]))

@@ -146,7 +146,7 @@
                                 (= spec-val (get-in each [:synsem :sem :pred])))))
                         result)
                 result)]
-          (lazy-shuffle result))))))
+          result)))))

 (defn get-parent-phrases-for-spec [cache spec]
   (log/trace (str "Looking up spec: " (show-spec spec)))
@@ -154,7 +154,7 @@
         result (if (nil? result) (list) result)]
     (if (empty? result)
       (log/trace (str "parent-phrases for spec: " (show-spec spec) " is empty.")))
-    (lazy-shuffle result)))
+    result))

 (defn get-head-phrases-of [parent cache]
   (if (= true (get-in parent [:head :phrasal] :true))
@@ -163,14 +163,14 @@
           label (label-of parent)]
       (if (empty? result)
         (log/warn (str "headed-phrases of parent: " label " is empty: " (get-in parent [:head]))))
-      (lazy-shuffle result))))
+      result)))

 (defn get-comp-phrases-of [parent cache]
   (let [result (:comp-phrases (get cache (get-in parent [:rule])))
         result (if (nil? result) (list) result)]
     (if (empty? result)
       (log/trace (str "comp-phrases of parent: " (label-of parent) " is empty.")))
-    (lazy-shuffle result)))
+    result))

 (defn overc-with-cache-1 [parent lex]
   (if (not (empty? lex))


fix syntax errors and typos

fix syntax errors and typos

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -98,15 +98,15 @@
                 target-expr
                 ((-> models
                      (get "la")
-                     ((get :generate-fn) target-spec)))
+                     (get :generate-fn)) target-spec)
                 semantics (get-in target-expr [:synsem :sem])
                 source-expr
                 ((-> models
                      (get source-language)
-                     ((get :generate-fn) {:synsem {:sem semantics}})))]
+                     (get :generate-fn)) {:synsem {:sem semantics}})]
             {:source ((-> models
                           (get source-language)
-                          ((get :fo) source-expr)))
+                          ((get :morph) source-expr)))
              :target-spec target-spec
              :targets [target-expr]})
           true


Enable to receive the index paramer on function argument on map operator.

--- src/beicon/core.cljc
+++ src/beicon/core.cljc
@@ -963,7 +963,7 @@
   "Apply a function to each element of an observable
   sequence."
   [f ob]
-  #?(:cljs (pipe ob (.map rxop #(f %)))
+  #?(:cljs (pipe ob (.map rxop #(f %1 %2)))
      :clj  (.map ob (as-function f))))

 (defn flat-map


Update database

Update database

--- src/blog/handler.clj
+++ src/blog/handler.clj
@@ -27,8 +27,8 @@
   (println "blog is starting")
   ;;u slucaju da ne postji tabela, napravi je
   (if-not (.exists (java.io.File. "./db.sq3"))
-    (db/create-guestbook-table))
-  )
+    (db/create-blog-table)
+    (db/create-comment-table)))

 (defn destroy []
   (println "blog is shutting down"))


fix refactoring leftover

fix refactoring leftover

--- src/status_im/notifications/core.cljs
+++ src/status_im/notifications/core.cljs
@@ -37,7 +37,7 @@
     (.onTokenRefresh (.messaging firebase)
                      (fn [x]
                        (log/debug "on-refresh-fcm-token: " x)
-                       (re-frame/dispatch [:notifications/update-fcm-token x]))))
+                       (re-frame/dispatch [:notifications.callback/get-fcm-token-success x]))))

   ;; TODO(oskarth): Only called in background on iOS right now.
   ;; NOTE(oskarth): Hardcoded data keys :sum and :msg in status-go right now.


Fix typo for :nailgun-bind

Fix typo for :nailgun-bind

--- src/clojars/main.clj
+++ src/clojars/main.clj
@@ -19,7 +19,7 @@
 (defn start-nailgun []
   (when-let [port (:nailgun-port config)]
     (println "clojars-web: starting nailgun on" (str (:nailgun-bind config) ":" port))
-    (.run (NGServer. (InetAddress/getByName (:nailgun-bin config)) port))))
+    (.run (NGServer. (InetAddress/getByName (:nailgun-bind config)) port))))

 (defn -main [& args]
   (alter-var-root #'*read-eval* (constantly false))


Name changing on tests.

Name changing on tests.

--- test/beicon/core_spec.cljs
+++ test/beicon/core_spec.cljs
@@ -152,7 +152,7 @@
       (s/push! s2 4)
       (s/end! s2))))

-(t/deftest event-stream-merge
+(t/deftest observable-merge
   (t/async done
     (let [s1 (s/from-coll [1 2 3])
           s2 (s/from-coll [:1 :2 :3])
@@ -160,14 +160,14 @@
       (drain! ms #(t/is (= % [1 :1 2 :2 3 :3])))
       (s/on-end ms done))))

-(t/deftest event-stream-skip-while
+(t/deftest observable-skip-while
   (t/async done
     (let [nums (s/from-coll [1 1 1 2 3 4 5])
           sample (s/skip-while odd? nums)]
       (drain! sample #(t/is (= % [2 3 4 5])))
       (s/on-end sample done))))

-(t/deftest event-stream-skip-until
+(t/deftest observable-skip-until
   (t/async done
     (let [s (s/bus)
           sv (s/bus)
@@ -213,7 +213,7 @@
                     (t/is (= % [1 2]))
                     (done))))))

-(t/deftest event-stream-as-functor
+(t/deftest observable-as-functor
  (t/async done
    (let [s (s/from-coll [0 1 2])
          s2 (m/fmap inc s)]
@@ -222,7 +222,7 @@
      (drain! s2 #(do (t/is (= % [1 2 3]))
                       (done))))))

-(t/deftest event-stream-as-applicative
+(t/deftest observable-as-applicative
  (t/async done
    (let [pinc (m/pure s/observable-context inc)
          pval (m/pure s/observable-context 41)
@@ -231,7 +231,7 @@
      (drain! life #(do (t/is (= % [42]))
                        (done))))))

-(t/deftest event-stream-as-monad
+(t/deftest observable-as-monad
   (t/async done
     (let [sn (s/from-coll [1 2 3])
           snks (m/mlet [n sn


What's the base URL?

What's the base URL?

--- test/icecap/e2e/common.clj
+++ test/icecap/e2e/common.clj
@@ -1,6 +1,6 @@
 (ns icecap.e2e.common
   "Common tools for icecap e2e testing."
-  (:require [icecap.core :refer [run]]
+  (:require [icecap.core :as core]
             [clojure.test :refer :all]
             [taoensso.timbre :refer [info spy]]))

@@ -9,9 +9,12 @@
 (defn icecap-fixture
   "Runs an icecap server as a test fixture."
   [f]
-  (with-redefs [icecap-server (run)]
+  (with-redefs [icecap-server (core/run)]
     (f)
     (.close icecap-server)))
+
+(def base-url
+  (str "http://localhost:" core/port))

 (defn create-cap
   "Creates a capability with the given plan."


FINALLY get proper 404ing

FINALLY get proper 404ing

--- src/doctopus/web.clj
+++ src/doctopus/web.clj
@@ -22,11 +22,18 @@
             :body (slurp (io/resource "500.html"))}))))

 (defn four-oh-four
-  [req]
-  (log/debug "404ing on request:" req)
+  [route]
+  (log/debug "404ing on route:" route)
   {:status 404
    :headers {"Content-Type" "text/html"}
-   :body (format "
Could not find a page matching %s
" (get-in req [:params :ext]))})
+   :body (format "
Could not find a page matching %s
" route)})
+
+(defn wrap-route-not-found
+  [handler]
+  (fn [request]
+    (if-let [response (handler request)]
+      response
+      (four-oh-four (:uri request)))))

 (defn serve-index
   "Just returns our index.html, with the content-type set correctly"
@@ -37,14 +44,14 @@

 ;; Bidi routes are defined as nested sets of ""
 (def routes ["/" {""           {:get serve-index}
-                  "index.html" {:get serve-index}
-                  [:ext]       four-oh-four}])
+                  "index.html" {:get serve-index}}])

 (def application-handlers
   (bidi/make-handler routes))

 (def application
   (-> (wrap-defaults application-handlers site-defaults)
+      (wrap-route-not-found)
       (reload/wrap-reload)
       ((if (= (:env (server-config)) :production)
          wrap-error-page


autocomplete added self ref to namespace (#56)

broke cloverage

--- src/crucible/aws/ec2.clj
+++ src/crucible/aws/ec2.clj
@@ -1,8 +1,7 @@
 (ns crucible.aws.ec2
   "Resources in AWS::EC2::*"
   (:require [clojure.spec :as s]
-            [crucible.resources :refer [spec-or-ref defresource] :as res]
-            [crucible.aws.ec2 :as ec2]))
+            [crucible.resources :refer [spec-or-ref defresource] :as res]))

 (defn ec2 [suffix] (str "AWS::EC2::" suffix))


defect: missing argument message was not appearing

--- src/fat_jar/core.clj
+++ src/fat_jar/core.clj
@@ -17,7 +17,7 @@
          print-help #(do (println "usage:") (println (:summary %)))]
          ; (println options)
     (cond
-      (errors? options) (do (print-help options) (print (:errors options)))
+      (errors? options) (do (print-help options) (println (:errors options)))
       (help? options) (print-help options)
       :else (do
         (println "doing stuff")


fixed bug with invalid index filter keys

--- src/distillery/tasks.clj
+++ src/distillery/tasks.clj
@@ -120,18 +120,19 @@
       :duration duration)))

-(def ^:private filter-map {:not-short proc/not-short?
-                :noun proc/noun?
-                :min-confidence proc/min-confidence?
-                :good-confidence proc/good-confidence?
-                :no-punctuation proc/no-punctuation?
-                :not-in-blacklist bl/not-in-blacklist?})
+(def ^:private filter-map
+  {:not-short proc/not-short?
+   :noun proc/noun?
+   :min-confidence proc/min-confidence?
+   :good-confidence proc/good-confidence?
+   :no-punctuation proc/no-punctuation?
+   :not-in-blacklist bl/not-in-blacklist?})

 (defn- word-predicate
   "Create the word predicate for the video index."
   [{:keys [configuration] :as job}]
   (let [filters (map #(% filter-map) (cfg/value :index-filter configuration))]
-    (partial multi-filter filters)))
+    (partial multi-filter (filter #(not (nil? %)) filters))))

 (defn- build-video-index
@@ -159,7 +160,7 @@
                job [:videos]
                (fn [videos]
                  (vec ((map-fn)
-                       (fn [video] build-video-index job (build-video-statistics video))
+                       (fn [video] (build-video-index job (build-video-statistics video)))
                        videos))))
          job* (assoc job*
                 :words (build-global-index job*))]


Match docstring style with api/list-groups

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -20,10 +20,10 @@
   dispatch)

 (defmulti list-artifacts
-  "Succeeds yielding a sequence of Thing[:artifact] representing all Maven
-  artifacts in the queried datastore that belong to the specified Group. Will
-  Succeed with an empty result if there are no known artifacts. Fails if the
-  group is unknown or if another exception is encountered."
+  "Succeeds with a result Seq[Artifact] representing all Maven artifacts in the
+  queried datastore that belong to the specified Group. Will Succeed with an
+  empty result if there are no known artifacts. Fails if the group is unknown or
+  if another exception is encountered."

   {:arglists '[[config group-thing]]}
   dispatch)


Ende Kapitel I

Ende Kapitel I

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -31,7 +31,7 @@
 (defn page [name]
   (str ""
        (if name
-  (str "Nice to meet you, " name "! \n" "

")
+  (str "Nice to meet you, " name "! \n" "

")
         (str "<form>"
               "Name: <input name='name' type='text'>"
               "<input type='submit'>"
@@ -40,8 +40,8 @@
 )

-(defn handler [{{name "name", empfaenger "empfaenger"} :params}]
-  (-> (r/response (page [name empfaenger]))
+(defn handler [{{name "name"} :params}]
+  (-> (r/response (page [name]))
       (r/content-type "text/html")))

 (def app


Add an extra line break between forms

Add an extra line break between forms

--- src/lazubot/core.clj
+++ src/lazubot/core.clj
@@ -63,7 +63,7 @@
                    (get-in conn [:opts :username])))
     (let [content (get-in message [:message :content])
           forms (extract-forms content)
-          reply (interpose "\n" (map #(str % "\n" "=> " (sb (read-string %))) forms))]
+          reply (interpose "\n" (map #(str % "\n" "=> " (sb (read-string %)) "\n") forms))]
       (respond message (apply str reply)))))

 (defn -main []


Add a nice spinning cog for the app loading

--- src/markiki/core.clj
+++ src/markiki/core.clj
@@ -100,6 +100,7 @@
                 [:link {:rel "icon" :href "favicon.ico"}]
                 [:title "Markiki - Your Markdown Wiki"]
                 (include-css "css/bootstrap.min.css")
+                (include-css "https://maxcdn.bootstrapcdn.com/font-awesome/4.4.0/css/font-awesome.min.css")
                 (include-css "css/markiki.css")]
                [:body
                 [:nav.navbar.navbar-inverse.navbar-fixed-top
@@ -121,8 +122,8 @@
                     [:li [:a {:href "#"} "Home"]]]]]]
                 [:div.container
                  [:div#app
-                  [:h1 "Markiki homepage"]
-                  [:p.lead "Fetch some content please!"]]]
+                  [:i {:class "fa fa-cog fa-spin fa-5x"
+                       :style "margin-top:3em;"}]]]
                 (include-js "js/markiki.js")
                 [:script "window.onload = function(){markiki.core.main();}"]])))


separate config watching from request dispatch

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -11,11 +11,6 @@
             [aleph.http :as http])
   (:gen-class))

-(defn refresh-backend-watcher [watcher old-prefix new-prefix]
-  (if (and watcher (= old-prefix new-prefix))
-    watcher
-    (do (if watcher (close! watcher))
-        (etcd/watch-prefix new-prefix))))
 (defn spy [a] (pprint a) a)

 (defn proxy-handler1 [backends-ch req]
@@ -47,40 +42,6 @@
       (println [:shutdown backend]))
     ch))

-(defn update-listeners-from-config [ch current new-address]
-  ;; open server sockets for all the addresses in config that aren't
-  ;; in listeners; drain and close all the sockets in
-  ;; listeners which aren't in config.
-  ;; we only have one listener right now, so this takes
-  ;; some shortcuts
-  (if new-address
-    (if (get current new-address)
-      current
-      (do
-        ;; need to check this isn't breaking in-flight requests
-        (when-let [old (first (vals current))]
-          (println [:closing old])
-          (.close old))
-        {new-address
-         (http/start-server (partial proxy-handler ch)
-                            (parse-address  new-address))}))
-    current))
-
-(defn update-backends-from-config [current new-backends]
-  (let [before (set (keys current))
-        after (set (keys new-backends))
-        deleted (set/difference before after)
-        create (set/difference after before)]
-    (dorun (map (fn [b] (close! (:channel (get current b)))) deleted))
-    (reduce-kv (fn [m k v]
-                 (assoc m k
-                        (if (:channel v)
-                          v
-                          (assoc v :channel
-                                 (make-backend-channel v)))))
-               {}
-               (apply dissoc new-backends deleted))))
-
 (defn s->millepoch-time [s]
   (.getTimeInMillis (clojure.instant/read-instant-calendar s)))

@@ -90,61 +51,110 @@
 (defn healthy-backend?
   "true if backend seen more recently than time"
   [time b]
-  (> (s->millepoch-time (:last-seen-at b))
-     time))
+  (> (:last-seen-at-millepoch b) time))

-(defn run-server [prefix]
-  (let [shutdown-ch (chan)
-        config-watcher (etcd/watch-prefix prefix)
-        backends-ch (chan)]
+(defn combined-config-watcher [prefix]
+  (let [config-watcher (etcd/watch-prefix prefix)
+        out-ch (chan)]
     (go
-      (loop [listeners {}
-             backends {}
-             backend-prefix nil
+      (loop [backend-prefix nil
              backend-watcher nil]
         (let [config (etcd/get-prefix prefix)
               new-bp (:upstream-service-etcd-prefix config)
-              backends (if new-bp
-                         (update-backends-from-config
-                          backends (etcd/get-prefix new-bp))
-                         backends)
-              listeners (update-listeners-from-config
-                         backends-ch
-                         listeners
-                         (:listen-address config))]
-          (print-state listeners backends)
-          (let [[value ch]
-                (alts! (remove nil?
-                               [config-watcher
-                                backend-watcher
-                                shutdown-ch
-                                backends-ch]))]
-            (when (= ch backends-ch)
-              (let [since (- (millepoch-time-now)
-                             (* 1000 (Integer/parseInt (:upstream-freshness config))))
-                    good-backends (filter (partial healthy-backend? since)
-                                          (vals backends))]
-                (if (seq good-backends)
-                  (alts! (map (fn [b] [(:channel b) value]) good-backends))
-                  (>! (second value) {:status 500 :headers {}
-                                      :body "No healthy downstreams"}))))
-            (if (= ch shutdown-ch)
-              (.close (first (vals listeners)))
-              (recur listeners
-                     backends
-                     new-bp
-                     (refresh-backend-watcher backend-watcher backend-prefix new-bp))))))
-      (println "quit"))
+              backend-watcher
+              (if (and backend-watcher (= new-bp backend-prefix))
+                backend-watcher
+                (and new-bp (etcd/watch-prefix new-bp)))]
+          (>! out-ch {:config config
+                      :backends (if new-bp (etcd/get-prefix new-bp) {})})
+          (alts! (remove nil? [config-watcher backend-watcher]))
+          (recur new-bp backend-watcher))))
+    out-ch))
+
+(defn update-backends-state [app-state backends-spec]
+  (let [before (reduce (fn [m bk]
+                         (assoc m (:listen-address bk) bk))
+                       {}
+                       (:backends app-state))
+        after  (reduce (fn [m bk]
+                         (assoc m (:listen-address bk) bk))
+                       {}
+                       (vals backends-spec))
+        b-addrs (set (keys before))
+        a-addrs (set (keys after))
+        deleted (set/difference b-addrs a-addrs)
+        create (set/difference a-addrs b-addrs)]
+    (pprint [:update-backends before after deleted create])
+    (dorun (map (fn [b] (close! (:channel (get before b)))) deleted))
+    (map (fn [a]
+           (let [bk (get after a)]
+             (assoc bk
+                    :channel
+                    (or (:channel (get before a))
+                        (make-backend-channel bk))
+                    :last-seen-at-millepoch
+                    (s->millepoch-time (:last-seen-at bk))
+                    )))
+         a-addrs)))
+
+(defn open-listener [addr dispatch-ch]
+  (http/start-server (partial proxy-handler dispatch-ch)
+                     (parse-address addr)))
+
+(defn update-app-state [app-state m]
+  (println [:update-app-state app-state m])
+  (let [dispatch-ch (:dispatch-channel app-state)
+        config (:config m)
+        backends-spec (:backends m)
+        addr (:listen-address config)]
+    (assoc app-state
+           :upstream-freshness-ms
+           (* 1000 (Integer/parseInt (:upstream-freshness config)))
+           :dispatch-channel dispatch-ch
+           :listen-address (:listen-address config)
+           :listener
+           (if-let [l (:listener app-state)]
+             (if (= (:listen-address app-state) addr)
+               l
+               (do
+                 (.close l)
+                 (open-listener addr dispatch-ch)))
+             (open-listener addr dispatch-ch))
+           :backends (update-backends-state app-state backends-spec))))
+
+(defn run-server [prefix]
+  (let [config-ch (combined-config-watcher prefix)
+        shutdown-ch (chan)
+        dispatcher-ch (chan)]
+    (go
+      (loop [app-state {:dispatch-channel dispatcher-ch}]
+        (let [backends (:backends app-state)
+              [val ch] (alts! [config-ch dispatcher-ch shutdown-ch])]
+          (condp = ch
+            config-ch
+            (recur (spy (update-app-state app-state val)))
+            dispatcher-ch
+            (let [since (- (millepoch-time-now)
+                           (:upstream-freshness-ms app-state))
+                  good-backends (filter (partial healthy-backend? since)
+                                        backends)]
+              (if (seq good-backends)
+                (alts! (map (fn [b] [(:channel b) val]) good-backends))
+                (>! (second val) {:status 500 :headers {}
+                                  :body "No healthy downstreams"}))
+              (recur app-state))
+            shutdown-ch
+            (do
+              (dorun (map (fn [b] (async/close! (:channel b))) backends))
+              (when-let [l (:listener app-state)]
+                (.close l))
+              (println "stopping"))))))
     shutdown-ch))
-
-
-
-

 (defn -main
   "I don't do a whole lot ... yet."
   [& args]
   (println "Hello, World!")
-;  (add-watch etcd/configuration :update-frontend update-frontend)
-;  (etcd/watch-config (first args))
-  (println "running"))
+  (let [s (run-server (first args))]
+    (Thread/sleep (* (Integer/parseInt (second args)) 1000))
+    (async/put! s :done)))


You're gonna need a url

You're gonna need a url

--- src/myshelf/core.clj
+++ src/myshelf/core.clj
@@ -51,7 +51,8 @@
                                        params)]
     (xml/parse (input-stream
                 (.getBytes
-                 (:body (http/get {:query-params credentials})))))))
+                 (:body (http/get url
+                                  {:query-params credentials})))))))

 (defn get-user-id
   "Fetch the Goodreads user id for the user that has granted access"


WIP: fix comparisons

WIP: fix comparisons

--- src/oi_lang/obj.cljs
+++ src/oi_lang/obj.cljs
@@ -59,14 +59,22 @@
     {:env env :result (apply target args)}
     (throw (str "unsupported activation: " (or target "nil") " " (or args "nil")))))

+(defn lookup-slot [obj slot-name]
+  (when (nil? obj)
+    (throw (str "slot not found: " slot-name)))
+  (if (contains? (:slots obj) slot-name)
+    (get (:slots obj) slot-name)
+    (lookup-slot (:proto obj) slot-name)))
+
 (defn oi-= [a b]
   (if (and (vector? a) (vector? b))
     (every? (fn [[a b]] (oi-= a b)) (map vector a b))
-    (and (= (:type a) (:type b))
-         (= (:value a) (:value b)))))
+    (let [eq (lookup-slot a "=")]
+      (eq b))))

 (declare oi-boolean)

+; todo: this can't work, self isn't what we need here
 (defn oi-object []
   (let [self {:slots {} :proto nil}]
     (assoc self
@@ -82,7 +90,13 @@
 (defn oi-list [& items]
   {:type  :list
    :value items
-   :slots {}
+   :slots {"=" (fn [other-list]
+                 (println "list=" items other-list)
+                 (and (= (:type other-list) :list)
+                      (every? (fn ([[a b]]
+                                   (let [eq (lookup-slot a "=")]
+                                     (eq b))))
+                              (map vector items (:value other-list)))))}
    :proto initial})

 (def lobby {:type  :object
@@ -145,13 +159,6 @@

 (defn ast->runtime* [asts]
   (vec (map ast->runtime asts)))
-
-(defn lookup-slot [obj slot-name]
-  (when (nil? obj)
-    (throw (str "slot not found: " slot-name)))
-  (if (contains? (:slots obj) slot-name)
-    (get (:slots obj) slot-name)
-    (lookup-slot (:proto obj) slot-name)))

 (defn do-activations [env expr]
   (match expr


Add cookies to the response when specified

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -7,14 +7,15 @@

 (require '[monger.collection :as mc])
 (use 'ring.middleware.file)
-
+(use 'ring.middleware.cookies)
 (use '[clojure.data.json :only (read-json json-str)])

 (use '[ontrail.summary])

-(defn json-response [data & [status]]
+(defn json-response [data & [status authToken]]
   {:status (or status 200)
    :headers {"Content-Type" "application/json"}
+   :cookies (if authToken {"authToken" authToken} {})
    :body (json-str data)})

 (defroutes app-routes
@@ -26,5 +27,7 @@
 (defn -main [& args]
   "Main thread for the server which starts an async server with
   all the routes we specified and is websocket ready."
-  (start-http-server (wrap-ring-handler app-routes)
+  (start-http-server (-> app-routes
+                       wrap-cookies
+                       wrap-ring-handler)
                      {:host "localhost" :port 8080 :websocket true}))


Quantify over walls. Convenience for decreasing movement. Draw walls. Fix a bug with guards which are satisfied and will never become unsatisfied. Limit recursion into update-scene arbitrarily. Ignore mouse inputs on diagnostic UI labels.

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -2,10 +2,10 @@
   (:require
     #_[om.core :as om :include-macros true]
     [clojure.set :refer [union]]
-    [clojure.walk :as walk]
+    #_[clojure.walk :as walk]
     [sablono.core :as sab :include-macros true])
   (:require-macros
-    [devcards.core :as dc :refer [defcard deftest]]))
+    [devcards.core :refer [defcard deftest]]))

 (enable-console-print!)

@@ -97,22 +97,26 @@
         v2k (if (= (count simple-guard) 4) (third simple-guard) nil)
         [v10 v1f] (get-var-and-flow has ha v1k)
         [v20 v2f] (get-var-and-flow has ha v2k)
-        ; _ (println (str "(" v10 " + " v1f "t) - (" v20 " + " v2f "t) " (case rel :gt ">" :geq ">=" :leq "<=" :lt "<") " " c))
+        sat (guard-satisfied? rel v10 v20 c)
+        #_ _ #_(println (str "(" v10 " + " v1f "t) - (" v20 " + " v2f "t) "
+             (case rel :gt ">" :geq ">=" :leq "<=" :lt "<") " " c))
         ; by algebra: A0+fA*dt-B0-fB*dt-C~0 --> (fA-fB)*dt ~ (-A0 + B0 + C) --> dt ~ (-A0 + B0 + C)/(fA-fB)
         denom (- v1f v2f)
-        rhs (/ (+ (- v10) v20 c)
-               denom)
+        rhs (if (= denom 0)
+              Infinity
+              (/ (+ (- v10) v20 c)
+                 denom))
         ; since we are dividing by denom, flip rel if denom (a constant) < 0
-        rel (if (< denom 0)
+        rel (if (> denom 0)
+              rel
               (case rel
                 :gt :lt
                 :geq :leq
                 :leq :geq
-                :lt :gt)
-              rel)
+                :lt :gt))
         ; t REL rhs
         entry-time (:entry-time ha)
-        ; _ (println (:id ha) simple-guard "et" entry-time "push up" time-unit rhs "to" (+ entry-time time-unit) (+ entry-time rhs))
+        ;_ (println (:id ha) simple-guard "et" entry-time "push up" time-unit rhs "to" (+ entry-time time-unit) (+ entry-time rhs) "sat?" sat)
         min-t (+ entry-time time-unit)
         rhs (+ entry-time rhs)]
     (assert (not (nil? v10))
@@ -121,7 +125,7 @@
             "V2 must be a valid variable reference")
     (cond
       ;if RHS is +-infinity, then the guard will never flip truth value
-      (or (= rhs Infinity) (= rhs -Infinity)) (if (guard-satisfied? rel v10 v20 c)
+      (or (= rhs Infinity) (= rhs -Infinity)) (if sat
                                                 [-Infinity Infinity]
                                                 [Infinity Infinity])
       ; if t is bounded from above by a number less than time-unit, return an interval which will become empty during intersection
@@ -135,14 +139,13 @@
               ; >= : t >= rhs --> guard becomes true once t exceeds or equals rhs
               :geq [(.max js/Math rhs min-t) Infinity]
               ;  > : t  > rhs --> guard becomes true once t exceeds rhs
-              :gt [(.max js/Math (+ rhs (/ time-unit 16)) min-t) Infinity])
-      )))
+              :gt [(.max js/Math (+ rhs (/ time-unit 16)) min-t) Infinity]))))

 (defn transition-interval [has ha transition]
   ;(println "Transition" (:id ha) (:x ha) (:target transition) (:guard transition))
   (let [intervals (map #(simple-interval has ha %) (:guard transition))
         interval (intersect-all intervals)]
-    ; (println "interval:" intervals "->" interval)
+    ;(println "interval:" intervals "->" interval)
     ; TODO: handle cases where transition is also guarded on states
     {:interval   interval
      :id         (:id ha)
@@ -288,17 +291,20 @@
         ; mentioned above, they might have calculated their new intervals based on stale information.
         ; calculating intervals is idempotent and has no second-order effects so it is fine to do it repeatedly
         ; and it also suffices to do it a single time once all the HAs are updated with new times, values and flows.
-        deps (into #{} (filter (fn [k] (some transitioned-ids (ha-dependencies (get has k)))) (keys has)))
+        deps (into #{} (filter (fn [k]
+                                 (some transitioned-ids (ha-dependencies (get has k))))
+                               (keys has)))
         reenter-has (map #(let [ha (get has %)]
                            (enter-state has ha (:state ha) t))
                          deps)]
     #_(println "next transitions" #_reenter-has (transition-intervals has
-                                                                      (second reenter-has)
-                                                                      Infinity
-                                                                      (required-transitions (second reenter-has))))
+                                                                    (second reenter-has)
+                                                                    Infinity
+                                                                    (required-transitions (second reenter-has))))
     (merge has (zipmap (map :id reenter-has) reenter-has))))

-(defn update-scene [scene now inputs]
+(defn update-scene [scene now inputs bailout]
+  (assert (<= bailout 100) "Recursed too deeply in update-scene")
   (let [qthen (floor-time (:now scene) time-unit)
         qnow (floor-time now time-unit)
         has (:objects scene)
@@ -312,49 +318,90 @@
                                     (map #(next-transition has % qthen inputs) (vals has)))]
     (cond
       (> min-t qnow) (assoc scene :now now)
-      (= min-t qnow) (do #_(println "clean border") (assoc scene :now now
-                                                                 :objects (follow-transitions has transitions)))
-      :else (do #_(println "messy border overflow" (- now min-t)) (update-scene (assoc scene :now min-t
-                                                                                :objects (follow-transitions has transitions))
-                                                                                now
-                                                                                inputs))
+      (= min-t qnow) (do #_(println "clean border")
+                       (assoc scene :now now
+                                    :objects (follow-transitions has transitions)))
+      :else (do (println "messy border overflow" (- now min-t))
+                (update-scene (assoc scene :now min-t
+                                           :objects (follow-transitions has transitions))
+                              now
+                              inputs
+                              (inc bailout)))
       )))

 (defonce scene-a (atom {}))
 (defonce last-time nil)

-(defn goomba [id x y speed state others]
-  (make-ha id                                               ;id
-           {:x     x :y y                                   ;init
-            :w     16 :h 16
-            :state state}
-           (make-state
-             :right                                         ;name
-             {:x speed}                                     ;flows
-             ;edges
-             ; x + 16 < 96 --> x < 96 - 16 && x + 16 + dx*frame >= 80 --> x >= 80 - dx*frame
-             (make-edge :left [[:lt :x 80] [:geq :x '(- 80 [:d :x])]] #{:required})
-             ; x + 16 < x2 && x + dx*frame + 16 >= x2 + dx2*frame
-             ; x - x2 < -16 && x - x2 >= dx2*frame - dx*frame - 16
-             (map #(make-edge :left [[:lt :x [% :x] -16]
-                                     [:geq :x [% :x] (list '- [:d % :x] [:d :x] 16)]]
-                              #{:required}) others))
-           (make-state
-             :left                                          ;name
-             {:x (- speed)}                                 ;flows
-             ;edges
-             ; x > 8 && x + dx*frame <= 8 --> x <= 8 - dx*frame
-             (make-edge :right [[:gt :x 8] [:leq :x '(- 8 [:d :x])]] #{:required})
-             ; x > x2 + 16 && x + dx*frame <= x2 + dx2*frame + 16 --> x - x2 > 16 + dx2 && x - x2 <= dx2*frame + 16 - dx*frame
-             ; x - x2 > 16
-             (map #(make-edge :right [[:gt :x [% :x] 16]
-                                      [:leq :x [% :x] (list '+ [:d % :x] 16 (list '- [:d :x]))]]
-                              #{:required}) others))))
-
-(defn make-scene-a [x] (let [objects [(goomba :ga x 8 16 :right #{:gb :gc :gd})
-                                      (goomba :gb (+ x 18) 8 16 :left #{:ga :gc :gd})
-                                      (goomba :gc (+ x 38) 8 16 :right #{:ga :gb :gd})
-                                      (goomba :gd (+ x 58) 8 16 :left #{:ga :gb :gc})]
+(defn moving-inc-c [vbl width limit]
+  [[:lt vbl (- limit width)]
+   [:geq vbl (list '- limit width [:d vbl])]])
+
+(defn moving-dec-c [vbl limit]
+  [[:gt vbl limit]
+   [:leq vbl (list '- limit [:d vbl])]])
+
+(defn moving-inc [vbl width other-ha]
+  [[:lt vbl [other-ha vbl] (- width)]
+   [:geq vbl [other-ha vbl] (list '- [:d other-ha vbl] [:d vbl] width)]])
+
+(defn moving-dec [vbl width other-ha]
+  [[:gt vbl [other-ha vbl] width]
+   [:leq vbl [other-ha vbl] (list '+ [:d other-ha vbl] width (list '- [:d vbl]))]])
+
+(defn between-c [vbl min max]
+  [[:geq vbl min]
+   [:lt vbl max]])
+
+(defn goomba [id x y speed state others walls]
+  (let [others (disj others id)]
+    (make-ha id                                             ;id
+             {:x     x :y y                                 ;init
+              :w     16 :h 16
+              :state state}
+             (make-state
+               :right                                       ;name
+               {:x speed}                                   ;flows
+               ;edges
+               ; x + 16 < 96 --> x < 96 - 16 && x + 16 + dx*frame >= 80 --> x >= 80 - dx*frame
+               (mapcat (fn [[x y w h]]
+                         ; left-transition means bumping into left side of wall
+                         [(make-edge :left
+                                     (concat (moving-inc-c :x 16 x)
+                                             (between-c :y 0 100 #_(- y 16) #_(+ y h)))
+                                     #{:required [:this id] [:other [:wall x y w h]]})])
+                       walls)
+               ; x + 16 < x2 && x + dx*frame + 16 >= x2 + dx2*frame
+               ; x - x2 < -16 && x - x2 >= dx2*frame - dx*frame - 16
+               (map #(make-edge :left (moving-inc :x 16 %) #{:required [:this id] [:other %]}) others))
+             (make-state
+               :left                                        ;name
+               {:x (- speed)}                               ;flows
+               ;edges
+               ; x > 8 && x + dx*frame <= 8 --> x <= 8 - dx*frame
+               (mapcat (fn [[x y w h]]
+                         ; right-transition means bumping into right side of wall
+                         [(make-edge :right
+                                     (concat (moving-dec-c :x (+ x w))
+                                             (between-c :y (- y 16) (+ y h)))
+                                     #{:required [:this id] [:other [:wall x y w h]]})])
+                       walls)
+               ; x > x2 + 16 && x + dx*frame <= x2 + dx2*frame + 16 -->
+               ;   x - x2 > 16 + dx2 && x - x2 <= dx2*frame + 16 - dx*frame
+               ; x - x2 > 16
+               (map #(make-edge :right (moving-dec :x 16 %) #{:required [:this id] [:other %]}) others)))))
+
+(def scene-a-walls #{[0 0 104 8]
+                     [0 8 8 16]
+                     [96 8 8 16]})
+
+(defn make-scene-a [x] (let [ids #{:ga :gb :gc :gd}
+                             walls scene-a-walls
+                             objects [(goomba :ga x 8 16 :right ids walls)
+                                      (goomba :gb (+ x 18) 8 16 :left ids walls)
+                                      (goomba :gc (+ x 38) 8 16 :right ids walls)
+                                      (goomba :gd (+ x 58) 8 16 :left ids walls)
+                                      ; 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
@@ -379,7 +426,8 @@
     (swap! scene-a
            (fn [s] (let [new-s (update-scene s
                                              (+ (:now s) (/ (- t last-time) 1000))
-                                             #{[(floor-time (:now s) time-unit) #{}]})]
+                                             #{[(floor-time (:now s) time-unit) #{}]}
+                                             0)]
                      (if (and (:pause-on-play new-s)
                               (not= (ha-states s) (ha-states new-s)))
                        (assoc new-s :playing false)
@@ -422,13 +470,16 @@
            (ha-states @scene))
          scene-a)

-(defn scene-widget [scene owner]
+(defn scene-widget [scene _owner]
   (let [scale 2
         view-h (str (* scale 240) "px")
         ct (count (:objects @scene))
         line-h (/ (* scale 240) ct)]
-    (sab/html [:div {:style {:backgroundColor "blue" :width (str (* scale 320) "px") :height view-h :position "relative"}}
-               (map (fn [{x :x y :y w :w h :h :as ha} i]
+    (sab/html [:div {:style {:backgroundColor "blue"
+                             :width           (str (* scale 320) "px")
+                             :height          view-h
+                             :position        "relative"}}
+               (map (fn [ha i]
                       (let [trans-count (count (required-transitions ha))
                             trans-h (/ line-h trans-count)]
                         [:div
@@ -437,12 +488,23 @@
                                       sx (* scale (:x (extrapolate ha s)))
                                       ex (* scale (:x (extrapolate ha e)))
                                       line-top (+ (* i line-h) (* j trans-h))]
-                                  [:div {:style {:height   trans-h :width (.abs js/Math (- sx ex))
-                                                 :top      line-top :left (.min js/Math sx ex)
-                                                 :position :absolute :backgroundColor "grey"}}
-                                   [:div {:style {:position :absolute :width "100px" :backgroundColor "rgba(255,255,255,0.5)"}} (str (:id ha) "-" (:target (:transition trans)))]
-                                   [:div {:style {:height "100%" :width "2px" :position :absolute :left (if (< sx ex) "0%" "100%") :backgroundColor "green"}}]
-                                   [:div {:style {:height "100%" :width "2px" :position :absolute :left (if (< sx ex) "100%" "0%") :backgroundColor "red"}}]]))
+                                  [:div {:style {:height        trans-h :width (.abs js/Math (- sx ex))
+                                                 :top           line-top :left (.min js/Math sx ex)
+                                                 :position      "absolute" :backgroundColor "grey"
+                                                 :pointerEvents "none"}}
+                                   [:div {:style {:position        "absolute"
+                                                  :width           "100px"
+                                                  :backgroundColor "rgba(255,255,255,0.5)"
+                                                  :pointerEvents   "none"}}
+                                    (str (:id ha) "-" (:target (:transition trans)))]
+                                   [:div {:style {:height          "100%" :width "2px"
+                                                  :position        "absolute" :left (if (< sx ex) "0%" "100%")
+                                                  :backgroundColor "green"
+                                                  :pointerEvents   "none"}}]
+                                   [:div {:style {:height          "100%" :width "2px"
+                                                  :position        "absolute" :left (if (< sx ex) "100%" "0%")
+                                                  :backgroundColor "red"
+                                                  :pointerEvents   "none"}}]]))
                               (transition-intervals (:objects @scene)
                                                     ha
                                                     Infinity
@@ -450,14 +512,25 @@
                               (range 0 trans-count))]))
                     (map #(extrapolate % (:now @scene)) (vals (:objects @scene)))
                     (range 0 ct))
+               (map (fn [[x y w h]]
+                      [:div {:style {:width           (str (* scale w) "px") :height (str (* scale h) "px")
+                                     :backgroundColor "white"
+                                     :position        "absolute"
+                                     :left            (str (* scale x) "px")
+                                     :bottom          (str (* scale y) "px")}}])
+                    scene-a-walls)
                (map (fn [{x :x y :y w :w h :h :as ha}]
                       [:div
-                       [:div {:style {:width           (str (* scale w) "px") :height (str (* scale h) "px") :borderRadius (str (* scale w) "px")
+                       [:div {:style {:width           (str (* scale w) "px") :height (str (* scale h) "px")
+                                      :borderRadius    (str (* scale w) "px")
                                       :backgroundColor "brown"
-                                      :position        "absolute" :left (str (* scale x) "px") :bottom (str (* scale y) "px")}}
+                                      :position        "absolute"
+                                      :left            (str (* scale x) "px")
+                                      :bottom          (str (* scale y) "px")}}
                         (str (:id ha))]])
                     (map #(extrapolate % (:now @scene)) (vals (:objects @scene))))
-               [:button {:onClick #(swap! scene (fn [s] (assoc s :playing (not (:playing s)))))} (if (:playing @scene) "PAUSE" "PLAY")]
+               [:button {:onClick #(swap! scene (fn [s] (assoc s :playing (not (:playing s)))))}
+                (if (:playing @scene) "PAUSE" "PLAY")]
                [:span {:style {:backgroundColor "lightgrey"}} "Pause on state change?"
                 [:input {:type     "checkbox"
                          :checked  (:pause-on-play @scene)
@@ -482,13 +555,9 @@
   (.requestAnimationFrame js/window #(rererender target)))

 (defn main []
-  ;; conditionally start the app based on wether the #main-app-area
+  ;; conditionally start the app based on whether the #main-app-area
   ;; node is on the page
   (if-let [node (.getElementById js/document "main-app-area")]
     (.requestAnimationFrame js/window #(rererender node))))

 (main)
-
-;; remember to run lein figwheel and then browse to
-;; http://localhost:3449/cards.html
-


feat(nrepl): nrepl hyperlinks connect the REPL to the project process when available

--- ccw.core/src/clj/ccw/editors/clojure/nrepl_hyperlink.clj
+++ ccw.core/src/clj/ccw/editors/clojure/nrepl_hyperlink.clj
@@ -17,7 +17,7 @@
         document (.getDocument console)
         s (.get document offset length)
         [[url]] (re-seq pattern s)
-        open-repl-view #(ccw.repl.REPLView/connect url true)
+        open-repl-view #(ccw.repl.REPLView/connect url console (some-> console .getProcess .getLaunch) true)
         hyperlink (reify org.eclipse.ui.console.IHyperlink
                     (linkActivated [this] (open-repl-view))
                     (linkExited [this])


New test test-get-calendar-5

New test test-get-calendar-5

--- test/clj_calendar/calendar_test.clj
+++ test/clj_calendar/calendar_test.clj
@@ -171,6 +171,15 @@
             (is (=  (.get calendar (java.util.Calendar/SECOND)) 30)))
 ))

+(deftest test-get-calendar-5
+    "Check the function clj-calendar.calendar/get-calendar."
+    (testing "the function clj-calendar.calendar/get-calendar."
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 01 10 20 30)
+            (is (>=  (.get calendar (java.util.Calendar/MILLISECOND)) 0))
+            (is (<=  (.get calendar (java.util.Calendar/MILLISECOND)) 1000)))
+))
+
 (deftest test-format-date-using-desired-format
     "Check the function clj-calendar.calendar/format-date-using-desired-format"
     (testing "the function clj-calendar.calendar/format-date-using-desired-format."


more tests for all/last/first on nil

more tests for all/last/first on nil

--- test/com/rpl/specter/core_test.cljx
+++ test/com/rpl/specter/core_test.cljx
@@ -1192,7 +1192,12 @@
        (first (select s/META (setval s/META meta-map v))))))

-(deftest beginning-end-on-nil
+(deftest beginning-end-all-first-last-on-nil
   (is (= [2 3] (setval s/END [2 3] nil) (setval s/BEGINNING [2 3] nil)))
   (is (nil? (setval s/FIRST :a nil)))
-  )
+  (is (nil? (setval s/LAST :a nil)))
+  (is (nil? (transform s/ALL inc nil)))
+  (is (empty? (select s/FIRST nil)))
+  (is (empty? (select s/LAST nil)))
+  (is (empty? (select s/ALL nil)))
+  )


Add another failing test

Add another failing test

--- test/riemann/core_test.clj
+++ test/riemann/core_test.clj
@@ -366,3 +366,17 @@
                                   "riemann.core"
                                   "riemann.pubsub"]
                                  (stop! core))))))
+
+(deftest transition-wrapped-index
+  (let [first-index (wrap-index (index))
+        first-core  (logging/suppress ["riemann.core" "riemann.pubsub"]
+                                      (transition! (core) {:index first-index}))
+        second-index (wrap-index (index))
+        second-core  (logging/suppress ["riemann.core" "riemann.pubsub"]
+                                       (transition! (core) {:index second-index}))]
+
+    (first-index {:service 1 :state "ok" :time 0})
+    (is (= (seq first-index) [{:service 1 :state "ok" :time 0}]))
+
+    (transition! first-core second-core)
+    (is (= (seq second-index) [{:service 1 :state "ok" :time 0}]))))


Add resource request and limit to init-container in pod (#1747)

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

--- scheduler/src/cook/kubernetes/api.clj
+++ scheduler/src/cook/kubernetes/api.clj
@@ -644,6 +644,7 @@
 (defn- add-as-decimals
   "Takes two doubles and adds them as decimals to avoid floating point error. Kubernetes will not be able to launch a
    pod if the required cpu has too much precision. For example, adding 0.1 and 0.02 as doubles results in 0.12000000000000001"
+  ; If you get an error like IllegalArgumentException "No suffix for exponent-18" in JSON serialization. Use this function.
   [a b]
   (double (+ (bigdec a) (bigdec b))))

@@ -776,6 +777,19 @@
     (merge pod-labels-defaults
            pod-labels-from-job-labels
            pod-labels-from-job-application)))
+
+(defn set-mem-cpu-resources
+  "Given a resources object and a CPU and memory request and limit, update the resources object to reflect the
+  desired requests and limits."
+  [^V1ResourceRequirements resources memory-request memory-limit cpu-request cpu-limit]
+  (let [{:keys [set-container-cpu-limit?]} (config/kubernetes)]
+    (.putRequestsItem resources "memory" (double->quantity (* memory-multiplier memory-request)))
+    (.putLimitsItem resources "memory" (double->quantity (* memory-multiplier memory-limit)))
+    (.putRequestsItem resources "cpu" (double->quantity cpu-request))
+    (when set-container-cpu-limit?
+      ; Some environments may need pods to run in the "Guaranteed"
+      ; QoS, which requires limits for both memory and cpu
+      (.putLimitsItem resources "cpu" (double->quantity cpu-limit)))))

 (defn ^V1Pod task-metadata->pod
   "Given a task-request and other data generate the kubernetes V1Pod to launch that task."
@@ -882,13 +896,8 @@
     (.setTty container true)
     (.setStdin container true)

-    (.putRequestsItem resources "memory" (double->quantity (* memory-multiplier computed-mem)))
-    (.putLimitsItem resources "memory" (double->quantity (* memory-multiplier computed-mem)))
-    (.putRequestsItem resources "cpu" (double->quantity cpus))
-    (when set-container-cpu-limit?
-      ; Some environments may need pods to run in the "Guaranteed"
-      ; QoS, which requires limits for both memory and cpu
-      (.putLimitsItem resources "cpu" (double->quantity cpus)))
+    (set-mem-cpu-resources resources computed-mem computed-mem cpus cpus)
+
     (when (pos? gpus)
       (.putLimitsItem resources "nvidia.com/gpu" (double->quantity gpus))
       (.putRequestsItem resources "nvidia.com/gpu" (double->quantity gpus))
@@ -908,7 +917,15 @@
     ; init container
     (when use-cook-init?
       (when-let [{:keys [command image]} init-container]
-        (let [container (V1Container.)]
+        (let [container (V1Container.)
+              get-resource-requirements-fn (fn [fieldname] (if use-cook-sidecar?
+                                                             (get-in sidecar [:resource-requirements fieldname])
+                                                             0))
+              total-memory-request (add-as-decimals computed-mem (get-resource-requirements-fn :memory-request))
+              total-memory-limit (add-as-decimals computed-mem (get-resource-requirements-fn :memory-limit))
+              total-cpu-request (add-as-decimals cpus (get-resource-requirements-fn :cpu-request))
+              total-cpu-limit (add-as-decimals cpus (get-resource-requirements-fn :cpu-limit))
+              resources (V1ResourceRequirements.)]
           ; container
           (.setName container cook-init-container-name)
           (.setImage container image)
@@ -918,6 +935,8 @@
           (.setVolumeMounts container (filterv some? (concat [(init-container-workdir-volume-mount-fn false)
                                                               (scratch-space-volume-mount-fn false)]
                                                              init-container-checkpoint-volume-mounts)))
+          (set-mem-cpu-resources resources total-memory-request total-memory-limit total-cpu-request total-cpu-limit)
+          (.setResources container resources)
           (.addInitContainersItem pod-spec container))))

     ; sandbox file server container
@@ -948,11 +967,7 @@
             (.setReadinessProbe container readiness-probe)))

           ; resources
-          (.putRequestsItem resources "cpu" (double->quantity cpu-request))
-          (when set-container-cpu-limit?
-            (.putLimitsItem resources "cpu" (double->quantity cpu-limit)))
-          (.putRequestsItem resources "memory" (double->quantity (* memory-multiplier memory-request)))
-          (.putLimitsItem resources "memory" (double->quantity (* memory-multiplier memory-limit)))
+          (set-mem-cpu-resources resources memory-request memory-limit cpu-request cpu-limit)
           (.setResources container resources)

           (.setVolumeMounts container [(sandbox-volume-mount-fn true) (sidecar-workdir-volume-mount-fn false)])


actually appears the refresh is removing the projects

--- test/functional/functional_test.clj
+++ test/functional/functional_test.clj
@@ -71,7 +71,7 @@
     (save-screenshot-and-source "tracking")

     ; test settings aren't reset when we refresh the page
-    (refresh)
+    ;(refresh)
     (let [tray (tracking-page/get-tray)]
       (tracking-page/show-projects tray))

@@ -98,8 +98,8 @@
     (save-screenshot-and-source "settings")

     (backup-page/navigate base-url)
-    ;(-> (backup-page/export-data)
-    ;    (backup-page/import-data))
+    (-> (backup-page/export-data)
+        (backup-page/import-data))

     (save-screenshot-and-source "backup")


Added syntax-quote test.

Added syntax-quote test.

--- test/useful/utils_test.clj
+++ test/useful/utils_test.clj
@@ -101,3 +101,6 @@
 (deftest test-with-adjustments
   (is (= 1 (with-adjustments #(fnil % 0) [+ inc]
              (+ nil (inc nil))))))
+
+(deftest test-syntax-quote
+  (is (= '((quote foo) (quote (bar [baz] "hi"))) (syntax-quote '(foo (bar [baz] "hi"))))))


Fixed error in itest

Fixed error in itest

--- test/elefant_server/api/rest_test.clj
+++ test/elefant_server/api/rest_test.clj
@@ -115,7 +115,7 @@
                           (def subscription (future (->> (client/get (->> trumpeteeResponse :_links :subscribe :href) {:as :stream}) :body)))

                           (deref subscription 3000 :timed-out)
-                          (->> (client/post (->> trumpeteerResponse :_links :trumpet :href) {:form-params {"message" "My trumpet"} :as :json}) :body :trumpeteersWithinDistance) => 2)
+                          (->> (client/post (->> trumpeteerResponse :_links :trumpet :href) {:form-params {"message" "My trumpet"} :as :json}) :body :trumpeteersWithinDistance) => 1)

                     (fact "/trumpet returns doesn't return unsubscribed trumpeteers or self" :it
                           ; Create trumpeteers


changed query away from std out

changed query away from std out

--- test/forma/classify/logistic_test.clj
+++ test/forma/classify/logistic_test.clj
@@ -119,6 +119,9 @@
 (defn random-eco []
   (if (zero? (rand-int 2)) 22220 22221))

+(def modis-sample (for [x (range 10) y (range 10)]
+                    [27 8 x y]))
+
 (def sample-dynamic-tap
   (vec (for [[h v s l] modis-sample
              pd (range 827 837)]
@@ -175,7 +178,7 @@
 (defn grab-forma-output
   [path]
   (let [src (hfs-seqfile path)]
-    (?<- (stdout)
+    (??<-
          [?s ?l ?prob-series]
          (src _ _ _ ?s ?l ?prob-series)
          (:distinct false))))


Rework tracker to allow operations to carry from one thread to another

--- src/io/aviso/tracker.clj
+++ src/io/aviso/tracker.clj
@@ -1,18 +1,37 @@
 (ns io.aviso.tracker
   "Code for tracking operations so that a history can be presented when an exception is thrown."
-  (:require
-    [clojure.tools.logging :as l]
-    [clojure.tools.logging.impl :as impl]
-    [io.aviso.exception :as exception]))
+  (:require [clojure.string :as str]
+            [clojure.tools.logging :as l]
+            [clojure.tools.logging.impl :as impl]
+            [io.aviso.writer :as writer]
+            [io.aviso.exception :as exception])
+  (:import (java.util WeakHashMap Map)))

 ;;; Contains a vector of messages (or functions that return messages) used to log the route to the exception.
-(def ^:dynamic ^:private *operation-traces*)
+(def ^:dynamic *operation-traces*
+  "Contains a vector of operation traces (as passed to [[trace]]). These are used to log operations, when exceptions
+  occur."
+  [])

-(def ^:dynamic ^:private *innermost-exception*)
+(def ^:dynamic *log-trace-level*
+  "Controls whether operation traces are logged on entry to the [[track]] macro. By default (nil), no
+  logging takes places.  Otherwise, this is a level (such as :debug or :info) to be used."
+  nil)

-(def ^:dynamic *log-traces*
-  "A boolean to control the whether traces are logged at :trace level as they are created."
-  false)
+(def ^:private ^Map log-exceptions?
+  (WeakHashMap.))
+
+(defn- set-should-log-operations!
+  [flag]
+  (locking log-exceptions?
+    (if flag
+      (.put log-exceptions? (Thread/currentThread) true)
+      (.remove log-exceptions? (Thread/currentThread)))))
+
+(defn- should-log-operations?
+  []
+  (locking log-exceptions?
+    (.get log-exceptions? (Thread/currentThread))))

 (defn- label-to-string
   "Converts a trace to a string; a trace may be a function which is invoked."
@@ -22,11 +41,15 @@
 (defn- error [logger message]
   (l/log* logger :error nil message))

-(defn- log-trace-label-stack [logger trace-labels message e]
-  (error logger "An exception has occurred:")
-  (doseq [[trace-message i] (map vector trace-labels (iterate inc 1))]
-    (error logger (format "[%3d] - %s" i trace-message)))
-  (error logger (format "%s%n%s" message (exception/format-exception e))))
+(defn- log-trace-label-stack [logger trace-labels e]
+  (let [lines (concat ["An exception has occurred."]
+                      (map-indexed (fn [i label]
+                                     (format "[%3d] - %s" (inc i) label))
+                                   trace-labels)
+                      [(exception/format-exception e)])]
+    (->> lines
+         (str/join writer/eol)
+         (error logger))))

 (defn track*
   "Tracks the execution of a function of no arguments. The trace macro converts into a call to track*.
@@ -41,27 +64,22 @@
   f
   : function to invoke. track* returns the result from this function."
   [logger label f]
-  (if (bound? #'*operation-traces*)
+  (binding [*operation-traces* (conj *operation-traces* label)]
+    (set-should-log-operations! true)
     (try
-      (swap! *operation-traces* conj label)
-      (when *log-traces* (l/log* logger :trace nil (label-to-string label)))
+      (when *log-trace-level*
+        (l/log* logger *log-trace-level* nil (label-to-string label)))
       (f)
       (catch Throwable e
-        (if @*innermost-exception*
-          (let [trace-label-strings (mapv label-to-string @*operation-traces*)
+        (if (should-log-operations?)
+          (let [trace-label-strings (mapv label-to-string *operation-traces*)
                 message (or (.getMessage e) (-> e .getClass .getName))]
-            (log-trace-label-stack logger trace-label-strings message e)
-            (reset! *innermost-exception* false)
+            (log-trace-label-stack logger trace-label-strings e)
+            (set-should-log-operations! false)
             (throw (ex-info message
                             {:operation-trace trace-label-strings}
                             e)))
-          (throw e)))
-      (finally
-        (swap! *operation-traces* pop)))
-    ;; Else, if not yet bound..
-    (binding [*operation-traces* (atom [])
-              *innermost-exception* (atom true)]
-      (track* logger label f))))
+          (throw e))))))

 (defn get-logger
   "Determines the logger instance for a namespace (by leveraging some clojure.tools.logging internals)."
@@ -76,7 +94,13 @@
   most deeply nested label. The exception thrown is formatted and logged as well.  The actual exception will be rethrown, wrapped in a
   new `ex-info` exception, with key `:operation-trace` set to the vector of operation trace strings.

-  label may be a string, an object, or a function that returns a string; execution of the function is deferred until needed."
+  label may be a string, an object, or a function that returns a string; execution of the function is deferred until
+  an operation trace label is needed.
+
+  The operation trace is stored in a dynamic var; if you make use of Clojure's bound-fn macro to execute code in a new thread
+  with the same bindings, then operations in a new thread will log as successors to operations in the current thread.
+
+  Note that the clojure.core.async thead and go macros *do* propogate bindings to new threads."
   [label & body]
   `(track* (get-logger ~*ns*) ~label #(do ~@body)))


Generalise body mime-type handling.

Generalise body mime-type handling.

--- src/kixi/hecuba/amon.clj
+++ src/kixi/hecuba/amon.clj
@@ -100,6 +100,11 @@
     [:pre (with-out-str
             (pprint item))]]))

+(defmulti decode-body :content-type :default "application/json")
+
+(defmethod decode-body "application/json" [{body :body}] (some-> body read-json-body ->shallow-kebab-map))
+(defmethod decode-body "application/edn" [{body :body}] (some-> body read-edn-body ->shallow-kebab-map))
+
 ;; Resources

 (defresource programmes [{:keys [commander querier]} handlers]
@@ -126,8 +131,8 @@
         items)))

   :post!
-  (fn [{{body :body} :request}]
-    {:programme-id (upsert! commander :programme (-> body read-json-body ->shallow-kebab-map))})
+  (fn [{request :request}]
+    {:programme-id (upsert! commander :programme (decode-body request))})

   :handle-created
   (fn [{id :programme-id {routes :modular.bidi/routes} :request}]
@@ -191,8 +196,8 @@
         coll)))

   :post!
-  (fn [{{body :body} :request}]
-    {:project-id (upsert! commander :project (-> body read-json-body ->shallow-kebab-map))})
+  (fn [request]
+    {:project-id (upsert! commander :project (decode-body request))})

   :handle-created
   (fn [{id :project-id {routes :modular.bidi/routes} :request}]


stronger validation of `defcomponent` structure

--- src/main/om_css/core.clj
+++ src/main/om_css/core.clj
@@ -192,7 +192,10 @@
               children))
    (foo (dom/a {:href \"http://google.com\"}))
    "
-  (when-not (and (vector? args) (= (count args) 2))
+  (when-not (and (vector? args) (= (count args) 2)
+              ;; arguments are vectors or destructuring maps
+              (or (symbol? (first args)) (map? (first args)))
+              (or (symbol? (second args)) (map? (second args))))
     (throw (IllegalArgumentException.
              (str "Malformed `defcomponent`. Correct syntax: "
                "`(defcomponent [props children] "


Deprecate semi-sweet version of *include-midje-checks*

--- src/midje/semi_sweet.clj
+++ src/midje/semi_sweet.clj
@@ -63,6 +63,11 @@
      :dynamic true}
   *include-midje-checks* true)

+(set-validator! #'*include-midje-checks*
+                (fn [_]
+                  (deprecate "Set #'midje.sweet/*include-midje-checks* instead of the #'midje.semi-sweet version.")
+                  true))
+

 ;;; Interface: Main macros


GAWB-1554 Changed hover text for unaccessible workspaces protected by… (#669)

* GAWB-1554 Changed hover text for unaccessible workspaces protected by a realm other than dbGapAuthorizedUsers.

--- src/cljs/main/broadfcui/page/workspaces_list.cljs
+++ src/cljs/main/broadfcui/page/workspaces_list.cljs
@@ -21,15 +21,17 @@

 (def row-height-px 56)

-(def disabled-text
+(def dbGap-disabled-text
   (str "This workspace contains controlled access data. You can only access the contents of this workspace if you are "
        "dbGaP authorized for TCGA data and have linked your FireCloud account to your eRA Commons account."))
+
+(def non-dbGap-disabled-text "This workspace is protected. To access the data, please contact help@firecloud.org.")

 (react/defc StatusCell
   {:render
    (fn [{:keys [props]}]
      (let [{:keys [nav-context data]} props
-           {:keys [href status disabled?]} data]
+           {:keys [href status disabled? hover-text]} data]
        [:a {:href (if disabled?
                     "javascript:;"
                     (nav/create-href nav-context href))
@@ -37,7 +39,7 @@
                     :backgroundColor (if disabled? (:disabled-state style/colors) (style/color-for-status status))
                     :margin "2px 0 2px 2px" :height (- row-height-px 4)
                     :cursor (when disabled? "default")}
-            :title (when disabled? disabled-text)}
+            :title hover-text}
         [:span {:style {:position "absolute" :top 0 :right 0 :bottom 0 :left 0
                         :backgroundColor "rgba(0,0,0,0.2)"}}]
         (style/center {}
@@ -51,7 +53,7 @@
   {:render
    (fn [{:keys [props]}]
      (let [{:keys [nav-context data]} props
-           {:keys [href status protected? disabled?]} data
+           {:keys [href status restricted? disabled? hover-text]} data
            color (style/color-for-status status)]
        [:a {:href (if disabled?
                     "javascript:;"
@@ -62,8 +64,8 @@
                     :cursor (when disabled? "default")
                     :height (- row-height-px 4)
                     :margin "2px 0"}
-            :title (when disabled? disabled-text)}
-        (when protected?
+            :title hover-text}
+        (when restricted?
           [:span {:style {:display "block" :position "relative"}}
            [:span {:style {:display "block" :position "absolute" :left -17 :top -9
                            :width (- row-height-px 4) :padding "4px 0"
@@ -219,10 +221,13 @@
           :->row (fn [ws]
                    (let [ws-name (get-workspace-name-string ws)
                          ws-href (let [x (:workspace ws)] (str (:namespace x) ":" (:name x)))
-                         disabled? (= (:accessLevel ws) "NO ACCESS")]
-                     [{:name ws-name :href ws-href :status (:status ws) :disabled? disabled?}
-                      {:name ws-name :href ws-href :status (:status ws) :disabled? disabled?
-                       :protected? (get-in ws [:workspace :realm])}
+                         disabled? (= (:accessLevel ws) "NO ACCESS")
+                         hover-text (when disabled? (if (get-in ws [:workspace :isProtected])
+                                                      dbGap-disabled-text
+                                                      non-dbGap-disabled-text))]
+                     [{:name ws-name :href ws-href :status (:status ws) :disabled? disabled? :hover-text hover-text}
+                      {:name ws-name :href ws-href :status (:status ws) :disabled? disabled? :hover-text hover-text
+                       :restricted? (get-in ws [:workspace :realm])}
                       (get-workspace-description ws)
                       (get-in ws [:workspace :lastModified])
                       (:accessLevel ws)


Better default values for sites

Better default values for sites

--- src/sleuth/sites.clj
+++ src/sleuth/sites.clj
@@ -25,8 +25,8 @@
   (mc/ensure-index "sites" (array-map :url 1) {:unique true})
   (let [id (if (nil? id) (ObjectId.) (ObjectId. id))
         site (merge {:_id id
-                     :name (if name (s/trim name) "")
-                     :url (if url (s/trim url) "")
+                     :name (if name (s/trim name) "New Site")
+                     :url (if url (s/trim url) "http://example.com")
                      :event-count (or event-count 0)
                      :site-key (gen-key user url)
                      :user-id (:_id user)


play music

play music

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -167,11 +167,16 @@
     ;; wait for fonts to be ready
     (<! render!)

+    (go (let [tune (<! (sound/load-sound "/sfx/splash-screen.ogg"))
+              [source gain] (sound/play-sound tune 0.4 true)
+              ])
+        )
+
     ;;
     ;; bouncing name
     ;;
     (sprite/set-alpha! test-text 0.0)
-    (sprite/set-scale! test-text 7)
+    (sprite/set-scale! test-text 6)
     (set! (.-filters test-text) #js [(make-test)])
     (.addChild (-> canvas :layer :ui) test-text)
     (resources/fadein test-text :duration 5)
@@ -188,15 +193,24 @@
     ;;
     ;; scrolling message
     ;;
-    (sprite/set-scale! scroll-text 4)
-    (.addChild (-> canvas :layer :ui) scroll-text)
-    (go (loop [n -3600]
-          (let [h (.-innerHeight js/window)
-                hh (/ h 2)
-                qh (/ h 4)]
-            (sprite/set-pos! scroll-text (* n -5) (- hh 80)))
-          (<! (events/next-frame))
-          (recur (if (> n 3600) -3600 (inc n)))))
+    (go
+      (sprite/set-scale! scroll-text 4)
+      (.addChild (-> canvas :layer :ui) scroll-text)
+      (sprite/set-pos! scroll-text 10000 10000)
+
+      ;; we have to wait a frame or the font is wrong? huh?
+      (<! (events/next-frame))
+      (let [w (.-width scroll-text)
+            hw (/ w 2 5)
+            buff 300
+            off (+ hw buff)]
+        (go (loop [n (- off)]
+              (let [h (.-innerHeight js/window)
+                    hh (/ h 2)
+                    qh (/ h 4)]
+                (sprite/set-pos! scroll-text (* n -5) (- hh 80)))
+              (<! (events/next-frame))
+              (recur (if (> n off) (- off) (inc n)))))))

     ;;
     ;; parallax stars


did stuff

did stuff

--- src-clj/mappt/database/sqlite/core.clj
+++ src-clj/mappt/database/sqlite/core.clj
@@ -298,7 +298,17 @@
               WHERE object_uuid = ?" uuid]]
         (jdbc/query conn query))))

-  (property-insert! [this prop])
+  (property-insert! [this {:keys [name type value_uuid object_uuid]
+                           :or {name (str "property-" (uuid))}
+                           :as props}]
+    (jdbc/with-db-connection [conn db-spec]
+      (let [prop-map
+            {:name name
+             :type type
+             :value_uuid value_uuid
+             :object_uuid object_uuid}]
+        (jdbc/insert! conn :mappt_properties prop-map))))
+
   (property-update! [this prop])
   (property-delete! [this prop])
   MapptHierarchy


Normalize responses from providers to match our schema

--- domain/src/domain/cv.clj
+++ domain/src/domain/cv.clj
@@ -43,19 +43,34 @@
     (let [res (f image creds)]        ; call f to POST
       (>!! c (json/read-str (:body res) :key-fn keyword))))) ; parse result as json, put it in c

+(defn- age->sym [n]
+  (let [age (if (string? n)
+              (Integer/parseInt n)
+              n)]
+    (cond
+      (>= age 50) :old
+      (>= age 30) :mid
+      :else       :young)))
+
+(defn- str->kw [str]
+  (-> str (.toLowerCase) (keyword)))
+
 (defn normalize-sightcorp [result]
-  (map (fn [x]
-         {:age    (get-in x [:age :value])
-          :gender (get-in x [:gender :value])})
+  (map (fn [r]
+         {:age    (age->sym (get-in r [:age :value]))
+          :gender (str->kw  (get-in r [:gender :value]))})
        (:persons result)))

 (defn normalize-microsoft [result]
-  (map :attributes result))
+  (map (fn [r]
+         {:age    (age->sym (get-in r [:attributes :age]))
+          :gender (str->kw  (get-in r [:attributes :gender]))})
+       result))

 (defn normalize-faceplus [result]
-  (map (fn [x]
-         {:age    (get-in x [:attribute :age :value])
-          :gender (get-in x [:attribute :gender :value])})
+  (map (fn [r]
+         {:age    (age->sym (get-in r [:attribute :age :value]))
+          :gender (str->kw  (get-in r [:attribute :gender :value]))})
        (:face result)))

 (defn get-features [image]


Adding support for multi-channel buffers.

--- src/overtone/core/sc.clj
+++ src/overtone/core/sc.clj
@@ -646,14 +646,15 @@
 ; size is in samples
 (defn buffer
   "Allocate a new buffer for storing audio data."
-  [size]
-  (let [id (alloc-id :audio-buffer)
+  [size & [channels]]
+  (let [channels (or channels 1)
+        id (alloc-id :audio-buffer)
         ready? (atom false)]
     (on "/done" #(if (= "/b_alloc" (first (:args %)))
                    (do
                      (reset! ready? true)
                      :done)))
-    (snd "/b_alloc" id size)
+    (snd "/b_alloc" id size channels)
     (with-meta {:id id
                 :size size
                 :ready? ready?}


Added caching and storing by date.

Added caching and storing by date.

--- src/vertigo/core.clj
+++ src/vertigo/core.clj
@@ -1,22 +1,34 @@
 (ns views
   (:use [hiccup.core]))

-(defn- layout [content]
+(defn layout [content]
   (html [:html
           [:head]
           [:body
             [:div#content
               content]]]))

-(defn list-shows [shows]
+(defn render-show [show]
+  [:div (:title show)])
+
+(defn show-table [shows]
   [:table
-    (for [day shows]
+    [:tr
+      [:th "Date"]
+      [:th "Comedy"]
+      [:th "Action"]
+      [:th "Drama"]
+      [:th "Others"]]
+    (for [[day genres] shows]
       [:tr
-        [:td (:time (first (:comedy day)))]
-        [:td (map :title (:comedy day))]])])
+        [:td day]
+        [:td (map render-show (:comedy genres))]
+        [:td (map render-show (:action genres))]
+        [:td (map render-show (:drama genres))]
+        [:td (map render-show (:other genres))]])])

-(defn shows [shows]
-  (layout (list-shows shows)))
+(defn calendar [shows]
+  (layout (show-table shows)))

 (ns vertigo.core
   (:require [clojure.xml :as xml]
@@ -30,45 +42,45 @@

 (defrecord Show [title
                  theatre
-                 time
                  genres
                  image])
+(def shows-db (atom {}))

-(defn group-by-genre [shows]
-  (group-by
-    (fn [{genres :genres}]
-      (condp some genres
-        #{"Komedia"} :comedy
-        #{"Draama"} :drama
-        #{"Toiminta"} :action
-        :other))
-    shows))
+(defn parse-shows-and-group-by-genre [xz]
+  (let [shows (for [show (xml-> xz :Shows :Show)]
+          (Show.
+            (xml1-> show :OriginalTitle text)
+            (xml1-> show :TheatreAndAuditorium text)
+            (into #{} (split (xml1-> show :Genres text) #", "))
+            (xml1-> show :Images :EventLargeImagePortrait text)))]
+    (group-by
+      (fn [{genres :genres}]
+        (condp some genres
+          #{"Komedia"} :comedy
+          #{"Draama"} :drama
+          #{"Toiminta"} :action
+          :other))
+      shows)))

-(defn parse-shows [xz]
-  (for [show (xml-> xz :Shows :Show)]
-    (Show.
-      (xml1-> show :OriginalTitle text)
-      (xml1-> show :TheatreAndAuditorium text)
-      (xml1-> show :dttmShowStart text)
-      (into #{} (split (xml1-> show :Genres text) #", "))
-      (xml1-> show :Images :EventLargeImagePortrait text))))
+(defn retrieve-shows-by-date [date]
+  (let [formatted-date (unparse (formatter "dd.MM.yyyy") date)
+        cached-shows   (get @shows-db formatted-date)]
+    (if cached-shows
+      [formatted-date cached-shows]
+      (let [new-shows (parse-shows-and-group-by-genre
+                        (zip/xml-zip
+                          (xml/parse
+                            (str "http://finnkino.fi/xml/Schedule/?area=1002&dt="
+                                 formatted-date))))]
+        [formatted-date (get (swap! shows-db assoc formatted-date new-shows) formatted-date)]))))

-(def finnish-date-format (formatter "dd.MM.yyyy"))
-
-(def week-of-shows
-  (pmap
-    parse-shows
-    (map
-      #(zip/xml-zip (xml/parse (str "http://finnkino.fi/xml/Schedule/?area=1002&dt=" (unparse finnish-date-format %))))
-      (for [day (range 7)]
-        (.plusDays (now) day)))))
-
-(def week-of-shows-grouped-by-genre
-  (map group-by-genre (filter not-empty week-of-shows)))
+(defn retrieve-shows-for-whole-week []
+  (let [dates (take 7 (iterate #(.plusDays % 1) (now)))]
+    (map retrieve-shows-by-date dates)))

 (defroutes handler
   (GET "/" []
-    (views/shows week-of-shows-grouped-by-genre)))
+    (views/calendar (retrieve-shows-for-whole-week))))

 (run-jetty handler {:port 8080 :join? false})


Added lots of documentation to the util.clj simulation-plans variable.


replaced colon with slash in mi bio_to_ice rule

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/bio_to_ice/ontology_ice_gen_rules.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/bio_to_ice/ontology_ice_gen_rules.clj
@@ -73,7 +73,7 @@
 ;; create ICE URI's for each term in the PSI Molecular Interaction Ontology
 `{:name "mi-ice-gen"
   :head ((?/ice obo/IAO_0000219 ?/cls)) ; denotes
-  :body ((?/cls oboInOwl:hasOBONamespace ["PSI-MI"])
+  :body ((?/cls oboInOwl/hasOBONamespace ["PSI-MI"])
          (?/cls rdf/type owl/Class))
   :reify ([?/ice {:ln (:localname ?/cls)
                   :ns "iaomi" :prefix "" :suffix "_ICE"}])}


turn off the ga script while we debug

turn off the ga script while we debug

--- src/pc/views/content.clj
+++ src/pc/views/content.clj
@@ -102,7 +102,9 @@
                                        (utils/update-when-in [:cust] #(-> % escape-entity pr-str))
                                        (assoc :cdn-base-url (common/cdn-base-url)))))
     (when (prod-assets?)
-      scripts/google-analytics)
+      ;; turn off while we figure out why this is breaking
+      nil;scripts/google-analytics
+      )
     (scripts/rollbar (pc.profile/env) (pc.assets/asset-manifest-version))
     (scripts/mixpanel)]
    [:body


added tests for analytics.track/project-image-change

--- src-cljs/frontend/analytics/core.cljs
+++ src-cljs/frontend/analytics/core.cljs
@@ -59,7 +59,6 @@
     :build-timing-upsell-clicked
     :build-timing-upsell-impression
     :cancel-plan-clicked
-    :change-image-clicked
     :insights-bar-clicked
     :login-clicked
     :new-plan-clicked


Don't reimplement pdoseq and prun in lazy/

--- src/clj/com/climate/claypoole/lazy.clj
+++ src/clj/com/climate/claypoole/lazy.clj
@@ -237,10 +237,14 @@
   Similar to pfor, only the body is done in parallel. For more details, see
   pfor."
   [pool bindings & body]
-  `(dorun (upfor ~pool ~bindings (do ~@body))))
+  ;; There's no sensible lazy version of this, so just use base claypoole's
+  ;; implementation.
+  `(cp/pdoseq ~pool ~bindings ~@body))

 (defn prun!
   "Like run!, but in parallel. Unlike the streaming sequence functions (e.g.
   pmap), prun! blocks until all the work is done."
   [pool proc coll]
-  (dorun (upmap pool proc coll)))
+  ;; There's no sensible lazy version of this, so just use base claypoole's
+  ;; implementation.
+  (cp/prun! pool proc coll))


Update SQL call

Update SQL call

--- src/clj/org/openforis/ceo/db/plots.clj
+++ src/clj/org/openforis/ceo/db/plots.clj
@@ -45,8 +45,7 @@
   (let [plot-id (tc/val->int (:plotId params))]
     (data-response (if-let [geom (sql-primitive (call-sql "select_plot_geom" plot-id))]
                      {:geom    geom
-                      :samples (->> (call-sql "select_plot_sample_geoms" plot-id)
-                                    (mapv (fn [{:keys [geom]}] {:geom geom})))}
+                      :samples (call-sql "select_plot_sample_geoms" plot-id)}
                      ""))))

 (defn- unlock-plots [user-id]


Minor cosmetic changes on routing ns.

Minor cosmetic changes on routing ns.

--- src/clojure/catacumba/impl/routing.clj
+++ src/clojure/catacumba/impl/routing.clj
@@ -86,7 +86,9 @@
   [^Chain chain [_ handlersmap]]
   {:pre [(map? handlersmap)]}
   (letfn [(attach [^Context ctx ^ByMethodSpec spec [method handler]]
-            (let [^Handler handler (if (vector? handler) (combine-handlers handler) (hs/adapter handler))
+            (let [^Handler handler (if (vector? handler)
+                                     (combine-handlers handler)
+                                     (hs/adapter handler))
                   ^Block block (hp/fn->block #(.handle handler ctx))]
               (case method
                 :get (.get spec block)


added :_initialization hint for component. It may be needed fot tricky GUIs like panel that adds new components onto itself on mouse click. Full init cycle on the first addition may result in adding duplicated component because of component-adding evolver called during init

--- flatguicore/src/flatgui/widgets/componentbase.clj
+++ flatguicore/src/flatgui/widgets/componentbase.clj
@@ -200,7 +200,8 @@
                                               (= original-target-id-path target-id-path) reason))
              target-component (assoc pre-target-component
                                 :target-id-path-index (dec (count target-id-path))
-                                :evolve-reason-provider evolve-reason-provider)
+                                :evolve-reason-provider evolve-reason-provider
+                                :_initialization initialization)
              ps-count (count properties-to-evolve)]
         (loop [ pi 0
                 tgt target-component
@@ -348,11 +349,6 @@
 (defn evolve-by-dependencies [original-container container original-target-id-path target-id-path reason properties-to-evolve debug-shift initialization issuer]
     (let [ ;[GOOD DEBUG OUTPUT] _ (if (not= [:text :selection] properties-to-evolve) (println (debug-prefix debug-shift) ">>> entered evolve-by-dependencies function " target-id-path " for properties " properties-to-evolve))
            k (fgc/get-access-key target-id-path)
-           evolved-properties-key (fgc/conjv k :evolved-properties)
-          ;already-evolved (get-in (:aux-container container) evolved-properties-key)
-           ;
-           ;@todo If current reason in not a vector (which meands depencency), take only evolvers dependent on current reason
-           ;
            remaining-to-evolve (if properties-to-evolve
                                  properties-to-evolve
                                  (if initialization


threaded poller

threaded poller

Use standard java wait and notify to broadcast to worker threads
when there are new votes to process.

Ensure no two worker threads are working on the same zid by keeping
the in-progress zids in a set.

Track the votes which need processing in a map of lists for each zid.

--- src/polismath/poller.clj
+++ src/polismath/poller.clj
@@ -12,7 +12,9 @@
             [clojure.java.jdbc :as sql]
             [monger.core :as mg]
             [monger.collection :as mgcol]
+            [clojure.tools.trace :as tr]
             [environ.core :as env]))
+

@@ -65,35 +67,83 @@
                (encode-seq (into-array v) jsonGenerator)))

-
-(defn -main []
-  (println "launching poller " (System/currentTimeMillis))
-  (let [poll-interval 1000
-        pg-spec         (heroku-db-spec (env/env :database-url))
-        mg-db           (mongo-connect! (env/env :mongo-url))
-        last-timestamp  (atom 0)
-        conversations   (atom {})]
-    (endlessly poll-interval
-      (println "poll >" @last-timestamp)
-      (let [new-votes (poll pg-spec @last-timestamp)
-            zid-to-votes (group-by :zid new-votes)
-            zid-votes (shuffle (into [] zid-to-votes))
-            ]
-        (doseq [[zid votes] zid-votes]
-          (let [lastVoteTimestamp (:created (last votes))]
-            (swap! conversations
-              (fn [convs]
-                (assoc convs zid
-                    (try
-                      (do
-                        (println "zid: " zid)
-                        (conv-update (or (convs zid) {:rating-mat (named-matrix)}) votes))
-                      (catch Exception e
-                        (do
-                          (println "exception when processing zid: " zid)
-                          (.printStackTrace e)))))))
-
-            (println "zid: " zid)
+(def poll-interval 1000)
+(def pg-spec         (heroku-db-spec (env/env :database-url)))
+(def mg-db           (mongo-connect! (env/env :mongo-url)))
+(def last-timestamp  (atom 0))
+(def conversations   (atom {})) ; generated artifacts
+(def pending-votes   (ref {})) ; zid -> votes
+
+(def dinner-bell (Object.))
+(def active-zids (ref #{}))
+(def pending-votes (ref {})) ; zid -> new votes
+
+(defn notify-workers []
+  (locking dinner-bell
+    (.notifyAll dinner-bell)))
+
+(defn wait-for-dinner-bell []
+  (locking dinner-bell
+    (.wait dinner-bell)))
+
+(defn pending-inactive-zids []
+  (filter (fn [zid] (not (contains? @active-zids zid)))
+          (keys @pending-votes)))
+
+(defn should-take-votes []
+  (> (count (pending-inactive-zids)) 0))
+
+(defn should-not-take-votes []
+  (not (should-take-votes)))
+
+
+(defn make-worker-thread [id]
+ (fn [] ;; closure to capture the id
+  (do
+    (println "starting worker thread" id)
+   (while #(true)
+     (do
+       (println "worker" id "checking for votes")
+    ; if there are votes pending, take a zid and go for it.
+    ; otherwise, wait for a notification
+    (while (should-not-take-votes)
+      (do
+        (println "worker" id "no votes to take")
+        (wait-for-dinner-bell)))
+    ;
+    (let [
+          [zid votes]
+          (dosync
+           ; TODO ensure that we actually get votes here.
+           (let [zid (first (shuffle (pending-inactive-zids)))
+                 votes (@pending-votes zid)]
+             (do
+               (ref-set pending-votes (dissoc @pending-votes zid))
+               (ref-set active-zids (conj @active-zids zid))
+               (vector zid votes))))]
+
+      (println "worker thread" id "starting on math for zid:" zid)
+
+
+    ; DO MATH
+      (swap!
+       conversations
+       (fn [convs]
+         (assoc convs zid
+                (try
+                  (do
+                    (conv-update (or (convs zid) {:rating-mat (named-matrix)}) votes))
+                  (catch Exception e
+                    (do
+                      (println "exception when processing zid: " zid)
+                      (.printStackTrace e)))))))
+
+
+    ; UPLOAD/PUBLISH - do this in worker thread so we don't start more
+    ; work on a zid before we upload the result. That may be a later optimization.
+
+      (let [lastVoteTimestamp (:created (last votes))]
+          (println "zid: " zid)
             (println "time: " (System/currentTimeMillis))
             (println "\n\n")
             (let [
@@ -113,7 +163,49 @@
                 (assoc obj
                  "lastVoteTimestamp" lastVoteTimestamp
                  "zid" zid))))
-
-        (swap! last-timestamp (fn [_] (:created (last new-votes))))
-
-      ))))))
+            )
+
+      (println "worker thread" id "finished zid" zid)
+      (dosync ; do-sync needed?
+       (ref-set active-zids (disj @active-zids zid)))
+  ))))))
+
+
+(defn merge-pending-votes [zid-votes-pairs]
+  (dosync ;; dosync needed?
+   (ref-set pending-votes
+    (reduce
+     (fn [o zid-vote-pair]
+       (let [zid (first zid-vote-pair) votes (second zid-vote-pair)]
+         (assoc o zid
+                (concat (or (get o zid) [])
+                        votes))))
+     @pending-votes
+     zid-votes-pairs
+     ))))
+
+
+(defn -main []
+  (println "launching poller " (System/currentTimeMillis))
+
+  (let [threads (map #(Thread. %1)
+                     (map make-worker-thread
+                          (range 4)))]
+    (println (map #(.start %1) threads))
+    )
+
+
+  (endlessly poll-interval
+      (println "poll >" @last-timestamp)
+      (let [new-votes (poll pg-spec @last-timestamp)
+            zid-to-votes (group-by :zid new-votes)
+            zid-votes (into [] zid-to-votes)
+            ]
+        (if (> (count zid-votes) 0)
+          (do
+            (println "poller found new votes for" (count zid-votes) "conversations.")
+            (merge-pending-votes zid-votes)
+            (notify-workers)
+            (swap! last-timestamp (fn [_] (:created (last new-votes))))))
+
+        )))


Woops... main -> -main in polismath.server

--- src/polismath/server.clj
+++ src/polismath/server.clj
@@ -408,7 +408,7 @@

 ;; Main function; just start the component

-(defn main []
+(defn -main []
   (start-server!))

 ;; For sketching and REPLING


updating system with ip and vmid works

updating system with ip and vmid works

--- src/proxmox/provider.clj
+++ src/proxmox/provider.clj
@@ -101,15 +101,13 @@
   Vm
   (create [this]
           (debug "creating" (:vmid ct))
-          (let [ct* (gen-ip ct) {:keys [hostname vmid ip_address]} ct* id (extended :id)]
+          (let [ct* (gen-ip ct) {:keys [hostname vmid ip_address]} ct* id (extended :system-id)]
             (try+
-              (debug "ct* is" ct* )
-              (debug "ct is" ct )
               (check-task node (prox-post (str "/nodes/" node "/openvz") ct*))
               (enable-features this)
               (when (p/system-exists? id)
                 (p/update-system id
-                  (merge-with merge (p/get-system id) {:proxmox (select-keys ct* [:vmid :ip_address])})))
+                  (merge-with merge {:proxmox (select-keys ct* [:vmid :ip_address])} (p/get-system id))))
               (catch [:status 500] e
                 (release-ip (ct* :ip_address))
                 (warn "Container already exists" e)))))


Some debugging stuff.

Some debugging stuff.

--- src/rewindable/agos.cljs
+++ src/rewindable/agos.cljs
@@ -5,19 +5,27 @@
             [cljs.core.async.impl.buffers]
             [cljs.core.async.impl.channels]))

+(defn sstate [state]
+  (println (rest state)))
+
 (defn agos-take [state blk ^not-native c]
+  (println :agos-take (sstate state) blk c)
   (cljs.core.async.impl.ioc-helpers/take! state blk c))

 (defn agos-put [state blk ^not-native c val]
+  (println :agos-put (sstate state) blk c val)
   (cljs.core.async.impl.ioc-helpers/put! state blk c val))

 (defn agos-alts [state cont-block ports & rest]
+  (println :agos-alts (sstate state) cont-block ports rest)
   (apply cljs.core.async.impl.ioc-helpers/ioc-alts! state cont-block ports rest))

 (defn agos-return-chan [state value]
+  (println :agos-return-chan (sstate state) value)
   (cljs.core.async.impl.ioc-helpers/return-chan state value))

 (defn agos-chan [buf]
+  (println :agos-chan buf)
   (cljs.core.async.impl.channels/ManyToManyChannel. (buffers/ring-buffer 32) 0
                                                     (buffers/ring-buffer 32) 0
                                                     buf false))


Use alphabetical order

Use alphabetical order

--- examples/nightpad/src/nightpad/core.clj
+++ examples/nightpad/src/nightpad/core.clj
@@ -2,8 +2,8 @@
   (:require [nightcode.completions :as completions]
             [nightcode.editors :as editors]
             [nightcode.shortcuts :as shortcuts]
+            [nightcode.ui :as ui]
             [nightcode.utils :as utils]
-            [nightcode.ui :as ui]
             [nightcode.window :as window]
             [seesaw.core :as s])
   (:gen-class))