(ns status-im.chat.views.message
  (:require-macros [status-im.utils.views :refer [defview]])
  (:require [clojure.string :as s]
            [re-frame.core :refer [subscribe dispatch]]
            [reagent.core :as r]
            [status-im.i18n :refer [message-status-label]]
            [status-im.components.react :refer [view
                                                text
                                                image
                                                animated-view
                                                touchable-highlight]]
            [status-im.components.animation :as anim]
            [status-im.chat.views.request-message :refer [message-content-command-request]]
            [status-im.chat.styles.message :as st]
            [status-im.models.chats :refer [chat-by-id]]
            [status-im.models.commands :refer [parse-command-message-content
                                               parse-command-request]]
            [status-im.resources :as res]
            [status-im.utils.datetime :as time]
            [status-im.constants :refer [text-content-type
                                         content-type-status
                                         content-type-command
                                         content-type-command-request]]
            [status-im.utils.identicon :refer [identicon]]
            [status-im.chat.utils :as cu]))

(defn message-date [timestamp]
  [view {}
   [view st/message-date-container
    [text {:style st/message-date-text
           :font  :default}
     (time/to-short-str timestamp)]]])

(defn contact-photo [{:keys [photo-path]}]
  [view st/contact-photo-container
   [image {:source (if (s/blank? photo-path)
                     res/user-no-photo
                     {:uri photo-path})
           :style  st/contact-photo}]])

(defn contact-online [{:keys [online]}]
  (when online
    [view st/online-container
     [view st/online-dot-left]
     [view st/online-dot-right]]))

(defn message-content-status [{:keys [from content]}]
  [view st/status-container
   [view st/status-image-view
    [contact-photo {}]
    [contact-online {:online true}]]
   [text {:style st/status-from
          :font  :default}
    from]
   [text {:style st/status-text
          :font  :default}
    content]])

(defn message-content-audio [_]
  [view st/audio-container
   [view st/play-view
    [image {:source res/play
            :style  st/play-image}]]
   [view st/track-container
    [view st/track]
    [view st/track-mark]
    [text {:style st/track-duration-text
           :font  :default}
     "03:39"]]])

(defview message-content-command [content preview]
  [commands [:get-commands-and-responses]]
  (let [{:keys [command content]} (parse-command-message-content commands content)
        {:keys [name icon type]} command]
    [view st/content-command-view
     [view st/command-container
      [view (st/command-view command)
       [text {:style st/command-name
              :font  :default}
        (str (if (= :command type) "!" "") name)]]]
     (when icon
       [view st/command-image-view
        [image {:source {:uri icon}
                :style  st/command-image}]])
     (if preview
       preview
       [text {:style st/command-text
              :font  :default}
        (str content)])]))

(defn set-chat-command [message-id command]
  (dispatch [:set-response-chat-command message-id (keyword (:name command))]))

(defn message-view
  [message content]
  [view (st/message-view message)
   #_(when incoming-group
       [text {:style message-author-text}
        "Justas"])
   content])

(defmulti message-content (fn [_ message _]
                            (message :content-type)))

(defmethod message-content content-type-command-request
  [wrapper message]
  [wrapper message [message-content-command-request message]])

(defn text-message
  [{:keys [content] :as message}]
  [message-view message
   [text {:style (st/text-message message)
          :font  :default}
    (str content)]])

(defmethod message-content text-content-type
  [wrapper message]
  [wrapper message [text-message message]])

(defmethod message-content content-type-status
  [_ message]
  [message-content-status message])

(defmethod message-content content-type-command
  [wrapper {:keys [content rendered-preview] :as message}]
  [wrapper message
   [message-view message [message-content-command content rendered-preview]]])

(defmethod message-content :default
  [wrapper {:keys [content-type content] :as message}]
  [wrapper message
   [message-view message
    [message-content-audio {:content      content
                            :content-type content-type}]]])

(defview group-message-delivery-status [{:keys [message-id group-id message-status user-statuses] :as msg}]
  [app-db-message-user-statuses [:get-in [:message-user-statuses message-id]]
   app-db-message-status-value [:get-in [:message-statuses message-id :status]]
   chat [:get-chat-by-id group-id]
   contacts [:get-contacts]]
  (let [status            (or message-status app-db-message-status-value :sending)
        user-statuses     (merge user-statuses app-db-message-user-statuses)
        participants      (:contacts chat)
        seen-by-everyone? (and (= (count user-statuses) (count participants))
                               (every? (fn [[_ {:keys [status]}]]
                                         (= (keyword status) :seen)) user-statuses))]
    (if (or (zero? (count user-statuses))
            seen-by-everyone?)
      [view st/delivery-view
       [image {:source (case status
                         :seen {:uri :icon_ok_small}
                         :failed res/delivery-failed-icon
                         nil)
               :style  st/delivery-image}]
       [text {:style st/delivery-text
              :font  :default}
        (message-status-label
          (if seen-by-everyone?
            :seen-by-everyone
            status))]]
      [touchable-highlight
       {:on-press (fn []
                    (dispatch [:show-message-details {:message-status status
                                                      :user-statuses  user-statuses
                                                      :participants   participants}]))}
       [view st/delivery-view
        (for [[_ {:keys [whisper-identity]}] (take 3 user-statuses)]
          ^{:key whisper-identity}
          [image {:source {:uri (or (get-in contacts [whisper-identity :photo-path])
                                    (identicon whisper-identity))}
                  :style  {:width        16
                           :height       16
                           :borderRadius 8}}])
        (if (> (count user-statuses) 3)
          [text {:style st/delivery-text
                 :font  :default}
           (str "+ " (- (count user-statuses) 3))])]])))

(defview message-delivery-status [{:keys [message-id chat-id message-status user-statuses]}]
  [app-db-message-status-value [:get-in [:message-statuses message-id :status]]]
  (let [delivery-status (get-in user-statuses [chat-id :status])
        status          (if (cu/console? chat-id)
                          :seen
                          (or delivery-status message-status app-db-message-status-value :sending))]
    [view st/delivery-view
     [image {:source (case status
                       :seen {:uri :icon_ok_small}
                       :failed res/delivery-failed-icon
                       nil)
             :style  st/delivery-image}]
     [text {:style st/delivery-text
            :font  :default}
      (message-status-label status)]]))

(defview member-photo [from]
  [photo-path [:photo-path from]]
  [view st/photo-view
   [image {:source (if (s/blank? photo-path)
                     res/user-no-photo
                     {:uri photo-path})
           :style  st/photo}]])

(defn incoming-group-message-body
  [{:keys [selected same-author from] :as message} content]
  (let [delivery-status :seen-by-everyone]
    [view st/group-message-wrapper
     (when selected
       [text {:style st/selected-message
              :font  :default}
        "Mar 7th, 15:22"])
     [view (st/incoming-group-message-body-st message)
      [view st/message-author
       (when (not same-author) [member-photo from])]
      [view st/group-message-view
       content
       ;; TODO show for last or selected
       (when (and selected delivery-status)
         [message-delivery-status message])]]]))

(defn message-body
  [{:keys [outgoing message-type] :as message} content]
  [view (st/message-body message)
   content
   (when outgoing
     (if (= (keyword message-type) :group-user-message)
       [group-message-delivery-status message]
       [message-delivery-status message]))])

(defn message-container-animation-logic [{:keys [to-value val callback]}]
  (fn [_]
    (let [to-value @to-value]
      (when (< 0 to-value)
        (anim/start
          (anim/spring val {:toValue  to-value
                            :friction 4
                            :tension  10})
          (fn [arg]
            (when (.-finished arg)
              (callback))))))))

(defn message-container [message & children]
  (if (:new? message)
    (let [layout-height (r/atom 0)
          anim-value (anim/create-value 1)
          anim-callback #(dispatch [:set-message-shown message])
          context {:to-value layout-height
                   :val      anim-value
                   :callback anim-callback}
          on-update (message-container-animation-logic context)]
      (r/create-class
        {:component-did-update
         on-update
         :reagent-render
         (fn [message & children]
           @layout-height
           [animated-view {:style (st/message-container anim-value)}
            (into [view {:onLayout (fn [event]
                                     (let [height (.. event -nativeEvent -layout -height)]
                                       (reset! layout-height height)))}]
                  children)])}))
    (into [view] children)))

(defn chat-message [{:keys [outgoing message-id chat-id user-statuses from]}]
  (let [my-identity (subscribe [:get :current-public-key])
        status      (subscribe [:get-in [:message-user-statuses message-id my-identity]])]
    (r/create-class
      {:component-did-mount
       (fn []
         (when (and (not outgoing)
                    (not= :seen (keyword @status))
                    (not= :seen (keyword (get-in user-statuses [@my-identity :status]))))
           (dispatch [:send-seen! {:chat-id    chat-id
                                   :from       from
                                   :message-id message-id}])))
       :reagent-render
       (fn [{:keys [outgoing timestamp new-day group-chat] :as message}]
         [message-container message
          ;; TODO there is no new-day info in message
          (when new-day
            [message-date timestamp])
          [view
           (let [incoming-group (and group-chat (not outgoing))]
             [message-content
              (if incoming-group
                incoming-group-message-body
                message-body)
              (merge message {:incoming-group incoming-group})])]])})))

