allow partial instantiation of defintions

--- src/latte/norm.clj
+++ src/latte/norm.clj
@@ -98,17 +98,46 @@
 ;; ## Delta-reduction (unfolding of definitions)
 ;;}

-(defn delta-reduction [def-env t]
+(defn instantiate-def [params body args]
+  (loop [args args, params params, sub {}]
+    (if (seq args)
+      (if (empty? params)
+        (throw (ex-info "Not enough parameters (please report)" {:args args}))
+        (recur (rest args) (rest params) (assoc sub (ffirst params) (first args))))
+      (loop [params (reverse params), res body]
+        (if (seq params)
+          (recur (rest params) (list 'lambda (first params) res))
+          (stx/subst res sub))))))
+
+(example
+ (instantiate-def '[[x :type] [y :type] [z :type]]
+                  '[[x y] z]
+                  '((lambda [t :type] t) t1 [t2 t3]))
+ => '[[(lambda [t :type] t) t1] [t2 t3]])
+
+(example
+ (instantiate-def '[[x :type] [y :type] [z :type] [t :type]]
+                  '[[x y] [z t]]
+                  '((lambda [t :type] t) t1 [t2 t3]))
+ => '(lambda [t' :type] [[(lambda [t :type] t) t1] [[t2 t3] t']]))
+
+(example
+ (instantiate-def '[[x :type] [y :type] [z :type]]
+                  '[[x y] z]
+                  '())
+ => '(lambda [x :type] (lambda [y :type] (lambda [z :type] [[x y] z]))))
+
+ (defn delta-reduction [def-env t]
   (if (not (stx/ref? t))
     (throw (ex-info "Cannot delta-reduce: not a reference term." {:term t}))
     (let [[name & args] t]
       (if (not (get def-env name))
         (throw (ex-info "No such definition" {:term t :def-name name}))
         (let [sdef (get def-env name)]
-          (if (not= (count args) (:arity sdef))
-            (throw (ex-info "Wrong arity for definition." {:term t :def-name name :expected-arity (:arity sdef)}))
+          (if (> (count args) (:arity sdef))
+            (throw (ex-info "Too many arguments to instantiate definition." {:term t :def-name name :nb-params (count (:arity sdef)) :nb-args (count args)}))
             (if (:parsed-term sdef)
-              [(stx/subst (:parsed-term sdef) (zipmap (map first (:params sdef)) args)) true]
+              [(instantiate-def (:params sdef) (:parsed-term sdef) args) true]
               [t false])))))))

 (example
@@ -124,11 +153,15 @@
                   '(test [a b] c [t (lambda [t] t)]))
  => '[(test [a b] c [t (lambda [t] t)]) false])

+(example
+ (delta-reduction '{test {:arity 3
+                          :params [[x :type] [y :kind] [z :type]]
+                          :parsed-term [y (lambda [t :type] [x [z t]])]}}
+                  '(test [a b] c))
+ => '[(lambda [z :type] [c (lambda [t :type] [[a b] [z t]])]) true])

 (defn delta-step [def-env t]
   (cond
-    ;; reduction of a delta-redex
-    (stx/ref? t) (delta-reduction def-env t)
     ;; binder
     (stx/binder? t)
     (let [[binder [x ty] body] t]
@@ -155,7 +188,9 @@
           [args' red?] (reduce (fn [[res red?] arg]
                                  (let [[arg' red?'] (delta-step def-env arg)]
                                    [(conj res arg') (or red? red?')])) [[] false] args)]
-      [(list* def-name args') red?])
+      (if red?
+        [(list* def-name args') red?]
+        (delta-reduction def-env t)))
     ;; other cases
     :else [t false]))

@@ -172,7 +207,6 @@
 ;;{
 ;; ## Normalization (up-to beta/delta)
 ;;}
-

 (defn normalize
   ([t] (normalize {} t))


Replace Accounts buttons

Replace Accounts buttons

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -2,6 +2,7 @@
   (:require [frontend.async :refer [raise!]]
             [frontend.components.common :as common]
             [frontend.components.forms :as forms]
+            [frontend.components.pieces.button :as button]
             [frontend.components.pieces.icon :as icon]
             [frontend.components.pieces.table :as table]
             [frontend.components.project.common :as project]
@@ -94,14 +95,12 @@
               :value     heroku-api-key-input
               :on-change  #(utils/edit-input owner (conj state/user-path :heroku-api-key-input) %)}]
             [:label {:placeholder "Add new key"}]
-            (forms/managed-button
-             [:input.btn
-              {:data-loading-text "Saving...",
-               :data-failed-text  "Failed to save Heroku key",
-               :data-success-text "Saved",
-               :type "submit"
-               :value "Save Heroku key"
-               :on-click submit-form!}])]]])))))
+            (button/managed-button
+             {:loading-text "Saving..."
+              :failed-text "Failed to save key"
+              :success-text "Saved"
+              :on-click submit-form!}
+             "Save Heroku key")]]])))))

 (defn api-tokens [app owner]
   (reify
@@ -127,14 +126,12 @@
               :value     (str new-user-token)
               :on-change #(utils/edit-input owner state/new-user-token-path %)}]
             [:label {:placeholder "Token name"}]
-            (forms/managed-button
-             [:input.btn
-              {:data-loading-text "Creating...",
-               :data-failed-text  "Failed to add token",
-               :data-success-text "Created",
-               :on-click          #(create-token! new-user-token)
-               :type "submit"
-               :value "Create new token"}])]
+            (button/managed-button
+             {:loading-text "Creating..."
+              :failed-text "Failed to add token"
+              :success-text "Created"
+              :on-click #(create-token! new-user-token)}
+             "Create new token")]

           [:div.api-item
            (when (seq tokens)
@@ -163,10 +160,9 @@

 (def available-betas
-  [;; {:id "insights"
-   ;;  :name "Insights"
-   ;;  :description "Also this text. Insights is super fun for the whole family! "}
-   ])
+  [(comment {:id "insights"
+             :name "Insights"
+             :description "Also this text. Insights is super fun for the whole family! "})])

 (defn set-beta-preference! [owner betas id value]
   (raise! owner [:preferences-updated {state/user-betas-key
@@ -193,12 +189,11 @@
                     (om/build svg {:class "badge-enrolled"
                                    :src (common/icon-path "Status-Passed")}))]
                  [:p (:description program)]
-                 [:input.btn.btn-info
-                  {:on-click #(set-beta-preference! owner betas (:id program) (not participating?))
-                   :type "submit"
-                   :value (if participating?
-                            (str "Leave " (:name program) " Beta")
-                            (str "Join " (:name program) " Beta"))}]]))
+                 (button/button
+                  {:on-click #(set-beta-preference! owner betas (:id program) (not participating?))}
+                  (if participating?
+                    (str "Leave " (:name program) " Beta")
+                    (str "Join " (:name program) " Beta")))]))
             available-betas))])))))

 (defn set-beta-program-preference! [owner pref]
@@ -216,12 +211,12 @@
          features and settings before they are released publicly!"]
         [:form
          (if (not clicked-join?)
-           [:input.btn
+           (button/button
             {:on-click #(do
-                          (om/set-state! owner :clicked-join? true)
-                          ((om/get-shared owner :track-event) {:event-type :beta-join-clicked}))
-             :type "submit"
-             :value "Join Beta Program"}]
+                         (om/set-state! owner :clicked-join? true)
+                         ((om/get-shared owner :track-event) {:event-type :beta-join-clicked}))
+             :primary? true}
+            "Join Beta Program")
            [:div
             [:div.card
              [:h1 "Beta Terms"]
@@ -238,12 +233,11 @@
                     posting, but we do encourage you to talk with your
                     coworkers!"]]]
             [:p]
-            [:input.btn
-            {:on-click #(do
+            (button/button
+             {:on-click #(do
                           (set-beta-program-preference! owner true)
-                          ((om/get-shared owner :track-event) {:event-type :beta-accept-terms-clicked}))
-             :type "submit"
-             :value "Accept"}]])]]))))
+                          ((om/get-shared owner :track-event) {:event-type :beta-accept-terms-clicked}))}
+             "Accept")])]]))))

 (defn beta-program-member [app owner]
   (reify
@@ -254,13 +248,12 @@
         [:div
          [:p "Thanks for being part of the beta program.  We'll let you know when we release updates so you'll be the first to see new features!" ]
          [:p "We'd love to know what you think - " [:a {:href "mailto:beta@circleci.com"} "send us your feedback"] "!"]
-         [:form
-          [:input.btn.btn-danger
-           {:on-click #(do
-                         (set-beta-program-preference! owner false)
-                         ((om/get-shared owner :track-event) {:event-type :beta-leave-clicked}))
-            :type "submit"
-            :value "Leave Beta Program"}]]]
+         (button/button
+          {:on-click #(do
+                       (set-beta-program-preference! owner false)
+                       ((om/get-shared owner :track-event) {:event-type :beta-leave-clicked}))
+           :primary? true}
+          "Leave Beta Program")]
         (comment
           ;; uncomment to turn on beta sub programs
           [:hr]


devices-wip

devices-wip

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -442,20 +442,21 @@
       (let [{:keys [programmes projects properties devices active-components]} data
             history (om/get-shared owner :history)]
         (html
-         [:div {:id "devices-div" :class (if (:property-id devices) "" "hidden")}
-          [:h2  "Devices"]
-          [:ul {:class "breadcrumb"}
-           [:li [:a
-                 {:onClick (back-to-programmes history)}
-                 (title-for programmes)]]
-           [:li [:a
-                 {:onClick (back-to-projects history)}
-                 (title-for projects)]]
-           [:li [:a
-                 {:onClick (back-to-properties history)}
-                 (title-for properties :title-key :address-street-two)]
-            " " (when (:fetching devices) [:span {:class "glyphicon glyphicon-cloud-download spinner"}])]]
-          (om/build devices-table devices {:opts {:histkey :devices}})])))))
+         [:div {:id "devices-div"}
+          [:div {:class (if (:property-id devices) "" "hidden")}
+           [:h2  "Devices"]
+           [:ul {:class "breadcrumb"}
+            [:li [:a
+                  {:onClick (back-to-programmes history)}
+                  (title-for programmes)]]
+            [:li [:a
+                  {:onClick (back-to-projects history)}
+                  (title-for projects)]]
+            [:li [:a
+                  {:onClick (back-to-properties history)}
+                  (title-for properties :title-key :address-street-two)]
+             " " (when (:fetching devices) [:span {:class "glyphicon glyphicon-cloud-download spinner"}])]]
+           (om/build devices-table devices {:opts {:histkey :devices}})]])))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; sensors


Add the record id to the catalog view

Add the record id to the catalog view

