fix thumbnails tests

fix thumbnails tests

--- test/vignette/util/thumbnail_test.clj
+++ test/vignette/util/thumbnail_test.clj
@@ -38,23 +38,20 @@
          (mime-type-of ..file..) => "video/ogg"))

 (facts :generate-thumbnail
-  (generate-thumbnail ..system.. beach-map) => ..object..
+  (generate-thumbnail ..store.. beach-map) => ..object..
   (provided
-    (store ..system..) => ..store..
     (get-original ..store.. beach-map) => ..original..
     (original->local ..original..) => ..local..
     (original->thumbnail ..local.. beach-map) => ..thumb..
     (background-delete-file ..local..) => true
     (create-stored-object ..thumb.. & anything) => ..object..)

-  (generate-thumbnail ..system.. beach-map) => (throws ExceptionInfo)
+  (generate-thumbnail ..store.. beach-map) => (throws ExceptionInfo)
   (provided
-    (store ..system..) => ..store..
     (get-original ..store.. beach-map) => nil)

-  (generate-thumbnail ..system.. beach-map) => falsey
+  (generate-thumbnail ..store.. beach-map) => falsey
   (provided
-    (store ..system..) => ..store..
     (get-original ..store.. beach-map) => ..original..
     (original->local ..original..) => ..local..
     (background-delete-file ..local..) => true
@@ -62,31 +59,28 @@

 (facts :get-or-generate-thumbnail
        ; get existing
-       (get-or-generate-thumbnail ..system.. beach-map) => ..thumb..
+       (get-or-generate-thumbnail ..store.. beach-map) => ..thumb..
        (provided
-         (store ..system..) => ..store..
          (get-thumbnail ..store.. beach-map) => ..thumb..)

        ; generate new - success
-       (get-or-generate-thumbnail ..system.. beach-map) => ..thumb..
+       (get-or-generate-thumbnail ..store.. beach-map) => ..thumb..
        (provided
-         (store ..system..) => ..store..
          (get-thumbnail ..store.. beach-map) => false
-         (generate-thumbnail ..system.. beach-map) => ..thumb..)
+         (generate-thumbnail ..store.. beach-map) => ..thumb..)

        ; generate new - fail
        (let [image-dne (assoc beach-map :original "doesnotexist.jpg")]
-         (get-or-generate-thumbnail ..system.. image-dne) => (throws ExceptionInfo)
+         (get-or-generate-thumbnail ..store.. image-dne) => (throws ExceptionInfo)
          (provided
-           (store ..system..) => ..store..
            (get-thumbnail ..store.. image-dne) => false
            (get-original ..store.. image-dne) => false))

        ; fall through when :replace is set
        (let [option-map (assoc-in beach-map [:options :replace] "true")]
-         (get-or-generate-thumbnail ..system.. option-map) => ..new-thumb..
+         (get-or-generate-thumbnail ..store.. option-map) => ..new-thumb..
          (provided
-           (generate-thumbnail ..system.. option-map) => ..new-thumb..)))
+           (generate-thumbnail ..store.. option-map) => ..new-thumb..)))

 (facts :route-map->thumb-args
        (route-map->thumb-args beach-map) => (contains ["--height" "100" "--width" "100"


cond -> boolean logic refactor

cond -> boolean logic refactor

--- src/cats/monad/maybe.cljc
+++ src/cats/monad/maybe.cljc
@@ -82,14 +82,10 @@
   "Return true in case of `v` is instance
   of Maybe monad."
   [v]
-  (cond
-    (or (instance? Just v) (instance? Nothing v))
-    true
-
-    (satisfies? p/Contextual v)
-    (identical? (p/-get-context v) context)
-
-    :else false))
+  (or (instance? Just v)
+      (instance? Nothing v)
+      (and (satisfies? p/Contextual v)
+           (identical? (p/-get-context v) context))))

 (defn just
   "A Just type constructor."


* src/clj/cljs/compiler.clj: direct invocation for known fns

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -587,7 +587,8 @@

 (defmethod emit :invoke
   [{:keys [f args env]}]
-  (let [f (if (-> f :info :fn-var)
+  (let [fn? (-> f :info :fn-var)
+        f (if fn?
             (let [info (-> f :info :info)
                   arity (count args)
                   methods (:methods info)]
@@ -597,12 +598,16 @@
                 (let [arities (map #(-> % :params count) methods)]
                   (if (some #{arity} arities)
                     (update-in f [:info :name]
-                      (fn [name] (symbol (str name ".__" arity))))
+                               (fn [name] (symbol (str name ".__" arity))))
                     f))))
             f)]
     (emit-wrap env
-               (print (str (emits f) ".call("
-                           (comma-sep (cons "null" (map emits args)))
+               (print (str (emits f) (when-not fn? ".call") "("
+                           (let [args (map emits args)
+                                 args (if-not fn?
+                                        (cons "null" args)
+                                        args)]
+                             (comma-sep args))
                            ")")))))

 (defmethod emit :new


Adding game/id to pulled attributes in game sub

--- src/clj/zetawar/subs.cljs
+++ src/clj/zetawar/subs.cljs
@@ -32,7 +32,8 @@
 (deftrack game-eid [conn]
   (-> @(app conn) :app/game e))

-(def game-pull [:game/credits-per-base
+(def game-pull [:game/id
+                :game/credits-per-base
                 :game/max-count-per-unit
                 :game/scenario-id
                 :game/map


all for commodity-id in lot report filter

--- src/clj_money/reports.clj
+++ src/clj_money/reports.clj
@@ -467,13 +467,17 @@
            :gain gain)))

 (defn lot-report
-  [storage-spec account-id]
-  (->> {:account-id account-id}
-       (lots/search storage-spec)
-       (map #(->> %
-                  (append-commodity-caption storage-spec)
-                  (append-current-price storage-spec)
-                  (append-lot-transactions storage-spec)
-                  (append-lot-calculated-values storage-spec)))
-       (sort-by :caption)
-       (map #(dissoc % :id :shares-purchased :updated-at :created-at :account-id))))
+  ([storage-spec account-id]
+   (lot-report storage-spec account-id nil))
+  ([storage-spec account-id commodity-id]
+   (->> (cond-> {:account-id account-id}
+          commodity-id
+          (assoc :commodity-id commodity-id))
+        (lots/search storage-spec)
+        (map #(->> %
+                   (append-commodity-caption storage-spec)
+                   (append-current-price storage-spec)
+                   (append-lot-transactions storage-spec)
+                   (append-lot-calculated-values storage-spec)))
+        (sort-by :caption)
+        (map #(dissoc % :id :shares-purchased :updated-at :created-at :account-id)))))


Functions to start, stop, reset the game

--- src/cljs/engine/core.cljs
+++ src/cljs/engine/core.cljs
@@ -5,10 +5,13 @@
   (:use-macros [dommy.macros :only [node sel sel1]])
   (:require-macros [cljs.core.async.macros :refer [go]]))

+
+;; TODO need a defonce so we can eval more than once
 ;; Global game state
+(def game (atom nil))
 (def systems (atom []))
 (def entities (atom []))
-(def paused (atom false))
+(def paused? (atom false))

 ;; TODO make a record and protocol for an entity
 (defn create-entity!
@@ -31,7 +34,7 @@
    Renders the stage to the screen"
   [renderer stage]
   (info "draw function called")
-  (when-not @paused
+  (when-not @paused?
     (doseq [e @entities]
           (render-entity stage e))
     (.render renderer stage)))
@@ -46,31 +49,64 @@

 (defn tick-game
   "Tick the game by miliseconds of time"
-  [time]
+  []
   ;; Update the global entities state atom
   (swap! entities #(map update-entity %)))

+;; TODO combine the game-loop and render-loop as systems that
+;; run synchronously
+
 (defn game-loop
   "Calculate changes based on the time since last change"
-  []
+  [renderer stage]
   ;; TODO Calculate the changes since the last game tick
-  ;; TODO should this be async? Allows skipping frames
-  (.setInterval js/window #(tick-game time) (/ 1000 60)))
+  (when-not @paused?
+    (tick-game)
+    (draw renderer stage)))

-(def stage (js/PIXI.Stage. 0x66ff99))
+(defn set-interval
+  "Creates an interval loop of n calls to function f per second.
+   Returns a function to cancel the interval."
+  [f n]
+  (.setInterval js/window f (/ 1000 n))
+  #(.clearInterval f (/ 1000 n)))

-(defn render-loop
-  "Renders the game every n seconds"
+(defn init-game
+  "Renders the game every n seconds.
+   Hashmap of game properties."
   []
   (let [;; TODO get the screen height and width
         ;; TODO allow the screen height and width to be variable?
         width 800
         height 600
-        renderer (js/PIXI.CanvasRenderer. width height)]
+        frame-rate 60
+        stage (js/PIXI.Stage. 0x66ff99)
+        renderer (js/PIXI.CanvasRenderer. width height)
+        main-loop (set-interval #(game-loop renderer stage) 60)]
     (dom/append! (sel1 :body) (.-view renderer))
-    (.setInterval js/window #(draw renderer stage) (/ 1000 60))))
+    ;; TODO return a function that also cleans up the canvas
+    {:renderer renderer
+     :stage stage
+     :end main-loop}))

-(defn start []
+
+;; Start, stop, reset the game. Game is stored in an atom and
+;; referenced directly in these functions
+(defn start-game! []
   (create-entity! stage "static/images/bunny.png" 500 500 0.05 0.05)
-  (render-loop)
-  (game-loop))
+  (create-entity! stage "static/images/bunny.png" 400 400 0.05 0.05)
+  (create-entity! stage "static/images/bunny.png" 200 200 0.05 0.05)
+  (reset! game (init-game)))
+
+(defn stop-game!
+  "Stop the game loop and remove the canvas"
+  []
+  (when @game
+    (dom/remove! (sel1 :canvas))
+    (:end @game)))
+
+(defn reset-game!
+  "End the"
+  []
+  (stop-game!)
+  (reset! game (start-game!)))


I want a SegmentContainer, not a list with one SegmentContainer

I often think that (take 1 coll) returns the first item from coll, rather than
a list that contains the first item from coll.

--- src/cljs/fatlip/core.cljs
+++ src/cljs/fatlip/core.cljs
@@ -304,7 +304,7 @@
                           (:dest %)
                           %)))
         with-qs (loop [f flat
-                       seg-c (take 1 segment-containers)
+                       seg-c (first segment-containers)
                        layer []]
                   (if (empty? f)
                     (if (empty? (:segments seg-c))
@@ -315,7 +315,7 @@
                         (recur (rest f) (update-in seg-c [:segments] conj item) layer)
                         (if (empty? (:segments seg-c))
                           (recur (rest f) seg-c (conj layer item))
-                          (recur (rest f) [] (conj layer seg-c item)))))))]
+                          (recur (rest f) (first segment-containers) (conj layer seg-c item)))))))]
     (assoc next-layer :with-qs with-qs)))


Shortify get-measures

Shortify get-measures

Realized that the structure of get-measure was ideal for if-let, and also
worked out how to use apply with map

--- src/cljs/fatlip/core.cljs
+++ src/cljs/fatlip/core.cljs
@@ -228,17 +228,13 @@
 (defn- get-measure
   "Calculate the average weighted position of a node's predecessors"
   [graph node pred-positions]
-  (let [preds (get-in graph [:preds node])]
-    (if preds
-      (apply / (->> preds
-                    (map #(let [weight (count (:characters %))
-                                pos (get pred-positions (:dest %))]
-                            [(* weight pos) weight]))
-                    (reduce #(-> %1
-                                 (update-in [0] + (get %2 0))
-                                 (update-in [1] + (get %2 1)))
-                            [0 0])))
-      0)))
+  (if-let [preds (get-in graph [:preds node])]
+    (apply / (->> preds
+                  (map #(let [weight (count (:characters %))
+                              pos (get pred-positions (:dest %))]
+                          [(* weight pos) weight]))
+                  (apply map +)))
+    0))

 (defn set-measures


add a function to read bam with sequential file access

--- src/clojure/cljam/bam.clj
+++ src/clojure/cljam/bam.clj
@@ -454,3 +454,40 @@
       (write-header w (:header sam))
       (write-refs w refs)
       (write-alignments w (:alignments sam) refs))))