(ns status-im.chat.views.message
  (:require-macros [status-im.utils.views :refer [defview]])
  (:require [clojure.string :as s]
            [re-frame.core :refer [subscribe dispatch]]
            [reagent.core :as r]
            [status-im.i18n :refer [message-status-label]]
            [status-im.components.react :refer [view
                                                text
                                                image
                                                animated-view
                                                touchable-highlight]]
            [status-im.components.animation :as anim]
            [status-im.chat.views.request-message :refer [message-content-command-request]]
            [status-im.chat.styles.message :as st]
            [status-im.models.chats :refer [chat-by-id]]
            [status-im.models.commands :refer [parse-command-message-content
                                               parse-command-request]]
            [status-im.resources :as res]
            [status-im.utils.datetime :as time]
            [status-im.constants :refer [text-content-type
                                         content-type-status
                                         content-type-command
                                         content-type-command-request]]
            [status-im.utils.identicon :refer [identicon]]
            [status-im.chat.utils :as cu]))

(defn message-date [timestamp]
  [view {}
   [view st/message-date-container
    [text {:style st/message-date-text
           :font  :default}
     (time/to-short-str timestamp)]]])

(defn contact-photo [{:keys [photo-path]}]
  [view st/contact-photo-container
   [image {:source (if (s/blank? photo-path)
                     res/user-no-photo
                     {:uri photo-path})
           :style  st/contact-photo}]])

(defn contact-online [{:keys [online]}]
  (when online
    [view st/online-container
     [view st/online-dot-left]
     [view st/online-dot-right]]))

(defn message-content-status [{:keys [from content]}]
  [view st/status-container
   [view st/status-image-view
    [contact-photo {}]
    [contact-online {:online true}]]
   [text {:style st/status-from
          :font  :default}
    from]
   [text {:style st/status-text
          :font  :default}
    content]])

(defn message-content-audio [_]
  [view st/audio-container
   [view st/play-view
    [image {:source res/play
            :style  st/play-image}]]
   [view st/track-container
    [view st/track]
    [view st/track-mark]
    [text {:style st/track-duration-text
           :font  :default}
     "03:39"]]])

(defview message-content-command [content preview]
  [commands [:get-commands-and-responses]]
  (let [{:keys [command content]} (parse-command-message-content commands content)
        {:keys [name icon type]} command]
    [view st/content-command-view
     [view st/command-container
      [view (st/command-view command)
       [text {:style st/command-name
              :font  :default}
        (str (if (= :command type) "!" "") name)]]]
     (when icon
       [view st/command-image-view
        [image {:source {:uri icon}
                :style  st/command-image}]])
     (if preview
       preview
       [text {:style st/command-text
              :font  :default}
        (str content)])]))

(defn set-chat-command [message-id command]
  (dispatch [:set-response-chat-command message-id (keyword (:name command))]))

(defn message-view
  [message content]
  [view (st/message-view message)
   #_(when incoming-group
       [text {:style message-author-text}
        "Justas"])
   content])

(defmulti message-content (fn [_ message _]
                            (message :content-type)))

(defmethod message-content content-type-command-request
  [wrapper message]
  [wrapper message [message-content-command-request message]])

(defn text-message
  [{:keys [content] :as message}]
  [message-view message
   [text {:style (st/text-message message)
          :font  :default}
    (str content)]])

(defmethod message-content text-content-type
  [wrapper message]
  [wrapper message [text-message message]])

(defmethod message-content content-type-status
  [_ message]
  [message-content-status message])

(defmethod message-content content-type-command
  [wrapper {:keys [content rendered-preview] :as message}]
  [wrapper message
   [message-view message [message-content-command content rendered-preview]]])

(defmethod message-content :default
  [wrapper {:keys [content-type content] :as message}]
  [wrapper message
   [message-view message
    [message-content-audio {:content      content
                            :content-type content-type}]]])

(defview group-message-delivery-status [{:keys [message-id group-id message-status user-statuses] :as msg}]
  [app-db-message-user-statuses [:get-in [:message-user-statuses message-id]]
   app-db-message-status-value [:get-in [:message-statuses message-id :status]]
   chat [:get-chat-by-id group-id]
   contacts [:get-contacts]]
  (let [status            (or message-status app-db-message-status-value :sending)
        user-statuses     (merge user-statuses app-db-message-user-statuses)
        participants      (:contacts chat)
        seen-by-everyone? (and (= (count user-statuses) (count participants))
                               (every? (fn [[_ {:keys [status]}]]
                                         (= (keyword status) :seen)) user-statuses))]
    (if (or (zero? (count user-statuses))
            seen-by-everyone?)
      [view st/delivery-view
       [image {:source (case status
                         :seen {:uri :icon_ok_small}
                         :failed res/delivery-failed-icon
                         nil)
               :style  st/delivery-image}]
       [text {:style st/delivery-text
              :font  :default}
        (message-status-label
          (if seen-by-everyone?
            :seen-by-everyone
            status))]]
      [touchable-highlight
       {:on-press (fn []
                    (dispatch [:show-message-details {:message-status status
                                                      :user-statuses  user-statuses
                                                      :participants   participants}]))}
       [view st/delivery-view
        (for [[_ {:keys [whisper-identity]}] (take 3 user-statuses)]
          ^{:key whisper-identity}
          [image {:source {:uri (or (get-in contacts [whisper-identity :photo-path])
                                    (identicon whisper-identity))}
                  :style  {:width        16
                           :height       16
                           :borderRadius 8}}])
        (if (> (count user-statuses) 3)
          [text {:style st/delivery-text
                 :font  :default}
           (str "+ " (- (count user-statuses) 3))])]])))

(defview message-delivery-status [{:keys [message-id chat-id message-status user-statuses]}]
  [app-db-message-status-value [:get-in [:message-statuses message-id :status]]]
  (let [delivery-status (get-in user-statuses [chat-id :status])
        status          (if (cu/console? chat-id)
                          :seen
                          (or delivery-status message-status app-db-message-status-value :sending))]
    [view st/delivery-view
     [image {:source (case status
                       :seen {:uri :icon_ok_small}
                       :failed res/delivery-failed-icon
                       nil)
             :style  st/delivery-image}]
     [text {:style st/delivery-text
            :font  :default}
      (message-status-label status)]]))

(defview member-photo [from]
  [photo-path [:photo-path from]]
  [view st/photo-view
   [image {:source {:uri (if (s/blank? photo-path)
                           (identicon from)
                           photo-path)}
           :style  st/photo}]])

(defn incoming-group-message-body
  [{:keys [selected same-author from] :as message} content]
  (let [delivery-status :seen-by-everyone]
    [view st/group-message-wrapper
     (when selected
       [text {:style st/selected-message
              :font  :default}
        "Mar 7th, 15:22"])
     [view (st/incoming-group-message-body-st message)
      [view st/message-author
       (when (not same-author) [member-photo from])]
      [view st/group-message-view
       content
       ;; TODO show for last or selected
       (when (and selected delivery-status)
         [message-delivery-status message])]]]))

(defn message-body
  [{:keys [outgoing message-type] :as message} content]
  [view (st/message-body message)
   content
   (when outgoing
     (if (= (keyword message-type) :group-user-message)
       [group-message-delivery-status message]
       [message-delivery-status message]))])

(defn message-container-animation-logic [{:keys [to-value val callback]}]
  (fn [_]
    (let [to-value @to-value]
      (when (< 0 to-value)
        (anim/start
          (anim/spring val {:toValue  to-value
                            :friction 4
                            :tension  10})
          (fn [arg]
            (when (.-finished arg)
              (callback))))))))

(defn message-container [message & children]
  (if (:new? message)
    (let [layout-height (r/atom 0)
          anim-value (anim/create-value 1)
          anim-callback #(dispatch [:set-message-shown message])
          context {:to-value layout-height
                   :val      anim-value
                   :callback anim-callback}
          on-update (message-container-animation-logic context)]
      (r/create-class
        {:component-did-update
         on-update
         :reagent-render
         (fn [message & children]
           @layout-height
           [animated-view {:style (st/message-container anim-value)}
            (into [view {:onLayout (fn [event]
                                     (let [height (.. event -nativeEvent -layout -height)]
                                       (reset! layout-height height)))}]
                  children)])}))
    (into [view] children)))

(defn chat-message [{:keys [outgoing message-id chat-id user-statuses from]}]
  (let [my-identity (subscribe [:get :current-public-key])
        status      (subscribe [:get-in [:message-user-statuses message-id my-identity]])]
    (r/create-class
      {:component-did-mount
       (fn []
         (when (and (not outgoing)
                    (not= :seen (keyword @status))
                    (not= :seen (keyword (get-in user-statuses [@my-identity :status]))))
           (dispatch [:send-seen! {:chat-id    chat-id
                                   :from       from
                                   :message-id message-id}])))
       :reagent-render
       (fn [{:keys [outgoing timestamp new-day group-chat] :as message}]
         [message-container message
          ;; TODO there is no new-day info in message
          (when new-day
            [message-date timestamp])
          [view
           (let [incoming-group (and group-chat (not outgoing))]
             [message-content
              (if incoming-group
                incoming-group-message-body
                message-body)
              (merge message {:incoming-group incoming-group})])]])})))