--- src/mdr2/views.clj
+++ src/mdr2/views.clj
@@ -149,9 +149,13 @@
      (when error
        [:p [:ul.alert.alert-danger [:li error]]])
      [:table.table.table-striped
-      [:thead [:tr [:th "Title"] [:th "Author"] [:th "Product Number"] [:th "Library Number"] [:th "Total time"] [:th "Number of CDs"] [:th "Depth"] [:th "Narrator"] [:th "Date of Production"] [:th "Libary signature"]]]
+      [:thead [:tr [:th "Title"] [:th "Author"] [:th "Product Number"]
+               [:th "Library Number"] [:th "Record id"] [:th "Total time"]
+               [:th "Number of CDs"] [:th "Depth"] [:th "Narrator"]
+               [:th "Date of Production"] [:th "Libary signature"]]]
       [:tbody
-       (for [{:keys [id title creator product_number library_number
+       (for [{:keys [id title creator product_number
+                     library_number library_record_id
                      total_time volumes depth narrator produced_date]}
              (prod/find-by-state "encoded")]
          [:tr
@@ -159,6 +163,7 @@
           [:td creator]
           [:td product_number]
           [:td library_number]
+          [:td library_record_id]
           [:td (quot total_time (* 1000 60))] ; in minutes
           [:td volumes]
           [:td depth]


[#3123] Fix property name

[#3123] Fix property name

--- backend/src/akvo/lumen/lib/transformation/engine.clj
+++ backend/src/akvo/lumen/lib/transformation/engine.clj
@@ -179,7 +179,7 @@
    {:keys [transformation data-groups data-group dataset-id main-op]}]
   (let [data-group (or data-group (data-group-by-op transformation data-groups))
         source-table (:table-name data-group)
-        other-dgs-columns (reduce (fn [c dg] (if (= (:id dg) (:id data-group))
+        other-dgs-columns (reduce (fn [c dg] (if (= (:group-id dg) (:group-id data-group))
                                                c (into c (:columns dg)))) [] data-groups)
         previous-columns (into (vec (:columns data-group)) other-dgs-columns)
         {:keys [success? message execution-log error-data data-groups-to-be-created] :as res}


lein-release plugin: bumped version from 0.4.7 to 0.4.8-SNAPSHOT for next development cycle

--- re_view/project.clj
+++ re_view/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view "0.4.7"
+(defproject re-view "0.4.8-SNAPSHOT"
   :description "ClojureScript React Library"
   :url "https://www.github.com/braintripping/re-view/tree/master/re_view"
   :license {:name "Eclipse Public License"


entering non pig latin for choice 2 throws error, still not idiomatic clojure

--- tech-int/src/tech_int/core.clj
+++ tech-int/src/tech_int/core.clj
@@ -73,13 +73,14 @@

 (defn checkIfPigLatin
     [array]
-    (loop [array array
-           i 0]
-        (if (< i (count array))
-            (ends-with? (array i) "ay")
-            (recur array (inc i))
-        )
-    )
+    ; (loop [array array
+    ;        i 0]
+    ;     (if (< i (count array))
+    ;         (ends-with? (array i) "ay")
+    ;         (recur array (inc i))
+    ;     )
+    ; )
+    (every? true? (ends-with? array "ay"))

 )


fix to work with cake/face branch

fix to work with cake/face branch

--- tasks.clj
+++ tasks.clj
@@ -1,9 +1,9 @@
 (ns user
   (:use [cake.core :only [deftask remove-dep!]]
         [cake.file :only [file rm rmdir]]
-        [cake.project :only [log]]
+        [bake.core :only [log]]
         [cake.ant :only [ant args env add-zipfileset]]
-        [cake.tasks.deps :only [os-name os-arch]])
+        [cake.utils :only [os-name os-arch]])
   (:import [org.apache.tools.ant.taskdefs Copy ExecTask Replace]))

 (def tokyocabinet      "tokyocabinet-1.4.45")


need to use a mult from the start

need to use a mult from the start

--- src/pc/datomic.clj
+++ src/pc/datomic.clj
@@ -97,6 +97,7 @@
   (datomic-error? ex :db.error/cas-failed))

 (defonce tx-report-ch (async/chan (async/sliding-buffer 1024)))
+(defonce tx-report-mult (async/mult tx-report-ch))

 (defn setup-tx-report-ch [conn]
   (let [queue (d/tx-report-queue conn)]


Disable usage queue, ssh info and artifacts for non-logged in viewers of builds.

--- frontend/components/build_head.cljs
+++ frontend/components/build_head.cljs
@@ -223,7 +223,8 @@
             run-queued? (build-model/in-run-queue? build)
             usage-queued? (build-model/in-usage-queue? build)
             plan (get-in data [:project-data :plan])
-            user (:user data)]
+            user (:user data)
+            logged-in? (not (empty user))]
         (html
          [:div.build-head-wrapper
           [:div.build-head
@@ -347,15 +348,15 @@
                                                                         :build-num build-num}])}
                   "Cancel"]))]]
             [:div.no-user-actions]]
-           (when (:show-usage-queue usage-queue-data)
+           (when (and logged-in? (:show-usage-queue usage-queue-data))
              (om/build build-queue {:build build
                                     :builds (:builds usage-queue-data)
                                     :plan plan}))
            (when (:subject build)
              (om/build build-commits build-data))
-           (when (build-model/ssh-enabled-now? build)
+           (when (and logged-in? (build-model/ssh-enabled-now? build))
              (om/build build-ssh (:node build)))
-           (when (:has_artifacts build)
+           (when (and logged-in? (:has_artifacts build))
              (om/build build-artifacts-list
                        {:artifacts-data (get build-data :artifacts-data) :user user}
                        {:opts {:show-node-indices? (< 1 (:parallel build))}}))]])))))


stricter checks, cleanup

stricter checks, cleanup

--- test/clojento/magento/t_db.clj
+++ test/clojento/magento/t_db.clj
@@ -98,17 +98,23 @@
             (first (run-query (:db @system) :product-entities [ 1 ])) => (just {:id 1 :sku "sku-1" :type "simple" :attribute-set 4 :date-created anything :date-updated anything})
             (first (run-query (:db @system) :product-entities [[1]])) => (just {:id 1 :sku "sku-1" :type "simple" :attribute-set 4 :date-created anything :date-updated anything}))
       (fact "get multiple products"
-            (run-query (:db @system) :product-entities [[1 2]])   => (just [(contains {:id 1}) (contains {:id 2})] :in-any-order)
-            (run-query (:db @system) :product-entities [[3 2 1]]) => (just [(contains {:id 1}) (contains {:id 2}) (contains {:id 3})] :in-any-order)))
+            (run-query (:db @system) :product-entities [[1 2]])   => (just [(contains {:id 1})
+                                                                            (contains {:id 2})] :in-any-order)
+            (run-query (:db @system) :product-entities [[3 2 1]]) => (just [(contains {:id 1})
+                                                                            (contains {:id 2})
+                                                                            (contains {:id 3})] :in-any-order)))

     (facts "query :product-websites"
       (fact "get missing product(s)"
             (run-query (:db @system) :product-websites [-1]) => []
             (run-query (:db @system) :product-websites [[-1 -2]]) => [])
       (fact "get product with id 1"
-            (run-query (:db @system) :product-websites [ 1 ]) => (contains {:id 1 :website-id 1} {:id 1 :website-id 2}))
+            (run-query (:db @system) :product-websites [ 1 ]) => (just [{:id 1 :website-id 1}
+                                                                        {:id 1 :website-id 2}] :in-any-order))
       (fact "get multiple products"
-            (run-query (:db @system) :product-websites [[1 2]])   => (contains {:id 1 :website-id 1} {:id 1 :website-id 2} {:id 2 :website-id 1})
+            (run-query (:db @system) :product-websites [[1 2]])   => (just [{:id 1 :website-id 1}
+                                                                            {:id 1 :website-id 2}
+                                                                            {:id 2 :website-id 1}] :in-any-order)
             (count (run-query (:db @system) :product-websites [[3 2 1]])) => 4))

     (facts "query :product-stock"


tabular validation testing now uses causes-validation-error

--- test/midje/ideas/t_tabular.clj
+++ test/midje/ideas/t_tabular.clj
@@ -93,13 +93,20 @@
  ;; Error handling

-(after-silently
- (tabular
-  (fact "A misparenthesization that results in no table is noticed."
-    (tabular-forms '?forms) => '?expected
-    ?forms                       ?expect
-    [ fact table ]               [fact table]))
- (fact @reported => (one-of a-user-error)))
+(causes-validation-error #"There's no table\. \(Misparenthesized form\?\)"
+  (tabular "A misparenthesization that results in no table is noticed."
+    (fact
+      (tabular-forms '?forms) => '?expected
+      ?forms                       ?expect
+      [ fact table ]               [fact table])))
+
+(causes-validation-error #"There's no table\. \(Misparenthesized form\?\)"
+  (tabular
+    (fact nil => nil)))
+
+(causes-validation-error #"There's no table\. \(Misparenthesized form\?\)"
+  (tabular "doc string present"
+    (fact nil => nil)))

  ;; Other tests via midje.sweet API


AB & JC | #166 | Removed 11 o'clock

AB & JC | #166 | Removed 11 o'clock

--- test/mooncake/test/handler.clj
+++ test/mooncake/test/handler.clj
@@ -9,7 +9,6 @@

 (def ten-oclock "2015-01-01T10:00:00.000Z")
-(def eleven-oclock "2015-01-01T11:00:00.000Z")
 (def twelve-oclock "2015-01-01T12:00:00.000Z")

 (facts "about site-handlers"


refine update process

refine update process

--- src/clj/clj_money/models/transactions.clj
+++ src/clj/clj_money/models/transactions.clj
@@ -280,15 +280,15 @@
                                     :transaction-date transaction-date}
                                    {:limit 1})))

-; TODO delete
 (defn- upsert-item
   "Updates the specified transaction item"
   [storage {:keys [id transaction-date] :as item}]
-  (if (:id item)
-    (do
-      (update-transaction-item storage item)
-      (find-item-by-id storage id transaction-date))
-    (create-transaction-item storage item)))
+  (let [to-save (before-save-item item)]
+    (if (:id to-save)
+      (do
+        (update-transaction-item storage to-save)
+        (find-item-by-id storage id transaction-date))
+      (create-transaction-item storage to-save))))

 (defn- update-item-index-and-balance
   "Updates only the index and balance attributes of an item, returning true if
@@ -489,6 +489,7 @@
   ([storage-spec criteria options]
    (first (search-items storage-spec criteria options))))

+; TODO delete
 (defn- recalculate-account-item
   "Accepts a processing context and an item, updates
   the items :index and :balance attributes, and returns
@@ -778,7 +779,6 @@
   (doseq [item (:items transaction)]
     (as-> item i
       (assoc i :transaction-id (:id transaction))
-      (before-save-item i)
       (upsert-item storage i))))

 (defn- find-base-item
@@ -796,6 +796,26 @@
                      [:index :desc]]
               :limit 1}))

