(ns asciinema.player.source
  (:refer-clojure :exclude [js->clj])
  (:require [cljs.core.async :refer [chan >! <! put! close! timeout poll!]]
            [goog.net.XhrIo :as xhr]
            [schema.core :as s]
            [asciinema.player.format.asciicast-v0 :as v0]
            [asciinema.player.format.asciicast-v1 :as v1]
            [asciinema.player.frames :as f]
            [asciinema.vt :as vt]
            [asciinema.player.messages :as m]
            [asciinema.player.util :as util]
            [asciinema.player.patch :refer [js->clj]])
  (:require-macros [cljs.core.async.macros :refer [go go-loop]]))

(defprotocol Source
  (init [this] "Initializes the source")
  (close [this] "Closes the source, stopping all processes and connections")
  (start [this] "Starts the playback")
  (stop [this] "Stops the playback")
  (toggle [this] "Toggles the playback on/off")
  (seek [this time] "Jumps to the given time")
  (change-speed [this speed] "Changes playback speed (1.0 is normal speed)"))

(defmulti make-source
  "Returns a Source instance for given type and args."
  (fn [url {:keys [type]}]
    (or type :asciicast)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmulti initialize-asciicast
  "Given fetched asciicast extracts width, height and frames into a map."
  (fn [asciicast]
    (if (vector? asciicast)
      0
      (:version asciicast))))

(defmethod initialize-asciicast 0 [asciicast]
  (v0/initialize-asciicast asciicast))

(defmethod initialize-asciicast 1 [asciicast]
  (v1/initialize-asciicast asciicast))

(defmethod initialize-asciicast :default [asciicast]
  (throw (str "unsupported asciicast version: " (:version asciicast))))

(defn time-frames
  "Returns infinite seq of time frames."
  []
  (let [interval (/ 1 3)]
    (map (fn [n]
           (let [t (* interval n)]
             (f/frame t t)))
         (range))))

(defn screen-at
  "Returns screen state (lines + cursor) at given time (in seconds)."
  [seconds screen-frames]
  (last (f/frame-at seconds screen-frames)))

(defn lazy-promise-chan
  "Returns a function f returning a promise channel. The calculation of the
  promise value is triggered by calling f with truthy value."
  ;; TODO simplify it with async/promise-chan when it gets fixed (http://dev.clojure.org/jira/browse/ASYNC-159)
  [f]
  (let [force-ch (chan)
        ready-chan (chan)
        value (atom nil)]
    (go
      (<! force-ch)
      (f (fn [v]
           (reset! value v)
           (close! ready-chan))))
    (fn [force?]
      (when force?
        (close! force-ch))
      (let [value-ch (chan)]
        (go
          (<! ready-chan)
          (>! value-ch @value))
        value-ch))))

(defn make-recording-ch-fn [url recording-fn]
  (lazy-promise-chan
   (fn [deliver]
     (xhr/send url (fn [event]
                     (let [res (-> event .-target .getResponseText)]
                       (deliver (recording-fn res))))))))

(defn report-metadata
  "Waits for recording to load and then reports its size and duration to the
  player."
  [{:keys [recording-ch-fn]} msg-ch]
  (go
    (let [{:keys [duration width height]} (<! (@recording-ch-fn false))]
      (>! msg-ch (m/->SetMetadata width height duration))
      (>! msg-ch (m/->TriggerCanPlay)))))

(defn show-poster
  "Forces loading of recording and sends 'poster' at a given time to the
  player."
  [{:keys [recording-ch-fn]} time msg-ch]
  (go
    (let [{:keys [frames]} (<! (@recording-ch-fn true))]
      (>! msg-ch (m/->UpdateScreen (screen-at time frames))))))

(defn show-loading
  "Reports 'loading' to the player until the recording is loaded."
  [{:keys [recording-ch-fn]} msg-ch]
  (when-not (poll! (@recording-ch-fn false))
    (go
      (>! msg-ch (m/->SetLoading true))
      (<! (@recording-ch-fn false))
      (>! msg-ch (m/->SetLoading false)))))

(defn emit-coll
  "Starts sending frames as events with a given name, stopping when stop-ch
  closes."
  [coll]
  (let [out-ch (chan)]
    (go
      (let [elapsed-time (util/timer)]
        (loop [coll coll
               wall-time (elapsed-time)]
          (if-let [[time data] (first coll)]
            (let [ahead (- time wall-time)]
              (if (pos? ahead)
                (let [timeout-ch (timeout (* 1000 ahead))]
                  (<! timeout-ch)
                  (when (>! out-ch data)
                    (recur (rest coll) (elapsed-time))))
                (when (>! out-ch data)
                  (recur (rest coll) wall-time))))
            (close! out-ch)))))
    out-ch))

(defn play-frames [msg-ch frames start-at speed loop? stop-ch]
  (go
    (loop [start-at start-at
           sub-ch (emit-coll (f/frames-for-playback start-at speed frames))
           elapsed-time (util/timer speed)]
      (let [[v c] (alts! [sub-ch stop-ch])]
        (condp = c
          sub-ch (if v
                   (do
                     (>! msg-ch v)
                     (recur start-at sub-ch elapsed-time))
                   (if loop?
                     (recur 0 (emit-coll (f/frames-for-playback 0 speed frames)) (util/timer speed))
                     nil))
          stop-ch (do
                    (close! sub-ch)
                    (+ start-at (elapsed-time))))))))

(defn play!
  "Starts emitting :time and :frame events with given start position and speed.
  Stops when stop-ch closes. Returns a channel to which stop position is
  eventually delivered."
  [msg-ch frames duration start-at speed loop? stop-ch]
  (go
    (>! msg-ch (m/->SetPlaying true))
    (>! msg-ch (m/->UpdateTime start-at))
    (>! msg-ch (m/->UpdateScreen (screen-at start-at frames)))
    (let [screen-frames (f/map-frame-data m/->UpdateScreen frames)
          time-frames (f/map-frame-data m/->UpdateTime (time-frames))
          frames (f/interleave-frames screen-frames time-frames)
          stopped-at (<! (play-frames msg-ch frames start-at speed loop? stop-ch))]
      (>! msg-ch (m/->UpdateTime (or stopped-at duration)))
      (>! msg-ch (m/->SetPlaying false))
      stopped-at)))

(defn start-event-loop!
  "Main event loop of the Recording."
  [{:keys [recording-ch-fn start-at speed loop?] :as source} command-ch msg-ch]
  (let [pri-ch (chan 10)]
    (go-loop [start-at start-at
              speed speed
              end-ch nil
              stop-ch nil]
      (let [ports (remove nil? [pri-ch command-ch end-ch])
            [v c] (alts! ports :priority true)
            [command arg] (if (= c end-ch) [:internal/rewind v] v)]
        (condp = command
          :start (if stop-ch
                   (recur start-at speed end-ch stop-ch)
                   (do
                     (show-loading source msg-ch)
                     (let [{:keys [frames duration]} (<! (@recording-ch-fn true))
                           stop-ch (chan)
                           end-ch (play! msg-ch frames duration start-at speed loop? stop-ch)]
                       (recur nil speed end-ch stop-ch))))
          :stop (if stop-ch
                  (do
                    (close! stop-ch)
                    (recur (<! end-ch) speed nil nil))
                  (recur start-at speed end-ch stop-ch))
          :toggle (let [command (if stop-ch :stop :start)]
                    (>! pri-ch [command])
                    (recur start-at speed end-ch stop-ch))
          :seek (let [new-start-at arg]
                  (when stop-ch
                    (>! pri-ch [:stop]))
                  (>! pri-ch [:internal/seek new-start-at])
                  (when stop-ch
                    (>! pri-ch [:start]))
                  (recur start-at speed end-ch stop-ch))
          :change-speed (let [new-speed arg]
                          (when stop-ch
                            (>! pri-ch [:stop])
                            (>! pri-ch [:start]))
                          (recur start-at new-speed end-ch stop-ch))
          :exit nil
          :internal/rewind (recur 0 speed nil nil)
          :internal/seek (let [start-at arg
                               {:keys [frames duration]} (<! (@recording-ch-fn true))
                               start-at (util/adjust-to-range start-at 0 duration)]
                           (>! msg-ch (m/->UpdateTime start-at))
                           (>! msg-ch (m/->UpdateScreen (screen-at start-at frames)))
                           (recur start-at speed end-ch stop-ch)))))))

(defrecord Recording [recording-ch-fn command-ch start-at speed auto-play? loop? preload? poster-time]
  Source
  (init [this]
    (let [msg-ch (chan)]
      (start-event-loop! this command-ch msg-ch)
      (report-metadata this msg-ch)
      (when preload?
        (@recording-ch-fn true))
      (if auto-play?
        (start this)
        (when poster-time
          (show-poster this poster-time msg-ch)))
      msg-ch))
  (close [this]
    (put! command-ch [:stop])
    (put! command-ch [:exit]))
  (start [this]
    (put! command-ch [:start]))
  (stop [this]
    (put! command-ch [:stop]))
  (toggle [this]
    (put! command-ch [:toggle]))
  (seek [this time]
    (put! command-ch [:seek time]))
  (change-speed [this speed]
    (put! command-ch [:change-speed speed])))

(defmethod make-source :asciicast [url {:keys [start-at speed auto-play loop preload poster-time]}]
  (let [recording-ch-fn (make-recording-ch-fn url (fn [json]
                                                    (-> json
                                                        js/JSON.parse
                                                        (js->clj :keywordize-keys true)
                                                        initialize-asciicast)))
        command-ch (chan 10)]
    (->Recording (atom recording-ch-fn)
                 command-ch
                 start-at
                 speed
                 auto-play
                 loop
                 preload
                 poster-time)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn vts! [width height msg-ch]
  (let [stdout-ch (chan)]
    (go-loop [vt (vt/make-vt width height)]
      (when-let [stdout (<! stdout-ch)]
        (let [new-vt (vt/feed-str vt stdout)]
          (>! msg-ch (m/->UpdateScreen new-vt))
          (recur new-vt))))
    stdout-ch))

(defn start-random-stdout-gen! [msg-ch stdout-ch speed stop-ch]
  (go
    (>! msg-ch (m/->SetPlaying true))
    (loop []
      (let [[v c] (alts! [stop-ch (timeout (/ (* 100 (rand)) speed))])]
        (when-not (= c stop-ch)
          (>! stdout-ch (js/String.fromCharCode (rand-int 0xa0)))
          (recur))))
    (>! msg-ch (m/->SetPlaying false))))

(defrecord JunkPrinter [speed auto-play? width height msg-ch stdout-ch stop-ch]
  Source
  (init [this]
    (reset! msg-ch (chan))
    (reset! stdout-ch (vts! width height @msg-ch))
    (when auto-play?
      (start this))
    @msg-ch)
  (close [this]
    (stop this))
  (start [this]
    (when-not @stop-ch
      (let [command-ch (chan)]
        (reset! stop-ch command-ch)
        (start-random-stdout-gen! @msg-ch @stdout-ch speed command-ch))))
  (stop [this]
    (when @stop-ch
      (close! @stop-ch)
      (reset! stop-ch nil)))
  (toggle [this]
    (if @stop-ch
      (stop this)
      (start this)))
  (seek [this position]
    nil)
  (change-speed [this speed]
    nil))

(defmethod make-source :random [_ {:keys [url width height speed auto-play]}]
  (->JunkPrinter speed auto-play width height (atom nil) (atom nil) (atom nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn es-message [payload]
  (js->clj (.parse js/JSON payload) :keywordize-keys true))

(defn process-es-messages! [es-ch msg-ch]
  (go
    (let [{:keys [time width height stdout]} (<! es-ch)
          stdout-ch (vts! width height msg-ch)]
      (>! stdout-ch stdout)
      (loop []
        (when-let [{:keys [stdout]} (<! es-ch)]
          (>! stdout-ch stdout)
          (recur))))))

(defn start-event-source! [url msg-ch]
  (let [es (js/EventSource. url)
        es-ch (atom nil)]
    (put! msg-ch (m/->SetLoading true))
    (set! (.-onopen es) (fn []
                          (let [command-ch (chan 10000 (map es-message))] ; 10000 to make enough buffer for very fast es producers
                            (reset! es-ch command-ch)
                            (process-es-messages! command-ch msg-ch)
                            (put! msg-ch (m/->SetPlaying true))
                            (put! msg-ch (m/->SetLoading false)))))
    (set! (.-onerror es) (fn [err]
                           (close! @es-ch)
                           (reset! es-ch nil)
                           (put! msg-ch (m/->SetLoading true))))
    (set! (.-onmessage es) (fn [event]
                             (when-let [command-ch @es-ch]
                               (put! command-ch (.-data event)))))))

(defrecord Stream [msg-ch url auto-play? started?]
  Source
  (init [this]
    (reset! msg-ch (chan))
    (when auto-play?
      (start this)))
  (close [this]
    (stop this)) ; TODO disconnect ES
  (start [this]
    (when-not @started?
      (reset! started? true)
      (start-event-source! url @msg-ch)))
  (stop [this]
    nil)
  (toggle [this]
    (start this))
  (seek [this position]
    nil)
  (change-speed [this speed]
    nil))

(defmethod make-source :stream [url {:keys [auto-play]}]
  (->Stream (atom nil) url auto-play (atom false)))

(ns asciinema.player.source
  (:refer-clojure :exclude [js->clj])
  (:require [cljs.core.async :refer [chan >! <! put! close! timeout poll!]]
            [goog.net.XhrIo :as xhr]
            [schema.core :as s]
            [asciinema.player.format.asciicast-v0 :as v0]
            [asciinema.player.format.asciicast-v1 :as v1]
            [asciinema.player.frames :as f]
            [asciinema.vt :as vt]
            [asciinema.player.messages :as m]
            [asciinema.player.util :as util]
            [asciinema.player.patch :refer [js->clj]])
  (:require-macros [cljs.core.async.macros :refer [go go-loop]]))

(defprotocol Source
  (init [this] "Initializes the source")
  (close [this] "Closes the source, stopping all processes and connections")
  (start [this] "Starts the playback")
  (stop [this] "Stops the playback")
  (toggle [this] "Toggles the playback on/off")
  (seek [this time] "Jumps to the given time")
  (change-speed [this speed] "Changes playback speed (1.0 is normal speed)"))

(defmulti make-source
  "Returns a Source instance for given type and args."
  (fn [url {:keys [type]}]
    (or type :asciicast)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmulti initialize-asciicast
  "Given fetched asciicast extracts width, height and frames into a map."
  (fn [asciicast]
    (if (vector? asciicast)
      0
      (:version asciicast))))

(defmethod initialize-asciicast 0 [asciicast]
  (v0/initialize-asciicast asciicast))

(defmethod initialize-asciicast 1 [asciicast]
  (v1/initialize-asciicast asciicast))

(defmethod initialize-asciicast :default [asciicast]
  (throw (str "unsupported asciicast version: " (:version asciicast))))

(defn time-frames
  "Returns infinite seq of time frames."
  []
  (let [interval (/ 1 3)]
    (map (fn [n]
           (let [t (* interval n)]
             (f/frame t t)))
         (range))))

(defn screen-at
  "Returns screen state (lines + cursor) at given time (in seconds)."
  [seconds screen-frames]
  (last (f/frame-at seconds screen-frames)))

(defn lazy-promise-chan
  "Returns a function f returning a promise channel. The calculation of the
  promise value is triggered by calling f with truthy value."
  ;; TODO simplify it with async/promise-chan when it gets fixed (http://dev.clojure.org/jira/browse/ASYNC-159)
  [f]
  (let [force-ch (chan)
        ready-chan (chan)
        value (atom nil)]
    (go
      (<! force-ch)
      (f (fn [v]
           (reset! value v)
           (close! ready-chan))))
    (fn [force?]
      (when force?
        (close! force-ch))
      (let [value-ch (chan)]
        (go
          (<! ready-chan)
          (>! value-ch @value))
        value-ch))))

(defn make-recording-ch-fn [url recording-fn]
  (lazy-promise-chan
   (fn [deliver]
     (xhr/send url (fn [event]
                     (let [res (-> event .-target .getResponseText)]
                       (deliver (recording-fn res))))))))

(defn report-metadata
  "Waits for recording to load and then reports its size and duration to the
  player."
  [{:keys [recording-ch-fn]} msg-ch]
  (go
    (let [{:keys [duration width height]} (<! (@recording-ch-fn false))]
      (>! msg-ch (m/->SetMetadata width height duration))
      (>! msg-ch (m/->TriggerCanPlay)))))

(defn show-poster
  "Forces loading of recording and sends 'poster' at a given time to the
  player."
  [{:keys [recording-ch-fn]} time msg-ch]
  (go
    (let [{:keys [frames]} (<! (@recording-ch-fn true))]
      (>! msg-ch (m/->UpdateScreen (screen-at time frames))))))

(defn show-loading
  "Reports 'loading' to the player until the recording is loaded."
  [{:keys [recording-ch-fn]} msg-ch]
  (when-not (poll! (@recording-ch-fn false))
    (go
      (>! msg-ch (m/->SetLoading true))
      (<! (@recording-ch-fn false))
      (>! msg-ch (m/->SetLoading false)))))

(defn emit-coll
  "Starts sending frames as events with a given name, stopping when out-ch
  closes."
  [coll]
  (let [out-ch (chan)]
    (go
      (let [elapsed-time (util/timer)]
        (loop [coll coll
               wall-time (elapsed-time)]
          (if-let [[time data] (first coll)]
            (let [ahead (- time wall-time)]
              (if (pos? ahead)
                (let [timeout-ch (timeout (* 1000 ahead))]
                  (<! timeout-ch)
                  (when (>! out-ch data)
                    (recur (rest coll) (elapsed-time))))
                (when (>! out-ch data)
                  (recur (rest coll) wall-time))))
            (close! out-ch)))))
    out-ch))

(defn play-frames [msg-ch frames start-at speed loop? stop-ch]
  (go
    (loop [start-at start-at
           sub-ch (emit-coll (f/frames-for-playback start-at speed frames))
           elapsed-time (util/timer speed)]
      (let [[v c] (alts! [sub-ch stop-ch])]
        (condp = c
          sub-ch (if v
                   (do
                     (>! msg-ch v)
                     (recur start-at sub-ch elapsed-time))
                   (if loop?
                     (recur 0 (emit-coll (f/frames-for-playback 0 speed frames)) (util/timer speed))
                     nil))
          stop-ch (do
                    (close! sub-ch)
                    (+ start-at (elapsed-time))))))))

(defn play!
  "Starts emitting :time and :frame events with given start position and speed.
  Stops when stop-ch closes. Returns a channel to which stop position is
  eventually delivered."
  [msg-ch frames duration start-at speed loop? stop-ch]
  (go
    (>! msg-ch (m/->SetPlaying true))
    (>! msg-ch (m/->UpdateTime start-at))
    (>! msg-ch (m/->UpdateScreen (screen-at start-at frames)))
    (let [screen-frames (f/map-frame-data m/->UpdateScreen frames)
          time-frames (f/map-frame-data m/->UpdateTime (time-frames))
          frames (f/interleave-frames screen-frames time-frames)
          stopped-at (<! (play-frames msg-ch frames start-at speed loop? stop-ch))]
      (>! msg-ch (m/->UpdateTime (or stopped-at duration)))
      (>! msg-ch (m/->SetPlaying false))
      stopped-at)))

(defn start-event-loop!
  "Main event loop of the Recording."
  [{:keys [recording-ch-fn start-at speed loop?] :as source} command-ch msg-ch]
  (let [pri-ch (chan 10)]
    (go-loop [start-at start-at
              speed speed
              end-ch nil
              stop-ch nil]
      (let [ports (remove nil? [pri-ch command-ch end-ch])
            [v c] (alts! ports :priority true)
            [command arg] (if (= c end-ch) [:internal/rewind v] v)]
        (condp = command
          :start (if stop-ch
                   (recur start-at speed end-ch stop-ch)
                   (do
                     (show-loading source msg-ch)
                     (let [{:keys [frames duration]} (<! (@recording-ch-fn true))
                           stop-ch (chan)
                           end-ch (play! msg-ch frames duration start-at speed loop? stop-ch)]
                       (recur nil speed end-ch stop-ch))))
          :stop (if stop-ch
                  (do
                    (close! stop-ch)
                    (recur (<! end-ch) speed nil nil))
                  (recur start-at speed end-ch stop-ch))
          :toggle (let [command (if stop-ch :stop :start)]
                    (>! pri-ch [command])
                    (recur start-at speed end-ch stop-ch))
          :seek (let [new-start-at arg]
                  (when stop-ch
                    (>! pri-ch [:stop]))
                  (>! pri-ch [:internal/seek new-start-at])
                  (when stop-ch
                    (>! pri-ch [:start]))
                  (recur start-at speed end-ch stop-ch))
          :change-speed (let [new-speed arg]
                          (when stop-ch
                            (>! pri-ch [:stop])
                            (>! pri-ch [:start]))
                          (recur start-at new-speed end-ch stop-ch))
          :exit nil
          :internal/rewind (recur 0 speed nil nil)
          :internal/seek (let [start-at arg
                               {:keys [frames duration]} (<! (@recording-ch-fn true))
                               start-at (util/adjust-to-range start-at 0 duration)]
                           (>! msg-ch (m/->UpdateTime start-at))
                           (>! msg-ch (m/->UpdateScreen (screen-at start-at frames)))
                           (recur start-at speed end-ch stop-ch)))))))

(defrecord Recording [recording-ch-fn command-ch start-at speed auto-play? loop? preload? poster-time]
  Source
  (init [this]
    (let [msg-ch (chan)]
      (start-event-loop! this command-ch msg-ch)
      (report-metadata this msg-ch)
      (when preload?
        (@recording-ch-fn true))
      (if auto-play?
        (start this)
        (when poster-time
          (show-poster this poster-time msg-ch)))
      msg-ch))
  (close [this]
    (put! command-ch [:stop])
    (put! command-ch [:exit]))
  (start [this]
    (put! command-ch [:start]))
  (stop [this]
    (put! command-ch [:stop]))
  (toggle [this]
    (put! command-ch [:toggle]))
  (seek [this time]
    (put! command-ch [:seek time]))
  (change-speed [this speed]
    (put! command-ch [:change-speed speed])))

(defmethod make-source :asciicast [url {:keys [start-at speed auto-play loop preload poster-time]}]
  (let [recording-ch-fn (make-recording-ch-fn url (fn [json]
                                                    (-> json
                                                        js/JSON.parse
                                                        (js->clj :keywordize-keys true)
                                                        initialize-asciicast)))
        command-ch (chan 10)]
    (->Recording (atom recording-ch-fn)
                 command-ch
                 start-at
                 speed
                 auto-play
                 loop
                 preload
                 poster-time)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn vts! [width height msg-ch]
  (let [stdout-ch (chan)]
    (go-loop [vt (vt/make-vt width height)]
      (when-let [stdout (<! stdout-ch)]
        (let [new-vt (vt/feed-str vt stdout)]
          (>! msg-ch (m/->UpdateScreen new-vt))
          (recur new-vt))))
    stdout-ch))

(defn start-random-stdout-gen! [msg-ch stdout-ch speed stop-ch]
  (go
    (>! msg-ch (m/->SetPlaying true))
    (loop []
      (let [[v c] (alts! [stop-ch (timeout (/ (* 100 (rand)) speed))])]
        (when-not (= c stop-ch)
          (>! stdout-ch (js/String.fromCharCode (rand-int 0xa0)))
          (recur))))
    (>! msg-ch (m/->SetPlaying false))))

(defrecord JunkPrinter [speed auto-play? width height msg-ch stdout-ch stop-ch]
  Source
  (init [this]
    (reset! msg-ch (chan))
    (reset! stdout-ch (vts! width height @msg-ch))
    (when auto-play?
      (start this))
    @msg-ch)
  (close [this]
    (stop this))
  (start [this]
    (when-not @stop-ch
      (let [command-ch (chan)]
        (reset! stop-ch command-ch)
        (start-random-stdout-gen! @msg-ch @stdout-ch speed command-ch))))
  (stop [this]
    (when @stop-ch
      (close! @stop-ch)
      (reset! stop-ch nil)))
  (toggle [this]
    (if @stop-ch
      (stop this)
      (start this)))
  (seek [this position]
    nil)
  (change-speed [this speed]
    nil))

(defmethod make-source :random [_ {:keys [url width height speed auto-play]}]
  (->JunkPrinter speed auto-play width height (atom nil) (atom nil) (atom nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn es-message [payload]
  (js->clj (.parse js/JSON payload) :keywordize-keys true))

(defn process-es-messages! [es-ch msg-ch]
  (go
    (let [{:keys [time width height stdout]} (<! es-ch)
          stdout-ch (vts! width height msg-ch)]
      (>! stdout-ch stdout)
      (loop []
        (when-let [{:keys [stdout]} (<! es-ch)]
          (>! stdout-ch stdout)
          (recur))))))

(defn start-event-source! [url msg-ch]
  (let [es (js/EventSource. url)
        es-ch (atom nil)]
    (put! msg-ch (m/->SetLoading true))
    (set! (.-onopen es) (fn []
                          (let [command-ch (chan 10000 (map es-message))] ; 10000 to make enough buffer for very fast es producers
                            (reset! es-ch command-ch)
                            (process-es-messages! command-ch msg-ch)
                            (put! msg-ch (m/->SetPlaying true))
                            (put! msg-ch (m/->SetLoading false)))))
    (set! (.-onerror es) (fn [err]
                           (close! @es-ch)
                           (reset! es-ch nil)
                           (put! msg-ch (m/->SetLoading true))))
    (set! (.-onmessage es) (fn [event]
                             (when-let [command-ch @es-ch]
                               (put! command-ch (.-data event)))))))

(defrecord Stream [msg-ch url auto-play? started?]
  Source
  (init [this]
    (reset! msg-ch (chan))
    (when auto-play?
      (start this)))
  (close [this]
    (stop this)) ; TODO disconnect ES
  (start [this]
    (when-not @started?
      (reset! started? true)
      (start-event-source! url @msg-ch)))
  (stop [this]
    nil)
  (toggle [this]
    (start this))
  (seek [this position]
    nil)
  (change-speed [this speed]
    nil))

(defmethod make-source :stream [url {:keys [auto-play]}]
  (->Stream (atom nil) url auto-play (atom false)))

Fix docstring

Fix docstring


(ns funcatron.sample.clojure.funcs-test
  (:require [clojure.test :refer :all]
            )
  (:import (funcatron.intf.impl ContextImpl)
           (java.util.logging Logger)
           (funcatron.sample.clojure SimpleGet PostOrDelete)
           (com.fasterxml.jackson.databind ObjectMapper)
           (funcatron.intf MetaResponse)))

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

(def ^ObjectMapper jackson (ObjectMapper.))

(ContextImpl/initContext
  {}
  (-> (fn [])
      .getClass
      .getClassLoader)
  (Logger/getAnonymousLogger))

(deftest simple-test
  (testing "Simple"
    (let [s (SimpleGet.)
          result (.apply s {} (ContextImpl. {} (Logger/getAnonymousLogger)))
          res-json (.writeValueAsString jackson result)]
      (is (instance? String res-json))
      (is (>= (.indexOf ^String res-json "bools") 0))
      )
    ))

(deftest Not_POST_DELETE_on_PostOrDelete
  (let [pod (PostOrDelete.)
        result (.apply pod nil (ContextImpl. {"parameters"     {"path" {"cnt" 42}}
                                              "request-method" "get"}
                                             (Logger/getAnonymousLogger)))]
    (is (instance? MetaResponse result))
    (is (= 400 (.getResponseCode ^MetaResponse result)))
    ))

(deftest DELETE_on_PostOrDelete
  (let [pod (PostOrDelete.)
        result (.apply pod nil (ContextImpl. {"parameters"     {"path" {"cnt" 45}}
                                              "request-method" "delete"}
                                             (Logger/getAnonymousLogger)))
        res-json (.writeValueAsString jackson result)]
    (is (contains? result "name"))
    (is (contains? result "age"))
    (is (= 45 (result "age")))
    (is (string? res-json))
    )
  )

(deftest POST_on_PostOrDelete
  (let [pod (PostOrDelete.)
        result (.apply pod {"name" "David" "age" 33}
                       (ContextImpl. {"parameters"     {"path" {"cnt" 3}}
                                      "request-method" "post"}
                                     (Logger/getAnonymousLogger)))
        res-json (.writeValueAsString jackson result)]

    (is (sequential? result))
    (is (= 3 (count result)))
    (is (contains? (get result 0) "age"))
    (is (= 34 (get-in result [0 "age"])))
    (is (string? res-json))
    )
  )

(ns funcatron.sample.clojure.funcs-test
  (:require [clojure.test :refer :all]
            [funcatron.sample.clojure.funcs :refer :all])
  (:import (funcatron.intf.impl ContextImpl)
           (java.util.logging Logger)
           (com.fasterxml.jackson.databind ObjectMapper)
           (funcatron.intf MetaResponse)))

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

(def ^ObjectMapper jackson (ObjectMapper.))

(ContextImpl/initContext
  {}
  (-> (fn [])
      .getClass
      .getClassLoader)
  (Logger/getAnonymousLogger))

(deftest simple-test
  (testing "Simple"
    (let [result (simple_get {} (ContextImpl. {} (Logger/getAnonymousLogger)))
          res-json (.writeValueAsString jackson result)]
      (is (instance? String res-json))
      (is (>= (.indexOf ^String res-json "bools") 0))
      )
    ))

(deftest Not_POST_DELETE_on_post_or_delete
  (let [result (post_or_delete nil (ContextImpl. {"parameters"     {"path" {"cnt" 42}}
                                                  "request-method" "get"}
                                                 (Logger/getAnonymousLogger)))]
    (is (instance? MetaResponse result))
    (is (= 400 (.getResponseCode ^MetaResponse result)))
    ))

(deftest DELETE_on_post_or_delete
  (let [result (post_or_delete nil (ContextImpl. {"parameters"     {"path" {"cnt" 45}}
                                                  "request-method" "delete"}
                                                 (Logger/getAnonymousLogger)))
        res-json (.writeValueAsString jackson result)]
    (is (contains? result "name"))
    (is (contains? result "age"))
    (is (= 45 (result "age")))
    (is (string? res-json))
    )
  )

(deftest POST_on_post_or_delete
  (let [result (post_or_delete {"name" "David" "age" 33}
                               (ContextImpl. {"parameters"     {"path" {"cnt" 3}}
                                              "request-method" "post"}
                                             (Logger/getAnonymousLogger)))
        res-json (.writeValueAsString jackson result)]

    (is (sequential? result))
    (is (= 3 (count result)))
    (is (contains? (get result 0) "age"))
    (is (= 34 (get-in result [0 "age"])))
    (is (string? res-json))
    )
  )

Fix Clojure tests

Fix Clojure tests


(ns fowles.util
  (:require [clojure.java.io :as io]
            [clojure.data.json :as json]
            [clojure.string :as str]
            [zeromq.zmq :as zmq]
            [clojure.core.async :refer [chan close! timeout
                                        go-loop <! >! alt!
                                        <!! alt!!]]
            [clj-time
             [core :as t]
             [coerce :as c]
             ]))

;;-------------------------------
;; async

(defn- get-n-in-ms
  "Grab up to n items from in-ch within max-wait-ms.
   Return [acc, bool]  (whether to continue)"
  [in-ch n max-wait-ms]
  (let [t (timeout max-wait-ms)]
    (go-loop [i 0, acc []]
      (if (= i n)
        ;; Got enough.
        [acc, true]
        ;; Maybe get more...
        (alt!
         t     ([_] [acc, true])
         in-ch ([v]
                  (if (nil? v)
                    [acc, false]
                    (recur (inc i) (conj acc v)))))))))

(defn mk-grouped-ch
  "grab up to num items from from in-ch and return as one msg on out-ch"
  [in-ch num max-wait-ms]
  (let [out-ch (chan)]
    (go-loop []
      (let [[acc c] (<! (get-n-in-ms in-ch num max-wait-ms))]
        (if (seq acc) (>! out-ch acc))
        (if c
          (recur)
          (close! out-ch))))
    out-ch))

;;-------------------------------
;; ZMQ

(defn mk-connect-addr
  [host port]
  (str "tcp://" host ":" port))

(defn mk-socket
  ":: (keyword, str, int) -> zmq-socket"
  [push-or-pull host port]
  (let [context (zmq/context 1)]
    (doto (zmq/socket context push-or-pull)
      (zmq/connect (mk-connect-addr host port)))))

(def mk-pusher (partial mk-socket :push))
(def mk-puller (partial mk-socket :pull))

;;----------------------------

(def WAIT_MS 1000)

(defn dequeue-all-timeout
  [ch ms]
  (let [t (timeout ms)]
    (loop [acc []]
      (alt!!
       t  ([_] acc)
       ch ([v]
             (if (nil? v)
               acc
               (recur (conj acc v))))))))

(defn print-msgs
  [name ch]
  (let [msgs (dequeue-all-timeout ch WAIT_MS)]
    (json/pprint {name msgs})))

(defn request-msg->input-msg
  [request-msg]
  (let [req (:request request-msg)
        id-name (:id-name req)]
    {:request (:query-type req)
     id-name  (get-in req [:args id-name])}))

(defn print-requests
  [name ch]
  (let [requests (map request-msg->input-msg
                      (dequeue-all-timeout ch WAIT_MS))]
    (json/pprint {name requests})))

(defn print-pending-requests
  [chs-map]
  (println "*** :msg")
  (doseq [msg (dequeue-all-timeout (:msg chs-map) WAIT_MS)]
    (println msg))
  (doseq [ch-name [:requests :next-pages :retries]]
    (println "***" ch-name)
    (doseq [msg (map request-msg->input-msg
                     (dequeue-all-timeout (get chs-map ch-name) WAIT_MS))]
      (json/pprint msg))))

;;-----------------------

(def SLEEP_SECS 5)

(defn- wait-around []
  (println "\nSleeping for" SLEEP_SECS
           "seconds, to allow work to finish.")
  (loop [i 0]
    (if (< i SLEEP_SECS)
      (do
        (println "**")
        (flush)
        (Thread/sleep 1000)
        (recur (inc i))))))

;;-----------------------

(defn prep-shutdown
  [chs-map]
  (.addShutdownHook
   (Runtime/getRuntime)
   (Thread.
    (fn []
      ;; This stops any more input from coming in.
      (close! (:msg chs-map))
      (wait-around)
      (doseq [name [:failed :bodies :responses]]
        (print-msgs name (get chs-map name)))
      (print-pending-requests chs-map)))))

(ns fowles.util
  (:require [clojure.java.io :as io]
            [clojure.data.json :as json]
            [clojure.string :as str]
            [zeromq.zmq :as zmq]
            [clojure.core.async :refer [chan close! timeout
                                        go-loop <! >! alt!
                                        <!! >!! alt!!]]
            [clj-time
             [core :as t]
             [coerce :as c]
             ]))

;;-------------------------------
;; async

(defn- get-n-in-ms
  "Grab up to n items from in-ch within max-wait-ms.
   Return [acc, bool]  (whether to continue)"
  [in-ch n max-wait-ms]
  (let [t (timeout max-wait-ms)]
    (go-loop [i 0, acc []]
      (if (= i n)
        ;; Got enough.
        [acc, true]
        ;; Maybe get more...
        (alt!
         t     ([_] [acc, true])
         in-ch ([v]
                  (if (nil? v)
                    [acc, false]
                    (recur (inc i) (conj acc v)))))))))

(defn mk-grouped-ch
  "grab up to num items from from in-ch and return as one msg on out-ch"
  [in-ch num max-wait-ms]
  (let [out-ch (chan)]
    (go-loop []
      (let [[acc c] (<! (get-n-in-ms in-ch num max-wait-ms))]
        (if (seq acc) (>! out-ch acc))
        (if c
          (recur)
          (close! out-ch))))
    out-ch))

;;-------------------------------
;; ZMQ

(defn mk-connect-addr
  [host port]
  (str "tcp://" host ":" port))

(defn mk-socket
  ":: (keyword, str, int) -> zmq-socket"
  [push-or-pull host port]
  (let [context (zmq/context 1)]
    (doto (zmq/socket context push-or-pull)
      (zmq/connect (mk-connect-addr host port)))))

(def mk-pusher (partial mk-socket :push))
(def mk-puller (partial mk-socket :pull))

;;----------------------------

(def WAIT_MS 1000)

(defn dequeue-all-timeout
  [ch ms]
  (let [t (timeout ms)]
    (loop [acc []]
      (alt!!
       t  ([_] acc)
       ch ([v]
             (if (nil? v)
               acc
               (recur (conj acc v))))))))

(defn print-msgs
  [name ch]
  (let [msgs (dequeue-all-timeout ch WAIT_MS)]
    (json/pprint {name msgs})))

(defn request-msg->input-msg
  [request-msg]
  (let [req (:request request-msg)
        id-name (:id-name req)]
    {:request (:query-type req)
     id-name  (get-in req [:args id-name])}))

(defn print-pending-requests
  [chs-map]
  (println "*** :msg")
  (doseq [msg (dequeue-all-timeout (:msg chs-map) WAIT_MS)]
    (do
      (>!! (:failed chs-map) msg)
      (println msg)))
  (doseq [ch-name [:requests :next-pages :retries]]
    (println "***" ch-name)
    (doseq [msg (map request-msg->input-msg
                     (dequeue-all-timeout (get chs-map ch-name) WAIT_MS))]
      (do
        (>!! (:failed chs-map) (json/write-str msg))
        (json/pprint msg)))))

;;-----------------------

(def SLEEP_SECS 5)

;; TODO: Make this an async.timeout?
(defn- wait-around []
  (println "\nSleeping for" SLEEP_SECS
           "seconds, to allow work to finish.")
  (loop [i 0]
    (if (< i SLEEP_SECS)
      (do
        (println "**")
        (flush)
        (Thread/sleep 1000)
        (recur (inc i))))))

;;-----------------------

(defn prep-shutdown
  [chs-map]
  (.addShutdownHook
   (Runtime/getRuntime)
   (Thread.
    (fn []
      ;; Stop any more input from coming in.
      (close! (:msg chs-map))
      (wait-around)
      (doseq [name [:failed :bodies :responses]]
        (print-msgs name (get chs-map name)))
      (print-pending-requests chs-map)))))

send pending requests to failure sink

send pending requests to failure sink


(ns status-im.data-store.realm.schemas.account.v21.core
  (:require [status-im.data-store.realm.schemas.account.v19.chat :as chat]
            [status-im.data-store.realm.schemas.account.v1.chat-contact :as chat-contact]
            [status-im.data-store.realm.schemas.account.v19.contact :as contact]
            [status-im.data-store.realm.schemas.account.v20.discover :as discover]
            [status-im.data-store.realm.schemas.account.v19.message :as message]
            [status-im.data-store.realm.schemas.account.v12.pending-message :as pending-message]
            [status-im.data-store.realm.schemas.account.v1.processed-message :as processed-message]
            [status-im.data-store.realm.schemas.account.v19.request :as request]
            [status-im.data-store.realm.schemas.account.v19.user-status :as user-status]
            [status-im.data-store.realm.schemas.account.v5.contact-group :as contact-group]
            [status-im.data-store.realm.schemas.account.v5.group-contact :as group-contact]
            [status-im.data-store.realm.schemas.account.v8.local-storage :as local-storage]
            [status-im.data-store.realm.schemas.account.v21.browser :as browser]
            [taoensso.timbre :as log]
            [cljs.reader :as reader]
            [clojure.string :as str]))

(def schema [chat/schema
             chat-contact/schema
             contact/schema
             discover/schema
             message/schema
             pending-message/schema
             processed-message/schema
             request/schema
             user-status/schema
             contact-group/schema
             group-contact/schema
             local-storage/schema
             browser/schema])

(defn remove-contact! [new-realm whisper-identity]
  (when-let [contact (some-> new-realm
                             (.objects "contact")
                             (.filtered (str "whisper-identity = \"" whisper-identity "\""))
                             (aget 0))]
    (log/debug "v21 Removing contact " (pr-str contact))
    (.delete new-realm contact)))

(defn remove-location-messages! [old-realm new-realm]
  (let [messages (.objects new-realm "message")]
    (dotimes [i (.-length messages)]
      (let [message (aget messages i)
            content (aget message "content")
            type    (aget message "content-type")]
        (when (and (= type "command")
                   (> (str/index-of content "command=location") -1))
          (aset message "show?" false))))))

(defn remove-phone-messages! [old-realm new-realm]
  (let [messages (.objects new-realm "message")]
    (dotimes [i (.-length messages)]
      (let [message (aget messages i)
            content (aget message "content")
            type    (aget message "content-type")]
        (when (and (= type "command")
                   (> (str/index-of content "command=phone") -1))
          (aset message "show?" false))))))

(defn migration [old-realm new-realm]
  (log/debug "migrating v21 account database: " old-realm new-realm)
  (remove-contact! new-realm "browse")
  (remove-location-messages! old-realm new-realm)
  (remove-phone-messages! old-realm new-realm))

(ns status-im.data-store.realm.schemas.account.v21.core
  (:require [status-im.data-store.realm.schemas.account.v19.chat :as chat]
            [status-im.data-store.realm.schemas.account.v1.chat-contact :as chat-contact]
            [status-im.data-store.realm.schemas.account.v19.contact :as contact]
            [status-im.data-store.realm.schemas.account.v20.discover :as discover]
            [status-im.data-store.realm.schemas.account.v19.message :as message]
            [status-im.data-store.realm.schemas.account.v12.pending-message :as pending-message]
            [status-im.data-store.realm.schemas.account.v1.processed-message :as processed-message]
            [status-im.data-store.realm.schemas.account.v19.request :as request]
            [status-im.data-store.realm.schemas.account.v19.user-status :as user-status]
            [status-im.data-store.realm.schemas.account.v5.contact-group :as contact-group]
            [status-im.data-store.realm.schemas.account.v5.group-contact :as group-contact]
            [status-im.data-store.realm.schemas.account.v8.local-storage :as local-storage]
            [status-im.data-store.realm.schemas.account.v21.browser :as browser]
            [taoensso.timbre :as log]
            [cljs.reader :as reader]
            [clojure.string :as string]))

(def schema [chat/schema
             chat-contact/schema
             contact/schema
             discover/schema
             message/schema
             pending-message/schema
             processed-message/schema
             request/schema
             user-status/schema
             contact-group/schema
             group-contact/schema
             local-storage/schema
             browser/schema])

(defn remove-contact! [new-realm whisper-identity]
  (when-let [contact (some-> new-realm
                             (.objects "contact")
                             (.filtered (str "whisper-identity = \"" whisper-identity "\""))
                             (aget 0))]
    (log/debug "v21 Removing contact " (pr-str contact))
    (.delete new-realm contact)))

(defn remove-location-messages! [old-realm new-realm]
  (let [messages (.objects new-realm "message")]
    (dotimes [i (.-length messages)]
      (let [message (aget messages i)
            content (aget message "content")
            type    (aget message "content-type")]
        (when (and (= type "command")
                   (string/includes? content "command=location"))
          (aset message "show?" false))))))

(defn remove-phone-messages! [old-realm new-realm]
  (let [messages (.objects new-realm "message")]
    (dotimes [i (.-length messages)]
      (let [message (aget messages i)
            content (aget message "content")
            type    (aget message "content-type")]
        (when (and (= type "command")
                   (string/includes? content "command=phone"))
          (aset message "show?" false))))))

(defn migration [old-realm new-realm]
  (log/debug "migrating v21 account database: " old-realm new-realm)
  (remove-contact! new-realm "browse")
  (remove-location-messages! old-realm new-realm)
  (remove-phone-messages! old-realm new-realm))

fix location/phone commands migrations #3256

Signed-off-by: Eric Dvorsak <96f164ad4d9b2b0dacf8ebee2bb1eeb3aa69adf1@dvorsak.fr>


(ns joiner.ring
  (:require [com.ashafa.clutch.http-client :as http]
            [com.ashafa.clutch.utils :as utils])
  (:use [joiner.core]))

(defn- in-any-role? [allow-roles roles]
  (if (empty? allow-roles)
    false
    (or (contains? roles (first allow-roles))
        (recur (rest allow-roles) roles))))

(defn- get-current-user [request]
    "Authenticate against the configured couchdb instance using the given ring request's headers"
    (let [headers (select-keys (:headers request) ["authorization" "cookie"])]
      (:userCtx (http/couchdb-request :get (utils/url (assoc (couchdb-instance) :username nil :password nil) "_session") :headers headers))))

(defn- get-user [request]
  (if (:username request)
    {:name (:username request)
     :roles (:roles request)}
    (get-current-user request)))

(defn wrap-couchdb-user [handler & [ & {:keys [allow-roles]}]]
  "Wrap request with current couchdb user.
  If a user context is available, request is associated with
  a user (:username) and a predicate that given a role name returns true
  or false depending on whether user is in given role or not."
  (let [error-response {:status 403
                        :headers {"content-type" "text/plain"}
                        :body "Not authorized."}]
    (fn [request]
      (let [user (get-user request)]
        (if (and (not (empty? allow-roles))
                 (not (in-any-role? allow-roles (set (:roles user)))))
          error-response
          (handler (assoc request
                          :username (:name user)
                          :roles (:roles user)
                          :in-role? (fn [role]
                                      (contains? (set (:roles user)) role)))))))))

(ns joiner.ring
  (:require [com.ashafa.clutch.http-client :as http]
            [com.ashafa.clutch.utils :as utils]
            [com.ashafa.clutch :as clutch])
  (:use [joiner.core]))

(defn- in-any-role? [allow-roles roles]
  (if (empty? allow-roles)
    false
    (or (contains? roles (first allow-roles))
        (recur (rest allow-roles) roles))))

(defn- get-current-user [request]
    "Authenticate against the configured couchdb instance using the given ring request's headers"
    (let [headers (select-keys (:headers request) ["authorization" "cookie"])]
      (:userCtx (http/couchdb-request :get (utils/url (assoc (couchdb-instance) :username nil :password nil) "_session") :headers headers))))

(defn- get-user [request]
  (if (:username request)
    {:name (:username request)
     :roles (:roles request)}
    (get-current-user request)))

(defn wrap-with-db [handler db]
  (fn [request]
    (clutch/with-db db
                    (handler request))))

(defn wrap-couchdb-user [handler & [ & {:keys [allow-roles]}]]
  "Wrap request with current couchdb user.
  If a user context is available, request is associated with
  a user (:username) and a predicate that given a role name returns true
  or false depending on whether user is in given role or not."
  (let [error-response {:status 403
                        :headers {"content-type" "text/plain"}
                        :body "Not authorized."}]
    (fn [request]
      (let [user (get-user request)]
        (if (and (not (empty? allow-roles))
                 (not (in-any-role? allow-roles (set (:roles user)))))
          error-response
          (handler (assoc request
                          :username (:name user)
                          :roles (:roles user)
                          :in-role? (fn [role]
                                      (contains? (set (:roles user)) role)))))))))

add wrap-with-db

add wrap-with-db


(ns mbeanz.core
  (:gen-class)
  (:require [clojure.java.jmx :as jmx]
            [clojure.core.match :refer [match]]
            [mbeanz.common :refer :all])
  (:import [java.lang.IllegalArgumentException]))

(defn get-identifiers [[bean-name & bean-ops]]
  (->> bean-ops
       (flatten)
       (map (partial hash-map :bean (str bean-name) :operation))))

(defn list-beans [object-name-pattern]
  (->> (jmx/mbean-names object-name-pattern)
       (sort)
       (map (comp get-identifiers
                  #(list % (map first (partition-by identity (jmx/operation-names %))))))
       (flatten)))

(defn- get-operation-info [bean-name operation]
  (filter #(= (-> % .getName keyword) operation) (jmx/operations bean-name)))

(defn cast-type [[type-name arg]]
  (match [type-name]
         ["int"] (int (Integer/parseInt arg))
         ["java.lang.Integer"] (Integer/parseInt arg)
         ["long"] (long (Long/parseLong arg))
         ["java.lang.Long"] (Long/parseLong arg)
         ["boolean"] (boolean (Boolean/parseBoolean arg))
         ["java.lang.Boolean"] (Boolean/parseBoolean arg)
         ["double"] (double (Double/parseDouble arg))
         ["java.lang.Double"] (Double/parseDouble arg)
         ["float"] (float (Float/parseFloat arg))
         ["java.lang.Float"] (Float/parseFloat arg)
         ["java.lang.String"] arg
         :else (throw (IllegalArgumentException. (str "Unsupported argument type " type-name)))))

(defn invoke [bean-name operation & typed-args]
  (if (seq? typed-args)
    (let [types (map first typed-args)
          values (map cast-type typed-args)]
      (apply jmx/invoke-signature bean-name operation types values))
    (jmx/invoke bean-name operation)))

(defn- get-signature-descriptions [operation]
  {:name (.getName operation)
   :description (.getDescription operation)
   :signature (map #(hash-map :name (.getName %)
                              :description (.getDescription %)
                              :type (.getType %))
                   (.getSignature operation))})

(defn describe [bean-name operation]
  (map get-signature-descriptions (get-operation-info bean-name operation)))

(ns mbeanz.core
  (:gen-class)
  (:require [clojure.java.jmx :as jmx]
            [clojure.core.match :refer [match]]
            [mbeanz.common :refer :all])
  (:import [java.lang.IllegalArgumentException]))

(defn get-identifiers [[bean-name & bean-ops]]
  (->> bean-ops
       (flatten)
       (sort)
       (map (partial hash-map :bean (str bean-name) :operation))))

(defn list-beans [object-name-pattern]
  (->> (jmx/mbean-names object-name-pattern)
       (sort)
       (map (comp get-identifiers
                  #(list % (map first (partition-by identity (jmx/operation-names %))))))
       (flatten)))

(defn- get-operation-info [bean-name operation]
  (filter #(= (-> % .getName keyword) operation) (jmx/operations bean-name)))

(defn cast-type [[type-name arg]]
  (match [type-name]
         ["int"] (int (Integer/parseInt arg))
         ["java.lang.Integer"] (Integer/parseInt arg)
         ["long"] (long (Long/parseLong arg))
         ["java.lang.Long"] (Long/parseLong arg)
         ["boolean"] (boolean (Boolean/parseBoolean arg))
         ["java.lang.Boolean"] (Boolean/parseBoolean arg)
         ["double"] (double (Double/parseDouble arg))
         ["java.lang.Double"] (Double/parseDouble arg)
         ["float"] (float (Float/parseFloat arg))
         ["java.lang.Float"] (Float/parseFloat arg)
         ["java.lang.String"] arg
         :else (throw (IllegalArgumentException. (str "Unsupported argument type " type-name)))))

(defn invoke [bean-name operation & typed-args]
  (if (seq? typed-args)
    (let [types (map first typed-args)
          values (map cast-type typed-args)]
      (apply jmx/invoke-signature bean-name operation types values))
    (jmx/invoke bean-name operation)))

(defn- get-signature-descriptions [operation]
  {:name (.getName operation)
   :description (.getDescription operation)
   :signature (map #(hash-map :name (.getName %)
                              :description (.getDescription %)
                              :type (.getType %))
                   (.getSignature operation))})

(defn describe [bean-name operation]
  (map get-signature-descriptions (get-operation-info bean-name operation)))

Sort mbean operations

Sort mbean operations


(ns ^{:doc "Functions and macros for initialising and controlling visualisation applets."}
  quil.applet
  (:import [processing.core PApplet]
           [javax.swing JFrame]
           [java.awt Dimension]
           [java.awt.event WindowListener])
  (:require [quil.util :refer [resolve-constant-key no-fn absolute-path]]
            [clojure.stacktrace :refer [print-cause-trace]]
            [clojure.string :as string]))

(defonce untitled-applet-id* (atom 0))
(def ^:dynamic *applet* nil)

(defn ^PApplet current-applet []
  *applet*)

(defn target-frame-rate []
  (:target-frame-rate (meta (current-applet))))

(defn applet-disposed
  "This function is called when PApplet executes 'dispose' method.
  It means we can dispose frame, call on-close function and perform other
  clean ups."
  [applet]
  (.dispose (. applet frame))
  ((:on-close (meta applet))))

(defn applet-state
  "Fetch an element of state from within the applet"
  [applet k]
  (get @(:state (meta applet)) k))

(defn applet-close
  "Sets 'finished' field in applet to true. Main run loop in applet
   should stop as soon as finished == true and then call dispose."
  [applet]
  (set! (.finished applet) true))

(defn- prepare-applet-frame
  [applet title renderer]
  (let [m              (meta applet)
        keep-on-top?   (:keep-on-top m)
        frame          (.frame applet)
        resizable?     (:resizable m)]
    (doseq [listener (.getWindowListeners frame)]
      (.removeWindowListener frame listener))
    (doto frame
      (.addWindowListener  (reify WindowListener
                             (windowActivated [this e])
                             (windowClosing [this e]
                               (applet-close applet))
                             (windowDeactivated [this e])
                             (windowDeiconified [this e])
                             (windowIconified [this e])
                             (windowOpened [this e])
                             (windowClosed [this e])))
      (.setDefaultCloseOperation JFrame/DO_NOTHING_ON_CLOSE))
    (javax.swing.SwingUtilities/invokeLater
     (fn []
       (when resizable?
         (.setResizable frame resizable?))
       (.setAlwaysOnTop frame keep-on-top?)))
    applet))

(defn- applet-run
  "Launches the applet to the specified target."
  [applet title renderer]
  (PApplet/runSketch (into-array String ["--hide-stop" title]) applet)
  (prepare-applet-frame applet title renderer))

(def ^{:private true}
  renderer-modes {:p2d    PApplet/P2D
                  :p3d    PApplet/P3D
                  :java2d PApplet/JAVA2D
                  :opengl PApplet/OPENGL
                  :pdf    PApplet/PDF
                  :dxf    PApplet/DXF})

(defn resolve-renderer
  "Converts keyword to Processing renderer string constant.
  This string can be passed to native Processing methods."
  [renderer]
  (resolve-constant-key renderer renderer-modes))

(defn- display-size
  "Returns size of screen. If there are 2 or more screens it probably return size of
  default one whatever it means."
  []
  (let [bounds (.. (java.awt.GraphicsEnvironment/getLocalGraphicsEnvironment)
                   getDefaultScreenDevice
                   getDefaultConfiguration
                   getBounds)]
    [(.-width bounds) (.-height bounds)]))

(defn- process-size
  "Checks that the size vector is exactly two elements. If not, throws
  an exception, otherwise returns the size vector unmodified."
  [size]
  (cond (= size :fullscreen) (display-size)
        (and (coll? size) (= 2 (count size))) size
        :else (throw (IllegalArgumentException.
                      (str "Invalid size definition:" size ". Was expecting :fullscreen or 2 elements vector: [x-size y-size].")))))

(defn- to-method-name [keyword]
  "Converts keyword to java-style method symbol. :on-key-pressed => onKeyPressed"
  (-> keyword
      name
      (string/replace
       #"-."
       #(-> % string/upper-case (subs 1)))
      symbol))

(defn- parent-method [method]
  "Appends string 'Parent' to given symbol"
  (symbol (str method "Parent")))

(defmacro with-applet [applet & body]
  "Binds dynamic var to current applet."
  `(binding [*applet* ~applet]
     ~@body))

(def listeners [:key-pressed
                :key-released
                :key-typed
                :mouse-pressed
                :mouse-released
                :mouse-moved
                :mouse-dragged
                :mouse-entered
                :mouse-exited
                :mouse-clicked
                :focus-gained
                :focus-lost])

(gen-class
  :name "quil.Applet"
  :implements [clojure.lang.IMeta]
  :extends processing.core.PApplet
  :state state
  :init quil-applet-init
  :post-init quil-applet-post-init
  :constructors {[java.util.Map] []}
  :exposes-methods {keyTyped keyTypedParent
                    loop loopParent
                    mouseDragged mouseDraggedParent
                    keyPressed keyPressedParent
                    mouseExited mouseExitedParent
                    mouseClicked mouseClickedParent
                    mouseEntered mouseEnteredParent
                    mouseMoved mouseMovedParent
                    keyReleased keyReleasedParent
                    mousePressed mousePressedParent
                    focusGained focusGainedParent
                    frameRate frameRateParent
                    mouseReleased mouseReleasedParent
                    focusLost focusLostParent
                    noLoop noLoopParent
                    sketchFullScreen sketchFullScreenParent
                    exit exitParent})

(defn -exit [this] (.dispose this))

(defn -sketchFullScreen [this] (:present (meta this)))

(defn -quil-applet-init [state]
  [[] state])

(defn -quil-applet-post-init [this _]
  (let [[width height] (:size (meta this))]
    (.resize this width height)))

(defn -meta [this]
  (.state this))

(defn -setup [this]
  ; If renderer is :pdf - we need to set it via size method,
  ; as there is no other way to set file path for renderer.
  ; Size method call must be FIRST in setup function
  ; (don't know why, but let's trust Processing guys).
  ; Technically it's not first (there are 'when' and 'let' before 'size'),
  ; but hopefully it will work fine.
  (when (= (:renderer (meta this)) :pdf)
    (let [[width height] (:size (meta this))
          renderer (resolve-renderer (:renderer (meta this)))
          file (-> this meta :output-file absolute-path)]
      (.size this (int width) (int height) renderer file)))
  (with-applet this
    ((:setup-fn (meta this)))))

(defn -draw [this]
  (with-applet this
    ((:draw-fn (meta this)))))

(defn -noLoop [this]
  (reset! (:looping? (meta this)) false)
  (.noLoopParent this))

(defn -loop [this]
  (reset! (:looping? (meta this)) true)
  (.loopParent this))

(defn -frameRate [this new-rate-target]
  (reset! (target-frame-rate) new-rate-target)
  (.frameRateParent this new-rate-target))

(defn -sketchRenderer [this]
  (let [renderer (:renderer (meta this))
        ; If renderer :pdf we can't use it as initial renderer
        ; as path to output file is not set and path can be set only
        ; via .size(width, height, renderer, path) method in setup function.
        ; Set :java2d renderer instead and call size method in setup later.
        initial-renderer (if (= renderer :pdf) :java2d renderer)]
      (resolve-renderer initial-renderer)))

(defmacro generate-listeners
  "Generates all listeners like onKeyPress, onMouseClick and others."
  []
  (letfn [(prefix [v method]
            (symbol (str v method)))
          (generate-listener [listener]
            (let [method (to-method-name listener)
                  parent-method-name (prefix "." (parent-method method))]
               `(defn ~(prefix "-" method)
                  ([this#] (with-applet this# ((~listener (meta this#)))))
                  ([this# evt#] (~parent-method-name this# evt#)))))]
    `(do ~@(map generate-listener listeners))))

(generate-listeners)

(defn -mouseWheel [this evt]
  (with-applet this
    (when-let [mouse-wheel (:mouse-wheel (.state this))]
      (mouse-wheel (.getCount evt)))))

(defn attach-applet-listeners [applet]
  (let [listeners {:on-dispose #(applet-disposed applet)}
        listener-obj (quil.helpers.AppletListener. listeners)]
    (.registerMethod applet "dispose" listener-obj)
    applet))

(def ^{:private true}
  opts-applet-params
  #{:resizable :exit-on-close :keep-on-top :present})

(defn applet
  "Create and start a new visualisation applet.

   :size           - a vector of width and height for the sketch or :fullscreen.
                     Defaults to [500 300].

   :renderer       - Specify the renderer type. One of :p2d, :p3d, :java2d,
                     :opengl, :pdf). Defaults to :java2d. :dxf renderer
                     can't be used as sketch renderer. Use begin-raw method
                     instead.

   :output-file    - Specify an output file path. Only used in :pdf mode.

   :title          - a string which will be displayed at the top of
                     the sketch window.

   :opts           - Short form for true\false options. Sets added parameters in true.
                     You can use supported parameters without :opts but :opts has a higher priority.
                     Example: :opts [:keep-on-top]
                     Supported parameters: :keep-on-top, :exit-on-close, :resizable, :present

   :keep-on-top    - Sets whether sketch window should always be above other windows.
                     Note: some platforms might not support always-on-top windows.

   :exit-on-close  - Sets behavior of JVM when sketch is closed.

   :resizable      - Sets whether sketch is resizable by the user.

   :present        - Switch to sketch present mode (fullscreen without borders, OS panels).

   :setup          - a fn to be called once when setting the sketch up.

   :draw           - a fn to be repeatedly called at most n times per
                     second where n is the target frame-rate set for
                     the visualisation.

   :focus-gained   - Called when the sketch gains focus.

   :focus-lost     - Called when the sketch loses focus.

   :mouse-entered  - Called when the mouse enters the sketch window.

   :mouse-exited   - Called when the mouse leaves the sketch window

   :mouse-pressed  - Called every time a mouse button is pressed.

   :mouse-released - Called every time a mouse button is released.

   :mouse-clicked  - called once after a mouse button has been pressed
                     and then released.

   :mouse-moved    - Called every time the mouse moves and a button is
                     not pressed.

   :mouse-dragged  - Called every time the mouse moves and a button is
                     pressed.

   :mouse-wheel    - Called every time mouse wheel is rotated.
                     Takes 1 argument - wheel rotation, an int.
                     Negative values if the mouse wheel was rotated
                     up/away from the user, and positive values
                     if the mouse wheel was rotated down/ towards the user

   :key-pressed    - Called every time any key is pressed.

   :key-released   - Called every time any key is released.

   :key-typed      - Called once every time non-modifier keys are
                     pressed.

   :safe-draw-fn   - Catches and prints exceptions in the draw fn.
                     Default is true.

   :on-close       - Called once, when sketch is closed"
  [& opts]
  (let [raw-options      (merge {:size [500 300]
                                 :target :frame
                                 :safe-draw-fn true}
                                (apply hash-map opts))

        prepare-opts     (let [user-opts (set (:opts raw-options))]
                           (reduce #(assoc %1 %2 (contains? user-opts %2)) {}
                                   opts-applet-params))

        options           (merge (dissoc raw-options :opts) prepare-opts)

        size              (process-size (:size options))
        title             (or (:title options) (str "Quil " (swap! untitled-applet-id* inc)))
        renderer          (or (:renderer options) :java2d)
        draw-fn           (or (:draw options) no-fn)
        setup-fn          (or (:setup options) no-fn)
        safe-draw-fn      (fn []
                            (try
                              (draw-fn)
                              (catch Exception e
                                (println "Exception in Quil draw-fn for sketch" title ": " e "\nstacktrace: " (with-out-str (print-cause-trace e)))
                                (Thread/sleep 1000))))
        draw-fn           (if (:safe-draw-fn options) safe-draw-fn draw-fn)

        on-close-fn       (let [close-fn (or (:on-close options) no-fn)]
                            (if (:exit-on-close options)
                              (fn []
                                (close-fn)
                                (System/exit 0))
                              close-fn))

        state             (atom nil)
        looping?          (atom true)
        listeners         (into {} (for [name listeners]
                                     [name (or (options name) no-fn)]))

        applet-state      (merge options
                                 {:state state
                                  :looping? looping?
                                  :on-close on-close-fn
                                  :setup-fn setup-fn
                                  :draw-fn draw-fn
                                  :renderer renderer
                                  :size size
                                  :target-frame-rate (atom 60)}
                                 listeners)
        prx-obj           (quil.Applet. applet-state)]
    (doto prx-obj
      (applet-run title renderer)
      (attach-applet-listeners))))

(def ^{:private true}
  non-fn-applet-params
  #{:size :renderer :output-file :title :target})

(defmacro defapplet
  "Define and start an applet and bind it to a var with the symbol
  app-name. If any of the options to the various callbacks are
  symbols, it wraps them in a call to var to ensure they aren't
  inlined and that redefinitions to the original fns are reflected in
  the visualisation. See applet for the available options."
  [app-name & opts]
  (let [fn-param? #(not (contains? non-fn-applet-params %))
        opts  (mapcat (fn [[k v]]
                        [k (if (and (symbol? v)
                                    (fn-param? k))
                             `(var ~v)
                             v)])
                      (partition 2 opts))]
    `(def ~app-name (applet ~@opts))))

(ns ^{:doc "Functions and macros for initialising and controlling visualisation applets."}
  quil.applet
  (:import [processing.core PApplet]
           [javax.swing JFrame]
           [java.awt Dimension]
           [java.awt.event WindowListener])
  (:require [quil.util :refer [resolve-constant-key no-fn absolute-path]]
            [clojure.stacktrace :refer [print-cause-trace]]
            [clojure.string :as string]))

(defonce untitled-applet-id* (atom 0))
(def ^:dynamic *applet* nil)

(defn ^PApplet current-applet []
  *applet*)

(defn target-frame-rate []
  (:target-frame-rate (meta (current-applet))))

(defn applet-disposed
  "This function is called when PApplet executes 'dispose' method.
  It means we can dispose frame, call on-close function and perform other
  clean ups."
  [applet]
  (.dispose (. applet frame))
  ((:on-close (meta applet))))

(defn applet-state
  "Fetch an element of state from within the applet"
  [applet k]
  (get @(:state (meta applet)) k))

(defn applet-close
  "Sets 'finished' field in applet to true. Main run loop in applet
   should stop as soon as finished == true and then call dispose."
  [applet]
  (set! (.finished applet) true))

(defn- prepare-applet-frame
  [applet title renderer]
  (let [m              (meta applet)
        keep-on-top?   (:keep-on-top m)
        frame          (.frame applet)
        resizable?     (:resizable m)]
    (doseq [listener (.getWindowListeners frame)]
      (.removeWindowListener frame listener))
    (doto frame
      (.addWindowListener  (reify WindowListener
                             (windowActivated [this e])
                             (windowClosing [this e]
                               (applet-close applet))
                             (windowDeactivated [this e])
                             (windowDeiconified [this e])
                             (windowIconified [this e])
                             (windowOpened [this e])
                             (windowClosed [this e])))
      (.setDefaultCloseOperation JFrame/DO_NOTHING_ON_CLOSE))
    (javax.swing.SwingUtilities/invokeLater
     (fn []
       (when resizable?
         (.setResizable frame resizable?))
       (.setAlwaysOnTop frame keep-on-top?)))
    applet))

(defn- applet-run
  "Launches the applet to the specified target."
  [applet title renderer]
  (PApplet/runSketch
   (into-array String
               (vec (filter string?
                   [(when (and (:bgcolor (meta applet))
                               (:present (meta applet)))
                     (str "--bgcolor" "=" (str (:bgcolor (meta applet)))))
                    "--hide-stop" title])))
   applet)
  (prepare-applet-frame applet title renderer))

(def ^{:private true}
  renderer-modes {:p2d    PApplet/P2D
                  :p3d    PApplet/P3D
                  :java2d PApplet/JAVA2D
                  :opengl PApplet/OPENGL
                  :pdf    PApplet/PDF
                  :dxf    PApplet/DXF})

(defn resolve-renderer
  "Converts keyword to Processing renderer string constant.
  This string can be passed to native Processing methods."
  [renderer]
  (resolve-constant-key renderer renderer-modes))

(defn- display-size
  "Returns size of screen. If there are 2 or more screens it probably return size of
  default one whatever it means."
  []
  (let [bounds (.. (java.awt.GraphicsEnvironment/getLocalGraphicsEnvironment)
                   getDefaultScreenDevice
                   getDefaultConfiguration
                   getBounds)]
    [(.-width bounds) (.-height bounds)]))

(defn- process-size
  "Checks that the size vector is exactly two elements. If not, throws
  an exception, otherwise returns the size vector unmodified."
  [size]
  (cond (= size :fullscreen) (display-size)
        (and (coll? size) (= 2 (count size))) size
        :else (throw (IllegalArgumentException.
                      (str "Invalid size definition:" size ". Was expecting :fullscreen or 2 elements vector: [x-size y-size].")))))

(defn- to-method-name [keyword]
  "Converts keyword to java-style method symbol. :on-key-pressed => onKeyPressed"
  (-> keyword
      name
      (string/replace
       #"-."
       #(-> % string/upper-case (subs 1)))
      symbol))

(defn- parent-method [method]
  "Appends string 'Parent' to given symbol"
  (symbol (str method "Parent")))

(defmacro with-applet [applet & body]
  "Binds dynamic var to current applet."
  `(binding [*applet* ~applet]
     ~@body))

(def listeners [:key-pressed
                :key-released
                :key-typed
                :mouse-pressed
                :mouse-released
                :mouse-moved
                :mouse-dragged
                :mouse-entered
                :mouse-exited
                :mouse-clicked
                :focus-gained
                :focus-lost])

(gen-class
  :name "quil.Applet"
  :implements [clojure.lang.IMeta]
  :extends processing.core.PApplet
  :state state
  :init quil-applet-init
  :post-init quil-applet-post-init
  :constructors {[java.util.Map] []}
  :exposes-methods {keyTyped keyTypedParent
                    loop loopParent
                    mouseDragged mouseDraggedParent
                    keyPressed keyPressedParent
                    mouseExited mouseExitedParent
                    mouseClicked mouseClickedParent
                    mouseEntered mouseEnteredParent
                    mouseMoved mouseMovedParent
                    keyReleased keyReleasedParent
                    mousePressed mousePressedParent
                    focusGained focusGainedParent
                    frameRate frameRateParent
                    mouseReleased mouseReleasedParent
                    focusLost focusLostParent
                    noLoop noLoopParent
                    sketchFullScreen sketchFullScreenParent
                    exit exitParent})

(defn -exit [this] (.dispose this))

(defn -sketchFullScreen [this] (:present (meta this)))

(defn -quil-applet-init [state]
  [[] state])

(defn -quil-applet-post-init [this _]
  (let [[width height] (:size (meta this))]
    (.resize this width height)))

(defn -meta [this]
  (.state this))

(defn -setup [this]
  ; If renderer is :pdf - we need to set it via size method,
  ; as there is no other way to set file path for renderer.
  ; Size method call must be FIRST in setup function
  ; (don't know why, but let's trust Processing guys).
  ; Technically it's not first (there are 'when' and 'let' before 'size'),
  ; but hopefully it will work fine.
  (when (= (:renderer (meta this)) :pdf)
    (let [[width height] (:size (meta this))
          renderer (resolve-renderer (:renderer (meta this)))
          file (-> this meta :output-file absolute-path)]
      (.size this (int width) (int height) renderer file)))
  (with-applet this
    ((:setup-fn (meta this)))))

(defn -draw [this]
  (with-applet this
    ((:draw-fn (meta this)))))

(defn -noLoop [this]
  (reset! (:looping? (meta this)) false)
  (.noLoopParent this))

(defn -loop [this]
  (reset! (:looping? (meta this)) true)
  (.loopParent this))

(defn -frameRate [this new-rate-target]
  (reset! (target-frame-rate) new-rate-target)
  (.frameRateParent this new-rate-target))

(defn -sketchRenderer [this]
  (let [renderer (:renderer (meta this))
        ; If renderer :pdf we can't use it as initial renderer
        ; as path to output file is not set and path can be set only
        ; via .size(width, height, renderer, path) method in setup function.
        ; Set :java2d renderer instead and call size method in setup later.
        initial-renderer (if (= renderer :pdf) :java2d renderer)]
      (resolve-renderer initial-renderer)))

(defmacro generate-listeners
  "Generates all listeners like onKeyPress, onMouseClick and others."
  []
  (letfn [(prefix [v method]
            (symbol (str v method)))
          (generate-listener [listener]
            (let [method (to-method-name listener)
                  parent-method-name (prefix "." (parent-method method))]
               `(defn ~(prefix "-" method)
                  ([this#] (with-applet this# ((~listener (meta this#)))))
                  ([this# evt#] (~parent-method-name this# evt#)))))]
    `(do ~@(map generate-listener listeners))))

(generate-listeners)

(defn -mouseWheel [this evt]
  (with-applet this
    (when-let [mouse-wheel (:mouse-wheel (.state this))]
      (mouse-wheel (.getCount evt)))))

(defn attach-applet-listeners [applet]
  (let [listeners {:on-dispose #(applet-disposed applet)}
        listener-obj (quil.helpers.AppletListener. listeners)]
    (.registerMethod applet "dispose" listener-obj)
    applet))

(def ^{:private true}
  opts-applet-params
  #{:resizable :exit-on-close :keep-on-top :present})

(defn applet
  "Create and start a new visualisation applet.

   :size           - a vector of width and height for the sketch or :fullscreen.
                     Defaults to [500 300].

   :renderer       - Specify the renderer type. One of :p2d, :p3d, :java2d,
                     :opengl, :pdf). Defaults to :java2d. :dxf renderer
                     can't be used as sketch renderer. Use begin-raw method
                     instead.

   :output-file    - Specify an output file path. Only used in :pdf mode.

   :title          - a string which will be displayed at the top of
                     the sketch window.

   :opts           - Short form for true\false options. Sets added parameters in true.
                     You can use supported parameters without :opts but :opts has a higher priority.
                     Example: :opts [:keep-on-top]
                     Supported parameters: :keep-on-top, :exit-on-close, :resizable, :present

   :keep-on-top    - Sets whether sketch window should always be above other windows.
                     Note: some platforms might not support always-on-top windows.

   :exit-on-close  - Sets behavior of JVM when sketch is closed.

   :resizable      - Sets whether sketch is resizable by the user.

   :present        - Switch to sketch present mode (fullscreen without borders, OS panels).

   :bgcolor        - Sets background color for unused space in present mode.
                     Example: :bgcolor 200

   :setup          - a fn to be called once when setting the sketch up.

   :draw           - a fn to be repeatedly called at most n times per
                     second where n is the target frame-rate set for
                     the visualisation.

   :focus-gained   - Called when the sketch gains focus.

   :focus-lost     - Called when the sketch loses focus.

   :mouse-entered  - Called when the mouse enters the sketch window.

   :mouse-exited   - Called when the mouse leaves the sketch window

   :mouse-pressed  - Called every time a mouse button is pressed.

   :mouse-released - Called every time a mouse button is released.

   :mouse-clicked  - called once after a mouse button has been pressed
                     and then released.

   :mouse-moved    - Called every time the mouse moves and a button is
                     not pressed.

   :mouse-dragged  - Called every time the mouse moves and a button is
                     pressed.

   :mouse-wheel    - Called every time mouse wheel is rotated.
                     Takes 1 argument - wheel rotation, an int.
                     Negative values if the mouse wheel was rotated
                     up/away from the user, and positive values
                     if the mouse wheel was rotated down/ towards the user

   :key-pressed    - Called every time any key is pressed.

   :key-released   - Called every time any key is released.

   :key-typed      - Called once every time non-modifier keys are
                     pressed.

   :safe-draw-fn   - Catches and prints exceptions in the draw fn.
                     Default is true.

   :on-close       - Called once, when sketch is closed"
  [& opts]
  (let [raw-options      (merge {:size [500 300]
                                 :target :frame
                                 :safe-draw-fn true}
                                (apply hash-map opts))

        prepare-opts     (let [user-opts (set (:opts raw-options))]
                           (reduce #(assoc %1 %2 (contains? user-opts %2)) {}
                                   opts-applet-params))

        options           (merge (dissoc raw-options :opts) prepare-opts)

        size              (process-size (:size options))
        title             (or (:title options) (str "Quil " (swap! untitled-applet-id* inc)))
        renderer          (or (:renderer options) :java2d)
        draw-fn           (or (:draw options) no-fn)
        setup-fn          (or (:setup options) no-fn)
        safe-draw-fn      (fn []
                            (try
                              (draw-fn)
                              (catch Exception e
                                (println "Exception in Quil draw-fn for sketch" title ": " e "\nstacktrace: " (with-out-str (print-cause-trace e)))
                                (Thread/sleep 1000))))
        draw-fn           (if (:safe-draw-fn options) safe-draw-fn draw-fn)

        on-close-fn       (let [close-fn (or (:on-close options) no-fn)]
                            (if (:exit-on-close options)
                              (fn []
                                (close-fn)
                                (System/exit 0))
                              close-fn))

        state             (atom nil)
        looping?          (atom true)
        listeners         (into {} (for [name listeners]
                                     [name (or (options name) no-fn)]))

        applet-state      (merge options
                                 {:state state
                                  :looping? looping?
                                  :on-close on-close-fn
                                  :setup-fn setup-fn
                                  :draw-fn draw-fn
                                  :renderer renderer
                                  :size size
                                  :target-frame-rate (atom 60)}
                                 listeners)
        prx-obj           (quil.Applet. applet-state)]
    (doto prx-obj
      (applet-run title renderer)
      (attach-applet-listeners))))

(def ^{:private true}
  non-fn-applet-params
  #{:size :renderer :output-file :title :target})

(defmacro defapplet
  "Define and start an applet and bind it to a var with the symbol
  app-name. If any of the options to the various callbacks are
  symbols, it wraps them in a call to var to ensure they aren't
  inlined and that redefinitions to the original fns are reflected in
  the visualisation. See applet for the available options."
  [app-name & opts]
  (let [fn-param? #(not (contains? non-fn-applet-params %))
        opts  (mapcat (fn [[k v]]
                        [k (if (and (symbol? v)
                                    (fn-param? k))
                             `(var ~v)
                             v)])
                      (partition 2 opts))]
    `(def ~app-name (applet ~@opts))))

Add :bgcolor option.

Add :bgcolor option.


{:user {:aliases {"slamhound" ["run" "-m" "slam.hound"]}  ; Q: Will I ever find occasion to actually use this?
        :dependencies [;; Q: what's this really for? A: modifying CLASSPATH at runtime
                       [alembic "0.3.2" :exclusions [org.tcrawley/dynapath]]
                       [com.cemerick/pomegranate "0.3.1" :exclusions [org.apache.maven.wagon/wagon-http
                                                                      org.tcrawley/dynapath]]
                       [commons-io "2.5"]
                       [commons-logging "1.2"]
                       ;; TODO: Replace this with whatever replaced it
                       ;; Careful: 0.3.4 was working OK
                       ;; Q: Did hara replace this too?
                       #_[im.chit/vinyasa "0.4.7" :exclusions [im.chit/hara.reflect
                                                             org.clojure/clojure
                                                             org.codehaus.plexus/plexus-utils
                                                             org.slf4j/jcl-over-slf4j]]
                       [leiningen #= (leiningen.core.main/leiningen-version) :exclusions [cheshire
                                                                                com.fasterxml.jackson.core/jackson-core
                                                                                com.fasterxml.jackson.dataformat/jackson-dataformat-smile
                                                                                commons-codec
                                                                                commons-io
                                                                                commons-logging
                                                                                #_org.apache.httpcomponents/httpclient
                                                                                #_org.apache.httpcomponents/httpcore
                                                                                #_org.apache.maven.wagon/wagon-http
                                                                                org.apache.maven.wagon/wagon-http-shared4
                                                                                org.apache.maven.wagon/wagon-provider-api
                                                                                org.clojure/clojure
                                                                                org.clojure/tools.reader
                                                                                org.jsoup/jsoup
                                                                                potemkin
                                                                                slingshot]]
                       ;; Q: How many of any of the rest of these do I actually use?
                       [org.apache.maven.wagon/wagon-provider-api "2.12"]
                       [org.codehaus.plexus/plexus-utils "3.0.24"]
                       ;; I use this everywhere. But it doesn't belong in here
                       #_[org.clojure/tools.namespace "0.2.10"]
                       ;; I know I have a lot of projects that transitively rely on this, but they really shouldn't
                       #_[org.clojure/tools.nrepl "0.2.12" :exclusions [org.clojure/clojure]]
                       [pjstadig/humane-test-output "0.8.2"]
                       ;; Q: Is there any point to this next one?
                       #_[ritz/ritz-nrepl-middleware "0.7.0"]
                       ;; Q: Do I actually use this anywhere/for anything?
                       ;; A: leiningen does.
                       ;; Q: Why am/was I overriding?
                       #_[slingshot "0.12.2" :exclusions [org.clojure/clojure]]]
        :injections [#_(require '[vinyasa.inject :as inject])
                     ;; TODO: call install-pretty-exception
                     #_(require 'io.aviso.repl)
                     #_(inject/in
                      ;; Default injection ns is .
                      [vinyasa.inject :refer [inject [in inject-in]]]
                      [alembic.still [distill pull]]  ; Q: what is/was this?
                      ;; I still want this.
                      ;; Q: Where did it go?
                      #_[cemerick.pomegranate add-classpath add-dependencies get-classpath resources]

                      ;;; At least 90% certain that I don't want any of the rest of this
                      ;; Inject into clojure.core
                      clojure.core
                      [vinyasa.reflection .> .? .* .% .%> .& .>ns .>var]

                      ;; Inject into clojure.core, with prefix
                      clojure.core >
                      [clojure.pprint pprint]
                      [clojure.java.shell sh])
                     ;;; Well, this doesn't seem awful; I think I do want something like this.
                     ;;; But it doesn't seem worth including here...really ought to be decided on
                     ;;; a case-by-case basis, oughtn't it?
                     (require 'pjstadig.humane-test-output)
                     (pjstadig.humane-test-output/activate!)]
        ;;:local-repo "repo"
        :plugins [[com.jakemccrary/lein-test-refresh "0.20.0"]
                  [jonase/eastwood "0.2.4" :exclusions [org.clojure/clojure]]
                  ;; Check for out-dated plugins in here using `lein ancient check-profiles`
                  [lein-ancient "0.6.10" :exclusions [cheshire
                                                      common-codec
                                                      commons-codec
                                                      org.clojure/clojure
                                                      #_org.clojure/tools.reader
                                                      slingshot]]
                  [lein-kibit "0.1.5" :exclusions [org.clojure/clojure]]
                  [lein-pprint "1.1.2"]
                  [mvxcvi/whidbey "1.3.1" :exclusions [org.clojure/clojure]]]
        :repl-options {:nrepl-middleware
                       []}
        :whidbey {:width 180
                  :map-delimiter ""
                  :extend-notation true
                  :print-meta true
                  :color-scheme {}
                  :print-color true}}
 :repl {:plugins [[cider/cider-nrepl "0.14.0" :exclusions [org.clojure/java.classpath]]]}}

{:user {:aliases {"slamhound" ["run" "-m" "slam.hound"]}  ; Q: Will I ever find occasion to actually use this?
        :dependencies [;; Q: what's this really for? A: modifying CLASSPATH at runtime
                       [alembic "0.3.2" :exclusions [org.tcrawley/dynapath]]
                       [com.cemerick/pomegranate "0.3.1" :exclusions [org.apache.maven.wagon/wagon-http
                                                                      org.tcrawley/dynapath]]
                       [commons-io "2.5"]
                       [commons-logging "1.2"]
                       [leiningen #= (leiningen.core.main/leiningen-version) :exclusions [cheshire
                                                                                com.fasterxml.jackson.core/jackson-core
                                                                                com.fasterxml.jackson.dataformat/jackson-dataformat-smile
                                                                                commons-codec
                                                                                commons-io
                                                                                commons-logging
                                                                                #_org.apache.httpcomponents/httpclient
                                                                                #_org.apache.httpcomponents/httpcore
                                                                                #_org.apache.maven.wagon/wagon-http
                                                                                org.apache.maven.wagon/wagon-http-shared4
                                                                                org.apache.maven.wagon/wagon-provider-api
                                                                                org.clojure/clojure
                                                                                org.clojure/tools.reader
                                                                                org.jsoup/jsoup
                                                                                potemkin
                                                                                slingshot]]
                       ;; Q: How many of any of the rest of these do I actually use?
                       [org.apache.maven.wagon/wagon-provider-api "2.12"]
                       [org.codehaus.plexus/plexus-utils "3.0.24"]
                       [pjstadig/humane-test-output "0.8.2"]]
        :injections [;; TODO: call install-pretty-exception
                     ;;; Well, this doesn't seem awful; I think I do want something like this.
                     ;;; But it doesn't seem worth including here...really ought to be decided on
                     ;;; a case-by-case basis, oughtn't it?
                     (require 'pjstadig.humane-test-output)
                     (pjstadig.humane-test-output/activate!)]
        ;;:local-repo "repo"
        :plugins [#_[cider/cider-nrepl "0.15.0" :exclusions [org.clojure/java.classpath]]
                  [com.jakemccrary/lein-test-refresh "0.20.0"]
                  [jonase/eastwood "0.2.4" :exclusions [org.clojure/clojure]]
                  ;; Check for out-dated plugins in here using `lein ancient check-profiles`
                  [lein-ancient "0.6.10" :exclusions [cheshire
                                                      common-codec
                                                      commons-codec
                                                      org.clojure/clojure
                                                      #_org.clojure/tools.reader
                                                      slingshot]]
                  [lein-kibit "0.1.5" :exclusions [org.clojure/clojure]]
                  [lein-pprint "1.1.2"]
                  [mvxcvi/whidbey "1.3.1" :exclusions [org.clojure/clojure]]]
        :repl-options {:nrepl-middleware
                       []}
        :whidbey {:width 180
                  :map-delimiter ""
                  :extend-notation true
                  :print-meta true
                  :color-scheme {}
                  :print-color true}}
 :repl {:plugins [[cider/cider-nrepl "0.15.0" :exclusions [org.clojure/java.classpath]]]}}

Clean up leiningen profile

Clean up leiningen profile

Remove some pieces that I'm just not using to debug a startup error
that was working on one machine but not others


;; Copyright (c) Andrew A. Raines
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use,
;; copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following
;; conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.

(ns postal.sendmail
  (:use [postal.message :only [message->str sender recipients]]))

(def sendmails ["/usr/lib/sendmail"
                "/usr/sbin/sendmail"
                "/usr/bin/sendmail"
                "/usr/local/lib/sendmail"
                "/usr/local/sbin/sendmail"
                "/usr/local/bin/sendmail"
                "/usr/sbin/msmtp"])

(def errors {0  [:SUCCESS        "message sent"]
             64 [:EX_USAGE       "command line usage error"]
             65 [:EX_DATAERR     "data format error"]
             66 [:EX_NOINPUT     "cannot open input"]
             67 [:EX_NOUSER      "addressee unknown"]
             68 [:EX_NOHOST      "host name unknown"]
             69 [:EX_UNAVAILABLE "service unavailable"]
             70 [:EX_SOFTWARE    "internal software error"]
             71 [:EX_OSERR       "system error (no fork?)"]
             72 [:EX_OSFILE      "critical OS file missing"]
             73 [:EX_CANTCREAT   "can't create (user) output file"]
             74 [:EX_IOERR       "input/output error"]
             75 [:EX_TEMPFAIL    "temp failure; user is invited to retry"]
             76 [:EX_PROTOCOL    "remote error in protocol"]
             77 [:EX_NOPERM      "permission denied"]
             78 [:EX_CONFIG      "configuration error"]})

(defn error [code]
  (let [[e message] (errors code)]
    {:code code
     :error e
     :message message}))

(defn sendmail-find []
  (first (filter #(.isFile (java.io.File. ^String %)) sendmails)))

(defn sanitize [^String text]
  (.replaceAll text "\r\n" (System/getProperty "line.separator")))

(defn sendmail-send [msg]
  (let [mail (sanitize (message->str msg))
        cmd (concat
             [(sendmail-find) (format "-f %s" (sender msg))]
             (recipients msg))
        pb (ProcessBuilder. cmd)
        p (.start pb)
        smtp (java.io.PrintStream. (.getOutputStream p))]
    (.print smtp mail)
    (.close smtp)
    (.waitFor p)
    (error (.exitValue p))))

;; Copyright (c) Andrew A. Raines
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use,
;; copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following
;; conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.

(ns postal.sendmail
  (:use [postal.message :only [message->str sender recipients]]))

(def sendmails ["/usr/lib/sendmail"
                "/usr/sbin/sendmail"
                "/usr/bin/sendmail"
                "/usr/local/lib/sendmail"
                "/usr/local/sbin/sendmail"
                "/usr/local/bin/sendmail"
                "/usr/sbin/msmtp"])

(def errors {0  [:SUCCESS        "message sent"]
             64 [:EX_USAGE       "command line usage error"]
             65 [:EX_DATAERR     "data format error"]
             66 [:EX_NOINPUT     "cannot open input"]
             67 [:EX_NOUSER      "addressee unknown"]
             68 [:EX_NOHOST      "host name unknown"]
             69 [:EX_UNAVAILABLE "service unavailable"]
             70 [:EX_SOFTWARE    "internal software error"]
             71 [:EX_OSERR       "system error (no fork?)"]
             72 [:EX_OSFILE      "critical OS file missing"]
             73 [:EX_CANTCREAT   "can't create (user) output file"]
             74 [:EX_IOERR       "input/output error"]
             75 [:EX_TEMPFAIL    "temp failure; user is invited to retry"]
             76 [:EX_PROTOCOL    "remote error in protocol"]
             77 [:EX_NOPERM      "permission denied"]
             78 [:EX_CONFIG      "configuration error"]})

(defn error [code]
  (let [[e message] (errors code)]
    {:code code
     :error e
     :message message}))

(defn sendmail-find []
  (if-let [SENDMAIL (System/getenv "SENDMAIL")]
    SENDMAIL
    (first (filter #(.isFile (java.io.File. ^String %)) sendmails))))

(defn sanitize [^String text]
  (.replaceAll text "\r\n" (System/getProperty "line.separator")))

(defn sendmail-send [msg]
  (let [mail (sanitize (message->str msg))
        cmd (concat
             [(sendmail-find) (format "-f %s" (sender msg))]
             (recipients msg))
        pb (ProcessBuilder. cmd)
        p (.start pb)
        smtp (java.io.PrintStream. (.getOutputStream p))]
    (.print smtp mail)
    (.close smtp)
    (.waitFor p)
    (error (.exitValue p))))

Use $SENDMAIL from the environment, if provided.

Addresses issue #34.