(ns chat.client.views.threads
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [om.core :as om]
            [om.dom :as dom]
            [clojure.string :as string]
            [cljs.core.async :as async :refer [<! >! put! chan alts! timeout]]
            [cljs-uuid-utils.core :as uuid]
            [chat.client.dispatcher :refer [dispatch!]]
            [chat.client.store :as store]
            [chat.client.views.user-modal :refer [user-modal-view]]
            [chat.client.views.new-message :refer [new-message-view]]
            [chat.client.views.helpers :as helpers])
  (:import [goog.events KeyCodes]))

(defn message-view [message owner]
  (reify
    om/IRender
    (render [_]
      (let [sender (get-in @store/app-state [:users (message :user-id)])]
        (dom/div #js {:className "message"}
          (dom/img #js {:className "avatar" :src (sender :avatar)})
          (apply dom/div #js {:className "content"}
            (helpers/format-message (message :content)))
          (dom/div #js {:className "info"}
            (str (or (sender :nickname) (sender :email)) " @ " (helpers/format-date (message :created-at)))))))))

(defn thread-tags-view [thread owner]
  (reify
    om/IRender
    (render [_]
      (let [tags (->> (thread :tag-ids)
                      (map #(get-in @store/app-state [:tags %])))
            mentions (->> (thread :mentioned-ids)
                          (map #(get-in @store/app-state [:users %])))]
        (apply dom/div #js {:className "tags"}
          (pr-str (thread :mentioned-ids))
          (concat
            (map (fn [u]
                   (dom/div #js {:className "tag"
                                 :style #js {:backgroundColor (helpers/tag->color u)}}
                     (str "@" (or (u :nickname) (u :email))))) mentions)
            (map (fn [tag]
                   (dom/div #js {:className "tag"
                                 :style #js {:backgroundColor (helpers/tag->color tag)}}
                     (tag :name))) tags)))))))

(defn thread-view [thread owner {:keys [searched?] :as opts}]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className "thread"}
        (when-not (or (thread :new?) searched?)
          (dom/div #js {:className "close"
                        :onClick (fn [_]
                                   (dispatch! :hide-thread {:thread-id (thread :id)}))} "×"))
        (om/build thread-tags-view thread)
        (when-not (thread :new?)
          (apply dom/div #js {:className "messages"}
            (om/build-all message-view (->> (thread :messages)
                                            (sort-by :created-at))
                          {:key :id})))
        (om/build new-message-view {:thread-id (thread :id)
                                    :placeholder (if (thread :new?)
                                                   "Start a conversation..."
                                                   "Reply...")}
                  {:react-key "message"})))))

(defn debounce
  "Given the input channel source and a debouncing time of msecs, return a new
  channel that will forward the latest event from source at most every msecs
  milliseconds"
  [source msecs]
  (let [out (chan)]
    (go
      (loop [state ::init
             lastv nil
             chans [source]]
        (let [[_ threshold] chans]
          (let [[v sc] (alts! chans)]
            (condp = sc
              source (recur ::debouncing v
                            (case state
                              ::init (conj chans (timeout msecs))
                              ::debouncing (conj (pop chans) (timeout msecs))))
              threshold (do (when lastv
                              (put! out lastv))
                            (recur ::init nil (pop chans))))))))
    out))

(defn search-view [data owner]
  (reify
    om/IInitState
    (init-state [_]
      {:search-chan (chan)})
    om/IWillMount
    (will-mount [_]
      (let [search (debounce (om/get-state owner :search-chan) 1000)]
        (go (while true
              (let [{:keys [query]} (<! search)]
                (if (string/blank? query)
                  (store/set-search-results! {})
                  (dispatch! :search-history query)))))))
    om/IRenderState
    (render-state [_ {:keys [search-chan]}]
      (dom/div #js {:className "search"}
        (dom/input #js {:type "search" :placeholder "Search History"
                        :onChange
                        (fn [e] (put! search-chan {:query (.. e -target -value)}))})))))

(defn threads-view [data owner]
  (reify
    om/IRender
    (render [_]
      (dom/div nil
        (when-let [err (data :error-msg)]
          (dom/div #js {:className "error-banner"}
            err
            (dom/span #js {:className "close"
                           :onClick (fn [_] (store/clear-error!))}
              "×")))
        (om/build user-modal-view data)
        (om/build search-view {})
        (apply dom/div #js {:className "threads"}
          (concat
            (map (fn [t] (om/build thread-view t
                                   {:key :id
                                    :opts {:searched? (some? (get-in data [:search-results (t :id)]))}}))
                 (->> (vals (merge (data :threads)
                                   (data :search-results)))
                      (sort-by
                        (comp (partial apply min)
                              (partial map :created-at)
                              :messages))))
            [(om/build thread-view
                       {:id (uuid/make-random-squuid)
                        :new? true
                        :tag-ids []
                        :messages []}
                       {:react-key "new-thread"})]))))))

(ns chat.client.views.threads
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [om.core :as om]
            [om.dom :as dom]
            [clojure.string :as string]
            [cljs.core.async :as async :refer [<! >! put! chan alts! timeout]]
            [cljs-uuid-utils.core :as uuid]
            [chat.client.dispatcher :refer [dispatch!]]
            [chat.client.store :as store]
            [chat.client.views.user-modal :refer [user-modal-view]]
            [chat.client.views.new-message :refer [new-message-view]]
            [chat.client.views.helpers :as helpers])
  (:import [goog.events KeyCodes]))

(defn message-view [message owner]
  (reify
    om/IRender
    (render [_]
      (let [sender (get-in @store/app-state [:users (message :user-id)])]
        (dom/div #js {:className "message"}
          (dom/img #js {:className "avatar" :src (sender :avatar)})
          (apply dom/div #js {:className "content"}
            (helpers/format-message (message :content)))
          (dom/div #js {:className "info"}
            (str (or (sender :nickname) (sender :email)) " @ " (helpers/format-date (message :created-at)))))))))

(defn thread-tags-view [thread owner]
  (reify
    om/IRender
    (render [_]
      (let [tags (->> (thread :tag-ids)
                      (map #(get-in @store/app-state [:tags %])))
            mentions (->> (thread :mentioned-ids)
                          (map #(get-in @store/app-state [:users %])))]
        (apply dom/div #js {:className "tags"}
          (concat
            (map (fn [u]
                   (dom/div #js {:className "tag"
                                 :style #js {:backgroundColor (helpers/tag->color u)}}
                     (str "@" (or (u :nickname) (u :email))))) mentions)
            (map (fn [tag]
                   (dom/div #js {:className "tag"
                                 :style #js {:backgroundColor (helpers/tag->color tag)}}
                     (tag :name))) tags)))))))

(defn thread-view [thread owner {:keys [searched?] :as opts}]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className "thread"}
        (when-not (or (thread :new?) searched?)
          (dom/div #js {:className "close"
                        :onClick (fn [_]
                                   (dispatch! :hide-thread {:thread-id (thread :id)}))} "×"))
        (om/build thread-tags-view thread)
        (when-not (thread :new?)
          (apply dom/div #js {:className "messages"}
            (om/build-all message-view (->> (thread :messages)
                                            (sort-by :created-at))
                          {:key :id})))
        (om/build new-message-view {:thread-id (thread :id)
                                    :placeholder (if (thread :new?)
                                                   "Start a conversation..."
                                                   "Reply...")}
                  {:react-key "message"})))))

(defn debounce
  "Given the input channel source and a debouncing time of msecs, return a new
  channel that will forward the latest event from source at most every msecs
  milliseconds"
  [source msecs]
  (let [out (chan)]
    (go
      (loop [state ::init
             lastv nil
             chans [source]]
        (let [[_ threshold] chans]
          (let [[v sc] (alts! chans)]
            (condp = sc
              source (recur ::debouncing v
                            (case state
                              ::init (conj chans (timeout msecs))
                              ::debouncing (conj (pop chans) (timeout msecs))))
              threshold (do (when lastv
                              (put! out lastv))
                            (recur ::init nil (pop chans))))))))
    out))

(defn search-view [data owner]
  (reify
    om/IInitState
    (init-state [_]
      {:search-chan (chan)})
    om/IWillMount
    (will-mount [_]
      (let [search (debounce (om/get-state owner :search-chan) 1000)]
        (go (while true
              (let [{:keys [query]} (<! search)]
                (if (string/blank? query)
                  (store/set-search-results! {})
                  (dispatch! :search-history query)))))))
    om/IRenderState
    (render-state [_ {:keys [search-chan]}]
      (dom/div #js {:className "search"}
        (dom/input #js {:type "search" :placeholder "Search History"
                        :onChange
                        (fn [e] (put! search-chan {:query (.. e -target -value)}))})))))

(defn threads-view [data owner]
  (reify
    om/IRender
    (render [_]
      (dom/div nil
        (when-let [err (data :error-msg)]
          (dom/div #js {:className "error-banner"}
            err
            (dom/span #js {:className "close"
                           :onClick (fn [_] (store/clear-error!))}
              "×")))
        (om/build user-modal-view data)
        (om/build search-view {})
        (apply dom/div #js {:className "threads"}
          (concat
            (map (fn [t] (om/build thread-view t
                                   {:key :id
                                    :opts {:searched? (some? (get-in data [:search-results (t :id)]))}}))
                 (->> (vals (merge (data :threads)
                                   (data :search-results)))
                      (sort-by
                        (comp (partial apply min)
                              (partial map :created-at)
                              :messages))))
            [(om/build thread-view
                       {:id (uuid/make-random-squuid)
                        :new? true
                        :tag-ids []
                        :messages []}
                       {:react-key "new-thread"})]))))))

remove leftover debug pr-str

remove leftover debug pr-str