+(defn- process-items
+  "Recalculates and updates statistics in the specifed items"
+  [storage account {:keys [index balance] :or {index -1 balance 0M}} items]
+  (loop [item (first items)
+         remaining (rest items)
+         last-index index
+         last-balance balance]
+    (let [new-index (+ last-index 1)
+          new-balance (+ last-balance (polarize-quantity item account))]
+      (upsert-item storage (assoc item
+                                  :balance new-balance
+                                  :index new-index))
+      ; TODO if the item does not require updating, exit the loop and return nil
+      (if (seq remaining)
+        (recur (first remaining)
+               (rest remaining)
+               new-index
+               new-balance)
+        [new-index new-balance]))))
+
 (defn- recalculate-account
   "Recalculates statistics for items in the the specified account
   as of the specified date"
@@ -803,10 +823,13 @@
   (let [base-item (find-base-item storage account-id as-of)
         items (search-items storage
                             {:account-id account-id
-                                     :transaction-date [:>= as-of]}
-                            {:sort [:transaction-date :index]})]
-    (pprint {:base-item base-item
-             :items items})))
+                             :transaction-date [:>= as-of]}
+                            {:sort [:transaction-date :index]})
+        account (accounts/find-by-id storage account-id)
+        [last-index
+         balance] (process-items storage account base-item items)]
+    ; TODO only update account if balance is not nil
+    (accounts/update storage (assoc account :quantity balance))))

 ; Processing a transaction
 ; 1. Save the transaction and item records
@@ -831,20 +854,28 @@
       (if (validation/has-error? validated)
         validated
         (do
-        (let [existing (find-existing-transaction storage transaction)
-              dereferenced-items (->> (:items existing)
-                                     (remove #(some (fn [i] (= (:id i)
-                                                               (:id %)))
-                                                    (:items validated))))
-              recalc-base-date (earlier (:transaction-date existing)
-                                        (:transaction-date validated))
-              recalc-account-ids (->> (:items validated)
-                                   (concat dereferenced-items)
-                                   (map :account-id)
-                                   (into #{}))]
-              (update-full-transaction storage validated)
-              (doseq [account-id recalc-account-ids]
-                (recalculate-account storage account-id recalc-base-date))))))))
+          (let [existing (find-existing-transaction storage transaction)
+                dereferenced-items (->> (:items existing)
+                                        (remove #(some (fn [i] (= (:id i)
+                                                                  (:id %)))
+                                                       (:items validated))))
+                dereferenced-account-ids (difference (->> (:items existing)
+                                                          (map :account-id)
+                                                          (into #{}))
+                                                     (->> (:items validated)
+                                                          (map :account-id)
+                                                          (into #{})))
+                recalc-base-date (earlier (:transaction-date existing)
+                                          (:transaction-date validated))
+                recalc-account-ids (->> (:items validated)
+                                        (map :account-id)
+                                        (concat dereferenced-account-ids)
+                                        (into #{}))]
+            (update-full-transaction storage validated)
+            (doseq [item dereferenced-items]
+              (delete-transaction-item storage (:id item) (:transaction-date existing)))
+            (doseq [account-id recalc-account-ids]
+              (recalculate-account storage account-id recalc-base-date))))))))

 (defn- get-preceding-items
   "Returns the items that precede each item in the


endorsement modal

endorsement modal

--- src/cljs/salava/badge/ui/endorsement.cljs
+++ src/cljs/salava/badge/ui/endorsement.cljs
@@ -7,7 +7,10 @@
             [salava.core.ui.modal :as mo]
             [clojure.string :refer [blank?]]
             [reagent.session :as session]
-            [salava.user.ui.helper :refer [profile-picture]]))
+            [salava.user.ui.helper :refer [profile-picture]]
+            [reagent-modals.modals :as m]
+            [salava.core.ui.layout :as layout]
+            [salava.core.ui.error :as err]))

 (defn endorsement-row [endorsement]
@@ -39,7 +42,17 @@
               (for [endorsement @endorsements]
                 (endorsement-row endorsement)))]])))

-;; User Endorsements
+;; User Badge Endorsements
+
+(defn init-user-endorsements [state]
+  (ajax/GET
+    (path-for (str "/obpv1/badge/user/endorsements"))
+    {:handler (fn [data]
+                (reset! state (assoc data
+                                :initializing false
+                                :permission "success"))
+                )}
+    (fn [] (swap! state assoc :permission "error"))))

 (defn init-user-badge-endorsement [state]
   (ajax/GET
@@ -57,9 +70,17 @@
     (path-for "/obpv1/badge/user/pending_endorsement/")
     {:handler (fn [data]
                 (swap! state assoc :pending data)
-                )}
-    )
-  )
+                )}))
+
+(defn edit-endorsement [id badge-id content]
+  (ajax/POST
+    (path-for (str "/obpv1/badge/endorsement/edit/" id))
+    {:params {:content content
+              :user_badge_id badge-id}
+     :handler (fn [data]
+                (when (= "success" (:status data))
+                  (prn data)
+                  ))}))

 (defn save-endorsement [state]
   (ajax/POST
@@ -81,12 +102,12 @@
                 (when (= "success" (:status data))
                   (reload-fn state)))}))

-(defn delete-endorsement [id user_badge_id state]
+(defn delete-endorsement [id user_badge_id state reload-fn]
   (ajax/DELETE
     (path-for (str "/obpv1/badge/endorsement/" user_badge_id "/" id))
     {:handler (fn [data]
                 (when (= "success" (:status data))
-                  (init-user-badge-endorsement state)))}))
+                  (when reload-fn (reload-fn state))))}))

 (defn process-text [s state]
@@ -135,15 +156,19 @@
      [:div.form-group
       [:label {:for "claim"} (t :badge/Composeyourendorsement)  ]
       [:textarea.form-control {:id "claim"
-                               :rows "5"
-                               :cols "60"
+                               :rows "10"
+                               :cols "50"
                                :max-length "1500"
                                :type "text"
                                :value @(cursor state [:endorsement-comment])
                                :on-change #(do
                                              (reset! (cursor state [:endorsement-comment]) (.-target.value %))
                                              )
-                               #_:on-key-down #_(if (= (.-which %) 13)
+                               :on-key-down #(when (= (.-which %) 13)
+                                               (prn (clojure.string/split-lines @(cursor state [:endorsement-comment])))
+                                               ;(process-text "test" state)
+                                               ;(reset! (cursor state [:endorsement-comment]) (str (.-target.value %) "\n\n* ") )
+                                               ;(prn @(cursor state [:endorsement-comment]))
                                                #_(add-tag tags-atom new-tag-atom))}]]
      [:div
       [:button.btn.btn-primary {:on-click #(do
@@ -238,7 +263,6 @@
 (defn endorsement-list [badge-id]
   (let [state (atom {:id badge-id})]
     (init-user-badge-endorsement state)
-
     (fn []
       (when (seq @(cursor state [:user-badge-endorsements]))
         [:div
@@ -267,7 +291,7 @@
                                                 :aria-label "OK"
                                                 :class "close"
                                                 :on-click #(do (.preventDefault %)
-                                                             (delete-endorsement id user_badge_id state))
+                                                             (delete-endorsement id user_badge_id state init-user-badge-endorsement))
                                                 }
                                        [:i.fa.fa-trash.trash]]]]
                                [:div.panel-body
@@ -290,6 +314,305 @@

                     ) [:div] @(cursor state [:user-badge-endorsements]))]]))))

