(ns frontend.components.build
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
            [frontend.async :refer [put!]]
            [frontend.datetime :as datetime]
            [frontend.models.container :as container-model]
            [frontend.models.build :as build-model]
            [frontend.models.plan :as plan-model]
            [frontend.models.project :as project-model]
            [frontend.components.build-config :as build-config]
            [frontend.components.build-head :as build-head]
            [frontend.components.build-invites :as build-invites]
            [frontend.components.build-steps :as build-steps]
            [frontend.components.common :as common]
            [frontend.components.project.common :as project-common]
            [frontend.state :as state]
            [frontend.utils :as utils :include-macros true]
            [frontend.utils.github :as gh-utils]
            [frontend.utils.vcs-url :as vcs-url]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [sablono.core :as html :refer-macros [html]])
    (:require-macros [frontend.utils :refer [html]]))

(defn report-error [build controls-ch]
  (let [build-id (build-model/id build)
        build-url (:build_url build)]
    (when (:failed build)
      [:div.alert.alert-danger
       (if-not (:infrastructure_fail build)
         [:div.alert-wrap
          "Error! "
          [:a {:href "/docs/troubleshooting"}
           "Check out common problems "]
          "or "
          [:a {:title "Report an error in how Circle ran this build"
               :on-click #(put! controls-ch [:report-build-clicked {:build-url build-url}])}
           "report this issue"]
          " and we'll investigate."]

         [:div
          "Looks like we had a bug in our infrastructure, or that of our providers (generally "
          [:a {:href "https://status.github.com/"} "GitHub"]
          " or "
          [:a {:href "https://status.aws.amazon.com/"} "AWS"]
          ") We should have automatically retried this build. We've been alerted of"
          " the issue and are almost certainly looking into it, please "
          (common/contact-us-inner controls-ch)
          " if you're interested in the cause of the problem."])])))

(defn container-pill [{:keys [container current-container-id build-running?]} owner]
  (reify
    om/IRender
    (render [_]
      (html
       (let [container-id (container-model/id container)
             controls-ch (om/get-shared owner [:comms :controls])
             status (container-model/status container build-running?)]
         [:li {:class (when (= container-id current-container-id) "active")}
          [:a.container-selector
           {:on-click #(put! controls-ch [:container-selected {:container-id container-id}])
            :class (container-model/status->classes status)}
           (str (:index container))
           (case status
             :failed [:i.fa.fa-times]
             :success [:i.fa.fa-check]
             :cancelled [:i.fa.fa-exclamation]
             :running [:i.fa.fa-clock-o]
             :waiting [:i.fa.fa-clock-o]
             nil)]])))))

(defn container-pills [data owner]
  (reify
    om/IRender
    (render [_]
      (let [container-data (:container-data data)
            build-running? (:build-running? data)
            {:keys [containers current-container-id]} container-data
            controls-ch (om/get-shared owner [:comms :controls])
            hide-pills? (or (>= 1 (count containers))
                            (empty? (remove :filler-action (mapcat :actions containers))))]
        (html
         [:div.containers (when hide-pills? {:style {:display "none"}})
          [:ul.container-list
           (for [container containers]
             (om/build container-pill
                       {:container container
                        :build-running? build-running?
                        :current-container-id current-container-id}
                       {:react-key (:index container)}))]])))))

(defn show-trial-notice? [plan]
  (and (plan-model/trial? plan)
       (plan-model/trial-over? plan)
       (> 4 (plan-model/days-left-in-trial plan))))

(defn notices [data owner]
  (reify
    om/IRender
    (render [_]
      (html
       (let [build-data (:build-data data)
             project-data (:project-data data)
             plan (:plan project-data)
             project (:project project-data)
             build (:build build-data)
             controls-ch (om/get-shared owner [:comms :controls])]
         [:div.row-fluid
          [:div.offset1.span10
           [:div (common/messages (:messages build))]
           (when (empty? (:messages build))
             [:div (report-error build controls-ch)])

           (when (and plan (show-trial-notice? plan))
             (om/build project-common/trial-notice plan))

           (when (and project (project-common/show-enable-notice project))
             (om/build project-common/enable-notice project))

           (when (and project (project-common/show-follow-notice project))
             (om/build project-common/follow-notice project))

           (when (build-model/display-build-invite build)
             (om/build build-invites/build-invites
                       (:invite-data build-data)
                       {:opts {:project-name (vcs-url/project-name (:vcs_url build))}}))

           (when (and (build-model/config-errors? build)
                      (not (:dismiss-config-errors build-data)))
             (om/build build-config/config-errors build))]])))))

(defn build [data owner]
  (reify
    om/IRender
    (render [_]
      (let [build (get-in data state/build-path)
            build-data (get-in data state/build-data-path)
            container-data (get-in data state/container-data-path)
            project-data (get-in data state/project-data-path)
            user (get-in data state/user-path)
            controls-ch (om/get-shared owner [:comms :controls])]
        (html
         [:div#build-log-container
          (if-not build
           [:div
             (om/build common/flashes (get-in data state/error-message-path))
             [:div.loading-spinner common/spinner]]

            [:div
             (om/build build-head/build-head {:build-data (dissoc build-data :container-data)
                                              :project-data project-data
                                              :user user})
             (om/build common/flashes (get-in data state/error-message-path))
             (om/build notices {:build-data (dissoc build-data :container-data)
                                :project-data project-data})
             (om/build container-pills {:container-data container-data
                                        :build-running? (build-model/running? build)})
             (om/build build-steps/container-build-steps container-data)

             (when (< 1 (count (:steps build)))
               [:div (common/messages (:messages build))])])])))))

(ns frontend.components.build
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
            [frontend.async :refer [put!]]
            [frontend.datetime :as datetime]
            [frontend.models.container :as container-model]
            [frontend.models.build :as build-model]
            [frontend.models.plan :as plan-model]
            [frontend.models.project :as project-model]
            [frontend.components.build-config :as build-config]
            [frontend.components.build-head :as build-head]
            [frontend.components.build-invites :as build-invites]
            [frontend.components.build-steps :as build-steps]
            [frontend.components.common :as common]
            [frontend.components.project.common :as project-common]
            [frontend.state :as state]
            [frontend.utils :as utils :include-macros true]
            [frontend.utils.github :as gh-utils]
            [frontend.utils.vcs-url :as vcs-url]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [sablono.core :as html :refer-macros [html]])
    (:require-macros [frontend.utils :refer [html]]))

(defn report-error [build controls-ch]
  (let [build-id (build-model/id build)
        build-url (:build_url build)]
    (when (:failed build)
      [:div.alert.alert-danger
       (if-not (:infrastructure_fail build)
         [:div.alert-wrap
          "Error! "
          [:a {:href "/docs/troubleshooting"}
           "Check out common problems "]
          "or "
          [:a {:title "Report an error in how Circle ran this build"
               :on-click #(put! controls-ch [:report-build-clicked {:build-url build-url}])}
           "report this issue"]
          " and we'll investigate."]

         [:div
          "Looks like we had a bug in our infrastructure, or that of our providers (generally "
          [:a {:href "https://status.github.com/"} "GitHub"]
          " or "
          [:a {:href "https://status.aws.amazon.com/"} "AWS"]
          ") We should have automatically retried this build. We've been alerted of"
          " the issue and are almost certainly looking into it, please "
          (common/contact-us-inner controls-ch)
          " if you're interested in the cause of the problem."])])))

(defn container-pill [{:keys [container current-container-id build-running?]} owner]
  (reify
    om/IRender
    (render [_]
      (html
       (let [container-id (container-model/id container)
             controls-ch (om/get-shared owner [:comms :controls])
             status (container-model/status container build-running?)]
         [:li {:class (when (= container-id current-container-id) "active")}
          [:a.container-selector
           {:on-click #(put! controls-ch [:container-selected {:container-id container-id}])
            :class (container-model/status->classes status)}
           (str (:index container))
           (case status
             :failed (common/ico :fail-light)
             :success (common/ico :pass-light)
             :canceled (common/ico :fail-light)
             :running (common/ico :logo-light)
             :waiting (common/ico :none-light)
             nil)]])))))

(defn container-pills [data owner]
  (reify
    om/IRender
    (render [_]
      (let [container-data (:container-data data)
            build-running? (:build-running? data)
            {:keys [containers current-container-id]} container-data
            controls-ch (om/get-shared owner [:comms :controls])
            hide-pills? (or (>= 1 (count containers))
                            (empty? (remove :filler-action (mapcat :actions containers))))]
        (html
         [:div.containers (when hide-pills? {:style {:display "none"}})
          [:ul.container-list
           (for [container containers]
             (om/build container-pill
                       {:container container
                        :build-running? build-running?
                        :current-container-id current-container-id}
                       {:react-key (:index container)}))]])))))

(defn show-trial-notice? [plan]
  (and (plan-model/trial? plan)
       (plan-model/trial-over? plan)
       (> 4 (plan-model/days-left-in-trial plan))))

(defn notices [data owner]
  (reify
    om/IRender
    (render [_]
      (html
       (let [build-data (:build-data data)
             project-data (:project-data data)
             plan (:plan project-data)
             project (:project project-data)
             build (:build build-data)
             controls-ch (om/get-shared owner [:comms :controls])]
         [:div.row-fluid
          [:div.offset1.span10
           [:div (common/messages (:messages build))]
           (when (empty? (:messages build))
             [:div (report-error build controls-ch)])

           (when (and plan (show-trial-notice? plan))
             (om/build project-common/trial-notice plan))

           (when (and project (project-common/show-enable-notice project))
             (om/build project-common/enable-notice project))

           (when (and project (project-common/show-follow-notice project))
             (om/build project-common/follow-notice project))

           (when (build-model/display-build-invite build)
             (om/build build-invites/build-invites
                       (:invite-data build-data)
                       {:opts {:project-name (vcs-url/project-name (:vcs_url build))}}))

           (when (and (build-model/config-errors? build)
                      (not (:dismiss-config-errors build-data)))
             (om/build build-config/config-errors build))]])))))

(defn build [data owner]
  (reify
    om/IRender
    (render [_]
      (let [build (get-in data state/build-path)
            build-data (get-in data state/build-data-path)
            container-data (get-in data state/container-data-path)
            project-data (get-in data state/project-data-path)
            user (get-in data state/user-path)
            controls-ch (om/get-shared owner [:comms :controls])]
        (html
         [:div#build-log-container
          (if-not build
           [:div
             (om/build common/flashes (get-in data state/error-message-path))
             [:div.loading-spinner common/spinner]]

            [:div
             (om/build build-head/build-head {:build-data (dissoc build-data :container-data)
                                              :project-data project-data
                                              :user user})
             (om/build common/flashes (get-in data state/error-message-path))
             (om/build notices {:build-data (dissoc build-data :container-data)
                                :project-data project-data})
             (om/build container-pills {:container-data container-data
                                        :build-running? (build-model/running? build)})
             (om/build build-steps/container-build-steps container-data)

             (when (< 1 (count (:steps build)))
               [:div (common/messages (:messages build))])])])))))

use slimmer icons for container pills

use slimmer icons for container pills


(ns frontend.components.forms
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
            [frontend.async :refer [put!]]
            [frontend.components.common :as common]
            [frontend.utils :as utils :include-macros true]
            [frontend.disposable :as disposable :refer [dispose]]
            [om.core :as om :include-macros true])
  (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]
                   [frontend.utils :refer [html]]))