(ns mbeanz.handler
  (:require [compojure.route :as route]
            [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
            [ring.middleware.json :refer [wrap-json-response]]
            [ring.middleware.logger :refer [wrap-with-logger]]
            [compojure.core :refer :all]
            [mbeanz.core :refer :all]
            [mbeanz.common :refer :all]
            [environ.core :refer [env]]
            [clojure.java.jmx :as jmx]))

(def object-pattern (env :mbeanz-object-pattern))

(def jmx-remote-host (env :mbeanz-jmx-remote-host))

(def jmx-remote-port (Integer/parseInt (env :mbeanz-jmx-remote-port)))

(defn- identifier-string [identifiers]
  (map #(str (:bean %) " " (stringify (:operation %))) identifiers))

(defn- with-bean-and-operation [operation function]
  (fn [request]
    (jmx/with-connection {:host jmx-remote-host :port jmx-remote-port}
      (let [mbean (get-in request [:params :bean])]
        (doall (function mbean (keyword operation)))))))

(defn- handle-invoke [operation]
  (fn [request]
    (jmx/with-connection {:host jmx-remote-host :port jmx-remote-port}
      (let [mbean (get-in request [:params :bean])
            args (get-in request [:params :args])
            result (invoke mbean (keyword operation) args)]
        {:body {:result result} }))))

(defn- handle-list-beans []
  (fn [request]
    (jmx/with-connection {:host jmx-remote-host :port jmx-remote-port}
      (identifier-string (doall (list-beans object-pattern))))))

(defroutes app-routes
  (GET "/list" [] (handle-list-beans))
  (GET "/describe/:operation" [operation] (with-bean-and-operation operation describe))
  (GET "/parameters/:operation" [operation] (with-bean-and-operation operation get-params))
  (GET "/invoke/:operation" [operation] (handle-invoke operation))
  (route/not-found "Not Found"))

(def app
  (-> app-routes
      (wrap-with-logger)
      (wrap-json-response)
      (wrap-defaults api-defaults)))

(ns mbeanz.handler
  (:require [compojure.route :as route]
            [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
            [ring.middleware.json :refer [wrap-json-response]]
            [ring.middleware.logger :refer [wrap-with-logger]]
            [compojure.core :refer :all]
            [mbeanz.core :refer :all]
            [mbeanz.common :refer :all]
            [environ.core :refer [env]]
            [clojure.java.jmx :as jmx]))

(def object-pattern (env :mbeanz-object-pattern))

(def jmx-remote-host (env :mbeanz-jmx-remote-host))

(def jmx-remote-port (Integer/parseInt (env :mbeanz-jmx-remote-port)))

(defn- identifier-string [identifiers]
  (map #(str (:bean %) " " (stringify (:operation %))) identifiers))

(defn- with-bean-and-operation [operation function]
  (fn [request]
    (jmx/with-connection {:host jmx-remote-host :port jmx-remote-port}
      (let [mbean (get-in request [:params :bean])]
        (doall (function mbean (keyword operation)))))))

(defn- handle-invoke [operation]
  (fn [request]
    (jmx/with-connection {:host jmx-remote-host :port jmx-remote-port}
      (let [mbean (get-in request [:params :bean])
            args (get-in request [:params :args])]
        (if (string? args)
          (hash-map :body {:result (invoke mbean (keyword operation) args)})
          (hash-map :body {:result (apply invoke mbean (keyword operation) args)}))))))

(defn- handle-list-beans []
  (fn [request]
    (jmx/with-connection {:host jmx-remote-host :port jmx-remote-port}
      (identifier-string (doall (list-beans object-pattern))))))

(defroutes app-routes
  (GET "/list" [] (handle-list-beans))
  (GET "/describe/:operation" [operation] (with-bean-and-operation operation describe))
  (GET "/parameters/:operation" [operation] (with-bean-and-operation operation get-params))
  (GET "/invoke/:operation" [operation] (handle-invoke operation))
  (route/not-found "Not Found"))

(def app
  (-> app-routes
      (wrap-with-logger)
      (wrap-json-response)
      (wrap-defaults api-defaults)))

Make it work with any arity operations

Make it work with any arity operations


(ns spectrace.trace-test
  (:require [clojure.spec.alpha :as s]
            [clojure.test :refer [deftest is are]]
            [spectrace.trace :as trace]))

(s/def ::x integer?)
(s/def ::y string?)

(deftest traces-test
  (are [spec data expected]
      (= expected (trace/traces (s/explain-data spec data)))

    (s/spec integer?)
    :a
    [[{:spec `integer? :path [] :val :a :in []}]]

    ::x
    :a
    [[{:spec `integer? :path [] :val :a :in []
       :spec-name ::x}]]

    (s/and integer? even?)
    3
    [[{:spec `(s/and integer? even?) :path [] :val 3 :in []}
      {:spec `even? :path [] :val 3 :in []}]]

    (s/or :int integer? :str string?)
    :a
    [[{:spec `(s/or :int integer? :str string?)
       :path [:int]
       :val :a
       :in []}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/or :int integer? :str string?)
       :path [:str]
       :val :a
       :in []}
      {:spec `string? :path [] :val :a :in []}]]

    (s/nilable integer?)
    :a
    [[{:spec `(s/nilable integer?) :path [::s/pred] :val :a :in []}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/nilable integer?) :path [::s/nil] :val :a :in []}
      {:spec 'nil? :path [] :val :a :in []}]]

    (s/tuple integer? string?)
    [1 :a]
    [[{:spec `(s/tuple integer? string?) :path [1] :val [1 :a] :in [1]}
      {:spec `string? :path [] :val :a :in []}]]

    (s/map-of integer? string?)
    {:a :b}
    [[{:spec `(s/map-of integer? string?)
       :path [0]
       :val {:a :b}
       :in [:a 0]}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/map-of integer? string?)
       :path [1]
       :val {:a :b}
       :in [:a 1]}
      {:spec `string? :path [] :val :b :in []}]]

    (s/every-kv integer? string?)
    {:a :b}
    [[{:spec `(s/every-kv integer? string?)
       :path [0]
       :val {:a :b}
       :in [:a 0]}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/every-kv integer? string?)
       :path [1]
       :val {:a :b}
       :in [:a 1]}
      {:spec `string? :path [] :val :b :in []}]]

    (s/cat :int integer? :str string?)
    [1 :b]
    [[{:spec `(s/cat :int integer? :str string?)
       :path [:str]
       :val [1 :b]
       :in [1]}
      {:spec `string? :path [] :val :b :in []}]]

    (s/& (s/cat :x integer? :y integer?)
         (fn [{:keys [x y]}] (< x y)))
    [4 :a]
    [[{:spec `(s/& (s/cat :x integer? :y integer?)
                   (fn [{:keys [~'x ~'y]}] (< ~'x ~'y)))
       :path [:y]
       :val [4 :a]
       :in [1]}
      {:spec `(s/cat :x integer? :y integer?)
       :path [:y]
       :val [4 :a]
       :in [1]}
      {:spec `integer? :path [] :val :a :in []}]]

    (s/& (s/cat :x integer? :y integer?)
         (fn [{:keys [x y]}] (< x y)))
    [4 3]
    [[{:spec `(s/& (s/cat :x integer? :y integer?)
                   (fn [{:keys [~'x ~'y]}] (< ~'x ~'y)))
       :path []
       :val [4 3]
       :in [1]}
      {:spec `(fn [{:keys [~'x ~'y]}] (< ~'x ~'y))
       :path []
       :val [4 3]
       :in [1]}]]

    (s/alt :int integer? :str string?)
    [:a]
    [[{:spec `(s/alt :int integer? :str string?)
       :path [:int]
       :val [:a]
       :in [0]}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/alt :int integer? :str string?)
       :path [:str]
       :val [:a]
       :in [0]}
      {:spec `string? :path [] :val :a :in []}]]

    (s/* integer?)
    [1 :a 3]
    [[{:spec `(s/* integer?) :path [] :val [1 :a 3] :in [1]}
      {:spec `integer? :path [] :val :a :in []}]]

    (s/+ integer?)
    [:a]
    [[{:spec `(s/+ integer?) :path [] :val [:a] :in [0]}
      {:spec `integer? :path [] :val :a :in []}]]

    ))

(ns spectrace.trace-test
  (:require [clojure.spec.alpha :as s]
            [clojure.test :refer [deftest is are]]
            [spectrace.trace :as trace]))

(s/def ::x integer?)
(s/def ::y string?)

(deftest traces-test
  (are [spec data expected]
      (= expected (trace/traces (s/explain-data spec data)))

    (s/spec integer?)
    :a
    [[{:spec `integer? :path [] :val :a :in []}]]

    ::x
    :a
    [[{:spec `integer? :path [] :val :a :in []
       :spec-name ::x}]]

    (s/and integer? even?)
    3
    [[{:spec `(s/and integer? even?) :path [] :val 3 :in []}
      {:spec `even? :path [] :val 3 :in []}]]

    (s/or :int integer? :str string?)
    :a
    [[{:spec `(s/or :int integer? :str string?)
       :path [:int]
       :val :a
       :in []}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/or :int integer? :str string?)
       :path [:str]
       :val :a
       :in []}
      {:spec `string? :path [] :val :a :in []}]]

    (s/nilable integer?)
    :a
    [[{:spec `(s/nilable integer?) :path [::s/pred] :val :a :in []}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/nilable integer?) :path [::s/nil] :val :a :in []}
      {:spec 'nil? :path [] :val :a :in []}]]

    (s/tuple integer? string?)
    [1 :a]
    [[{:spec `(s/tuple integer? string?) :path [1] :val [1 :a] :in [1]}
      {:spec `string? :path [] :val :a :in []}]]

    ;; Can't test them until CLJ-2168 will be fixed
    #_(s/coll-of integer?)
    #_[1 :a]
    #_[[{:spec `(s/coll-of integer?) :path [] :val [1 :a] :in [1]}
      {:spec `integer? :path [] :val :a :in []}]]

    #_(s/every integer?)
    #_[1 :a]
    #_[[{:spec `(s/every integer?) :path [] :val [1 :a] :in [1]}
      {:spec `integer? :path [] :val :a :in []}]]

    (s/map-of integer? string?)
    {:a :b}
    [[{:spec `(s/map-of integer? string?)
       :path [0]
       :val {:a :b}
       :in [:a 0]}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/map-of integer? string?)
       :path [1]
       :val {:a :b}
       :in [:a 1]}
      {:spec `string? :path [] :val :b :in []}]]

    (s/every-kv integer? string?)
    {:a :b}
    [[{:spec `(s/every-kv integer? string?)
       :path [0]
       :val {:a :b}
       :in [:a 0]}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/every-kv integer? string?)
       :path [1]
       :val {:a :b}
       :in [:a 1]}
      {:spec `string? :path [] :val :b :in []}]]

    (s/cat :int integer? :str string?)
    [1 :b]
    [[{:spec `(s/cat :int integer? :str string?)
       :path [:str]
       :val [1 :b]
       :in [1]}
      {:spec `string? :path [] :val :b :in []}]]

    (s/& (s/cat :x integer? :y integer?)
         (fn [{:keys [x y]}] (< x y)))
    [4 :a]
    [[{:spec `(s/& (s/cat :x integer? :y integer?)
                   (fn [{:keys [~'x ~'y]}] (< ~'x ~'y)))
       :path [:y]
       :val [4 :a]
       :in [1]}
      {:spec `(s/cat :x integer? :y integer?)
       :path [:y]
       :val [4 :a]
       :in [1]}
      {:spec `integer? :path [] :val :a :in []}]]

    (s/& (s/cat :x integer? :y integer?)
         (fn [{:keys [x y]}] (< x y)))
    [4 3]
    [[{:spec `(s/& (s/cat :x integer? :y integer?)
                   (fn [{:keys [~'x ~'y]}] (< ~'x ~'y)))
       :path []
       :val [4 3]
       :in [1]}
      {:spec `(fn [{:keys [~'x ~'y]}] (< ~'x ~'y))
       :path []
       :val [4 3]
       :in [1]}]]

    (s/alt :int integer? :str string?)
    [:a]
    [[{:spec `(s/alt :int integer? :str string?)
       :path [:int]
       :val [:a]
       :in [0]}
      {:spec `integer? :path [] :val :a :in []}]
     [{:spec `(s/alt :int integer? :str string?)
       :path [:str]
       :val [:a]
       :in [0]}
      {:spec `string? :path [] :val :a :in []}]]

    (s/* integer?)
    [1 :a 3]
    [[{:spec `(s/* integer?) :path [] :val [1 :a 3] :in [1]}
      {:spec `integer? :path [] :val :a :in []}]]

    (s/+ integer?)
    [:a]
    [[{:spec `(s/+ integer?) :path [] :val [:a] :in [0]}
      {:spec `integer? :path [] :val :a :in []}]]

    ))

Comment some test cases that can't be tested because of CLJ-2168


(ns com.palletops.bakery.httpkit
  "Component for running http-kit server.
  Provides an idempotent start and stop."
  (:require
   [com.palletops.api-builder.api :refer [defn-api]]
   [com.palletops.leaven.protocols :refer [Startable Stoppable]]
   [org.httpkit.server :as httpkit]
   [schema.core :as schema]))

(defn- start
  [handler {:keys [port join?] :as config}]
  {:pre [handler port]}
  (httpkit/run-server handler config))

(defn- stop
  [server stop-timeout]
  (server :timeout stop-timeout))

(defrecord Httpkit
    [config server handler stop-timeout]
  Startable
  (start [component]
    (if server
      component
      (assoc component :server (start handler config))))
  Stoppable
  (stop [component]
    (if server
      (do
        (stop server stop-timeout)
        (assoc component :server nil))
      component)))

(def HttpkitOptions
  {:handler (schema/make-fn-schema schema/Any [[schema/Any]])
   (schema/optional-key :config) {schema/Keyword schema/Any}
   (schema/optional-key :stop-timeout) schema/Int})

(defn-api httpkit
  "Return an httpkit component, that will dispatch ring requests to
  the `handler` handler. An optional :stop-timeout can specify a
  timeout when waiting for the server to stop (defaults to 100ms).
  All other options are passed to httpkit.  The default port is 3000.
  The start and stop implementations are idempotent."
  {:sig [[HttpkitOptions :- Httpkit]]}
  [{:keys [config handler stop-timeout]
    :or {stop-timeout 100}
    :as options}]
  (map->Httpkit
   {:config (merge
             {:port 3000
              :join? false}
             config)
    :stop-timeout stop-timeout
    :handler handler}))

(ns com.palletops.bakery.httpkit
  "Component for running http-kit server.
  Provides an idempotent start and stop."
  (:require
   [com.palletops.api-builder.api :refer [defn-api]]
   [com.palletops.leaven.protocols :refer [Startable Stoppable]]
   [org.httpkit.server :as httpkit]
   [schema.core :as schema]))

(defn- start
  [handler {:keys [port join?] :as config}]
  {:pre [handler port]
   :post [(fn? %)]}
  (httpkit/run-server handler config))

(defn- stop
  [server stop-timeout]
  (server :timeout stop-timeout))

(defrecord Httpkit
    [config server handler stop-timeout]
  Startable
  (start [component]
    (if server
      component
      (assoc component :server (start handler config))))
  Stoppable
  (stop [component]
    (if server
      (do
        (stop server stop-timeout)
        (assoc component :server nil))
      component)))

(def HttpkitOptions
  {:handler (schema/make-fn-schema schema/Any [[schema/Any]])
   (schema/optional-key :config) {schema/Keyword schema/Any}
   (schema/optional-key :stop-timeout) schema/Int})

(defn-api httpkit
  "Return an httpkit component, that will dispatch ring requests to
  the `handler` handler. An optional :stop-timeout can specify a
  timeout when waiting for the server to stop (defaults to 100ms).
  All other options are passed to httpkit.  The default port is 3000.
  The start and stop implementations are idempotent."
  {:sig [[HttpkitOptions :- Httpkit]]}
  [{:keys [config handler stop-timeout]
    :or {stop-timeout 100}
    :as options}]
  (map->Httpkit
   {:config (merge
             {:port 3000
              :join? false}
             config)
    :stop-timeout stop-timeout
    :handler handler}))

Add post-condtion to httpkit start

Add post-condtion to httpkit start


; Copyright © 2011 Sattvik Software & Technology Resources, Ltd. Co.
; All rights reserved.
;
; This program and the accompanying materials are made available under the
; terms of the Eclipse Public License v1.0 which accompanies this distribution,
; and is available at <http://www.eclipse.org/legal/epl-v10.html>.
;
; By using this software in any fashion, you are agreeing to be bound by the
; terms of this license.  You must not remove this notice, or any other, from
; this software.

(ns neko.activity
  "Utilities to aid in working with an activity."
  {:author "Daniel Solano Gómez"}
  (:import android.app.Activity
           android.view.View)
  (:use neko.-utils))

(def
  ^{:doc "The current activity to operate on."
    :dynamic true}
  *activity*)

(defmacro with-activity
  "Evaluates body such that *activity* is bound to the given activity."
  [activity & body]
  `(binding [*activity* ~activity]
     ~@body))

(defn activity?
  "Determines whether the argument is an instance of Activity."
  [x]
  (instance? Activity x))

(defn has-*activity*?
  "Ensures that the calling context has a valid *activity* var."
  []
  (and (bound? #'*activity*)
       (activity? *activity*)))

(defn set-content-view!
  "Sets the content for the activity.  The view may be one of:

  + A view object, which will be used directly
  + An integer presumed to be a valid layout ID."
  ([view]
   {:pre [(or (instance? View view)
              (integer? view))]}
   (set-content-view! *activity* view))
  ([^Activity activity view]
   {:pre [(activity? activity)
          (or (instance? View view)
              (integer? view))]}
   (cond
     (instance? View view)
       (.setContentView activity ^View view)
     (integer? view)
       (.setContentView activity ^Integer view))))

(defn request-window-features!
  "Requests the given features for the activity.  The features should be
  keywords such as :no-title or :indeterminate-progress corresponding
  FEATURE_NO_TITLE and FEATURE_INDETERMINATE_PROGRESS, respectively.  Returns a
  sequence of boolean values corresponding to each feature, where a true value
  indicates the requested feature is supported and now enabled.

  If within a with-activity form, supplying an activity as the first argument
  is not necessary.

  This function should be called before set-content-view!."
  {:arglists '([& features] [activity & features])}
  [activity & features]
  {:pre  [(or (activity? activity)
              (and (keyword? activity)
                   (has-*activity*?)))
          (every? keyword? features)]
   :post [%
          (every? (fn [x] (instance? Boolean x)) %)]}
  (let [[^Activity activity features]
          (if (instance? Activity activity)
            [activity features]
            [*activity* (cons activity features)])
        keyword->int (fn [k]
                       (static-field-value android.view.Window
                                           k
                                           #(str "FEATURE_" %)))
        request-feature  (fn [k]
                           (try
                             (.requestWindowFeature activity (keyword->int k))
                             (catch NoSuchFieldException _
                               (throw (IllegalArgumentException.
                                        (format "‘%s’ is not a valid feature."
                                                k))))))]
    (doall (map request-feature features))))

(defmacro defactivity
  "Creates an activity with the given full package-qualified name.
  Optional arguments should be provided in a key-value fashion.

  Available optional arguments:

  :extends, :prefix - same as for `gen-class`.

  :def - symbol to bind the Activity object to in the onCreate
  method. Relevant only if :create is used.

  :on-create - takes a two-argument function. Generates a handler for
  activity's `onCreate` event which automatically calls the
  superOnCreate method and creates a var with the name denoted by
  `:def` (or activity's lower-cased name by default) to store the
  activity object. Then calls the provided function onto the
  Application object.

  :on-start, :on-restart, :on-resume, :on-pause, :on-stop, :on-destroy
  - same as :on-create but require a one-argument function."
  [name & {:keys [extends prefix on-create def] :as options}]
  (let [options (or options {}) ;; Handle no-options case
        sname (simple-name name)
        prefix (or prefix (str sname "-"))
        def (or def (symbol (unicaseize sname)))]
    `(do
       (gen-class
        :name ~name
        :main false
        :prefix ~prefix
        :extends ~(or extends Activity)
        :exposes-methods {~'onCreate ~'superOnCreate
                          ~'onStart ~'superOnStart
                          ~'onRestart ~'superOnRestart
                          ~'onResume ~'superOnResume
                          ~'onPause ~'superOnPause
                          ~'onStop ~'superOnStop
                          ~'onDestroy ~'superOnDestroy})
       ~(when on-create
          `(defn ~(symbol (str prefix "onCreate"))
             [~(vary-meta 'this assoc :tag name),
              ^android.os.Bundle ~'savedInstanceState]
             (.superOnCreate ~'this ~'savedInstanceState)
             (def ~(vary-meta def assoc :tag name) ~'this)
             (~on-create ~'this ~'savedInstanceState)))
       ~@(map #(let [func (options %)
                     event-name (keyword->camelcase %)]
                 (when func
                   `(defn ~(symbol (str prefix event-name))
                      [~(vary-meta 'this assoc :tag name)]
                      (~(symbol (str ".super" (capitalize event-name))) ~'this)
                      (~func ~'this))))
              [:on-start :on-restart :on-resume
               :on-pause :on-stop :on-destroy]))))

; Copyright © 2011 Sattvik Software & Technology Resources, Ltd. Co.
; All rights reserved.
;
; This program and the accompanying materials are made available under the
; terms of the Eclipse Public License v1.0 which accompanies this distribution,
; and is available at <http://www.eclipse.org/legal/epl-v10.html>.
;
; By using this software in any fashion, you are agreeing to be bound by the
; terms of this license.  You must not remove this notice, or any other, from
; this software.

(ns neko.activity
  "Utilities to aid in working with an activity."
  {:author "Daniel Solano Gómez"}
  (:import android.app.Activity
           android.view.View)
  (:use neko.-utils))

(def
  ^{:doc "The current activity to operate on."
    :dynamic true}
  *activity*)

(defmacro with-activity
  "Evaluates body such that *activity* is bound to the given activity."
  [activity & body]
  `(binding [*activity* ~activity]
     ~@body))

(defn activity?
  "Determines whether the argument is an instance of Activity."
  [x]
  (instance? Activity x))

(defn has-*activity*?
  "Ensures that the calling context has a valid *activity* var."
  []
  (and (bound? #'*activity*)
       (activity? *activity*)))

(defn set-content-view!
  "Sets the content for the activity.  The view may be one of:

  + A view object, which will be used directly
  + An integer presumed to be a valid layout ID."
  ([view]
   {:pre [(or (instance? View view)
              (integer? view))]}
   (set-content-view! *activity* view))
  ([^Activity activity view]
   {:pre [(activity? activity)
          (or (instance? View view)
              (integer? view))]}
   (cond
     (instance? View view)
       (.setContentView activity ^View view)
     (integer? view)
       (.setContentView activity ^Integer view))))

(defn request-window-features!
  "Requests the given features for the activity.  The features should be
  keywords such as :no-title or :indeterminate-progress corresponding
  FEATURE_NO_TITLE and FEATURE_INDETERMINATE_PROGRESS, respectively.  Returns a
  sequence of boolean values corresponding to each feature, where a true value
  indicates the requested feature is supported and now enabled.

  If within a with-activity form, supplying an activity as the first argument
  is not necessary.

  This function should be called before set-content-view!."
  {:arglists '([& features] [activity & features])}
  [activity & features]
  {:pre  [(or (activity? activity)
              (and (keyword? activity)
                   (has-*activity*?)))
          (every? keyword? features)]
   :post [%
          (every? (fn [x] (instance? Boolean x)) %)]}
  (let [[^Activity activity features]
          (if (instance? Activity activity)
            [activity features]
            [*activity* (cons activity features)])
        keyword->int (fn [k]
                       (static-field-value android.view.Window
                                           k
                                           #(str "FEATURE_" %)))
        request-feature  (fn [k]
                           (try
                             (.requestWindowFeature activity (keyword->int k))
                             (catch NoSuchFieldException _
                               (throw (IllegalArgumentException.
                                        (format "‘%s’ is not a valid feature."
                                                k))))))]
    (doall (map request-feature features))))

(defmacro defactivity
  "Creates an activity with the given full package-qualified name.
  Optional arguments should be provided in a key-value fashion.

  Available optional arguments:

  :extends, :prefix - same as for `gen-class`.

  :def - symbol to bind the Activity object to in the onCreate
  method. Relevant only if :create is used.

  :on-create - takes a two-argument function. Generates a handler for
  activity's `onCreate` event which automatically calls the
  superOnCreate method and creates a var with the name denoted by
  `:def` (or activity's lower-cased name by default) to store the
  activity object. Then calls the provided function onto the
  Application object.

  :on-start, :on-restart, :on-resume, :on-pause, :on-stop, :on-destroy
  - same as :on-create but require a one-argument function."
  [name & {:keys [extends prefix on-create def] :as options}]
  (let [options (or options {}) ;; Handle no-options case
        sname (simple-name name)
        prefix (or prefix (str sname "-"))
        def (or def (symbol (unicaseize sname)))]
    `(do
       (gen-class
        :name ~name
        :main false
        :prefix ~prefix
        :extends ~(or extends Activity)
        :exposes-methods {~'onCreate ~'superOnCreate
                          ~'onStart ~'superOnStart
                          ~'onRestart ~'superOnRestart
                          ~'onResume ~'superOnResume
                          ~'onPause ~'superOnPause
                          ~'onStop ~'superOnStop
                          ~'onCreateContextMenu ~'superOnCreateContextMenu
                          ~'onContextItemSelected ~'superOnContextItemSelected
                          ~'onDestroy ~'superOnDestroy})
       ~(when on-create
          `(defn ~(symbol (str prefix "onCreate"))
             [~(vary-meta 'this assoc :tag name),
              ^android.os.Bundle ~'savedInstanceState]
             (.superOnCreate ~'this ~'savedInstanceState)
             (def ~(vary-meta def assoc :tag name) ~'this)
             (~on-create ~'this ~'savedInstanceState)))
       ~@(map #(let [func (options %)
                     event-name (keyword->camelcase %)]
                 (when func
                   `(defn ~(symbol (str prefix event-name))
                      [~(vary-meta 'this assoc :tag name)]
                      (~(symbol (str ".super" (capitalize event-name))) ~'this)
                      (~func ~'this))))
              [:on-start :on-restart :on-resume
               :on-pause :on-stop :on-destroy]))))

Add some more inherited methods to the activity


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.

(ns containium.standalone
  (:require [containium.systems :refer (with-systems)]
            [containium.systems.config :refer (map-config)]
            [containium.systems.repl :as repl]
            [containium.systems.elasticsearch :as elastic]
            [containium.systems.cassandra.embedded :as cassandra]
            [containium.systems.ring.http-kit :refer (test-http-kit)]
            [ring.middleware.session.memory :refer (memory-store)]
            [clojure.java.io :as io]))

(defn run [spec {:keys [start stop ring profiles active-profiles dev?]
                 :or {:profiles [dev provided user system base]
                      :active-profiles [dev provided user system base]
                      :dev? true}
                 :as containium-map}]
  (with-systems systems [:config (map-config spec)
                         :repl repl/nrepl
                         :session-store (memory-store)
                         :ring (test-http-kit (-> ring :handler))
                         :elastic elastic/embedded
                         :cassandra cassandra/embedded]
    (start systems
           {:file (io/as-file ".")
            :profiles profiles
            :active-profiles active-profiles
            :dev? (:dev? containium-map true)
            :containium containium-map})
    (read-line)
    (stop systems))
  (shutdown-agents))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.

(ns containium.standalone
  (:require [containium.systems :refer (with-systems)]
            [containium.systems.config :refer (map-config)]
            [containium.systems.repl :as repl]
            [containium.systems.elasticsearch :as elastic]
            [containium.systems.cassandra.embedded :as cassandra]
            [containium.systems.ring.http-kit :refer (test-http-kit)]
            [containium.systems.logging :as logging]
            [ring.middleware.session.memory :refer (memory-store)]
            [clojure.java.io :as io]))

(defn run [spec {:keys [start stop ring profiles active-profiles dev?]
                 :or {:profiles [dev provided user system base]
                      :active-profiles [dev provided user system base]
                      :dev? true}
                 :as containium-map}]
  (with-systems systems [:config (map-config spec)
                         :logging logging/logger
                         :repl repl/nrepl
                         :session-store (memory-store)
                         :ring (test-http-kit (-> ring :handler))
                         :elastic elastic/embedded
                         :cassandra cassandra/embedded]
    (start systems
           {:file (io/as-file ".")
            :profiles profiles
            :active-profiles active-profiles
            :dev? (:dev? containium-map true)
            :containium containium-map})
    (read-line)
    (stop systems))
  (shutdown-agents))

Add logging system to containium.standalone


(ns gamma-hello-triangle.core
  (:require [gamma.api :as g]
            [gamma.program :as p]
            [goog.dom :as gdom]
            [goog.webgl :as ggl]))

(def vertex-position (g/attribute "a_VertexPosition" :vec2))

(def vertex-shader {(g/gl-position) (g/vec4 vertex-position 0 1)})

(def fragment-shader {(g/gl-frag-color) (g/vec4 1 0 0 1)})

(def hello-triangle
  (p/program
    {:vertex-shader vertex-shader
     :fragment-shader fragment-shader}))

(defn main []
  (let [gl  (.getContext (gdom/getElement "gl-canvas") "webgl")
        vs  (.createShader gl ggl/VERTEX_SHADER)
        fs  (.createShader gl ggl/FRAGMENT_SHADER)
        pgm (.createProgram gl)
        xs  (js/Float32Array. #js [-0.5 -0.5 0.5 -0.5 0 0])
        buf (.createBuffer gl)]
    (doto gl
      (.shaderSource vs (-> hello-triangle :vertex-shader :glsl))
      (.compileShader vs)
      (.shaderSource fs (-> hello-triangle :fragment-shader :glsl))
      (.compileShader fs)
      (.attachShader pgm vs)
      (.attachShader pgm fs)
      (.linkProgram pgm)
      (.bindBuffer ggl/ARRAY_BUFFER buf)
      (.bufferData ggl/ARRAY_BUFFER xs ggl/STATIC_DRAW)
      (.enableVertexAttribArray (.getAttribLocation gl pgm (:name vertex-position)))
      (.vertexAttribPointer (.getAttribLocation gl pgm (:name vertex-position))
        2 ggl/FLOAT false 0 0)
      (.useProgram pgm)
      (.drawArrays ggl/TRIANGLES 0 3))))

(comment
  (main)
  )

remove comment

remove comment


(ns fhofherr.clj-io.files
  (:refer-clojure :exclude [exists?])
  (:require [clojure.java.io :as io])
  (:import [java.nio.file CopyOption
            FileVisitResult
            Files
            LinkOption
            SimpleFileVisitor]
           [java.time Instant]
           [java.nio.file.attribute FileAttribute
            FileTime
            PosixFileAttributes
            PosixFileAttributeView
            PosixFilePermission]))

(def ^:private no-follow-links (into-array LinkOption
                                           [LinkOption/NOFOLLOW_LINKS]))
(def ^:private follow-links (make-array LinkOption 0))

;; TODO: do we really need this?
(defn- posix-file-attribute-view
  [path]
  (Files/getFileAttributeView path PosixFileAttributeView no-follow-links))

(defn- posix-file-attributes
  [path]
  (Files/readAttributes path PosixFileAttributes no-follow-links))

(defn posix-permissions
  [path]
  (->> path
       (posix-file-attributes)
       (.permissions)
       (into #{})))

(defn set-posix-permissions
  [path posix-permissions]
  (let [fav (posix-file-attribute-view path)]
    (Files/setPosixFilePermissions path posix-permissions)))

(defn has-posix-permissions?
  [path expected-perms]
  (->> path
       (posix-permissions)
       (clojure.set/intersection expected-perms)
       (not-empty)
       (boolean)))

(defn readable?
  [path & {:keys [by] :or {by :owner}}]
  {:pre [(#{:owner :group :others} by)]}
  (case by
    :owner (has-posix-permissions? path #{PosixFilePermission/OWNER_READ})
    :group (has-posix-permissions? path #{PosixFilePermission/GROUP_READ})
    :others (has-posix-permissions? path #{PosixFilePermission/OTHERS_READ})))

(defn writable?
  [path & {:keys [by] :or {by :owner}}]
  {:pre [(#{:owner :group :others} by)]}
  (case by
    :owner (has-posix-permissions? path #{PosixFilePermission/OWNER_WRITE})
    :group (has-posix-permissions? path #{PosixFilePermission/GROUP_WRITE})
    :others (has-posix-permissions? path #{PosixFilePermission/OTHERS_WRITE})))

(defn executable?
  [path & {:keys [by] :or {by :owner}}]
  {:pre [(#{:owner :group :others} by)]}
  (case by
    :owner (has-posix-permissions? path #{PosixFilePermission/OWNER_EXECUTE})
    :group (has-posix-permissions? path #{PosixFilePermission/GROUP_EXECUTE})
    :others (has-posix-permissions? path #{PosixFilePermission/OTHERS_EXECUTE})))

(def ^:private available-perms)

(defn- parse-perms
  [permstr perm-type]
  {:pre [(#{:owner :group :others} perm-type)]}
  (let [available-perms {:owner {\r PosixFilePermission/OWNER_READ
                                 \w PosixFilePermission/OWNER_WRITE
                                 \x PosixFilePermission/OWNER_EXECUTE}
                         :group {\r PosixFilePermission/GROUP_READ
                                 \w PosixFilePermission/GROUP_WRITE
                                 \x PosixFilePermission/GROUP_EXECUTE}
                         :others {\r PosixFilePermission/OTHERS_READ
                                  \w PosixFilePermission/OTHERS_WRITE
                                  \x PosixFilePermission/OTHERS_EXECUTE}}
        lookup-perm (fn [c]
                      {:pre [(#{\r \w \x} c)]}
                      (get-in available-perms [perm-type c]))]
    (->> permstr
         (map lookup-perm)
         (into #{}))))

(defn chmod
  [path arg & args]
  {:pre [(or (string? arg) (keyword? arg))]}
  (let [perms (if (string? arg)
                (parse-perms arg :owner)
                (as-> [arg] $
                      (into $ args)
                      (partition 2 $)
                      (map (fn [[t p]] (parse-perms p t)) $)
                      (apply clojure.set/union $)))]
    (set-posix-permissions path perms))
  path)

(defn ctime
  [path]
  (-> path
      (posix-file-attributes)
      (.creationTime)
      (.toInstant)))

(defn mtime
  [path]
  (-> path
      (posix-file-attributes)
      (.lastModifiedTime)
      (.toInstant)))

(defn atime
  [path]
  (-> path
      (posix-file-attributes)
      (.lastAccessTime)
      (.toInstant)))

(defn create-tmp-dir
  []
  (Files/createTempDirectory "tmp-" (make-array FileAttribute 0)))

(defn create-tmp-file
  []
  (Files/createTempFile "tmp-" "" (make-array FileAttribute 0)))

(defn rm-rf
  [path]
  (Files/walkFileTree path
                      (proxy [SimpleFileVisitor] []
                        (visitFile [file attrs]
                          (Files/delete file)
                          FileVisitResult/CONTINUE)
                        (postVisitDirectory [dir attrs]
                          (Files/delete dir)
                          FileVisitResult/CONTINUE))))

(defn copy-resource
  "TODO: add dedicated tests."
  [resource path]
  (let [is (-> resource
               (io/resource)
               (io/input-stream))]
    (Files/copy is path (make-array CopyOption 0))
    path))

(defmacro with-tmp-dir
  [bnd & body]
  `(let [f# (fn ~bnd ~@body)
         tmp-dir# (create-tmp-dir)]
     (try
       (f# tmp-dir#)
       (finally
         (rm-rf tmp-dir#)))))

(defmacro with-tmp-file
  [bnd & body]
  `(let [f# (fn ~bnd ~@body)
         tmp-file# (create-tmp-file)]
     (try
       (f# tmp-file#)
       (finally
         (rm-rf tmp-file#)))))

(defn exists?
  [path]
  (Files/exists path follow-links))

(defn directory?
  [path]
  (Files/isDirectory path follow-links))

(defn mkdir
  [path]
  (Files/createDirectory path (make-array FileAttribute 0)))

(defn touch
  ([path]
   (touch path nil))
  ([path ^Instant date-time]
   (when-not (exists? path)
     (Files/createFile path (make-array FileAttribute 0)))
   (let [mt (or date-time (Instant/now))
         at (or date-time (Instant/now))
         ct (ctime path)
         attr-view (posix-file-attribute-view path)]
     (.setTimes attr-view
                (FileTime/from mt)
                (FileTime/from at)
                (FileTime/from ct)))
   path))

(ns fhofherr.clj-io.files
  (:refer-clojure :exclude [exists?])
  (:require [clojure.java.io :as io]
            [clojure.set :as s])
  (:import [java.nio.file CopyOption
            FileVisitResult
            Files
            LinkOption
            SimpleFileVisitor]
           [java.time Instant]
           [java.nio.file.attribute FileAttribute
            FileTime
            PosixFileAttributes
            PosixFileAttributeView
            PosixFilePermission]))

(def ^:private no-follow-links (into-array LinkOption
                                           [LinkOption/NOFOLLOW_LINKS]))
(def ^:private follow-links (make-array LinkOption 0))

;; TODO: do we really need this?
(defn- posix-file-attribute-view
  [path]
  (Files/getFileAttributeView path PosixFileAttributeView no-follow-links))

(defn- posix-file-attributes
  [path]
  (Files/readAttributes path PosixFileAttributes no-follow-links))

(defn posix-permissions
  [path]
  (->> path
       (posix-file-attributes)
       (.permissions)
       (into #{})))

(defn set-posix-permissions
  [path posix-permissions]
  (let [fav (posix-file-attribute-view path)]
    (Files/setPosixFilePermissions path posix-permissions)))

(defn has-posix-permissions?
  [path expected-perms]
  (->> path
       (posix-permissions)
       (s/intersection expected-perms)
       (not-empty)
       (boolean)))

(defn readable?
  [path & {:keys [by] :or {by :owner}}]
  {:pre [(#{:owner :group :others} by)]}
  (case by
    :owner (has-posix-permissions? path #{PosixFilePermission/OWNER_READ})
    :group (has-posix-permissions? path #{PosixFilePermission/GROUP_READ})
    :others (has-posix-permissions? path #{PosixFilePermission/OTHERS_READ})))

(defn writable?
  [path & {:keys [by] :or {by :owner}}]
  {:pre [(#{:owner :group :others} by)]}
  (case by
    :owner (has-posix-permissions? path #{PosixFilePermission/OWNER_WRITE})
    :group (has-posix-permissions? path #{PosixFilePermission/GROUP_WRITE})
    :others (has-posix-permissions? path #{PosixFilePermission/OTHERS_WRITE})))

(defn executable?
  [path & {:keys [by] :or {by :owner}}]
  {:pre [(#{:owner :group :others} by)]}
  (case by
    :owner (has-posix-permissions? path #{PosixFilePermission/OWNER_EXECUTE})
    :group (has-posix-permissions? path #{PosixFilePermission/GROUP_EXECUTE})
    :others (has-posix-permissions? path #{PosixFilePermission/OTHERS_EXECUTE})))

(def ^:private available-perms)

(defn- parse-perms
  [permstr perm-type]
  {:pre [(#{:owner :group :others} perm-type)]}
  (let [available-perms {:owner {\r PosixFilePermission/OWNER_READ
                                 \w PosixFilePermission/OWNER_WRITE
                                 \x PosixFilePermission/OWNER_EXECUTE}
                         :group {\r PosixFilePermission/GROUP_READ
                                 \w PosixFilePermission/GROUP_WRITE
                                 \x PosixFilePermission/GROUP_EXECUTE}
                         :others {\r PosixFilePermission/OTHERS_READ
                                  \w PosixFilePermission/OTHERS_WRITE
                                  \x PosixFilePermission/OTHERS_EXECUTE}}
        lookup-perm (fn [c]
                      {:pre [(#{\r \w \x} c)]}
                      (get-in available-perms [perm-type c]))]
    (->> permstr
         (map lookup-perm)
         (into #{}))))

(defn chmod
  [path arg & args]
  {:pre [(or (string? arg) (keyword? arg))]}
  (let [perms (if (string? arg)
                (parse-perms arg :owner)
                (as-> [arg] $
                      (into $ args)
                      (partition 2 $)
                      (map (fn [[t p]] (parse-perms p t)) $)
                      (apply s/union $)))]
    (set-posix-permissions path perms))
  path)

(defn ctime
  [path]
  (-> path
      (posix-file-attributes)
      (.creationTime)
      (.toInstant)))

(defn mtime
  [path]
  (-> path
      (posix-file-attributes)
      (.lastModifiedTime)
      (.toInstant)))

(defn atime
  [path]
  (-> path
      (posix-file-attributes)
      (.lastAccessTime)
      (.toInstant)))

(defn create-tmp-dir
  []
  (Files/createTempDirectory "tmp-" (make-array FileAttribute 0)))

(defn create-tmp-file
  []
  (Files/createTempFile "tmp-" "" (make-array FileAttribute 0)))

(defn rm-rf
  [path]
  (Files/walkFileTree path
                      (proxy [SimpleFileVisitor] []
                        (visitFile [file attrs]
                          (Files/delete file)
                          FileVisitResult/CONTINUE)
                        (postVisitDirectory [dir attrs]
                          (Files/delete dir)
                          FileVisitResult/CONTINUE))))

(defn copy-resource
  "TODO: add dedicated tests."
  [resource path]
  (let [is (-> resource
               (io/resource)
               (io/input-stream))]
    (Files/copy is path (make-array CopyOption 0))
    path))

(defmacro with-tmp-dir
  [bnd & body]
  `(let [f# (fn ~bnd ~@body)
         tmp-dir# (create-tmp-dir)]
     (try
       (f# tmp-dir#)
       (finally
         (rm-rf tmp-dir#)))))

(defmacro with-tmp-file
  [bnd & body]
  `(let [f# (fn ~bnd ~@body)
         tmp-file# (create-tmp-file)]
     (try
       (f# tmp-file#)
       (finally
         (rm-rf tmp-file#)))))

(defn exists?
  [path]
  (Files/exists path follow-links))

(defn directory?
  [path]
  (Files/isDirectory path follow-links))

(defn mkdir
  [path]
  (Files/createDirectory path (make-array FileAttribute 0)))

(defn touch
  ([path]
   (touch path nil))
  ([path ^Instant date-time]
   (when-not (exists? path)
     (Files/createFile path (make-array FileAttribute 0)))
   (let [mt (or date-time (Instant/now))
         at (or date-time (Instant/now))
         ct (ctime path)
         attr-view (posix-file-attribute-view path)]
     (.setTimes attr-view
                (FileTime/from mt)
                (FileTime/from at)
                (FileTime/from ct)))
   path))

Fix problem with uberjar creation

Fix problem with uberjar creation


(ns ninjudd.eventual.client
  (:require [cljs.core.async :refer [put! chan]]
            [cljs.reader :refer [read-string]]))

(defn event-source-channel [f url]
  (let [source (new js/EventSource url)
        out (chan)]
    (.addEventListener source "message"
                       (fn [e]
                         (put! out (f (.-data e)))))
    out))

(defn edn-events [url]
  (event-source-channel read-string url))

(defn json-events [url]
  (event-source-channel #(.parse js/JSON %) url))

(ns ninjudd.eventual.client
  (:require [cljs.core.async :as async]
            [cljs.reader :refer [read-string]]))

(defn event-source [f url]
  (let [source (new js/EventSource url)
        channel (async/chan)]
    (.addEventListener source "message"
                       (fn [e]
                         (async/put! channel (f (.-data e)))))
    {:event-source source
     :channel channel}))

(defn edn-event-source [url]
  (event-source read-string url))

(defn json-event-source [url]
  (event-source #(.parse js/JSON %) url))

(defn close! [{:keys [channel event-source]}]
  (when event-source
    (.close event-source))
  (async/close! channel))

add close! method to client and return a map with EventSource + channel close! closes both the EventSource and the channel


(ns overtone.core.ugen.noise)

(def specs
     [

      {:name "WhiteNoise"
       :args []
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates noise whose spectrum has equal power at all frequencies."}

      {:name "BrownNoise"
       :args []
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates noise whose spectrum falls off in power by 6 dB per octave."}

      {:name "PinkNoise"
       :args []
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates noise whose spectrum falls off in power by 3 dB per octave. This gives equal power over the span of each octave. This version gives 8 octaves of pink noise."}

      {:name "ClipNoise"
       :args []
       :muladd true
       :rates #{:ar}
       :doc "Generates noise whose values are either -1 or 1. This produces the maximum energy for the least peak to peak amplitude."}

      {:name "GrayNoise"
       :args []
       :muladd true
       :rates #{:ar}
       :doc "Generates random impulses from -1 to +1 given a density (average number of impulses per second)"}

      {:name "Crackle"
       :args [{:name "chaosParam", :default 1.5}]
       :muladd true
       :rates #{:ar :kr}
       :doc "A noise generator based on a chaotic function. The argument represents a parameter of the chaotic function with useful values from just below 1.0 to just above 2.0. Towards 2.0 the sound crackles."}

      {:name "Logistic"
       :args [{:name "chaos-param", :default 3.0}
              {:name "freq", :default 1000.0}
              {:name "init", :default 0.5}]
       :muladd true
       :rates #{:ar}
       :doc "A noise generator based on the logistic map:

  y = chaos-param * y * (1.0 - y)

  chaos-param - a parameter of the chaotic function with useful values from 0.0 to 4.0.
  Chaos occurs from 3.57 up. Don't use values outside this range if you don't want the UGen to blow up.
  freq - Frequency of calculation; if over the sampling rate, this is clamped to the sampling rate
  init - Initial value of y in the equation above

  y will stay in the range of 0.0 to 1.0 for normal values of the chaos-param. This leads to a DC offset
  and may cause a pop when you stop the Synth. For output you might want to combine this UGen with a LeakDC
  or rescale around 0.0 via mul and add: see example below. "}

      {:name "LFNoise0"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates random values at a rate (the rate is not guaranteed but approximate)"}

      {:name "LFNoise1"
       :args [{:name "freq", :default 500.0}]
       :muladd true]
       :rates #{:ar :kr}
       :doc "Generates linearly interpolated random values at the supplied rate (the rate is not guaranteed but approximate). "}

      {:name "LFNoise2"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates quadratically interpolated random values at the suplied rate (the rate is not guaranteed but approximate).

  Note: quadratic interpolation means that the noise values can occasionally extend beyond the normal range
  of +-1, if the freq varies in certain ways. If this is undesirable then you might like to clip2 the values
  or use a linearly-interpolating unit instead."}

      {:name "LFClipNoise"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar}
       :doc "Randomly generates the values -1 or +1 at a rate given by the nearest integer division of the sample rate by the freq argument. It is probably pretty hard on your speakers!"}

      {:name "LFDNoise0"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Like LFNoise0, it generates random values at a rate given
  by the freq argument,  with two differences:

  -no time quantization
  -fast recovery from low freq values.

  (LFNoise0,1,2 quantize to the nearest integer division of the samplerate
  and they poll the freq argument only when scheduled, and thus seem
  to hang when freqs get very low).

  If you don't need very high or very low freqs, or use fixed freqs
  LFNoise0 is more efficient."}

      {:name "LFDNoise1"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Like LFNoise1, it generates linearly interpolated random values
  at a rate given by the freq argument, with two differences:

  -no time quantization
  -fast recovery from low freq values.

  (LFNoise0,1,2 quantize to the nearest integer division of the samplerate
  and they poll the freq argument only when scheduled, and thus seem
  to hang when freqs get very low).

  If you don't need very high or very low freqs, or use fixed freqs
  LFNoise1 is more efficient."}

      {:name "LFDNoise3"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Similar to LFNoise2, it generates polynomially interpolated random values
  at a rate given by the freq argument, with 3 differences:

  -no time quantization
  -fast recovery from low freq values
  -cubic instead of quadratic interpolation

  (LFNoise0,1,2 quantize to the nearest integer division of the samplerate
  and they poll the freq argument only when scheduled, and thus seem
  to hang when freqs get very low).
  If you don't need very high or very low freqs, or use fixed freqs
  LFNoise2 is more efficient."}

      {:name "LFDClipNoise"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar}
       :doc "Like LFClipNoise, it generates the values -1 or +1 at a rate given
  by the freq argument,  with two differences:

  -no time quantization
  -fast recovery from low freq values.

  (LFClipNoise, as well as LFNoise0,1,2 quantize to the nearest integer division
  of the samplerate, and they poll the freq argument only when scheduled;
  thus they often seem to hang when freqs get very low).

  If you don't need very high or very low freqs, or use fixed freqs
  LFNoise0 is more efficient."}

      {:name "Hasher"
       :args [{:name "in", :default 0.0}]
       :muladd true
       :rates #{:ar}
       :doc "Returns a unique output value from zero to one for each input value according to a hash function. The same input value will always produce the same output value. The input need not be from zero to one.
in - input signal"}

      {:name "MantissaMask"
       :args [{:name "in", :default 0.0}
              {:name "bits", :default 3}]
       :muladd true
       :rates #{:ar}
       :doc "Masks off bits in the mantissa of the floating point sample value. This introduces a quantization noise, but is less severe than linearly quantizing the signal.

  in - input signal
  bits - the number of mantissa bits to preserve. a number from 0 to 23."}

      {:name "Dust"
       :args [{:name "density", :default 0.0}]
       :muladd true
       :rates #{:ar}
       :doc "Generates random impulses from 0 to +1.
  density - average number of impulses per second."}

      {:name "Dust2"
       :args [{:name "density", :default 0.0}]
       :muladd true
       :rates #{:ar}
       :doc "Generates random impulses from -1 to +1.
  density - average number of impulses per second"}])

(ns overtone.core.ugen.noise)

(def specs
     [

      {:name "WhiteNoise"
       :args []
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates noise whose spectrum has equal power at all frequencies."}

      {:name "BrownNoise"
       :args []
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates noise whose spectrum falls off in power by 6 dB per octave."}

      {:name "PinkNoise"
       :args []
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates noise whose spectrum falls off in power by 3 dB per octave. This gives equal power over the span of each octave. This version gives 8 octaves of pink noise."}

      {:name "ClipNoise"
       :args []
       :muladd true
       :rates #{:ar}
       :doc "Generates noise whose values are either -1 or 1. This produces the maximum energy for the least peak to peak amplitude."}

      {:name "GrayNoise"
       :args []
       :muladd true
       :rates #{:ar}
       :doc "Generates random impulses from -1 to +1 given a density (average number of impulses per second)"}

      {:name "Crackle"
       :args [{:name "chaosParam", :default 1.5}]
       :muladd true
       :rates #{:ar :kr}
       :doc "A noise generator based on a chaotic function. The argument represents a parameter of the chaotic function with useful values from just below 1.0 to just above 2.0. Towards 2.0 the sound crackles."}

      {:name "Logistic"
       :args [{:name "chaos-param", :default 3.0}
              {:name "freq", :default 1000.0}
              {:name "init", :default 0.5}]
       :muladd true
       :rates #{:ar}
       :doc "A noise generator based on the logistic map:

  y = chaos-param * y * (1.0 - y)

  chaos-param - a parameter of the chaotic function with useful values from 0.0 to 4.0.
  Chaos occurs from 3.57 up. Don't use values outside this range if you don't want the UGen to blow up.
  freq - Frequency of calculation; if over the sampling rate, this is clamped to the sampling rate
  init - Initial value of y in the equation above

  y will stay in the range of 0.0 to 1.0 for normal values of the chaos-param. This leads to a DC offset
  and may cause a pop when you stop the Synth. For output you might want to combine this UGen with a LeakDC
  or rescale around 0.0 via mul and add: see example below. "}

      {:name "LFNoise0"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates random values at a rate (the rate is not guaranteed but approximate)"}

      {:name "LFNoise1"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates linearly interpolated random values at the supplied rate (the rate is not guaranteed but approximate). "}

      {:name "LFNoise2"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Generates quadratically interpolated random values at the suplied rate (the rate is not guaranteed but approximate).

  Note: quadratic interpolation means that the noise values can occasionally extend beyond the normal range
  of +-1, if the freq varies in certain ways. If this is undesirable then you might like to clip2 the values
  or use a linearly-interpolating unit instead."}

      {:name "LFClipNoise"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar}
       :doc "Randomly generates the values -1 or +1 at a rate given by the nearest integer division of the sample rate by the freq argument. It is probably pretty hard on your speakers!"}

      {:name "LFDNoise0"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Like LFNoise0, it generates random values at a rate given
  by the freq argument,  with two differences:

  -no time quantization
  -fast recovery from low freq values.

  (LFNoise0,1,2 quantize to the nearest integer division of the samplerate
  and they poll the freq argument only when scheduled, and thus seem
  to hang when freqs get very low).

  If you don't need very high or very low freqs, or use fixed freqs
  LFNoise0 is more efficient."}

      {:name "LFDNoise1"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Like LFNoise1, it generates linearly interpolated random values
  at a rate given by the freq argument, with two differences:

  -no time quantization
  -fast recovery from low freq values.

  (LFNoise0,1,2 quantize to the nearest integer division of the samplerate
  and they poll the freq argument only when scheduled, and thus seem
  to hang when freqs get very low).

  If you don't need very high or very low freqs, or use fixed freqs
  LFNoise1 is more efficient."}

      {:name "LFDNoise3"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar :kr}
       :doc "Similar to LFNoise2, it generates polynomially interpolated random values
  at a rate given by the freq argument, with 3 differences:

  -no time quantization
  -fast recovery from low freq values
  -cubic instead of quadratic interpolation

  (LFNoise0,1,2 quantize to the nearest integer division of the samplerate
  and they poll the freq argument only when scheduled, and thus seem
  to hang when freqs get very low).
  If you don't need very high or very low freqs, or use fixed freqs
  LFNoise2 is more efficient."}

      {:name "LFDClipNoise"
       :args [{:name "freq", :default 500.0}]
       :muladd true
       :rates #{:ar}
       :doc "Like LFClipNoise, it generates the values -1 or +1 at a rate given
  by the freq argument,  with two differences:

  -no time quantization
  -fast recovery from low freq values.

  (LFClipNoise, as well as LFNoise0,1,2 quantize to the nearest integer division
  of the samplerate, and they poll the freq argument only when scheduled;
  thus they often seem to hang when freqs get very low).

  If you don't need very high or very low freqs, or use fixed freqs
  LFNoise0 is more efficient."}

      {:name "Hasher"
       :args [{:name "in", :default 0.0}]
       :muladd true
       :rates #{:ar}
       :doc "Returns a unique output value from zero to one for each input value according to a hash function. The same input value will always produce the same output value. The input need not be from zero to one.
in - input signal"}

      {:name "MantissaMask"
       :args [{:name "in", :default 0.0}
              {:name "bits", :default 3}]
       :muladd true
       :rates #{:ar}
       :doc "Masks off bits in the mantissa of the floating point sample value. This introduces a quantization noise, but is less severe than linearly quantizing the signal.

  in - input signal
  bits - the number of mantissa bits to preserve. a number from 0 to 23."}

      {:name "Dust"
       :args [{:name "density", :default 0.0}]
       :muladd true
       :rates #{:ar}
       :doc "Generates random impulses from 0 to +1.
  density - average number of impulses per second."}

      {:name "Dust2"
       :args [{:name "density", :default 0.0}]
       :muladd true
       :rates #{:ar}
       :doc "Generates random impulses from -1 to +1.
  density - average number of impulses per second"}])

remove unecessary ]

remove unecessary ]


(ns pc.http.issues
  (:require [clojure.tools.logging :as log]
            [datomic.api :as d]
            [pc.datomic :as pcd]
            [pc.models.cust :as cust-model]
            [pc.models.issue :as issue-model]
            [pc.http.datomic2 :as datomic2])
  (:import [java.util UUID]))

(defonce issue-subs (atom #{}))

(defn subscribe [{:keys [client-id ?data ?reply-fn] :as req}]
  (swap! issue-subs conj client-id)
  (let [issues (map issue-model/read-api (issue-model/all-issues (:db req)))]
    (?reply-fn {:entities issues
                :entity-type :issue})))

(defn unsubscribe [client-id]
  (swap! issue-subs disj client-id))

(defn handle-transaction [{:keys [client-id ?data ?reply-fn] :as req}]
  (if-let [cust (some-> req :ring-req :auth :cust)]
    (let [datoms (->> ?data
                   :datoms
                   (remove (comp nil? :v)))
          _ (def myd datoms)
          ;; note that these aren't all of the rejected datoms, just the ones not on the whitelist
          rejects (remove (comp datomic2/issue-whitelisted?
                                pcd/datom->transaction)
                          datoms)]
      (log/infof "transacting %s datoms (minus %s rejects) on %s"
                 (count datoms) (count rejects) client-id)
      (datomic2/transact-issue! datoms
                                {:client-id client-id
                                 :cust cust
                                 :session-uuid (UUID/fromString (get-in req [:ring-req :session :sente-id]))
                                 :timestamp (:receive-instant req)})
      (when ?reply-fn
        (?reply-fn {:rejected-datoms rejects})))
    (comment "Handle logged out users")))

(defn set-status [{:keys [client-id ?data ?reply-fn] :as req}]
  (let [cust (some-> req :ring-req :auth :cust)]
    (when (contains? cust-model/admin-emails (:cust/email cust))
      (let [issue-uuid (:frontend/issue-id ?data)
            status (:issue/status ?data)]
        (assert (= "issue.status" (namespace status)))
        @(d/transact (pcd/conn) [{:db/id (d/tempid :db.part/tx)
                                  :transaction/broadcast true
                                  :transaction/issue-tx? true
                                  :cust/uuid (:cust/uuid cust)}
                                 {:frontend/issue-id issue-uuid
                                  :db/id (d/tempid :db.part/user)
                                  :issue/status status}])))))

(ns pc.http.issues
  (:require [clojure.tools.logging :as log]
            [datomic.api :as d]
            [pc.datomic :as pcd]
            [pc.models.cust :as cust-model]
            [pc.models.issue :as issue-model]
            [pc.http.sente.common :as sente-common]
            [pc.http.datomic2 :as datomic2])
  (:import [java.util UUID]))

(defonce issue-subs (atom #{}))

(defn subscribe [{:keys [client-id ?data ?reply-fn] :as req}]
  (swap! issue-subs conj client-id)
  (let [issues (map issue-model/read-api (issue-model/all-issues (:db req)))]
    (sente-common/send-reply req {:entities issues
                                  :entity-type :issue})))

(defn unsubscribe [client-id]
  (swap! issue-subs disj client-id))

(defn handle-transaction [{:keys [client-id ?data ?reply-fn] :as req}]
  (if-let [cust (some-> req :ring-req :auth :cust)]
    (let [datoms (->> ?data
                   :datoms
                   (remove (comp nil? :v)))
          _ (def myd datoms)
          ;; note that these aren't all of the rejected datoms, just the ones not on the whitelist
          rejects (remove (comp datomic2/issue-whitelisted?
                                pcd/datom->transaction)
                          datoms)]
      (log/infof "transacting %s datoms (minus %s rejects) on %s"
                 (count datoms) (count rejects) client-id)
      (datomic2/transact-issue! datoms
                                {:client-id client-id
                                 :cust cust
                                 :session-uuid (UUID/fromString (get-in req [:ring-req :session :sente-id]))
                                 :timestamp (:receive-instant req)})
      (sente-common/send-reply req {:rejected-datoms rejects}))
    (comment "Handle logged out users")))

(defn set-status [{:keys [client-id ?data ?reply-fn] :as req}]
  (let [cust (some-> req :ring-req :auth :cust)]
    (when (contains? cust-model/admin-emails (:cust/email cust))
      (let [issue-uuid (:frontend/issue-id ?data)
            status (:issue/status ?data)]
        (assert (= "issue.status" (namespace status)))
        @(d/transact (pcd/conn) [{:db/id (d/tempid :db.part/tx)
                                  :transaction/broadcast true
                                  :transaction/issue-tx? true
                                  :cust/uuid (:cust/uuid cust)}
                                 {:frontend/issue-id issue-uuid
                                  :db/id (d/tempid :db.part/user)
                                  :issue/status status}])))))

make issues work with talaria

make issues work with talaria


(ns pc.views.admin
  (:require [clj-time.core :as time]
            [datomic.api :as d]
            [hiccup.core :as h]
            [pc.datomic :as pcd]
            [pc.early-access]
            [pc.http.urls :as urls]
            [pc.models.cust :as cust-model]
            [ring.util.anti-forgery :as anti-forgery]))

(defn count-users [db time]
  (count (seq (d/datoms (d/as-of db (clj-time.coerce/to-date time))
                        :avet
                        :cust/email))))

(defn users-graph []
  (let [db (pcd/default-db)
        now (time/now)
        ;; day we got our first user!
        earliest (time/date-time 2014 11 9)
        times (take-while #(time/before? % (time/plus now (time/days 1)))
                          (iterate #(clj-time.core/plus % (clj-time.core/days 1))
                                   earliest))

        user-counts (map (partial count-users db) times)
        users-per-day (map (fn [a b] (- b a)) (cons 0 user-counts) user-counts)
        width 1000
        height 500
        x-tick-width (/ 1000 (count times))

        max-users-per-day (apply max users-per-day)
        y-tick-width (/ 500 max-users-per-day)

        max-users (apply max user-counts)
        y-cumulative-tick-width (/ 500 max-users)
        padding 20]
    (list
     [:svg {:width 1200 :height 600}
      [:rect {:x 20 :y 20 :width 1000 :height 500
              :fill "none" :stroke "black"}]
      (for [i (range 0 (inc 500) 25)]
        (list
         [:line {:x1 padding :y1 (+ padding i)
                 :x2 (+ padding 1000) :y2 (+ padding i)
                 :strokeWidth 1 :stroke "black"}]
         [:text {:x (+ (* 1.5 padding) 1000) :y (+ padding i)}
          (- max-users-per-day (int (* i (/ max-users-per-day 500))))]))
      (map-indexed (fn [i user-count]
                     [:circle {:cx (+ padding (* x-tick-width i))
                               :cy (+ padding (- 500 (* y-tick-width user-count)))
                               :r 5
                               :fill "blue"}])
                   users-per-day)]
     [:svg {:width 1200 :height 600}
      [:rect {:x 20 :y 20 :width 1000 :height 500
              :fill "none" :stroke "black"}]
      (for [i (range 0 (inc 500) 25)]
        (list
         [:line {:x1 padding :y1 (+ padding i)
                 :x2 (+ padding 1000) :y2 (+ padding i)
                 :strokeWidth 1 :stroke "black"}]
         [:text {:x (+ (* 1.5 padding) 1000) :y (+ padding i)}
          (- max-users (int (* i (/ max-users 500))))]))
      (map-indexed (fn [i user-count]
                     [:circle {:cx (+ padding (* x-tick-width i))
                               :cy (+ padding (- 500 (* y-cumulative-tick-width user-count)))
                               :r 5
                               :fill "blue"}])
                   user-counts)])))

(defn early-access-users []
  (let [db (pcd/default-db)
        requested (d/q '{:find [[?t ...]]
                         :where [[?t :flags :flags/requested-early-access]]}
                       db)
        granted (set (d/q '{:find [[?t ...]]
                            :where [[?t :flags :flags/private-docs]]}
                          db))
        not-granted (remove #(contains? granted %) requested)]
    (list
     [:style "td, th { padding: 5px; text-align: left }"]
     (if-not (seq not-granted)
       [:h4 "No users that requested early access, but don't have it."]
       (list
        [:p (str (count not-granted) " pending:")
         [:table {:border 1}
          [:tr
           [:th "Email"]
           [:th "Name"]
           [:th "Company"]
           [:th "Employee Count"]
           [:th "Use Case"]
           [:th "Grant Access (can't be undone without a repl!)"]]
          (for [cust-id (sort not-granted)
                :let [cust (cust-model/find-by-id db cust-id)
                      req (first (pc.early-access/find-by-cust db cust))]]
            [:tr
             [:td (:cust/email cust)]
             [:td (or (:cust/name cust)
                      (:cust/first-name cust))]
             [:td (:early-access-request/company-name req)]
             [:td (:early-access-request/employee-count req)]
             [:td (:early-access-request/use-case req)]
             [:td [:form {:action "/grant-early-access" :method "post"}
                   (anti-forgery/anti-forgery-field)
                   [:input {:type "hidden" :name "cust-uuid" :value (str (:cust/uuid cust))}]
                   [:input {:type "submit" :value "Grant early access"}]]]])]]))
     [:p (str (count granted) " granted:")
      [:table {:border 1}
       [:tr
        [:th "Email"]
        [:th "Name"]
        [:th "Company"]
        [:th "Employee Count"]
        [:th "Use Case"]]
       (for [cust-id (sort granted)
             :let [cust (cust-model/find-by-id db cust-id)
                   req (first (pc.early-access/find-by-cust db cust))]]
         [:tr
          [:td (:cust/email cust)]
          [:td (or (:cust/name cust)
                   (:cust/first-name cust))]
          [:td (:early-access-request/company-name req)]
          [:td (:early-access-request/employee-count req)]
          [:td (:early-access-request/use-case req)]])]])))

(defn format-runtime [ms]
  (let [h (int (Math/floor (/ ms (* 1000 60 60))))
        m (int (Math/floor (mod (/ ms 1000 60) 60)))
        s (int (Math/floor (mod (/ ms 1000) 60)))]
    (format "%s:%s:%s" h m s)))

(defn clients [client-stats document-subs]
  [:div
   [:form {:action "/refresh-client-stats" :method "post"}
    (anti-forgery/anti-forgery-field)
    [:input {:type "hidden" :name "refresh-all" :value true}]
    [:input {:type "submit" :value "Refresh all (don't do this too often)"}]]
   [:style "td, th { padding: 5px; text-align: left }"]
   [:table {:border 1}
    [:tr
     [:th "Document (subs)"]
     [:th "User"]
     [:th "Action"]
     [:th "Code version"]
     [:th "Chat #"]
     [:th "unread-chat #"]
     [:th "TX #"]
     [:th "layer count"]
     [:th "logged-in?"]
     [:th "run-time (h:m:s)"]
     [:th "subscriber-count"]
     [:th "visibility"]]
    (for [[client-id stats] (reverse (sort-by (comp :last-update second) client-stats))
          :let [doc-id (get-in stats [:document :db/id])]]
      [:tr
       [:td
        [:a {:href (urls/doc-svg doc-id)}
         [:img {:style "width:100;height:100;"
                :src (urls/doc-svg doc-id)}]]]
       [:td (get-in stats [:cust :cust/email])]
       [:td [:form {:action "/refresh-client-stats" :method "post"}
             (anti-forgery/anti-forgery-field)
             [:input {:type "hidden" :name "client-id" :value client-id}]
             [:input {:type "submit" :value "refresh"}]]]
       [:td (get-in stats [:stats :code-version])]
       [:td (get-in stats [:stats :chat-count])]
       [:td (get-in stats [:stats :unread-chat-count])]
       [:td (get-in stats [:stats :transaction-count])]
       [:td (get-in stats [:stats :layer-count])]
       [:td (get-in stats [:stats :logged-in?])]
       [:td (some-> (get-in stats [:stats :run-time-millis]) format-runtime)]
       [:td (count (get document-subs doc-id))]
       [:td (let [visibility (get-in stats [:stats :visibility])]
              (list visibility
                    (when (= "hidden" visibility)
                      [:form {:action "/refresh-client-browser" :method "post"}
                       (anti-forgery/anti-forgery-field)
                       [:input {:type "hidden" :name "client-id" :value client-id}]
                       [:input {:type "submit" :value "refresh browser"}]])))]])]])

(ns pc.views.admin
  (:require [clj-time.core :as time]
            [datomic.api :as d]
            [hiccup.core :as h]
            [pc.datomic :as pcd]
            [pc.early-access]
            [pc.http.urls :as urls]
            [pc.models.cust :as cust-model]
            [ring.util.anti-forgery :as anti-forgery]))

(defn count-users [db time]
  (count (seq (d/datoms (d/as-of db (clj-time.coerce/to-date time))
                        :avet
                        :cust/email))))

(defn users-graph []
  (let [db (pcd/default-db)
        now (time/now)
        ;; day we got our first user!
        earliest (time/from-time-zone (time/date-time 2014 11 9)
                                      (time/time-zone-for-id "America/Los_Angeles"))
        times (take-while #(time/before? % (time/plus now (time/days 1)))
                          (iterate #(clj-time.core/plus % (clj-time.core/days 1))
                                   earliest))

        user-counts (map (partial count-users db) times)
        users-per-day (map (fn [a b] (- b a)) (cons 0 user-counts) user-counts)
        width 1000
        height 500
        x-tick-width (/ 1000 (count times))

        max-users-per-day (apply max users-per-day)
        y-tick-width (/ 500 max-users-per-day)

        max-users (apply max user-counts)
        y-cumulative-tick-width (/ 500 max-users)
        padding 20]
    (list
     [:svg {:width 1200 :height 600}
      [:rect {:x 20 :y 20 :width 1000 :height 500
              :fill "none" :stroke "black"}]
      (for [i (range 0 (inc 500) 25)]
        (list
         [:line {:x1 padding :y1 (+ padding i)
                 :x2 (+ padding 1000) :y2 (+ padding i)
                 :strokeWidth 1 :stroke "black"}]
         [:text {:x (+ (* 1.5 padding) 1000) :y (+ padding i)}
          (- max-users-per-day (int (* i (/ max-users-per-day 500))))]))
      (map-indexed (fn [i user-count]
                     [:circle {:cx (+ padding (* x-tick-width i))
                               :cy (+ padding (- 500 (* y-tick-width user-count)))
                               :r 5
                               :fill "blue"}])
                   users-per-day)]
     [:svg {:width 1200 :height 600}
      [:rect {:x 20 :y 20 :width 1000 :height 500
              :fill "none" :stroke "black"}]
      (for [i (range 0 (inc 500) 25)]
        (list
         [:line {:x1 padding :y1 (+ padding i)
                 :x2 (+ padding 1000) :y2 (+ padding i)
                 :strokeWidth 1 :stroke "black"}]
         [:text {:x (+ (* 1.5 padding) 1000) :y (+ padding i)}
          (- max-users (int (* i (/ max-users 500))))]))
      (map-indexed (fn [i user-count]
                     [:circle {:cx (+ padding (* x-tick-width i))
                               :cy (+ padding (- 500 (* y-cumulative-tick-width user-count)))
                               :r 5
                               :fill "blue"}])
                   user-counts)])))

(defn early-access-users []
  (let [db (pcd/default-db)
        requested (d/q '{:find [[?t ...]]
                         :where [[?t :flags :flags/requested-early-access]]}
                       db)
        granted (set (d/q '{:find [[?t ...]]
                            :where [[?t :flags :flags/private-docs]]}
                          db))
        not-granted (remove #(contains? granted %) requested)]
    (list
     [:style "td, th { padding: 5px; text-align: left }"]
     (if-not (seq not-granted)
       [:h4 "No users that requested early access, but don't have it."]
       (list
        [:p (str (count not-granted) " pending:")
         [:table {:border 1}
          [:tr
           [:th "Email"]
           [:th "Name"]
           [:th "Company"]
           [:th "Employee Count"]
           [:th "Use Case"]
           [:th "Grant Access (can't be undone without a repl!)"]]
          (for [cust-id (sort not-granted)
                :let [cust (cust-model/find-by-id db cust-id)
                      req (first (pc.early-access/find-by-cust db cust))]]
            [:tr
             [:td (:cust/email cust)]
             [:td (or (:cust/name cust)
                      (:cust/first-name cust))]
             [:td (:early-access-request/company-name req)]
             [:td (:early-access-request/employee-count req)]
             [:td (:early-access-request/use-case req)]
             [:td [:form {:action "/grant-early-access" :method "post"}
                   (anti-forgery/anti-forgery-field)
                   [:input {:type "hidden" :name "cust-uuid" :value (str (:cust/uuid cust))}]
                   [:input {:type "submit" :value "Grant early access"}]]]])]]))
     [:p (str (count granted) " granted:")
      [:table {:border 1}
       [:tr
        [:th "Email"]
        [:th "Name"]
        [:th "Company"]
        [:th "Employee Count"]
        [:th "Use Case"]]
       (for [cust-id (sort granted)
             :let [cust (cust-model/find-by-id db cust-id)
                   req (first (pc.early-access/find-by-cust db cust))]]
         [:tr
          [:td (:cust/email cust)]
          [:td (or (:cust/name cust)
                   (:cust/first-name cust))]
          [:td (:early-access-request/company-name req)]
          [:td (:early-access-request/employee-count req)]
          [:td (:early-access-request/use-case req)]])]])))

(defn format-runtime [ms]
  (let [h (int (Math/floor (/ ms (* 1000 60 60))))
        m (int (Math/floor (mod (/ ms 1000 60) 60)))
        s (int (Math/floor (mod (/ ms 1000) 60)))]
    (format "%s:%s:%s" h m s)))

(defn clients [client-stats document-subs]
  [:div
   [:form {:action "/refresh-client-stats" :method "post"}
    (anti-forgery/anti-forgery-field)
    [:input {:type "hidden" :name "refresh-all" :value true}]
    [:input {:type "submit" :value "Refresh all (don't do this too often)"}]]
   [:style "td, th { padding: 5px; text-align: left }"]
   [:table {:border 1}
    [:tr
     [:th "Document (subs)"]
     [:th "User"]
     [:th "Action"]
     [:th "Code version"]
     [:th "Chat #"]
     [:th "unread-chat #"]
     [:th "TX #"]
     [:th "layer count"]
     [:th "logged-in?"]
     [:th "run-time (h:m:s)"]
     [:th "subscriber-count"]
     [:th "visibility"]]
    (for [[client-id stats] (reverse (sort-by (comp :last-update second) client-stats))
          :let [doc-id (get-in stats [:document :db/id])]]
      [:tr
       [:td
        [:a {:href (urls/doc-svg doc-id)}
         [:img {:style "width:100;height:100;"
                :src (urls/doc-svg doc-id)}]]]
       [:td (get-in stats [:cust :cust/email])]
       [:td [:form {:action "/refresh-client-stats" :method "post"}
             (anti-forgery/anti-forgery-field)
             [:input {:type "hidden" :name "client-id" :value client-id}]
             [:input {:type "submit" :value "refresh"}]]]
       [:td (get-in stats [:stats :code-version])]
       [:td (get-in stats [:stats :chat-count])]
       [:td (get-in stats [:stats :unread-chat-count])]
       [:td (get-in stats [:stats :transaction-count])]
       [:td (get-in stats [:stats :layer-count])]
       [:td (get-in stats [:stats :logged-in?])]
       [:td (some-> (get-in stats [:stats :run-time-millis]) format-runtime)]
       [:td (count (get document-subs doc-id))]
       [:td (let [visibility (get-in stats [:stats :visibility])]
              (list visibility
                    (when (= "hidden" visibility)
                      [:form {:action "/refresh-client-browser" :method "post"}
                       (anti-forgery/anti-forgery-field)
                       [:input {:type "hidden" :name "client-id" :value client-id}]
                       [:input {:type "submit" :value "refresh browser"}]])))]])]])

use pst for the graphs

use pst for the graphs