+(defn profile [element-data]
+  (let [{:keys [id first_name last_name profile_picture status header]} element-data
+        current-user (session/get-in [:user :id])]
+    [:div.endorsement-profile.panel.panel-default
+     [:a {:href "#" :on-click #(mo/open-modal [:user :profile] {:user-id id})}
+      [:div.panel-body
+       [:div.header [:span.label.label-default.text-center header]]
+       [:div.col-md-4
+        [:div.profile-image
+         [:img.img-responsive.img-thumbnail
+          {:src (profile-picture profile_picture)
+           :alt (str first_name " " last_name)}]]]
+       [:div.col-md-8
+        [:h4 (str first_name " " last_name)]
+        (when (= status "pending") [:p [:span.label.label-info (t :social/Pending)]])]]]]))
+
+(defn user-endorsement-content [params]
+  (fn []
+    (let [{:keys [endorsement state]} @params
+          {:keys [id profile_picture name first_name last_name image_file content user_badge_id endorser_id endorsee_id status]} endorsement]
+      [:div.row {:id "badge-info"}
+       [:div.col-md-3
+        [:div.badge-image [:img.badge-image {:src (str "/" image_file)}]]]
+       [:div.col-md-9.badge-info
+        [:div
+         [:h1.uppercase-header name]
+
+         [:div.pull-right.delete-btn
+          [:a {:on-click #(do
+                            (.preventDefault %)
+                            (delete-endorsement id user_badge_id nil nil)
+                            )
+               :data-dismiss "modal"} [:i.fa.fa-trash] (t :badge/Delete)]
+          ]
+
+         [:div (t :badge/Manageendorsementtext)]
+
+         [profile {:id (or endorsee_id endorser_id) :profile_picture profile_picture :first_name first_name :last_name last_name :status status :header (if endorsee_id (t :badge/YouEndorsed) (t :badge/Endorsedyou))}]
+         [:hr]
+         (if endorsee_id
+           [:div
+            [:div.form-group
+             [:label {:for "claim"} (t :badge/Composeyourendorsement)]
+             [:textarea.form-control {:id "claim"
+                                      :rows "10"
+                                      :cols "50"
+                                      :max-length "1500"
+                                      :type "text"
+                                      :value @(cursor params [:endorsement :content])
+                                      :on-change #(do
+                                                    (reset! (cursor params [:endorsement :content]) (.-target.value %))
+                                                    )}]]
+            [:div
+             [:button.btn.btn-primary {:on-click #(do
+                                                    (.preventDefault %)
+                                                    (edit-endorsement id user_badge_id @(cursor params [:endorsement :content]))
+                                                    ;;save endorsement
+                                                    )
+                                       :disabled (blank? @(cursor params [:endorsement :content]))
+                                       :data-dismiss "modal"
+
+                                       } (t :core/Save)]]]
+
+           [:div
+            [:div
+             [:div {:dangerouslySetInnerHTML {:__html content}}]
+             (when (= "pending" status)
+               [:div.caption
+                [:hr]
+                [:div.text-center
+                 [:ul.list-inline.buttons.buttons
+                  [:a.button {:href "#"
+                              :on-click #(do
+                                           (.preventDefault %)
+                                           (update-status id "accepted" user_badge_id state init-user-badge-endorsement)
+                                           )} [:li [:i.fa.fa-check] ]]
+                  [:a.button {:href "#"
+                              :on-click #(do
+                                           (.preventDefault %)
+                                           (update-status id "declined" user_badge_id state init-user-badge-endorsement))}[:li.cancel [:i.fa.fa-remove]]]]]])
+             ]
+
+
+            ])]]])))
+
+
+
+(defn endorsements [state]
+  (let [endorsements (->> (list* @(cursor state [:received]) @(cursor state [:given]))
+                          flatten
+                          (sort-by :mtime >))]
+    [:div.panel
+     [:div.panel-heading
+      [:h3
+       (str (t :badge/Endorsements) ;" (" (count endorsements) ")"
+            ) [:span.badge (count endorsements)]]]
+     [:div.panel-body
+      [:table.table  {:summary (t :badge/Endorsements)}
+       (reduce (fn [r endorsement]
+                 (let [{:keys [id endorsee_id endorser_id profile_picture first_name last_name name image_file content status user_badge_id mtime]} endorsement
+                       endorser (str first_name " " last_name)]
+                   (conj r [:div.list-item
+                            [:a {:href "#" :on-click #(do
+                                                        (.preventDefault %)
+                                                        (mo/open-modal [:badge :user-endorsement] (atom {:endorsement endorsement :state state}) {:hidden (fn [] (init-user-endorsements state))} ))}
+                             [:div.col-md-12 [:small.pull-right [:i (date-from-unix-time (* 1000 mtime) "days")]]]
+                             [:div.row
+                              [:div.labels [:span.label.label-default (if endorser_id
+                                                                        (t :badge/Endorsedyou)
+                                                                        (t :badge/YouEndorsed))]
+                               [:span.label {:class (case status
+                                                      "pending" "label-info"
+                                                      "accepted" "label-success"
+                                                      nil)}
+                                (case status
+                                  "pending" (t :badge/Pending)
+                                  "accepted" (t :badge/Accepted)
+                                  nil)
+                                ]]
+                              ]
+                             [:div.media
+                              [:div.media-left.media-top.list-item-body
+                               [:img.profile-pic.media-object {:src (profile-picture profile_picture)}]
+                               ]
+                              [:div.media-body
+                               [:h4.media-heading  endorser]
+                               [:div.media
+                                [:div.media-left.media-middle
+                                 [:img.media-object.badge-img {:src (str "/" image_file)}]]
+                                [:div.media-body
+                                 [:p.badge-name name]
+                                 ]]]
+                              ]]]))) [:div] endorsements)]]]))
+
+(defn received-endorsements [state]
+  (let [endorsements @(cursor state [:received])]
+    [:div.panel
+     [:div.panel-heading
+      [:h3
+       (str (t :badge/Receivedendorsements) " (" (count endorsements) ")")]]
+     [:div.panel-body
+      [:table.table  {:summary (t :badge/Receivedendorsements)}
+       (reduce (fn [r endorsement]
+                 (let [{:keys [id endorser_id profile_picture first_name last_name name image_file content status user_badge_id mtime]} endorsement
+                       endorser (str first_name " " last_name)]
+                   (conj r [:div.list-item
+                            [:div.col-md-12 [:small.pull-right [:i (date-from-unix-time (* 1000 mtime) "days")]]]
+                            [:div [:span.label.label-info.table-cell (t :badge/Endorsedyou)]
+                             [:span.label.table-cell {:class (case status
+                                                               "pending" "label-info"
+                                                               "accepted" "label-success"
+                                                               nil)}
+                              (case status
+                                "pending" (t :badge/Pending)
+                                "accepted" (t :badge/Accepted))
+                              ]]
+                            [:div.media
+                             [:div.media-left.media-middle
+                              [:img.profile-pic.media-object {:src (profile-picture profile_picture)}]
+                              ]
+                             [:div.media-body
+
+                              [:h4.media-heading  endorser #_[:small.pull-right [:i (date-from-unix-time (* 1000 mtime) "days")]]]
+                              ;[:span.label.label-info (t :badge/Endorsedyou)]
+                              [:div.media
+                               [:div.media-left.media-middle
+                                [:img.media-object.badge-img {:src (str "/" image_file)}]]
+                               [:div.media-body
+                                [:p.media-heading.badge-name name]
+                                #_[:span.label.label-info (t :badge/Endorsedyou)]
+                                #_[:span.label {:class (case status
+                                                         "pending" "label-info"
+                                                         "accepted" "label-success"
+                                                         nil)}
+                                   (case status
+                                     "pending" (t :badge/Pending)
+                                     "accepted" (t :badge/Accepted))
+                                   ]]]]
+                             ]]))) [:div] endorsements)]]]))
+
+(defn given-endorsements [state]
+  (let [endorsements @(cursor state [:given])]
+    [:div.panel
+     [:div.panel-heading
+      [:h3
+       (str (t :badge/Givenendorsements) " (" (count endorsements) ")")]]
+     [:div.panel-body
+      [:table.table  {:summary (t :badge/Givenendorsements)}
+       (reduce (fn [r endorsement]
+                 (let [{:keys [id endorsee_id profile_picture first_name last_name name image_file content status user_badge_id mtime]} endorsement
+                       endorser (str first_name " " last_name)]
+                   (conj r [:div.list-item
+                            [:div.col-md-12 [:small.pull-right [:i (date-from-unix-time (* 1000 mtime) "days")]]]
+                            [:div.row
+                             ;[:div.col-md-3 [:small.pull-right [:i (date-from-unix-time (* 1000 mtime) "days")]]]
+                             [:div [:span.label.label-info.table-cell (t :badge/YouEndorsed)]
+                              [:span.label.table-cell {:class (case status
+                                                                "pending" "label-info"
+                                                                "accepted" "label-success"
+                                                                nil)}
+                               (case status
+                                 "pending" (t :badge/Pending)
+                                 "accepted" (t :badge/Accepted))
+                               ]]
+                             ]
+                            [:div.media
+                             [:div.media-left.media-top
+                              [:img.profile-pic.media-object {:src (profile-picture profile_picture)}]
+                              ]
+                             [:div.media-body.list-item-body
+                              ;[:span.label.label-info (t :badge/YouEndorsed)]
+
+                              [:h4.media-heading  endorser #_[:small.pull-right ]]
+
+                              [:div.media
+                               [:div.media-left.media-middle
+                                [:img.media-object.badge-img {:src (str "/" image_file)}]]
+                               [:div.media-body
+                                [:p.badge-name name]
+                                ]]]
+                             ]]))) [:div] endorsements)]]]))
+
+(defn user-endorsements-content [state]
+  [:div
+   [m/modal-window]
+   [:div#badge-stats
+
+    (if (or (seq @(cursor state [:received]) ) (seq @(cursor state [:given]))) (endorsements state) [:div (t :badge/Youhavenoendorsements)])
+    ;(when (seq @(cursor state [:received]))(received-endorsements state))
+    ;(when (seq @(cursor state [:given]))(given-endorsements state))
+
+    ]])
+
 (defn request-endorsement [])

+(defn handler [site-navi]
+  (let [state (atom {:initializing true
+                     :permission "initial"})
+        user (session/get :user)]
+    (init-user-endorsements state)
+    (fn []
+      (cond
+        (= "initial" (:permission @state)) [:div]
+        (and user (= "error" (:permission @state))) (layout/default-no-sidebar site-navi (err/error-content))
+        (= "error" (:permission @state)) (layout/landing-page site-navi (err/error-content))
+        :else (layout/default site-navi (user-endorsements-content state)))
+      )
+    )
+  )
+
+;;;;;;
+;;     [:div#endorsebadge
+;;      (reduce (fn [r endorsement]
+;;                (let [{:keys [id endorsee_id profile_picture first_name last_name name image_file content status user_badge_id]} endorsement
+;;                      endorser (str first_name " " last_name)]
+;;                  (conj r
+
+;;                        #_[:div.col-xs-12.col-sm-6.col-md-4
+;;                           [:div.thumbnail
+;;                            [:div.endorser
+;;                             [:div.row [:span.pull-right.label {:class (case status
+;;                                                                         "pending" "label-info"
+;;                                                                         "accepted" "label-success"
+;;                                                                         nil)}
+;;                                        (case status
+;;                                          "pending" (t :badge/pending)
+;;                                          "accepted" (t :badge/accepted))
+;;                                        ]]
+;;                             [:div [:a {:href "#"
+;;                                        :on-click #(mo/open-modal [:user :profile] {:user-id endorsee_id})}
+;;                                    [:img {:src (profile-picture profile_picture)}]
+;;                                    (str first_name " " last_name " ")]
+;;                              ]
+
+;;                             #_[profile-link-inline endorsee_id first_name last_name profile_picture id]
+;;                             [:hr.border]
+;;                             ]
+;;                            [:div.caption
+;;                             [:div.position-relative.text-center.row
+;;                              [:img{:src (str "/" image_file)}]]
+
+;;                             [:div
+;;                              [:p.heading.text-center name]
+;;                              [:div.thumbnail-description.smaller {:dangerouslySetInnerHTML {:__html content}}]]
+;;                             ]
+
+;;                            (when (= "pending" status)
+;;                              [:div.caption.card-footer.text-center
+;;                               [:hr]
+;;                               [:ul.list-inline.buttons
+;;                                [:a.button {:href "#"
+;;                                            :on-click #(do
+;;                                                         (.preventDefault %)
+;;                                                         (update-status id "accepted" user_badge_id state init-pending-endorsements)
+;;                                                         )} [:li [:i.fa.fa-check] ]]
+;;                                [:a.button {:href "#"
+;;                                            :on-click #(do
+;;                                                         (.preventDefault %)
+;;                                                         (update-status id "declined" user_badge_id state init-pending-endorsements))}[:li.cancel [:i.fa.fa-remove]]]]])]
+;;                           ]))) [:div.panel]
+;;              endorsements)]


(PE-3590) Call kitchensink cn-for-dn to get CN from cert DN

This commit changes the `get-cert-common-name` function to use the
`cn-for-dn` function in clj-kitchensink to get the common name from the
certificate's distinguished name, as opposed to reimplementing the same
logic locally.

This commit also removes the warning that previously would have been
logged in the event that a client certificate was not provided in a
request routed to JRuby.

--- src/clj/puppetlabs/master/services/handler/request_handler_core.clj
+++ src/clj/puppetlabs/master/services/handler/request_handler_core.clj
@@ -2,11 +2,11 @@
   (:import (com.puppetlabs.master JRubyPuppet
                                   JRubyPuppetResponse)
            (java.security.cert X509Certificate)
-           (java.util HashMap)
-           (javax.naming.ldap LdapName))
+           (java.util HashMap))
   (:require [clojure.tools.logging :as log]
             [clojure.string :as string]
-            [clojure.walk :as walk]))
+            [clojure.walk :as walk]
+            [puppetlabs.kitchensink.core :as ks]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Internal
@@ -16,15 +16,11 @@
   [request]
   (if-let [cert (:ssl-client-cert request)]
     (if-let [cert-dn (-> cert .getSubjectX500Principal .getName)]
-      (if-let [cert-cn (some #(when (.equalsIgnoreCase "CN"
-                                                       (.getType %))
-                                (.getValue %))
-                             (-> cert-dn (LdapName.) .getRdns))]
+      (if-let [cert-cn (ks/cn-for-dn cert-dn)]
         cert-cn
         (log/errorf "cn not found in client certificate dn: %s"
                    cert-dn))
-      (log/error "dn not found for client certificate subject"))
-    (log/warn "No client certificate found")))
+      (log/error "dn not found for client certificate subject"))))

 (defn response->map
   "Converts a JRubyPuppetResponse instance to a map."


Putting osx/linux tabs around add-project repo list.

--- src-cljs/frontend/components/add_projects.cljs
+++ src-cljs/frontend/components/add_projects.cljs
@@ -268,39 +268,51 @@
                  :on-change #(utils/toggle-input owner [:settings :add-projects :show-forks] %)}]
         "Show forks"]]])))