correct identicon in the group chat (#249)

Former-commit-id: 0912b61f70c0430483ffa6ba1026b26396481469


(ns clj-money.web.accounts
  (:refer-clojure :exclude [update])
  (:require [clojure.tools.logging :as log]
            [clojure.pprint :refer [pprint]]
            [environ.core :refer [env]]
            [hiccup.core :refer :all]
            [hiccup.page :refer :all]
            [ring.util.response :refer :all]
            [ring.util.codec :refer [url-encode]]
            [clj-money.authorization :refer [authorize
                                             allowed?
                                             apply-scope
                                             tag-resource]]
            [clj-money.permissions.accounts]
            [clj-money.permissions.transactions]
            [clj-money.permissions.reconciliations]
            [clj-money.url :refer :all]
            [clj-money.inflection :refer [humanize]]
            [clj-money.util :refer [format-number
                                    pprint-and-return]]
            [clj-money.pagination :as pagination]
            [clj-money.validation :as validation]
            [clj-money.models.accounts :as accounts]
            [clj-money.models.transactions :as transactions]
            [clj-money.models.commodities :as commodities]
            [clj-money.models.lots :as lots]
            [clj-money.models.prices :as prices]
            [clj-money.web.money-shared :refer [grouped-options-for-accounts
                                                budget-monitors]]
            [clj-money.reports :as reports])
  (:use [clj-money.web.shared :refer :all]))

(defmacro with-accounts-layout
  [page-title entity-or-id options & content]
  `(with-layout
     ~page-title (assoc ~options :side-bar (budget-monitors ~entity-or-id))
     ~@content))

(defn- can-add-child?
  [account]
  true)

(defn- account-row
  "Renders a single account row"
  [account depth]
  [:tr
   [:td
    [:span {:class (format "account-depth-%s" depth)}
     (:name account)
     " "
     (when (can-add-child? account)
       [:a.small-add {:href (format "/entities/%s/accounts/new?parent-id=%s" (:entity-id account) (:id account))
                      :title "Click here to add a child to this account."}
        "+"])]]
   [:td.text-right
    [:span {:class (format "balance-depth-%s" depth)}
     (format-number (+ (:balance account) (:children-balance account)))]]
   [:td
    [:span.btn-group
     (when (allowed? :show account)
       (glyph-button :list-alt
                     (format "/accounts/%s" (:id account))
                     {:level :default
                      :size :extra-small
                      :title "Click here to view transactions for this account"
                      :disabled (contains? (:tags account) :tradable)}))
     (when (allowed? :create (-> {:account-id (:id account)}
                                 (tag-resource :reconciliation)))
       (glyph-button :check
                     (format "/accounts/%s/reconciliations/new" (:id account))
                     {:level :default
                      :size :extra-small
                      :title "Click here to reconcile this account"}))
     (when (allowed? :edit account)
       (glyph-button :pencil
                     (format "/accounts/%s/edit" (:id account))
                     {:level :info
                      :size :extra-small
                      :title "Click here to edit this account"}))
     (when (allowed? :delete account)
       (glyph-button :remove
                     (format "/accounts/%s/delete" (:id account))
                     {:level :danger
                      :size :extra-small
                      :data-method :post
                      :data-confirm "Are you sure you want to delete this account?"
                      :title "Click here to remove this account"
                      :disabled (seq (:children account))}))]]])

(defn- render-child-rows?
  [account]
  true)

(defn- account-and-children-rows
  "Renders an individual account row and any child rows"
  ([account] (account-and-children-rows account 0))
  ([account depth]
   (let [account-row (account-row account depth)]
     (if (render-child-rows? account)
       (concat
         [account-row]
         (->> (:children account)
              (map #(account-and-children-rows % (+ depth 1)))
              (into [])))
       account-row))))

(defn- account-rows
  "Renders rows for all accounts and type headers"
  [{:keys [type accounts]}]
  (html
    [:tr.account-type
     [:td type]
     [:td.text-right (->> accounts
                          (map (juxt :balance :children-balance))
                          (reduce (fn [sum [balance children-balance]]
                                    (+ sum balance children-balance))
                                  0)
                          format-number)]
     [:td " "]]
    (map account-and-children-rows accounts)))

(defn index
  "Renders the list of accounts"
  ([req] (index req {}))
  ([{{entity :entity :as params} :params} options]
   (with-accounts-layout "Accounts" entity (merge options {:entity entity})
     [:table.table.table-striped
      [:tr
       [:th.col-sm-6 "Name"]
       [:th.col-sm-4.text-right "Balance"]
       [:th.col-sm-2 " "]]
      (let [groups (->> (apply-scope {:entity-id (:id entity)}
                                     :account)
                        (accounts/search (env :db))
                        accounts/nest)]
        (map account-rows groups))]
     [:a.btn.btn-primary
      {:href (format "/entities/%s/accounts/new" (:id entity))
       :title "Click here to add a new account."}
      "Add"])))

(defn- transaction-item-row
  [{:keys [transaction
           description
           polarized-amount
           reconciled?
           account-id
           balance] :as item}]
  [:tr
   [:td.text-right (:transaction-date transaction)]
   [:td (:description transaction)]
   [:td.text-right (format-number polarized-amount)]
   [:td.text-right (format-number balance)]
   [:td.text-center [:span.glyphicon
                     {:aria-hidden "true"
                      :class (if reconciled? "glyphicon-check" "glyphicon-unchecked")}]]
   [:td
    [:span.btn-group
     (when (allowed? :update transaction)
       (glyph-button :pencil
                     (-> (path "/transactions" (:id transaction) "edit")
                         (query {:redirect (url-encode (format "/accounts/%s" account-id))})
                         format-url)
                     {:level :info
                      :size :extra-small
                      :title "Click here to edit this transaction."}))
     (glyph-button :paperclip
                   (-> (path "/transactions" (:id transaction) "attachments")
                       (query {:redirect (url-encode (format "/accounts/%s" account-id))})
                       format-url)
                   {:level :default
                    :size :extra-small
                    :title "Click here to view attachments for this transaction."})
     (when (allowed? :delete transaction)
       (let [can-delete? (transactions/can-delete? transaction)]
         (glyph-button :remove
                       (-> (path "/transactions" (:id transaction) "delete")
                           (query {:redirect (url-encode (format "/accounts/%s" account-id))})
                           format-url)
                       {:level :danger
                        :disabled (not can-delete?)
                        :size :extra-small
                        :title (if can-delete?
                                 "Click here to remove this transaction."
                                 "This transaction contains reconciled items and cannot be removed.")
                        :data-method :post
                        :data-confirm "Are you sure you want to remove this transaction?"
                        :method :post})))]]])

(defmulti ^:private show-account
  (fn [account params]
    (cond
      (contains? (:tags account) :trading)
      :trading-account

      (contains? (:tags account) :tradable)
      :trading-detail

      :else
      :standard)))

(defmethod ^:private show-account :standard
  [account params]
  (html
    [:table.table.table-striped.table-hover
     [:tr
      [:th.text-right "Date"]
      [:th "Description"]
      [:th.text-right "Amount"]
      [:th.text-right "Balance"]
      [:th.text-center "Rec."]
      [:th " "]]
     (->> (transactions/items-by-account (env :db)
                                         (:id account)
                                         (pagination/prepare-options params))
          (map #(assoc % :transaction (transactions/find-by-id
                                        (env :db)
                                        (:transaction-id %))))
          (map transaction-item-row))]
    [:p
     (pagination/nav
       (assoc params
              :url (-> (path "/accounts"
                             (:id account)))
              :total (transactions/count-items-by-account (env :db) (:id account))))]

    [:p
     [:a.btn.btn-primary
      {:href (-> (path "/entities"
                       (:entity-id account)
                       "transactions"
                       "new")
                 (query {:redirect (url-encode (format "/accounts/%s" (:id account)))})
                 format-url)
       :title "Click here to add a new transaction."}
      "Add"]
     " "
     [:a.btn.btn-default
      {:href (format "/accounts/%s/reconciliations/new" (:id account))
       :title "Click here to reconcile this account."}
      "Reconcile"]
     " "
     [:a.btn.btn-default
      {:href (format "/entities/%s/accounts" (:entity-id account))
       :title "Click here to return to the list of accounts."}
      "Back"]]))

(defn- commodity-row
  [{:keys [style
           caption
           shares
           price
           cost
           gain
           value
           commodity-id]}
   account]
  [:tr {:class (format "report-%s" (name style))}
   [:td caption]
   [:td.text-right (if shares
                     (format-number shares {:format :commodity-price})
                     " ")]
   [:td.text-right (if price
                     (format-number price {:format :commodity-price})
                     " ")]
   [:td.text-right (format-number value)]
   [:td {:class (when gain (format "text-right %s" (if (<= 0 gain) "gain" "loss")))}
    (if gain
      (format-number gain)
      " ")]
   [:td
    (when shares
      [:div.btn-group
       (glyph-button :list-alt
                     (format "/accounts/%s/lots?commodity-id=%s"
                             (:id account)
                             commodity-id)
                     {:size :extra-small
                      :title "Click here to view the lots for this commodity"})
       (glyph-button :plus-sign
                     (format "/accounts/%s/purchases/new?commodity-id=%s"
                             (:id account)
                             commodity-id)
                     {:size :extra-small
                      :level :success
                      :title "Click here to purchase more shares of this commodity."})
       (glyph-button :minus-sign
                     (format "/accounts/%s/sales/new?commodity-id=%s&shares=%s"
                             (:id account)
                             commodity-id
                             shares)
                     {:size :extra-small
                      :level :danger
                      :title "Click here to sell shares of this commodity."})])]])

(defmethod show-account :trading-account
  [account params]
  (html
    (let [summary (reports/commodities-account-summary (env :db) (:id account))]
      [:div.row
       [:div.col-md-10
        [:table.table.table-striped.table-hover
         [:tr
          [:th "Commodity"]
          [:th.text-right "Shares"]
          [:th.text-right "Price"]
          [:th.text-right "Value"]
          [:th.text-right "Gain"]
          [:th " "]]
         (if (seq summary)
           (map #(commodity-row % account)
                summary)
           [:tr
            [:td.empty-table {:colspan 4}
             "This account does not have any positions"]])]]])
    [:a.btn.btn-primary
     {:href (format "/accounts/%s/purchases/new" (:id account))
      :title "Click here to purchase a commodity with this account."}
     "Purchase"]
    " "
    [:a.btn.btn-default
     {:href (format "/entities/%s/accounts" (:entity-id account))
      :title "Click here to return to the list of accounts"}
     "Back"]))

(defmethod show-account :trading-detail
  [account params]
  (html
    [:p
     "Information page for commodity accounts is not ready yet."]
    [:a.btn.btn-primary
     {:href (format "/entities/%s/accounts" (:entity-id account))
      :title "Click here to return to the list of accounts."}
     "Back"]))

(defn show
  "Renders account details, including transactions"
  ([req] (show req {}))
  ([{{id :id :as params} :params} options]
   (let [account (authorize (accounts/find-by-id (env :db) id) :show)]
     (with-accounts-layout (format "Account - %s" (:name account)) (:entity-id account) options
       (show-account account params)))))

(defn- form-fields
  "Renders the form fields for an account"
  [account]
  (html
    (text-input-field account :name {:autofocus true})
    (select-field account :type (map #(vector :option {:value %} (humanize %))
                                     accounts/account-types))
    (select-field account
                  :parent-id
                  (grouped-options-for-accounts (:entity-id account)
                                                {:include-none? true
                                                 :selected-id (:parent-id account)}))
    [:input.btn.btn-primary {:type :submit
                             :value "Save"
                             :title "Click here to save the account"}]
    " "
    [:a.btn.btn-default {:href (format "/entities/%s/accounts" (:entity-id account))
                         :title "Click here to return to the list of accounts."}
     "Back"]))

(defn- new-account-defaults
  [{:keys [entity-id parent-id]}]
  (let [parent (if parent-id
                 (accounts/find-by-id (env :db)  parent-id))
        account {:entity-id entity-id}]
    (tag-resource (if parent
                    (-> account
                        (assoc :parent-id (:id parent))
                        (assoc :type (:type parent)))
                    account) :account)))

(defn new-account
  "Renders the new account form"
  ([{params :params :as req}]
   (new-account req (new-account-defaults params)))
  ([{{entity :entity} :params} account]
   (with-accounts-layout "New account" entity {}
     (form (format "/entities/%s/accounts" (:id entity)) {}
           (form-fields (authorize account :new))))))

(defn create
  "Creates the account and redirects to the index page on success, or
  re-renders the new form on failure"
  [{params :params}]
  (let [account (accounts/create (env :db)
                                 (-> params
                                     (select-keys [:entity-id
                                                   :name
                                                   :type
                                                   :parent-id])
                                     (tag-resource :account)
                                     (authorize :create)))]
    (if (validation/has-error? account)
      (new-account {:params (select-keys account [:entity-id])} account)
      (redirect (str "/entities/" (:entity-id account) "/accounts")))))

(defn edit
  "Renders the edit form for an account"
  [req]
  (let [account (authorize (or (:account req)
                               (accounts/find-by-id (env :db) (-> req :params :id)))
                           :edit)]
    (with-accounts-layout "Edit account" (:entity-id account) {}
      (form (format "/accounts/%s" (:id account)) {}
            [:input {:type :hidden
                     :name "entity-id"
                     :value (:entity-id account)}]
            (form-fields account)))))

(defn update
  "Updates the account and redirects to the account list on
  success or rerenders the edit from on error"
  [{params :params}]
  (let [account (authorize (accounts/find-by-id (env :db) (:id params))
                           :update)]
    (let [updated (merge account
                         (select-keys params [:id
                                              :name
                                              :type
                                              :entity-id
                                              :parent-id]))
          result (accounts/update (env :db) updated)]
      (if (validation/has-error? result)
        (edit {:account result})
        (redirect (format "/entities/%s/accounts" (:entity-id result)))))))

(defn delete
  "Deletes the specified account"
  [{{id :id :as params} :params}]
  (let [account (authorize (accounts/find-by-id (env :db) id) :delete)]
    (try
      (accounts/delete (env :db) (:id account))
      (redirect (format "/entities/%s/accounts" (:entity-id account)))
      (catch Exception e
        (log/error e "Unable to delete account id=" id)
        (index (:entity-id account) {:alerts [{:type :danger
                                               :message (html [:strong "Unable to delete the account."]
                                                              " "
                                                              (.getMessage e))}]})))))

(ns clj-money.web.accounts
  (:refer-clojure :exclude [update])
  (:require [clojure.tools.logging :as log]
            [clojure.pprint :refer [pprint]]
            [environ.core :refer [env]]
            [hiccup.core :refer :all]
            [hiccup.page :refer :all]
            [ring.util.response :refer :all]
            [ring.util.codec :refer [url-encode]]
            [clj-money.authorization :refer [authorize
                                             allowed?
                                             apply-scope
                                             tag-resource]]
            [clj-money.permissions.accounts]
            [clj-money.permissions.transactions]
            [clj-money.permissions.reconciliations]
            [clj-money.url :refer :all]
            [clj-money.inflection :refer [humanize]]
            [clj-money.util :refer [format-number
                                    pprint-and-return]]
            [clj-money.pagination :as pagination]
            [clj-money.validation :as validation]
            [clj-money.models.accounts :as accounts]
            [clj-money.models.transactions :as transactions]
            [clj-money.models.commodities :as commodities]
            [clj-money.models.lots :as lots]
            [clj-money.models.prices :as prices]
            [clj-money.web.money-shared :refer [grouped-options-for-accounts
                                                budget-monitors]]
            [clj-money.reports :as reports])
  (:use [clj-money.web.shared :refer :all]))

(defmacro with-accounts-layout
  [page-title entity-or-id options & content]
  `(with-layout
     ~page-title (assoc ~options :side-bar (budget-monitors ~entity-or-id))
     ~@content))

(defn- can-add-child?
  [account]
  true)

(defn- account-row
  "Renders a single account row"
  [account depth]
  [:tr
   [:td
    [:span {:class (format "account-depth-%s" depth)}
     (:name account)
     " "
     (when (can-add-child? account)
       [:a.small-add {:href (format "/entities/%s/accounts/new?parent-id=%s" (:entity-id account) (:id account))
                      :title "Click here to add a child to this account."}
        "+"])]]
   [:td.text-right
    [:span {:class (format "balance-depth-%s" depth)}
     (format-number (+ (:balance account) (:children-balance account)))]]
   [:td
    [:span.btn-group
     (when (allowed? :show account)
       (glyph-button :list-alt
                     (format "/accounts/%s" (:id account))
                     {:level :default
                      :size :extra-small
                      :title "Click here to view transactions for this account"
                      :disabled (contains? (:tags account) :tradable)}))
     (when (allowed? :create (-> {:account-id (:id account)}
                                 (tag-resource :reconciliation)))
       (glyph-button :check
                     (format "/accounts/%s/reconciliations/new" (:id account))
                     {:level :default
                      :size :extra-small
                      :title "Click here to reconcile this account"}))
     (when (allowed? :edit account)
       (glyph-button :pencil
                     (format "/accounts/%s/edit" (:id account))
                     {:level :info
                      :size :extra-small
                      :title "Click here to edit this account"}))
     (when (allowed? :delete account)
       (glyph-button :remove
                     (format "/accounts/%s/delete" (:id account))
                     {:level :danger
                      :size :extra-small
                      :data-method :post
                      :data-confirm "Are you sure you want to delete this account?"
                      :title "Click here to remove this account"
                      :disabled (seq (:children account))}))]]])

(defn- render-child-rows?
  [account]
  true)

(defn- account-and-children-rows
  "Renders an individual account row and any child rows"
  ([account] (account-and-children-rows account 0))
  ([account depth]
   (let [account-row (account-row account depth)]
     (if (render-child-rows? account)
       (concat
         [account-row]
         (->> (:children account)
              (map #(account-and-children-rows % (+ depth 1)))
              (into [])))
       account-row))))

(defn- account-rows
  "Renders rows for all accounts and type headers"
  [{:keys [type accounts]}]
  (html
    [:tr.account-type
     [:td type]
     [:td.text-right (->> accounts
                          (map (juxt :balance :children-balance))
                          (reduce (fn [sum [balance children-balance]]
                                    (+ sum balance children-balance))
                                  0)
                          format-number)]
     [:td " "]]
    (map account-and-children-rows accounts)))

(defn index
  "Renders the list of accounts"
  ([req] (index req {}))
  ([{{entity :entity :as params} :params} options]
   (with-accounts-layout "Accounts" entity (merge options {:entity entity})
     [:table.table.table-striped
      [:tr
       [:th.col-sm-6 "Name"]
       [:th.col-sm-4.text-right "Balance"]
       [:th.col-sm-2 " "]]
      (let [groups (->> (apply-scope {:entity-id (:id entity)}
                                     :account)
                        (accounts/search (env :db))
                        accounts/nest)]
        (map account-rows groups))]
     [:a.btn.btn-primary
      {:href (format "/entities/%s/accounts/new" (:id entity))
       :title "Click here to add a new account."}
      "Add"])))

(defn- transaction-item-row
  [{:keys [transaction
           description
           polarized-amount
           reconciled?
           account-id
           balance] :as item}]
  [:tr
   [:td.text-right (:transaction-date transaction)]
   [:td (:description transaction)]
   [:td.text-right (format-number polarized-amount)]
   [:td.text-right (format-number balance)]
   [:td.text-center [:span.glyphicon
                     {:aria-hidden "true"
                      :class (if reconciled? "glyphicon-check" "glyphicon-unchecked")}]]
   [:td
    [:span.btn-group
     (when (allowed? :update transaction)
       (glyph-button :pencil
                     (-> (path "/transactions" (:id transaction) "edit")
                         (query {:redirect (url-encode (format "/accounts/%s" account-id))})
                         format-url)
                     {:level :info
                      :size :extra-small
                      :title "Click here to edit this transaction."}))
     (glyph-button :paperclip
                   (-> (path "/transactions" (:id transaction) "attachments")
                       (query {:redirect (url-encode (format "/accounts/%s" account-id))})
                       format-url)
                   {:level :default
                    :size :extra-small
                    :title "Click here to view attachments for this transaction."})
     (when (allowed? :delete transaction)
       (let [can-delete? (transactions/can-delete? transaction)]
         (glyph-button :remove
                       (-> (path "/transactions" (:id transaction) "delete")
                           (query {:redirect (url-encode (format "/accounts/%s" account-id))})
                           format-url)
                       {:level :danger
                        :disabled (not can-delete?)
                        :size :extra-small
                        :title (if can-delete?
                                 "Click here to remove this transaction."
                                 "This transaction contains reconciled items and cannot be removed.")
                        :data-method :post
                        :data-confirm "Are you sure you want to remove this transaction?"
                        :method :post})))]]])

(defmulti ^:private show-account
  (fn [account params]
    (cond
      (contains? (:tags account) :trading)
      :trading-account

      (contains? (:tags account) :tradable)
      :trading-detail

      :else
      :standard)))

(defmethod ^:private show-account :standard
  [account params]
  (html
    [:table.table.table-striped.table-hover
     [:tr
      [:th.text-right "Date"]
      [:th "Description"]
      [:th.text-right "Amount"]
      [:th.text-right "Balance"]
      [:th.text-center "Rec."]
      [:th " "]]
     (->> (transactions/search-items (env :db)
                                     {:account-id (:id account)}
                                     (pagination/prepare-options params))
          (map #(assoc % :transaction (transactions/find-by-id
                                        (env :db)
                                        (:transaction-id %)
                                        (:transaction-date %))))
          (map transaction-item-row))]
    [:p
     (pagination/nav
       (assoc params
              :url (-> (path "/accounts"
                             (:id account)))
              :total (transactions/count-items-by-account (env :db) (:id account))))]

    [:p
     [:a.btn.btn-primary
      {:href (-> (path "/entities"
                       (:entity-id account)
                       "transactions"
                       "new")
                 (query {:redirect (url-encode (format "/accounts/%s" (:id account)))})
                 format-url)
       :title "Click here to add a new transaction."}
      "Add"]
     " "
     [:a.btn.btn-default
      {:href (format "/accounts/%s/reconciliations/new" (:id account))
       :title "Click here to reconcile this account."}
      "Reconcile"]
     " "
     [:a.btn.btn-default
      {:href (format "/entities/%s/accounts" (:entity-id account))
       :title "Click here to return to the list of accounts."}
      "Back"]]))