+
+(deftype BamSequentialReader [r refs]
+  java.io.Closeable
+  (close [this]
+    (.. this r close)))
+
+(defprotocol ISequentialReader
+  (refs [this])
+  (read-next [this]))
+
+(extend-type BamSequentialReader
+  ISequentialReader
+  (refs [this] (.refs this))
+  (read-next [this]
+    (try
+      (read-alignment (.r this) (.refs this))
+      (catch EOFException e nil))))
+
+(defn open-bam
+  [f]
+  (let [rdr (DataInputStream.
+             (BGZFInputStream.
+              (BufferedInputStream. (FileInputStream. (file f)) buffer-size)))]
+    (if-not (Arrays/equals (lsb/read-bytes rdr 4) (.getBytes bam-magic))
+      (throw (IOException. "Invalid BAM file header")))
+    (let [header (sam/parse-header (lsb/read-string rdr (lsb/read-int rdr)))
+          n-ref  (lsb/read-int rdr)
+          refs   (loop [i n-ref, ret []]
+                   (if (zero? i)
+                     ret
+                     (let [l-name (lsb/read-int rdr)
+                           name   (lsb/read-string rdr l-name)
+                           l-ref  (lsb/read-int rdr)]
+                       (recur (dec i)
+                              (conj ret {:name (subs name 0 (dec l-name))
+                                         :len  l-ref})))))]
+      (->BamSequentialReader rdr refs))))


Fix tagged-value helper fn

Fix tagged-value helper fn