;; Version 2 of the stateful button follows. New code should prefer this version, managed-button, over the old version, stateful-button.
;; Example usage:

;; component html:
;; [:form (forms/managed-button [:input {:type "submit" :on-click #(put! controls-ch [:my-control])}])]

;; controls handler:
;; (defmethod post-control-event! :my-control
;;   [target message args previous-state current-state]
;;   (let [status (do-something)
;;         uuid frontend.async/*uuid*]
;;     (forms/release-button! uuid status)))

(def registered-channels (atom {}))

(defn register-channel! [owner]
  (let [channel (chan)
        uuid (utils/uuid)]
    (swap! registered-channels assoc uuid channel)
    (om/update-state! owner [:registered-channel-uuids] #(conj % uuid))
    {:channel channel :uuid uuid}))

(defn deregister-channel! [owner uuid]
  (om/update-state! owner [:registered-channel-uuids] #(disj % uuid))
  (when-let [channel (get @registered-channels uuid)]
    (swap! registered-channels dissoc uuid)
    (close! channel)))

(defn release-button!
  "Used by the controls controller to set the button state. status should be a valid button state,
  :success, :failed, or :idle"
  [uuid status]
  (when-let [channel (get @registered-channels uuid)]
    (put! channel status)))

(defn append-cycle
  "Adds the button-state to the end of the lifecycle"
  [owner button-state]
  (om/update-state! owner [:lifecycle] #(conj % button-state)))

(defn wrap-managed-button-handler
  "Wraps the on-click handler with a uuid binding and registers a global channel
   so that the controls handler can communicate that it is finished with the button."
  [handler owner]
  (fn [& args]
    (append-cycle owner :loading)
    (let [{:keys [uuid channel]} (register-channel! owner)]
      (binding [frontend.async/*uuid* uuid]
        (go (append-cycle owner (<! channel))
            (deregister-channel! owner uuid))
        (apply handler args)))))

(defn schedule-idle
  "Transistions the state from success/failed to idle."
  [owner lifecycle]
  ;; Clear timer, just in case. No harm in clearing nil or finished timers
  (js/clearTimeout (om/get-state owner [:idle-timer]))
  (let [cycle-count (count lifecycle)
        t (js/setTimeout
           ;; Careful not to transition to idle if the spinner somehow got
           ;; back to a loading state. This shouldn't happen, but we'll be
           ;; extra careful.
           #(om/update-state! owner [:lifecycle]
                              (fn [cycles]
                                (if (= (count cycles) cycle-count)
                                  (conj cycles :idle)
                                  cycles)))
           1000)]
    (om/set-state! owner [:idle-timer] t)))

(defn managed-button*
  "Takes an ordinary input or button hiccup form.
   Automatically disables the button until the controls handler calls release-button!"
  [hiccup-form owner]
  (reify
    om/IDisplayName (display-name [_] "Managed button")
    om/IInitState
    (init-state [_]
      {:lifecycle [:idle]
       :registered-channel-uuids #{}
       :idle-timer nil})

    om/IWillUnmount
    (will-unmount [_]
      (js/clearTimeout (om/get-state owner [:idle-timer]))
      (doseq [uuid (om/get-state owner [:registered-channel-uuids])]
        (deregister-channel! owner uuid)))

    om/IWillUpdate
    (will-update [_ _ {:keys [lifecycle]}]
      (when (#{:success :failed} (last lifecycle))
        (schedule-idle owner lifecycle)))

    om/IRenderState
    (render-state [_ {:keys [lifecycle]}]
      (let [button-state (last lifecycle)
            [tag attrs & rest] hiccup-form
            data-field (keyword (str "data-" (name button-state) "-text"))
            new-value (-> (merge {:data-loading-text "..."
                                  :data-success-text "Saved"
                                  :data-failed-text "Failed"}
                                 attrs)
                          (get data-field (:value attrs)))
            new-body (cond (= :idle button-state) rest
                           (:data-spinner attrs) common/spinner
                           :else new-value)
            new-attrs (-> attrs
                          ;; Disable the button when it's not idle
                          ;; We're changing the value of the button, so its safer not to let
                          ;; people click on it.
                          (assoc :disabled (not= :idle button-state))
                          (update-in [:class] (fn [c] (cond (= :idle button-state) c
                                                            (string? c) (str c  " disabled")
                                                            (coll? c) (conj c "disabled")
                                                            :else "disabled")))
                          (update-in [:on-click] wrap-managed-button-handler owner)
                          (update-in [:value] (fn [v]
                                                (or new-value v))))]
        (html
         (vec (concat [tag new-attrs]
                      [new-body])))))))

(defn managed-button
  "Takes an ordinary input or button hiccup form.
   Disables the button while the controls handler waits for any API responses to come back.
   When the button is clicked, it replaces the button value with data-loading-text,
   when the response comes back, and the control handler calls release-button! it replaces the
   button with the data-:status-text for a second."
  [hiccup-form]
  (om/build managed-button* hiccup-form))

;; Version 1 of the stateful button

(defn tap-api
  "Sets up a tap of the api channel and watches for the API request associated with
  the form submission to complete.
  Runs success-fn if the API call was succesful and failure-fn if it failed.
  Will "
  [api-mult api-tap uuid {:keys [success-fn failure-fn api-count]
                          :or {api-count 1}}]
  (async/tap api-mult api-tap)
  (go-loop [api-calls 0 ; keep track of how many api-calls we handled
            results #{}]
           (let [v (<! api-tap)]
             (let [message-uuid (:uuid (meta v))
                   message (first v)
                   status (second v)]
               (cond
                (and (= uuid message-uuid)
                     (#{:success :failed} status))
                (if (and (= status :success) (< (inc api-calls) api-count))
                  (do (utils/mlog "completed" (inc api-calls) "of" api-count "api calls")
                      (recur (inc api-calls) (conj results status)))
                  (do (if (= #{:success} (conj results status))
                        (success-fn)
                        (failure-fn))
                      ;; There's a chance of a race if the button gets clicked twice.
                      ;; No good ideas on how to fix it, and it shouldn't happen,
                      ;; so punting for now
                      (async/untap api-mult api-tap)))

                (nil? v) nil ;; don't recur on closed channel

                :else (recur api-calls results))))))

(defn cleanup
  "Cleans up api-tap channel and stops the idle timer from firing"
  [owner]
  (dispose (om/get-state owner [:api-tap-id]))
  (js/clearTimeout (om/get-state owner [:idle-timer])))

(defn wrap-handler
  "Wraps the on-click handler with a uuid binding to trace the channel passing, and taps
  the api channel so that we can wait for the api call to finish successfully."
  [handler owner api-count]
  (let [api-tap (disposable/from-id (om/get-state owner [:api-tap-id]))
        api-mult (om/get-shared owner [:comms :api-mult])]
    (fn [& args]
      (append-cycle owner :loading)
      (let [uuid (utils/uuid)]
        (binding [frontend.async/*uuid* uuid]
          (tap-api api-mult api-tap uuid
                   {:api-count api-count
                    :success-fn
                    #(append-cycle owner :success)
                    :failure-fn
                    #(append-cycle owner :failed)})
          (apply handler args))))))

(defn stateful-button*
  "Takes an ordinary input or button hiccup form.
  Disables the button while it waits for the API response to come back.
  When the button is clicked, it replaces the button value with data-loading-text,
  when the response comes back, it replaces the button with the data-:status-text for a second."
  [hiccup-form owner]
  (reify
    om/IDisplayName (display-name [_] "Stateful button")
    om/IInitState
    (init-state [_]
      {:lifecycle [:idle]
       ;; use a sliding-buffer so that we don't block
       :api-tap-id (disposable/register (chan (sliding-buffer 10)) close!)
       :idle-timer nil})

    om/IWillUnmount (will-unmount [_] (cleanup owner))

    om/IWillUpdate
    (will-update [_ _ {:keys [lifecycle]}]
      (when (#{:success :failed} (last lifecycle))
        (schedule-idle owner lifecycle)))

    om/IRenderState
    (render-state [_ {:keys [lifecycle]}]
      (let [button-state (last lifecycle)
            [tag attrs & rest] hiccup-form
            data-field (keyword (str "data-" (name button-state) "-text"))
            new-value (-> (merge {:data-loading-text "..."
                                  :data-success-text "Saved"
                                  :data-failed-text "Failed"}
                                 attrs)
                          (get data-field (:value attrs)))
            new-body (cond (= :idle button-state) rest
                           (:data-spinner attrs) common/spinner
                           :else new-value)
            api-count (get attrs :data-api-count 1) ; number of api calls to wait for
            new-attrs (-> attrs
                          ;; Disable the button when it's not idle
                          ;; We're changing the value of the button, so its safer not to let
                          ;; people click on it.
                          (assoc :disabled (not= :idle button-state))
                          (update-in [:class] (fn [c] (cond (= :idle button-state) c
                                                            (string? c) (str c  " disabled")
                                                            (coll? c) (conj c "disabled")
                                                            :else "disabled")))
                          ;; Update the on-click handler to watch the api channel for success
                          (update-in [:on-click] wrap-handler owner api-count)
                          (update-in [:value] (fn [v]
                                                (or new-value v))))]
        (html
         (vec (concat [tag new-attrs]
                      [new-body])))))))

(defn stateful-button
  "Takes an ordinary input or button hiccup form.
   Disables the button while it waits for the API response to come back.
   When the button is clicked, it replaces the button value with data-loading-text,
   when the response comes back, it replaces the button with the data-:status-text for a second.
   If the button needs to wait for multiple api calls to complete, add data-api-count"
  [hiccup-form]
  (om/build stateful-button* hiccup-form))

(ns frontend.components.forms
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
            [frontend.async :refer [put!]]
            [frontend.components.common :as common]
            [frontend.utils :as utils :include-macros true]
            [frontend.disposable :as disposable :refer [dispose]]
            [om.core :as om :include-macros true])
  (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]
                   [frontend.utils :refer [html]]))

;; Version 2 of the stateful button follows. New code should prefer this version, managed-button, over the old version, stateful-button.
;; Example usage:

;; component html:
;; [:form (forms/managed-button [:input {:type "submit" :on-click #(put! controls-ch [:my-control])}])]

;; controls handler:
;; (defmethod post-control-event! :my-control
;;   [target message args previous-state current-state]
;;   (let [status (do-something)
;;         uuid frontend.async/*uuid*]
;;     (forms/release-button! uuid status)))

(def registered-channels (atom {}))

(defn register-channel! [owner]
  (let [channel (chan)
        uuid (utils/uuid)]
    (swap! registered-channels assoc uuid channel)
    (om/update-state! owner [:registered-channel-uuids] #(conj % uuid))
    {:channel channel :uuid uuid}))

(defn deregister-channel! [owner uuid]
  ;;XXX The `when is a hack to silently ignore updates to unmounted component state.
  (om/update-state! owner [:registered-channel-uuids] #(when % (disj % uuid)))
  (when-let [channel (get @registered-channels uuid)]
    (swap! registered-channels dissoc uuid)
    (close! channel)))

(defn release-button!
  "Used by the controls controller to set the button state. status should be a valid button state,
  :success, :failed, or :idle"
  [uuid status]
  (when-let [channel (get @registered-channels uuid)]
    (put! channel status)))

(defn append-cycle
  "Adds the button-state to the end of the lifecycle"
  [owner button-state]
  (om/update-state! owner [:lifecycle] #(conj % button-state)))

(defn wrap-managed-button-handler
  "Wraps the on-click handler with a uuid binding and registers a global channel
   so that the controls handler can communicate that it is finished with the button."
  [handler owner]
  (fn [& args]
    (append-cycle owner :loading)
    (let [{:keys [uuid channel]} (register-channel! owner)]
      (binding [frontend.async/*uuid* uuid]
        ;;XXX Async mutation of state may execute after dismount!
        (go (append-cycle owner (<! channel))
            (deregister-channel! owner uuid))
        (apply handler args)))))

(defn schedule-idle
  "Transistions the state from success/failed to idle."
  [owner lifecycle]
  ;; Clear timer, just in case. No harm in clearing nil or finished timers
  (js/clearTimeout (om/get-state owner [:idle-timer]))
  (let [cycle-count (count lifecycle)
        t (js/setTimeout
           ;; Careful not to transition to idle if the spinner somehow got
           ;; back to a loading state. This shouldn't happen, but we'll be
           ;; extra careful.
           #(om/update-state! owner [:lifecycle]
                              (fn [cycles]
                                (if (= (count cycles) cycle-count)
                                  (conj cycles :idle)
                                  cycles)))
           1000)]
    (om/set-state! owner [:idle-timer] t)))

(defn managed-button*
  "Takes an ordinary input or button hiccup form.
   Automatically disables the button until the controls handler calls release-button!"
  [hiccup-form owner]
  (reify
    om/IDisplayName (display-name [_] "Managed button")
    om/IInitState
    (init-state [_]
      {:lifecycle [:idle]
       :registered-channel-uuids #{}
       :idle-timer nil})

    om/IWillUnmount
    (will-unmount [_]
      (js/clearTimeout (om/get-state owner [:idle-timer]))
      (doseq [uuid (om/get-state owner [:registered-channel-uuids])]
        (deregister-channel! owner uuid)))

    om/IWillUpdate
    (will-update [_ _ {:keys [lifecycle]}]
      (when (#{:success :failed} (last lifecycle))
        (schedule-idle owner lifecycle)))

    om/IRenderState
    (render-state [_ {:keys [lifecycle]}]
      (let [button-state (last lifecycle)
            [tag attrs & rest] hiccup-form
            data-field (keyword (str "data-" (name button-state) "-text"))
            new-value (-> (merge {:data-loading-text "..."
                                  :data-success-text "Saved"
                                  :data-failed-text "Failed"}
                                 attrs)
                          (get data-field (:value attrs)))
            new-body (cond (= :idle button-state) rest
                           (:data-spinner attrs) common/spinner
                           :else new-value)
            new-attrs (-> attrs
                          ;; Disable the button when it's not idle
                          ;; We're changing the value of the button, so its safer not to let
                          ;; people click on it.
                          (assoc :disabled (not= :idle button-state))
                          (update-in [:class] (fn [c] (cond (= :idle button-state) c
                                                            (string? c) (str c  " disabled")
                                                            (coll? c) (conj c "disabled")
                                                            :else "disabled")))
                          (update-in [:on-click] wrap-managed-button-handler owner)
                          (update-in [:value] (fn [v]
                                                (or new-value v))))]
        (html
         (vec (concat [tag new-attrs]
                      [new-body])))))))

(defn managed-button
  "Takes an ordinary input or button hiccup form.
   Disables the button while the controls handler waits for any API responses to come back.
   When the button is clicked, it replaces the button value with data-loading-text,
   when the response comes back, and the control handler calls release-button! it replaces the
   button with the data-:status-text for a second."
  [hiccup-form]
  (om/build managed-button* hiccup-form))

;; Version 1 of the stateful button

(defn tap-api
  "Sets up a tap of the api channel and watches for the API request associated with
  the form submission to complete.
  Runs success-fn if the API call was succesful and failure-fn if it failed.
  Will "
  [api-mult api-tap uuid {:keys [success-fn failure-fn api-count]
                          :or {api-count 1}}]
  (async/tap api-mult api-tap)
  (go-loop [api-calls 0 ; keep track of how many api-calls we handled
            results #{}]
           (let [v (<! api-tap)]
             (let [message-uuid (:uuid (meta v))
                   message (first v)
                   status (second v)]
               (cond
                (and (= uuid message-uuid)
                     (#{:success :failed} status))
                (if (and (= status :success) (< (inc api-calls) api-count))
                  (do (utils/mlog "completed" (inc api-calls) "of" api-count "api calls")
                      (recur (inc api-calls) (conj results status)))
                  (do (if (= #{:success} (conj results status))
                        (success-fn)
                        (failure-fn))
                      ;; There's a chance of a race if the button gets clicked twice.
                      ;; No good ideas on how to fix it, and it shouldn't happen,
                      ;; so punting for now
                      (async/untap api-mult api-tap)))

                (nil? v) nil ;; don't recur on closed channel

                :else (recur api-calls results))))))

(defn cleanup
  "Cleans up api-tap channel and stops the idle timer from firing"
  [owner]
  (dispose (om/get-state owner [:api-tap-id]))
  (js/clearTimeout (om/get-state owner [:idle-timer])))

(defn wrap-handler
  "Wraps the on-click handler with a uuid binding to trace the channel passing, and taps
  the api channel so that we can wait for the api call to finish successfully."
  [handler owner api-count]
  (let [api-tap (disposable/from-id (om/get-state owner [:api-tap-id]))
        api-mult (om/get-shared owner [:comms :api-mult])]
    (fn [& args]
      (append-cycle owner :loading)
      (let [uuid (utils/uuid)]
        (binding [frontend.async/*uuid* uuid]
          (tap-api api-mult api-tap uuid
                   {:api-count api-count
                    :success-fn
                    #(append-cycle owner :success)
                    :failure-fn
                    #(append-cycle owner :failed)})
          (apply handler args))))))

(defn stateful-button*
  "Takes an ordinary input or button hiccup form.
  Disables the button while it waits for the API response to come back.
  When the button is clicked, it replaces the button value with data-loading-text,
  when the response comes back, it replaces the button with the data-:status-text for a second."
  [hiccup-form owner]
  (reify
    om/IDisplayName (display-name [_] "Stateful button")
    om/IInitState
    (init-state [_]
      {:lifecycle [:idle]
       ;; use a sliding-buffer so that we don't block
       :api-tap-id (disposable/register (chan (sliding-buffer 10)) close!)
       :idle-timer nil})

    om/IWillUnmount (will-unmount [_] (cleanup owner))

    om/IWillUpdate
    (will-update [_ _ {:keys [lifecycle]}]
      (when (#{:success :failed} (last lifecycle))
        (schedule-idle owner lifecycle)))

    om/IRenderState
    (render-state [_ {:keys [lifecycle]}]
      (let [button-state (last lifecycle)
            [tag attrs & rest] hiccup-form
            data-field (keyword (str "data-" (name button-state) "-text"))
            new-value (-> (merge {:data-loading-text "..."
                                  :data-success-text "Saved"
                                  :data-failed-text "Failed"}
                                 attrs)
                          (get data-field (:value attrs)))
            new-body (cond (= :idle button-state) rest
                           (:data-spinner attrs) common/spinner
                           :else new-value)
            api-count (get attrs :data-api-count 1) ; number of api calls to wait for
            new-attrs (-> attrs
                          ;; Disable the button when it's not idle
                          ;; We're changing the value of the button, so its safer not to let
                          ;; people click on it.
                          (assoc :disabled (not= :idle button-state))
                          (update-in [:class] (fn [c] (cond (= :idle button-state) c
                                                            (string? c) (str c  " disabled")
                                                            (coll? c) (conj c "disabled")
                                                            :else "disabled")))
                          ;; Update the on-click handler to watch the api channel for success
                          (update-in [:on-click] wrap-handler owner api-count)
                          (update-in [:value] (fn [v]
                                                (or new-value v))))]
        (html
         (vec (concat [tag new-attrs]
                      [new-body])))))))

(defn stateful-button
  "Takes an ordinary input or button hiccup form.
   Disables the button while it waits for the API response to come back.
   When the button is clicked, it replaces the button value with data-loading-text,
   when the response comes back, it replaces the button with the data-:status-text for a second.
   If the button needs to wait for multiple api calls to complete, add data-api-count"
  [hiccup-form]
  (om/build stateful-button* hiccup-form))

Fix flaky test by hacking bad cleanup code.

Proper fix forthcoming with other Om-state cleanup.


(ns spec-tools.json-schema
  "Tools for converting specs into JSON Schemata."
  (:require [clojure.spec :as s]
            [spec-tools.visitor :as visitor :refer [visit]]))

(defn- only-entry? [key a-map] (= [key] (keys a-map)))

(defn- simplify-all-of [spec]
  (let [subspecs (->> (:allOf spec) (remove empty?))]
    (cond
      (empty? subspecs) (dissoc spec :allOf)
      (and (= (count subspecs) 1) (only-entry? :allOf spec)) (first subspecs)
      :else (assoc spec :allOf subspecs))))

(defn- unwrap
  "Unwrap [x] to x. Asserts that coll has exactly one element."
  [coll]
  {:pre [(= 1 (count coll))]}
  (first coll))

(defn- spec-dispatch [dispatch spec children] dispatch)
(defmulti accept-spec spec-dispatch :default ::default)

;; predicate list taken from https://github.com/clojure/clojure/blob/master/src/clj/clojure/spec/gen.clj

; any? (one-of [(return nil) (any-printable)])
; some? (such-that some? (any-printable))
; number? (one-of [(large-integer) (double)])

; integer? (large-integer)
(defmethod accept-spec 'clojure.core/integer? [_ _ _] {:type "integer"})

; int? (large-integer)
(defmethod accept-spec 'clojure.core/int? [_ _ _] {:type "integer"})

; pos-int? (large-integer* {:min 1})
; neg-int? (large-integer* {:max -1})
; nat-int? (large-integer* {:min 0})

; float? (double)
(defmethod accept-spec 'clojure.core/float? [_ _ _] {:type "number"})

; double? (double)
(defmethod accept-spec 'clojure.core/double? [_ _ _] {:type "number"})

; boolean? (boolean)
(defmethod accept-spec 'clojure.core/boolean? [_ _ _] {:type "boolean"})

; string? (string-alphanumeric)
(defmethod accept-spec 'clojure.core/string? [_ _ _] {:type "string"})

; ident? (one-of [(keyword-ns) (symbol-ns)])
; simple-ident? (one-of [(keyword) (symbol)])
; qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)]))

; keyword? (keyword-ns)
(defmethod accept-spec 'clojure.core/keyword? [_ _ _] {:type "string"})

; simple-keyword? (keyword)
; qualified-keyword? (such-that qualified? (keyword-ns))
; symbol? (symbol-ns)
; simple-symbol? (symbol)
; qualified-symbol? (such-that qualified? (symbol-ns))
; uuid? (uuid)
; uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid))
; bigdec? (fmap #(BigDecimal/valueOf %)
;               (double* {:infinite? false :NaN? false}))
; inst? (fmap #(java.util.Date. %)
;             (large-integer))
; seqable? (one-of [(return nil)
;                   (list simple)
;                   (vector simple)
;                   (map simple simple)
;                   (set simple)
;                   (string-alphanumeric)])
; indexed? (vector simple)
; map? (map simple simple)
; vector? (vector simple)
; list? (list simple)
; seq? (list simple)
; char? (char)
; set? (set simple)

; nil? (return nil)
(defmethod accept-spec 'clojure.core/nil? [_ _ _] {:type "null"})

; false? (return false)
; true? (return true)
; zero? (return 0)
; rational? (one-of [(large-integer) (ratio)])
; coll? (one-of [(map simple simple)
;                (list simple)
;                (vector simple)
;                (set simple)])
; empty? (elements [nil '() [] {} #{}])
; associative? (one-of [(map simple simple) (vector simple)])
; sequential? (one-of [(list simple) (vector simple)])
; ratio? (such-that ratio? (ratio))
; bytes? (bytes)

(defmethod accept-spec 'clojure.core/pos? [_ _ _] {:minimum 0 :exclusiveMinimum true})
(defmethod accept-spec 'clojure.core/neg? [_ _ _] {:maximum 0 :exclusiveMaximum true})

(defmethod accept-spec ::visitor/set [dispatch spec children]
  {:enum children})

(defn- is-map-of?
  "Predicate to check if spec looks like an expansion of clojure.spec/map-of."
  [spec]
  (let [[_ inner-spec & {:as kwargs}] (s/form spec)
        pred (when (seq? inner-spec) (first inner-spec))]
    ;; (s/map-of key-spec value-spec) expands to
    ;; (s/every (s/tuple key-spec value-spec) :into {} ...)
    (and (= pred #?(:clj 'clojure.spec/tuple :cljs 'cljs.spec/tuple)) (= (get kwargs :into)) {})))

; keys
(defmethod accept-spec 'clojure.spec/keys [dispatch spec children]
  (let [[_ & {:keys [req req-un opt opt-un]}] (s/form spec)
        names (map name (concat req req-un opt opt-un))
        required (map name (concat req req-un))]
    {:type "object"
     :properties (zipmap names children)
     :required required}))

; or
(defmethod accept-spec 'clojure.spec/or [dispatch spec children]
  {:anyOf children})

; and
(defmethod accept-spec 'clojure.spec/and [dispatch spec children]
  (simplify-all-of {:allOf children}))

; merge

; every
(defmethod accept-spec 'clojure.spec/every [dispatch spec children]
  ;; Special case handling of s/map-of, which expands to s/every
  (if (is-map-of? spec)
    {:type "object" :additionalProperties (get-in (unwrap children) [:items 1])}
    {:type "array" :items (unwrap children)}))

; every-ks
; coll-of
; map-of

; *
(defmethod accept-spec 'clojure.spec/* [dispatch spec children]
  {:type "array" :items (unwrap children)})

; +
(defmethod accept-spec 'clojure.spec/+ [dispatch spec children]
  {:type "array" :items (unwrap children) :minItems 1})

; ?
; alt
; cat
; &

; tuple
(defmethod accept-spec 'clojure.spec/tuple [dispatch spec children]
  {:type "array" :items children :minItems (count children)})

; keys*

; nilable

(defmethod accept-spec 'clojure.spec/nilable [dispatch spec children]
  {:oneOf [(unwrap children) {:type "null"}]})

;; this is just a function in clojure.spec?
(defmethod accept-spec 'clojure.spec/int-in-range? [dispatch spec children]
  (let [[_ minimum maximum _] (visitor/strip-fn-if-needed spec)]
    {:minimum minimum :maximum maximum}))

(defmethod accept-spec ::default [dispatch spec children]
  {})

(defn to-json [spec] (visit spec accept-spec))

(ns spec-tools.json-schema
  "Tools for converting specs into JSON Schemata."
  (:require [clojure.spec :as s]
            [spec-tools.visitor :as visitor :refer [visit]]))

(defn- only-entry? [key a-map] (= [key] (keys a-map)))

(defn- simplify-all-of [spec]
  (let [subspecs (->> (:allOf spec) (remove empty?))]
    (cond
      (empty? subspecs) (dissoc spec :allOf)
      (and (= (count subspecs) 1) (only-entry? :allOf spec)) (first subspecs)
      :else (assoc spec :allOf subspecs))))

(defn- unwrap
  "Unwrap [x] to x. Asserts that coll has exactly one element."
  [coll]
  {:pre [(= 1 (count coll))]}
  (first coll))

(defn- spec-dispatch [dispatch spec children] dispatch)
(defmulti accept-spec spec-dispatch :default ::default)

;;
;; predicate list taken from https://github.com/clojure/clojure/blob/master/src/clj/clojure/spec/gen.clj
;;

; any? (one-of [(return nil) (any-printable)])
(defmethod accept-spec 'clojure.core/any? [_ _ _] {:type "object"})

; some? (such-that some? (any-printable))
(defmethod accept-spec 'clojure.core/some? [_ _ _] {:type "object"})

; number? (one-of [(large-integer) (double)])
(defmethod accept-spec 'clojure.core/number? [_ _ _] {:type "double"})

; integer? (large-integer)
(defmethod accept-spec 'clojure.core/integer? [_ _ _] {:type "integer"})

; int? (large-integer)
(defmethod accept-spec 'clojure.core/int? [_ _ _] {:type "integer" :format "int64"})

; pos-int? (large-integer* {:min 1})
(defmethod accept-spec 'clojure.core/pos-int? [_ _ _] {:type "integer", :format "int64", :minimum 1})

; neg-int? (large-integer* {:max -1})
(defmethod accept-spec 'clojure.core/neg-int? [_ _ _] {:type "integer", :format "int64", :maximum -1})

; nat-int? (large-integer* {:min 0})
(defmethod accept-spec 'clojure.core/nat-int? [_ _ _] {:type "integer",, :format "int64" :minimum 0})

; float? (double)
(defmethod accept-spec 'clojure.core/float? [_ _ _] {:type "number"})

; double? (double)
(defmethod accept-spec 'clojure.core/double? [_ _ _] {:type "number"})

; boolean? (boolean)
(defmethod accept-spec 'clojure.core/boolean? [_ _ _] {:type "boolean"})

; string? (string-alphanumeric)
(defmethod accept-spec 'clojure.core/string? [_ _ _] {:type "string"})

; ident? (one-of [(keyword-ns) (symbol-ns)])
(defmethod accept-spec 'clojure.core/ident? [_ _ _] {:type "string"})

; simple-ident? (one-of [(keyword) (symbol)])
(defmethod accept-spec 'clojure.core/simple-ident? [_ _ _] {:type "string"})

; qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)]))
(defmethod accept-spec 'clojure.core/qualified-ident? [_ _ _] {:type "string"})

; keyword? (keyword-ns)
(defmethod accept-spec 'clojure.core/keyword? [_ _ _] {:type "string"})

; simple-keyword? (keyword)
(defmethod accept-spec 'clojure.core/simple-keyword? [_ _ _] {:type "string"})

; qualified-keyword? (such-that qualified? (keyword-ns))
(defmethod accept-spec 'clojure.core/qualified-keyword? [_ _ _] {:type "string"})

; symbol? (symbol-ns)
(defmethod accept-spec 'clojure.core/symbol? [_ _ _] {:type "string"})

; simple-symbol? (symbol)
(defmethod accept-spec 'clojure.core/simple-symbol? [_ _ _] {:type "string"})

; qualified-symbol? (such-that qualified? (symbol-ns))
(defmethod accept-spec 'clojure.core/qualified-symbol? [_ _ _] {:type "string"})

; uuid? (uuid)
(defmethod accept-spec 'clojure.core/uuid? [_ _ _] {:type "string" :format "uuid"})

; uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid))
(defmethod accept-spec 'clojure.core/uri? [_ _ _] {:type "string" :format "uri"})

; bigdec? (fmap #(BigDecimal/valueOf %)
;               (double* {:infinite? false :NaN? false}))
(defmethod accept-spec 'clojure.core/bigdec? [_ _ _] {:type "double"})

; inst? (fmap #(java.util.Date. %)
;             (large-integer))
(defmethod accept-spec 'clojure.core/bigdec? [_ _ _] {:type "double"})

; seqable? (one-of [(return nil)
;                   (list simple)
;                   (vector simple)
;                   (map simple simple)
;                   (set simple)
;                   (string-alphanumeric)])
(defmethod accept-spec 'clojure.core/seqable? [_ _ _] {:type "array"})

; indexed? (vector simple)
(defmethod accept-spec 'clojure.core/map? [_ _ _] {:type "array"})

; map? (map simple simple)
(defmethod accept-spec 'clojure.core/map? [_ _ _] {:type "object"})

; vector? (vector simple)
(defmethod accept-spec 'clojure.core/vector? [_ _ _] {:type "array"})

; list? (list simple)
(defmethod accept-spec 'clojure.core/list? [_ _ _] {:type "array"})

; seq? (list simple)
(defmethod accept-spec 'clojure.core/seq? [_ _ _] {:type "array"})

; char? (char)
(defmethod accept-spec 'clojure.core/char? [_ _ _] {:type "string"})

; set? (set simple)
(defmethod accept-spec 'clojure.core/set? [_ _ _] {:type "array" :uniqueItems true})

; nil? (return nil)
(defmethod accept-spec 'clojure.core/nil? [_ _ _] {:type "null"})

; false? (return false)
(defmethod accept-spec 'clojure.core/false? [_ _ _] {:type "boolean"})

; true? (return true)
(defmethod accept-spec 'clojure.core/true? [_ _ _] {:type "boolean"})

; zero? (return 0)
(defmethod accept-spec 'clojure.core/zero? [_ _ _] {:type "integer"})

; rational? (one-of [(large-integer) (ratio)])
(defmethod accept-spec 'clojure.core/coll? [_ _ _] {:type "double"})

; coll? (one-of [(map simple simple)
;                (list simple)
;                (vector simple)
;                (set simple)])
(defmethod accept-spec 'clojure.core/coll? [_ _ _] {:type "object"})

; empty? (elements [nil '() [] {} #{}])
(defmethod accept-spec 'clojure.core/coll? [_ _ _] {:type "array" :maxItems 0 :minItems 0})

; associative? (one-of [(map simple simple) (vector simple)])
(defmethod accept-spec 'clojure.core/associative? [_ _ _] {:type "object"})

; sequential? (one-of [(list simple) (vector simple)])
(defmethod accept-spec 'clojure.core/sequential? [_ _ _] {:type "array"})

; ratio? (such-that ratio? (ratio))
(defmethod accept-spec 'clojure.core/ratio? [_ _ _] {:type "integer"})

; bytes? (bytes)
(defmethod accept-spec 'clojure.core/ratio? [_ _ _] {:type "string" :format "byte"})

(defmethod accept-spec 'clojure.core/pos? [_ _ _] {:minimum 0 :exclusiveMinimum true})
(defmethod accept-spec 'clojure.core/neg? [_ _ _] {:maximum 0 :exclusiveMaximum true})

(defmethod accept-spec ::visitor/set [dispatch spec children]
  {:enum children})

(defn- is-map-of?
  "Predicate to check if spec looks like an expansion of clojure.spec/map-of."
  [spec]
  (let [[_ inner-spec & {:as kwargs}] (s/form spec)
        pred (when (seq? inner-spec) (first inner-spec))]
    ;; (s/map-of key-spec value-spec) expands to
    ;; (s/every (s/tuple key-spec value-spec) :into {} ...)
    (and (= pred #?(:clj 'clojure.spec/tuple :cljs 'cljs.spec/tuple)) (= (get kwargs :into)) {})))

; keys
(defmethod accept-spec 'clojure.spec/keys [dispatch spec children]
  (let [[_ & {:keys [req req-un opt opt-un]}] (s/form spec)
        names (map name (concat req req-un opt opt-un))
        required (map name (concat req req-un))]
    {:type "object"
     :properties (zipmap names children)
     :required required}))

; or
(defmethod accept-spec 'clojure.spec/or [dispatch spec children]
  {:anyOf children})

; and
(defmethod accept-spec 'clojure.spec/and [dispatch spec children]
  (simplify-all-of {:allOf children}))

; merge

; every
(defmethod accept-spec 'clojure.spec/every [dispatch spec children]
  ;; Special case handling of s/map-of, which expands to s/every
  (if (is-map-of? spec)
    {:type "object" :additionalProperties (get-in (unwrap children) [:items 1])}
    {:type "array" :items (unwrap children)}))

; every-ks
; coll-of
; map-of

; *
(defmethod accept-spec 'clojure.spec/* [dispatch spec children]
  {:type "array" :items (unwrap children)})

; +
(defmethod accept-spec 'clojure.spec/+ [dispatch spec children]
  {:type "array" :items (unwrap children) :minItems 1})

; ?
; alt
; cat
; &

; tuple
(defmethod accept-spec 'clojure.spec/tuple [dispatch spec children]
  {:type "array" :items children :minItems (count children)})

; keys*

; nilable

(defmethod accept-spec 'clojure.spec/nilable [dispatch spec children]
  {:oneOf [(unwrap children) {:type "null"}]})

;; this is just a function in clojure.spec?
(defmethod accept-spec 'clojure.spec/int-in-range? [dispatch spec children]
  (let [[_ minimum maximum _] (visitor/strip-fn-if-needed spec)]
    {:minimum minimum :maximum maximum}))

(defmethod accept-spec ::default [dispatch spec children]
  {})

(defn to-json [spec] (visit spec accept-spec))

Implement all core predicates,

Implement all core predicates,


(defproject ring/ring-jetty-adapter "1.8.0"
  :description "Ring Jetty adapter."
  :url "https://github.com/ring-clojure/ring"
  :scm {:dir ".."}
  :license {:name "The MIT License"
            :url "http://opensource.org/licenses/MIT"}
  :dependencies [[org.clojure/clojure "1.7.0"]
                 [ring/ring-core "1.8.0"]
                 [ring/ring-servlet "1.8.0"]
                 [org.eclipse.jetty/jetty-server "9.4.22.v20191022"]]
  :aliases {"test-all" ["with-profile" "default:+1.8:+1.9:+1.10" "test"]}
  :profiles
  {:dev  {:dependencies [[clj-http "3.10.0"]]
          :jvm-opts ["-Dorg.eclipse.jetty.server.HttpChannelState.DEFAULT_TIMEOUT=500"]}
   :1.8  {:dependencies [[org.clojure/clojure "1.8.0"]]}
   :1.9  {:dependencies [[org.clojure/clojure "1.9.0"]]}
   :1.10 {:dependencies [[org.clojure/clojure "1.10.1"]]}})

(defproject ring/ring-jetty-adapter "1.8.0"
  :description "Ring Jetty adapter."
  :url "https://github.com/ring-clojure/ring"
  :scm {:dir ".."}
  :license {:name "The MIT License"
            :url "http://opensource.org/licenses/MIT"}
  :dependencies [[org.clojure/clojure "1.7.0"]
                 [ring/ring-core "1.8.0"]
                 [ring/ring-servlet "1.8.0"]
                 [org.eclipse.jetty/jetty-server "9.4.24.v20191120"]]
  :aliases {"test-all" ["with-profile" "default:+1.8:+1.9:+1.10" "test"]}
  :profiles
  {:dev  {:dependencies [[clj-http "3.10.0"]]
          :jvm-opts ["-Dorg.eclipse.jetty.server.HttpChannelState.DEFAULT_TIMEOUT=500"]}
   :1.8  {:dependencies [[org.clojure/clojure "1.8.0"]]}
   :1.9  {:dependencies [[org.clojure/clojure "1.9.0"]]}
   :1.10 {:dependencies [[org.clojure/clojure "1.10.1"]]}})

Update Jetty to 9.4.24.v20191120

Update Jetty to 9.4.24.v20191120


; Licensed to the Apache Software Foundation (ASF) under one
; or more contributor license agreements. See the NOTICE file
; distributed with this work for additional information
; regarding copyright ownership. The ASF licenses this file
; to you under the Apache License, Version 2.0 (the
; "License"); you may not use this file except in compliance
; with the License. You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
(ns dda.pallet.dda-user-crate.app.instantiate-existing
  (:require
    [schema.core :as s]
    [dda.pallet.core.app :as core-app]
    [dda.pallet.dda-user-crate.app :as app]))

(defn install
  [& options]
  (let [{:keys [domain targets summarize-session]
         :or {domain "user.edn"
              targets "targets.edn"
              summarize-session true}} options]
    (core-app/existing-install app/crate-app
                          {:domain domain
                           :targets targets})))

(defn configure
 [& options]
 (let [{:keys [domain targets summarize-session]
        :or {domain "user.edn"
             targets "targets.edn"
             summarize-session true}} options]
  (core-app/existing-configure app/crate-app
                          {:domain domain
                           :targets targets})))

(defn serverspec
  [& options]
  (let [{:keys [domain targets summarize-session]
         :or {domain "user.edn"
              targets "targets.edn"
              summarize-session true}} options]
    (core-app/existing-serverspec app/crate-app
                             {:domain domain
                              :targets targets})))

; Licensed to the Apache Software Foundation (ASF) under one
; or more contributor license agreements. See the NOTICE file
; distributed with this work for additional information
; regarding copyright ownership. The ASF licenses this file
; to you under the Apache License, Version 2.0 (the
; "License"); you may not use this file except in compliance
; with the License. You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
(ns dda.pallet.dda-user-crate.app.instantiate-existing
  (:require
    [schema.core :as s]
    [dda.pallet.core.app :as core-app]
    [dda.pallet.dda-user-crate.app :as app]))

(defn- get-results-of-session
  "gets the results of the session in some form"
  [session]
  (let [results (:results session)
        phases (map #(-> % :result) results)
        exit-codes (map #(-> % :exit) (flatten phases))
        every-exit-code (every? #(or (= 0 %) (= nil %)) exit-codes)]
    (spit "phases.edn" (prn-str phases))
    (spit "results.edn" (prn-str results))
    (spit "exit-codes.edn" (prn-str exit-codes))
    (println every-exit-code)))

(defn install
  [& options]
  (let [{:keys [domain targets summarize-session]
         :or {domain "user.edn"
              targets "targets.edn"
              summarize-session true}} options]
    (let [session (get-results-of-session
                    (core-app/existing-install
                                            app/crate-app
                                            {:domain domain
                                             :targets targets}))])))

(defn configure
 [& options]
 (let [{:keys [domain targets summarize-session]
        :or {domain "user.edn"
             targets "targets.edn"
             summarize-session true}} options]
  (core-app/existing-configure app/crate-app
                          {:domain domain
                           :targets targets})))

(defn serverspec
  [& options]
  (let [{:keys [domain targets summarize-session]
         :or {domain "user.edn"
              targets "targets.edn"
              summarize-session true}} options]
    (core-app/existing-serverspec app/crate-app
                             {:domain domain
                              :targets targets})))

add function to parse session and return true if all actions successful or false if not


(ns org.openforis.ceo.db.imagery
  (:require [clojure.data.json :as json]
            [org.openforis.ceo.database :refer [call-sql sql-primitive]]
            [org.openforis.ceo.db.institutions :refer [is-inst-admin-query]] ; FIXME this function has not yet been converted in institutions
            [org.openforis.ceo.utils.type-conversion :as tc]
            [org.openforis.ceo.views :refer [data-response]]))

(defn- clean-source [sourceConfig]
  (if (#{"GeoServer" "SecureWatch" "Planet"})
    (select-keys sourceConfig [:type :startDate :endDate :month :year])
    sourceConfig))

(defn- map-imagery [imagery admin?]
  (mapv (fn [{:keys [imagery_id institution_id visibility title attribution extent source_config]}]
          {:id           imagery_id ; FIXME, legacy variable name, update to imageryId
           :institution  institution_id ; FIXME, legacy variable name, update to institutionId
           :visibility   visibility
           :title        title
           :attribution  attribution
           :extent       extent
           :sourceConfig (if admin? source_config (clean-source source_config))})
        imagery))

(defn get-institution-imagery [{:keys [params]}]
  (let [institution-id (tc/str->int (:institutionId params))
        user-id        (tc/str->int (:userId params))]
    (data-response (map-imagery (call-sql "select_imagery_by_institution" institution-id user-id)
                                (is-inst-admin-query user-id institution-id)))))

(defn get-project-imagery [{:keys [params]}]
  (let [project-id (tc/str->int (:projectId params))
        user-id    (tc/str->int (:userId params))
        token-key  (:token-key params)] ; TODO, what case are we using for the session?
    (data-response (map-imagery (call-sql "select_imagery_by_project" project-id user-id token-key)
                                false))))

(defn get-public-imagery [_]
  (data-response (map-imagery (call-sql "select_public_imagery")
                              false)))

(defn get-imagery-source-config [imagery-id]
  (data-response (sql-primitive (call-sql "select_imagery_source_config" imagery-id)))) ; FIXME this SQL function does not yet exist

(defn add-institution-imagery [{:keys [params]}]
  (let [institution-id       (tc/str->int (:institutionId params))
        imagery-title        (:imageryTitle params)
        imagery-attribution  (:imageryAttribution params)
        source-config        (json/read-str (:sourceConfig params)) ; TODO is this needed?
        add-to-all-projects? (tc/str-bool (:addToAllProjects params) true)]
    (if (sql-primitive (call-sql "check_institution_imagery")) ; TODO this SQL function name is unclear
      (data-response "The title you have chosen is already taken")
      (let [new-imagery-id (call-sql "add_institution_imagery"
                                     institution-id
                                     "private"
                                     imagery-title
                                     imagery-attribution
                                     nil ; FIXME, this was being saved a string to match JSON, create update query to replace "null" with NULL
                                     source-config)]
        (when add-to-all-projects?
          (call-sql "add_imagery_to_all_institution_projects" new-imagery-id))
        (data-response "")))))

;; TODO this should not be needed. Just build the source config on the front end and reuse add-institution-imagery
(defn add-geodash-imagery [{:keys [params]}]
  (let [institution-id      (tc/str->int (:institutionId params))
        imagery-title       (:imageryTitle params)
        imagery-attribution (:imageryAttribution params)
        gee-url             (:geeUrl params)
        gee-params          (json/read-str (:geeParam params))
        source-config       {:type      "GeeGateway"
                             :geeUrl    gee-url
                             :geeParams gee-params}]
    (if (sql-primitive (call-sql "check_institution_imagery"))
      (data-response "The title you have chosen is already taken")
      (do
        (call-sql "add_institution_imagery"
                  institution-id
                  "private"
                  imagery-title
                  imagery-attribution
                  nil
                  source-config)
        (data-response "")))))

(defn update-institution-imagery [{:keys [params]}]
  (let [imagery-id           (tc/str->int (:imageryId params))
        imagery-title        (:imageryTitle params) ;TODO there is no backend check for uniqueness. check_institution_imagery needs to be updated to handle existing imagery
        imagery-attribution  (:imageryAttribution params)
        source-config        (json/read-str (:sourceConfig params))
        add-to-all-projects? (tc/str-bool (:addToAllProjects params) true)]
    (call-sql "update_institution_imagery"
              imagery-id
              imagery-title
              imagery-attribution
              source-config)
    (when add-to-all-projects?
      (call-sql "add_imagery_to_all_institution_projects" imagery-id))
    (data-response "")))

(defn archive-institution-imagery [{:keys [params]}]
  (call-sql "archive_imagery" (tc/str->int (:imageryId params)))
  (data-response ""))

(ns org.openforis.ceo.db.imagery
  (:require [clojure.data.json :as json]
            [org.openforis.ceo.database :refer [call-sql sql-primitive]]
            [org.openforis.ceo.db.institutions :refer [is-inst-admin-query]] ; FIXME this function has not yet been converted in institutions
            [org.openforis.ceo.utils.type-conversion :as tc]
            [org.openforis.ceo.views :refer [data-response]]))

(defn- clean-source [sourceConfig]
  (if (#{"GeoServer" "SecureWatch" "Planet"})
    (select-keys sourceConfig [:type :startDate :endDate :month :year])
    sourceConfig))

(defn- map-imagery [imagery admin?]
  (mapv (fn [{:keys [imagery_id institution_id visibility title attribution extent source_config]}]
          {:id           imagery_id ; FIXME, legacy variable name, update to imageryId
           :institution  institution_id ; FIXME, legacy variable name, update to institutionId
           :visibility   visibility
           :title        title
           :attribution  attribution
           :extent       extent
           :sourceConfig (if admin? source_config (clean-source source_config))})
        imagery))

(defn get-institution-imagery [{:keys [params]}]
  (let [institution-id (tc/str->int (:institutionId params))
        user-id        (tc/str->int (:userId params))]
    (data-response (map-imagery (call-sql "select_imagery_by_institution" institution-id user-id)
                                (is-inst-admin-query user-id institution-id)))))

(defn get-project-imagery [{:keys [params]}]
  (let [project-id (tc/str->int (:projectId params))
        user-id    (tc/str->int (:userId params))
        token-key  (:token-key params)] ; TODO, what case are we using for the session?
    (data-response (map-imagery (call-sql "select_imagery_by_project" project-id user-id token-key)
                                false))))

(defn get-public-imagery [_]
  (data-response (map-imagery (call-sql "select_public_imagery")
                              false)))

(defn get-imagery-source-config [imagery-id]
  (data-response (sql-primitive (call-sql "select_imagery_source_config" imagery-id)))) ; FIXME this SQL function does not yet exist

(defn add-institution-imagery [{:keys [params]}]
  (let [institution-id       (tc/str->int (:institutionId params))
        imagery-title        (:imageryTitle params)
        imagery-attribution  (:imageryAttribution params)
        source-config        (json/read-str (:sourceConfig params)) ; TODO is this needed?
        add-to-all-projects? (tc/str-bool (:addToAllProjects params) true)]
    (if (sql-primitive (call-sql "check_institution_imagery")) ; TODO this SQL function name is unclear
      (data-response "The title you have chosen is already taken")
      (let [new-imagery-id (sql-primitive (call-sql "add_institution_imagery"
                                                    institution-id
                                                    "private"
                                                    imagery-title
                                                    imagery-attribution
                                                    nil ; FIXME, this was being saved a string to match JSON, create update query to replace "null" with NULL
                                                    source-config))]
        (when add-to-all-projects?
          (call-sql "add_imagery_to_all_institution_projects" new-imagery-id))
        (data-response "")))))

;; TODO this should not be needed. Just build the source config on the front end and reuse add-institution-imagery
(defn add-geodash-imagery [{:keys [params]}]
  (let [institution-id      (tc/str->int (:institutionId params))
        imagery-title       (:imageryTitle params)
        imagery-attribution (:imageryAttribution params)
        gee-url             (:geeUrl params)
        gee-params          (json/read-str (:geeParam params))
        source-config       {:type      "GeeGateway"
                             :geeUrl    gee-url
                             :geeParams gee-params}]
    (if (sql-primitive (call-sql "check_institution_imagery"))
      (data-response "The title you have chosen is already taken")
      (do
        (call-sql "add_institution_imagery"
                  institution-id
                  "private"
                  imagery-title
                  imagery-attribution
                  nil
                  source-config)
        (data-response "")))))

(defn update-institution-imagery [{:keys [params]}]
  (let [imagery-id           (tc/str->int (:imageryId params))
        imagery-title        (:imageryTitle params) ;TODO there is no backend check for uniqueness. check_institution_imagery needs to be updated to handle existing imagery
        imagery-attribution  (:imageryAttribution params)
        source-config        (json/read-str (:sourceConfig params))
        add-to-all-projects? (tc/str-bool (:addToAllProjects params) true)]
    (call-sql "update_institution_imagery"
              imagery-id
              imagery-title
              imagery-attribution
              source-config)
    (when add-to-all-projects?
      (call-sql "add_imagery_to_all_institution_projects" imagery-id))
    (data-response "")))

(defn archive-institution-imagery [{:keys [params]}]
  (call-sql "archive_imagery" (tc/str->int (:imageryId params)))
  (data-response ""))

add missing sql-primitive

add missing sql-primitive


(ns clj-money.models.reconciliations
  (:refer-clojure :exclude [update])
  (:require [clojure.spec :as s]
            [clojure.pprint :refer [pprint]]
            [clj-time.coerce :refer [to-local-date]]
            [clj-money.util :refer [to-sql-date]]
            [clj-money.validation :as validation]
            [clj-money.coercion :as coercion]
            [clj-money.authorization :as authorization]
            [clj-money.models.accounts :as accounts]
            [clj-money.models.transactions :as transactions]
            [clj-money.models.helpers :refer [with-storage
                                              with-transacted-storage]]
            [clj-money.models.storage :refer [create-reconciliation
                                              update-reconciliation
                                              select-reconciliations-by-account-id
                                              find-reconciliation-by-id
                                              find-last-reconciliation-by-account-id
                                              find-new-reconciliation-by-account-id
                                              set-transaction-items-reconciled
                                              unreconcile-transaction-items-by-reconciliation-id
                                              delete-reconciliation]])
  (:import org.joda.time.LocalDate))

(s/def ::account-id integer?)
(s/def ::end-of-period #(instance? LocalDate %))
(s/def ::balance decimal?)
(s/def ::status #{:new :completed})
(s/def ::item-id integer?)
(s/def ::item-ids (s/coll-of ::item-id))

(s/def ::new-reconciliation (s/keys :req-un [::account-id ::end-of-period ::status ::balance] :opt-un [::item-ids]))
(s/def ::existing-reconciliation (s/keys :req-un [::id ::end-of-period ::status ::balance] :opt-un [::account-id ::item-ids]))

(def ^:private coercion-rules
  [(coercion/rule :local-date [:end-of-period])
   (coercion/rule :decimal [:balance])
   (coercion/rule :integer [:account-id])
   (coercion/rule :integer [:id])
   (coercion/rule :integer-collection [:item-ids])])

(defn- before-validation
  [reconciliation]
  (-> (coercion/coerce coercion-rules reconciliation)
      (update-in [:status] (fnil identity :new))))

(defn- before-save
  [reconciliation]
  (-> reconciliation
      (update-in [:end-of-period] to-sql-date)
      (update-in [:status] name)))

(defn- after-read
  [reconciliation]
  (when reconciliation
    (-> reconciliation
        (update-in [:end-of-period] to-local-date)
        (update-in [:status] keyword)
        (authorization/tag-resource :reconciliation))))

(defn find-last-completed
  "Returns the last reconciled balance for an account"
  [storage-spec account-id]
  (with-storage [s storage-spec]
    (after-read (find-last-reconciliation-by-account-id s account-id :completed))))

; TODO this still isn't ensureing that they are only loaded once, need to rework it
(defn- ensure-transaction-items
  [storage {item-ids :item-ids :as reconciliation}]
  (update-in reconciliation
         [::items]
         (fnil identity (if item-ids
                          (transactions/find-items-by-ids storage item-ids)
                          []))))

(defn- append-transaction-item-ids
  [storage reconciliation]
  (when reconciliation
    (assoc reconciliation
           :item-ids
           (mapv :id (transactions/select-items-by-reconciliation-id
                       storage
                       (:id reconciliation))))))

(defn find-by-id
  "Returns the specified reconciliation"
  [storage-spec id]
  (with-storage [s storage-spec]
    (->> id
         (find-reconciliation-by-id s)
         (append-transaction-item-ids s)
         after-read)))

(defn- is-in-balance?
  [storage reconciliation]
  (or (= :new (:status reconciliation))
      (let [account (accounts/find-by-id storage (:account-id reconciliation))
            starting-balance (or (:balance (find-last-completed storage (:account-id reconciliation)))
                                 0M)
            delta (->> reconciliation
                       (ensure-transaction-items storage)
                       ::items
                       (map #(accounts/polarize-amount % account))
                       (reduce +))]
        (= (:balance reconciliation)
           (+ starting-balance delta)))))

(defn- items-belong-to-account?
  [storage {account-id :account-id :as reconciliation}]
  (or (nil? (:item-ids reconciliation))
      (= (->> reconciliation
              (ensure-transaction-items storage)
              ::items
              (map :account-id)
              set)
         #{account-id})))

(defn- items-do-not-belong-to-another-reconciliation?
  [storage {id :id :as reconciliation}]
  (let [reconciliation-ids (->> reconciliation
                                (ensure-transaction-items storage)
                                ::items
                                (map :reconciliation-id)
                                (filter identity)
                                set)]
    (or (empty? reconciliation-ids)
        (= reconciliation-ids #{id}))))

(defn- can-be-updated?
  [storage {:keys [status id]}]
  (or (nil? id)
      (= :new (:status (find-by-id storage id)))))

(defn- is-after-last-reconciliation?
  [storage reconciliation]
  (let [last-completed (find-last-completed storage (:account-id reconciliation))]
    (or (nil? last-completed)
        (> 0 (compare (:end-of-period last-completed)
                      (:end-of-period reconciliation))))))

(defn find-working
  "Returns the uncompleted reconciliation for the specified
  account, if one exists"
  [storage-spec account-id]
  (with-storage [s storage-spec]
    (when-let [reconciliation (find-new-reconciliation-by-account-id s account-id)]
      (after-read reconciliation))))

(defn- working-reconciliation-exists?
  [storage {:keys [account-id id] :as rec}]
  (when account-id
    (when-let [existing (find-working storage account-id)]
      (or (nil? id) (not= id (:id existing))))))

(defn- no-working-reconciliation-exists?
  [storage reconciliation]
  (not (working-reconciliation-exists? storage reconciliation)))

(defn- validation-rules
  [storage]
  [(validation/create-rule (partial is-in-balance? storage)
                           [:balance]
                           "The account balance must match the statement balance.")
   (validation/create-rule (partial items-belong-to-account? storage)
                           [:item-ids]
                           "All items must belong to the account being reconciled")
   (validation/create-rule (partial items-do-not-belong-to-another-reconciliation? storage)
                           [:item-ids]
                           "No items may belong to another reconcilidation")
   (validation/create-rule (partial is-after-last-reconciliation? storage)
                           [:end-of-period]
                           "End of period must be after the latest reconciliation")
   (validation/create-rule (partial can-be-updated? storage)
                           [:status]
                           "A completed reconciliation cannot be updated")
   (validation/create-rule (partial no-working-reconciliation-exists? storage)
                           [:account-id]
                           "A new reconciliation cannot be created while a working reconciliation already exists")])

(defn- validate
  [spec rules reconciliation]
  (->> reconciliation
       before-validation
       (validation/validate spec rules)))

(defn create
  "Creates a new reconciliation record"
  [storage-spec reconciliation]
  (with-transacted-storage [s storage-spec]
    (let [validated (validate ::new-reconciliation
                              (validation-rules s)
                              reconciliation)]
      (if (validation/valid? validated)
        (let [created (->> validated
                           before-save
                           (create-reconciliation s))]
          (when (and (:item-ids validated) (seq (:item-ids validated)))
            (set-transaction-items-reconciled s (:id created) (:item-ids validated)))
          (->> created
               (append-transaction-item-ids s)
               after-read))
        validated))))

(defn find-by-account-id
  "Returns the reconciliations for the specified account"
  [storage-spec account-id]
  (with-storage [s storage-spec]
    (map after-read
         (select-reconciliations-by-account-id s account-id))))

(defn reload
  "Returns the same reconciliation reloaded from the data store"
  [storage-spec {id :id}]
  (find-by-id storage-spec id))

(defn- set-account-id
  [storage reconciliation]
  (let [existing (find-by-id storage (Integer. (:id reconciliation)))]
    (assoc reconciliation :account-id (:account-id existing))))

(defn update
  "Updates the specified reconciliation"
  [storage-spec reconciliation]
  (with-storage [s storage-spec]
    (let [validated (->> reconciliation
                         (set-account-id s)
                         (validate ::existing-reconciliation (validation-rules s)))]
      (if (validation/valid? validated)
        (do
          (->> validated
               before-save
               (update-reconciliation s))
          (unreconcile-transaction-items-by-reconciliation-id s (:id validated))
          (when (and (:item-ids validated) (seq (:item-ids validated)))
            (set-transaction-items-reconciled s (:id validated) (:item-ids validated)))
          (reload s validated))
        validated))))

(defn delete
  "Removes the specified reconciliation from the system. (Only the most recent may be deleted.)"
  [storage-spec id]
  (with-transacted-storage [s storage-spec]
    (let [reconciliation (find-by-id s id)
          most-recent (find-last-reconciliation-by-account-id
                        s
                        (:account-id reconciliation))]
      (when (not= id (:id most-recent))
        (throw (ex-info "Only the most recent reconciliation may be deleted" {:specified-reconciliation reconciliation
                                                                              :most-recent-reconciliation most-recent})))
      (unreconcile-transaction-items-by-reconciliation-id s id)
      (delete-reconciliation s id))))

(ns clj-money.models.reconciliations
  (:refer-clojure :exclude [update])
  (:require [clojure.spec :as s]
            [clojure.pprint :refer [pprint]]
            [clj-time.coerce :refer [to-local-date]]
            [clj-money.util :refer [to-sql-date]]
            [clj-money.validation :as validation]
            [clj-money.coercion :as coercion]
            [clj-money.authorization :as authorization]
            [clj-money.models.accounts :as accounts]
            [clj-money.models.transactions :as transactions]
            [clj-money.models.helpers :refer [with-storage
                                              with-transacted-storage]]
            [clj-money.models.storage :refer [create-reconciliation
                                              update-reconciliation
                                              select-reconciliations-by-account-id
                                              find-reconciliation-by-id
                                              find-last-reconciliation-by-account-id
                                              find-new-reconciliation-by-account-id
                                              set-transaction-items-reconciled
                                              unreconcile-transaction-items-by-reconciliation-id
                                              delete-reconciliation]])
  (:import org.joda.time.LocalDate))

(s/def ::account-id integer?)
(s/def ::end-of-period #(instance? LocalDate %))
(s/def ::balance decimal?)
(s/def ::status #{:new :completed})
(s/def ::item-id uuid?)
(s/def ::item-ids (s/coll-of ::item-id))

(s/def ::new-reconciliation (s/keys :req-un [::account-id ::end-of-period ::status ::balance] :opt-un [::item-ids]))
(s/def ::existing-reconciliation (s/keys :req-un [::id ::end-of-period ::status ::balance] :opt-un [::account-id ::item-ids]))

(def ^:private coercion-rules
  [(coercion/rule :local-date [:end-of-period])
   (coercion/rule :decimal [:balance])
   (coercion/rule :integer [:account-id])
   (coercion/rule :integer [:id])
   (coercion/rule :uuid-collection [:item-ids])])

(defn- before-validation
  [reconciliation]
  (-> (coercion/coerce coercion-rules reconciliation)
      (update-in [:status] (fnil identity :new))))

(defn- before-save
  [reconciliation]
  (-> reconciliation
      (update-in [:end-of-period] to-sql-date)
      (update-in [:status] name)))

(defn- after-read
  [reconciliation]
  (when reconciliation
    (-> reconciliation
        (update-in [:end-of-period] to-local-date)
        (update-in [:status] keyword)
        (authorization/tag-resource :reconciliation))))

(defn find-last-completed
  "Returns the last reconciled balance for an account"
  [storage-spec account-id]
  (with-storage [s storage-spec]
    (after-read (find-last-reconciliation-by-account-id s account-id :completed))))

; TODO this still isn't ensureing that they are only loaded once, need to rework it
(defn- ensure-transaction-items
  [storage {item-ids :item-ids :as reconciliation}]
  (update-in reconciliation
         [::items]
         (fnil identity (if item-ids
                          (transactions/find-items-by-ids storage item-ids)
                          []))))

(defn- append-transaction-item-ids
  [storage reconciliation]
  (when reconciliation
    (assoc reconciliation
           :item-ids
           (mapv :id (transactions/select-items-by-reconciliation
                       storage
                       reconciliation)))))

(defn find-by-id
  "Returns the specified reconciliation"
  [storage-spec id]
  (with-storage [s storage-spec]
    (->> id
         (find-reconciliation-by-id s)
         (append-transaction-item-ids s)
         after-read)))

(defn- is-in-balance?
  [storage reconciliation]
  (or (= :new (:status reconciliation))
      (let [account (accounts/find-by-id storage (:account-id reconciliation))
            starting-balance (or (:balance (find-last-completed storage (:account-id reconciliation)))
                                 0M)
            delta (->> reconciliation
                       (ensure-transaction-items storage)
                       ::items
                       (map #(accounts/polarize-amount % account))
                       (reduce +))]
        (= (:balance reconciliation)
           (+ starting-balance delta)))))

(defn- items-belong-to-account?
  [storage {account-id :account-id :as reconciliation}]
  (or (nil? (:item-ids reconciliation))
      (= (->> reconciliation
              (ensure-transaction-items storage)
              ::items
              (map :account-id)
              set)
         #{account-id})))

(defn- items-do-not-belong-to-another-reconciliation?
  [storage {id :id :as reconciliation}]
  (let [reconciliation-ids (->> reconciliation
                                (ensure-transaction-items storage)
                                ::items
                                (map :reconciliation-id)
                                (filter identity)
                                set)]
    (or (empty? reconciliation-ids)
        (= reconciliation-ids #{id}))))

(defn- can-be-updated?
  [storage {:keys [status id]}]
  (or (nil? id)
      (= :new (:status (find-by-id storage id)))))

(defn- is-after-last-reconciliation?
  [storage reconciliation]
  (let [last-completed (find-last-completed storage (:account-id reconciliation))]
    (or (nil? last-completed)
        (> 0 (compare (:end-of-period last-completed)
                      (:end-of-period reconciliation))))))

(defn find-working
  "Returns the uncompleted reconciliation for the specified
  account, if one exists"
  [storage-spec account-id]
  (with-storage [s storage-spec]
    (when-let [reconciliation (find-new-reconciliation-by-account-id s account-id)]
      (after-read reconciliation))))

(defn- working-reconciliation-exists?
  [storage {:keys [account-id id] :as rec}]
  (when account-id
    (when-let [existing (find-working storage account-id)]
      (or (nil? id) (not= id (:id existing))))))

(defn- no-working-reconciliation-exists?
  [storage reconciliation]
  (not (working-reconciliation-exists? storage reconciliation)))

(defn- validation-rules
  [storage]
  [(validation/create-rule (partial is-in-balance? storage)
                           [:balance]
                           "The account balance must match the statement balance.")
   (validation/create-rule (partial items-belong-to-account? storage)
                           [:item-ids]
                           "All items must belong to the account being reconciled")
   (validation/create-rule (partial items-do-not-belong-to-another-reconciliation? storage)
                           [:item-ids]
                           "No items may belong to another reconcilidation")
   (validation/create-rule (partial is-after-last-reconciliation? storage)
                           [:end-of-period]
                           "End of period must be after the latest reconciliation")
   (validation/create-rule (partial can-be-updated? storage)
                           [:status]
                           "A completed reconciliation cannot be updated")
   (validation/create-rule (partial no-working-reconciliation-exists? storage)
                           [:account-id]
                           "A new reconciliation cannot be created while a working reconciliation already exists")])

(defn- validate
  [spec rules reconciliation]
  (->> reconciliation
       before-validation
       (validation/validate spec rules)))

(defn create
  "Creates a new reconciliation record"
  [storage-spec reconciliation]
  (with-transacted-storage [s storage-spec]
    (let [validated (validate ::new-reconciliation
                              (validation-rules s)
                              reconciliation)]
      (if (validation/valid? validated)
        (let [created (->> validated
                           before-save
                           (create-reconciliation s))]
          (when (and (:item-ids validated) (seq (:item-ids validated)))
            (set-transaction-items-reconciled s (:id created) (:item-ids validated)))
          (->> created
               (append-transaction-item-ids s)
               after-read))
        validated))))

(defn find-by-account-id
  "Returns the reconciliations for the specified account"
  [storage-spec account-id]
  (with-storage [s storage-spec]
    (map after-read
         (select-reconciliations-by-account-id s account-id))))

(defn reload
  "Returns the same reconciliation reloaded from the data store"
  [storage-spec {id :id}]
  (find-by-id storage-spec id))

(defn- set-account-id
  [storage reconciliation]
  (let [existing (find-by-id storage (Integer. (:id reconciliation)))]
    (assoc reconciliation :account-id (:account-id existing))))

(defn update
  "Updates the specified reconciliation"
  [storage-spec reconciliation]
  (with-storage [s storage-spec]
    (let [validated (->> reconciliation
                         (set-account-id s)
                         (validate ::existing-reconciliation (validation-rules s)))]
      (if (validation/valid? validated)
        (do
          (->> validated
               before-save
               (update-reconciliation s))
          (unreconcile-transaction-items-by-reconciliation-id s (:id validated))
          (when (and (:item-ids validated) (seq (:item-ids validated)))
            (set-transaction-items-reconciled s (:id validated) (:item-ids validated)))
          (reload s validated))
        validated))))

(defn delete
  "Removes the specified reconciliation from the system. (Only the most recent may be deleted.)"
  [storage-spec id]
  (with-transacted-storage [s storage-spec]
    (let [reconciliation (find-by-id s id)
          most-recent (find-last-reconciliation-by-account-id
                        s
                        (:account-id reconciliation))]
      (when (not= id (:id most-recent))
        (throw (ex-info "Only the most recent reconciliation may be deleted" {:specified-reconciliation reconciliation
                                                                              :most-recent-reconciliation most-recent})))
      (unreconcile-transaction-items-by-reconciliation-id s id)
      (delete-reconciliation s id))))

correct item for transaction item ids

correct item for transaction item ids


(ns day8.re-frame.trace.view.timing
  (:require [devtools.prefs]
            [devtools.formatters.core]
            [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
            [day8.re-frame.trace.utils.re-com :as rc]
            [day8.re-frame.trace.common-styles :as common]
            [day8.re-frame.trace.view.components :as components]))

(def timing-styles
  [:#--re-frame-trace--
   [:.timing-details
    {:background-color common/white-background-color
     :margin-top       common/gs-31s
     :padding          common/gs-19}]
   [:.timing-details--line
    {:margin "1em 0"}]

   [:p :ol
    {:max-width "26em"}]
   [:ol
    {"-webkit-padding-start" "20px"}]
   [:li
    {:margin "0 0 1em 0"}]

   [".rft-tag__timing"
    {:background-color common/disabled-background-color
     :border           (str "1px solid " common/border-line-color)
     :font-weight      "normal"
     :font-size        "14px"}]

   [".timing-part-panel"
    (merge (common/panel-style "3px")
           {:padding "12px"
            :margin common/gs-7s})]
   ])

(defn timing-tag [label]
  [components/tag "rft-tag__timing" label])

(defn timing-section
  [label time]
  [rc/v-box
   :align :center
   :gap "3px"
   :children [[rc/label :class "bm-textbox-label" :label label]
              [timing-tag (str time "ms")]]])

(defn render []
  (let [timing-data-available? @(rf/subscribe [:timing/data-available?])]
    (if timing-data-available?
      [rc/v-box
       :class "timing-details"
       :children [
                  [rc/h-box
                   :gap common/gs-12s
                   :class "timing-part-panel"
                   :children
                   [[timing-section "total" @(rf/subscribe [:timing/total-epoch-time])]
                    [timing-section "event" @(rf/subscribe [:timing/event-processing-time])]
                    ]]
                  (doall
                    (for [frame (range 1 (inc @(rf/subscribe [:timing/animation-frame-count])))
                          :let [frame-time (rf/subscribe [:timing/animation-frame-time frame])]]
                      (list
                        ;^{:key (str "af-line" frame)}
                        ;[rc/line :class "timing-details--line"]
                        ^{:key (str "af" frame)}
                        [rc/h-box
                         :align :center
                         :class "timing-part-panel"
                         :gap "25px"
                         :children
                         [[rc/label :label (str "Animation frame #" frame)]
                          [timing-section "total" @frame-time]
                          #_[timing-section "subs" 2]
                          #_[timing-section "views" 3]]])))

                  [rc/line :class "timing-details--line"]

                  [rc/v-box
                   :children
                   [[rc/p "Be careful. There are two problems with these numbers:"]
                    [:ol
                     [:li "Accurately timing anything in the browser is a nightmare. One moment a given function takes 1ms and the next it takes 10ms, and you'll never know why. So bouncy."]
                     [:li "You're currently running the dev build, not the production build. So don't freak out too much. Yet."]]
                    [rc/hyperlink-href
                     :label "Timing documentation"
                     :style {:margin-left common/gs-7s}
                     :attr {:rel "noopener noreferrer"}
                     :target "_blank"
                     :href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnderstandingTiming.md"]]]]]
      [rc/v-box
       :class "timing-details"
       :children [[:h1 "No timing data available currently."]]])))

(ns day8.re-frame.trace.view.timing
  (:require [devtools.prefs]
            [devtools.formatters.core]
            [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
            [day8.re-frame.trace.utils.re-com :as rc]
            [day8.re-frame.trace.common-styles :as common]
            [day8.re-frame.trace.view.components :as components]))

(def timing-styles
  [:#--re-frame-trace--
   [:.timing-details
    {:margin-top common/gs-31s}]
   [:.timing-details--line
    {:margin "1em 0"}]

   [:p :ol
    {:max-width "26em"}]
   [:ol
    {"-webkit-padding-start" "20px"}]
   [:li
    {:margin "0 0 1em 0"}]

   [".rft-tag__timing"
    {:background-color common/disabled-background-color
     :border           (str "1px solid " common/border-line-color)
     :font-weight      "normal"
     :font-size        "14px"}]

   [".timing-elapsed-panel"
    {:padding "12px"
     :margin  common/gs-7s}]
   [".timing-part-panel"
    (merge (common/panel-style "3px")
           {:padding "12px"
            :margin  common/gs-7s})]
   ])

(defn timing-tag [label]
  [components/tag "rft-tag__timing" label])

(defn timing-section
  [label time]
  [rc/v-box
   :align :center
   :gap "3px"
   :children [[rc/label :class "bm-textbox-label" :label label]
              [timing-tag (str time "ms")]]])

(defn render []
  (let [timing-data-available? @(rf/subscribe [:timing/data-available?])]
    (if timing-data-available?
      [rc/v-box
       :class "timing-details"
       :children [[rc/h-box
                   :class "timing-elapsed-panel"
                   :align :end
                   :children [[timing-section "elapsed" @(rf/subscribe [:timing/total-epoch-time])]
                              [rc/hyperlink-href
                               :label "guide me to greatness"
                               :style {:margin-left common/gs-19s}
                               :attr {:rel "noopener noreferrer"}
                               :target "_blank"
                               :href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnderstandingTiming.md"]

                              #_[rc/link {:label "Guide me to greatness"
                                        :href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnderstandingTiming.md"}]]]
                  [rc/h-box
                   :gap common/gs-12s
                   :class "timing-part-panel"
                   :children
                   [[:p "event" [:br] "processing"]
                    [timing-section "event" @(rf/subscribe [:timing/event-processing-time])]
                    ;;; TODO: calculate handler and effects timing separately
                    [timing-section "handler" -1]
                    [timing-section "effects" -1]

                    ]]
                  (doall
                    (for [frame (range 1 (inc @(rf/subscribe [:timing/animation-frame-count])))
                          :let [frame-time (rf/subscribe [:timing/animation-frame-time frame])]]
                      (list
                        ;^{:key (str "af-line" frame)}
                        ;[rc/line :class "timing-details--line"]
                        ^{:key (str "af" frame)}
                        [rc/h-box
                         :align :center
                         :class "timing-part-panel"
                         :gap common/gs-12s
                         :children
                         [[:p "Animation" [:br] "frame" [:br] (str "#" frame)]
                          [timing-section "total" @frame-time]
                          [:span "="]
                          ;; TODO: subs timing
                          [timing-section "subs" -1]
                          [:span "+"]
                          ;; TODO: views timing
                          [timing-section "views" -1]
                          [:span "+"]
                          ;; TODO: timing for the rest
                          [timing-section "react, etc" -1]]])))]]
      [rc/v-box
       :class "timing-details"
       :children [[:h1 "No timing data available currently."]]])))

Improve Timing panel granularity

Improve Timing panel granularity

Fixes #136