(defn- commodity-row
  [{:keys [style
           caption
           shares
           price
           cost
           gain
           value
           commodity-id]}
   account]
  [:tr {:class (format "report-%s" (name style))}
   [:td caption]
   [:td.text-right (if shares
                     (format-number shares {:format :commodity-price})
                     " ")]
   [:td.text-right (if price
                     (format-number price {:format :commodity-price})
                     " ")]
   [:td.text-right (format-number value)]
   [:td {:class (when gain (format "text-right %s" (if (<= 0 gain) "gain" "loss")))}
    (if gain
      (format-number gain)
      " ")]
   [:td
    (when shares
      [:div.btn-group
       (glyph-button :list-alt
                     (format "/accounts/%s/lots?commodity-id=%s"
                             (:id account)
                             commodity-id)
                     {:size :extra-small
                      :title "Click here to view the lots for this commodity"})
       (glyph-button :plus-sign
                     (format "/accounts/%s/purchases/new?commodity-id=%s"
                             (:id account)
                             commodity-id)
                     {:size :extra-small
                      :level :success
                      :title "Click here to purchase more shares of this commodity."})
       (glyph-button :minus-sign
                     (format "/accounts/%s/sales/new?commodity-id=%s&shares=%s"
                             (:id account)
                             commodity-id
                             shares)
                     {:size :extra-small
                      :level :danger
                      :title "Click here to sell shares of this commodity."})])]])