--- src/cognitect/transit.clj
+++ src/cognitect/transit.clj
@@ -27,8 +27,7 @@

 (defn tagged-value
   "Creates a TaggedValue object."
-  ([tag rep] (tagged-value tag rep nil))
-  ([tag rep str-rep] (TransitFactory/taggedValue tag rep str-rep)))
+  [tag rep] (TransitFactory/taggedValue tag rep))

 (defn nsed-name
   "Convert a keyword or symbol to a string in


Log when partial accumulation of JUnit XML

--- src/buildviz/gosync.clj
+++ src/buildviz/gosync.clj
@@ -289,8 +289,16 @@
          (map get-junit-xml))))

 (defn get-accumulated-junit-xml [job-instance]
-  (let [junit-xml-list (remove nil? (get-all-junit-xml job-instance))]
+  (let [all-junit-xml (get-all-junit-xml job-instance)
+        junit-xml-list (remove nil? all-junit-xml)]
     (when-not (empty? junit-xml-list)
+      (when-not (= (count junit-xml-list) (count all-junit-xml))
+        (let [{pipeline-name :pipelineName
+               pipeline-run :pipelineRun
+               stage-name :stageName
+               stage-run :stageRun} job-instance]
+          (log/warnf "Unable to accumulate all JUnit XML for jobs of %s %s (%s %s)"
+                   pipeline-name stage-name pipeline-run stage-run)))
       (accumulate-junit-xml-results junit-xml-list))))

 (defn fetch-junit-xml [job-instance]


Docstrings

Docstrings

--- src/cats/protocols.cljc
+++ src/cats/protocols.cljc
@@ -73,8 +73,11 @@
   (-foldr [fctx f z xs] "Right-associative fold of a structure."))

 (defprotocol Traversable
-  "TODO"
-  (-traverse [tctx f tv] "TODO"))
+  "Abstraction of data structures that can be traversed from left to right
+  performing an action on every element."
+  (-traverse [tctx f tv]
+    "Map each element to an Applicative, evaluate the applicatives from left
+     to right and collect the results."))

 (defprotocol Monad
   "The Monad abstraction."


Adapt interceptors implementation to the ratpack api changes.

--- src/clojure/catacumba/handlers/interceptor.clj
+++ src/clojure/catacumba/handlers/interceptor.clj
@@ -53,8 +53,9 @@
   continuation (as a cloure function) that must be called in
   order for processing to proceed."
   [context interceptor]
-  (let [^Context ctx (:catacumba/context context)]
-    (.addInterceptor ctx
+  (let [^Context ctx (:catacumba/context context)
+        ^Execution exec (.getExecution ctx)]
+    (.addInterceptor exec
                      (exec-interceptor interceptor)
                      (reify Block
                        (^void execute [_]


removed empty ns

removed empty ns

--- src/corpus_utils/core.clj
+++ src/corpus_utils/core.clj
@@ -1,3 +0,0 @@
-(ns corpus-utils.core
-  (:require [schema.core :as s]
-            [schema.macros :as sm]))


secretbox benchmark change

secretbox benchmark change

--- benchmarks/caesium/crypto/secretbox_benchmark.clj
+++ benchmarks/caesium/crypto/secretbox_benchmark.clj
@@ -67,30 +67,37 @@
 (def sizes (map (partial bit-shift-left 1) [6 8 10 12 20 24]))

 (defmacro bench-secretnonce
-  [fs converter]
+  [prefix fs converter]
   (let [rand-buf `(comp ~converter ~randombytes)]
-    `(doseq [[size# msg#] (map (juxt identity ~rand-buf) sizes)
+    `(doseq [[size# ptext#] (map (juxt identity ~rand-buf) sizes)
              f# ~fs]
        (let [key# (~rand-buf s/keybytes)
              nonce# (~rand-buf s/noncebytes)
              out# (~rand-buf (+ s/macbytes size#))]
-         (print-title f# (fmt-bytes size#) (mapv type [out# msg# nonce# key#]))
-         (bench (f# out# msg# nonce# key#))))))
+         (print-title ~prefix
+                      f#
+                      (fmt-bytes size#)
+                      (mapv type [out# msg# nonce# key#]))
+         (bench (f# out# ptext# nonce# key#))))))

 (deftest ^:benchmark to-buf!-benchmarks
-  (print-title "secretbox to-buf! with direct bufs, pre-allocation")
-  (bench-secretnonce [secretbox-easy-to-direct-byte-bufs-with-macros!
-                      secretbox-easy-to-direct-byte-bufs!
-                      secretbox-easy-to-byte-bufs-nocast!
-                      secretbox-easy-refl!]
-                     bb/->direct-byte-buf)
+  (bench-secretnonce
+   "secretbox to-buf! with direct bufs, pre-allocation"
+   [secretbox-easy-to-direct-byte-bufs-with-macros!
+    secretbox-easy-to-direct-byte-bufs!
+    secretbox-easy-to-byte-bufs-nocast!
+    secretbox-easy-refl!]
+   bb/->direct-byte-buf)

-  (print-title "secretbox to-buf! with indirect bufs, pre-allocation")
-  (bench-secretnonce [secretbox-easy-to-indirect-byte-bufs-with-macros!
-                      secretbox-easy-to-indirect-byte-bufs!
-                      secretbox-easy-to-byte-bufs-nocast!
-                      secretbox-easy-refl!]
-                     bb/->indirect-byte-buf)
+  (bench-secretnonce
+   "secretbox to-buf! with indirect bufs, pre-allocation"
+   [secretbox-easy-to-indirect-byte-bufs-with-macros!
+    secretbox-easy-to-indirect-byte-bufs!
+    secretbox-easy-to-byte-bufs-nocast!
+    secretbox-easy-refl!]
+   bb/->indirect-byte-buf)

-  (print-title "secretbox to-buf! with byte arrays, pre-allocation")
-  (bench-secretnonce [s/secretbox-easy-to-buf!] identity))
+  (bench-secretnonce
+   "secretbox to-buf! with byte arrays, pre-allocation"
+   [s/secretbox-easy-to-buf!]
+   identity))


Application registry

Application registry

This is useful to check client-ids, secrets and look-up callback URLs

--- src/cylon/impl/oauth2.clj
+++ src/cylon/impl/oauth2.clj
@@ -22,10 +22,38 @@
    [clj-time.core :refer (now plus days)]
    ))

-
-
 (defprotocol Scopes
   (valid-scope? [_ scope]))
+
+(defprotocol ApplicationRegistry
+  (register-application [_ properties])
+  (lookup-application [_ client-id]))
+
+(s/defn register-application+ :- {:client-id s/Str
+                                  :client-secret s/Str}
+  [p :- (s/protocol ApplicationRegistry)
+   ;; If client-id and/or client-secret are not specified, they will be
+   ;; generated.
+   properties :- {(s/optional-key :client-id) s/Str
+                  (s/optional-key :client-secret) s/Str
+                  :application-name s/Str
+                  :homepage-uri s/Str
+                  (s/optional-key :description) s/Str
+                  :callback-uri s/Str}]
+  (register-application p properties))
+
+(s/defn lookup-application+ :- {:application-name s/Str
+                                :homepage-uri s/Str
+                                (s/optional-key :description) s/Str
+                                :callback-uri s/Str
+                                :client-id s/Str
+                                :client-secret s/Str}
+  [p :- (s/protocol ApplicationRegistry)
+   client-id :- s/Str]
+  (lookup-application p client-id))
+
+;; TODO: client secret
+;; TODO: callback uri

 (defrecord AuthServer [store scopes iss]
   Scopes
@@ -74,7 +102,10 @@
                  client-id (get params "client_id")
                  scope (get params "scope")
                  state (get params "state")
-                 scopes (set (str/split scope #"[\s]+"))]
+                 scopes (set (str/split scope #"[\s]+"))
+                 ;; Lookup application
+                 {:keys [callback-uri] :as application}
+                 (lookup-application+ (:application-registry this) client-id)]

              ;; openid-connect core 3.1.2.2
              ;;(if (contains? scopes "openid"))
@@ -122,19 +153,17 @@
                      {:status 302
                       :headers {"Location"
                                 (format
-                                 "http://localhost:8010/oauth/grant?code=%s&state=%s"
-                                 code state
+                                 ;; TODO: Replace this with the callback uri
+                                 "%s?code=%s&state=%s"
+                                 callback-uri code state
                                  )}
                       :cookies {"session-id" (->cookie session)}})))
                ;; Fail
                {:status 302
-                :headers {"Location" (str "/login/oauth/authorize?client_id=" client-id)}
-                :body "Try again"}
-               )
-
-             )
-           )
-         wrap-params wrap-cookies)
+                :headers {"Location" (format "%s?client_id=%s" (path-for (:modular.bidi/routes req) ::get-authenticate-form) client-id)}
+                :body "Try again"})))
+
+         wrap-params wrap-cookies s/with-fn-validation)

      ::get-totp-code
      (fn [req]
@@ -154,14 +183,17 @@
      ::post-totp-code
      (-> (fn [req]
            (let [code (-> req :form-params (get "code"))
-                 secret (get-session-value req "session-id" (:session-store this) :totp-secret)]
+                 secret (get-session-value req "session-id" (:session-store this) :totp-secret)
+                 ]
              (if (= code (totp-token secret))
                ;; Success, set up the exchange
                (let [session (get-session (:session-store this) (get-cookie-value req "session-id"))
                      client-id (get session :client-id)
+                     _ (infof "Looking up app with client-id %s yields %s" client-id (lookup-application+ (:application-registry this) client-id))
+                     {:keys [callback-uri] :as application}
+                     (lookup-application+ (:application-registry this) client-id)
                      state (get session :state)
                      identity (get session :cylon/identity)
-
                      code (str (java.util.UUID/randomUUID))]

                  ;; Remember the code for the possible exchange - TODO expire these
@@ -172,10 +204,7 @@

                  {:status 302
                   :headers {"Location"
-                            (format
-                             "http://localhost:8010/oauth/grant?code=%s&state=%s"
-                             code state
-                             )}})
+                            (format "%s?code=%s&state=%s" callback-uri code state)}})

                ;; Failed, have another go!
                {:status 302
@@ -184,44 +213,50 @@
                 }

                )))
-         wrap-params wrap-cookies)
+         wrap-params wrap-cookies s/with-fn-validation)

      ::exchange-code-for-access-token
      (-> (fn [req]
            (let [params (:form-params req)
                  code (get params "code")
-                 client-id (get params "client_id")]
-             (if-let [{identity :cylon/identity}
-                      (get @store
-                           ;; I don't think this key has to include client-id
-                           ;; - it can just be 'code'.
-                           {:client-id client-id :code code})]
-
-               (let [{access-token :cylon.session/key}
-                     (create-session! (:access-token-store this) {:scopes #{:superuser/read-users :repo :superuser/gist :admin}})
-                     claim {:iss iss
-                            :sub identity
-                            :aud client-id
-                            :exp (plus (now) (days 1)) ; expiry
-                            :iat (now)}]
-
-                 (info "Claim is %s" claim)
-
-                 {:status 200
-                  :body (encode {"access_token" access-token
-                                 "scope" "repo gist openid profile email"
-                                 "token_type" "Bearer"
-                                 "expires_in" 3600
-                                 ;; TODO Refresh token (optional)
-                                 ;; ...
-                                 ;; OpenID Connect ID Token
-                                 "id_token" (-> claim
-                                                jwt
-                                                (sign :HS256 "secret") to-str)
-                                 })})
-               {:status 400
-                :body "You did not supply a valid code!"})))
-         wrap-params)})
+                 client-id (get params "client_id")
+                 client-secret (get params "client_secret")
+                 application (lookup-application+ (:application-registry this) client-id)]
+
+             (if (not= (:client-secret application) client-secret)
+               {:status 400 :body "Invalid request - bad secret"}
+
+               (if-let [{identity :cylon/identity}
+                        (get @store
+                             ;; I don't think this key has to include client-id
+                             ;; - it can just be 'code'.
+                             {:client-id client-id :code code})]
+
+                 (let [{access-token :cylon.session/key}
+                       (create-session! (:access-token-store this) {:scopes #{:superuser/read-users :repo :superuser/gist :admin}})
+                       claim {:iss iss
+                              :sub identity
+                              :aud client-id
+                              :exp (plus (now) (days 1)) ; expiry
+                              :iat (now)}]
+
+                   (info "Claim is %s" claim)
+
+                   {:status 200
+                    :body (encode {"access_token" access-token
+                                   "scope" "repo gist openid profile email"
+                                   "token_type" "Bearer"
+                                   "expires_in" 3600
+                                   ;; TODO Refresh token (optional)
+                                   ;; ...
+                                   ;; OpenID Connect ID Token
+                                   "id_token" (-> claim
+                                                  jwt
+                                                  (sign :HS256 "secret") to-str)
+                                   })})
+                 {:status 400
+                  :body "Invalid request - unknown code"}))))
+         wrap-params s/with-fn-validation)})

   (routes [this]
     ["/" {"authorize" {:get ::get-authenticate-form
@@ -243,7 +278,8 @@
         map->AuthServer)
    [:access-token-store
     :session-store
-    :user-domain]))
+    :user-domain
+    :application-registry]))

 ;; --------

@@ -251,7 +287,31 @@
   (expect-state [_ state])
   (expecting-state? [this state]))

-(defrecord Application [client-id client-secret store access-token-uri]
+(defrecord Application [store access-token-uri]
+  component/Lifecycle
+  (start [this]
+    ;; If there's an :application-registry dependency, use it to
+    ;; register this app.
+    (if-let [reg (:application-registry this)]
+      (let [{:keys [client-id client-secret]}
+            (s/with-fn-validation
+              (register-application+
+               reg
+               (select-keys this [:client-id
+                                  :client-secret
+                                  :application-name
+                                  :homepage-uri
+                                  :description
+                                  :callback-uri])))]
+        ;; In case these are generated
+        (assoc this :client-id client-id :client-secret client-secret))
+
+      ;; If no app registry, make sure we can standalone as an app.
+      (s/validate {:client-id s/Str
+                   :client-secret s/Str
+                   s/Keyword s/Any} this)))
+  (stop [this] this)
+
   WebService
   (request-handlers [this]
     {::grant
@@ -279,7 +339,7 @@
                      ;; that looks to be a github thing.

                      :body (format "client_id=%s&client_secret=%s&code=%s"
-                                   client-id client-secret code)}
+                                   (:client-id this) (:client-secret this) code)}
                     #(if (:error %)
                        %
                        (update-in % [:body] (comp decode-stream io/reader))))]
@@ -342,12 +402,16 @@
   [& {:as opts}]
   (component/using
    (->> opts
-        (merge {:store (atom {:expected-states #{}})
-                })
-        (s/validate {:client-id s/Str
-                     :client-secret s/Str
+        (merge {:store (atom {:expected-states #{}})})
+        (s/validate {(s/optional-key :client-id) s/Str
+                     (s/optional-key :client-secret) s/Str
+                     :application-name s/Str
+                     :homepage-uri s/Str
+                     :callback-uri s/Str
+
+                     :required-scopes #{s/Keyword}
                      :store s/Any
-                     :required-scopes #{s/Keyword}
+
                      :authorize-uri s/Str
                      :access-token-uri s/Str
                      })
@@ -390,18 +454,38 @@
       (let [access-token (second (re-matches #"\Qtoken\E\s+(.*)" (get (:headers request) "authorization")))
             session (get-session (:access-token-store this) access-token)
             scopes (:scopes session)]
-
         (infof "session is %s, scopes is %s" session scopes)
-
-        (when scopes
-          (scopes scope)))
+        (when scopes (scopes scope)))

       ;; Not a valid scope
-
-      (throw (ex-info "Not a valid scope!" {:scope scope}))
-
-      )))
+      (throw (ex-info "Not a valid scope!" {:scope scope})))))

 (defn new-oauth2-access-token-authorizer [& {:as opts}]
-  (component/using (->OAuth2AccessTokenAuthorizer) [:access-token-store :auth-server])
-)
+  (component/using (->OAuth2AccessTokenAuthorizer) [:access-token-store :auth-server]))
+
+;; Optional ApplicationRegistry implementation
+
+(defrecord RefBackedApplicationRegistry []
+  component/Lifecycle
+  (start [this]
+    (assoc this :store {:last-client-id (ref 1000)
+                        :applications (ref {})}))
+  (stop [this] this)
+
+  ApplicationRegistry
+  (register-application [this properties]
+    (dosync
+     (let [client-id (or (:client-id properties)
+                         (str (alter (-> this :store :last-client-id) inc)))
+           properties (assoc properties
+                        :client-id client-id
+                        :client-secret (or (:client-secret properties)
+                                           (str (java.util.UUID/randomUUID))))]
+       (alter (-> this :store :applications) assoc client-id properties)
+       (select-keys properties [:client-id :client-secret]))))
+
+  (lookup-application [this client-id]
+    (-> this :store :applications deref (get client-id))))
+
+(defn new-ref-backed-application-registry []
+  (->RefBackedApplicationRegistry))


consistent log time spent for worker (timeout, failure, success)

--- jar-async/src/slipstream/async/collector.clj
+++ jar-async/src/slipstream/async/collector.clj
@@ -34,7 +34,7 @@
 (def number-of-readers 32)
 (def timeout-all-users-loop (seconds-in-msecs 240))
 (def timeout-online-loop (seconds-in-msecs 10))
-(def timeout-collect (* 2 timeout-collect-loop))
+(def timeout-collect (* 6 timeout-online-loop))
 (def timeout-collect-reader-release (+ timeout-collect (seconds-in-msecs 2)))
 (def timeout-processing-loop (seconds-in-msecs 60))

@@ -68,36 +68,33 @@
 ; This is the channel for queuing all user requests
 (def all-collector-chan (chan (sliding-buffer collector-chan-size)))

-(defn- build-user-connector-msg
-  [user connector]
-  (str "user " (get-name user) " on cloud " (.getConnectorInstanceName connector)))
-
 (defn- build-msg
-  [prefix user connector suffix]
-  (str prefix "for " (build-user-connector-msg user connector) suffix))
+  [user connector elapsed & info]
+  (apply str "[user " (get-name user) " on cloud " (.getConnectorInstanceName connector) "] (" elapsed " ms) : " info))

 (defn log-timeout
-  [user connector]
-  (log/log-error (build-msg "Timed out in waiting for collecting vms " user connector "")))
+  [user connector elapsed]
+  (log/log-error (build-msg user connector elapsed "Timed out in waiting for collecting vms")))

 (defn log-failure
-  [user connector]
-  (log/log-error (build-msg "Failed collecting vms " user connector "")))
+  [user connector elapsed]
+  (log/log-error (build-msg user connector elapsed "Failed collecting vms")))

 (defn log-collected
-  [user connector v]
-  (log/log-info (build-msg "Number of VMs collected " user connector (str ": " v))))
+  [user connector elapsed v]
+  (log/log-info (build-msg user connector elapsed "Number of VMs collected = " v)))

 (defn collect!
   [user connector]
-  (let [ch (chan 1)]
+  (let [ch (chan 1) start-ts (System/currentTimeMillis)]
     (go
-      (let [[v _] (alts! [ch (timeout timeout-collect-reader-release)])]
+      (let [ [v _] (alts! [ch (timeout timeout-collect-reader-release)])
+             elapsed (- (System/currentTimeMillis) start-ts) ]
         (swap! busy free [(get-name user) connector])
         (cond
-          (nil? v) (log-timeout user connector)
-          (< v 0) (log-failure user connector)
-          :else (log-collected user connector v))))
+          (nil? v) (log-timeout user connector elapsed)
+          (< v 0) (log-failure user connector elapsed)
+          :else (log-collected user connector elapsed))))
     (go (>! ch (Collector/collect user connector (msecs-in-seconds timeout-collect))))))

 (defn update-metric!
@@ -146,7 +143,7 @@
   (let [connectors (connectors)]
     (check-channel-size users connectors)
     (doseq [u users
-      c connectors]
+            c connectors]
       (if-not (@busy [(get-name u) c])
         (go (>! chan [u c]))
         (log/log-info "Avoiding working on " (build-user-connector-msg u c) " being in a process." )))))


Use proper slingshot namespace.

Use proper slingshot namespace.

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -1,7 +1,7 @@
 (ns clj-http.client
   "Batteries-included HTTP client."
   (:use [clj-http.cookies :only (wrap-cookies)]
-        [slingshot.core :only [throw+]])
+        [slingshot.slingshot :only [throw+]])
   (:require [clojure.string :as str]
             [clj-http.core :as core]
             [clj-http.util :as util])


CLJS-566: Added 1-arity method to partial

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -2597,6 +2597,7 @@
   "Takes a function f and fewer than the normal arguments to f, and
   returns a fn that takes a variable number of additional args. When
   called, the returned function calls f with args + additional args."
+  ([f] f)
   ([f arg1]
    (fn [& args] (apply f arg1 args)))
   ([f arg1 arg2]


* src/cljs/cljs/core.cljs: backout CLJS-84 fix, breaks browser REPL

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -981,8 +981,6 @@
   one arg, returns the concatenation of the str values of the args."
   ([] "")
   ([x] (cond
-        (symbol? x) (. x (substring 2 (.length x)))
-        (keyword? x) (str ":" (. x (substring 2 (.length x))))
         (nil? x) ""
         :else (. x (toString))))
   ([x & ys]


require cljs.test macro ns in cljs.test to get macro inference goodness

--- src/cljs/cljs/test.cljs
+++ src/cljs/cljs/test.cljs
@@ -241,7 +241,8 @@
    For additional event types, see the examples in the code.
 "}
   cljs.test
-  (:require-macros [clojure.template :as temp])
+  (:require-macros [clojure.template :as temp]
+                   [cljs.test :as test])
   (:require [clojure.string :as string]))

 ;; =============================================================================


cache route

cache route

--- src/cljsbin/routes.cljs
+++ src/cljsbin/routes.cljs
@@ -54,7 +54,6 @@
   (json-handler (fn [req]
                   {:user-agent (get-in req [:headers "user-agent"])})))

-;; FIXME differnt headers: macchiato session,cache control, empty length and type
 (defn clean-headers
   "Return a sorted map of headers with the proper casing."
   [req]
@@ -124,6 +123,14 @@
   (-> (r/file "./public/deny.txt")
       (r/content-type "text/plain")
       (res)))
+
+(defn cache
+  "Returns 200 unless an If-Modified-Since or If-None-Match header is provided, when it returns a 304."
+  [req res raise]
+  (if (or (get-in req [:headers "if-modified-since"])
+          (get-in req [:headers "if-none-match"]))
+    (res (r/not-modified))
+    (get_ req res raise)))

 (defn status
   "Returns given HTTP Status code."
@@ -241,6 +248,7 @@
        "/html" {:get html}
        "/robots.txt" {:get robots}
        "/deny" {:get deny}
+       "/cache" {:get cache}
        ["/status/" :status] {:get status}
        ["/delay/" :n] {:get delay_}
        "/response-headers" {:get response-headers}


Fix arity problems for some functions.

Fix arity problems for some functions.

--- src/cljx/quil/core.cljx
+++ src/cljx/quil/core.cljx
@@ -235,6 +235,17 @@
              KeyEvent/VK_F23     :f23
              KeyEvent/VK_F24     :f24})

+#+clj
+(def ^{:private true}
+  filter-modes {:threshold PConstants/THRESHOLD
+                :gray PConstants/GRAY
+                :invert PConstants/INVERT
+                :posterize PConstants/POSTERIZE
+                :blur PConstants/BLUR
+                :opaque PConstants/OPAQUE
+                :erode PConstants/ERODE
+                :dilate PConstants/DILATE})
+
 ;; ------------------ end PConstants section ---------------------

 #+cljs
@@ -447,6 +458,7 @@
   parameters. This is very slow because it will try to calculate the
   inverse of the transform, so avoid it whenever possible. The
   equivalent function in OpenGL is glMultMatrix()."
+  #+clj
   ([n00 n01 n02 n10 n11 n12]
      (.applyMatrix (current-graphics)
                    (float n00) (float n01) (float n02)
@@ -1719,21 +1731,16 @@
     :added "1.0"}
   fill
   "Sets the color used to fill shapes."
-  #+clj ([rgb] (if (int-like? rgb) (fill-int rgb) (fill-float rgb)))
-  #+clj ([rgb alpha] (if (int-like? rgb) (fill-int rgb alpha) (fill-float rgb alpha)))
+  ([rgb]
+    #+clj (if (int-like? rgb) (fill-int rgb) (fill-float rgb))
+    #+cljs (fill-float rgb))
+
+  ([rgb alpha]
+    #+clj (if (int-like? rgb) (fill-int rgb alpha) (fill-float rgb alpha))
+    #+cljs (fill-float rgb alpha))
+
   ([r g b] (fill-float r g b))
   ([r g b a] (fill-float r g b a)))
-
-#+clj
-(def ^{:private true}
-  filter-modes {:threshold PConstants/THRESHOLD
-                :gray PConstants/GRAY
-                :invert PConstants/INVERT
-                :posterize PConstants/POSTERIZE
-                :blur PConstants/BLUR
-                :opaque PConstants/OPAQUE
-                :erode PConstants/ERODE
-                :dilate PConstants/DILATE})

 #+clj
 (defn
@@ -3903,8 +3910,14 @@
   color is either specified in terms of the RGB or HSB color depending
   on the current color-mode (the default color space is RGB, with
   each value in the range from 0 to 255)."
-  #+clj ([rgb] (if (int-like? rgb) (stroke-int rgb) (stroke-float rgb)))
-  #+clj ([rgb alpha] (if (int-like? rgb) (stroke-int rgb alpha) (stroke-float rgb alpha)))
+  ([rgb]
+    #+clj (if (int-like? rgb) (stroke-int rgb) (stroke-float rgb))
+    #+cljs (stroke-float rgb))
+
+  ([rgb alpha]
+    #+clj (if (int-like? rgb) (stroke-int rgb alpha) (stroke-float rgb alpha))
+    #+cljs (stroke-float rgb alpha))
+
   ([x y z] (stroke-float x y z))
   ([x y z a] (stroke-float x y z a)))


Fixed issue #64: Delete unecessary imports from all modules

--- src/clouseau/server.clj
+++ src/clouseau/server.clj
@@ -39,9 +39,6 @@
 (ns clouseau.server)

 (require '[ring.util.response     :as http-response])
-(require '[hiccup.core            :as hiccup])
-(require '[hiccup.page            :as page])
-(require '[hiccup.form            :as form])

 (require '[clouseau.products      :as products])
 (require '[clouseau.calendar      :as calendar])


4clojure:: reverse-interleaving process(med difficulty)

--- src/clojure_learning/4clojure-exercises.clj
+++ src/clojure_learning/4clojure-exercises.clj
@@ -334,4 +334,24 @@
 ;; ................. and we reached the MEDIUM dificulty level :)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Write a function which reverses the interleave process into x number of subsequences
-;; (= (__ [1 2 3 4 5 6] 2) '((1 3 5) (2 4 6)))
+;; (= (__ (range 10) 5) '((0 5) (1 6) (2 7) (3 8) (4 9)))
+;; (= (__ [1 2 3 4 5 6] 2) '((1 3 5) (2 4 6))) -> true
+
+;; this func passes the the 1st unit test -> but fails for the second... not good :(
+((fn [coll pos] (partition-all pos coll)) [0 1 2 3 4 5 6 7 8 9] 5) ;((0 1 2 3 4) (5 6 7 8 9))
+(defn rev-interleave
+  [coll pos]
+  (letfn [(part-by [pos coll] (partition-all pos coll))]
+    (let [[head tail] (part-by pos coll)]
+      (map #(vector % %2) head tail))))
+
+;; Note -> fix this func -> as if the partitions are more than 2 -> the rest are lost!!! -> and it will work.
+;; --> use recur instead of [let]
+(rev-interleave (range 10) 5) ; ([0 5] [1 6] [2 7] [3 8] [4 9])
+;; map in action:
+(map #(vector %1 %2) [1 2 3] [4 5 6]); ([1 4] [2 5] [3 6])
+
+(rev-interleave [1 2 3 4 5 6] 2)
+(partition-all 2 [1 2 3 4 5 6])
+
+(doc interleave); returns a lazy seq of the first item in each coll, then the second...


Updated Apache Commons dependencies

Updated Apache Commons dependencies

--- ring-core/project.clj
+++ ring-core/project.clj
@@ -2,8 +2,8 @@
   :description "Ring core libraries."
   :url "http://github.com/mmcgrana/ring"
   :dependencies [[org.clojure/clojure "1.2.1"]
-                 [commons-codec "1.4"]
-                 [commons-io "1.4"]
+                 [commons-codec "1.6"]
+                 [commons-io "2.1"]
                  [commons-fileupload "1.2.1"]
                  [javax.servlet/servlet-api "2.5"]]
   :dev-dependencies [[org.clojure/clojure-contrib "1.2.0"]])


remove unused core.async require

remove unused core.async require

--- src/main/shadow/cljs/devtools/client/node.cljs
+++ src/main/shadow/cljs/devtools/client/node.cljs
@@ -6,8 +6,7 @@
     [shadow.remote.runtime.shared :as shared]
     [shadow.cljs.devtools.client.shared :as cljs-shared]
     [shadow.cljs.devtools.client.env :as env]
-    [shadow.remote.runtime.api :as api]
-    [cljs.core.async :as async]))
+    [shadow.remote.runtime.api :as api]))

 (defn node-eval [{:keys [js source-map-json] :as msg}]
   (let [result (js/SHADOW_NODE_EVAL js source-map-json)]


Define dispatchable QL functions with metadata annotation :yum:

--- src/metabase/driver/query_processor/expand.clj
+++ src/metabase/driver/query_processor/expand.clj
@@ -32,20 +32,11 @@
       (str/replace #"_" "-")
       keyword))

-(def ^:private ^:const dispatchable-tokens
-  "Keywords that have a corresponding function in this namespace that we can 'dispatch' to."
-  #{;; top-level
-    :aggregation :breakout :filter :fields :order-by :source-table :limit :page
-    ;; aggregation subclauses
-    :count :avg :distinct :stddev :sum :cum-sum
-    ;; filter subclauses
-    :and :or :inside :between := :!= :< :> :<= :>= :starts-with :contains :ends-with :time-interval
-    ;; fields
-    :fk-> :datetime-field
-    ;; order-by subclauses
-    :asc :desc
-    ;; values
-    :relative-datetime})
+;;; Function Dispatch
+;; QL functions are any public function in this namespace marked with `^:ql`.
+;; At the bottom of this namespace, we collect these functions and create a dispatch map, `token->ql-fn`.
+
+(declare token->ql-fn)

 (defn- apply-fn-for-token
   "Apply the appropriate function for dispatchable token.
@@ -55,9 +46,7 @@
    (apply-fn-for-token (first token+args) (rest token+args)))
   ([token args]
    (let [token (normalize-token token)
-         ;; _     (println "fn:" (cons (name token) args))
-         f     (core/or (when (contains? dispatchable-tokens token)
-                          (ns-resolve 'metabase.driver.query-processor.expand (symbol (name token))))
+         f     (core/or (token->ql-fn token)
                         (throw (Exception. (str "Illegal clause (no matching fn found): " token))))]
      (apply f args))))

@@ -86,12 +75,12 @@
                                  (apply-fn-for-token token args)))
     :else                    (throw (Exception. (str "Invalid field: " f)))))

-(s/defn ^:always-validate datetime-field :- FieldPlaceholder
+(s/defn ^:ql ^:always-validate datetime-field :- FieldPlaceholder
   "Reference to a `DateTimeField`. This is just a `Field` reference with an associated datetime UNIT."
   ([f _ unit] (datetime-field f unit))
   ([f unit]   (assoc (field f) :datetime-unit (normalize-token unit))))

-(s/defn ^:always-validate fk-> :- FieldPlaceholder
+(s/defn ^:ql ^:always-validate fk-> :- FieldPlaceholder
   "Reference to a `Field` that belongs to another `Table`. DEST-FIELD-ID is the ID of this Field, and FK-FIELD-ID is the ID of the foreign key field
    belonging to the *source table* we should use to perform the join.

@@ -111,7 +100,7 @@
     (vector? v)                    (apply-fn-for-token (first v) (cons f (rest v)))
     :else                          (i/map->ValuePlaceholder {:field-placeholder (field f), :value v})))

-(s/defn ^:always-validate relative-datetime :- RelativeDatetime
+(s/defn ^:ql ^:always-validate relative-datetime :- RelativeDatetime
   "Value that represents a point in time relative to each moment the query is ran, e.g. \"today\" or \"1 year ago\".

    With `:current` as the only arg, refer to the current point in time; otherwise N is some number and UNIT is a unit like `:day` or `:year`.
@@ -129,23 +118,23 @@
 (s/defn ^:private ^:always-validate ag-with-field :- i/Aggregation [ag-type f]
   {:aggregation-type ag-type, :field (field f)})

-(def ^{:arglists '([f])} avg      "Aggregation clause. Return the average value of F."                (partial ag-with-field :avg))
-(def ^{:arglists '([f])} distinct "Aggregation clause. Return the number of distinct values of F."    (partial ag-with-field :distinct))
-(def ^{:arglists '([f])} sum      "Aggregation clause. Return the sum of the values of F."            (partial ag-with-field :sum))
-(def ^{:arglists '([f])} cum-sum  "Aggregation clause. Return the cumulative sum of the values of F." (partial ag-with-field :cumulative-sum))
-
-(defn stddev
+(def ^:ql ^{:arglists '([f])} avg      "Aggregation clause. Return the average value of F."                (partial ag-with-field :avg))
+(def ^:ql ^{:arglists '([f])} distinct "Aggregation clause. Return the number of distinct values of F."    (partial ag-with-field :distinct))
+(def ^:ql ^{:arglists '([f])} sum      "Aggregation clause. Return the sum of the values of F."            (partial ag-with-field :sum))
+(def ^:ql ^{:arglists '([f])} cum-sum  "Aggregation clause. Return the cumulative sum of the values of F." (partial ag-with-field :cumulative-sum))
+
+(defn ^:ql stddev
   "Aggregation clause. Return the standard deviation of values of F."
   [f]
   (i/assert-driver-supports :standard-deviation-aggregations)
   (ag-with-field :stddev f))

-(s/defn ^:always-validate count :- i/Aggregation
+(s/defn ^:ql ^:always-validate count :- i/Aggregation
   "Aggregation clause. Return total row count (e.g., `COUNT(*)`). If F is specified, only count rows where F is non-null (e.g. `COUNT(f)`)."
   ([]  {:aggregation-type :count})
   ([f] (ag-with-field :count f)))

-(s/defn ^:always-validate aggregation
+(s/defn ^:ql ^:always-validate aggregation
   "Specify the aggregation to be performed for this query.

      (aggregation {} (count 100))
@@ -166,8 +155,8 @@

 (defn- fields-list-clause [k query & fields] (assoc query k (mapv field fields)))

-(def ^{:arglists '([query & fields])} breakout "Specify which fields to breakout by." (partial fields-list-clause :breakout))
-(def ^{:arglists '([query & fields])} fields   "Specify which fields to return."      (partial fields-list-clause :fields))
+(def ^:ql ^{:arglists '([query & fields])} breakout "Specify which fields to breakout by." (partial fields-list-clause :breakout))
+(def ^:ql ^{:arglists '([query & fields])} fields   "Specify which fields to return."      (partial fields-list-clause :fields))

 ;;; ## filter

@@ -178,8 +167,8 @@
   ([compound-type subclause & more]
    (i/map->CompoundFilter {:compound-type compound-type, :subclauses (mapv expand-filter-subclause-if-needed (cons subclause more))})))

-(def ^{:arglists '([& subclauses])} and "Filter subclause. Return results that satisfy *all* SUBCLAUSES." (partial compound-filter :and))
-(def ^{:arglists '([& subclauses])} or  "Filter subclause. Return results that satisfy *any* of the SUBCLAUSES." (partial compound-filter :or))
+(def ^:ql ^{:arglists '([& subclauses])} and "Filter subclause. Return results that satisfy *all* SUBCLAUSES." (partial compound-filter :and))
+(def ^:ql ^{:arglists '([& subclauses])} or  "Filter subclause. Return results that satisfy *any* of the SUBCLAUSES." (partial compound-filter :or))

 (s/defn ^:private ^:always-validate equality-filter :- i/Filter
   ([filter-type _ f v]
@@ -188,14 +177,14 @@
    (apply compound-fn (for [v (cons v more)]
                         (equality-filter filter-type compound-fn f v)))))

-(def ^{:arglists '([f v & more])} =
+(def ^:ql ^{:arglists '([f v & more])} =
   "Filter subclause. With a single value, return results where F == V. With two or more values, return results where F matches *any* of the values (i.e.`IN`)

      (= f v)
      (= f v1 v2) ; same as (or (= f v1) (= f v2))"
   (partial equality-filter := or))

-(def ^{:arglists '([f v & more])} !=
+(def ^:ql ^{:arglists '([f v & more])} !=
   "Filter subclause. With a single value, return results where F != V. With two or more values, return results where F does not match *any* of the values (i.e. `NOT IN`)

      (!= f v)
@@ -205,18 +194,18 @@
 (s/defn ^:private ^:always-validate comparison-filter :- ComparisonFilter [filter-type f v]
   (i/map->ComparisonFilter {:filter-type filter-type, :field (field f), :value (value f v)}))

-(def ^{:arglists '([f v])} <  "Filter subclause. Return results where F is less than V. V must be orderable, i.e. a number or datetime."                (partial comparison-filter :<))
-(def ^{:arglists '([f v])} <= "Filter subclause. Return results where F is less than or equal to V. V must be orderable, i.e. a number or datetime."    (partial comparison-filter :<=))
-(def ^{:arglists '([f v])} >  "Filter subclause. Return results where F is greater than V. V must be orderable, i.e. a number or datetime."             (partial comparison-filter :>))
-(def ^{:arglists '([f v])} >= "Filter subclause. Return results where F is greater than or equal to V. V must be orderable, i.e. a number or datetime." (partial comparison-filter :>=))
-
-(s/defn ^:always-validate between :- BetweenFilter
+(def ^:ql ^{:arglists '([f v])} <  "Filter subclause. Return results where F is less than V. V must be orderable, i.e. a number or datetime."                (partial comparison-filter :<))
+(def ^:ql ^{:arglists '([f v])} <= "Filter subclause. Return results where F is less than or equal to V. V must be orderable, i.e. a number or datetime."    (partial comparison-filter :<=))
+(def ^:ql ^{:arglists '([f v])} >  "Filter subclause. Return results where F is greater than V. V must be orderable, i.e. a number or datetime."             (partial comparison-filter :>))
+(def ^:ql ^{:arglists '([f v])} >= "Filter subclause. Return results where F is greater than or equal to V. V must be orderable, i.e. a number or datetime." (partial comparison-filter :>=))
+
+(s/defn ^:ql ^:always-validate between :- BetweenFilter
   "Filter subclause. Return results where F is between MIN and MAX. MIN and MAX must be orderable, i.e. numbers or datetimes.
    This behaves like SQL `BETWEEN`, i.e. MIN and MAX are inclusive."
   [f min-val max-val]
   (i/map->BetweenFilter {:filter-type :between, :field (field f), :min-val (value f min-val), :max-val (value f max-val)}))

-(s/defn ^:always-validate inside :- CompoundFilter
+(s/defn ^:ql ^:always-validate inside :- CompoundFilter
   "Filter subclause for geo bounding. Return results where LAT-FIELD and LON-FIELD are between some set of bounding values."
   [lat-field lon-field lat-max lon-min lat-min lon-max]
   (and (between lat-field lat-min lat-max)
@@ -225,11 +214,11 @@
 (s/defn ^:private ^:always-validate string-filter :- StringFilter [filter-type f s]
   (i/map->StringFilter {:filter-type filter-type, :field (field f), :value (value f s)}))

-(def ^{:arglists '([f s])} starts-with "Filter subclause. Return results where F starts with the string V."    (partial string-filter :starts-with))
-(def ^{:arglists '([f s])} contains    "Filter subclause. Return results where F contains the string V."       (partial string-filter :contains))
-(def ^{:arglists '([f s])} ends-with   "Filter subclause. Return results where F ends with with the string V." (partial string-filter :ends-with))
-
-(s/defn ^:always-validate time-interval :- i/Filter
+(def ^:ql ^{:arglists '([f s])} starts-with "Filter subclause. Return results where F starts with the string V."    (partial string-filter :starts-with))
+(def ^:ql ^{:arglists '([f s])} contains    "Filter subclause. Return results where F contains the string V."       (partial string-filter :contains))
+(def ^:ql ^{:arglists '([f s])} ends-with   "Filter subclause. Return results where F ends with with the string V." (partial string-filter :ends-with))
+
+(s/defn ^:ql ^:always-validate time-interval :- i/Filter
   "Filter subclause. Syntactic sugar for specifying a specific time interval.

     (filter {} (time-interval 100 :current :day)) ; return rows where datetime Field 100's value is in the current day"
@@ -255,7 +244,7 @@
     (vector? subclause) (apply-fn-for-token subclause)
     (map? subclause)    subclause))

-(s/defn ^:always-validate filter
+(s/defn ^:ql ^:always-validate filter
   "Filter the results returned by the query.

      (filter {} := 100 true) ; return rows where Field 100 == true"
@@ -264,7 +253,7 @@
   ([query filter-type & args]
    (filter query (apply-fn-for-token filter-type args))))

-(s/defn ^:always-validate limit
+(s/defn ^:ql ^:always-validate limit
   "Limit the number of results returned by the query.

      (limit {} 10)"
@@ -282,21 +271,21 @@
                                                                  "Prefer [:asc <field>] or [:desc <field>] instead.")))
                           {:field (field f), :direction (normalize-token direction)})))

-(s/defn ^:always-validate asc :- i/OrderBy
+(s/defn ^:ql ^:always-validate asc :- i/OrderBy
   "order-by subclause. Specify that results should be returned in ascending order for Field or AgRef F.

      (order-by {} (asc 100))"
   [f]
   {:field (field f), :direction :ascending})

-(s/defn ^:always-validate desc :- i/OrderBy
+(s/defn ^:ql ^:always-validate desc :- i/OrderBy
   "order-by subclause. Specify that results should be returned in ascending order for Field or AgRef F.

      (order-by {} (desc 100))"
   [f]
   {:field (field f), :direction :descending})

-(defn order-by
+(defn ^:ql order-by
   "Specify how ordering should be done for this query.

      (order-by {} (asc 20))        ; order by field 20
@@ -308,7 +297,7 @@

 ;;; ## page

-(s/defn ^:always-validate page
+(s/defn ^:ql ^:always-validate page
   "Specify which 'page' of results to fetch (offset and limit the results).

      (page {} {:page 1, :items 20}) ; fetch first 20 rows"
@@ -317,7 +306,7 @@

 ;;; ## source-table

-(s/defn ^:always-validate source-table
+(s/defn ^:ql ^:always-validate source-table
   "Specify the ID of the table to query (required).

      (source-table {} 100)"
@@ -390,3 +379,13 @@
   {:style/indent 0}
   [& body]
   `(run-query* (query ~@body)))
+
+
+;; Now collect the functions we marked as ^:ql (see above)
+
+(def token->ql-fn
+  "A map of keywords (e.g., `:=`), to the matching vars (e.g., `#'=`)."
+  (into {} (for [[symb varr] (ns-publics *ns*)
+                 :let        [metta (meta varr)]
+                 :when       (:ql metta)]
+             {(keyword symb) varr})))


Eliminate one occurrence of reflection via a type hint

--- src/compojure/route.clj
+++ src/compojure/route.clj
@@ -9,7 +9,7 @@

 (defn- add-wildcard
   "Add a wildcard to the end of a route path."
-  [path]
+  [^String path]
   (str path (if (.endsWith path "/") "*" "/*")))

 (defn files


(SERVER-1752) Remove unneeded with-test-logging

--- test/integration/puppetlabs/services/master/master_service_test.clj
+++ test/integration/puppetlabs/services/master/master_service_test.clj
@@ -355,76 +355,75 @@
     (with-redefs [metrics-core/build-graphite-sender
                   (fn [_ domain]
                     (metrics-testutils/make-graphite-sender reported-metrics-atom domain))]
-      (logutils/with-test-logging
-       (bootstrap-testutils/with-puppetserver-running
-        app
-        graphite-enabled-config
-        (let [registry (:registry (get-puppetserver-registry-context app))
-              get-memory-map
-              (fn [mem-type]
-                (ks/mapvals #(.getValue %)
-                            (filter #(.matches (key %) (format "puppetlabs.localhost.memory.%s.*" mem-type))
-                                    (.getMetrics registry))))
-              heap-memory-map (get-memory-map "heap")
-              non-heap-memory-map (get-memory-map "non-heap")
-              total-memory-map (get-memory-map "total")]
-          (testing "heap memory metrics work"
-            (= #{"puppetlabs.localhost.memory.heap.committed"
-                 "puppetlabs.localhost.memory.heap.init"
-                 "puppetlabs.localhost.memory.heap.max"
-                 "puppetlabs.localhost.memory.heap.used"} (ks/keyset heap-memory-map))
-            (is (every? #(< 0 %) (vals heap-memory-map))))
-
-          (testing "non-heap memory metrics work"
-            (= #{"puppetlabs.localhost.memory.non-heap.committed"
-                 "puppetlabs.localhost.memory.non-heap.init"
-                 "puppetlabs.localhost.memory.non-heap.max"
-                 "puppetlabs.localhost.memory.non-heap.used"}
-               (ks/keyset non-heap-memory-map))
-            ;; Some of the memory metrics don't propagate correctly on OS X, which can result in a
-            ;; value of -1. This is here so that these tests will pass when run in developers local
-            ;; environments.
-            (is (every? #(or (< 0 %) (= -1 %)) (vals non-heap-memory-map))))
-
-          (testing "total memory metrics work"
-            (= #{"puppetlabs.localhost.memory.total.committed"
-                 "puppetlabs.localhost.memory.total.init"
-                 "puppetlabs.localhost.memory.total.max"
-                 "puppetlabs.localhost.memory.total.used"}
-               (ks/keyset total-memory-map))
-            (is (every? #(< 0 %) (vals total-memory-map))))
-
-          (testing "uptime metric works"
-            (let [get-uptime (fn [] (-> registry
-                                        .getMetrics
-                                        (get "puppetlabs.localhost.uptime")
-                                        .getValue))
-                  uptime (get-uptime)]
-              (is (< 0 uptime))
-              ;; Make sure uptime can be updated after initialization.
-              (Thread/sleep 1)
-              (is (not= uptime (get-uptime))))))
-
-        (.report (get-puppetserver-graphite-reporter app))
-
-        (testing "jvm metrics are reported to graphite"
-          (is (every? #(metrics-testutils/reported? @reported-metrics-atom
-                                                    :puppetserver
-                                                    %)
-                      (map #(format "puppetlabs.localhost.memory.%s" %)
-                           ["heap.committed"
-                            "heap.init"
-                            "heap.max"
-                            "heap.used"
-                            "non-heap.committed"
-                            "non-heap.init"
-                            "non-heap.max"
-                            "non-heap.used"
-                            "total.committed"
-                            "total.init"
-                            "total.max"
-                            "total.used"])))
-
-          (is (metrics-testutils/reported? @reported-metrics-atom
-                                           :puppetserver
-                                           "puppetlabs.localhost.uptime"))))))))
+      (bootstrap-testutils/with-puppetserver-running
+       app
+       graphite-enabled-config
+       (let [registry (:registry (get-puppetserver-registry-context app))
+             get-memory-map
+             (fn [mem-type]
+               (ks/mapvals #(.getValue %)
+                           (filter #(.matches (key %) (format "puppetlabs.localhost.memory.%s.*" mem-type))
+                                   (.getMetrics registry))))
+             heap-memory-map (get-memory-map "heap")
+             non-heap-memory-map (get-memory-map "non-heap")
+             total-memory-map (get-memory-map "total")]
+         (testing "heap memory metrics work"
+           (= #{"puppetlabs.localhost.memory.heap.committed"
+                "puppetlabs.localhost.memory.heap.init"
+                "puppetlabs.localhost.memory.heap.max"
+                "puppetlabs.localhost.memory.heap.used"} (ks/keyset heap-memory-map))
+           (is (every? #(< 0 %) (vals heap-memory-map))))
+
+         (testing "non-heap memory metrics work"
+           (= #{"puppetlabs.localhost.memory.non-heap.committed"
+                "puppetlabs.localhost.memory.non-heap.init"
+                "puppetlabs.localhost.memory.non-heap.max"
+                "puppetlabs.localhost.memory.non-heap.used"}
+              (ks/keyset non-heap-memory-map))
+           ;; Some of the memory metrics don't propagate correctly on OS X, which can result in a
+           ;; value of -1. This is here so that these tests will pass when run in developers local
+           ;; environments.
+           (is (every? #(or (< 0 %) (= -1 %)) (vals non-heap-memory-map))))
+
+         (testing "total memory metrics work"
+           (= #{"puppetlabs.localhost.memory.total.committed"
+                "puppetlabs.localhost.memory.total.init"
+                "puppetlabs.localhost.memory.total.max"
+                "puppetlabs.localhost.memory.total.used"}
+              (ks/keyset total-memory-map))
+           (is (every? #(< 0 %) (vals total-memory-map))))
+
+         (testing "uptime metric works"
+           (let [get-uptime (fn [] (-> registry
+                                       .getMetrics
+                                       (get "puppetlabs.localhost.uptime")
+                                       .getValue))
+                 uptime (get-uptime)]
+             (is (< 0 uptime))
+             ;; Make sure uptime can be updated after initialization.
+             (Thread/sleep 1)
+             (is (not= uptime (get-uptime))))))
+
+       (.report (get-puppetserver-graphite-reporter app))
+
+       (testing "jvm metrics are reported to graphite"
+         (is (every? #(metrics-testutils/reported? @reported-metrics-atom
+                                                   :puppetserver
+                                                   %)
+                     (map #(format "puppetlabs.localhost.memory.%s" %)
+                          ["heap.committed"
+                           "heap.init"
+                           "heap.max"
+                           "heap.used"
+                           "non-heap.committed"
+                           "non-heap.init"
+                           "non-heap.max"
+                           "non-heap.used"
+                           "total.committed"
+                           "total.init"
+                           "total.max"
+                           "total.used"])))
+
+         (is (metrics-testutils/reported? @reported-metrics-atom
+                                          :puppetserver
+                                          "puppetlabs.localhost.uptime")))))))


Bumps version to 1.34.2-SNAPSHOT

Bumps version to 1.34.2-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.34.1"
+(defproject cook "1.34.2-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Bumps version to 1.49.3-SNAPSHOT

Bumps version to 1.49.3-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.49.2"
+(defproject cook "1.49.3-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


fix for undeclared Var cljs.pprint/pprint warning

--- src/datafrisk/view.cljs
+++ src/datafrisk/view.cljs
@@ -1,5 +1,6 @@
 (ns datafrisk.view
-  (:require [reagent.core :as r]
+  (:require [cljs.pprint :refer [pprint]]
+            [reagent.core :as r]
             [datafrisk.util :as u]))

 (declare DataFrisk)
@@ -326,7 +327,7 @@
       expanded-paths)))

 (defn copy-to-clipboard [data]
-  (let [pretty (with-out-str (cljs.pprint/pprint data))
+  (let [pretty (with-out-str (pprint data))
         textArea (.createElement js/document "textarea")]
     (doto textArea
       ;; Put in top left corner of screen
@@ -422,4 +423,4 @@
                           :overflow-x "auto"
                           :overflow-y "auto"}}
             (map-indexed (fn [id x]
-                           ^{:key id} [Root x id state-atom]) data)])]))))+                           ^{:key id} [Root x id state-atom]) data)])]))))


fixed problem with lazyness in cogroup-transform

--- src/datasplash/core.clj
+++ src/datasplash/core.clj
@@ -352,6 +352,16 @@

 (def
   ^{:arglists [['f 'pcoll] ['f 'options 'pcoll]]
+    :added "0.2.0"
+    :doc
+    (with-opts-docstr
+      "Uses a raw pardo-fn as a ppardo transform
+Function f should be a function of one argument, the Pardo$Context object."
+      pardo-schema)}
+  pardo (map-op pardo-fn {:label :pardo}))
+
+(def
+  ^{:arglists [['f 'pcoll] ['f 'options 'pcoll]]
     :added "0.1.0"
     :doc
     (with-opts-docstr
@@ -518,7 +528,7 @@
     (reify
       Partition$PartitionFn
       (partitionFor [this elem num]
-       (f elem num)))))
+        (f elem num)))))

 (defn dpartition-by
   ([f num options ^PCollection pcoll]
@@ -915,20 +925,24 @@
                               (map #(.getTupleTag %))
                               (sort-by #(.getId %)))
             rel (apply-transform pcolltuple (CoGroupByKey/create) base-schema opts)
-            cogbk-coder (-> rel
-                            (.getCoder)
-                            (.getValueCoder))
-            final-rel (map-kv (fn [^KV elt]
-                                (let [k (.getKey elt)
-                                      raw-values (.getValue elt)
-
-                                      values (mapv (fn [tag] (let [raw-val (.getAll raw-values tag)
-                                                                   m-val (into (list) (iterator-seq (.iterator raw-val)))]
-                                                               m-val)) ordered-tags)]
-                                  [k values]))
-                              (assoc opts
-                                     :without-coercion-to-clj true)
-                              rel)]
+            final-rel (pardo (fn [^DoFn$ProcessContext c]
+                               (let [^KV kv (.element c)
+                                     k (.getKey kv)
+                                     ^CoGbkResult raw-values (.getValue kv)
+                                     values (mapv
+                                             (fn [tag]
+                                               (loop [^java.util.Iterator it (.iterator (.getAll raw-values tag))
+                                                      acc (list)]
+                                                 (if (.hasNext it)
+                                                   (recur it (conj acc (.next it)))
+                                                   acc)))
+                                             ordered-tags)]
+                                 (.output c (make-kv k values))))
+                             (assoc opts
+                                    :without-coercion-to-clj true
+                                    :coder (make-kv-coder (.getKeyCoder (.getCoder rel))
+                                                          (make-nippy-coder)))
+                             rel)]
         final-rel)))))

 (defn cogroup


changes assertion in integration test for Envoy reverse proxy sidecar (#1323)

* changes assertion in integration test for Envoy reverse proxy sidecar

* Update kubernetes_scheduler_integration_test.clj

--- waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
+++ waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
@@ -405,7 +405,8 @@
               (testing "Expected envoy specific headers are present in both request and response"
                 (let [response-body (try-parse-json (:body response))
                       response-headers (:headers response)]
-                  (is (contains? (get response-body "headers") "x-envoy-expected-rq-timeout-ms"))
+                  ;; x-envoy-expected-rq-timeout-ms is absent when timeouts are disabled
+                  (is (contains? (get response-body "headers") "x-envoy-external-address"))
                   (is (contains? response-headers "x-envoy-upstream-service-time")))))

             (let [response (make-request-with-debug-info


added test function for reverse-index-results

--- src/distillery/jobs.clj
+++ src/distillery/jobs.clj
@@ -1,10 +1,11 @@
 (ns distillery.jobs
   (:require [clojure.string :as string])
+  (:require [clojure.pprint :as pp])
   (:require [distillery.config :as cfg])
   (:require [distillery.data :refer :all])
   (:require [distillery.files :refer :all])
   (:require [distillery.blacklist :refer :all])
-  (:require [distillery.processing :refer :all])
+  (:require [distillery.processing :as proc])
   (:require [distillery.view.html :refer (save-page)])
   (:require [distillery.view.dependencies :refer (save-dependencies)])
   (:require [distillery.view.base :refer (render)])
@@ -53,3 +54,8 @@
          v-video/render-video-page
          (apply render)
          (save-page target-file))))
+
+(defn print-reverse-indexed-results
+  [{:keys [video]}]
+  (let [results (load-data (:results-file video))]
+    (pp/pprint (proc/reverse-index-results [(first results)]))))


updated example

updated example

--- src/examples/sclang.clj
+++ src/examples/sclang.clj
@@ -5,23 +5,21 @@

 (refer-ugens)
 (boot :internal "127.0.0.1" 5300)
+(connect-jack-ports)
 (def cb (make-vpost-cb println))
 (sclang-start cb)
+;; wait ... until (isCompiledOk)
+(sclang-connect-to-external "127.0.0.1" 5300)

-;(interpret "\"Hello, World!\".postln")
+(interpret "s.queryAllNodes;")

+(interpret (slurp "src/examples/hello.sc"))
+;(node-free 1000)

-(interpret "
-s.queryAllNodes;
-")
-(interpret (slurp "src/examples/hello.sc"))
-
-;(node-free 1003)
-
-(interpret (slurp "src/examples/play_buf.sc"))

 (load-sample "samples/kick.wav")
+(interpret (slurp "src/examples/play_buf.sc"))

 (defn kick []
   (interpret "


Added match/unmatch

Added match/unmatch

--- dev/user.clj
+++ dev/user.clj
@@ -1,5 +1,6 @@
 (ns user
   (:require [clojure.java.io :as io]
+            [clojure.tools.logging :as log]
             [net.cgrand.reload :refer [auto-reload]]
             [video-server.android :as android]
             [video-server.discovery :as discovery]
@@ -69,6 +70,20 @@
         (when-let [poster (:poster info)]
           (save-poster folder title poster))))))

+(defn match [title & [series? year duration]]
+  (when-let [title (title-for-title title)]
+    (let [fb (freebase-metadata (:title title) series? year duration)
+          info (fetch-metadata title fb)]
+      (save-metadata folder title info)
+      (when-let [poster (:poster info)]
+        (save-poster folder title poster)))))
+
+(defn unmatch [title & {:as info}]
+  (when-let [title (title-for-title title)]
+    (save-metadata folder title (merge (select-keys title [:title]) info))
+    (when-let [image (log/spy (poster-for-title title))]
+      (io/delete-file image))))
+
 (defn start []
   (main/set-log-level (main/log-level log-level))
   (binding [encoder/*fake-encode* (and fake (nil? (:encode options)))]


add partials, destructuring

add partials, destructuring

--- src/functions/core.cljc
+++ src/functions/core.cljc
@@ -1,7 +1,8 @@
-(ns functions.core)
+(ns ^{:doc "All about functions and their scope"}
+    functions.core)

-;; Apply
+;; Apply: the ultimate function!

 (apply str ["hello" " " "world"])

@@ -9,11 +10,14 @@

 (apply max [1 2 3])

+(map (partial apply +) [[1 2] [3 4]])

 ;; Regular Functions

 (defn foo [str]
   (println "hello " str))
+
+;; Multi Arity

 (defn total
   ([price qty]
@@ -21,12 +25,24 @@
   ([price]
    (* price 10)))

+(defn greeting
+  ([] (greeting "Hello" "world"))
+  ([name] (greeting "Hello" name))
+  ([salutation name] (str salutation ", " name "!")))

-;; Dynamic Binding
+;; Variadic

-(def ^:dynamic *evalme* 10)
+(defn average
+  ([x] x)
+  ([x y] (/ (+ x y) 2))
+  ([x y & extra] (/ (reduce + (+ x y) extra)
+                    (+ 2 (count extra)))))

-(binding [*evalme* 20]
-  (str "hello" *evalme*))
+;; Destructuring

-(str "hello" *evalme*)
+(defn printer [& {name :name
+                  [hole1 hole2] :scores}]
+  {"name" name "hole1" hole1 "hole2" hole2})
+
+(comment
+  (printer :name "Joey" :scores [42 18]))


Simplified either?

Simplified either?

--- src/grimoire/either.clj
+++ src/grimoire/either.clj
@@ -67,9 +67,8 @@
   Type predicate, matching either succeed or failure structures. Intended as a
   postcondition for maybe functions."
   [x]
-  (and (vector? x)
-       (= 2 (count x))
-       (#{:succeed :fail} (first x))))
+  (or (succeed? x)
+      (fail? x)))

 (defmacro with-result
   "This macro is a helper designed to emulate the Haskell pattern matching which


Something distantly meaningful

Something distantly meaningful

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -13,22 +13,19 @@
   (let [output-area (dom/getElement "output")]
     (when output-area (set! (.-value output-area) harnocode))))

-
-
-
 ;; Best try on filling "column" of l subsequent ones with one or more tokens
 (defn fill-column [ts l]
   [(first ts) (rest ts)])

 (defn fill-group [[result tokens] group]
     (if (== (first group) 0)
-      [(string/join result (repeat (count group) "_")) tokens]
+      [(conj result (string/join (repeat (count group) "_"))) tokens]
       (let [[column rest-ts] (fill-column tokens (count group))]
-        [(string/join result column) rest-ts])))
+        [(conj result column) rest-ts])))

 (defn arrange-tokens-line [ts line]
   (let [groups (partition-by identity line)]
-    (first (reduce fill-group ["" ts] groups))))
+    (first (reduce fill-group [[] ts] groups))))

 (defn arrange-tokens [ts img]
   (map #(arrange-tokens-line ts %) img))
@@ -46,15 +43,16 @@
     ))

-(let [code      "var answer = 42;"
+(let [code      "var a = 42; var b = 'hello';"
       img       [[0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
                  [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]]
       width     (count (first img))
       harnocode (harnify code img width)]


player 1 is always first to start

player 1 is always first to start

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -34,10 +34,11 @@

 (declare initial-loop)
 (defn game-loop [players]
-  (let [ch-ins (mapv :ch-in players)
+  (let [players (shuffle players)
+        ch-ins (mapv :ch-in players)
         ch-outs (mapv :ch-out players)
         state (atom (vec (repeat (* ncols nrows) 0)))
-        turn (atom (rand-int 2))
+        turn (atom 0)
         winner (atom nil)
         process-move (fn [move]
                        ;; This function enforces the rules of


added responder for waiting states

added responder for waiting states

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -2,7 +2,7 @@
   (:gen-class)
   (:require
    [clojure.core
-    [async :as async :refer [go go-loop <! >! chan put! alts!]]]
+    [async :as async :refer [go go-loop <! >! chan put! alt! alts!]]]
    [taoensso.timbre :as tb]
    [manifold
     [stream :as st]
@@ -58,43 +58,44 @@
     true))

 (defn game-loop [players]
-  (let [ch-ins (vec (map (comp first :chs) players))
-        ch-outs (vec (map (comp second :chs) players))
+  (let [ch-ins (vec (map :ch-in players))
+        ch-outs (vec (map :ch-out players))
         state (atom (vec (repeat (* ncols nrows) 0)))
         turn (atom 0)
         winner (atom nil)
         notify (fn [ch]
-                 (go (>! ch
-                         (cond->
-                             {:type :state
-                              :turn (inc (or @turn -1))
-                              :you (inc (.indexOf ch-outs ch))
-                              :state @state}
-                           @winner
-                           (assoc
-                            :winner (inc @winner)
-                            :turn 0)))))]
+                 (put!
+                  ch (cond->
+                         {:type :state
+                          :turn (inc (or @turn -1))
+                          :you (inc (.indexOf ch-outs ch))
+                          :state @state}
+                       @winner
+                       (assoc
+                        :winner (inc @winner)
+                        :turn 0))))]
     (go
+      (doseq [ch-out (vals ch-outs)]
+        (notify ch-out))
       ;; During the game
       (loop []
-        (<! (notify (ch-outs @turn)))
         (when-let [[{:keys [type move] :as msg} ch-in] (alts! ch-ins)]
           (when msg
             (let [actor (.indexOf ch-ins ch-in)
                   ch-out (ch-outs actor)]
               (cond
                 (= type "state_request")
-                (<! (notify ch-out))
+                (notify ch-out)
                 (and (= type "move")
                      (= @turn actor)
                      (process-move state winner turn move))
-                :next-turn
-                :else (>! ch-out {:type :ignored :msg msg})))
+                (notify (ch-outs @turn))
+                :else (put! ch-out {:type :ignored :msg msg})))
             (when-not @winner
               (recur)))))
       ;; Cleanup
-      (doseq [{:keys [latch] [_ ch-out] :chs} players]
-        (<! (notify ch-out))
+      (doseq [{:keys [latch ch-out]} players]
+        (notify ch-out)
         (>! ch-out {:type (if @winner "end" "disconnected")})
         (async/close! latch)))))

@@ -110,8 +111,18 @@
                         first)]
     (do (swap! awaiting (partial remove #{player1}))
         (swap! match-count update-in [#{(:id player0) (:id player1)}] (fnil inc 0))
+        (async/close! (:waiter player1))
         (game-loop [player0 player1]))
-    (swap! awaiting conj player0)))
+    (let [waiter (chan)]
+      (go-loop []
+        (alt!
+          waiter :done
+          (:ch-in player0)
+          ([msg]
+           (put! (:ch-out player0)
+                 {:type :ignored :msg msg :reason "waiting for match"})
+           (recur))))
+      (swap! awaiting conj (assoc player0 :waiter waiter)))))

 (defn matcher-init []
   (let [ch (chan)]
@@ -124,13 +135,13 @@
     (reset! matcher ch)))

 ;;; Game handler
-(defn game-handler [[ch-in ch-out :as chs]]
+(defn game-handler [[ch-in ch-out]]
   (go-loop []
     (when-let [msg (<! ch-in)]
       (let [{:keys [type id]} msg]
         (if (and (= type "start") id)
           (let [latch (chan)]
-            (>! @matcher {:id id :chs chs :latch latch})
+            (>! @matcher {:id id :ch-in ch-in :ch-out ch-out :latch latch})
             ;; Waits here until game ends
             (<! latch))
           (>! ch-out {:type "ignored" :msg msg}))


Implements add-cadences and creates necessary index.

--- src/cadence/model.clj
+++ src/cadence/model.clj
@@ -9,6 +9,7 @@
         [cemerick.friend.credentials :only [hash-bcrypt]]))

 (defn- ensure-indexes []
+  (mc/ensure-index "cadences" {:random_point "2d"})
   (mc/ensure-index "users" {:username 1} {:unique 1 :dropDups 1}))

 (defn connect [connection-info]
@@ -34,9 +35,13 @@
                   :password (hash-bcrypt (:password user)))))

 (defn add-cadences
-  "Batach inserts many cadences for the logged in user."
-  [cads]
-  true)
+  "Batch inserts many cadences for the given user."
+  [cads user-id]
+  (mc/insert-batch "cadences"
+                   (map (fn [x]
+                          (merge x {:user_id user-id
+                                    :random_point [(rand) 0]}))
+                        cads)))

 (def identity #(get friend/*identity* :current))
 (def get-auth #((:authentications friend/*identity*) (:current friend/*identity*)))


wrote a simple recursive desent parser

wrote a simple recursive desent parser

--- src/cas/language.cljs
+++ src/cas/language.cljs
@@ -18,9 +18,6 @@
     (= obj "WHILE")
     :while

-    (= obj "INT")
-    :int
-
     (= obj "SUB")
     :sub

@@ -29,12 +26,6 @@

     (= obj "DONE")
     :done
-
-    (= obj "{")
-    :open-curly
-
-    (= obj "}")
-    :close-curly

     (= obj "(")
     :open-paren
@@ -48,6 +39,58 @@

     )
   )
+
+(defn- parse-ident [stream]
+  (assert (string? (stream :peek)))
+  (stream :eat))
+
+(defn- parse-var-list [stream]
+  (assert (= (stream :eat) :open-paren))
+
+  (loop [args []]
+    (if (= (stream :peek) :close-paren)
+      args)
+    (recur (conj args (parse-ident stream)))))
+
+(defn- parse-ident-atom [stream]
+  (let [ident (stream :eat)]
+    (case (stream :peek)
+      :open-paren
+      [:func-call ident (parse-var-list stream)]
+
+      true ident)))
+
+(defn- parse-atom [stream]
+  (if (integer? (stream :peek))
+    (stream :eat)
+    (parse-ident-atom stream)))
+
+(defn- parse-dm [stream]
+  (let [left (parse-atom stream)]
+    (case (stream :peek)
+      "/" (do (stream :eat) [:div left (parse-dm stream)])
+      "*" (do (stream :eat) [:div left (parse-dm stream)])
+      true left)))
+
+(defn- parse-pm [stream]
+  (let [left (parse-dm stream)]
+    (case (stream :peek)
+      "+" [:add left (parse-pm stream)]
+      "-" [:sub left (parse-pm stream)]
+      true left)))
+
+(defn- parse-assign [stream]
+  (let [left (parse-pm stream)]
+    (case (stream :peek)
+      "="  (do (stream :eat) [:assign left (parse-assign stream)])
+      "+=" (do (stream :eat) [:assign left [:add left (parse-assign stream)]])
+      "*=" (do (stream :eat) [:assign left [:mul left (parse-assign stream)]])
+      "/=" (do (stream :eat) [:assign left [:div left (parse-assign stream)]])
+      "-=" (do (stream :eat) [:assign left [:sub left (parse-assign stream)]])
+      true left)))
+
+(defn- parse-expression [stream]
+  (parse-assign stream))

 ;;
 ;; Anything of the form: DO expression_list... DONE
@@ -117,7 +160,7 @@
   (assert (= (stream :eat) :sub))

   (let [identifier (parse-ident stream)
-        param-list (parse-param-list stream)
+        param-list (parse-var-list stream)
         block      (parse-block stream)]
     [:sub identifier param-list block]
     )
@@ -161,6 +204,5 @@
   (let [ast (make-ast text)
         idx 0]
     (fn [state] ;; action generator
-      (evaluate toks idx state)
       )
   ))


Clearing non used imports and fixing https://github.com/weavejester/compojure/issues/89

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -32,11 +32,10 @@
     [ring.middleware.session :refer (wrap-session)]
     [compojure.core :refer (GET ANY)]
     [swag.core :refer (swagger-routes GET- POST- PUT- DELETE- defroutes- errors )]
-    [ring.middleware [multipart-params :as mp] ]
     [celestial.security :as sec]
     [celestial.persistency :as p]
     [celestial.persistency.systems :as s]
-    [compojure.handler :as handler :refer (site)]
+    [compojure.handler :as handler]
     [celestial.jobs :as jobs]
     [cemerick.friend :as friend]
     [compojure.route :as route]))
@@ -165,9 +164,8 @@
   (-> (compose-routes secured?)
       (wrap-swag)
       (wrap-session {:cookie-name "celestial" :store (cookie-store)})
+      (wrap-restful-format :formats [:json-kw :edn :yaml-kw :yaml-in-html])
       (handler/api)
-      (wrap-restful-format :formats [:json-kw :edn :yaml-kw :yaml-in-html])
-      (mp/wrap-multipart-params)
       (expose-metrics-as-json)
       (instrument)
       (error-wrap)))


jobs GET

jobs GET

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -101,9 +101,15 @@
            )))

   (GET- "/jobs/:queue/:uuid/status" [^:string queue ^:string uuid]
-        {:nickname "jobStatus" :summary "job status tracking"
+        {:nickname "jobStatus" :summary "single job status tracking"
          :notes "job status can be pending, processing, done or nil"}
-        (success {:job-status (jobs/status queue uuid)})))
+        (success {:job (jobs/status queue uuid)}))
+
+  (GET- "/jobs" []
+        {:nickname "jobsStatus" :summary "Global job status tracking"
+         :notes "job status can be either pending, processing, done or nil"}
+        (success {:jobs (jobs/jobs-status)}))
+  )

 (defn convert-roles [user]


Moved ->str to a protocol

Moved ->str to a protocol

--- src/labs/redis/core.clj
+++ src/labs/redis/core.clj
@@ -6,7 +6,7 @@
         [clojure.pprint :only (pprint)]
         [clojure.java.io :only (resource)])
   (:require [clojure.data.json :as json])
-  (:import [labs.redis Client ClientPool Reply BulkReply MultiBulkReply]))
+  (:import [labs.redis Client ClientPool Reply BulkReply StatusReply MultiBulkReply LinkedReplyFuture]))

 (set! *warn-on-reflection* true)

@@ -60,15 +60,16 @@
 (defn value [^Reply reply]
   (.getValue reply))

-
-(defn ->str
-  "Coerces reply into a String."
-  [reply]
-  (when reply
-    (condp instance? reply
-      byte-array-class (String. ^bytes reply)
-      BulkReply (let [bs (.bytes ^BulkReply reply)] (when bs (String. bs)))
-      java.lang.Object (.toString ^java.lang.Object reply))))
+(defprotocol StringCoerce
+  (->str [reply] "Coerces a reply into a String."))
+
+(extend-protocol StringCoerce
+  (Class/forName "[B")  (->str [reply] (String. ^bytes reply))
+  BulkReply (->str [reply] (let [bs (.bytes reply)] (when bs (String. bs))))
+  StatusReply (->str [reply] (->str @reply))
+  LinkedReplyFuture (->str [reply] (->str @reply))
+  Object (->str [reply] (.toString reply))
+  nil (->str [reply] nil))

 (defn ->strs [reply]
   (when reply


Inline keyword?

Inline keyword?

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -15,7 +15,7 @@
                             memfn ns or proxy proxy-super pvalues refer-clojure reify sync time
                             when when-first when-let when-not while with-bindings with-in-str
                             with-loading-context with-local-vars with-open with-out-str with-precision with-redefs
-                            satisfies? identical? true? false? number? nil? instance? symbol? str get
+                            satisfies? identical? true? false? number? nil? instance? symbol? keyword? str get
                             make-array

                             aget aset
@@ -257,6 +257,9 @@

 (defmacro symbol? [x]
   (bool-expr `(instance? Symbol ~x)))
+
+(defmacro keyword? [x]
+  (bool-expr `(instance? Keyword ~x)))

 (defmacro aget
   ([a i]
@@ -1055,7 +1058,7 @@
      (even? (count seq-exprs)) "an even number of forms in binding vector")
   (let [to-groups (fn [seq-exprs]
                     (reduce (fn [groups [k v]]
-                              (if (keyword? k)
+                              (if (core/keyword? k)
                                 (conj (pop groups) (conj (peek groups) [k v]))
                                 (conj groups [k v])))
                             [] (partition 2 seq-exprs)))
@@ -1071,7 +1074,7 @@
                                      (= k :when) `(if ~v
                                                     ~(do-mod etc)
                                                     (recur (rest ~gxs)))
-                                     (keyword? k) (err "Invalid 'for' keyword " k)
+                                     (core/keyword? k) (err "Invalid 'for' keyword " k)
                                      next-groups
                                       `(let [iterys# ~(emit-bind next-groups)
                                              fs# (seq (iterys# ~next-expr))]
@@ -1098,7 +1101,7 @@
                                                          ~(do-cmod etc)
                                                          (recur
                                                            (unchecked-inc ~gi)))
-                                          (keyword? k)
+                                          (core/keyword? k)
                                             (err "Invalid 'for' keyword " k)
                                           :else
                                             `(do (chunk-append ~gb ~body-expr)
@@ -1142,7 +1145,7 @@
                        v (second exprs)

                        seqsym (gensym "seq__")
-                       recform (if (keyword? k) recform `(recur (next ~seqsym) nil 0 0))
+                       recform (if (core/keyword? k) recform `(recur (next ~seqsym) nil 0 0))
                        steppair (step recform (nnext exprs))
                        needrec (steppair 0)
                        subform (steppair 1)]
@@ -1156,7 +1159,7 @@
                                              ~subform
                                              ~@(when needrec [recform]))
                                            ~recform)]
-                     (keyword? k) (err "Invalid 'doseq' keyword" k)
+                     (core/keyword? k) (err "Invalid 'doseq' keyword" k)
                      :else (let [chunksym (with-meta (gensym "chunk__")
                                             {:tag 'not-native})
                                  countsym (gensym "count__")


`cljs.test/function?` needs to check that it's argument is symbol first

--- src/clj/cljs/test.clj
+++ src/clj/cljs/test.clj
@@ -18,7 +18,7 @@
   "Returns true if argument is a function or a symbol that resolves to
   a function (not a macro)."
   [menv x]
-  (:fn-var (ana-api/resolve menv x)))
+  (and (symbol? x) (:fn-var (ana-api/resolve menv x))))

 (defn assert-predicate
   "Returns generic assertion code for any functional predicate.  The


Flush output before read-line

Flush output before read-line

--- src/clojars/admin.clj
+++ src/clojars/admin.clj
@@ -122,6 +122,7 @@
 (defn- confirm-and-verify-group
   [username group]
   (printf "Do you want to verify %s for %s? [y/N] " group username)
+  (flush)
   (let [res (read-line)]
     (if (= res "y")
       (do


changed search engine to yahoo

changed search engine to yahoo

--- src/complico/core.clj
+++ src/complico/core.clj
@@ -12,7 +12,7 @@
             [hiccup.core :as hiccup]))

 ; url of the external search engine to use
-(def external-search-url "http://www.bing.com/search?q=")
+(def external-search-url "http://uk.search.yahoo.com/search?p=")

 (def home-page
   (selmer/render-file "templates/index.html" {}))


Fix return type of index/assign-keys.

Fix return type of index/assign-keys.

--- src/merkle_db/index.clj
+++ src/merkle_db/index.clj
@@ -123,24 +123,24 @@
   "Assigns record keys to the children of this node which they would belong
   to. Returns a sequence of vectors containing the child index and a sequence
   of record keys, only including children which had keys assigned."
-  [split-keys record-keys]
-  (loop [results []
-         index 0
-         split-keys split-keys
-         record-keys record-keys]
-    (if (seq record-keys)
+  [index record-keys]
+  (loop [assignments []
+         children (::children index)
+         split-keys (::keys index)
+         pending-keys (sort (set record-keys))]
+    (if (seq pending-keys)
       (if (seq split-keys)
         ; Take next batch of keys.
         (let [split (first split-keys)
-              [in after] (split-with #(key/before? % split) record-keys)
-              results' (if (seq in)
-                         (conj results [index in])
-                         results)]
-          (recur results' (inc index) (next split-keys) after))
+              [in after] (split-with #(key/before? % split) pending-keys)
+              assignments' (if (seq in)
+                             (conj assignments [(first children) in])
+                             assignments)]
+          (recur assignments' (next children) (next split-keys) after))
         ; No more splits, emit one final group with remaining keys.
-        (conj results [index record-keys]))
+        (conj assignments [(first children) pending-keys]))
       ; No more record keys to assign.
-      results)))
+      assignments)))

 (defn- child-boundaries


whoops

whoops

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -124,6 +124,7 @@
               :role "button"}
              (common/icon :command)
              [:span "Shortcuts"]]
+             (om/build auth-link app {:opts {:source "start-overlay"}})
             ]])))))

 (defn team-start [app owner]


Remove dead class

Remove dead class

--- src-cljs/frontend/components/stories.cljs
+++ src-cljs/frontend/components/stories.cljs
@@ -45,7 +45,7 @@
 (defrendermethod story :shopify
   [app owner]
   (html
-    [:article.product-page.stories.shopify
+    [:article.product-page.stories
      (story-jumbotron {:logo (utils/cdn-path "/img/outer/customers/logo-shopify.svg")
                        :heading "Scalable Continuous Integration with CircleCI"
                        :subheading (list
@@ -136,7 +136,7 @@
 (defrendermethod story :wit
   [app owner]
   (html
-    [:article.product-page.stories.shopify
+    [:article.product-page.stories
      (story-jumbotron {:logo (utils/cdn-path "/img/outer/customers/customer-wit.svg")
                        :heading "Continuous Delivery for Containers"
                        :subheading "How Wit.ai uses CircleCI and Docker to deploy their containerized services"})
@@ -183,7 +183,7 @@
 (defrendermethod story :learnzillion
   [app owner]
   (html
-   [:article.product-page.stories.shopify
+   [:article.product-page.stories
     (story-jumbotron {:logo (utils/cdn-path "/img/outer/customers/customer-learnzillion.png")
                       :heading "Fast, Automated Browser Testing"
                       :subheading "How LearnZillion uses CircleCI to fully automate their QA process"})
@@ -225,7 +225,7 @@
 (defrendermethod story :sony
   [app owner]
   (html
-   [:article.product-page.stories.shopify
+   [:article.product-page.stories
     (story-jumbotron {:heading "Continuous Delivery with Golang and Docker"
                       :subheading "How Sony Japan continuously deploys microservices built with Go and Docker in minutes"})


Removing redundant code.

Removing redundant code.

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -159,10 +159,6 @@
                                   (dom/a #js {:href (get row href)} (get-in row k))
                                   (get-in row k))))))))))))))))

-(defn make-channel-pair []
-  {:in (chan (sliding-buffer 1))
-   :out (chan (sliding-buffer 1))})
-
 (defn device-detail [{:keys [selected data] :as cursor} owner]
   (om/component
    (let [row      (first (filter #(= (:id %) selected) data))]