-(defn repo-lists [{:keys [user repos selected-org settings] :as data} owner]
+(defn repo-lists [{:keys [user repos selected-org settings osx-enabled?] :as data} owner]
   (reify
+    om/IInitState
+    (init-state [_]
+      {:selected-tab :linux})
+
     om/IRenderState
-    (render-state [_ _]
+    (render-state [_ {:keys [selected-tab]}]
       (let [selected-org-login (:login selected-org)
             loading-repos? (get-in user [:repos-loading (keyword (:vcs-type selected-org))])
             repo-filter-string (get-in settings [:add-projects :repo-filter-string])
             show-forks (true? (get-in settings [:add-projects :show-forks]))]
         (html
           [:div.proj-wrapper
-           (if selected-org-login
-             (let [;; we display a repo if it belongs to this org, matches the filter string,
-                   ;; and matches the fork settings.
-                   display? (fn [repo]
-                              (and
-                                (or show-forks (not (:fork repo)))
-                                (select-vcs-type (or (:vcs-type selected-org)
-                                                     "github") repo)
-                                (= (:username repo) selected-org-login)
-                                (gstring/caseInsensitiveContains (:name repo) repo-filter-string)))
-                   filtered-repos (->> repos (filter display?) (sort-by :pushed_at) (reverse))]
-               [:div (om/build repo-filter settings)
-                (if (empty? filtered-repos)
-                  (if loading-repos?
-                    [:div.loading-spinner common/spinner]
-                    [:div.add-repos
-                     (if repo-filter-string
-                       (str "No matching repos for organization " selected-org-login)
-                       (str "No repos found for organization " selected-org-login))])
-                  [:ul.proj-list.list-unstyled
-                   (for [repo filtered-repos]
-                     (om/build repo-item {:repo repo :settings settings}))])])
-             repos-explanation)])))))
+           [:div.tabbed-wrapper
+            [:ul.nav.nav-tabs
+             [:li {:class (when (= selected-tab :linux) "active")}
+              [:a {:on-click #(om/set-state! owner [:selected-tab] :linux)}
+               [:i.fa.fa-linux.fa-lg] "Linux"]]
+             [:li {:class (when (= selected-tab :osx) "active")}
+              [:a {:on-click #(om/set-state! owner [:selected-tab] :osx)}
+               [:i.fa.fa-apple.fa-lg] " iOS"]]]
+            (if selected-org-login
+              (let [;; we display a repo if it belongs to this org, matches the filter string,
+                    ;; and matches the fork settings.
+                    display? (fn [repo]
+                               (and
+                                 (or show-forks (not (:fork repo)))
+                                 (select-vcs-type (or (:vcs-type selected-org)
+                                                      "github") repo)
+                                 (= (:username repo) selected-org-login)
+                                 (gstring/caseInsensitiveContains (:name repo) repo-filter-string)))
+                    filtered-repos (->> repos (filter display?) (sort-by :pushed_at) (reverse))]
+                [:div (om/build repo-filter settings)
+                 (if (empty? filtered-repos)
+                   (if loading-repos?
+                     [:div.loading-spinner common/spinner]
+                     [:div.add-repos
+                      (if repo-filter-string
+                        (str "No matching repos for organization " selected-org-login)
+                        (str "No repos found for organization " selected-org-login))])
+                   [:ul.proj-list.list-unstyled
+                    (for [repo filtered-repos]
+                      (om/build repo-item {:repo repo :settings settings}))])])
+              repos-explanation)]])))))

 (defn inaccessible-follows
   "Any repo we follow where the org isn't in our set of orgs is either: an org
@@ -496,9 +508,9 @@
         [:span.big-number "2"]
         [:div.instruction "Choose a repo, and we'll watch the repository for activity in GitHub such as pushes and pull requests. We'll kick off the first build immediately, and a new build will be initiated each time someone pushes commits."]]
        (om/build repo-lists {:user user
-                       :repos repos
-                       :selected-org selected-org
-                       :settings settings})
+                             :repos repos
+                             :selected-org selected-org
+                             :settings settings})
        [:hr]
        ;; This is a chain to get the organization that the user has clicked on and whether or not to show a payment plan upsell.
        ;; The logic is if the user clicked on themselves as the org, or if the api returns show-upsell? as true with the org, then


Add cache headers to css and js resources.

--- src/org/playasophy/wonderdome/web/app.clj
+++ src/org/playasophy/wonderdome/web/app.clj
@@ -26,6 +26,17 @@

 ;;;;; RESPONSE FUNCTIONS ;;;;;
+
+(defn- wrap-caching
+  "Ring middleware to add a cache-control header if the response matches
+  certain content types."
+  [handler max-age cacheable-type?]
+  (fn [req]
+    (let [resp (handler req)]
+      (if (cacheable-type? (get-in resp [:headers "Content-Type"]))
+        (r/header resp "Cache-Control" (format "public,max-age=%d" max-age))
+        resp))))
+

 (defn- bad-request
   [body]
@@ -114,6 +125,7 @@
       wrap-params
       (wrap-resource "/public")
       wrap-content-type
+      (wrap-caching 300 #{"text/css" "text/javascript"})
       wrap-not-modified
       wrap-exception-handler
       wrap-request-logger


Fix device api date encoding.

Fix device api date encoding.

Cheshire beats data.json again.

--- src/kixi/hecuba/api/devices.clj
+++ src/kixi/hecuba/api/devices.clj
@@ -203,7 +203,8 @@
           (ring-response {:status 404 :body "Please provide valid entity_id and device_id"}))))))

 (defn resource-handle-ok [ctx]
-  (::item ctx))
+  (let [req (:request ctx)]
+    (util/render-item req (::item ctx))))

 (defn resource-respond-with-entity [ctx]
   (let [request (:request ctx)


fix misplaced ref; add config and workspace arguments back to render-launch-overlay

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_config_editor.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_config_editor.cljs
@@ -143,7 +143,7 @@
                                            {"name" "Mock Participant" "entityType" "Participant"}]})))}
        "Launch Analysis"]])])