(defmethod show-account :trading-account
  [account params]
  (html
    (let [summary (reports/commodities-account-summary (env :db) (:id account))]
      [:div.row
       [:div.col-md-10
        [:table.table.table-striped.table-hover
         [:tr
          [:th "Commodity"]
          [:th.text-right "Shares"]
          [:th.text-right "Price"]
          [:th.text-right "Value"]
          [:th.text-right "Gain"]
          [:th " "]]
         (if (seq summary)
           (map #(commodity-row % account)
                summary)
           [:tr
            [:td.empty-table {:colspan 4}
             "This account does not have any positions"]])]]])
    [:a.btn.btn-primary
     {:href (format "/accounts/%s/purchases/new" (:id account))
      :title "Click here to purchase a commodity with this account."}
     "Purchase"]
    " "
    [:a.btn.btn-default
     {:href (format "/entities/%s/accounts" (:entity-id account))
      :title "Click here to return to the list of accounts"}
     "Back"]))

(defmethod show-account :trading-detail
  [account params]
  (html
    [:p
     "Information page for commodity accounts is not ready yet."]
    [:a.btn.btn-primary
     {:href (format "/entities/%s/accounts" (:entity-id account))
      :title "Click here to return to the list of accounts."}
     "Back"]))

(defn show
  "Renders account details, including transactions"
  ([req] (show req {}))
  ([{{id :id :as params} :params} options]
   (let [account (authorize (accounts/find-by-id (env :db) id) :show)]
     (with-accounts-layout (format "Account - %s" (:name account)) (:entity-id account) options
       (show-account account params)))))

(defn- form-fields
  "Renders the form fields for an account"
  [account]
  (html
    (text-input-field account :name {:autofocus true})
    (select-field account :type (map #(vector :option {:value %} (humanize %))
                                     accounts/account-types))
    (select-field account
                  :parent-id
                  (grouped-options-for-accounts (:entity-id account)
                                                {:include-none? true
                                                 :selected-id (:parent-id account)}))
    [:input.btn.btn-primary {:type :submit
                             :value "Save"
                             :title "Click here to save the account"}]
    " "
    [:a.btn.btn-default {:href (format "/entities/%s/accounts" (:entity-id account))
                         :title "Click here to return to the list of accounts."}
     "Back"]))

(defn- new-account-defaults
  [{:keys [entity-id parent-id]}]
  (let [parent (if parent-id
                 (accounts/find-by-id (env :db)  parent-id))
        account {:entity-id entity-id}]
    (tag-resource (if parent
                    (-> account
                        (assoc :parent-id (:id parent))
                        (assoc :type (:type parent)))
                    account) :account)))

(defn new-account
  "Renders the new account form"
  ([{params :params :as req}]
   (new-account req (new-account-defaults params)))
  ([{{entity :entity} :params} account]
   (with-accounts-layout "New account" entity {}
     (form (format "/entities/%s/accounts" (:id entity)) {}
           (form-fields (authorize account :new))))))

(defn create
  "Creates the account and redirects to the index page on success, or
  re-renders the new form on failure"
  [{params :params}]
  (let [account (accounts/create (env :db)
                                 (-> params
                                     (select-keys [:entity-id
                                                   :name
                                                   :type
                                                   :parent-id])
                                     (tag-resource :account)
                                     (authorize :create)))]
    (if (validation/has-error? account)
      (new-account {:params (select-keys account [:entity-id])} account)
      (redirect (str "/entities/" (:entity-id account) "/accounts")))))

(defn edit
  "Renders the edit form for an account"
  [req]
  (let [account (authorize (or (:account req)
                               (accounts/find-by-id (env :db) (-> req :params :id)))
                           :edit)]
    (with-accounts-layout "Edit account" (:entity-id account) {}
      (form (format "/accounts/%s" (:id account)) {}
            [:input {:type :hidden
                     :name "entity-id"
                     :value (:entity-id account)}]
            (form-fields account)))))

(defn update
  "Updates the account and redirects to the account list on
  success or rerenders the edit from on error"
  [{params :params}]
  (let [account (authorize (accounts/find-by-id (env :db) (:id params))
                           :update)]
    (let [updated (merge account
                         (select-keys params [:id
                                              :name
                                              :type
                                              :entity-id
                                              :parent-id]))
          result (accounts/update (env :db) updated)]
      (if (validation/has-error? result)
        (edit {:account result})
        (redirect (format "/entities/%s/accounts" (:entity-id result)))))))

