Better fix for update share from email org.

--- src/oc/storage/api/updates.clj
+++ src/oc/storage/api/updates.clj
@@ -28,14 +28,16 @@
     (first (filter #(= slack-org-id (:slack-org-id %)) slack-bots))))

   ;; Other share requests don't need a Slack bot
-  ([_share-request _author] nil))
+  ([_share-request _author] :not-applicable))

 (defn- valid-share-request? [conn org-slug {share-request :data author :user}]
   (if-let [org (org-res/get-org conn org-slug)]
     (try
       (if-let* [new-update (update-res/->update conn org-slug share-request author)
                 slack-bot (slack-bot-for-share share-request author)]
-        {:new-update new-update :existing-org org :slack-bot (when slack-bot (dissoc slack-bot :slack-org-id))}
+        {:new-update new-update
+         :existing-org org
+         :slack-bot (when (map? slack-bot) (dissoc slack-bot :slack-org-id))}
         [false, {:existing-org org :reason "Slack bot not configured."}])
       (catch clojure.lang.ExceptionInfo e
         [false, {:existing-org org :reason (.getMessage e)}])) ; Not a valid share request


Speed it up a touch.

Speed it up a touch.

--- src/overtunes/songs/at_all.clj
+++ src/overtunes/songs/at_all.clj
@@ -100,6 +100,6 @@
   (at (timing 0)
       (chord# (update-in I [:i] raise))))

-(defn play# [] (-> (bpm 120) (from 2) intro# first-bit# (speed-up 3/2) variation# final-chord#))
+(defn play# [] (-> (bpm 160) (from 2) intro# first-bit# (speed-up 3/2) variation# final-chord#))

 ; (play#)


Undo the last couple of useless tweaks

Undo the last couple of useless tweaks

--- src/swartz/models/core.clj
+++ src/swartz/models/core.clj
@@ -1,8 +1,4 @@
 (ns swartz.models.core
-  (:require [environ.core :refer [env]]
-            [clojure.string :as str]))
+  (:require [environ.core :refer [env]]))

-(def db {:connection-uri (str/replace (env :database-url)
-                                      #":postgres:"
-                                      ":postgresql:")
-         :classname "org.postgresql.Driver"})
+(def db {:connection-uri (env :database-url)})


trend arrow for recent position changes

trend arrow for recent position changes

--- Clojure-Websockets/MainApp/src/cljs/birdwatch/wordcount_barchart.cljs
+++ Clojure-Websockets/MainApp/src/cljs/birdwatch/wordcount_barchart.cljs
@@ -1,10 +1,16 @@
 (ns birdwatch.wordcount-barchart
   (:require [birdwatch.util :as util]
+            [birdwatch.stats.regression :as reg]
             [reagent.core :as r :refer [atom]]))

 (enable-console-print!)

 (def items (atom []))
+(def pos-trends (atom {}))
+(def pos-items (atom {}))
+(def ratio-trends (atom {}))
+(def ratio-items (atom {}))
+
 (def ts-elem (util/by-id "wordcount-barchart"))
 (def ts-w (aget ts-elem "offsetWidth"))
 (def text-defaults {:stroke "none" :fill "#DDD" :fontWeight 500 :fontSize "0.8em" :dy ".35em" :textAnchor "end"})
@@ -25,37 +31,44 @@
     [:polygon {:transform arrowTrans :stroke "none" :fill color :points points}]))

 (defn bar [text cnt y h w idx]
-  [:g
-   [:text {:y (+ y 8) :x 138 :stroke "none" :fill "black" :dy ".35em" :textAnchor "end"} text]
-   [arrow 146 y :RIGHT-UP]
-   [arrow 160 y :RIGHT]
-   [:rect {:y y :x 168 :height 15 :width w :stroke "white" :fill "#428bca"}]
-   (if (> w 50)
-     [:text (merge text-defaults {:y (+ y 8) :x (+ w 160)}) cnt]
-     [:text (merge text-defaults {:y (+ y 8) :x (+ w 171) :fill "#666" :textAnchor "start"}) cnt])])
+  (let [pos-slope (get @pos-trends text)]
+    [:g
+     [:text {:y (+ y 8) :x 138 :stroke "none" :fill "black" :dy ".35em" :textAnchor "end"} text]
+     [arrow 146 y (cond
+                   (pos? pos-slope) :UP
+                   (neg? pos-slope ) :DOWN
+                   :else :RIGHT)]
+     [arrow 160 y :RIGHT]
+     [:rect {:y y :x 168 :height 15 :width w :stroke "white" :fill "#428bca"}]
+     (if (> w 50)
+       [:text (merge text-defaults {:y (+ y 8) :x (+ w 160)}) cnt]
+       [:text (merge text-defaults {:y (+ y 8) :x (+ w 171) :fill "#666" :textAnchor "start"}) cnt])]))

 (defn wordcount-barchart []
-  (let [items @items
-        indexed (map-indexed vector items)
-        mx (apply max (map (fn [[k v]] v) items))
-        cnt (count items)]
+  (let [indexed @items
+        mx (apply max (map (fn [[idx [k v]]] v) indexed))
+        cnt (count indexed)]
     [:div
      [:svg {:width ts-w :height (+ (* cnt 15) 5)}
       [:g
-        (doall (for [[idx [text cnt]] indexed]
-                 [bar text cnt (* idx 15) 15 (* (- ts-w 190) (/ cnt mx)) idx]))
+       (for [[idx [text cnt]] indexed]
+         ^{:key text}[bar text cnt (* idx 15) 15 (* (- ts-w 190) (/ cnt mx)) idx])
        [:line {:transform "translate(168, 0)" :y 0 :y2 (* cnt 15) :stroke "black"}]]]
      [:p.legend [:strong "1st trend indicator:"] " position changes in last "
       [:select {:defaultValue 300000}
-       (for [[v t] opts1] [:option {:value (* v 1000)} t])]]
+       (for [[v t] opts1] ^{:key v} [:option {:value (* v 1000)} t])]]
      [:p.legend [:strong "2nd trend indicator:"] " ratio change termCount / totalTermsCounted over last "
       [:select {:defaultValue 100}
-       (for [[v t] opts2] [:option {:value v} t])]]]))
+       (for [[v t] opts2] ^{:key v} [:option {:value v} t])]]]))

 (r/render-component [wordcount-barchart] ts-elem)

 (defn update-words
   "update wordcount chart"
   [words]
-  (reset! items words))
+  (reset! items (vec (map-indexed vector words)))
+  (doseq [[idx [text cnt]] @items]
+    (let [slope (get (reg/linear-regression (take 3 (get @pos-items text))) 1)]
+      (swap! pos-items update-in [text] conj idx)
+      (swap! pos-trends assoc-in [text] slope))))


remove a degug statement, and add a comment

--- src/tamaki_core/invoke.clj
+++ src/tamaki_core/invoke.clj
@@ -28,9 +28,9 @@
   (not (= (.indexOf steps step) -1)))

 (defn build
+  "executes steps"
   ([step config]
    (doseq [p (sub-steps step steps)]
-     (println p)
      (invoke p config)))
   ([step] (build step (config/load-config))))


removed line height for android

removed line height for android

--- src/status_im/ui/screens/wallet/components/styles.cljs
+++ src/status_im/ui/screens/wallet/components/styles.cljs
@@ -17,8 +17,7 @@
    :ios     {:font-size      14
              :line-height    16
              :letter-spacing -0.2}
-   :android {:font-size   12
-             :line-height 12}})
+   :android {:font-size   12}})

 (def amount-text-input-container
   {:margin-top 8})


test cleanup

test cleanup

--- test/cljs/ohds/component-test.cljs
+++ test/cljs/ohds/component-test.cljs
@@ -20,37 +20,35 @@
   (go
     {:status 401 :body "bad login"}))