-(defn- render-launch-overlay [state refs]
+(defn- render-launch-overlay [state refs workspace config]
   [comps/ModalDialog
    {:show-when (:submitting? @state)
     :dismiss-self #(swap! state assoc :submitting? false)
@@ -158,7 +158,7 @@
         "Select Entity"]
        [:div {:style {:position "absolute" :top 4 :right 4}}
         [comps/Button {:icon :x :onClick #(swap! state assoc :submitting? false)}]]
-       [:div {:style {:ref "launchContainer" :padding "22px 48px 40px" :backgroundColor (:background-gray style/colors)}}
+       [:div {:ref "launchContainer" :style {:padding "22px 48px 40px" :backgroundColor (:background-gray style/colors)}}
         (style/create-form-label "Select Entity Type")
         (style/create-select
           {:style {:width "50%" :minWidth 50 :maxWidth 200} :ref "filter"
@@ -306,7 +306,7 @@
 (defn- render-display [state refs config editing? props]
   [:div {}
    [comps/Blocker {:banner (:blocker @state)}]
-   (render-launch-overlay state refs)
+   (render-launch-overlay state refs  (:workspace props) config)
    [:div {:style {:padding "0em 2em"}}
     (render-top-bar config)
     [:div {:style {:padding "1em 0em"}}


Omit nils from concat & union

Omit nils from concat & union

--- src/main/clojure/pigpen/set.clj
+++ src/main/clojure/pigpen/set.clj
@@ -114,7 +114,7 @@
   {:arglists '([opts? relations+])}
   [& opts-relations]
   (let [[opts relations] (split-opts-relations opts-relations)]
-    (raw/distinct$ (raw/union$ relations {}) opts)))
+    (raw/distinct$ (raw/union$ (filter identity relations) {}) opts)))

 (defn concat
   "Concatenates all relations provided. Does not guarantee any ordering of the
@@ -133,7 +133,7 @@
 "
   {:arglists '([relations+])}
   [& relations]
-  (raw/union$ relations {}))
+  (raw/union$ (filter identity relations) {}))

 (defn union-multiset
   "Performs a union on all relations provided and returns all results.
@@ -152,7 +152,7 @@
 "
   {:arglists '([relations+])}
   [& relations]
-  (raw/union$ relations {}))
+  (raw/union$ (filter identity relations) {}))

 (defn intersection
   "Performs an intersection on all relations provided and returns the distinct


Fix race conditions, looks like dirty hack (

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -259,7 +259,7 @@
         (reify FutureCallback
           (onSuccess [_ result]
             (when-not (nil? result)
-              (Thread/sleep 0)
+              (Thread/sleep 1)
               (success (conv/to-clj result))))
           (onFailure [_ result]
             (when-not (nil? result)


Refactoring: read-job-info-as-json and read-build-number-for-job

--- src/cloverage_jenkins_reporter/jenkins_api.clj
+++ src/cloverage_jenkins_reporter/jenkins_api.clj
@@ -30,6 +30,11 @@

 (require '[clojure.data.json       :as json])

+(defn encode-spaces
+    "Encode spaces in URL into its codes."
+    [^String url]
+    (clojure.string/replace url " " "%20"))
+
 (defn list-of-all-jobs-url
     [jenkins-url jenkins-job-list-url]
     (str jenkins-url jenkins-job-list-url))
@@ -44,7 +49,7 @@
 (defn read-job-info-as-json
     "Fetch the timestamp and duration of the last build from Jenkins server."
     [jenkins-url jenkins-job-prefix-url job-name]
-    (let [full-json-url (str jenkins-url jenkins-job-prefix-url (.replace job-name " " "%20") "/lastBuild/api/json?pretty=true")
+    (let [full-json-url (str jenkins-url jenkins-job-prefix-url (encode-spaces job-name) "/lastBuild/api/json?pretty=true")
           inputstr (slurp full-json-url)]
         (if inputstr
             (let [parsed   (json/read-str inputstr)
@@ -57,18 +62,13 @@

 (defn read-build-number-for-job
     [jenkins-url jenkins-job-prefix-url job-name]
-    (let [full-json-url (str jenkins-url jenkins-job-prefix-url (.replace job-name " " "%20") "/api/json?pretty=true")
+    (let [full-json-url (str jenkins-url jenkins-job-prefix-url (encode-spaces job-name) "/api/json?pretty=true")
           inputstr (slurp full-json-url)]
         (if inputstr
             (-> (json/read-str inputstr)
                 (get "lastBuild")
                 (get "number"))
             nil)))
-
-(defn encode-spaces
-    "Encode spaces in URL into its codes."
-    [^String url]
-    (clojure.string/replace url " " "%20"))

 (defn url-to-file-from-last-build
     [jenkins-url jenkins-job-prefix-url job-name file-name]


dry up sql queries

dry up sql queries

--- src/clj_money/models/storage/sql_storage.clj
+++ src/clj_money/models/storage/sql_storage.clj
@@ -69,6 +69,14 @@
       (assoc :updated-at (t/now))
       ->sql-keys))

+(defn- query
+  "Executes a SQL query and maps field names into
+  clojure keys"
+  [db-spec sql-map]
+  (->> (sql/format sql-map)
+       (jdbc/query db-spec)
+       (map ->clojure-keys)))
+
 (deftype SqlStorage [db-spec]
   Storage

@@ -79,20 +87,17 @@

   (select-users
     [_]
-    (let [sql (sql/format (-> (h/select :first_name :last_name :email)
-                              (h/from :users)))]
-      (->> (jdbc/query db-spec sql)
-           (map ->clojure-keys))))
+    (query db-spec (-> (h/select :first_name :last_name :email)
+                       (h/from :users))))

   (find-user-by-email
     [this email]
-    (let [sql (sql/format (-> (h/select :id :first_name :last_name :email :password)
-                              (h/from :users)
-                              (h/where [:= :email email])))]
-      (->> sql
-           (jdbc/query db-spec)
-           first
-           ->clojure-keys)))
+    (->> (-> (h/select :id :first_name :last_name :email :password)
+             (h/from :users)
+             (h/where [:= :email email])
+             (h/limit 1))
+         (query db-spec)
+         first))

   (user-exists-with-email?
     [this email]
@@ -106,13 +111,13 @@
          (jdbc/insert! db-spec :entities)
          first
          ->clojure-keys))
+
   (select-entities
     [_ user-id]
-    (let [sql (sql/format (-> (h/select :*)
-                              (h/from :entities)
-                              (h/where [:= :user_id user-id])
-                              (h/order-by :name)))]
-      (map ->clojure-keys (jdbc/query db-spec sql))))
+    (query db-spec (-> (h/select :*)
+                       (h/from :entities)
+                       (h/where [:= :user_id user-id])
+                       (h/order-by :name))))

   (entity-exists-with-name?
     [_ user-id name]
@@ -146,10 +151,9 @@

   (select-accounts-by-entity-id
     [_ entity-id]
-    (let [sql (sql/format (-> (h/select :*)
-                              (h/from :accounts)
-                              (h/where [:= :entity_id entity-id])))]
-      (map ->clojure-keys (jdbc/query db-spec sql))))
+    (query db-spec (-> (h/select :*)
+                       (h/from :accounts)
+                       (h/where [:= :entity_id entity-id]))))

   (update-account
     [_ account]
@@ -168,37 +172,32 @@

   (find-accounts-by-name
     [_ entity-id name]
-    (let [sql (sql/format (-> (h/select :*)
-                              (h/from :accounts)
-                              (h/where [:and
-                                        [:= :entity_id entity-id]
-                                        [:= :name name]])))]
-      (->> (jdbc/query db-spec sql)
-          (map ->clojure-keys))))
+    (query db-spec (-> (h/select :*)
+                       (h/from :accounts)
+                       (h/where [:and
+                                 [:= :entity_id entity-id]
+                                 [:= :name name]]))))

   ; Transactions
   (select-transactions-by-entity-id
     [_ entity-id]
-    (let [sql (sql/format (-> (h/select :*)
-                              (h/from :transactions)
-                              (h/where [:= :entity-id entity-id])
-                              (h/order-by [:transaction-date :desc])))]
-      (->> (jdbc/query db-spec sql)
-           (map ->clojure-keys))))
+    (query db-spec (-> (h/select :*)
+                      (h/from :transactions)
+                      (h/where [:= :entity-id entity-id])
+                      (h/order-by [:transaction-date :desc]))))

   (create-transaction
     [_ transaction]
     (insert db-spec :transactions transaction))

   (find-transaction-by-id
-      [_ id]
-      (let [sql (sql/format (-> (h/select :*)
-                                (h/from :transactions)
-                                (h/where [:= :id id])
-                                (h/limit 1)))]
-        (->> (jdbc/query db-spec sql)
-            (map ->clojure-keys)
-            first)))
+    [_ id]
+    (->> (-> (h/select :*)
+            (h/from :transactions)
+            (h/where [:= :id id])
+            (h/limit 1))
+        (query db-spec )
+        first))

   (delete-transaction
     [_ id]
@@ -220,66 +219,55 @@

   (select-transaction-items-by-transaction-id
     [_ transaction-id]
-    (let [sql (sql/format (-> (h/select :*)
-                              (h/from :transaction_items)
-                              (h/where [:= :transaction_id transaction-id])))]
-            (->> (jdbc/query db-spec sql)
-                (map ->clojure-keys))))
+    (query db-spec (-> (h/select :*)
+                      (h/from :transaction_items)
+                      (h/where [:= :transaction_id transaction-id]))))

   (select-transaction-items-by-account-id
     [_ account-id]
-    (let [sql (sql/format (-> (h/select :*)
-                              (h/from :transaction_items)
-                              (h/where [:= :account_id account-id])
-                              (h/order-by [:index :desc])))]
-            (->> (jdbc/query db-spec sql)
-                (map ->clojure-keys))))
+    (query db-spec (-> (h/select :*)
+                      (h/from :transaction_items)
+                      (h/where [:= :account_id account-id])
+                      (h/order-by [:index :desc]))))

   (select-transaction-items-by-account-id-and-starting-index
     [_ account-id index]
-    (let [sql (sql/format (-> (h/select :*)
-                              (h/from :transaction_items)
-                              (h/where [:and
-                                        [:= :account_id account-id]
-                                        [:>= :index index]])
-                              (h/order-by [:index :desc])))]
-      (->> (jdbc/query db-spec sql)
-          (map ->clojure-keys))))
+    (query db-spec (-> (h/select :*)
+                      (h/from :transaction_items)
+                      (h/where [:and
+                                [:= :account_id account-id]
+                                [:>= :index index]])
+                      (h/order-by [:index :desc]))))

   (select-transaction-items-by-account-id-on-or-after-date
     [_ account-id transaction-date]
-    (let [sql (sql/format (-> (h/select :i.*)
-                                (h/from [:transaction_items :i])
-                                (h/join [:transactions :t] [:= :t.id :i.transaction-id])
-                                (h/where [:and
-                                          [:= :i.account_id account-id]
-                                          [:>= :t.transaction_date transaction-date]])
-                                (h/order-by :index)))]
-        (->> (jdbc/query db-spec sql)
-            (map ->clojure-keys))))
+    (query db-spec (-> (h/select :i.*)
+                      (h/from [:transaction_items :i])
+                      (h/join [:transactions :t] [:= :t.id :i.transaction-id])
+                      (h/where [:and
+                                [:= :i.account_id account-id]
+                                [:>= :t.transaction_date transaction-date]])
+                      (h/order-by :index))))

   (find-transaction-item-by-id
     [_ id]
-    (let [sql (sql/format (-> (h/select :*)
-                              (h/from :transaction_items)
-                              (h/where [:= :id id])
-                              (h/limit 1)))]
-      (->> (jdbc/query db-spec sql)
-           first
-           ->clojure-keys)))
+    (->> (-> (h/select :*)
+            (h/from :transaction_items)
+            (h/where [:= :id id])
+            (h/limit 1))
+        (query db-spec)
+        first))

   (find-transaction-items-preceding-date
     [_ account-id transaction-date]
-    (let [sql (sql/format (-> (h/select :i.*)
-                              (h/from [:transaction_items :i])
-                              (h/join [:transactions :t] [:= :t.id :i.transaction-id])
-                              (h/where [:and
-                                        [:= :i.account-id account-id]
-                                        [:< :t.transaction-date transaction-date]])
-                              (h/order-by [:t.transaction-date :desc] [:i.index :desc])
-                              (h/limit 2)))]
-      (->> (jdbc/query db-spec sql)
-          (map ->clojure-keys))))
+    (query db-spec (-> (h/select :i.*)
+                      (h/from [:transaction_items :i])
+                      (h/join [:transactions :t] [:= :t.id :i.transaction-id])
+                      (h/where [:and
+                                [:= :i.account-id account-id]
+                                [:< :t.transaction-date transaction-date]])
+                      (h/order-by [:t.transaction-date :desc] [:i.index :desc])
+                      (h/limit 2))))

   (update-transaction-item
     [_ transaction-item]


make partition walk lazy and shortcut it on limit-1 queries

--- src/clj_money/models/storage/sql_storage.clj
+++ src/clj_money/models/storage/sql_storage.clj
@@ -510,22 +510,26 @@
     (let [[start end] (if (sequential? trade-date)
                         (rest trade-date)
                         [trade-date trade-date])
-          tables (cond-> (tables-for-range start end :prices)
-                  (descending-sort? (:sort options))
-                  reverse)
-          result (->> tables
-                      (map keyword)
-                      (mapcat (fn [table]
-                                (let [sql (-> (h/select :p.*)
-                                              (h/from [table :p])
-                                              (h/join [:commodities :c] [:= :c.id :p.commodity_id])
-                                              (append-where criteria {:prefix "p"})
-                                              (append-limit options)
-                                              (append-paging options))]
-                                  (query db-spec sql)))))]
-      (if (= 1 (:limit options))
-        (take 1 result)
-        result)))
+          tables (tables-for-range start
+                                  end
+                                  :prices
+                                  {:descending? (descending-sort?
+                                                  (:sort options))})]
+      (->> tables
+          (map keyword)
+          (reduce (fn [records table]
+                    (let [sql (-> (h/select :p.*)
+                                  (h/from [table :p])
+                                  (h/join [:commodities :c] [:= :c.id :p.commodity_id])
+                                  (append-where criteria {:prefix "p"})
+                                  (append-limit options)
+                                  (append-paging options))
+                          updated-records (concat records (query db-spec sql))]
+                      (if (and (= 1 (:limit options))
+                                (seq updated-records))
+                        (reduced updated-records)
+                        updated-records) ))
+                  []))))

   (update-price
     [_ price]


Fix paths again

Fix paths again

--- src/clojure/leiningen/new/libgdx_clojure.clj
+++ src/clojure/leiningen/new/libgdx_clojure.clj
@@ -24,10 +24,11 @@
               :class-name class-name
               :desktop-class-name desktop-class-name
               :android-class-name android-class-name
-              :activity "MainActivity"
+              :activity "AndroidLauncher"
               :namespace main-ns
               :desktop-namespace desktop-ns
               :android-namespace android-ns
+              :dirs (t/name-to-path package-name)
               :nested-dirs (t/name-to-path main-ns)
               :desktop-dirs (t/name-to-path desktop-ns)
               :android-dirs (t/name-to-path android-ns)
@@ -72,7 +73,7 @@
                 (lein-droid-render "splash_rotation.xml")]
                ["android/res/layout/splashscreen.xml"
                 (lein-droid-render "splashscreen.xml")]
-               ["android/src/java/{{path}}/SplashActivity.java"
+               ["android/src/java/{{dirs}}/SplashActivity.java"
                 (lein-droid-render "SplashActivity.java" data)]
                ["android/libs/armeabi/libgdx.so"
                 (-> (io/resource "armeabi-libgdx.so") io/input-stream)]


RAM in service Offer may be a decimal number

--- ssclj/jar/src/com/sixsq/slipstream/ssclj/resources/spec/accounting_record_vm.cljc
+++ ssclj/jar/src/com/sixsq/slipstream/ssclj/resources/spec/accounting_record_vm.cljc
@@ -7,7 +7,7 @@

 (s/def :cimi.accounting-record-vm/cpu pos-int?)
-(s/def :cimi.accounting-record-vm/ram pos-int?)
+(s/def :cimi.accounting-record-vm/ram pos?)
 (s/def :cimi.accounting-record-vm/disk pos-int?)
 (s/def :cimi.accounting-record-vm/instanceType :cimi.core/nonblank-string)


dirty hack for avoiding serial comm problem

--- src/kondolisp/serial.clj
+++ src/kondolisp/serial.clj
@@ -2,7 +2,7 @@

 (ns kondolisp.serial
   (:use [clojure core]
-        [clojure.contrib str-utils java-utils pprint])
+        [clojure.contrib str-utils java-utils pprint  seq-utils])
   (:import (gnu.io CommPort
                    CommPortIdentifier
                    SerialPort)
@@ -87,5 +87,8 @@
 (defn write-serial [bytes]
   (let [serial @*serial*]
     (when serial
-      (let [out (.getOutputStream serial)]
-        (.write out (to-byte-array bytes))))))
+      (let [out (.getOutputStream serial),
+            bytes-blocks (partition-all 32 bytes)]
+        (doseq [bytes bytes-blocks]
+          (.write out (to-byte-array bytes))
+          (Thread/sleep 50))))))


Add "bad idea" note to doc string of `with-ns-aliases`'s

--- test/com/nomistech/clojure_the_language/c_200_clojure_basics/s_500_namespaces.clj
+++ test/com/nomistech/clojure_the_language/c_200_clojure_basics/s_500_namespaces.clj
@@ -28,7 +28,9 @@
           ns-alias-forms))

 (defmacro with-ns-aliases
-  "Replace the specified namespace aliases in `form`.
+  "(This is probably a bad idea -- if you think you need this, maybe you should
+  split your stuff into more than one namespaces instead.)
+  Replace the specified namespace aliases in `form`.
   `ns-alias-forms` is of the form:
       [[namespace-1 :as alias-1]
        [namespace-2 :as alias-2]


default state of anon_tracking_enabled is `true` if the value is unset (meaning a fresh install).

--- src/metabase/models/setting.clj
+++ src/metabase/models/setting.clj
@@ -162,7 +162,8 @@
    :timezones             common/timezones
    :version               (config/mb-version-info)
    ;; all of these values are dynamic settings controlled at runtime
-   :anon_tracking_enabled (= "true" (get :anon-tracking-enabled))
+   :anon_tracking_enabled (let [tracking? (get :anon-tracking-enabled)]
+                            (or (nil? tracking?) (= "true" tracking?)))
    :site_name             (get :site-name)
    :email_configured      (not (s/blank? (get :email-smtp-host)))})


Removes 'mesos' from leadership logs (#1261)

--- scheduler/src/cook/mesos.clj
+++ scheduler/src/cook/mesos.clj
@@ -153,7 +153,7 @@
                           ;clojure.lang.Agent/pooledExecutor
                           (reify LeaderSelectorListener
                             (takeLeadership [_ client]
-                              (log/warn "Taking mesos leadership")
+                              (log/warn "Taking leadership")
                               (reset! mesos-leadership-atom true)
                               ;; TODO: get the framework ID and try to reregister
                               (let [normal-exit (atom true)]
@@ -226,10 +226,10 @@
                                     (reset! mesos-leadership-atom false)
                                     (counters/dec! mesos-leader)
                                     (when @normal-exit
-                                      (log/warn "Lost mesos leadership naturally"))
+                                      (log/warn "Lost leadership naturally"))
                                     ;; Better to fail over and rely on start up code we trust then rely on rarely run code
                                     ;; to make sure we yield leadership correctly (and fully)
-                                    (log/fatal "Lost mesos leadership. Exiting. Expecting a supervisor to restart me!")
+                                    (log/fatal "Lost leadership. Exiting. Expecting a supervisor to restart me!")
                                     (System/exit 0)))))
                             (stateChanged [_ client newState]
                               ;; We will give up our leadership whenever it seems that we lost
@@ -251,7 +251,7 @@
                                  (java.util.UUID/randomUUID)))
     (.autoRequeue leader-selector)
     (.start leader-selector)
-    (log/info "Started the mesos leader selector")
+    (log/info "Started the leader selector")
     {:submitter (partial submit-to-mesos mesos-datomic-conn)
      :leader-selector leader-selector}))


Small example for LinClosure

Small example for LinClosure

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/algorithms/linclosure.clj
+++ src/conexp/contrib/algorithms/linclosure.clj
@@ -43,4 +43,20 @@

 ;;;

-nil+(comment
+
+  (use '[clojure.contrib.def :only (defvar-)])
+  (require '[conexp.main :as cm])
+
+  (defvar- impls (cm/set-of (cm/make-implication A B)
+                            [A (cm/subsets #{1 2 3 4 5 6 7 8 9 10}),
+                             B (cm/subsets #{1 2 3 4 5 6 7 8 9 10})]))
+
+  (time (close-under-implications impls #{}))
+  (time (cm/close-under-implications impls #{}))
+
+  nil)
+
+;;;
+
+nil


Making test a little bit more strong.

Making test a little bit more strong.

--- clojure-functional/src/test/clojure/no/knowit/clojure_functional/order_service.clj
+++ clojure-functional/src/test/clojure/no/knowit/clojure_functional/order_service.clj
@@ -34,6 +34,7 @@
         result (doall (create-order-fn itineraries))
         stop (- (System/currentTimeMillis) start)]
     (is (= 5 (count result)))
+    (is (every? #(= (class %) Order) result) true)
     (is (< stop 400))))

 (run-tests)


put imported classes in :mappings rather than in :aliases

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -297,8 +297,8 @@

     (swap! *env* assoc-in [:namespaces ns-name]
            {:ns             ns-name
-            :mappings       (merge core-mappings require-mappings)
-            :aliases        (merge imports require-aliases)
+            :mappings       (merge core-mappings require-mappings imports)
+            :aliases        require-aliases
             :macro-mappings (merge core-macro-mappings macro-mappings)
             :macro-aliases  macro-aliases})))


Use :val instead of :msg and pr-str the :ns (#585)

--- src/main/shadow/cljs/devtools/server/prepl.clj
+++ src/main/shadow/cljs/devtools/server/prepl.clj
@@ -83,7 +83,7 @@
     ;; (send! {:tag :runtimes :runtimes runtimes})

     (if (empty? runtimes)
-      (send! {:tag :err :msg "No available JS runtimes!"})
+      (send! {:tag :err :val "No available JS runtimes!"})
       ;; work loop
       (let [session-id (str (UUID/randomUUID))
             session-ns 'cljs.user
@@ -99,7 +99,7 @@
           (alt!!
             server-close
             ([_]
-             (send! {:tag :err :msg "The server is shutting down."})
+             (send! {:tag :err :val "The server is shutting down."})
              :close)

             ;; input from tool
@@ -109,7 +109,7 @@
                (let [{:keys [error? ex source]} msg]
                  (cond
                    error?
-                   (do (send! {:tag :err :msg (str "Failed to read: " ex)})
+                   (do (send! {:tag :err :val (str "Failed to read: " ex)})
                        (recur loop-state))

                    (= ":repl/quit" source)
@@ -144,7 +144,7 @@
                        {::m/keys [printed-result form eval-ms]} msg]
                    ;; worst hack in history to prevent having to read-string the result
                    (send! {:tag :ret
-                           :ns session-ns
+                           :ns (pr-str session-ns)
                            :form form
                            :ms (or eval-ms 0)
                            :val printed-result})
@@ -152,19 +152,19 @@

                  ::m/session-out
                  (do (when (= session-id (::m/session-id msg))
-                       (send! {:tag :out :msg (::m/text msg)}))
+                       (send! {:tag :out :val (::m/text msg)}))
                      (recur loop-state))

                  ::m/session-err
                  (do (when (= session-id (::m/session-id msg))
-                       (send! {:tag :err :msg (::m/text msg)}))
+                       (send! {:tag :err :val (::m/text msg)}))
                      (recur loop-state))

                  ::m/runtime-disconnect
                  (if-not (= runtime-id (::m/runtime-id msg))
                    (recur loop-state)
                    ;; inform client and let loop end, ending in disconnect
-                   (send! {:tag :err :msg "The JS Runtime disconnected."}))
+                   (send! {:tag :err :val "The JS Runtime disconnected."}))

                  ;; mostly likely coming after disconnect on the browser reload
                  ;; FIXME: should disconnect not actually disconnect but rather just wait?
@@ -280,4 +280,4 @@
   (start-server svc :browser {:port 12345})
   (stop-server-for-build svc :browser)
   (stop svc)
-  )+  )


Remove duplicated import.

Remove duplicated import.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -3,7 +3,6 @@
             [clojure.walk :refer (keywordize-keys)]
             [clj-time.core :as time]
             [clj-time.format :as time-format]
-            [clj-time.core :as t]
             [oc.lib.text :as text]
             [hiccup.core :as h]
             [hickory.core :as hickory]


Creating a new app now makes its own database schema

This is great as now database schemas are separated. We still however
need to delete the contents of the old client side cache when we switch
applications

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -2322,8 +2322,23 @@
                               "         \"New app\"))")

                             (:id publisher)]
-                           )]
-    {:id (:id response)}))
+                           )
+
+        new-app-id      (:id response)
+
+        new-schema-name    (str "app_" new-app-id "_dev")
+        new-schema         (sql-1 "insert into appshare_schemas (database_schema_name) values (?) returning id" [new-schema-name])
+        new-schema-id      (:id new-schema)
+        ]
+    (do
+      (sql-1 "insert into appshare_application_schemas  (fk_appshare_application_id,fk_appshare_schema_id, application_environment) values (?, ?,?)"
+             [new-app-id  new-schema-id  "DEV"])
+
+
+      (sql-1 (str "create schema " new-schema-name)
+             [])
+
+      {:id new-app-id})))


fix expansion of all-nil clauses in Query Expander

--- src/metabase/driver/query_processor/expand.clj
+++ src/metabase/driver/query_processor/expand.clj
@@ -221,7 +221,8 @@
   `(defn ~(vary-meta fn-name assoc :private true) [form#]
      (when (and form#
                 (or (not (sequential? form#))
-                    (seq form#)))
+                    (and (seq form#)
+                         (every? identity form#))))
        (match form#
          ~@match-forms))))


Make HUD success notification longer

Make HUD success notification longer

--- src/adzerk/boot_reload/display.cljs
+++ src/adzerk/boot_reload/display.cljs
@@ -106,7 +106,7 @@
     (dom/appendChild js/document.body el)
     (timer/callOnce show! transition-duration)
     (when no-prob?
-      (timer/callOnce hide! (* transition-duration 3)))))
+      (timer/callOnce hide! (* transition-duration 5)))))

 (defn gen-id []
   (str "boot-reload-hud-" (name (gensym))))


(maint) add helper for configuration exceptions

--- src/puppetlabs/trapperkeeper/services/authorization/authorization_core.clj
+++ src/puppetlabs/trapperkeeper/services/authorization/authorization_core.clj
@@ -19,6 +19,32 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Private
+
+;; TODO should these IllegalArgumentExceptions be schema errors?
+(defn ^:private reject! [& strings]
+  (throw (IllegalArgumentException. (apply str strings))))
+
+(schema/defn validate-ace-config-map!
+  [config-value :- (schema/pred map? "map?")]
+  (when (:attrs config-value)
+    (schema/validate acl/CSRAttributes (:attrs config-value)))
+
+  (when (:certname config-value)
+    (schema/validate String config-value))
+
+  (when (or (not (or (:attrs config-value) (:certname config-value)))
+            (and (:attrs config-value) (:certname config-value)))
+    (throw IllegalArgumentException "ACL Definition must contain exactly one of 'certname' or 'attrs' keys.")))
+
+(schema/defn canonicalize-acl :- acl/ACEConfig
+  [config-value]
+  (cond
+    (string? config-value) {:certname config-value}
+    (map? config-value) (do (validate-ace-config-map! config-value)
+                            ;; TODO need to turn attr keys into keywords?
+                            ;; TODO should certname and attrs be XOR or OR?
+                            config-value)
+    :else (throw IllegalArgumentException (format "Unable to parse ACL: '%s'" config-value))))

 (defn pprint-rule
   [rule]
@@ -105,10 +131,9 @@
                           (.matcher "")
                           .groupCount)
                       (catch PatternSyntaxException e
-                        (throw (IllegalArgumentException.
-                                (str "The path regex provided in the rule"
-                                     " defined as " (pprint-rule rule)
-                                     " is invalid: " (.getMessage e))))))
+                        (reject! "The path regex provided in the rule"
+                                 " defined as " (pprint-rule rule)
+                                 " is invalid: " (.getMessage e))))
         get-br-list (fn [match-str]
                       (map #(Integer/parseInt (second %))
                            (re-seq #"\$(\d+)" match-str)))
@@ -122,11 +147,10 @@
     (doseq [[largest field] [[largest-allow-br "allow"]
                              [largest-deny-br "deny"]]
             :when (> largest group-count)]
-      (throw (IllegalArgumentException.
-              (str "The " field " field provided in the rule specified as "
-                   (pprint-rule rule) " contains the back reference '$"
-                   largest "' which refers to a capture group in "
-                   "the regex that doesn't exist."))))))
+      (reject! "The " field " field provided in the rule specified as "
+               (pprint-rule rule) " contains the back reference '$"
+               largest "' which refers to a capture group in "
+               "the regex that doesn't exist."))))

 (defn validate-auth-config-rule!
   "Tests to see if the given map contains the proper data to define an auth
@@ -134,95 +158,79 @@
   with a useful error message."
   [rule]
   (when-not (map? rule)
-    (throw (IllegalArgumentException.
-            "An authorization rule should be specified as a map.")))
+    (reject! "An authorization rule should be specified as a map."))
   (when-not (:match-request rule)
-    (throw (IllegalArgumentException.
-            "An authorization rule must contain a 'match-request' section.")))
+    (reject! "An authorization rule must contain a 'match-request' section."))
   (doseq [k [:path :type]]
     (when-not (contains? (:match-request rule) k)
-      (throw (IllegalArgumentException.
-              (str "The authorization rule specified as " (pprint-rule rule)
-                   " does not contain a '" (name k) "' key.")))))
+      (reject! "The authorization rule specified as " (pprint-rule rule)
+               " does not contain a '" (name k) "' key.")))
   (doseq [k [:sort-order :name]]
     (when-not (get rule k)
-      (throw (IllegalArgumentException.
-              (str "The authorization rule specified as " (pprint-rule rule)
-                   " does not contain a '" (name k) "' key.")))))
+      (reject! "The authorization rule specified as " (pprint-rule rule)
+               " does not contain a '" (name k) "' key.")))
   (when (or (not (integer? (:sort-order rule)))
             (< (:sort-order rule) 1)
             (> (:sort-order rule) 999))
-    (throw (IllegalArgumentException.
-            (str "The sort-order set in the authorization rule specified as "
-                 (pprint-rule rule) " is invalid. It should be a number "
-                 "from 1 to 999."))))
+    (reject! "The sort-order set in the authorization rule specified as "
+             (pprint-rule rule) " is invalid. It should be a number "
+             "from 1 to 999."))
   (if (:allow-unauthenticated rule)
     (if (some #{:deny :allow} (keys rule))
-      (throw (IllegalArgumentException.
-              (str "Authorization rule specified as  " (pprint-rule rule)
-                   " cannot have allow or deny if allow-unauthenticated."))))
+      (reject! "Authorization rule specified as  " (pprint-rule rule)
+               " cannot have allow or deny if allow-unauthenticated."))
     (when-not (some #{:deny :allow} (keys rule))
-      (throw (IllegalArgumentException.
-              (str "Authorization rule specified as " (pprint-rule rule)
-                   " must contain either a 'deny' or 'allow' rule.")))))
+      (reject! "Authorization rule specified as " (pprint-rule rule)
+               " must contain either a 'deny' or 'allow' rule.")))
   (when-not (string? (:type (:match-request rule)))
-    (throw (IllegalArgumentException.
-            (str "The type set in the authorization rule specified "
-                 "as " (pprint-rule rule) " should be a "
-                 "string that is either 'path' or 'regex'."))))
+    (reject! "The type set in the authorization rule specified "
+             "as " (pprint-rule rule) " should be a "
+             "string that is either 'path' or 'regex'."))
   (let [type (-> rule :match-request :type name str/lower-case)]
     (when-not (or (= type "path") (= type "regex"))
-      (throw (IllegalArgumentException.
-              (str "The type set in the authorization rule specified "
-                   "as " (pprint-rule rule) " is invalid. "
-                   "It should be set to either 'path' or 'regex'.")))))
+      (reject! "The type set in the authorization rule specified "
+               "as " (pprint-rule rule) " is invalid. "
+               "It should be set to either 'path' or 'regex'.")))
   (when-not (string? (:path (:match-request rule)))
-    (throw (IllegalArgumentException.
-            (str "The path set in the authorization rule specified as "
-                 (pprint-rule rule) " is invalid. "
-                 "It should be a string."))))
+    (reject! "The path set in the authorization rule specified as "
+             (pprint-rule rule) " is invalid. "
+             "It should be a string."))
   (when-not (valid-method? rule)
-    (throw (IllegalArgumentException.
-            (str "The method specified in the authorization rule specified as "
-                 (pprint-rule rule) " is invalid. "
-                 "It should be either a string or list of strings that is "
-                 "equal to one of the following methods: '"
-                 (str/join "', '" (sort valid-methods)) "'"))))
+    (reject! "The method specified in the authorization rule specified as "
+             (pprint-rule rule) " is invalid. "
+             "It should be either a string or list of strings that is "
+             "equal to one of the following methods: '"
+             (str/join "', '" (sort valid-methods)) "'"))
   (when (= "regex" (-> rule :match-request :type name str/lower-case))
     (validate-regex-backreferences! rule))
   (doseq [[type names] (select-keys rule [:allow :deny])]
     (if (vector? names)
       (when-not (every? string? names)
-        (throw (IllegalArgumentException.
-                (str "The " (name type) " list in the rule specified as "
-                     (pprint-rule rule)
-                     " contains one or more names that are not strings."))))
+        (reject! "The " (name type) " list in the rule specified as "
+                 (pprint-rule rule)
+                 " contains one or more names that are not strings."))
       (when-not (string? names)
-        (throw (IllegalArgumentException.
-                (str "The name '" names "' in the '" (name type) "' field of "
-                     "the rule specified as " (pprint-rule rule) " is invalid. "
-                     "It should be a string."))))))
+        (reject! "The name '" names "' in the '" (name type) "' field of "
+                 "the rule specified as " (pprint-rule rule) " is invalid. "
+                 "It should be a string."))))
   (when-let [query-params (:query-params (:match-request rule))]
     (when-not (map? query-params)
-      (throw (IllegalArgumentException. "Rule query-params must be a map.")))
+      (reject! "Rule query-params must be a map."))
     (doseq [param (keys query-params)
             :let [value (get query-params param)]]
       (when-not (keyword? param)
-        (throw (IllegalArgumentException.
-                (str "The query-param '" param "' in the rule specified as "
-                     (pprint-rule rule) " is invalid. It should be a string."))))
+        (reject! "The query-param '" param "' in the rule specified as "
+                 (pprint-rule rule) " is invalid. It should be a string."))
       (when-not (or (string? value)
                     (vector? value))
-        (throw (IllegalArgumentException.
-                (str "The query-param value for '" param "' in the rule "
-                     "specified as " (pprint-rule rule) " is invalid. "
-                     "It should be a string or list of strings."))))
+        (reject! "The query-param value for '" param "' in the rule "
+                 "specified as " (pprint-rule rule) " is invalid. "
+                 "It should be a string or list of strings."))
       (when (vector? value)
         (when-not (every? string? value)
-          (throw (IllegalArgumentException.
-                  (str "The '" param "' query-param in the rule specified as "
-                       (pprint-rule rule) " contains one or more values that "
-                       "are not strings.")))))))
+          (reject! "The '" param "' query-param in the rule specified as "
+                   (pprint-rule rule) " contains one or more values that "
+                   "are not strings.")))))
   rule)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -234,30 +242,24 @@
   the input config will be returned."
   [config]
   (when-not config
-    (throw (IllegalArgumentException.
-            "Missing authorization service configuration.")))
+    (reject! "Missing authorization service configuration."))
   (when-not (map? config)
-    (throw (IllegalArgumentException.
-            "The authorization service configuration is not a map.")))
+    (reject! "The authorization service configuration is not a map."))
   (let [allow-header-cert-info (:allow-header-cert-info config)]
     (when (and (not (nil? allow-header-cert-info))
                (not (ks/boolean? allow-header-cert-info)))
-      (throw (IllegalArgumentException.
-              "allow-header-cert-info is not a boolean."))))
+      (reject! "allow-header-cert-info is not a boolean.")))
   (when-not (= 1 (:version config))
-    (throw (IllegalArgumentException.
-            (str "Unsupported or missing version in configuration file. "
-                 "Supported versions are: 1"))))
+    (reject! "Unsupported or missing version in configuration file. "
+             "Supported versions are: 1"))
   (when-not (vector? (:rules config))
-    (throw (IllegalArgumentException.
-            "The authorization service configuration rules is not a list.")))
+    (reject! "The authorization service configuration rules is not a list."))
   (doseq [rule (:rules config)]
     (validate-auth-config-rule! rule))
   (doseq [[name rules] (group-by :name (:rules config))]
     (when-not (= 1 (count rules))
-      (throw (IllegalArgumentException.
-              (str "Duplicate rules named '" name "'. "
-                   "Rules must be uniquely named.")))))
+      (reject! "Duplicate rules named '" name "'. "
+               "Rules must be uniquely named.")))
   config)

 (schema/defn transform-config :- [rules/Rule]


Gracefully recover from disconnection.

Gracefully recover from disconnection.

We were not shutting down the Wayang display interface library when the
controller was yanked from us, which prevented us from using it the next
time it connected. Now we always shut down the library.

--- src/afterglow/controllers/ableton_push_2.clj
+++ src/afterglow/controllers/ableton_push_2.clj
@@ -2500,11 +2500,14 @@
     (Thread/sleep 35) ; Give the UI update thread time to shut down
     (clear-interface controller)
     (restore-led-palettes controller)
-    (Wayang/close)

     ;; Leave the User button bright, in case the user has Live
     ;; running and wants to be able to see how to return to it.
     (set-button-color controller (:user-mode control-buttons) white-color))
+
+  ;; Regardless of whether it was a clean or abrupt end, shut down the
+  ;; graphical display interface library.
+  (Wayang/close)

   ;; Cancel any UI overlays which were in effect
   (reset! (:overlays controller) (controllers/create-overlay-state))