(defn delete
  "Deletes the specified account"
  [{{id :id :as params} :params}]
  (let [account (authorize (accounts/find-by-id (env :db) id) :delete)]
    (try
      (accounts/delete (env :db) (:id account))
      (redirect (format "/entities/%s/accounts" (:entity-id account)))
      (catch Exception e
        (log/error e "Unable to delete account id=" id)
        (index (:entity-id account) {:alerts [{:type :danger
                                               :message (html [:strong "Unable to delete the account."]
                                                              " "
                                                              (.getMessage e))}]})))))

add missing param

add missing param


(ns planck.core
  (:require [cljs.js :as cljs]
            [cljs.pprint :refer [pprint]]
            [cljs.tagged-literals :as tags]
            [cljs.tools.reader :as r]
            [cljs.tools.reader.reader-types :refer [string-push-back-reader]]
            [cljs.analyzer :as ana]
            [cljs.repl :as repl]
            [clojure.string :as s]
            [cljs.env]
            [planck.io]))

(def st (cljs/empty-state))

(def current-ns (atom 'cljs.user))

(defn repl-read-string [line]
  (r/read-string {:read-cond :allow :features #{:cljs}} line))

(defn ^:export is-readable? [line]
  (binding [r/*data-readers* tags/*cljs-data-readers*]
    (try
      (repl-read-string line)
      true
      (catch :default _
        false))))

(defn ns-form? [form]
  (and (seq? form) (= 'ns (first form))))

(def repl-specials '#{in-ns doc})

(defn repl-special? [form]
  (and (seq? form) (repl-specials (first form))))

(def repl-special-doc-map
  '{in-ns {:arglists ([name])
           :doc      "Sets *cljs-ns* to the namespace named by the symbol, creating it if needed."}
    doc   {:arglists ([name])
           :doc      "Prints documentation for a var or special form given its name"}})

(defn- repl-special-doc [name-symbol]
  (assoc (repl-special-doc-map name-symbol)
    :name name-symbol
    :repl-special-function true))

;; Copied from cljs.analyzer.api (which hasn't yet been converted to cljc)
(defn resolve
  "Given an analysis environment resolve a var. Analogous to
   clojure.core/resolve"
  [env sym]
  {:pre [(map? env) (symbol? sym)]}
  (try
    (ana/resolve-var env sym
      (ana/confirm-var-exists-throw))
    (catch :default _
      (ana/resolve-macro-var env sym))))

(defn ^:export print-prompt []
  (print (str @current-ns "=> ")))

(defn form-full-path [relative-path extension]
  (str "/Users/mfikes/Projects/planck/ClojureScript/planck/src"
    relative-path extension))

(defn extension->lang [extension]
  (if (= ".js" extension)
    :js
    :clj))

(defn load-and-callback! [path extension cb]
  (let [full-path (form-full-path path extension)]
    (cb {:lang   (extension->lang extension)
         :source (planck.io/slurp full-path)})))

(defn load [{:keys [name macros path]} cb]
  (loop [extensions (if macros
                      [".clj" ".cljc"]
                      [".cljs" ".cljc" ".js"])]
    (if extensions
      (try
        (load-and-callback! path (first extensions) cb)
        (catch :default _
          (recur (next extensions))))
      (cb nil))))

(defn eval [{:keys [source]}]
  (try
    {:result (js/eval source)}
    (catch :default e
      {:error     true
       :exception e})))

(defn ^:export read-eval-print [line]
  (binding [ana/*cljs-ns* @current-ns
            *ns* (create-ns @current-ns)
            r/*data-readers* tags/*cljs-data-readers*]
    (let [env (assoc (ana/empty-env) :context :expr
                                     :ns {:name @current-ns})
          form (repl-read-string line)]
      (if (repl-special? form)
        (case (first form)
          in-ns (reset! current-ns (second (second form)))
          doc (if (repl-specials (second form))
                (repl/print-doc (repl-special-doc (second form)))
                (repl/print-doc
                  (let [sym (second form)
                        var (resolve env sym)]
                    (:meta var)))))
        (cljs/eval-str
          st
          line
          nil
          {:load          load
           :eval          eval
           :verbose       true
           :context       :expr
           :def-emits-var true}
          (fn [{:keys [ns value] :as ret}]
            (if-not (:error value)
              (let [result (:result value)]
                (prn result)
                (when-not
                  (or ('#{*1 *2 *3 *e} form)
                    (ns-form? form))
                  (set! *3 *2)
                  (set! *2 *1)
                  (set! *1 result))
                (reset! current-ns ns)
                nil)
              (let [e (:exception value)]
                (set! *e e)
                (print (.-message e) "\n"
                  (first (s/split (.-stack e) #"eval code")))))))))))

(ns planck.core
  (:require [cljs.js :as cljs]
            [cljs.pprint :refer [pprint]]
            [cljs.tagged-literals :as tags]
            [cljs.tools.reader :as r]
            [cljs.tools.reader.reader-types :refer [string-push-back-reader]]
            [cljs.analyzer :as ana]
            [cljs.repl :as repl]
            [clojure.string :as s]
            [cljs.env :as env]
            [planck.io]))

(def st (cljs/empty-state))

(def current-ns (atom 'cljs.user))

(defn repl-read-string [line]
  (r/read-string {:read-cond :allow :features #{:cljs}} line))

(defn ^:export is-readable? [line]
  (binding [r/*data-readers* tags/*cljs-data-readers*]
    (try
      (repl-read-string line)
      true
      (catch :default _
        false))))

(defn ns-form? [form]
  (and (seq? form) (= 'ns (first form))))

(def repl-specials '#{in-ns require doc})

(defn repl-special? [form]
  (and (seq? form) (repl-specials (first form))))

(def repl-special-doc-map
  '{in-ns   {:arglists ([name])
             :doc      "Sets *cljs-ns* to the namespace named by the symbol, creating it if needed."}
    require {:arglists ([& args])
             :doc      "Loads libs, skipping any that are already loaded."}
    doc     {:arglists ([name])
             :doc      "Prints documentation for a var or special form given its name"}})

(defn- repl-special-doc [name-symbol]
  (assoc (repl-special-doc-map name-symbol)
    :name name-symbol
    :repl-special-function true))

;; Copied from cljs.analyzer.api (which hasn't yet been converted to cljc)
(defn resolve
  "Given an analysis environment resolve a var. Analogous to
   clojure.core/resolve"
  [env sym]
  {:pre [(map? env) (symbol? sym)]}
  (try
    (ana/resolve-var env sym
      (ana/confirm-var-exists-throw))
    (catch :default _
      (ana/resolve-macro-var env sym))))

(defn ^:export print-prompt []
  (print (str @current-ns "=> ")))

(defn form-full-path [relative-path extension]
  (str "/Users/mfikes/Projects/planck/ClojureScript/planck/src/"
    relative-path extension))

(defn extension->lang [extension]
  (if (= ".js" extension)
    :js
    :clj))

(defn load-and-callback! [path extension cb]
  (let [full-path (form-full-path path extension)]
    (println "trying to load" full-path (planck.io/slurp full-path))
    (cb {:lang   (extension->lang extension)
         :source (planck.io/slurp full-path)})))

(defn load [{:keys [name macros path]} cb]
  (loop [extensions (if macros
                      [".clj" ".cljc"]
                      [".cljs" ".cljc" ".js"])]
    (if extensions
      (try
        (load-and-callback! path (first extensions) cb)
        (catch :default _
          (recur (next extensions))))
      (cb nil))))

(defn eval [{:keys [source]}]
  (try
    {:result (js/eval source)}
    (catch :default e
      {:error     true
       :exception e})))

(defn require [args]
  "((quote foo.bar) :reload)"
  (prn "require" args)
  (cljs.js/require
    {:*compiler*     (env/default-compiler-env)
     :*data-readers* tags/*cljs-data-readers*
     :*load-fn*      load
     :*eval-fn*      eval}
    (second (first args))
    (second args)
    (fn [res]
      (println "require result:" res))))

(defn ^:export read-eval-print [line]
  (binding [ana/*cljs-ns* @current-ns
            *ns* (create-ns @current-ns)
            r/*data-readers* tags/*cljs-data-readers*]
    (let [env (assoc (ana/empty-env) :context :expr
                                     :ns {:name @current-ns})
          form (repl-read-string line)]
      (if (repl-special? form)
        (case (first form)
          in-ns (reset! current-ns (second (second form)))
          require (planck.core/require (rest form))
          doc (if (repl-specials (second form))
                (repl/print-doc (repl-special-doc (second form)))
                (repl/print-doc
                  (let [sym (second form)
                        var (resolve env sym)]
                    (:meta var)))))
        (cljs/eval-str
          st
          line
          nil
          {:load          load
           :eval          eval
           :verbose       true
           :context       :expr
           :def-emits-var true}
          (fn [{:keys [ns value] :as ret}]
            (if-not (:error value)
              (let [result (:result value)]
                (prn result)
                (when-not
                  (or ('#{*1 *2 *3 *e} form)
                    (ns-form? form))
                  (set! *3 *2)
                  (set! *2 *1)
                  (set! *1 result))
                (reset! current-ns ns)
                nil)
              (let [e (:exception value)]
                (set! *e e)
                (print (.-message e) "\n"
                  (first (s/split (.-stack e) #"eval code")))))))))))

Add a require REPL special

Add a require REPL special


(ns circle.backend.action.tag
  (:require [circle.backend.build :as build])
  (:use [circle.backend.action :only (defaction)])
  (:use [circle.util.except :only (throw-if-not)])
  (:require [circle.backend.nodes :as nodes])
  (:require [circle.backend.ec2 :as ec2]))

(defaction tag-revision []
  {:name "tag revision"}
  (fn [build]
    (throw-if-not (-> @build :vcs_revision) "build must contain vcs revision")
    (ec2/add-tags (-> @build :instance-ids)
                  {:rev (-> @build :vcs_revision)
                   :build (build/build-name @build)})))

(ns circle.backend.action.tag
  (:require [circle.backend.build :as build])
  (:use [circle.backend.action :only (defaction)])
  (:use [circle.util.except :only (throw-if-not)])
  (:require [circle.backend.nodes :as nodes])
  (:require [circle.backend.ec2 :as ec2]))

(defaction tag-revision []
  {:name "tag revision"}
  (fn [build]
    (throw-if-not (-> @build :vcs_revision) "build must contain vcs revision")
    (ec2/add-tags (-> @build :instance-ids)
                  {:rev (-> @build :vcs_revision)
                   :build (build/build-name build)})))

Fix a bug tagging builds with their build name


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>

(ns vertx.timers
  "The timers and async scheduled tasks."
  (:require
   [clojure.spec.alpha :as s]
   [promesa.core :as p]
   [vertx.util :as vu])
  (:import
   io.vertx.core.Vertx
   io.vertx.core.Handler))

(defn schedule-once!
  [vsm ms f]
  (let [^Vertx system (vu/resolve-system vsm)
        ^Handler handler (vu/fn->handler (fn [v] (f)))
        timer-id (.setTimer system ms handler)]
    (reify
      java.lang.AutoCloseable
      (close [_]
        (.cancelTimer system timer-id)))))

(defn sechdule-periodic!
  [vsm ms f]
  (let [^Vertx system (vu/resolve-system vsm)
        ^Handler handler (vu/fn->handler (fn [v] (f)))
        timer-id (.setPeriodic system ms handler)]
    (reify
      java.lang.AutoCloseable
      (close [_]
        (.cancelTimer system timer-id)))))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>

(ns vertx.timers
  "The timers and async scheduled tasks."
  (:require
   [clojure.spec.alpha :as s]
   [promesa.core :as p]
   [vertx.util :as vu])
  (:import
   io.vertx.core.Vertx
   io.vertx.core.Handler))

;; --- Low Level API

(defn schedule-once!
  [vsm ms f]
  (let [^Vertx system (vu/resolve-system vsm)
        ^Handler handler (vu/fn->handler (fn [v] (f)))
        timer-id (.setTimer system ms handler)]
    (reify
      java.lang.AutoCloseable
      (close [_]
        (.cancelTimer system timer-id)))))

(defn sechdule-periodic!
  [vsm ms f]
  (let [^Vertx system (vu/resolve-system vsm)
        ^Handler handler (vu/fn->handler (fn [v] (f)))
        timer-id (.setPeriodic system ms handler)]
    (reify
      java.lang.AutoCloseable
      (close [_]
        (.cancelTimer system timer-id)))))

;; --- High Level API

(s/def ::once boolean?)
(s/def ::repeat boolean?)
(s/def ::delay integer?)
(s/def ::fn (s/or :fn fn? :var var?))

(s/def ::schedule-opts
  (s/keys :req [::fn ::delay] :opt [::once ::repeat]))

(defn schedule!
  "High level schedule function."
  [vsm {:keys [::once ::repeat ::delay] :as opts}]
  (s/assert ::schedule-opts opts)

  (when (and (not once) (not repeat))
    (throw (IllegalArgumentException. "you should specify `once` or `repeat` params")))

  (let [system (vu/resolve-system vsm)
        state  (atom nil)
        taskfn (fn wrapped-task []
                 (-> (p/do! ((::fn opts) opts))
                     (p/catch' (constantly nil)) ; explicitly ignore all errors
                     (p/then'  (fn [_]            ; the user needs to catch errors
                                 (when repeat
                                   (let [tid (schedule-once! vsm delay wrapped-task)]
                                     (reset! state tid)
                                     nil))))))
        tid  (schedule-once! vsm delay taskfn)]
    (reset! state tid)
    (reify
      java.lang.AutoCloseable
      (close [this]
        (locking this
          (when-let [timer-id (deref state)]
            (.cancelTimer system timer-id)
            (reset! state nil)))))))

:tada: Add high level `schedule!` function to vertx.timers.


(ns quil.snippets.math.trigonometry
  (:require #?(:clj [quil.snippets.macro :refer [defsnippet]])
            [quil.core :as q :include-macros true]
            quil.snippets.all-snippets-internal)
  #?(:cljs
     (:use-macros [quil.snippets.macro :only [defsnippet]])))

(defsnippet acos
  "acos"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/acos 0) = " (q/acos 0)) 10 20)
  (q/text (str "(q/acos 1) = " (q/acos 1)) 10 40))

#?(:cljs
   (defsnippet angle-mode
     "angle-mode"
     {}

     (comment "draw a red square for reference")
     (q/fill "red")
     (q/rect 0 0 100 100)

     (comment "rotation will be in degrees (instead of the default radians)")
     (q/angle-mode :degrees)
     (q/rotate 45)

     (comment "draw a green square after the rotation of 45 degrees")
     (q/fill "green")
     (q/rect 0 0 100 100)))

(defsnippet asin
  "asin"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/asin 0) = " (q/asin 0)) 10 20)
  (q/text (str "(q/asin 1) = " (q/asin 1)) 10 40))

(defsnippet atan
  "atan"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/atan 0) = " (q/atan 0)) 10 20)
  (q/text (str "(q/atan 1) = " (q/atan 1)) 10 40))

(defsnippet atan2-s
  "atan2"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/atan2 2 1) = " (q/atan2 2 1)) 10 20)
  (q/text (str "(q/atan2 1 2) = " (q/atan2 1 2)) 10 40))

(defsnippet cos
  "cos"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/cos 0) = " (q/cos 0)) 10 20)
  (q/text (str "(q/cos q/HALF-PI) = " (q/cos q/HALF-PI)) 10 40))

(defsnippet degrees
  "degrees"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/degrees 0) = " (q/degrees 0)) 10 20)
  (q/text (str "(q/degrees q/HALF-PI) = " (q/degrees q/HALF-PI)) 10 40))

(defsnippet radians
  "radians"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/radians 0) = " (q/radians 0)) 10 20)
  (q/text (str "(q/radians 90) = " (q/radians 90)) 10 40))

(defsnippet sin
  "sin"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/sin 0) = " (q/sin 0)) 10 20)
  (q/text (str "(q/sin q/HALF-PI) = " (q/sin q/HALF-PI)) 10 40))

(defsnippet tan
  "tan"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/tan 0) = " (q/tan 0)) 10 20)
  (q/text (str "(q/tan  q/QUARTER-PI) = " (q/tan  q/QUARTER-PI)) 10 40))

(ns quil.snippets.math.trigonometry
  (:require #?(:clj [quil.snippets.macro :refer [defsnippet]])
            [quil.core :as q :include-macros true]
            quil.snippets.all-snippets-internal)
  #?(:cljs
     (:use-macros [quil.snippets.macro :only [defsnippet]])))

(defsnippet acos
  "acos"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/acos 0) = " (q/acos 0)) 10 20)
  (q/text (str "(q/acos 1) = " (q/acos 1)) 10 40))

#?(:cljs
   (defsnippet angle-mode
     "angle-mode"
     {}

     (comment "draw a red square for reference")
     (q/fill 255 0 0)
     (q/rect 0 0 100 100)

     (comment "rotation will be in degrees (instead of the default radians)")
     (q/angle-mode :degrees)
     (q/rotate 45)

     (comment "draw a green square after the rotation of 45 degrees")
     (q/fill 0 255 0)
     (q/rect 0 0 100 100)))

(defsnippet asin
  "asin"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/asin 0) = " (q/asin 0)) 10 20)
  (q/text (str "(q/asin 1) = " (q/asin 1)) 10 40))

(defsnippet atan
  "atan"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/atan 0) = " (q/atan 0)) 10 20)
  (q/text (str "(q/atan 1) = " (q/atan 1)) 10 40))

(defsnippet atan2-s
  "atan2"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/atan2 2 1) = " (q/atan2 2 1)) 10 20)
  (q/text (str "(q/atan2 1 2) = " (q/atan2 1 2)) 10 40))

(defsnippet cos
  "cos"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/cos 0) = " (q/cos 0)) 10 20)
  (q/text (str "(q/cos q/HALF-PI) = " (q/cos q/HALF-PI)) 10 40))

(defsnippet degrees
  "degrees"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/degrees 0) = " (q/degrees 0)) 10 20)
  (q/text (str "(q/degrees q/HALF-PI) = " (q/degrees q/HALF-PI)) 10 40))

(defsnippet radians
  "radians"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/radians 0) = " (q/radians 0)) 10 20)
  (q/text (str "(q/radians 90) = " (q/radians 90)) 10 40))

(defsnippet sin
  "sin"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/sin 0) = " (q/sin 0)) 10 20)
  (q/text (str "(q/sin q/HALF-PI) = " (q/sin q/HALF-PI)) 10 40))

(defsnippet tan
  "tan"
  {}

  (q/background 255)
  (q/fill 0)
  (q/text (str "(q/tan 0) = " (q/tan 0)) 10 20)
  (q/text (str "(q/tan  q/QUARTER-PI) = " (q/tan  q/QUARTER-PI)) 10 40))

Use 3 arguments version of q/fill instead of unofficial cljs-specific string argument.


(ns onyx.coordinator.cluster-test
  (:require [clojure.test :refer :all]
            [clojure.core.async :refer [chan <!! >!! <! >! tap go]]
            [clojure.data.generators :as gen]
            [com.stuartsierra.component :as component]
            [datomic.api :as d]
            [onyx.system :as s]
            [onyx.coordinator.extensions :as extensions]
            [onyx.coordinator.log.datomic :as datomic]))

(def system (s/onyx-system {:sync :zookeeper :queue :hornetq :eviction-delay 500000}))

(def components (alter-var-root #'system component/start))

(def coordinator (:coordinator components))

(def sync-storage (:sync components))

(def log (:log components))

(def tx-queue (d/tx-report-queue (:conn log)))

(def offer-spy (chan 1000))

(tap (:offer-mult coordinator) offer-spy)

(def catalog
  [{:onyx/name :in
    :onyx/direction :input
    :onyx/consumption :sequential
    :onyx/type :queue
    :onyx/medium :hornetq
    :hornetq/queue-name "in-queue"}
   {:onyx/name :inc
    :onyx/type :transformer
    :onyx/consumption :sequential}
   {:onyx/name :out
    :onyx/direction :output
    :onyx/consumption :sequential
    :onyx/type :queue
    :onyx/medium :hornetq
    :hornetq/queue-name "out-queue"}])

(def workflow {:in {:inc :out}})

(def n-jobs 15)

(def n-peers 10)

(def tasks-per-job 3)

(doseq [_ (range n-jobs)]
  (>!! (:planning-ch-head coordinator) {:catalog catalog :workflow workflow}))

(doseq [_ (range n-jobs)]
  (<!! offer-spy))

(def peers (take n-peers (repeatedly (fn [] (extensions/create sync-storage :peer)))))

(defn start-peers! [peers]
  (doseq [peer peers]
    (go (try
          (let [payload (extensions/create sync-storage :payload)
                sync-spy (chan 1)
                status-spy (chan 1)]
            (extensions/write-place sync-storage peer payload)
            (extensions/on-change sync-storage payload #(go (>! sync-spy %)))

            (>! (:born-peer-ch-head coordinator) peer)

            (loop [payload-node payload]
              (<! sync-spy)

              (let [nodes (:nodes (extensions/read-place sync-storage payload-node))]
                (extensions/on-change sync-storage (:status nodes) #(go (>! status-spy %)))
                (extensions/touch-place sync-storage (:ack nodes))
                (<! status-spy)

                (let [next-payload (extensions/create sync-storage :payload)]
                  (extensions/write-place sync-storage peer next-payload)
                  (extensions/on-change sync-storage next-payload #(go (>! sync-spy %)))
                  (extensions/touch-place sync-storage (:completion nodes))

                  (recur next-payload)))))
          (catch Exception e (prn e))))))

(start-peers! peers)

(testing "All tasks complete"
  (loop []
    (let [db (:db-after (.take tx-queue))
          query '[:find (count ?task) :where [?task :task/complete? true]]
          result (ffirst (d/q query db))]
      (prn result)
      (when-not (= result (* n-jobs tasks-per-job))
        (recur)))))

(def result-db (d/db (:conn log)))

(deftest task-completeness
  (testing "No tasks are left incomplete"
    (let [query '[:find (count ?task) :where [?task :task/complete? false]]
          result (ffirst (d/q query result-db))]
      (is (nil? result)))))

(deftest task-safety
  (testing "No sequential task ever had more than 1 peer"
    (let [query '[:find ?task (count ?peer) :where
                  [?task :task/consumption :sequential]
                  [?peer :peer/task ?task]]
          result (map second (d/q query (d/history result-db)))]
      (is (every? (partial = 1) result)))))

(deftest peer-liveness
  (testing "No peers got 0 tasks"
    (let [query '[:find ?peer :where
                  [?peer :peer/task]]
          result (map first (d/q query (d/history result-db)))]
      (is (= (count result) n-peers)))))

(deftest peer-fairness
  (testing "All peers got a roughly even number of tasks assigned"
    (let [query '[:find ?peer (count ?task) :where
                  [?peer :peer/task ?task]]
          result (map second (d/q query (d/history result-db)))
          mean (/ (* n-jobs tasks-per-job) n-peers)
          confidence 0.5]
      (is (every?
           #(and (<= (- mean (* mean confidence)) %)
                 (>= (+ mean (* mean confidence)) %))
           result)))))

(run-tests 'onyx.coordinator.cluster-test)

(alter-var-root #'system component/stop)

(ns onyx.coordinator.cluster-test
  (:require [clojure.test :refer :all]
            [clojure.core.async :refer [chan <!! >!! <! >! tap go]]
            [clojure.data.generators :as gen]
            [com.stuartsierra.component :as component]
            [datomic.api :as d]
            [onyx.system :as s]
            [onyx.coordinator.extensions :as extensions]
            [onyx.coordinator.log.datomic :as datomic]))

(def system (s/onyx-system {:sync :zookeeper :queue :hornetq :eviction-delay 500000}))

(def components (alter-var-root #'system component/start))

(def coordinator (:coordinator components))

(def sync-storage (:sync components))

(def log (:log components))

(def tx-queue (d/tx-report-queue (:conn log)))

(def offer-spy (chan 1000))

(tap (:offer-mult coordinator) offer-spy)

(def catalog
  [{:onyx/name :in
    :onyx/direction :input
    :onyx/consumption :sequential
    :onyx/type :queue
    :onyx/medium :hornetq
    :hornetq/queue-name "in-queue"}
   {:onyx/name :inc
    :onyx/type :transformer
    :onyx/consumption :sequential}
   {:onyx/name :out
    :onyx/direction :output
    :onyx/consumption :sequential
    :onyx/type :queue
    :onyx/medium :hornetq
    :hornetq/queue-name "out-queue"}])

(def workflow {:in {:inc :out}})

(def n-jobs 15)

(def n-peers 10)

(def tasks-per-job 3)

(doseq [_ (range n-jobs)]
  (>!! (:planning-ch-head coordinator) {:catalog catalog :workflow workflow}))

(doseq [_ (range n-jobs)]
  (<!! offer-spy))

(def peers (take n-peers (repeatedly (fn [] (extensions/create sync-storage :peer)))))

(defn start-peers! [peers]
  (doseq [peer peers]
    (go (try
          (let [payload (extensions/create sync-storage :payload)
                sync-spy (chan 1)
                status-spy (chan 1)]
            (extensions/write-place sync-storage peer payload)
            (extensions/on-change sync-storage payload #(go (>! sync-spy %)))

            (>! (:born-peer-ch-head coordinator) peer)

            (loop [payload-node payload]
              (<! sync-spy)

              (let [nodes (:nodes (extensions/read-place sync-storage payload-node))]
                (extensions/on-change sync-storage (:status nodes) #(go (>! status-spy %)))
                (extensions/touch-place sync-storage (:ack nodes))
                (<! status-spy)

                (let [next-payload (extensions/create sync-storage :payload)]
                  (extensions/write-place sync-storage peer next-payload)
                  (extensions/on-change sync-storage next-payload #(go (>! sync-spy %)))
                  (extensions/touch-place sync-storage (:completion nodes))

                  (recur next-payload)))))
          (catch Exception e (prn e))))))

(start-peers! peers)

(testing "All tasks complete"
  (loop []
    (let [db (:db-after (.take tx-queue))
          query '[:find (count ?task) :where [?task :task/complete? true]]
          result (ffirst (d/q query db))]
      (prn result)
      (when-not (= result (* n-jobs tasks-per-job))
        (recur)))))

(def result-db (d/db (:conn log)))

(deftest task-completeness
  (testing "No tasks are left incomplete"
    (let [query '[:find (count ?task) :where [?task :task/complete? false]]
          result (ffirst (d/q query result-db))]
      (is (nil? result)))))

(deftest task-safety
  (testing "No sequential task ever had more than 1 peer"
    (let [query '[:find ?task (count ?peer) :where
                  [?task :task/consumption :sequential]
                  [?peer :peer/task ?task]]
          result (map second (d/q query (d/history result-db)))]
      (is (every? (partial = 1) result)))))

(deftest peer-liveness
  (testing "No peers got 0 tasks"
    (let [query '[:find ?peer :where
                  [?peer :peer/task]]
          result (map first (d/q query (d/history result-db)))]
      (is (= (count result) n-peers)))))

(deftest peer-fairness
  (testing "All peers got a roughly even number of tasks assigned"
    (let [query '[:find ?peer (count ?task) :where
                  [?peer :peer/task ?task]]
          result (map second (d/q query (d/history result-db)))
          mean (/ (* n-jobs tasks-per-job) n-peers)
          confidence 0.5]
      (is (every?
           #(and (<= (- mean (* mean confidence)) %)
                 (>= (+ mean (* mean confidence)) %))
           result)))))

#_(deftest concurrency-liveness
  (testing ">= 25% of all concurrency tasks got > 1 peer at some point"
    (let [query '[:find ?task (count ?peer) :where
                  [?task :task/consumption :concurrent]
                  [?peer :peer/task ?task]]
          result (map second (d/q query (d/history result-db)))]
      (is (>= (count (filter (partial < 1) result))
              (/ (* n-jobs tasks-per-job) 0.25))))))

(run-tests 'onyx.coordinator.cluster-test)

(alter-var-root #'system component/stop)

Test for concurrency.

Test for concurrency.