-(deftest login-form-rendering
-  (testing "login form success"
-    (async
-     done
-     (go
-       (with-redefs [http/post fake-login-success]
-         (with-mounted-component (c/login-form
-                                  app/login!
-                                  (fn [r s]
-                                    (app/login-callback r s)
-                                    (is (= (:page @app/app-state) :location))
-                                    (is (= (:fieldworker-id @app/app-state) "abc-123"))))
-           (fn [_ div]
-             (is (found-in #"Username" div))
-             (is (found-in #"Password" div))
-             (is (found-in #"Login" div))
-             (.click (.getElementById js/document "Login")))))
-       (done))))
-  (testing "login form failure"
-    (async
-     done
-     (go
-       (with-redefs [http/post fake-login-failure]
-         (with-mounted-component (c/login-form
-                                  app/login!
-                                  (fn [r s]
-                                    (app/login-callback r s)
-                                    (is (= (:page @app/app-state) :bad-login))
-                                    (is (nil? (:fieldworker-id @app/app-state)))))
-           (fn [_ div]
-             (.click (.getElementById js/document "Login")))))))))
+(deftest login-form-rendering ;;;TODO write a macro to clean up this duplication
+  (let [good-login-callback
+        (fn [r s]
+          (app/login-callback r s)
+          (is (= (:page @app/app-state) :location))
+          (is (= (:fieldworker-id @app/app-state) "abc-123")))
+        bad-login-callback
+        (fn [r s]
+          (app/login-callback r s)
+          (is (= (:page @app/app-state) :bad-login))
+          (is (nil? (:fieldworker-id @app/app-state))))
+        click-login (fn [] (.click (.getElementById js/document "Login")))]
+
+    (testing "login form success redirects to new location page"
+      (async done (go
+         (with-redefs [http/post fake-login-success]
+           (with-mounted-component (c/login-form app/login! good-login-callback)
+             (fn [_ div]
+               (is (found-in #"Username" div))
+               (is (found-in #"Password" div))
+               (is (found-in #"Login" div))
+               (click-login))))
+         (done))))
+    (testing "login form failure redirects to bad login page"
+      (async done (go
+         (with-redefs [http/post fake-login-failure]
+           (with-mounted-component (c/login-form app/login! bad-login-callback)
+             (fn [_ div] (click-login))))
+         (done))))))


no context = null

no context = null

--- src/webapp/controllers.clj
+++ src/webapp/controllers.clj
@@ -104,7 +104,7 @@

 (defn microblog_publish_ctrl [request] (let [message (:message (:params request))] (do
     (log request "microblog_post" "publish" (:remote-addr request) {:message message})
-    (mb_post_return message)
+    (mb_post_return message "")
     message_submitted)))

 (defn post_ctrl [request] (friend/authenticated (json_posts)))
@@ -176,4 +176,4 @@

 (defn fantasy-football_ctrl [request] (do
     (log request "fantasy_football" "page-view" (:remote-addr request) {})
-    ff))+    ff))


Disable the sine and cosine test sensors.

--- metlog-agent/src/metlog_agent/core.clj
+++ metlog-agent/src/metlog_agent/core.clj
@@ -26,8 +26,8 @@
 (defmacro defsensor [ name & body ]
   `(add-sensor-def ~name (fn [] ~@body)))

-(defsensor "sine" (Math/sin (/ (- (System/currentTimeMillis) start-t) 60000.0)))
-(defsensor "cosine" (Math/cos (/ (- (System/currentTimeMillis) start-t) 60000.0)))
+;; (defsensor "sine" (Math/sin (/ (- (System/currentTimeMillis) start-t) 60000.0)))
+;; (defsensor "cosine" (Math/cos (/ (- (System/currentTimeMillis) start-t) 60000.0)))

 (defn read-w1-sensor-at-path [ sensor-path ]
   (with-open [rdr (clojure.java.io/reader sensor-path)]


fix fragment scrolling to scroll to top

fix fragment scrolling to scroll to top

--- frontend/controllers/navigation.cljs
+++ frontend/controllers/navigation.cljs
@@ -10,6 +10,7 @@
             [frontend.utils.state :as state-utils]
             [frontend.utils.vcs-url :as vcs-url]
             [frontend.utils :as utils :refer [mlog merror]]
+            [goog.dom]
             [goog.string :as gstring]
             [goog.style])
   (:require-macros [frontend.utils :refer [inspect]]
@@ -30,9 +31,20 @@
 (defn scroll-to-fragment!
   "Scrolls to the element with id of fragment, if one exists"
   [fragment]
-  (when-let [node (sel1 (str "#" fragment))]
-    (let [main (sel1 "main.app-main")]
-      (set! (.-scrollTop main) (.-y (goog.style.getContainerOffsetToScrollInto node main))))))
+  (when-let [node (goog.dom.getElement fragment)]
+    (let [main (goog.dom.getElementByClass "app-main")
+          node-top (goog.style/getPageOffsetTop node)
+          main-top (goog.style/getPageOffsetTop main)
+          main-scroll (.-scrollTop main)]
+      (set! (.-scrollTop main) (+ main-scroll (- node-top main-top))))))
+
+(defn scroll!
+  "Scrolls to fragment if the url had one, or scrolls to the top of the page"
+  [args]
+  (if (:_fragment args)
+    ;; give the page time to render
+    (js/requestAnimationFrame #(scroll-to-fragment! (:_fragment args)))
+    (js/requestAnimationFrame #(set! (.-scrollTop (sel1 "main.app-main")) 0))))

 ;; --- Navigation Multimethod Declarations ---


Broke interaction-test/handshake pretty solidly

It's complex enough that I'm not following along very well. Need to
rethink this approach, too.

--- test/com/frereth/common/curve/interaction_test.clj
+++ test/com/frereth/common/curve/interaction_test.clj
@@ -195,27 +195,40 @@
                      cookie
                      500
                      ::timeout))
-    (throw (ex-info "Bad cookie"
+    (throw (ex-info "Bad Cookie packet from Server"
                     {:problem cookie}))))

 (defn wrote-cookie
   [clnt->srvr success]
-  (println "Cookie sent to server. Waiting for vouch")
+  (println "Server Cookie sent to client. Waiting for Initiate packet")
   (is success)
   (is (not= success ::timeout))
-  (strm/try-take! clnt->srvr ::drained 500 ::timeout))
+  (strm/try-take! (:chan clnt->srvr) ::drained 500 ::timeout))

 (defn vouch->server
-  [client-chan vouch]
+  [server-chan vouch]
   ;; I don't have any real failure indication available
   ;; if something goes wrong with/on the server trying
   ;; to cope with this incoming vouch.
   ;; I almost need an error stream for dealing with exceptions.
+  (println "Got Initiate packet from client: "
+           vouch
+           " for forwarding along to "
+           server-chan)
+  ;; There's something inside out going on.
+  ;; We just forwarded the from the server to the
+  ;; client (in wrote-cookie).
+  ;; Now we pulled the Initiate packet in response.
+  ;; The main point here is to forward that packet
+  ;; back to the Server.
+  ;; Which shouldn't have anything at all to do with
+  ;; client channels.
+  ;; Q: Was this ever making those round trips?
   (if-not (or (= vouch ::drained)
               (= vouch ::timeout))
-    (strm/try-put! (:chan client-chan)
+    (strm/try-put! (:chan server-chan)
                    {:message vouch
-                    :host "tester"
+                    :host "tester-client"
                     :port 65536}
                    500
                    ::timeout)
@@ -226,7 +239,7 @@
   [client-chan success]
   (if success
     (strm/try-take! (:chan client-chan) ::drained 500 ::timeout)
-    (throw (RuntimeException. "Failed writing Vouch to client"))))
+    (throw (RuntimeException. "Failed writing Vouch to server"))))

 (defn finalize
   [client<-server response]
@@ -252,8 +265,11 @@
   ;; Q: Is this a background-thread hidden sort of thing?
   ;; Maybe CIDER just isn't clever enough to spot it?

-  (is (not (= success ::timed-out)))
-  (is (not (= success ::drained)))
+  (is (not (= released-buffer ::timed-out)))
+  (is (not (= released-buffer ::drained)))
+  ;; This is just the tip of the iceberg showing
+  ;; why this approach was a terrible idea.
+  (is (= released-buffer released-buffer))
   ;; TODO: Make this more interesting.
   ;; Verify what we really got back
   ;; Send back a second block of data,
@@ -278,8 +294,6 @@
     ;; Q: What's up with that?
     (let [succeeded (deref wrote 3000 ::check-timeout)]
       (log/info (str "Client-child send result to " write-notifier " => "  succeeded " @ " (System/nanoTime)))
-      ;; N.B. for real implementations: use a PooledByteBufAllocator
-      ;; Instead of mucking around with this release-notifier nonsense
       ;; That should work around my current bug, though it's ignoring a
       ;; fundamental design flaw.
       (deferred/chain release-notifier (partial notified-about-release write-notifier release-notifier read-notifier))
@@ -293,6 +307,14 @@
   ;; 1. Start by writing 0 bytes
   ;; 2. Write, say, 480 bytes, send notification, then 320 more
   (let [write-notifier (strm/stream)
+        ;; Real implementations really must use a
+        ;; PooledByteBufAllocator.
+        ;; Of course, that needs to get set up at the
+        ;; outer pipeline level.
+        ;; Client shouldn't care: when it's done
+        ;; reading a buffer, it should call .release
+        ;; and be done with it.
+        ;; TODO: Make that happen (just not tonight)
         buffer (Unpooled/buffer 2048)
         release-notifier (strm/stream)
         read-notifier (strm/stream)
@@ -335,8 +357,8 @@
           (strm/close! (:chan server->client))
           (strm/close! (:chan server<-client)))))))

-(deftest handshake
-  (log/info "**********************************\nNew Hand-Shake test")
+(defn build-hand-shake-options
+  []
   (let [server-extension (byte-array [0x01 0x02 0x03 0x04
                                       0x05 0x06 0x07 0x08
                                       0x09 0x0a 0x0b 0x0c
@@ -345,27 +367,31 @@
                                     51 -105 -107 -125 -120 -41 83 -46
                                     -23 -72 109 -58 -100 87 115 95
                                     89 -74 -21 -33 20 21 110 95])
-        server-name (shared/encode-server-name "test.frereth.com")
-        options {::server #::shared{:extension server-extension
-                                    :my-keys #::shared{::K/server-name server-name
-                                                       :keydir "curve-test"}}
-                 ::client {::shared/extension (byte-array [0x10 0x0f 0x0e 0x0d
-                                                           0x0c 0x0b 0x0a 0x09
-                                                           0x08 0x07 0x06 0x05
-                                                           0x04 0x03 0x02 0x01])
-                           ::clnt/child-spawner client-child-spawner
-                           ::shared/my-keys {::K/server-name server-name}
-                           ::clnt/server-extension server-extension
-                           ;; Q: Where do I get the server's public key?
-                           ;; A: Right now, I just have the secret key's 32 bytes encoded as
-                           ;; the alphabet.
-                           ;; TODO: Really need to mirror what the code does to load the
-                           ;; secret key from a file.
-                           ;; Then I can just generate a random key pair for the server.
-                           ;; Use the key-put functionality to store the secret, then
-                           ;; hard-code the public key here.
-                           ::clnt/server-security {::clnt/server-long-term-pk server-long-pk
-                                                   ::shared/server-name server-name}}}
+        server-name (shared/encode-server-name "test.frereth.com")]
+    {::server #::shared{:extension server-extension
+                        :my-keys #::shared{::K/server-name server-name
+                                           :keydir "curve-test"}}
+     ::client {::shared/extension (byte-array [0x10 0x0f 0x0e 0x0d
+                                               0x0c 0x0b 0x0a 0x09
+                                               0x08 0x07 0x06 0x05
+                                               0x04 0x03 0x02 0x01])
+               ::clnt/child-spawner client-child-spawner
+               ::shared/my-keys {::K/server-name server-name}
+               ::clnt/server-extension server-extension
+               ;; Q: Where do I get the server's public key?
+               ;; A: Right now, I just have the secret key's 32 bytes encoded as
+               ;; the alphabet.
+               ;; TODO: Really need to mirror what the code does to load the
+               ;; secret key from a file.
+               ;; Then I can just generate a random key pair for the server.
+               ;; Use the key-put functionality to store the secret, then
+               ;; hard-code the public key here.
+               ::clnt/server-security {::clnt/server-long-term-pk server-long-pk
+                                       ::shared/server-name server-name}}}))
+
+(deftest handshake
+  (log/info "**********************************\nNew Hand-Shake test")
+  (let [options (build-hand-shake-options)
         chan->server (strm/stream)
         chan<-server (strm/stream)
         ;; TODO: This seems like it would be a great place to try switching to integrant
@@ -374,16 +400,16 @@
                                  ::clnt/chan->server chan->server))]
     (try
       (let [unstarted-server (srvr/ctor (::server options))
-            server<-client {:chan (strm/stream)}
-            server->client {:chan (strm/stream)}]
+            chan<-client {:chan (strm/stream)}
+            chan->client {:chan (strm/stream)}]
         (try
           (log/debug "Starting server based on\n"
                      #_(with-out-str (pprint (srvr/hide-long-arrays unstarted-server)))
                      "...stuff...")
           (try
             (let [server (srvr/start! (assoc unstarted-server
-                                             ::state/client-read-chan server<-client
-                                             ::state/client-write-chan server->client))]
+                                             ::state/client-read-chan chan<-client
+                                             ::state/client-write-chan chan->client))]
               (try
                 ;; Currently just called for side-effects.
                 ;; TODO: Seems like I really should hide that little detail
@@ -398,12 +424,12 @@
                                "Expected:" chan->server
                                "\nHave:" clnt->srvr))
                   (assert clnt->srvr)
-                  (let [write-hello (partial retrieve-hello server<-client)
-                        build-cookie (partial wrote-hello server->client)
+                  (let [write-hello (partial retrieve-hello chan<-client)
+                        build-cookie (partial wrote-hello chan->client)
                         write-cookie (partial forward-cookie chan<-server)
-                        get-cookie (partial wrote-cookie chan->server)
-                        write-vouch (partial vouch->server server<-client)
-                        get-server-response (partial wrote-vouch server->client)
+                        get-cookie (partial wrote-cookie chan<-client)
+                        write-vouch (partial vouch->server chan->server)
+                        get-server-response (partial wrote-vouch chan->client)
                         write-server-response (partial finalize chan<-server)
                         _ (println "interaction-test: Starting the stream "
                                    clnt->srvr)
@@ -453,8 +479,8 @@
                   (srvr/stop! server))))
             (catch clojure.lang.ExceptionInfo ex
               (is (not (.getData ex)))))
-          (finally (strm/close! (:chan server->client))
-                   (strm/close! (:chan server<-client)))))
+          (finally (strm/close! (:chan chan->client))
+                   (strm/close! (:chan chan<-client)))))
       (finally
         (clnt/stop! client)))))


fixed failing tests

fixed failing tests

--- test/de/otto/oscillator/util/graphite_url_test.clj
+++ test/de/otto/oscillator/util/graphite_url_test.clj
@@ -21,22 +21,22 @@
 (deftest move-time-test
   (testing "it applies a given function"
     (is (= "-4h"
-           (move-time "-6h" + 2)))
+           (move-time "-6h" 2)))
     (is (= "-1h"
-           (move-time "-2h" + 1)))
+           (move-time "-2h" 1)))
     (is (= "-24h"
-           (move-time "24h" - 48))))
+           (move-time "24h" -48))))
   (testing "it does not crash if current-time is missing"
     (is (= "-4h"
-           (move-time "" - 4)))
+           (move-time "" -4)))
     (is (= "-4h"
-           (move-time "30m" - 4)))
+           (move-time "30m" -4)))
     (is (= "-4h"
-           (move-time nil - 4))))
+           (move-time nil -4))))
   (testing "positive results will be mapped to -1min"
     (is (= "-1min"
-           (move-time "" + 0)
-           (move-time "-1h" + 2)))))
+           (move-time "" 0)
+           (move-time "-1h" 2)))))

 (deftest parse-hours-test
   (testing "it finds hours within string"


Clean up refresh profile

Clean up refresh profile

--- example/www/src/frontend/app/core.cljs
+++ example/www/src/frontend/app/core.cljs
@@ -12,42 +12,53 @@

 (enable-console-print!)

-(def LOGIN (str "http://" API-DOMAIN ":" API-PORT "/login"))
-(def ME (str "http://" API-DOMAIN ":" API-PORT "/me"))
+(def API-ENDPOINT (str "http://" API-DOMAIN ":" API-PORT))
+(def LOGIN (str API-ENDPOINT "/login"))
+(def ME (str API-ENDPOINT "/me"))

-(defn login [uid token callback]
-  (post-json
-    LOGIN
-    {:uid uid :token token}
-    callback
-    (fn [res] println "Login error:" res)))
+(defn show-flash [message]
+  (swap! app-state assoc
+         :flash message
+         :flash-shown true))

-(defn refresh-profile [res]
+(defn do-login [uid token then error]
+  (post-json LOGIN {:uid uid :token token} then error))
+
+(defn login
+  "Fetch uid and token and login. Redirect to social auth if fails"
+  [then]
   (let [uid (.-userUID (js* "window"))
         token (.-shortTermToken (js* "window"))
         auth-strategy PRIMARY-SOCIAL-AUTH]
-    (if (or (= 0 (:status res)) (= 500 (:status res)))
-      (swap! app-state assoc
-             :flash "Oops, a network problem..."
-             :flash-shown true)
-      (if (= 404 (:status res))
-        (if (and (< 0 (count uid)) (< 0 (count token)))
-          (login uid token
-                 (fn [res]
-                   (if (= "OK" (:message res))
-                     (get-json ME refresh-profile refresh-profile)
-                     (redirect "/error"))))
-          (redirect (str "/auth/" auth-strategy "?next=profile")))
-        (swap! app-state assoc
-               :user (:user res)
-               :flash ""
-               :flash-shown false
-               :profile-loading-shown false
-               :profile-shown true
-               :profile-greetings "You are awesome, ")))))
+    (if (and (< 0 (count uid)) (< 0 (count token)))
+      (do-login uid token then (fn [res] (show-flash "Login error.")))
+      (redirect (str "/auth/" auth-strategy "?next=profile")))))
+
+(defn get-me [then]
+  (get-json
+    ME
+    (fn [res]
+      (case (:status res)
+        (0 500) (show-flash "The API server is down...")
+        404 (show-flash "Failed to fetch your information.")
+        (then res)))
+    (fn [res] (show-flash "Oops, something went wrong while fetching info..."))))
+
+(defn refresh-profile [res]
+  (swap! app-state assoc
+         :user (:user res)
+         :flash ""
+         :flash-shown false
+         :profile-loading-shown false
+         :profile-shown true
+         :profile-greetings "You are awesome, "))

 (defn profile [target-elem]
-  (get-json ME refresh-profile refresh-profile)
+  (login
+    (fn [res]
+      (if (= "OK" (:message res))
+        (get-me refresh-profile)
+        (show-flash "Oops, something went wrong..."))))
   (reagent/render [#(profile-view @app-state)] target-elem))

 (defn route [path target-elem]


Basic Animation

Basic Animation

--- src/twentyfortyeight/view.cljs
+++ src/twentyfortyeight/view.cljs
@@ -64,14 +64,16 @@
           (#(rf/dispatch [:move-direction %]))))

 (defn tile-with-id
-  [tile-position]
-  (let [tile (rf/subscribe [:tile-at-position tile-position])
-        previous-tile (rf/subscribe [:previous-tile-with-id (:id @tile)])
-        spring-x (anim/spring (ratom/reaction (axis->coordinates (get-in @tile [:position :x]))) {:from (get-in @previous-tile [:position :x])})
-        spring-y (anim/spring (ratom/reaction (axis->coordinates (get-in @tile [:position :y]))){:from (get-in @previous-tile [:position :y])})]
-    (fn []
+  [tile-id]
+  (let [tile (rf/subscribe [:tile-with-id tile-id])
+        previous-tile (rf/subscribe [:previous-tile-with-id tile-id])
+        spring-x (anim/interpolate-to (ratom/reaction (axis->coordinates (get-in @tile [:position :x]))) {:from (get-in @previous-tile [:position :x])})
+        spring-y (anim/interpolate-to (ratom/reaction (axis->coordinates (get-in @tile [:position :y]))){:from (get-in @previous-tile [:position :y])})]
+    (fn
+      []
       [:div
-       {:style {:position "absolute"
+       {:key tile-id
+        :style {:position "absolute"
                 :background-color "orange"
                 :border-width 1
                 :display "flex"
@@ -84,23 +86,24 @@
                 :top @spring-y
                 :width tile-width
                 :height tile-width}}
-       [:a (str (:value @tile))]])))
+       [:a (:value @tile)]])))

 (defn game-board
   []
-  (let [tile-ids @(rf/subscribe [:tile-ids])]
-    [:div
-     {:style {:display "flex"
-              :flex-direction "column"
-              :width screen-width
-              :height screen-height
-              :position "fixed"
-              :justify-content "center"
-              :align-items "center"}}
-     [:button {:on-click #(rf/dispatch [:new-game])} "New Game"]
-     (doall (for [position db/all-positions]
-              ^{:key position}
-              [tile-with-id position]))]))
+  (let [tile-ids (rf/subscribe [:tile-ids])]
+    (fn []
+      [:div
+       {:style {:display "flex"
+                :flex-direction "column"
+                :width screen-width
+                :height screen-height
+                :position "fixed"
+                :justify-content "center"
+                :align-items "center"}}
+       [:button {:on-click #(rf/dispatch [:new-game])} "New Game"]
+       (doall (for [tile-id @tile-ids]
+                ^{:key tile-id}
+                [tile-with-id tile-id]))])))

 (defn game []
   (let [!hammer-manager (r/atom nil)]


Adapt to PR review

Adapt to PR review

--- backend/src/akvo/lumen/lib/public.clj
+++ backend/src/akvo/lumen/lib/public.clj
@@ -17,19 +17,20 @@
 (defn get-share [tenant-conn id]
   (public-by-id tenant-conn {:id id}))

+(def vis-aggregation-mapper {"pivot table" "pivot"
+                             "line"      "line"
+                             "bubble"    "bubble"
+                             "area"      "line"
+                             "pie"       "pie"
+                             "donut"     "donut"
+                             "polararea" "pie"
+                             "bar"       "bar"
+                             "scatter"   "scatter"})
+
 (defn run-visualisation
   [tenant-conn visualisation]
   (let [visualisation (keywordize-keys visualisation)
         [dataset-tag dataset] (dataset/fetch-metadata tenant-conn (:datasetId visualisation))
-        vis-aggregation-mapper {"pivot table" "pivot"
-                                "line"      "line"
-                                "bubble"    "bubble"
-                                "area"      "line"
-                                "pie"       "pie"
-                                "donut"     "donut"
-                                "polararea" "pie"
-                                "bar"       "bar"
-                                "scatter"   "scatter"}
         aggregation-type (get vis-aggregation-mapper (:visualisationType visualisation))
         [tag query-result] (aggregation/query tenant-conn
                                               (:datasetId visualisation)
@@ -67,12 +68,11 @@

 (defn visualisation-response-data [tenant-conn id config]
   (try
-    (let [vis-types #{"pivot table" "line" "bubble" "area" "pie" "donut" "polararea" "bar" "scatter" "map"}
-          [tag vis] (visualisation/fetch tenant-conn id)]
+    (let [[tag vis] (visualisation/fetch tenant-conn id)]
       (when (= tag ::lib/ok)
         (condp contains? (:visualisationType vis)
           #{"map"} (run-map-visualisation tenant-conn vis config)
-          vis-types (run-visualisation tenant-conn vis)
+          (set (keys vis-aggregation-mapper)) (run-visualisation tenant-conn vis)
           (run-unknown-type-visualisation tenant-conn vis))))
     (catch Exception e
       (log/warn e ::visualisation-response-data (str "problems fetching this vis-id: " id)))))


remove invalid tests

remove invalid tests

--- test/clj_money/pagination_test.clj
+++ test/clj_money/pagination_test.clj
@@ -1,34 +0,0 @@
-(ns clj-money.pagination-test
-  (:require [clojure.test :refer :all]
-            [clojure.pprint :refer [pprint]]
-            [clojure.data :refer [diff]]
-            [clj-money.url :as url]
-            [clj-money.pagination :as pagination]))
-
-(deftest create-nav
-  ; this test contains an extra level of nesting and isn't necessary to render
-  ; the content correctly, but it necessary to acknowledge a side effect
-  ; of the logic used to create the result. Probably a better test
-  ; should be conceived.
-  (let [expected [:nav {:aria-label "Page navigation"}
-                  [:ul.pagination
-                   [[:li {:class "active"} ; extra nesting
-                    [:a {:href "/somewhere/something?page=0&per-page=10"} "1"]]
-                   [:li {:class nil}
-                    [:a {:href "/somewhere/something?page=1&per-page=10"} "2"]]]]]
-        actual (pagination/nav {:page "0"
-                                :per-page "10"
-                                :url (url/path "/somewhere" "something")
-                                :total "15"})]
-    (is (= expected actual))))
-
-(deftest supply-defaults
-  (let [expected [:nav {:aria-label "Page navigation"}
-                  [:ul.pagination
-                   [[:li {:class "active"} ; extra nesting
-                    [:a {:href "/somewhere/something?page=0&per-page=10"} "1"]]
-                   [:li {:class nil}
-                    [:a {:href "/somewhere/something?page=1&per-page=10"} "2"]]]]]
-        actual (pagination/nav {:url (url/path "/somewhere" "something")
-                                :total "15"})]
-    (is (= expected actual))))


Fix the test

Fix the test

--- test/icecap/handlers/http_test.clj
+++ test/icecap/handlers/http_test.clj
@@ -18,9 +18,8 @@
     (are [s] (nil? (check-plan s))
          step))
   (testing "invalid steps"
-    (are [s expected] (let [step (merge {:type :http} s)
-                            reprs (map pr-str [(check-plan step) expected])]
-                        (apply = reprs))
+    (are [s expected] (let [step (merge {:type :http} s)]
+                        (= (check-plan step) expected))
          {} '{:url missing-required-key}
          {:uri url} '{:uri disallowed-key
                       :url missing-required-key}


Test fix :wrench:

Test fix :wrench:

--- test/metabase/api/session_test.clj
+++ test/metabase/api/session_test.clj
@@ -211,7 +211,8 @@
 ;; should totally work if the email domains match up
 (expect
   {:first_name "Rasta", :last_name "Toucan", :email "rasta@sf-toucannery.com"}
-  (with-temporary-setting-values [google-auth-auto-create-accounts-domain "sf-toucannery.com"]
+  (with-temporary-setting-values [google-auth-auto-create-accounts-domain "sf-toucannery.com"
+                                  admin-email                             "rasta@toucans.com"]
     (select-keys (u/prog1 (google-auth-create-new-user! "Rasta" "Toucan" "rasta@sf-toucannery.com")
                    (db/cascade-delete! User :id (:id <>)))                                          ; make sure we clean up after ourselves !
                  [:first_name :last_name :email])))
@@ -234,7 +235,8 @@
 ;; test that a user that doesn't exist with a *different* domain than the auto-create accounts domain gets an exception
 (expect
   clojure.lang.ExceptionInfo
-  (with-temporary-setting-values [google-auth-auto-create-accounts-domain nil]
+  (with-temporary-setting-values [google-auth-auto-create-accounts-domain nil
+                                  admin-email                             "rasta@toucans.com"]
     (google-auth-fetch-or-create-user! "Rasta" "Can" "rasta@sf-toucannery.com")))

 ;; test that a user that doesn't exist with the *same* domain as the auto-create accounts domain means a new user gets created


fix error in partition-str

fix error in partition-str

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

--- plugins/DataBrowser/src/org/micromanager/browser/utils.clj
+++ plugins/DataBrowser/src/org/micromanager/browser/utils.clj
@@ -37,13 +37,16 @@
 ; Java Preferences

 (defn partition-str [n s]
-  (loop [rem s acc []]
-    (if (pos? (.length rem))
-      (recur (.substring rem n)
-             (conj acc (.substring rem 0 n)))
-      (seq acc))))
-
-(def pref-max-bytes (* 3/4 Preferences/MAX_VALUE_LENGTH))
+  (loop [rem s
+         acc []]
+    ;(println n)
+    (let [l (.length rem)]
+      (if (pos? l)
+        (recur (if (< n l) (.substring rem n) "")
+               (conj acc (.substring rem 0 (min l n))))
+        (seq acc)))))
+
+(def pref-max-bytes (int (* 3/4 Preferences/MAX_VALUE_LENGTH)))

 (defn write-value-to-prefs
   "Writes a pure clojure data structure to Preferences object."


Make even worse

Make even worse

--- yatzy-clj/src/yatzy_clj/yatzy.clj
+++ yatzy-clj/src/yatzy_clj/yatzy.clj
@@ -106,11 +106,22 @@

 (defn three-of-a-kind [dice]
   (let [tallies (tally-die dice)
-        result (->> (range 0 6)
-                    (filter #(>= (nth tallies %) 3))
-                    (map (fn [i] (* (+ i 1) 3)))
-                    (first))]
-    (if (= nil result) 0 result)))
+        result (first (remove nil?
+            (for [i (range 0 6)]
+              (if (>= (nth tallies i) 3)
+                (* (+ i 1) 3)
+                nil
+                )
+              )
+            ))]
+    (if (= nil result)
+      0 result
+      )
+    )
+  )
+
+
+

 (defn four-of-a-kind [dice]
   (let [tallies (tally-die dice)


(TK-437) Reworked no graceful shutdown test to avoid hang

Previously, if the 'no graceful shutdown' test failed due to the server
not closing the socket when the server was stopped, this test could
hang.  This commit reworks the test steps to hopefully avoid hanging the
test suite in the event of this kind of failure.  There does still
appear to be an underlying bug in Jetty here but it has proven very
difficult to reliably reproduce.

--- test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
+++ test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
@@ -2,7 +2,7 @@
   (:import (org.apache.http ConnectionClosedException)
            (java.io IOException)
            (java.security.cert CRLException)
-           (java.net BindException)
+           (java.net BindException SocketTimeoutException)
            (java.nio.file Paths Files)
            (java.nio.file.attribute FileAttribute)
            (appender TestListAppender)
@@ -706,28 +706,59 @@
             (is (not (nil? (:error @response)))))))))

   (testing "no graceful shutdown when stop timeout is set to 0"
-    (tk-log-testutils/with-test-logging
-     (with-app-with-config
-       app
-       [jetty9-service]
-       {:webserver {:port 8080 :shutdown-timeout-seconds 0}}
-       (let [s (tk-app/get-service app :WebserverService)
-             add-ring-handler (partial add-ring-handler s)
-             in-request-handler (promise)
-             ring-handler (fn [_]
-                            (deliver in-request-handler true)
-                            (Thread/sleep 2000)
-                            {:status 200 :body "Hello, World!"})]
-         (add-ring-handler ring-handler "/hello")
-         (with-open [async-client (async/create-client {})]
-           (let [response (http-client-common/get async-client "http://localhost:8080/hello" {:as :text})]
-             @in-request-handler
-             (tk-app/stop app)
-             (let [resp @response]
-               (is (or
-                    (not (nil? (:error resp)))
-                    (= 404 (:status resp)))
-                   resp))))))))
+    (let [response (atom nil)]
+      ;; For this test, an active web request should exist at the time the
+      ;; webserver service is stopped.  Because the shutdown timeout is set to
+      ;; 0, though, the request should be terminated immediately as the
+      ;; webserver service is shut down, without waiting for ring handler
+      ;; to complete the request.
+      (with-open [async-client (async/create-client
+                                ;; Setting the socket timeout to something much
+                                ;; larger than the sleep delay done in the ring
+                                ;; handler below.  This timeout allows the HTTP
+                                ;; client request to not hang the test
+                                ;; indefinitely in the event of an unexpected
+                                ;; test failure.
+                                {:socket-timeout-milliseconds 120000})]
+        (tk-log-testutils/with-test-logging
+         (with-app-with-config
+          app
+          [jetty9-service]
+          {:webserver {:port 8080 :shutdown-timeout-seconds 0}}
+          (let [s (tk-app/get-service app :WebserverService)
+                add-ring-handler (partial add-ring-handler s)
+                in-request-handler (promise)
+                ring-handler (fn [_]
+                               (deliver in-request-handler true)
+                               ;; Sleeping for a long time to allow an HTTP
+                               ;; request to still be active at the point the
+                               ;; webserver is shutdown
+                               (Thread/sleep 60000)
+                               {:status 200 :body "Hello, World!"})]
+            (add-ring-handler ring-handler "/hello")
+            (reset! response (http-client-common/get
+                              async-client
+                              "http://localhost:8080/hello"
+                              {:as :text}))
+            @in-request-handler)))
+        ;; The web server should have been stopped by the time we get here.
+        ;; Depending upon timing, the Jetty webserver may provide an HTTP 404
+        ;; response or just terminate the socket for the web request which could
+        ;; not be completed, which should cause a ConnectionClosedException to
+        ;; be thrown.
+        ;;
+        ;; Note that per TK-437, we have occasionally seen this assertion fail
+        ;; due to a SocketTimeoutException being thrown.  In this case, there
+        ;; appears to be a timing-related bug in Jetty where the server socket
+        ;; isn't closed down even though the server otherwise appears to have
+        ;; been stopped properly - leaving the server-side of the connection in
+        ;; an indefinite CLOSE_WAIT state.
+        (let [resp @@response
+              error (:error resp)]
+          (is (or
+               (instance? ConnectionClosedException error)
+               (= 404 (:status resp)))
+              (str "request did not error as expected. response: " resp))))))

   (testing "tk app can still restart even if stop timeout expires"
     (let [in-request-handler? (promise)


[#2376] Fix monitoring buckets

[#2376] Fix monitoring buckets

--- backend/src/akvo/lumen/lib/auth.clj
+++ backend/src/akvo/lumen/lib/auth.clj
@@ -180,11 +180,11 @@

           auth-dashboards (->> (auth-dashboards tenant-conn (set auth-visualisations))
                                (prometheus/with-duration
-                                 (registry/get collector :app/auth-datasets {"tenant" tenant})))
+                                 (registry/get collector :app/auth-dashboards {"tenant" tenant})))

           auth-collections (->> (auth-collections tenant-conn auth-datasets auth-visualisations auth-dashboards)
                                 (prometheus/with-duration
-                                  (registry/get collector :app/auth-datasets {"tenant" tenant})))]
+                                  (registry/get collector :app/auth-collections {"tenant" tenant})))]
       {:rasters             rasters
        :auth-datasets       auth-datasets
        :auth-visualisations auth-visualisations


Hot-fix: avoid str/includes? null error

Hot-fix: avoid str/includes? null error

--- backend/src/akvo/lumen/lib/auth.clj
+++ backend/src/akvo/lumen/lib/auth.clj
@@ -35,7 +35,7 @@
   "Feature flag condition based on `First Name` jwt-claims
   To match just add `$auth` to your `First Name` in your related auth system user profile"
   [request]
-  (str/includes? (get (:jwt-claims request) "given_name") "$auth$"))
+  (str/includes? (get (:jwt-claims request) "given_name" "") "$auth$"))

 (defn wrap-auth-datasets
   "Add to the request a db-query-service with a authorised-uuid-tree validated using flow-api check_permissions"


Cleanup config handling

Cleanup config handling

--- demo/sitetools/core.cljs
+++ demo/sitetools/core.cljs
@@ -46,23 +46,25 @@

 (defonce history nil)

-(defn demo-handler [state [id x y :as event]]
+(defn demo-handler [state [id x :as event]]
   (case id
-    :set-content (let [title (if y
-                               (str (:title-prefix state) y)
-                               (str (:default-title state)))]
-                   (assert (vector? x))
+    :set-content (let [page x
+                       title (:title page)
+                       _ (assert (vector? (:content page)))
+                       title (if title
+                               (str (:title-prefix state) title)
+                               (str (:default-title state)))
+                       page (assoc page :title title)]
                    (when r/is-client
                      (set! js/document.title title))
-                   (assoc state :main-content x :title title))
-    :set-page (do (assert (string? x))
-                  (let [{pages :pages} state
-                        p (get pages x (get pages "/index.html"))]
-                    (-> state
-                        (assoc :page-path x)
-                        (recur [:set-content (:content p) (:title p)]))))
-    :goto-page (do
-                 (assert (string? x))
+                   (assoc state :current-page page))
+    :set-page (let [path x
+                    _ (assert (string? path))
+                    ps (:pages state)
+                    p (get ps path (get ps "/index.html"))]
+                (recur state [:set-content p]))
+    :goto-page (let [path x
+                     _ (assert (string? path))]
                  (when-some [h history]
                    (.setToken h x)
                    (r/next-tick #(set! js/document.body.scrollTop 0))
@@ -118,7 +120,7 @@
    child])

 (defn main-content []
-  (let [{comp :main-content} @config]
+  (let [comp (get-in @config [:current-page :content])]
     (assert (vector? comp))
     comp))

@@ -152,12 +154,14 @@

 (defn gen-page [page-path conf]
   (dispatch [:set-page page-path])
-  (let [b (:body conf)
+  (let [conf (merge conf @config)
+        b (:body conf)
         _ (assert (vector? b))
         bhtml (r/render-component-to-string b)]
     (str "<!doctype html>\n"
          (html-template (assoc conf
                                :page-conf {:page-path page-path}
+                               :title (-> conf :current-page :title)
                                :body-html bhtml)))))

 (defn fs [] (js/require "fs"))


Add user documentation example.

Add user documentation example.

--- test/behaviors/t_protocols.clj
+++ test/behaviors/t_protocols.clj
@@ -80,3 +80,39 @@
     (provided
       (add-fields rec) => 0)))

+
+
+
+
+;; An example used in the user documentation
+(defprotocol Peanoific
+  (pzero? [this])
+  (pequal? [this that])
+  (psuccessor [this])
+  (padd [this that])
+  (pmult [this that]))
+
+(defrecord-openly Peano [value]
+  Peanoific
+  (pzero? [this] :unfinished)
+  (pequal? [this that] :unfinished)
+  (psuccessor [this] :unfinished)
+  (padd [this that]
+        (if (pzero? that) this))
+  (pmult [this that] :unfinished))
+
+
+(fact
+  (padd (Peano. ...n...) (Peano. ...zero...)) => (Peano. ...n...)
+  (provided
+    (pzero? (Peano. ...zero...)) => true))
+
+(after-silently
+ (fact
+   (padd (Peano. ...a...) (psuccessor (Peano. ...b...)))
+   => (psuccessor (padd (Peano. ...a...) (Peano. ...b...)))
+   (provided
+     (pzero? anything) => false))
+ (fact @reported => (one-of bad-result)))
+
+


Refactor test setup duplication

Refactor test setup duplication

--- test/buildviz/handler_test.clj
+++ test/buildviz/handler_test.clj
@@ -9,6 +9,12 @@
   (f))

 (use-fixtures :each each-fixture)
+
+(defn a-build [jobName, buildNr, content]
+  (app (-> (request :put
+                    (format "/builds/%s/%s" jobName buildNr))
+           (body (json/generate-string content))
+           (content-type "application/json"))))

 (deftest Storage
   (testing "PUT to /builds/:job/:build"
@@ -27,18 +33,12 @@

   (testing "GET to /builds/:job/:build"
     ; GET should return 200
-    (app (-> (request :put
-                      "/builds/anotherBuild/1")
-             (body (json/generate-string {:start 42 :end 43}))
-             (content-type "application/json")))
+    (a-build "anotherBuild" 1 {:start 42 :end 43})
     (let [response (app (request :get "/builds/anotherBuild/1"))]
       (is (= (:status response) 200)))

     ; GET should return content stored by PUT
-    (app (-> (request :put
-                  "/builds/yetAnotherBuild/1")
-             (body (json/generate-string {:start 42 :end 43}))
-             (content-type "application/json")))
+    (a-build "yetAnotherBuild" 1, {:start 42 :end 43})
     (let [response (app (request :get "/builds/yetAnotherBuild/1"))
           resp-data (json/parse-string (:body response))]
       (is (= resp-data
@@ -49,18 +49,12 @@
       (is (= (:status response) 404)))

     ; GET should return 404 if build not found
-    (app (-> (request :put
-                      "/builds/anExistingBuild/1")
-             (body (json/generate-string {:start 42 :end 43}))
-             (content-type "application/json")))
+    (a-build "anExistingBuild" 1, {:start 42 :end 43})
     (let [response (app (request :get "/builds/anExistingBuild/2"))]
       (is (= (:status response) 404)))

     ; Different jobs should not interfere with each other
-    (app (-> (request :put
-                      "/builds/someBuild/1")
-             (body (json/generate-string {:start 42 :end 43}))
-             (content-type "application/json")))
+    (a-build "someBuild" 1, {:start 42 :end 43})
     (let [response (app (request :get "/builds/totallyUnrelatedBuild/1"))
           resp-data (json/parse-string (:body response))]
       (is (= (:status response) 404)))))
@@ -77,14 +71,8 @@
       (is (= resp-data {})))

     ; GET should return job summary
-    (app (-> (request :put
-                      "/builds/someBuild/1")
-             (body (json/generate-string {:start 42 :end 43}))
-             (content-type "application/json")))
-    (app (-> (request :put
-                      "/builds/anotherBuild/1")
-             (body (json/generate-string {:start 10 :end 12}))
-             (content-type "application/json")))
+    (a-build "someBuild" 1, {:start 42 :end 43})
+    (a-build "anotherBuild" 1, {:start 10 :end 12})
     (let [response (app (request :get "/pipeline"))
           resp-data (json/parse-string (:body response))]
       (is (= resp-data {"someBuild" {"averageRuntime" 1}


Added simple edn tests.

Added simple edn tests.

--- test/kixi/hecuba/amon_test.clj
+++ test/kixi/hecuba/amon_test.clj
@@ -193,3 +193,23 @@
   (is (true? (get (tc/quick-check 5 postable-entity?) :result)))
   )
 ;;-----------------------------
+;; edn/json equality tests
+;;-----------------------------
+(deftest ^:http-tests test-edn-json-programmes
+  (is (=
+       (:body (client/get (apply str "http://127.0.0.1:8010/4" @programme-loc) {:accept :json :content-type :json :basic-auth ["support@mastodonc.com" "password"]}))
+       (:body (client/get (apply str "http://127.0.0.1:8010/4" @programme-loc) {:accept :edn :content-type :json :basic-auth ["support@mastodonc.com" "password"]}))))
+  (log/info "Passed JSON EDN equality check for Programmes"))
+
+(deftest ^:http-tests test-edn-json-projects
+  (is (=
+       (:body (client/get (apply str "http://127.0.0.1:8010/4" @programme-loc @project-loc) {:accept :json :content-type :json :basic-auth ["support@mastodonc.com" "password"]}))
+       (:body (client/get (apply str "http://127.0.0.1:8010/4" @programme-loc @project-loc) {:accept :edn :content-type :json :basic-auth ["support@mastodonc.com" "password"]}))))
+  (log/info "Passed JSON EDN equality check for Projects"))
+;;-----------------------------
+;; test get device with edn (json not currently working):
+;; "Don't know how to write JSON of class java.util.Date"
+;;-----------------------------
+(deftest ^:http-tests test-edn-get-device
+  (is (:body (client/get (apply str "http://127.0.0.1:8010/4" @device-loc) {:accept :edn :content-type :json :basic-auth ["support@mastodonc.com" "password"]})))
+  (log/info "Passed EDN GET test for devices"))


Decode times when loading tracks

Decode times when loading tracks

--- src/gpx/db.clj
+++ src/gpx/db.clj
@@ -63,20 +63,19 @@
               :stats (to-json (:stats data))))

 (defn transform-segment [data]
-  (-> data
-    (assoc :times (map c/from-sql-time (:times data)))
-    (assoc :points
-      (map #(zipmap [:lat :lon :ele :time] %)
-        (map vector (:lats data) (:lons data) (:elevations data) (:times data))))
-    (dissoc :lats :lons :elevations :times)
-))
+  (let [times (map c/from-sql-time (:times data))]
+    (-> data
+      (assoc :times times)
+      (assoc :points
+        (map #(zipmap [:lat :lon :ele :time] %)
+          (map vector (:lats data) (:lons data) (:elevations data) times)))
+      (dissoc :lats :lons :elevations :times))))

 (defn prepare-segment [data]
   (assoc data :lats (to-double-array (:lats data))
               :lons (to-double-array (:lons data))
               :elevations (to-real-array (:elevations data))
               :times (to-ts-array (map #(f/unparse formatter %) (:times data)))))
-

 (defn prepare-waypoint [data]
   (assoc data :time (c/to-sql-time (:time data))))


more matchers

more matchers

--- src/matcha.clj
+++ src/matcha.clj
@@ -75,7 +75,7 @@
   [a]
   {:match (fn [b] (core/= a b))
    :description (pr-str a)
-   :describe-mismatch standard-describe-mismatch})
+   :describe-mismatch describe-class-mismatch})

 (defn <=
   "matches based if the value given is greater-than or equal to
@@ -208,6 +208,40 @@
    :describe-mismatch
    standard-describe-mismatch})

+(defn every?
+  "passes if every element of the sequence received matches the matcher
+
+  (matcha/run-match (matcha/every? (matcha/= 1)) [1]) ; => passes
+  (matcha/run-match (matcha/every? (matcha/= 1)) [2]) ; => fails"
+  [m]
+  {:match
+   (fn [xs] (core/every? (:match m) xs))
+   :description
+   (str "every item is " (:description m))
+   :describe-mismatch
+   (fn [xs]
+     (->> xs
+       (filter (complement (:match m)))
+       (map (:describe-mismatch m))
+       (string/join "an item ")))})
+
+(defn some
+  "passes if some elements of the sequence received matches the matcher
+
+  (matcha/run-match (matcha/some? (matcha/= 1)) [1 2]) ; => passes
+  (matcha/run-match (matcha/some? (matcha/= 1)) [2]) ; => fails"
+  [m]
+  {:match
+   (fn [xs] (core/some (:match m) xs))
+   :description
+   (str "some items are " (:description m))
+   :describe-mismatch
+   (fn [xs]
+     (->> xs
+       (filter (complement (:match m)))
+       (map #(str "an item " ((:describe-mismatch m) %)))
+       (string/join " ")))})
+
 (defn is-in?
   "passes if the value is included in the given collection


Docstring for r.u.servlet/set-status.

Docstring for r.u.servlet/set-status.

--- ring-servlet/src/ring/util/servlet.clj
+++ ring-servlet/src/ring/util/servlet.clj
@@ -52,7 +52,9 @@
      :servlet-response response
      :servlet-context  (.getServletContext servlet)}))

-(defn set-status [^HttpServletResponse response, status]
+(defn set-status
+  "Update a HttpServletResponse with a status code."
+  [^HttpServletResponse response, status]
   (.setStatus response status))

 (defn set-headers


[#242] Remove debug statement `(prn)`

[#242] Remove debug statement `(prn)`

--- api/src/clojure/org/akvo/flow_api/endpoint/sync.clj
+++ api/src/clojure/org/akvo/flow_api/endpoint/sync.clj
@@ -72,8 +72,7 @@
       (= offset (unilog/get-cursor db)) no-more-changes
       :else (changes-response offset db instance-id remote-api req))))

-(defn changes [deps {:keys [alias instance-id params] :as req}]
-  (prn "here" alias instance-id params)
+(defn changes [deps {:keys [instance-id params] :as req}]
   (let [{:keys [initial cursor next]} (spec/validate-params params-spec params)]
     (cond
       (and initial (or cursor next)) (anomaly/bad-request "Invalid parameters" {})


:8ball: clojure bob - passes some tests

:8ball: clojure bob - passes some tests

--- clojure/bob/bob.clj
+++ clojure/bob/bob.clj
@@ -1,2 +1,14 @@
 (ns bob)
-(def response-for (fn [x] ""))
+
+(declare question? ends-with?)
+
+(defn response-for [s]
+  (cond
+    (question? s) "Sure."
+    :else "Whatever."))
+
+(defn- question? [s]
+  (ends-with? \? s))
+
+(defn- ends-with? [c s]
+  (= (last (seq s)) c))


Fix Let

Fix Let

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -618,6 +618,16 @@
   ;; 10 => 8 ms
   ;; 50 => 1093 ms
   ;; 100 => 11492 ms
+
+  (let [plan (add-rules empty-flow-plan
+                        [(Rule. [(Recall. :known&pretended (->edge 'x 'y))
+                                 (Compute. (->Let 'z '[x y] "x + y"))
+                                 (Output. :pretended (->connected 'z 'z))])])
+        state (flow-plan->flow-state plan)]
+    (apush* (aget (:node->facts state) 0) (into-array (for [i (range 100)]
+                                                        (->edge i (inc i)))))
+    (fixpoint! state)
+    (persistent! (aget (:node->state state) 1)))
   )

 ;; TIME AND CHANGE


Stash partially written rule compiler

Stash partially written rule compiler

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -385,3 +385,32 @@
   ((pattern->deconstructor '[::eg "a" "b" "c"]) (->eg "a" "b" "c"))
   ((pattern->deconstructor '[::eg a b c]) (->eg "a" "b" "c"))
   )
+
+;; CLAUSES
+
+(defrecord Recall [memory pattern]) ;; memory is one of :known :pretended :remembered :forgotten :known&pretended
+(defrecord Filter [expr])
+(defrecord Let [name expr])
+(defrecord Set [name vars clauses])
+(defrecord Output [memory pattern]) ;; memory is one of :pretended :remembered :forgotten
+(defrecord OutputMany [memory expr]) ;; memory is one of :pretended :remembered :forgotten
+
+(defn clause->flow-plan [flow-plan shape clause]
+  (condp = (type clause)
+    ;; TODO !!! keep going here
+    ))
+
+;; RULES
+
+(defrecord Rule [clauses])
+
+(defn rule->flow-plan [flow-plan rule]
+  (loop [flow-plan flow-plan
+         shape []
+         clauses (:clauses rule)]
+    (if-let [[new-flow-plan new-shape clause] (first (map #(clause->flow-plan flow-plan shape %) clauses))]
+      (recur new-flow-plan new-shape (filter #(not= clause %) clauses))
+      (do (assert (empty? clauses) (str "Cannot join " (pr-str shape) " with " (pr-str clauses)))
+        flow-plan))))
+
+;; TODO !!! test


Fix shape printing

Fix shape printing

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -50,7 +50,7 @@
 (deftype FactShape [id madlib keys]
   Object
   (toString [this]
-            (apply str (interleave madlib (map (fn [k] (str "[" (name k) "]")) keys))))
+            (apply str (interleave madlib (concat (map (fn [k] (str "[" (name k) "]")) keys) [""]))))
   IEquiv
   (-equiv [this other]
           (and (instance? FactShape other)


didnt mean to autostart this

didnt mean to autostart this

--- src/block_chain/http.clj
+++ src/block_chain/http.clj
@@ -103,5 +103,3 @@
    (let [s (jetty/run-jetty #'test-api {:port port :join? false})]
      (.start s)
      (reset! server s))))
-
-(start!)


add TODO comments to sync for later

add TODO comments to sync for later

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -99,7 +99,9 @@
     (doseq [uid ids-to-send-to]
       (chsk-send! uid info))))

+; TODO: when using clojure.spec, use spec to validate this
 (defn user-can-message? [user-id ?data]
+  ; TODO: also check that thread in group
   (every?
       true?
       (concat


git: nil-pun on failed log from bad sha

git: nil-pun on failed log from bad sha

--- src/clj/clj_git/core.clj
+++ src/clj/clj_git/core.clj
@@ -31,12 +31,18 @@
    (run cmd args "."))
   ([cmd args dir]
    (prn cmd args dir)
-   (let [res (apply sh/sh "git" cmd (concat args [:dir dir]))]
-     (assert (= 0 (:exit res)) (format "%s: \nout: %s\nerr: %s"
-                                       (pr-str [cmd args])
-                                       (:out res)
-                                       (:err res)))
-     res)))
+   (let [res (apply sh/sh "git" cmd (concat args [:dir dir]))
+         err (fn [r]
+               (assert
+                (= 0 (:exit r)) (format "%s: \nout: %s\nerr: %s"
+                                        (pr-str [cmd args])
+                                        (:out r) (:err r))))
+         exit (:exit res)]
+     (if (pos? exit)
+       (case exit
+         128 (if (.contains (:err res) "bad object") nil (err))
+         (err))
+       res))))

 (defn git
   ([repo cmd]
@@ -125,13 +131,14 @@
   ([repo]
    (git-log-commit repo "HEAD"))
   ([repo sha]
-   (parse-raw-commit (git-log-raw-string repo sha))))
+   (when-let [raw (git-log-raw-string repo sha)]
+     (parse-raw-commit raw))))

 (defn git-log
   ([repo]
    (git-log repo "HEAD"))
   ([repo sha]
-   (let [commit (git-log-commit repo sha)]
+   (when-let [commit (git-log-commit repo sha)]
      (lazy-seq
       (cons commit (when-let [p (:parent commit)]
                      (git-log repo p)))))))


Build using the closure API. WIP Refs #28.

Provides functions to optimize JavaScript, calculate and add
dependencies and produce unoptimized output with a deps file.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -1,18 +1,601 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(set! *warn-on-reflection* true)
+
 (ns cljs.closure
-  (:use clojure.pprint)
-  (:require [clojure.java.shell :as shell]))
-
-(def chars (map char (concat (range 48 57) (range 65 90) (range 97 122))))
+  "Compile ClojureScript to JavaScript with optimizations from Google
+   Closure Compiler producing runnable JavaScript.
+
+   Use the 'build' function for end-to-end compilation.
+
+   build = compile -> add-dependencies -> optimize -> output
+
+   See comments for example usage. core.js and the Closure
+   compiler.jar must be on the classpath.
+
+   Two protocols are defined: IJavaScript and Compilable. The
+   Compilable protocol is satisfied by something which can return one
+   or more IJavaScripts.
+
+   With IJavaScriipt objects in hand, calling add-dependencies will
+   produce a sequence of IJavaScript objects which includes all
+   required dependencies from the Closure library plus cljs.core, in
+   dependency order. This function replaces the closurebuilder tool.
+
+   The optimize function converts one or more IJavaScripts into a
+   single string of JavaScript source code using the Closure Compiler
+   API.
+
+   The produced output is either a single string of optimized
+   JavaScript or a deps file for use during development.
+  "
+  (:require [cljs.compiler :as comp]
+            [clojure.java.io :as io]
+            [clojure.string :as string])
+  (:import java.io.File
+           java.io.BufferedInputStream
+           java.net.URL
+           java.util.logging.Level
+           java.util.jar.JarFile
+           com.google.common.collect.ImmutableList
+           com.google.javascript.jscomp.CompilerOptions
+           com.google.javascript.jscomp.CompilationLevel
+           com.google.javascript.jscomp.ClosureCodingConvention
+           com.google.javascript.jscomp.JSSourceFile
+           com.google.javascript.jscomp.Result
+           com.google.javascript.jscomp.JSError
+           com.google.javascript.jscomp.CommandLineRunner))
+
+(def name-chars (map char (concat (range 48 57) (range 65 90) (range 97 122))))

 (defn random-char []
-  (nth chars (.nextInt (java.util.Random.) (count chars))))
+  (nth name-chars (.nextInt (java.util.Random.) (count name-chars))))

 (defn random-string [length]
   (apply str (take length (repeatedly random-char))))

-(defn optimize [code]
-  (let [in (str "/tmp/" (random-string 4))
-        out (str in "-compiled.js")]
-    (spit in code)
-    (shell/sh "java" "-jar" "closure/compiler/compiler.jar" "--js" in "--js_output_file" out)
-    (pprint (slurp out))))
+;; from clojure.contrib.jar
+
+(defn jar-file?
+  "Returns true if file is a normal file with a .jar or .JAR extension."
+  [^File file]
+  (and (.isFile file)
+       (or (.endsWith (.getName file) ".jar")
+           (.endsWith (.getName file) ".JAR"))))
+
+(defn filenames-in-jar
+  "Returns a sequence of Strings naming the non-directory entries in
+the JAR file."
+  [^JarFile jar-file]
+  (map #(.getName %)
+       (filter #(not (.isDirectory %))
+               (enumeration-seq (.entries jar-file)))))
+
+;; from clojure.contrib.classpath
+
+(defn classpath
+  "Returns a sequence of File objects of the elements on CLASSPATH."
+  []
+  (map #(File. %)
+       (.split (System/getProperty "java.class.path")
+               (System/getProperty "path.separator"))))
+
+(defn classpath-jarfiles
+  "Returns a sequence of JarFile objects for the JAR files on classpath."
+  []
+  (map #(JarFile. %) (filter jar-file? (classpath))))
+
+;; End of functions from clojure.contrib
+
+;; Closure API
+;; ===========
+
+(defmulti js-source-file (fn [_ source] (class source)))
+
+(defmethod js-source-file String [^String name ^String source]
+  (JSSourceFile/fromCode name source))
+
+(defmethod js-source-file File [_ ^File source]
+  (JSSourceFile/fromFile source))
+
+(defmethod js-source-file BufferedInputStream [^String name ^BufferedInputStream source]
+  (JSSourceFile/fromInputStream name source))
+
+(defn set-options
+  "TODO: Add any other options that we would like to support."
+  [opts ^CompilerOptions compiler-options]
+  (doseq [flag (:flags opts)]
+    (case flag
+          :pretty-print (set! (. compiler-options prettyPrint) true))))
+
+(defn make-options
+  "Create a CompilerOptions object and set options from opts map."
+  [opts]
+  (let [level (case (:optimizations opts)
+                    :advanced CompilationLevel/ADVANCED_OPTIMIZATIONS
+                    :whitespace CompilationLevel/WHITESPACE_ONLY
+                    :simple CompilationLevel/SIMPLE_OPTIMIZATIONS)
+        compiler-options (doto (CompilerOptions.)
+                           (.setCodingConvention (ClosureCodingConvention.)))]
+    (do (.setOptionsForCompilationLevel level compiler-options)
+        (set-options opts compiler-options)
+        compiler-options)))
+
+(defn load-externs
+  "Externs are JavaScript files which contain empty definitions of
+  functions which will be provided by the envorinment. Any function in
+  an extern file will not be renamed during optimization.
+
+  Options may contain an :externs key with a list of file paths to
+  load. The :use-only-custom-externs flag may be used to indicate that
+  the default externs should be excluded.
+
+  TODO: Implement options described above."
+  [opts]
+  (CommandLineRunner/getDefaultExterns))
+
+(defn ^com.google.javascript.jscomp.Compiler make-closure-compiler []
+  (let [compiler (com.google.javascript.jscomp.Compiler.)]
+    (do (com.google.javascript.jscomp.Compiler/setLoggingLevel Level/WARNING)
+        compiler)))
+
+(defn report-failure [^Result result]
+  (let [errors (.errors result)
+        warnings (.warnings result)]
+    (doseq [next (seq errors)]
+      (println "ERROR:" (.toString ^JSError next)))
+    (doseq [next (seq warnings)]
+      (println "WARNING:" (.toString ^JSError next)))))
+
+(defn parse-js-ns
+  "Given the lines from a JavaScript source file, parse the provide
+  and require statements and return them in a map. Assumes that all
+  provide and require statements appear before the first function
+  definition."
+  [lines]
+  (letfn [(conj-in [m k v] (update-in m [k] (fn [old] (conj old v))))]
+    (->> (for [line lines x (string/split line #";")] x)
+         (map string/trim)
+         (take-while #(not (re-matches #".*=[\s]*function\(.*\)[\s]*[{].*" %)))
+         (map #(re-matches #".*goog\.(provide|require)\('(.*)'\)" %))
+         (remove nil?)
+         (map #(drop 1 %))
+         (reduce (fn [m ns]
+                   (if (= (first ns) "require")
+                     (conj-in m :requires (last ns))
+                     (conj-in m :provides (last ns))))
+                 {:requires [] :provides []}))))
+
+;; Protocols for IJavaScript and Compilable
+;; ========================================
+
+(defmulti to-url class)
+
+(defmethod to-url File [^File f] (.toURL (.toURI f)))
+
+(defmethod to-url String [s] (to-url (io/file s)))
+
+(defprotocol IJavaScript
+  (-url [this] "The URL where this JavaScript is located. Returns nil
+  when JavaScript exists in memory only.")
+  (-provides [this] "A list of namespaces that this JavaScript provides.")
+  (-requires [this] "A list of namespaces that this JavaScript requires.")
+  (-source [this] "The JavaScript source string."))
+
+(extend-protocol IJavaScript
+
+  String
+  (-url [this] nil)
+  (-provides [this] (:provides (parse-js-ns (string/split-lines this))))
+  (-requires [this] (:requires (parse-js-ns (string/split-lines this))))
+  (-source [this] this)
+
+  clojure.lang.IPersistentMap
+  (-url [this] (:url this))
+  (-provides [this] (:provides this))
+  (-requires [this] (:requires this))
+  (-source [this] (:source this)))
+
+(defrecord JavaScriptFile [^URL url provides requires]
+  IJavaScript
+  (-url [this] url)
+  (-provides [this] provides)
+  (-requires [this] requires)
+  (-source [this] (slurp (io/reader url))))
+
+(defn javascript-file [^URL url provides requires]
+  (JavaScriptFile. url (map name provides) (map name requires)))
+
+(defprotocol Compilable
+  (-compile [this opts] "Returns one or more IJavaScripts."))
+
+;; Compile
+;; =======
+
+;; TODO: Most of the code below assumes that core is the only file in
+;; ClojureScript. There are others and this will need to be changed to
+;; load them both as cljs source and as compiled JavaScript.
+
+(defmacro with-core
+  "Ensure that core.cljs has been loaded."
+  [& body]
+  `(do (when-not (:defs (get @comp/namespaces 'cljs.core))
+         (comp/load-file (comp/repl-env) "cljs/core.cljs"))
+       ~@body))
+
+(defn empty-env []
+  {:ns (@comp/namespaces comp/*cljs-ns*) :context :statement :locals {}})
+
+(defn compile-form-seq
+  "Compile a sequence of forms to a JavaScript source string."
+  [forms]
+  (with-core
+    (with-out-str
+      (binding [comp/*cljs-ns* 'cljs.user]
+        (doseq [form forms]
+          (comp/emit (comp/analyze (empty-env) form)))))))
+
+(defn compile-file
+  "Compile a single cljs file in memory returning the JavaScript
+  source as a String. The IJavaScript protocol is extended to String so
+  this result is suitable to be passed to anything that expects to see
+  IJavaScript."
+  [^File file]
+  (compile-form-seq (comp/forms-seq file)))
+
+(defn output-directory [opts]
+  (or (:output-dir opts) "out"))
+
+(defn compile-dir
+  "Recursively compile all cljs files under the given source
+  directory. Return a list of JavaScriptFiles in dependency order."
+  [^File src-dir opts]
+  (let [out-dir (output-directory opts)
+        compiled-info (comp/compile-root src-dir out-dir)]
+    (map (fn [{:keys [file ns requires]}]
+           (javascript-file (to-url file) [ns] requires))
+         compiled-info)))
+
+(extend-protocol Compilable
+
+  File
+  (-compile [this opts]
+    (if (.isDirectory this)
+      (compile-dir this opts)
+      (compile-file this)))
+
+  clojure.lang.PersistentList
+  (-compile [this opts]
+            (compile-form-seq [this]))
+
+  String
+  (-compile [this opts] (-compile (io/file this) opts))
+
+  clojure.lang.PersistentVector
+  (-compile [this opts] (compile-form-seq this))
+  )
+
+(comment
+  ;; compile a file in memory
+  (-compile "samples/hello/src/hello/core.cljs" {})
+  ;; compile a project
+  (-compile (io/file "samples/hello/src") {})
+  ;; compile a project with a custom output directory
+  (-compile (io/file "samples/hello/src") {:output-dir "my-output"})
+  ;; compile a form
+  (-compile '(defn plus-one [x] (inc x)) {})
+  ;; compile a vector of forms
+  (-compile '[(ns test.app (:require [goog.array :as array]))
+              (defn plus-one [x] (inc x))]
+            {})
+  )
+
+;; Dependencies
+;; ============
+;;
+;; Find dependencies from goog js files on the classpath. Eliminates
+;; the need for closurebuilder.
+
+(defn build-index
+  "Index a list of dependencies by namespace and file name. There can
+  be zero or more namespaces provided per file."
+  [deps]
+  (reduce (fn [m next]
+            (let [provides (:provides next)]
+              (-> (if (seq provides)
+                    (reduce (fn [m* provide]
+                              (assoc m* provide next))
+                            m
+                            provides)
+                    m)
+                  (assoc (:file next) next))))
+          {}
+          deps))
+
+(defn dependency-index*
+  "Create an indexed list of all namespaces in the Closure library
+  plus cljs.core."
+  []
+  (letfn [(graph-node [res]
+                      (-> (io/resource res)
+                          io/reader
+                          line-seq
+                          parse-js-ns
+                          (assoc :file res)))]
+    (let [goog (->> (classpath-jarfiles)
+                    (filter #(.endsWith (.getName %) "goog.jar"))
+                    first
+                    filenames-in-jar
+                    (filter #(.endsWith % ".js")))
+          all-nodes (map graph-node (conj goog "core.js"))]
+      (build-index all-nodes))))
+
+(def dependency-index (memoize dependency-index*))
+
+(defn dependency-order
+  "Topologically sort a collection of dependencies."
+  [coll]
+  (let [state (build-index coll)]
+    (:order (reduce comp/dependency-order-visit (assoc state :order []) (keys state)))))
+
+(defn dependencies
+  "Given a sequence of Closure namespace strings, return the list of
+  all dependencies in dependency order. The returned list will contain
+  file names relative to the classpath suitable to be passed to io/resource."
+  [requires]
+  (let [index (dependency-index)]
+    (loop [requires requires
+           deps []]
+      (if (seq requires)
+        (let [node (get index (first requires))]
+          (recur (concat (rest requires) (:requires node)) (conj deps node)))
+        (cons "goog/base.js" (map :file (distinct (dependency-order deps))))))))
+
+(comment
+  ;; find dependencies
+  (dependencies ["cljs.core"])
+  (dependencies ["goog.array"])
+  (dependencies ["cljs.core" "goog.array"])
+  )
+
+(defn add-dependencies
+  "Given one or more IJavaScript objects in dependency order, produce
+  a new sequence of IJavaScript objects which includes all dependencies
+  from the Closure library, plus cljs.core, in dependency order."
+  [& inputs]
+  (let [required (dependencies (mapcat -requires inputs))
+        index (dependency-index)]
+    (concat (map #(javascript-file (io/resource %)
+                                   (:provides (get index %))
+                                   (:requires (get index %))) required)
+            inputs)))
+
+(comment
+  ;; add dependencies to literal js
+  (add-dependencies "goog.provide('test.app');\ngoog.require('goog.array');")
+  ;; add dependencies to a JavaScriptFile record
+  (add-dependencies (javascript-file (to-url "samples/hello/src/hello/core.cljs")
+                                     ["hello.core"]
+                                     ["goog.array"]))
+  )
+
+;; Optimize
+;; ========
+
+(defmulti javascript-name class)
+
+(defmethod javascript-name URL [^URL url]
+  (if url (.getPath url) "cljs/user.js"))
+
+(defmethod javascript-name String [s]
+  (if-let [name (first (-provides s))] name "cljs/user.js"))
+
+(defmethod javascript-name JavaScriptFile [js] (javascript-name (-url js)))
+
+(defmethod js-source-file JavaScriptFile [_ js]
+  (when-let [url (-url js)]
+    (js-source-file (javascript-name url) (io/input-stream url))))
+
+(defn optimize
+  "Use the Closure Compiler to optimize one or more JavaScript files."
+  [opts & sources]
+  (let [closure-compiler (make-closure-compiler)
+        externs (load-externs opts)
+        compiler-options (make-options opts)
+        inputs (map #(js-source-file (javascript-name %) %) sources)
+        result ^Result (.compile closure-compiler externs inputs compiler-options)]
+    (if (.success result)
+      (.toSource closure-compiler)
+      (report-failure result))))
+
+(comment
+  ;; optimize JavaScript strings
+  (optimize {:optimizations :whitespace} "var x = 3 + 2; alert(x);")
+  ;; => "var x=3+2;alert(x);"
+  (optimize {:optimizations :simple} "var x = 3 + 2; alert(x);")
+  ;; => "var x=5;alert(x);"
+  (optimize {:optimizations :advanced} "var x = 3 + 2; alert(x);")
+  ;; => "alert(5);"
+
+  ;; optimize a ClojureScript form
+  (optimize {:optimizations :simple} (-compile '(def x 3) {}))
+
+  ;; optimize a project
+  (println (->> (-compile "samples/hello/src" {})
+                (apply add-dependencies)
+                (apply optimize {:optimizations :simple :flags #{:pretty-print}})))
+  )
+
+;; Output
+;; ======
+;;
+;; The result of a build is always a single string of JavaScript. The
+;; build process may produce files on disk but a single string is
+;; always output. What this string contains depends on whether the
+;; input has been optimized or not. If the :output-to option is set
+;; then this string will be written to the specified file. If not, it
+;; will be returned.
+;;
+;; The :output-dir option can be used to set the working directory
+;; where any files will be written to disk. By default this directory
+;; is 'out'.
+;;
+;; If inputs are optimized then the output string will be the complete
+;; application with all dependencies included.
+;;
+;; For unoptimized output the string will be a Closure deps file
+;; describing where the JavaScript files are on disk and their
+;; dependencies. All JavaScript files will be located in the working
+;; directory, including any dependencies from the Closure library.
+;;
+;; Unoptimized mode is faster because the Closure Compiler is not
+;; run. It also makes debugging much simpler because each file is
+;; loaded in its own script tag.
+;;
+;; When working with uncompiled files, you will need to add additional
+;; script tags to the hosting HTML file: one which pulls in Closure
+;; library's base.js and one which calls goog.require to load your
+;; code. See samples/hello/hello-dev.html for an example.
+
+(defn path-relative-to
+  "Generate a string which is the path to input relative to base."
+  [^File base input]
+  (let [base-path (comp/path-seq (.getCanonicalPath base))
+        input-path (comp/path-seq (.getFile ^URL (-url input)))
+        count-base (count base-path)
+        common (count (take-while true? (map #(= %1 %2) base-path input-path)))
+        prefix (repeat (- count-base common 1) "..")]
+    (comp/to-path (concat prefix (drop common input-path)))))
+
+(defn add-dep-string
+  "Return a goog.addDependency string for an input."
+  [opts input]
+  (letfn [(ns-list [coll] (when (seq coll) (apply str (interpose ", " (map #(str "'" % "'") coll)))))]
+    (str "goog.addDependency(\""
+         (path-relative-to (io/file (output-directory opts)"goog/base.js") input)
+         "\", ["
+         (ns-list (-provides input))
+         "], ["
+         (ns-list (-requires input))
+         "]);")))
+
+(defn deps-file
+  "Return a deps file string for a sequence of inputs."
+  [opts sources]
+  (apply str (interpose "\n" (map #(add-dep-string opts %) sources))))
+
+(comment
+  (path-relative-to (io/file "out/goog/base.js") {:url (io/resource "core.js")})
+  (add-dep-string {} {:url (io/resource "core.js") :requires ["goog.string"] :provides ["cljs.core"]})
+  (deps-file {} [{:url (io/resource "core.js") :requires ["goog.string"] :provides ["cljs.core"]}])
+  )
+
+(defn output-one-file [{:keys [output-to]} js]
+  (if output-to (spit output-to js) js))
+
+(defn output-deps-file [opts sources]
+  (output-one-file opts (deps-file opts sources)))
+
+(defn ^String output-path
+  "Given an IJavaScript which is either in memory or in a jar file,
+  return the output path for this file relative to the working
+  directory."
+  [js]
+  (if-let [url ^URL (-url js)]
+    (last (string/split (.getFile url) #"/goog.jar!/"))
+    (str (random-string 5) ".js")))
+
+(defn write-javascript
+  "Write a JavaScript file to disk. Only write if the file does not
+  already exist. Return IJavaScript for the file on disk."
+  [opts js]
+  (let [out-dir (io/file (output-directory opts))
+        out-name (output-path js)
+        out-file (io/file out-dir out-name)]
+    (do (when-not (.exists out-file)
+          (do (.mkdirs (.getParentFile (.getCanonicalFile out-file)))
+              (spit out-file (-source js))))
+        {:url (to-url out-file) :requires (-requires js) :provides (-provides js)
+         :library (when (.startsWith out-name "goog/") :goog)})))
+
+(defn source-on-disk
+  "Ensure that the given JavaScript exists on disk. Write in memory
+  sources and files contained in jars to the working directory. Return
+  updated IJavaScript with the new location."
+  [opts js]
+  (let [url ^URL (-url js)]
+    (if (or (not url) (= (.getProtocol url) "jar"))
+      (write-javascript opts js)
+      js)))
+
+(comment
+  (write-javascript {} "goog.provide('demo');\nalert('hello');\n")
+  ;; write something from a jar file to disk
+  (source-on-disk {}
+                  {:url (io/resource "goog/base.js")
+                   :source (slurp (io/reader (io/resource "goog/base.js")))})
+  ;; doesn't write a file that is already on disk
+  (source-on-disk {} {:url (io/resource "core.js")})
+  )
+
+(defn output-unoptimized [opts & sources]
+  (let [disk-sources (map #(source-on-disk opts %) sources)
+        goog-deps-url (io/resource "goog/deps.js")]
+    (do (write-javascript opts {:url goog-deps-url :source (slurp (io/reader goog-deps-url))})
+        (output-deps-file opts (remove #(= (:library %) :goog) disk-sources)))))
+
+(comment
+
+  ;; output unoptimized alone
+  (output-unoptimized {} "goog.provide('test');\ngoog.require('cljs.core');\nalert('hello');\n")
+  ;; output unoptimized with all dependencies
+  (apply output-unoptimized {} (add-dependencies
+                                "goog.provide('test');\ngoog.require('cljs.core');\nalert('hello');\n"))
+  ;; output unoptimized and write deps file to 'out/test.js'
+  (output-unoptimized {:output-to "out/test.js"}
+                      "goog.provide('test');\ngoog.require('cljs.core');\nalert('hello');\n")
+  )
+
+(defn build
+  "Given a source which can be compiled, produce runnable JavaScript."
+  [source opts]
+  (let [compiled (-compile source opts)
+        js-sources (if (coll? compiled)
+                     (apply add-dependencies compiled)
+                     (add-dependencies compiled))]
+    (if (:optimizations opts)
+      (->> js-sources
+           (apply optimize opts)
+           (output-one-file opts))
+      (apply output-unoptimized opts js-sources))))
+
+(comment
+
+  (println (build '[(ns hello.core)
+                    (defn ^{:export greet} greet [n] (str "Hola " n))
+                    (defn ^:export sum [xs] 42)]
+                  {:optimizations :simple :flags #{:pretty-print}}))
+
+  ;; build a project with optimizations
+  (build "samples/hello/src" {:optimizations :advanced})
+  (build "samples/hello/src" {:optimizations :advanced :output-to "samples/hello/hello.js"})
+  ;; open 'samples/hello/hello.html' to see the result in action
+
+  ;; build a project without optimizations
+  (build "samples/hello/src" {:output-to "samples/hello/hello.js"})
+  ;; open 'samples/hello/hello-dev.html' to see the result in action
+  ;; notice how each script was loaded individually
+
+  ;; build unoptimized from raw ClojureScript
+  (build '[(ns hello.core)
+           (defn ^{:export greet} greet [n] (str "Hola " n))
+           (defn ^:export sum [xs] 42)]
+         {:output-to "samples/hello/hello.js"})
+  ;; open 'samples/hello/hello-dev.html' to see the result in action
+  )


CLJS-1108: :modules :output-to needs to create directories

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -1032,8 +1032,10 @@
     (let [fdeps-str (when-not (empty? foreign-deps)
                       (foreign-deps-str opts foreign-deps))
           sm-name (when (:source-map opts)
-                    (str output-to ".map"))]
-      (spit (io/file output-to)
+                    (str output-to ".map"))
+          out-file (io/file output-to)]
+      (util/mkdirs out-file)
+      (spit out-file
         (as-> source source
           (if (= name :cljs-base)
             (add-header opts source)