(ns oc.storage.representations.content
  "Resource representations for OpenCompany content resources (which receive comments and reactions)."
  (:require [defun.core :refer (defun defun-)]
            [oc.lib.hateoas :as hateoas]
            [oc.storage.config :as config]
            [oc.storage.representations.media-types :as mt]))

(defun- interaction-url

  ([org-uuid board-uuid resource-uuid]
  (str config/interaction-server-url "/orgs/" org-uuid "/boards/" board-uuid "/resources/" resource-uuid "/comments"))

  ([org-uuid board-uuid resource-uuid reaction]
  (str config/interaction-server-url
       "/orgs/" org-uuid "/boards/" board-uuid "/resources/" resource-uuid "/reactions/" reaction "/on")))

(defn comment-link [org-uuid board-uuid resource-uuid]
  (let [comment-url (str (interaction-url org-uuid board-uuid resource-uuid) "/")]
    (hateoas/create-link comment-url {:content-type mt/comment-media-type
                                      :accept mt/comment-media-type})))

(defn- comment-authors
  "Return the latest, up to four, distinct authors."
  [comments]
  (let [authors (map #(assoc (:author %) :created-at (:created-at %)) comments) ; only authors from the comments
        grouped-authors (group-by :user-id authors) ; grouped by each author
        ; select newest comment for each author
        newest-authors (map #(last (sort-by :created-at (get grouped-authors %))) (keys grouped-authors))
        sorted-authors (reverse (sort-by :created-at newest-authors))] ; sort authors
    (take 4 sorted-authors))) ; last 4

(defn comments-link [org-uuid board-uuid resource-uuid comments]
  (let [comment-url (interaction-url org-uuid board-uuid resource-uuid)]
    (hateoas/link-map "comments" hateoas/GET comment-url {:accept mt/comment-collection-media-type}
                                                          {:count (count comments)
                                                           :authors (comment-authors comments)})))

(defn- react-link [org-uuid board-uuid resource-uuid reaction]
  (let [react-url (interaction-url org-uuid board-uuid resource-uuid reaction)]
    (hateoas/link-map "react" hateoas/PUT react-url {})))

(defn- unreact-link [org-uuid board-uuid resource-uuid reaction]
  (let [react-url (interaction-url org-uuid board-uuid resource-uuid reaction)]
    (hateoas/link-map "react" hateoas/DELETE react-url {})))

(defn- map-kv
  "Utility function to do an operation on the value of every key in a map."
  [f coll]
  (reduce-kv (fn [m k v] (assoc m k (f v))) (empty coll) coll))

(defn- reaction-and-link
  "Given the parts of a reaction URL, return a map representation of the reaction for use in the API."
  [org-uuid board-uuid resource-uuid reaction user?]
  (-> reaction
    (dissoc :author-ids)
    (assoc :reacted (if user? true false))
    (assoc :links [(if user?
                    (unreact-link org-uuid board-uuid resource-uuid (:reaction reaction))
                    (react-link org-uuid board-uuid resource-uuid (:reaction reaction)))])))

(defn- reaction-selection-sort
  "
  Sort order to select the most used reactions, with a tie breaker for default reactions in their default reaction
  order.
  "
  [reaction]
  (let [index-of (inc (.indexOf config/default-reactions (first reaction)))] ; order in the defaults
    (if (zero? index-of) ; is it in the defaults, or legacy?
      ;; it's legacy, so by reaction count
      (* (last reaction) -1) ; more reactions gives a lower (negative) #, so it has a higher sort
      ;; it's in the defaults, so by reaction count, but with a little extra for tie breaking with other reactions
      (- (* (last reaction) -1) (- 1 (* index-of 0.25)))))) ; the earlier it is in the defaults the bigger the tie breaker

(defn- reaction-order-sort
  "
  Keep the reaction order stable by sorting on the order they are provided, and if they are legacy
  reactions, by the order of how many reactions they have (which while not definitively stable, will
  effectively be fairly stable for legacy reactions).
  "
  [reaction]
  (let [index-of (.indexOf config/default-reactions (first reaction))] ; order in the defaults
    (if (= index-of -1) ; is it in the defaults, or legacy?
      (* (last reaction) 10) ; it's legacy, so by reaction count
      index-of))) ; by order in the defaults

(defn reactions-and-links
  "
  Given a sequence of reactions and the parts of a reaction URL, return a representation of the reactions
  for use in the API.
  "
  [org-uuid board-uuid resource-uuid reactions user-id]
  (let [limited-reactions (take config/max-reaction-count reactions)]
    (map #(reaction-and-link org-uuid board-uuid resource-uuid %
            ; the user left one of these reactions?
            (some (fn [author-id] (= user-id author-id)) (:author-ids %)))
      limited-reactions)))

(ns oc.storage.representations.content
  "Resource representations for OpenCompany content resources (which receive comments and reactions)."
  (:require [defun.core :refer (defun defun-)]
            [oc.lib.hateoas :as hateoas]
            [oc.storage.config :as config]
            [oc.storage.representations.media-types :as mt]))

(defun- interaction-url

  ([org-uuid board-uuid resource-uuid]
  (str config/interaction-server-url "/orgs/" org-uuid "/boards/" board-uuid "/resources/" resource-uuid "/comments"))

  ([org-uuid board-uuid resource-uuid reaction]
  (str config/interaction-server-url
       "/orgs/" org-uuid "/boards/" board-uuid "/resources/" resource-uuid "/reactions/" reaction "/on")))

(defn comment-link [org-uuid board-uuid resource-uuid]
  (let [comment-url (str (interaction-url org-uuid board-uuid resource-uuid) "/")]
    (hateoas/create-link comment-url {:content-type mt/comment-media-type
                                      :accept mt/comment-media-type})))

(defn- comment-authors
  "Return the latest, up to four, distinct authors."
  [comments]
  (let [authors (map #(assoc (:author %) :created-at (:created-at %)) comments) ; only authors from the comments
        grouped-authors (group-by :user-id authors) ; grouped by each author
        ; select newest comment for each author
        newest-authors (map #(last (sort-by :created-at (get grouped-authors %))) (keys grouped-authors))
        sorted-authors (reverse (sort-by :created-at newest-authors))] ; sort authors
    (take 4 sorted-authors))) ; last 4

(defn comments-link [org-uuid board-uuid resource-uuid comments]
  (let [comment-url (interaction-url org-uuid board-uuid resource-uuid)]
    (hateoas/link-map "comments" hateoas/GET comment-url {:accept mt/comment-collection-media-type}
                                                          {:count (count comments)
                                                           :authors (comment-authors comments)})))

(defn- react-link [org-uuid board-uuid resource-uuid reaction]
  (let [react-url (interaction-url org-uuid board-uuid resource-uuid reaction)]
    (hateoas/link-map "react" hateoas/PUT react-url {})))

(defn- unreact-link [org-uuid board-uuid resource-uuid reaction]
  (let [react-url (interaction-url org-uuid board-uuid resource-uuid reaction)]
    (hateoas/link-map "react" hateoas/DELETE react-url {})))

(defn- reaction-and-link
  "Given the parts of a reaction URL, return a map representation of the reaction for use in the API."
  [org-uuid board-uuid resource-uuid reaction user?]
  (-> reaction
    (dissoc :author-ids)
    (assoc :reacted (if user? true false))
    (assoc :links [(if user?
                    (unreact-link org-uuid board-uuid resource-uuid (:reaction reaction))
                    (react-link org-uuid board-uuid resource-uuid (:reaction reaction)))])))

(defn reactions-and-links
  "
  Given a sequence of reactions and the parts of a reaction URL, return a representation of the reactions
  for use in the API.
  "
  [org-uuid board-uuid resource-uuid reactions user-id]
  (let [limited-reactions (take config/max-reaction-count reactions)]
    (map #(reaction-and-link org-uuid board-uuid resource-uuid %
            ; the user left one of these reactions?
            (some (fn [author-id] (= user-id author-id)) (:author-ids %)))
      limited-reactions)))

Remove unused fns.

Remove unused fns.


(ns worker.worker
  (:require [goog.dom :as dom] [cljs.reader]))

(declare cljs-output-file)

(def *closure-base-path* goog/basePath)
(def *closure-base-file* (str *closure-base-path* "base.js"))
(def *serialize* pr-str)
(def *deserialize* cljs.reader/read-string)
(def *env-objs* {
  :document {:getElementsByTagName "function() {return [];}"}
})

(defn scripts-src []
  (let [scripts (.getElementsByTagName (dom/getDocument) "SCRIPT")]
    (->> (for [i (range (.-length scripts))] (aget scripts i))
         (remove #(empty? (.-src %)))
         (map #(.-src %)))))

(defn cljs-output-file []
  (if-not (empty? *closure-base-path*)
    (str *closure-base-path* "../cljs_deps.js")
    (first (scripts-src))))

(defn generate-obj-body [obj]
  (->> obj
    (map (fn [[key val]] (str (name key) ":" val)))
    (interpose ",")
    (#(str "{" (apply str %) "}"))))

(defn genetate-env [objs]
  (reduce
    (fn [res [obj body]] (str res "var " (name obj) "=" (generate-obj-body body) ";"))
    "" objs))

(def *cljs-output-file* (cljs-output-file))
(def *env-str* (genetate-env *env-objs*))

(defn ^:export pr-str-js [code] (*serialize* code))

(defn create-worker-body []
  (let [
    multi-loader (str
     "var CLOSURE_BASE_PATH = '" *closure-base-path* "';"
     "var CLOSURE_IMPORT_SCRIPT = (function(global) {"
     "return function(src) {"
        ;;"global['console'].log(src);"
        "global['importScripts'](src);"
        "return true;"
     "};"
     "})(self);"
     "importScripts('" *closure-base-file* "','" *cljs-output-file* "');"
     "goog.require('worker.worker');")
    single-loader (str
      "importScripts('" *cljs-output-file* "');"
    )]
  (str
    *env-str*
    (if (empty? *closure-base-path*) single-loader multi-loader)
    "self.onmessage = function(e) {"
      "var ns = e.data[0];"
      "var fn = e.data[1];"
      (if-not (empty? *closure-base-path*) "goog.require(ns);")
      "console.log(eval(ns));"
      "var res = eval(ns+'.'+fn)();"
      "self.postMessage(worker.worker.pr_str_js(res));"
    "};")))

(def worker-body (create-worker-body))
(def worker-blob (js/Blob. (clj->js [worker-body])))

(defn do-some [wmeta]
  (let [w (js/Worker. (.createObjectURL js/URL worker-blob))]
    (set! (.-onmessage w) (fn [e] (println (:prnt (*deserialize* (.-data e))))))
    (.postMessage w (cljs.core/clj->js [(:ns wmeta) (:name wmeta)]))))

reimplement do-some

reimplement do-some


(ns sparkle.core
  (:require [clojure.core.async :refer [thread chan <!! >!! alt!! close!]]
   [clojure.algo.generic.functor :refer [fmap]]
            [com.stuartsierra.component :as component])
  (:gen-class))

; Let's start by implementing rendering a vec of layers on one static set of LEDs

(def black {:r 0 :g 0 :b 0})
(def white {:r 1 :g 1 :b 1})

(def leds (take 5 (repeat black)))

(defn static-color [color]
  (fn [env leds]
    (map (constantly color) leds)))

(defn scale-brightness [factor]
  (fn [env leds]
    (map (fn [led]
           (fmap #(* factor %) led))
         leds)))

(defn brightness-gradient [start-factor end-factor]
  (fn [env leds]
    (let [step (/ (- end-factor start-factor)
                  (- (count leds) 1))
          factors (iterate #(+ % step) start-factor)]
      (map (fn [led factor]
             (fmap #(* factor %) led))
           leds factors))))

(defn pulse-brightness [{:keys [time] :as env} leds]
  (let [scaled-time (/ time 10000)
        brightness-factor (Math/sin scaled-time)]
    (map (fn [led]
           (fmap #(* % brightness-factor) led))
         leds)))

(defn apply-layers [layers env leds]
  (let [env-applied-layers (for [layer layers] (partial layer env))]
    ((apply comp env-applied-layers) leds)))

(defrecord RenderState [env model])

(defn display [{:keys [frame-chan] :as displayer} frame]
  (>!! frame-chan frame))

(defn start-displaying [{:keys [frame-chan] :as displayer}]
  (thread
    (loop [prev-frame nil]
      (let [frame (<!! frame-chan)]
        (if frame
          (do (when (not= frame prev-frame)
                (println frame))
              (recur frame))
          (println "Shutting down displayer"))))))

(defrecord Displayer [frame-chan]
  component/Lifecycle

  (start [displayer]
    (let [frame-chan (chan)
          displayer (assoc displayer :frame-chan frame-chan)]
      (start-displaying displayer)
      displayer))

  (stop [displayer]
    (close! frame-chan)
    displayer))

(defn get-env-updates [env]
  (-> env
      (assoc :time (System/currentTimeMillis))))

(defn render-step [{:keys [env model] :as state}]
  (let [{:keys [layers]} model
        updated-env (get-env-updates env)]
    (->> leds
         (apply-layers layers updated-env))))

(defn send-command [{:keys [command-chan] :as renderer} command]
  (>!! command-chan command))

(defmulti execute (fn [command layers status] (:type command)))

(defmethod execute :start [_ state status]
  [state :running])

(defmethod execute :pause [_ state status]
  [state :paused])

(defmethod execute :update [{:keys [new-state]} state status]
  [new-state status])

(defmethod execute :stop [_ _ _]
  nil)

(defn start-rendering [{:keys [command-chan displayer] :as renderer}]
  (thread
    (loop [state (-> RenderState {} {})
           status :running]
      (let [[state status :as loop-result]
            (if (= status :running)
              (alt!! command-chan ([command] (execute command state status))
                     :default (let [next-frame (render-step state)]
                                (display displayer next-frame)
                                [state :running]))
              (execute (<!! command-chan) state status))]
        (if loop-result
          (recur state status)
          (println "Shutting down render loop"))))))

(defrecord Renderer [command-chan displayer]
  component/Lifecycle

  (start [renderer]
    (let [command-chan (chan)
          renderer (assoc renderer :command-chan command-chan)]
      (start-rendering renderer)
      renderer))

  (stop [renderer]
    (>!! command-chan {:type :stop})
    renderer))

(defn sparkle-system []
  (component/system-map
   :renderer (component/using (map->Renderer {})
                              [:displayer])
   :displayer (map->Displayer {})))

;;; Below: defs useful for interacting with the running renderer

(def started-system (component/start (sparkle-system)))

(def renderer (:renderer started-system))

(def displayer (:displayer started-system))

(ns sparkle.core
  (:require [clojure.core.async :refer [thread chan <!! >!! alt!! close!]]
   [clojure.algo.generic.functor :refer [fmap]]
            [com.stuartsierra.component :as component])
  (:gen-class))

; Let's start by implementing rendering a vec of layers on one static set of LEDs

(def black {:r 0 :g 0 :b 0})
(def white {:r 1 :g 1 :b 1})

(def leds (take 5 (repeat black)))

(defn static-color [color]
  (fn [env leds]
    (map (constantly color) leds)))

(defn scale-brightness [factor]
  (fn [env leds]
    (map (fn [led]
           (fmap #(* factor %) led))
         leds)))

(defn brightness-gradient [start-factor end-factor]
  (fn [env leds]
    (let [step (/ (- end-factor start-factor)
                  (- (count leds) 1))
          factors (iterate #(+ % step) start-factor)]
      (map (fn [led factor]
             (fmap #(* factor %) led))
           leds factors))))

(defn pulse-brightness [{:keys [time] :as env} leds]
  (let [scaled-time (/ time 10000)
        brightness-factor (Math/sin scaled-time)]
    (map (fn [led]
           (fmap #(* % brightness-factor) led))
         leds)))

(defn apply-layers [layers env leds]
  (let [env-applied-layers (for [layer layers] (partial layer env))]
    ((apply comp env-applied-layers) leds)))

(defrecord RenderState [env model])

(defprotocol Displayer
  "A protocol for things that are capable of displaying frames"
  (display [displayer frame] "Display a frame"))

(defn to-displayer [{:keys [frame-chan] :as displayer} frame]
  (>!! frame-chan frame))

(defn start-displayer [{:keys [frame-chan] :as displayer}]
  (thread
    (loop []
      (let [frame (<!! frame-chan)]
        (if frame
          (do (display displayer frame)
              (recur))
          (println "Shutting down displayer"))))))

(defrecord ConsoleDisplayer [frame-chan prev-frame]
  component/Lifecycle
  (start [displayer]
    (let [displayer (-> displayer
                        (assoc :frame-chan (chan))
                        (assoc :prev-frame (atom nil)))]
      (start-displayer displayer)
      displayer))

  (stop [displayer]
    (close! frame-chan)
    displayer)

  Displayer
  (display [{:keys [prev-frame]} frame]
    (when (not= frame @prev-frame)
      (reset! prev-frame frame)
      (println frame))))

(defn get-env-updates [env]
  (-> env
      (assoc :time (System/currentTimeMillis))))

(defn render-step [{:keys [env model] :as state}]
  (let [{:keys [layers]} model
        updated-env (get-env-updates env)]
    (->> leds
         (apply-layers layers updated-env))))

(defn send-command [{:keys [command-chan] :as renderer} command]
  (>!! command-chan command))

(defmulti execute (fn [command layers status] (:type command)))

(defmethod execute :start [_ state status]
  [state :running])

(defmethod execute :pause [_ state status]
  [state :paused])

(defmethod execute :update [{:keys [new-state]} state status]
  [new-state status])

(defmethod execute :stop [_ _ _]
  nil)

(defn start-rendering [{:keys [command-chan displayer] :as renderer}]
  (thread
    (loop [state (-> RenderState {} {})
           status :running]
      (let [[state status :as loop-result]
            (if (= status :running)
              (alt!! command-chan ([command] (execute command state status))
                     :default (let [next-frame (render-step state)]
                                (to-displayer displayer next-frame)
                                [state :running]))
              (execute (<!! command-chan) state status))]
        (if loop-result
          (recur state status)
          (println "Shutting down render loop"))))))

(defrecord Renderer [command-chan displayer]
  component/Lifecycle

  (start [renderer]
    (let [command-chan (chan)
          renderer (assoc renderer :command-chan command-chan)]
      (start-rendering renderer)
      renderer))

  (stop [renderer]
    (>!! command-chan {:type :stop})
    renderer))

(defn sparkle-system []
  (component/system-map
   :renderer (component/using (map->Renderer {})
                              [:displayer])
   :displayer (map->ConsoleDisplayer {})))

;;; Below: defs useful for interacting with the running renderer

(def started-system (component/start (sparkle-system)))

(def renderer (:renderer started-system))

(def displayer (:displayer started-system))

Introduce Displayer protocol, implement for ConsoleDisplayer


(ns broadfcui.common.notifications
  (:require
   [dmohs.react :as react]
   [broadfcui.common :as common]
   [broadfcui.common.flex-utils :as flex]
   [broadfcui.common.icons :as icons]
   [broadfcui.common.links :as links]
   [broadfcui.common.markdown :as markdown]
   [broadfcui.common.style :as style]
   [broadfcui.components.buttons :as buttons]
   [broadfcui.components.foundation-tooltip :refer [FoundationTooltip]]
   [broadfcui.components.modals :as modals]
   [broadfcui.components.spinner :refer [spinner]]
   [broadfcui.components.top-banner :as top-banner]
   [broadfcui.config :as config]
   [broadfcui.utils :as utils]
   [broadfcui.utils.ajax :as ajax]
   [broadfcui.utils.user :as user]
   ))

(defn render-alert [{:keys [cleared? link message title link-title severity]} dismiss]
  (let [text-color (case severity
                     :info (:text-lighter style/colors)
                     "#eee")
        background-color (case severity
                           :info (:background-light style/colors)
                           (if cleared?
                             (:state-success style/colors)
                             (:state-exception style/colors)))]
    (top-banner/render
      [:div {:style {:color text-color
                     :background-color background-color
                     :padding "1rem"}}
       (when cleared?
         [:div {:style {:float "right"}}
          (icons/render-icon {:style {:fontSize "80%" :cursor "pointer"} :on-click dismiss} :close)])
       [:div {:style {:display "flex" :align-items "baseline"}}
        [icons/ExceptionIcon {:size 18 :color text-color}]
        [:span {:style {:margin-left "0.5rem" :font-weight "bold" :vertical-align "middle"}}
         (or title "Service Alert")
         (when cleared?
           " (resolved)")]
        [:span {:style {:color text-color :fontSize "90%" :margin-left "1rem"}}
         message
         (when link
           (links/create-external {:href link
                                   :style {:color text-color :margin-left "1rem"}}
                                  (or link-title "Read more...")))]]])))

(defn- status-alert-interval [attempt]
  (cond
    (zero? attempt) (config/status-alerts-refresh)
    (> attempt (config/max-retry-attempts)) (config/status-alerts-refresh)
    :else (ajax/get-exponential-backoff-interval attempt)))

(react/defc ServiceAlertContainer
  {:get-initial-state
   (fn []
     {:failed-retries 0})
   :render
   (fn [{:keys [this state]}]
     (let [{:keys [service-alerts]} @state]
       [:div {}
        (when (:show-new-service-alert-message? @state)
          (modals/render-message {:header "New Service Alert" :text "See the page header for details."
                                  :dismiss #(swap! state dissoc :show-new-service-alert-message?)}))
        (map #(render-alert % (partial this :-remove-alert %)) service-alerts)]))
   :component-did-update
   (fn [{:keys [this state locals]}]
     ;; Reset the interval
     (js/clearInterval (:interval-id @locals))
     ;; Update the poll interval based on the number of failed attempts (for exponential back offs)
     (swap! locals assoc :interval-id
            (js/setInterval #(this :-load-service-alerts)
                            (status-alert-interval (:failed-retries @state)))))
   :component-did-mount
   (fn [{:keys [this state locals]}]
     ;; Call once for initial load
     (this :-load-service-alerts true)
     ;; Add initial poll interval
     (swap! locals assoc :interval-id
            (js/setInterval #(this :-load-service-alerts)
                            (status-alert-interval (:failed-retries @state)))))
   :component-will-unmount
   (fn [{:keys [locals]}]
     (js/clearInterval (:interval-id @locals)))
   :-load-service-alerts
   (fn [{:keys [this]} & [first-time?]]
     (ajax/call {:url (config/google-bucket-url "alerts")
                 :on-done (partial this :-handle-response first-time?)}))
   :-handle-response
   (fn [{:keys [state]} first-time? {:keys [status-code raw-response]}]
     (let [alerts (if (and (ajax/check-server-down status-code)
                           (>= (:failed-retries @state) (config/max-retry-attempts)))
                    [{:title "Google Service Alert"
                      :message "There may be problems accessing data in Google Cloud Storage."
                      :link "https://status.cloud.google.com/"}]
                    (let [[parsed _] (utils/parse-json-string raw-response true false)]
                      parsed))
           alerts-set (set alerts)
           existing (set (remove :cleared? (:service-alerts @state)))
           cleared (clojure.set/difference existing alerts-set)
           new (clojure.set/difference alerts-set existing)
           updated (concat (:service-alerts @state) (filter #(contains? new %) alerts))
           updated (map (fn [alert]
                          (if (contains? cleared alert) (assoc alert :cleared? true) alert))
                        updated)]
       (swap! state assoc
              :service-alerts updated
              :failed-retries (if (ajax/check-server-down status-code)
                                (inc (:failed-retries @state))
                                0))
       (when (and (seq new) (not first-time?))
         (swap! state assoc :show-new-service-alert-message? true))))
   :-remove-alert
   (fn [{:keys [state]} alert]
     (swap! state update :service-alerts #(filter (partial not= alert) %)))})

(react/defc TrialAlertContainer
  {:render
   (fn [{:keys [state this]}]
     (let [{:keys [dismissed? loading? messages error]} @state]
       (when-let [current-trial-state (keyword (:trialState @user/profile))]
         (when (and (not dismissed?) (current-trial-state messages)) ; Disabled or mis-keyed users do not see a banner
           (let [{:keys [title message warning? link button eulas]} (messages current-trial-state)]
             (apply ;; needed until dmohs/react deals with nested seq's
              flex/box {:style {:color "white"
                                :background-color ((if warning? :state-warning :button-primary) style/colors)}}
              (flex/box {:style {:padding "1rem" :flexGrow 1
                                 :justifyContent "center" :alignItems "center"}}
                [:div {:data-test-id "trial-banner-title"
                       :style {:fontSize "1.5rem" :fontWeight 500 :textAlign "right"
                               :borderRight "1px solid white"
                               :paddingRight "1rem" :marginRight "1rem"
                               :maxWidth 200 :flexShrink 0}}
                 title]
                [:span {:style {:maxWidth 600 :lineHeight "1.5rem"}}
                 message
                 (when-let [{:keys [label url]} link]
                   (links/create-external {:href url :style {:color "white" :marginLeft "0.5rem"}} label))]
                (when-let [{:keys [label url external?]} button]
                  [:a {:data-test-id "trial-banner-button"
                       :data-test-state (if loading? "loading" "ready")
                       :style {:display "block"
                               :color "white" :textDecoration "none" :fontSize "1.125rem"
                               :fontWeight 500
                               :border "2px solid white" :borderRadius "0.25rem"
                               :padding "0.5rem 1rem" :marginLeft "0.5rem" :flexShrink 0}
                       :href (if external? url (when-not loading? "javascript:;"))
                       :onClick (when-not (or external? loading?)
                                  #(swap! state assoc :displaying-eula? true))
                       :target (when external? "_blank")}
                   (if loading?
                     (spinner {:style {:fontSize "1rem" :margin 0}})
                     label)
                   (when external?
                     (icons/render-icon
                      {:style {:margin "-0.5em -0.3em -0.5em 0.5em" :fontSize "1rem"}}
                      :external-link))]))
              [:div {:style {:alignSelf "center" :padding "1rem" :display "flex"
                             :flexDirection "column" :alignItems "flex-end"}}
               [FoundationTooltip
                {:tooltip "Hide for now"
                 :style {:borderBottom "none"}
                 :position "left"
                 :data-hover-delay 0
                 :text [:button {:className "button-reset" :onClick #(swap! state assoc :dismissed? true)
                                 :style {:display "block" :fontSize "1.5rem"
                                         :color "white" :cursor "pointer"}}
                        (icons/render-icon {} :close)]}]
               (when (= current-trial-state :Terminated)
                 (links/create-internal
                   {:style {:fontSize "small" :color "white" :margin "0.5rem -0.75rem -1.5rem"}
                    :onClick #(ajax/call-orch
                               "/profile/trial?operation=finalize"
                               {:method :post
                                :on-done user/reload-profile})}
                   "or hide forever?"))]
              (modals/show-modals
               state
               {:displaying-eula?
                (this :-show-eula-modal eulas)
                :error
                (modals/render-error {:text error :on-dismiss #(swap! state dissoc :error)})})))))))
   :component-will-mount
   (fn [{:keys [this state]}]
     (add-watch user/profile :trial-alerts
                (fn [_ _ _ {:keys [trialState]}]
                  (when trialState
                    (if-not (:messages @state)
                      (ajax/get-google-bucket-file "trial" #(swap! state assoc :messages %))
                      (.forceUpdate this))))))
   :-show-eula-modal
   (fn [{:keys [state]} eulas]
     (let [{:keys [page-2? terms-agreed? cloud-terms-agreed?]} @state
           {:keys [broad onix]} eulas
           accept-eula (fn []
                         (ajax/call-orch
                          "/profile/trial/userAgreement"
                          {:method :put
                           :on-done
                           (fn [{:keys [success?]}]
                             (if-not success?
                               (utils/multi-swap! state
                                 (assoc :error "An error occurred. Please try again.")
                                 (dissoc :loading?))
                               (ajax/call-orch
                                "/profile/trial"
                                {:method :post
                                 :on-done
                                 (fn [{:keys [success? get-parsed-response]}]
                                   (if success?
                                     (.reload js/location)))})))})
                         (utils/multi-swap! state
                           (assoc :loading? true)
                           (dissoc :displaying-eula?)))]
       [modals/OKCancelForm
        {:header "Welcome to the FireCloud Free Credit Program!"
         :dismiss #(swap! state dissoc :displaying-eula? :page-2? :terms-agreed? :cloud-terms-agreed?)
         :content
         (let [div-id (gensym "eula")]
           [:div {:id div-id
                  :style {:backgroundColor "white" :padding "1rem" :maxWidth 850}}
            [:style {}
             (str "#" div-id " .markdown-body strong {text-decoration: underline}\n"
                  "#" div-id " .markdown-body ol {counter-reset: item}\n"
                  "#" div-id " .markdown-body li:before {content: counters(item, \".\") \".\";\n"
                  "  counter-increment: item; margin-left: -2em; position: absolute}\n"
                  "#" div-id " .markdown-body li li:before {margin-left: -3em}\n"
                  "#" div-id " .markdown-body li li li:before {margin-left: -4em}\n"
                  "#" div-id " .markdown-body li {display: block}")]
            (if-not page-2?
              [markdown/MarkdownView {:text broad}]
              [:div {}
               [:div {:style {:fontSize "80%"}}
                [markdown/MarkdownView {:text onix}]]
               [:div {:style {:padding "1rem" :marginTop "0.5rem"
                              :border style/standard-line :background (:background-light style/colors)}}
                [:label {:style {:marginBottom "0.5rem" :display "block"}}
                 [:input {:type "checkbox"
                          :onChange #(swap! state assoc :terms-agreed? (.. % -target -checked))
                          :data-test-id "agree-terms"}]
                 "I agree to the terms of this Agreement."]
                [:label {:style {:display "block"}}
                 [:input {:type "checkbox"
                          :onChange #(swap! state assoc :cloud-terms-agreed? (.. % -target -checked))
                          :data-test-id "agree-cloud-terms"}]
                 "I agree to the Google Cloud Terms of Service."]
                [:div {:style {:paddingLeft "1rem"}} "Google Cloud Terms of Service: "
                 (links/create-external {:href "https://cloud.google.com/terms/"}
                   "https://cloud.google.com/terms/")]]])])
         :data-test-id "eula-modal"
         :button-bar (flex/box
                       {:style {:justifyContent "center" :width "100%"}}
                       (when page-2?
                         [buttons/Button
                          {:text "Back"
                           :style {:marginRight "2rem"}
                           :onClick #(swap! state dissoc :page-2? :terms-agreed? :cloud-terms-agreed?)}])
                       [buttons/Button
                        (if-not page-2?
                          {:text "Review Terms of Service"
                           :data-test-id "review-terms-of-service"
                           :onClick #(swap! state assoc :page-2? true)}
                          {:text "Accept"
                           :data-test-id "accept-terms-of-service"
                           :disabled? (when-not (and terms-agreed? cloud-terms-agreed?)
                                        "You must check the boxes to accept the agreement.")
                           :onClick accept-eula})])}]))})

(defn terra-link-text [terra-redirect-url]
  (let [final-terra-url (or terra-redirect-url (common/make-return-url))]
    [:div {}
      "You are using the classic FireCloud interface. "
      "As of August 2019, FireCloud will permanently migrate to our new experience, powered by Terra. Click "
      [:a {:href final-terra-url
           :target "_blank"
           :style {:color "white"}}
        "here"]
      " to try it out."]))

(react/defc TerraBanner
  {:render
   (fn [{:keys [state props]}]
     (let [{:keys [dismissed?]} @state
           {:keys [terra-redirect-url]} props]
       (when (not dismissed?)
         [:div {:style {:display "flex"
                        :align-items "center"
                        :height 66
                        :width "100%"
                        :border-bottom "2px solid rgb(176, 210, 57)"
                        :box-shadow "rgba(0, 0, 0, 0.12) 0px 3px 2px 0px"
                        :background "81px url('assets/header-left-hexes.svg') no-repeat,
                                       right url('assets/header-right-hexes.svg') no-repeat, rgb(116, 174, 67)"}}
          [:img {:src "assets/terra-logo.svg"
                  :style {:height "56px"
                          :width "60px"
                          :margin "4px 10px"}}]
          [:div {:style {:color "white"
                         :flexGrow 1
                         :text-align "center"
                         :font-weight "500"}}
            (if (and common/has-return? (config/terra-redirects-enabled))
              "This page is displaying in our legacy application. Please bear with us as we migrate these features fully into Terra."
              (terra-link-text terra-redirect-url))]
          [:div {:style {:margin "1rem"}}
           [FoundationTooltip
            {:tooltip "Hide for now"
             :style {:borderBottom "none"}
             :position "left"
             :data-hover-delay 0
             :text [:button {:className "button-reset" :onClick #(swap! state assoc :dismissed? true)
                             :style {:display "block" :fontSize "1.5rem"
                                     :color "white" :cursor "pointer"}}
                    (icons/render-icon {} :close)]}]]])))})

(ns broadfcui.common.notifications
  (:require
   [dmohs.react :as react]
   [broadfcui.common :as common]
   [broadfcui.common.flex-utils :as flex]
   [broadfcui.common.icons :as icons]
   [broadfcui.common.links :as links]
   [broadfcui.common.markdown :as markdown]
   [broadfcui.common.style :as style]
   [broadfcui.components.buttons :as buttons]
   [broadfcui.components.foundation-tooltip :refer [FoundationTooltip]]
   [broadfcui.components.modals :as modals]
   [broadfcui.components.spinner :refer [spinner]]
   [broadfcui.components.top-banner :as top-banner]
   [broadfcui.config :as config]
   [broadfcui.utils :as utils]
   [broadfcui.utils.ajax :as ajax]
   [broadfcui.utils.user :as user]
   ))

(defn render-alert [{:keys [cleared? link message title link-title severity]} dismiss]
  (let [text-color (case severity
                     :info (:text-lighter style/colors)
                     "#eee")
        background-color (case severity
                           :info (:background-light style/colors)
                           (if cleared?
                             (:state-success style/colors)
                             (:state-exception style/colors)))]
    (top-banner/render
      [:div {:style {:color text-color
                     :background-color background-color
                     :padding "1rem"}}
       (when cleared?
         [:div {:style {:float "right"}}
          (icons/render-icon {:style {:fontSize "80%" :cursor "pointer"} :on-click dismiss} :close)])
       [:div {:style {:display "flex" :align-items "baseline"}}
        [icons/ExceptionIcon {:size 18 :color text-color}]
        [:span {:style {:margin-left "0.5rem" :font-weight "bold" :vertical-align "middle"}}
         (or title "Service Alert")
         (when cleared?
           " (resolved)")]
        [:span {:style {:color text-color :fontSize "90%" :margin-left "1rem"}}
         message
         (when link
           (links/create-external {:href link
                                   :style {:color text-color :margin-left "1rem"}}
                                  (or link-title "Read more...")))]]])))

(defn- status-alert-interval [attempt]
  (cond
    (zero? attempt) (config/status-alerts-refresh)
    (> attempt (config/max-retry-attempts)) (config/status-alerts-refresh)
    :else (ajax/get-exponential-backoff-interval attempt)))

(react/defc ServiceAlertContainer
  {:get-initial-state
   (fn []
     {:failed-retries 0})
   :render
   (fn [{:keys [this state]}]
     (let [{:keys [service-alerts]} @state]
       [:div {}
        (when (:show-new-service-alert-message? @state)
          (modals/render-message {:header "New Service Alert" :text "See the page header for details."
                                  :dismiss #(swap! state dissoc :show-new-service-alert-message?)}))
        (map #(render-alert % (partial this :-remove-alert %)) service-alerts)]))
   :component-did-update
   (fn [{:keys [this state locals]}]
     ;; Reset the interval
     (js/clearInterval (:interval-id @locals))
     ;; Update the poll interval based on the number of failed attempts (for exponential back offs)
     (swap! locals assoc :interval-id
            (js/setInterval #(this :-load-service-alerts)
                            (status-alert-interval (:failed-retries @state)))))
   :component-did-mount
   (fn [{:keys [this state locals]}]
     ;; Call once for initial load
     (this :-load-service-alerts true)
     ;; Add initial poll interval
     (swap! locals assoc :interval-id
            (js/setInterval #(this :-load-service-alerts)
                            (status-alert-interval (:failed-retries @state)))))
   :component-will-unmount
   (fn [{:keys [locals]}]
     (js/clearInterval (:interval-id @locals)))
   :-load-service-alerts
   (fn [{:keys [this]} & [first-time?]]
     (ajax/call {:url (config/google-bucket-url "alerts")
                 :on-done (partial this :-handle-response first-time?)}))
   :-handle-response
   (fn [{:keys [state]} first-time? {:keys [status-code raw-response]}]
     (let [alerts (if (and (ajax/check-server-down status-code)
                           (>= (:failed-retries @state) (config/max-retry-attempts)))
                    [{:title "Google Service Alert"
                      :message "There may be problems accessing data in Google Cloud Storage."
                      :link "https://status.cloud.google.com/"}]
                    (let [[parsed _] (utils/parse-json-string raw-response true false)]
                      parsed))
           alerts-set (set alerts)
           existing (set (remove :cleared? (:service-alerts @state)))
           cleared (clojure.set/difference existing alerts-set)
           new (clojure.set/difference alerts-set existing)
           updated (concat (:service-alerts @state) (filter #(contains? new %) alerts))
           updated (map (fn [alert]
                          (if (contains? cleared alert) (assoc alert :cleared? true) alert))
                        updated)]
       (swap! state assoc
              :service-alerts updated
              :failed-retries (if (ajax/check-server-down status-code)
                                (inc (:failed-retries @state))
                                0))
       (when (and (seq new) (not first-time?))
         (swap! state assoc :show-new-service-alert-message? true))))
   :-remove-alert
   (fn [{:keys [state]} alert]
     (swap! state update :service-alerts #(filter (partial not= alert) %)))})

(react/defc TrialAlertContainer
  {:render
   (fn [{:keys [state this]}]
     (let [{:keys [dismissed? loading? messages error]} @state]
       (when-let [current-trial-state (keyword (:trialState @user/profile))]
         (when (and (not dismissed?) (current-trial-state messages)) ; Disabled or mis-keyed users do not see a banner
           (let [{:keys [title message warning? link button eulas]} (messages current-trial-state)]
             (apply ;; needed until dmohs/react deals with nested seq's
              flex/box {:style {:color "white"
                                :background-color ((if warning? :state-warning :button-primary) style/colors)}}
              (flex/box {:style {:padding "1rem" :flexGrow 1
                                 :justifyContent "center" :alignItems "center"}}
                [:div {:data-test-id "trial-banner-title"
                       :style {:fontSize "1.5rem" :fontWeight 500 :textAlign "right"
                               :borderRight "1px solid white"
                               :paddingRight "1rem" :marginRight "1rem"
                               :maxWidth 200 :flexShrink 0}}
                 title]
                [:span {:style {:maxWidth 600 :lineHeight "1.5rem"}}
                 message
                 (when-let [{:keys [label url]} link]
                   (links/create-external {:href url :style {:color "white" :marginLeft "0.5rem"}} label))]
                (when-let [{:keys [label url external?]} button]
                  [:a {:data-test-id "trial-banner-button"
                       :data-test-state (if loading? "loading" "ready")
                       :style {:display "block"
                               :color "white" :textDecoration "none" :fontSize "1.125rem"
                               :fontWeight 500
                               :border "2px solid white" :borderRadius "0.25rem"
                               :padding "0.5rem 1rem" :marginLeft "0.5rem" :flexShrink 0}
                       :href (if external? url (when-not loading? "javascript:;"))
                       :onClick (when-not (or external? loading?)
                                  #(swap! state assoc :displaying-eula? true))
                       :target (when external? "_blank")}
                   (if loading?
                     (spinner {:style {:fontSize "1rem" :margin 0}})
                     label)
                   (when external?
                     (icons/render-icon
                      {:style {:margin "-0.5em -0.3em -0.5em 0.5em" :fontSize "1rem"}}
                      :external-link))]))
              [:div {:style {:alignSelf "center" :padding "1rem" :display "flex"
                             :flexDirection "column" :alignItems "flex-end"}}
               [FoundationTooltip
                {:tooltip "Hide for now"
                 :style {:borderBottom "none"}
                 :position "left"
                 :data-hover-delay 0
                 :text [:button {:className "button-reset" :onClick #(swap! state assoc :dismissed? true)
                                 :style {:display "block" :fontSize "1.5rem"
                                         :color "white" :cursor "pointer"}}
                        (icons/render-icon {} :close)]}]
               (when (= current-trial-state :Terminated)
                 (links/create-internal
                   {:style {:fontSize "small" :color "white" :margin "0.5rem -0.75rem -1.5rem"}
                    :onClick #(ajax/call-orch
                               "/profile/trial?operation=finalize"
                               {:method :post
                                :on-done user/reload-profile})}
                   "or hide forever?"))]
              (modals/show-modals
               state
               {:displaying-eula?
                (this :-show-eula-modal eulas)
                :error
                (modals/render-error {:text error :on-dismiss #(swap! state dissoc :error)})})))))))
   :component-will-mount
   (fn [{:keys [this state]}]
     (add-watch user/profile :trial-alerts
                (fn [_ _ _ {:keys [trialState]}]
                  (when trialState
                    (if-not (:messages @state)
                      (ajax/get-google-bucket-file "trial" #(swap! state assoc :messages %))
                      (.forceUpdate this))))))
   :-show-eula-modal
   (fn [{:keys [state]} eulas]
     (let [{:keys [page-2? terms-agreed? cloud-terms-agreed?]} @state
           {:keys [broad onix]} eulas
           accept-eula (fn []
                         (ajax/call-orch
                          "/profile/trial/userAgreement"
                          {:method :put
                           :on-done
                           (fn [{:keys [success?]}]
                             (if-not success?
                               (utils/multi-swap! state
                                 (assoc :error "An error occurred. Please try again.")
                                 (dissoc :loading?))
                               (ajax/call-orch
                                "/profile/trial"
                                {:method :post
                                 :on-done
                                 (fn [{:keys [success? get-parsed-response]}]
                                   (if success?
                                     (.reload js/location)))})))})
                         (utils/multi-swap! state
                           (assoc :loading? true)
                           (dissoc :displaying-eula?)))]
       [modals/OKCancelForm
        {:header "Welcome to the FireCloud Free Credit Program!"
         :dismiss #(swap! state dissoc :displaying-eula? :page-2? :terms-agreed? :cloud-terms-agreed?)
         :content
         (let [div-id (gensym "eula")]
           [:div {:id div-id
                  :style {:backgroundColor "white" :padding "1rem" :maxWidth 850}}
            [:style {}
             (str "#" div-id " .markdown-body strong {text-decoration: underline}\n"
                  "#" div-id " .markdown-body ol {counter-reset: item}\n"
                  "#" div-id " .markdown-body li:before {content: counters(item, \".\") \".\";\n"
                  "  counter-increment: item; margin-left: -2em; position: absolute}\n"
                  "#" div-id " .markdown-body li li:before {margin-left: -3em}\n"
                  "#" div-id " .markdown-body li li li:before {margin-left: -4em}\n"
                  "#" div-id " .markdown-body li {display: block}")]
            (if-not page-2?
              [markdown/MarkdownView {:text broad}]
              [:div {}
               [:div {:style {:fontSize "80%"}}
                [markdown/MarkdownView {:text onix}]]
               [:div {:style {:padding "1rem" :marginTop "0.5rem"
                              :border style/standard-line :background (:background-light style/colors)}}
                [:label {:style {:marginBottom "0.5rem" :display "block"}}
                 [:input {:type "checkbox"
                          :onChange #(swap! state assoc :terms-agreed? (.. % -target -checked))
                          :data-test-id "agree-terms"}]
                 "I agree to the terms of this Agreement."]
                [:label {:style {:display "block"}}
                 [:input {:type "checkbox"
                          :onChange #(swap! state assoc :cloud-terms-agreed? (.. % -target -checked))
                          :data-test-id "agree-cloud-terms"}]
                 "I agree to the Google Cloud Terms of Service."]
                [:div {:style {:paddingLeft "1rem"}} "Google Cloud Terms of Service: "
                 (links/create-external {:href "https://cloud.google.com/terms/"}
                   "https://cloud.google.com/terms/")]]])])
         :data-test-id "eula-modal"
         :button-bar (flex/box
                       {:style {:justifyContent "center" :width "100%"}}
                       (when page-2?
                         [buttons/Button
                          {:text "Back"
                           :style {:marginRight "2rem"}
                           :onClick #(swap! state dissoc :page-2? :terms-agreed? :cloud-terms-agreed?)}])
                       [buttons/Button
                        (if-not page-2?
                          {:text "Review Terms of Service"
                           :data-test-id "review-terms-of-service"
                           :onClick #(swap! state assoc :page-2? true)}
                          {:text "Accept"
                           :data-test-id "accept-terms-of-service"
                           :disabled? (when-not (and terms-agreed? cloud-terms-agreed?)
                                        "You must check the boxes to accept the agreement.")
                           :onClick accept-eula})])}]))})

(defn terra-link-text [terra-redirect-url]
  (let [final-terra-url (or terra-redirect-url (common/make-return-url))]
    [:div {}
      "You are using the classic FireCloud interface. "
      "FireCloud will permanently migrate to our new experience, powered by Terra. Click "
      [:a {:href final-terra-url
           :target "_blank"
           :style {:color "white"}}
        "here"]
      " to try it out."]))

(react/defc TerraBanner
  {:render
   (fn [{:keys [state props]}]
     (let [{:keys [dismissed?]} @state
           {:keys [terra-redirect-url]} props]
       (when (not dismissed?)
         [:div {:style {:display "flex"
                        :align-items "center"
                        :height 66
                        :width "100%"
                        :border-bottom "2px solid rgb(176, 210, 57)"
                        :box-shadow "rgba(0, 0, 0, 0.12) 0px 3px 2px 0px"
                        :background "81px url('assets/header-left-hexes.svg') no-repeat,
                                       right url('assets/header-right-hexes.svg') no-repeat, rgb(116, 174, 67)"}}
          [:img {:src "assets/terra-logo.svg"
                  :style {:height "56px"
                          :width "60px"
                          :margin "4px 10px"}}]
          [:div {:style {:color "white"
                         :flexGrow 1
                         :text-align "center"
                         :font-weight "500"}}
            (if (and common/has-return? (config/terra-redirects-enabled))
              "This page is displaying in our legacy application. Please bear with us as we migrate these features fully into Terra."
              (terra-link-text terra-redirect-url))]
          [:div {:style {:margin "1rem"}}
           [FoundationTooltip
            {:tooltip "Hide for now"
             :style {:borderBottom "none"}
             :position "left"
             :data-hover-delay 0
             :text [:button {:className "button-reset" :onClick #(swap! state assoc :dismissed? true)
                             :style {:display "block" :fontSize "1.5rem"
                                     :color "white" :cursor "pointer"}}
                    (icons/render-icon {} :close)]}]]])))})

update migration banner to remove August reference (#1558) [SATURN-933]


;; Copyright (c) Stuart Sierra, 2012. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this
;; distribution. By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license. You must not
;; remove this notice, or any other, from this software.

(ns ^{:author "Stuart Sierra"
      :doc "REPL utilities for working with namespaces"}
  clojure.tools.namespace.repl
  (:require [clojure.tools.namespace.track :as track]
            [clojure.tools.namespace.dir :as dir]
            [clojure.tools.namespace.reload :as reload]))

(defonce ^:private refresh-tracker (track/tracker))

(defonce ^:private refresh-dirs [])

(defn- print-and-return [tracker]
  (if-let [e (::reload/error tracker)]
    (do (when (thread-bound? #'*e)
          (set! *e e))
        (prn :error-while-loading (::reload/error-ns tracker))
        e)
    :ok))

(defn- print-pending-reloads [tracker]
  (prn :reloading (::track/load tracker)))

(defn- load-disabled? [sym]
  (false? (::load (meta (find-ns sym)))))

(defn- unload-disabled? [sym]
  (or (false? (::unload (meta (find-ns sym))))
      (load-disabled? sym)))

(defn- remove-disabled [tracker]
  (-> tracker
      (update-in [::track/unload] #(remove unload-disabled? %))
      (update-in [::track/load] #(remove load-disabled? %))))

(defn- do-refresh [scan-fn after-sym]
  (let [current-ns (ns-name *ns*)]
    (alter-var-root #'refresh-tracker
                    #(apply scan-fn % refresh-dirs))
    (alter-var-root #'refresh-tracker remove-disabled)
    (print-pending-reloads refresh-tracker)
    (alter-var-root #'refresh-tracker reload/track-reload)
    (in-ns current-ns)
    (let [result (print-and-return refresh-tracker)]
      (if (and (= :ok result) after-sym)
        ((ns-resolve *ns* after-sym))
        result))))

(defn disable-unload!
  "Adds metadata to namespace (or *ns* if unspecified) telling
  'refresh' not to unload it. The namespace may still be reloaded, it
  just won't be removed first."
  ([] (disable-unload! *ns*))
  ([namespace] (alter-meta! namespace assoc ::unload false)))

(defn disable-reload!
  "Adds metadata to namespace (or *ns* if unspecified) telling
  'refresh' not to load it. Implies disable-unload! also."
  ([] (disable-reload! *ns*))
  ([namespace] (alter-meta! namespace assoc ::load false)))

(defn refresh
  "Scans source code directories for files which have changed (since
  the last time this function was run) and reloads them in dependency
  order. Returns :ok or an error; sets the latest exception to
  clojure.core/*e (if *e is thread-bound).

  The directories to be scanned are controlled by 'set-refresh-dirs';
  defaults to all directories on the Java classpath.

  Options are key-value pairs. Valid options are:

      :after   Namespace-qualified symbol naming a zero-argument
               function to be invoked after a successful refresh. This
               symbol will be resolved *after* all namespaces have
               been reloaded."
  [& options]
  (let [{:keys [after]} options]
    (when after
      (assert (symbol? after) ":after value must be a symbol")
      (assert (namespace after)
              ":after value must be a namespace-qualified symbol"))
    (do-refresh dir/scan after)))

(defn refresh-all
  "Scans source code directories for all Clojure source files and
  reloads them in dependency order.

  The directories to be scanned are controlled by 'set-refresh-dirs';
  defaults to all directories on the Java classpath."
  []
  (do-refresh dir/scan-all))

(defn set-refresh-dirs
  "Sets the directories which are scanned by 'refresh'. Supports the
  same types as clojure.java.io/file."
  [& dirs]
  (alter-var-root #'refresh-dirs (constantly dirs)))

;; Copyright (c) Stuart Sierra, 2012. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this
;; distribution. By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license. You must not
;; remove this notice, or any other, from this software.

(ns ^{:author "Stuart Sierra"
      :doc "REPL utilities for working with namespaces"}
  clojure.tools.namespace.repl
  (:require [clojure.tools.namespace.track :as track]
            [clojure.tools.namespace.dir :as dir]
            [clojure.tools.namespace.reload :as reload]))

(defonce ^:private refresh-tracker (track/tracker))

(defonce ^:private refresh-dirs [])

(defn- print-and-return [tracker]
  (if-let [e (::reload/error tracker)]
    (do (when (thread-bound? #'*e)
          (set! *e e))
        (prn :error-while-loading (::reload/error-ns tracker))
        e)
    :ok))

(defn- print-pending-reloads [tracker]
  (prn :reloading (::track/load tracker)))

(defn- load-disabled? [sym]
  (false? (::load (meta (find-ns sym)))))

(defn- unload-disabled? [sym]
  (or (false? (::unload (meta (find-ns sym))))
      (load-disabled? sym)))

(defn- remove-disabled [tracker]
  (-> tracker
      (update-in [::track/unload] #(remove unload-disabled? %))
      (update-in [::track/load] #(remove load-disabled? %))))

(defn- do-refresh [scan-fn after-sym]
  (when after-sym
    (assert (symbol? after-sym) ":after value must be a symbol")
    (assert (namespace after-sym)
            ":after value must be a namespace-qualified symbol"))
  (let [current-ns (ns-name *ns*)]
    (alter-var-root #'refresh-tracker
                    #(apply scan-fn % refresh-dirs))
    (alter-var-root #'refresh-tracker remove-disabled)
    (print-pending-reloads refresh-tracker)
    (alter-var-root #'refresh-tracker reload/track-reload)
    (in-ns current-ns)
    (let [result (print-and-return refresh-tracker)]
      (if (and (= :ok result) after-sym)
        ((ns-resolve *ns* after-sym))
        result))))

(defn disable-unload!
  "Adds metadata to namespace (or *ns* if unspecified) telling
  'refresh' not to unload it. The namespace may still be reloaded, it
  just won't be removed first."
  ([] (disable-unload! *ns*))
  ([namespace] (alter-meta! namespace assoc ::unload false)))

(defn disable-reload!
  "Adds metadata to namespace (or *ns* if unspecified) telling
  'refresh' not to load it. Implies disable-unload! also."
  ([] (disable-reload! *ns*))
  ([namespace] (alter-meta! namespace assoc ::load false)))

(defn refresh
  "Scans source code directories for files which have changed (since
  the last time this function was run) and reloads them in dependency
  order. Returns :ok or an error; sets the latest exception to
  clojure.core/*e (if *e is thread-bound).

  The directories to be scanned are controlled by 'set-refresh-dirs';
  defaults to all directories on the Java classpath.

  Options are key-value pairs. Valid options are:

      :after   Namespace-qualified symbol naming a zero-argument
               function to be invoked after a successful refresh. This
               symbol will be resolved *after* all namespaces have
               been reloaded."
  [& options]
  (let [{:keys [after]} options]
    (do-refresh dir/scan after)))

(defn refresh-all
  "Scans source code directories for all Clojure source files and
  reloads them in dependency order.

  The directories to be scanned are controlled by 'set-refresh-dirs';
  defaults to all directories on the Java classpath.

  Options are key-value pairs. Valid options are:

      :after   Namespace-qualified symbol naming a zero-argument
               function to be invoked after a successful refresh. This
               symbol will be resolved *after* all namespaces have
               been reloaded."
  [& options]
  (let [{:keys [after]} options]
    (do-refresh dir/scan-all after)))

(defn set-refresh-dirs
  "Sets the directories which are scanned by 'refresh'. Supports the
  same types as clojure.java.io/file."
  [& dirs]
  (alter-var-root #'refresh-dirs (constantly dirs)))

Fix arguments & support :after in refresh-all


(ns overtunes.songs.canone-alla-quarta
  (:use
    [overtone.live :only [at now]]
    [overtone.inst.sampled-piano :only [sampled-piano] :rename {sampled-piano piano#}]))

(defn update-all [m [& ks] f]
    (if ks
          (update-in
                  (update-all m (rest ks) f)
                  [(first ks)]
                  f)
          m))

(defn natural-map [ys] (zipmap (-> ys count range) ys))
(defn natural-seq [f]
    (if-let [y (f 0)]
          (cons y (natural-seq (comp f inc)))
          '()))

(defn connect [f1 f2] #(if-let [y2 (f2 %)] (f1 y2) nil))

(defn sum-n [series n] (reduce + (take n series)))
(defn sums [series] (cons 0 (reductions + series)))
(defn scale [intervals]
  #(if (neg? %)
     (let [downward-scale (connect - (scale (reverse intervals)))]
       (-> % - downward-scale))
     (sum-n (cycle intervals) %)))

(defn translate [f x y] #(-> % (+ x) f (+ y)))
(defn shift [f x] (connect #(+ x %) f))
(def major (scale [2 2 1 2 2 2 1]))
(def g-major (translate major 0 74))

(defn bpm [per-minute] #(-> % (/ per-minute) (* 60) (* 1000)))
(defn syncopate [timing durations] #(->> % (sum-n durations) timing))
(defn run [a & bs]
  (let [up-or-down #(if (<= %1 %2) (range %1 %2) (reverse (range (inc %2) (inc %1))))]
    (if bs
      (concat (up-or-down a (first bs)) (apply run bs))
      [a])))

(defn melody [notes]
  (let [functionalise #(update-all % [:time :pitch] natural-map)
        accumulate-time (update :time sums)]
    (-> notes accumulate-time functionalise)))

(def leader
  (let [call
          {:time (mapcat repeat [2 1 14 1] [1/4 1/2 1/4 3/2])
           :pitch (concat [0] (run -1 3) (run 2 0) [4] (run 1 8))}
        response
          {:time (mapcat repeat [10 1 2 1]  [1/4 1/2 1/4 9/4])
           :pitch (concat (run 7 -1) [0] (run 0 -3))}
        development
          {:time (mapcat repeat [1 12 1 1 1 12 1] [3/4 1/4 1/2 1 1/2 1/4 3])
           :pitch (concat [4 4] (run 2 -3) [-1 -2 0] (run 3 5) (repeat 3 1) [2] (run -1 1) [0 -1] (run 5 0))}
        line
          (merge-with concat call response development)]
    (melody line)))

(def bass
  (let [line
          {:time (repeat 24 1)
           :pitch (mapcat (partial repeat 3) (concat (run 0 -3) (run -5 -3) [0 7]))}
        lower-note #(- % 7)
        lower-melody (update :pitch #(connect lower-note %))]
   (-> bassline melody lower-melody)))

(defn melody# [melody]
  (let [notes (update-all melody [:pitch :time] natural-seq)
        play-at #(at %1 (piano# %2))]
    (dorun (map play-at (:time notes) (:pitch notes)))))

(defn update [k f] #(update-in % [k] f))
(def mirror (update :pitch #(connect - %)))
(defn after [beats] (update :time #(shift % beats)))
(defn transpose [interval] (update :pitch #(shift % interval)))
(def canone-alla-quarta (reduce connect [(after 3) (transpose -3) mirror]))

(defn sharps [notes] #(if (contains? notes %) (inc %) %))
(defn flats [notes] #(if (contains? notes %) (dec %) %))

(defn play# []
  (let [from-now #(translate % 0 (now))
        beat (from-now (bpm 100))
        with-beat (update :time (partial connect beat))
        in-key (update :pitch (partial connect g-major))
        after-a-half (after 1/2)
        with-sharps (update :pitch #(comp (sharps [12 22]) %))
        with-flats (update :pitch #(comp (flats [37]) %))]
    (-> bass in-key with-beat melody#)
    (-> leader after-a-half canone-alla-quarta in-key with-beat melody#)
    (-> leader after-a-half in-key with-sharps with-flats with-beat melody#)
    ))

(play#)

(ns overtunes.songs.canone-alla-quarta
  (:use
    [overtone.live :only [at now]]
    [overtone.inst.sampled-piano :only [sampled-piano] :rename {sampled-piano piano#}]))

(defn update-all [m [& ks] f]
    (if ks
          (update-in
                  (update-all m (rest ks) f)
                  [(first ks)]
                  f)
          m))

(defn natural-map [ys] (zipmap (-> ys count range) ys))
(defn natural-seq [f]
    (if-let [y (f 0)]
          (cons y (natural-seq (comp f inc)))
          '()))

(defn connect [f1 f2] #(if-let [y2 (f2 %)] (f1 y2) nil))

(defn sum-n [series n] (reduce + (take n series)))
(defn sums [series] (cons 0 (reductions + series)))
(defn scale [intervals]
  #(if (neg? %)
     (let [downward-scale (connect - (scale (reverse intervals)))]
       (-> % - downward-scale))
     (sum-n (cycle intervals) %)))

(defn translate [f x y] #(-> % (+ x) f (+ y)))
(defn shift [f x] (connect #(+ x %) f))
(def major (scale [2 2 1 2 2 2 1]))
(def g-major (translate major 0 74))

(defn bpm [per-minute] #(-> % (/ per-minute) (* 60) (* 1000)))
(defn syncopate [timing durations] #(->> % (sum-n durations) timing))
(defn run [a & bs]
  (let [up-or-down #(if (<= %1 %2) (range %1 %2) (reverse (range (inc %2) (inc %1))))]
    (if bs
      (concat (up-or-down a (first bs)) (apply run bs))
      [a])))

(defn melody [notes]
  (let [functionalise #(update-all % [:time :pitch] natural-map)
        accumulate-time (update :time sums)]
    (-> notes accumulate-time functionalise)))

(def leader
  (let [call
          {:time (mapcat repeat [2 1 14 1] [1/4 1/2 1/4 3/2])
           :pitch (concat (run 0 -1 3 0) [4] (run 1 8))}
        response
          {:time (mapcat repeat [10 1 2 1]  [1/4 1/2 1/4 9/4])
           :pitch (concat (run 7 -1 0) (run 0 -3))}
        development
          {:time (mapcat repeat [1 12 1 1 1 12 1] [3/4 1/4 1/2 1 1/2 1/4 3])
           :pitch (concat [4 4] (run 2 -3) [-1 -2 0] (run 3 5) (repeat 3 1) [2] (run -1 1 -1) (run 5 0))}
        line
          (merge-with concat call response development)]
    (melody line)))

(def bass
  (let [line
          {:time (repeat 24 1)
           :pitch (mapcat (partial repeat 3) (concat (run 0 -3) (run -5 -3) [0 7]))}
        lower-note #(- % 7)
        lower-melody (update :pitch #(connect lower-note %))]
   (-> bassline melody lower-melody)))

(defn melody# [melody]
  (let [notes (update-all melody [:pitch :time] natural-seq)
        play-at #(at %1 (piano# %2))]
    (dorun (map play-at (:time notes) (:pitch notes)))))

(defn update [k f] #(update-in % [k] f))
(def mirror (update :pitch #(connect - %)))
(defn after [beats] (update :time #(shift % beats)))
(defn transpose [interval] (update :pitch #(shift % interval)))
(def canone-alla-quarta (reduce connect [(after 3) (transpose -3) mirror]))

(defn sharps [notes] #(if (contains? notes %) (inc %) %))
(defn flats [notes] #(if (contains? notes %) (dec %) %))

(defn play# []
  (let [from-now #(translate % 0 (now))
        beat (from-now (bpm 100))
        with-beat (update :time (partial connect beat))
        in-key (update :pitch (partial connect g-major))
        after-a-half (after 1/2)
        with-sharps (update :pitch #(comp (sharps [12 22]) %))
        with-flats (update :pitch #(comp (flats [37]) %))]
    (-> bass in-key with-beat melody#)
    (-> leader after-a-half canone-alla-quarta in-key with-beat melody#)
    (-> leader after-a-half in-key with-sharps with-flats with-beat melody#)
    ))

(play#)

Make run handle n arguments

Make run handle n arguments


(ns u
  (:require [clojure.pprint])
  (:require [clojure.string :as string]))

; =======
; Utilities: general purpose fns to be used mostly inside other fns

(defn sym-to-var [sym]
  "Converts a symbol to var"
  ((ns-interns ((meta (resolve sym)) :ns)) sym))

(defn split [f coll]
  "Like ruby's partition"
  [(filter f coll) (remove f coll)])

; TODO: only display vars local to a namespace
(defn ns-dynamic-vars
  "dynamic vars for a namespace as determined by *var* convention"
  ([] (ns-dynamic-vars *ns*))
  ([nsname]
   (let [nsmap (ns-map nsname)]
     (->> nsmap (map first) (filter #(re-find #"^\*.*\*$" (str %))) (map #(nsmap %))))))

; =========
; Misc: Collection of useful fns for doc, debugging, etc.

;TODO: macroize so it can sit in front of a call like apply
(defn spy "Simple print debugging" [arg]
  (doto arg prn))

(defn doc-dir [nsname]
  "Prints docs for a given namespace"
  (let [ [resolved unresolved] (split resolve (clojure.repl/dir-fn nsname)) ]
    (doseq [sym resolved]
      (@#'clojure.repl/print-doc (meta (sym-to-var sym))))
    (when-not (empty? unresolved)
      (println (str "\n" "Unable to resolve these symbols: " (string/join ", " unresolved))))))

(def ^:dynamic *display* :table)

(defn display
  "Pretty prints data or returns it depending on value of *display*. Default is to print with table."
  [data & options]
  (case *display*
    :pprint (do (clojure.pprint/pprint data) (println ""))
    :self (identity data)
    (apply table.core/table data options)))

; =========
; Inspectors: inspect vars, namespaces, fns, envs, properties ...

(defn java-methods "List of methods for a java class" [klass]
  (sort (distinct (map #(.getName %) (seq (.getMethods klass))))))

; mtable 'doc
(defn var-meta "Prints meta of a symbol" [sym]
  (display (meta (resolve sym))))

(defn vars-meta "Prints public vars for a namespace with its meta info"
  ([] (vars-meta *ns*))
  ([nsname]
    (display (map #( meta (resolve %)) (clojure.repl/dir-fn nsname)))))

(defn vars-values
  "Prints dynamic vars for a namespace mapped to their values"
   [& options]
   (let [opts (apply hash-map options)]
     (apply
       display
       (cons
         ["Var" "Value"]
         (map #(identity [% (deref %)]) (ns-dynamic-vars (get opts :ns *ns*))))
       :sort true
       options)))

(defn class-paths "Prints list of class paths" []
  (clojure.pprint/pprint (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader)))))

(defn properties "List properties and their values" []
  (display
    (->> (System/getProperties) .stringPropertyNames
      (reduce #(assoc %1 %2 (System/getProperty %2)) {}))))

(defn envs "List of envs and their values" []
  (->> (System/getenv) keys (reduce #(assoc %1 %2 (System/getenv %2)) {}) display))

; Configuration
(set! clojure.core/*print-length* 100)
(set! clojure.core/*print-level* 5)

(println "Loaded user.clj!")

(ns u
  (:require [clojure.pprint])
  (:require [clojure.string :as string]))

; =======
; Utilities: general purpose fns to be used mostly inside other fns

(defn sym-to-var [sym]
  "Converts a symbol to var"
  ((ns-interns ((meta (resolve sym)) :ns)) sym))

(defn split [f coll]
  "Like ruby's partition"
  [(filter f coll) (remove f coll)])

; TODO: only display vars local to a namespace
(defn ns-dynamic-vars
  "dynamic vars for a namespace as determined by *var* convention"
  ([] (ns-dynamic-vars *ns*))
  ([nsname]
   (let [nsmap (ns-map nsname)]
     (->> nsmap (map first) (filter #(re-find #"^\*.*\*$" (str %))) (map #(nsmap %))))))

; =========
; Misc: Collection of useful fns for doc, debugging, etc.

;TODO: macroize so it can sit in front of a call like apply
(defn spy "Simple print debugging" [arg]
  (doto arg prn))

(defn doc-dir "Prints docs for a given namespace" [nsname]
  (let [ [resolved unresolved] (split resolve (clojure.repl/dir-fn nsname)) ]
    (doseq [sym resolved]
      (@#'clojure.repl/print-doc (meta (sym-to-var sym))))
    (when-not (empty? unresolved)
      (println (str "\n" "Unable to resolve these symbols: " (string/join ", " unresolved))))))

(def ^:dynamic *display* :table)

(defn display
  "Pretty prints data or returns it depending on value of *display*. Default is to print with table."
  [data & options]
  (case *display*
    :pprint (do (clojure.pprint/pprint data) (println ""))
    :self (identity data)
    (apply table.core/table data options)))

; =========
; Inspectors: inspect vars, namespaces, fns, envs, properties ...

(defn java-methods "List of methods for a java class" [klass]
  (sort (distinct (map #(.getName %) (seq (.getMethods klass))))))

; mtable 'doc
(defn var-meta "Prints meta of a symbol" [sym]
  (display (meta (resolve sym))))

(defn vars-meta "Prints public vars for a namespace with its meta info"
  ([] (vars-meta *ns*))
  ([nsname]
    (display (map #( meta (resolve %)) (clojure.repl/dir-fn nsname)))))

(defn vars-values
  "Prints dynamic vars for a namespace mapped to their values"
   [& options]
   (let [opts (apply hash-map options)]
     (apply
       display
       (cons
         ["Var" "Value"]
         (map #(identity [% (deref %)]) (ns-dynamic-vars (get opts :ns *ns*))))
       :sort true
       options)))

(defn class-paths "Prints list of class paths" []
  (clojure.pprint/pprint (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader)))))

(defn properties "List properties and their values" []
  (display
    (->> (System/getProperties) .stringPropertyNames
      (reduce #(assoc %1 %2 (System/getProperty %2)) {}))))

(defn envs "List of envs and their values" []
  (->> (System/getenv) keys (reduce #(assoc %1 %2 (System/getenv %2)) {}) display))

; Configuration
(set! clojure.core/*print-length* 100)
(set! clojure.core/*print-level* 5)

(println "Loaded user.clj!")

fix doc string

fix doc string


(ns com.puppetlabs.puppetdb.test.query.event
  (:require [com.puppetlabs.puppetdb.scf.storage :as scf-store]
            [com.puppetlabs.puppetdb.report :as report]
            [com.puppetlabs.puppetdb.query :as query]
            [com.puppetlabs.puppetdb.query.event :as event-query]
            [com.puppetlabs.utils :as utils])
  (:use clojure.test
         com.puppetlabs.puppetdb.fixtures
         com.puppetlabs.puppetdb.examples.report
         [com.puppetlabs.puppetdb.testutils.report :only [store-example-report!]]
         com.puppetlabs.puppetdb.testutils.event
         [clj-time.coerce :only [to-string to-timestamp to-long]]
         [clj-time.core :only [now ago days]]))

(use-fixtures :each with-test-db)

;; Begin tests

(deftest test-compile-resource-event-term
  (testing "should succesfully compile a valid equality query"
    (is (= (query/compile-term  event-query/resource-event-ops ["=" "report" "blah"])
           {:where   "resource_events.report = ?"
            :params  ["blah"]})))
  (testing "should fail with an invalid equality query"
    (is (thrown-with-msg?
          IllegalArgumentException #"foo is not a queryable object for resource events"
          (query/compile-term event-query/resource-event-ops ["=" "foo" "foo"]))))
  (testing "should successfully compile valid inequality queries"
    (let [start-time  "2011-01-01T12:00:01-03:00"
          end-time    "2011-01-01T12:00:03-03:00"]
      (is (= (query/compile-term  event-query/resource-event-ops [">" "timestamp" start-time])
            {:where   "resource_events.timestamp > ?"
             :params  [(to-timestamp start-time)]}))
      (is (= (query/compile-term  event-query/resource-event-ops ["<" "timestamp" end-time])
            {:where   "resource_events.timestamp < ?"
             :params  [(to-timestamp end-time)]}))
      (is (= (query/compile-term  event-query/resource-event-ops
                ["and" [">=" "timestamp" start-time] ["<=" "timestamp" end-time]])
            {:where   "(resource_events.timestamp >= ?) AND (resource_events.timestamp <= ?)"
             :params  [(to-timestamp start-time) (to-timestamp end-time)]}))))
  (testing "should fail with invalid inequality queries"
    (is (thrown-with-msg?
          IllegalArgumentException #"> requires exactly two arguments"
          (query/compile-term event-query/resource-event-ops [">" "timestamp"])))
    (is (thrown-with-msg?
          IllegalArgumentException #"'foo' is not a valid timestamp value"
          (query/compile-term event-query/resource-event-ops [">" "timestamp" "foo"])))
    (is (thrown-with-msg?
          IllegalArgumentException #"> operator does not support object 'resource_type'"
          (query/compile-term event-query/resource-event-ops [">" "resource_type" "foo"])))))

(deftest resource-event-queries
  (let [basic         (:basic reports)
        report-hash   (store-example-report! basic (now))]

    (testing "resource event retrieval by report"
      (testing "should return the list of resource events for a given report hash"
        (let [expected  (expected-resource-events (:resource-events basic) report-hash)
              actual    (resource-events-query-result ["=" "report" report-hash])]
          (is (= actual expected)))))

    (testing "resource event timestamp queries"
      (testing "should return the list of resource events that occurred before a given time"
        (let [end-time  "2011-01-01T12:00:03-03:00"
              expected    (expected-resource-events
                            (filter #(> (to-long end-time) (to-long (:timestamp %)))
                              (:resource-events basic))
                            report-hash)
              actual      (resource-events-query-result ["<" "timestamp" end-time])]
          (is (= actual expected))
          (is (= 2 (count actual)))))
      (testing "should return the list of resource events that occurred after a given time"
        (let [start-time  "2011-01-01T12:00:01-03:00"
              expected    (expected-resource-events
                            (filter #(< (to-long start-time) (to-long (:timestamp %)))
                              (:resource-events basic))
                            report-hash)
              actual      (resource-events-query-result [">" "timestamp" start-time])]
          (is (= actual expected))
          (is (= 2 (count actual)))))
      (testing "should return the list of resource events that occurred between a given start and end time"
        (let [start-time  "2011-01-01T12:00:01-03:00"
              end-time    "2011-01-01T12:00:03-03:00"
              expected    (expected-resource-events
                            (filter #(and (< (to-long start-time)
                                             (to-long (:timestamp %)))
                                          (> (to-long end-time)
                                             (to-long (:timestamp %))))
                              (:resource-events basic))
                            report-hash)
              actual      (resource-events-query-result
                            ["and"  [">" "timestamp" start-time]
                                    ["<" "timestamp" end-time]])]
          (is (= actual expected))
          (is (= 1 (count actual)))))
      (testing "should return the list of resource events that occurred between a given start and end time (inclusive)"
        (let [start-time  "2011-01-01T12:00:01-03:00"
              end-time    "2011-01-01T12:00:03-03:00"
              expected    (expected-resource-events
                            (filter #(and (<= (to-long start-time)
                                              (to-long (:timestamp %)))
                                          (>= (to-long end-time)
                                              (to-long (:timestamp %))))
                              (:resource-events basic))
                            report-hash)
              actual      (resource-events-query-result
                            ["and"   [">=" "timestamp" start-time]
                                     ["<=" "timestamp" end-time]])]
          (is (= actual expected))
          (is (= 3 (count actual))))))

    (testing "when querying with a limit"
      (let [num-events (count (:resource-events basic))]
        (testing "should succeed if the number of returned events is less than the limit"
          (is (= num-events
                (count (resource-events-limited-query-result (inc num-events) ["=" "report" report-hash])))))
        (testing "should fail if the number of returned events would exceed the limit"
          (is (thrown-with-msg?
            IllegalStateException #"Query returns more than the maximum number of results"
            (resource-events-limited-query-result (dec num-events) ["=" "report" report-hash]))))))

    (testing "equality queries"
      (doseq [[field value num-matches]
                  [[:resource-type  "Notify"              3]
                   [:resource-title "notify, yo"          1]
                   [:status         "success"             2]
                   [:property       "message"             2]
                   [:old-value      ["what" "the" "woah"] 1]
                   [:new-value      "notify, yo"          1]
                   [:message        "defined 'message' as 'notify, yo'" 2]
                   [:resource-title "bunk"                0]
                   [:certname       "foo.local"           3]
                   [:certname       "bunk.remote"         0]]]
        (testing (format "equality query on field '%s'" field)
          (let [expected  (expected-resource-events
                            (filter #(= value (% field))
                              (:resource-events basic))
                            report-hash)
                actual    (resource-events-query-result ["=" (name field) value])]
            (is (= actual expected))
            (is (= (count actual) num-matches))))))

    (testing "compound queries"
      (testing "'or' equality queries"
        (doseq [[terms num-matches]
                  [[[[:resource-title "notify, yo"]
                     [:status         "skipped"]]       2]
                   [[[:resource-type  "bunk"]
                     [:resource-title "notify, yar"]]   1]
                   [[[:resource-type  "bunk"]
                     [:status         "bunk"]]          0]
                   [[[:new-value      "notify, yo"]
                     [:resource-title "notify, yar"]
                     [:resource-title "hi"]]            3]]]
          (let [equality-fn (fn [m [k v]] (= v (m k)))
                expected    (expected-resource-events
                              (filter #(some identity (map (partial equality-fn %) terms))
                                (:resource-events basic))
                              report-hash)
                term-fn     (fn [[field value]] ["=" (name field) value])
                actual      (resource-events-query-result
                              (vec (cons "or" (map term-fn terms))))]
            (is (= actual expected))
            (is (= (count actual) num-matches))))))))

(ns com.puppetlabs.puppetdb.test.query.event
  (:require [com.puppetlabs.puppetdb.scf.storage :as scf-store]
            [com.puppetlabs.puppetdb.report :as report]
            [com.puppetlabs.puppetdb.query :as query]
            [com.puppetlabs.puppetdb.query.event :as event-query]
            [com.puppetlabs.utils :as utils])
  (:use clojure.test
         com.puppetlabs.puppetdb.fixtures
         com.puppetlabs.puppetdb.examples.report
         [com.puppetlabs.puppetdb.testutils.report :only [store-example-report!]]
         com.puppetlabs.puppetdb.testutils.event
         [clj-time.coerce :only [to-string to-timestamp to-long]]
         [clj-time.core :only [now ago days]]))

(use-fixtures :each with-test-db)

;; Begin tests

(deftest test-compile-resource-event-term
  (testing "should succesfully compile a valid equality query"
    (is (= (query/compile-term  event-query/resource-event-ops ["=" "report" "blah"])
           {:where   "resource_events.report = ?"
            :params  ["blah"]})))
  (testing "should fail with an invalid equality query"
    (is (thrown-with-msg?
          IllegalArgumentException #"foo is not a queryable object for resource events"
          (query/compile-term event-query/resource-event-ops ["=" "foo" "foo"]))))
  (testing "should successfully compile valid inequality queries"
    (let [start-time  "2011-01-01T12:00:01-03:00"
          end-time    "2011-01-01T12:00:03-03:00"]
      (is (= (query/compile-term  event-query/resource-event-ops [">" "timestamp" start-time])
            {:where   "resource_events.timestamp > ?"
             :params  [(to-timestamp start-time)]}))
      (is (= (query/compile-term  event-query/resource-event-ops ["<" "timestamp" end-time])
            {:where   "resource_events.timestamp < ?"
             :params  [(to-timestamp end-time)]}))
      (is (= (query/compile-term  event-query/resource-event-ops
                ["and" [">=" "timestamp" start-time] ["<=" "timestamp" end-time]])
            {:where   "(resource_events.timestamp >= ?) AND (resource_events.timestamp <= ?)"
             :params  [(to-timestamp start-time) (to-timestamp end-time)]}))))
  (testing "should fail with invalid inequality queries"
    (is (thrown-with-msg?
          IllegalArgumentException #"> requires exactly two arguments"
          (query/compile-term event-query/resource-event-ops [">" "timestamp"])))
    (is (thrown-with-msg?
          IllegalArgumentException #"'foo' is not a valid timestamp value"
          (query/compile-term event-query/resource-event-ops [">" "timestamp" "foo"])))
    (is (thrown-with-msg?
          IllegalArgumentException #"> operator does not support object 'resource_type'"
          (query/compile-term event-query/resource-event-ops [">" "resource_type" "foo"])))))

(deftest resource-event-queries
  (let [basic         (:basic reports)
        report-hash   (store-example-report! basic (now))]

    (testing "resource event retrieval by report"
      (testing "should return the list of resource events for a given report hash"
        (let [expected  (expected-resource-events (:resource-events basic) report-hash)
              actual    (resource-events-query-result ["=" "report" report-hash])]
          (is (= actual expected)))))

    (testing "resource event timestamp queries"
      (testing "should return the list of resource events that occurred before a given time"
        (let [end-time  "2011-01-01T12:00:03-03:00"
              expected    (expected-resource-events
                            (filter #(> (to-long end-time) (to-long (:timestamp %)))
                              (:resource-events basic))
                            report-hash)
              actual      (resource-events-query-result ["<" "timestamp" end-time])]
          (is (= actual expected))
          (is (= 2 (count actual)))))
      (testing "should return the list of resource events that occurred after a given time"
        (let [start-time  "2011-01-01T12:00:01-03:00"
              expected    (expected-resource-events
                            (filter #(< (to-long start-time) (to-long (:timestamp %)))
                              (:resource-events basic))
                            report-hash)
              actual      (resource-events-query-result [">" "timestamp" start-time])]
          (is (= actual expected))
          (is (= 2 (count actual)))))
      (testing "should return the list of resource events that occurred between a given start and end time"
        (let [start-time  "2011-01-01T12:00:01-03:00"
              end-time    "2011-01-01T12:00:03-03:00"
              expected    (expected-resource-events
                            (filter #(and (< (to-long start-time)
                                             (to-long (:timestamp %)))
                                          (> (to-long end-time)
                                             (to-long (:timestamp %))))
                              (:resource-events basic))
                            report-hash)
              actual      (resource-events-query-result
                            ["and"  [">" "timestamp" start-time]
                                    ["<" "timestamp" end-time]])]
          (is (= actual expected))
          (is (= 1 (count actual)))))
      (testing "should return the list of resource events that occurred between a given start and end time (inclusive)"
        (let [start-time  "2011-01-01T12:00:01-03:00"
              end-time    "2011-01-01T12:00:03-03:00"
              expected    (expected-resource-events
                            (filter #(and (<= (to-long start-time)
                                              (to-long (:timestamp %)))
                                          (>= (to-long end-time)
                                              (to-long (:timestamp %))))
                              (:resource-events basic))
                            report-hash)
              actual      (resource-events-query-result
                            ["and"   [">=" "timestamp" start-time]
                                     ["<=" "timestamp" end-time]])]
          (is (= actual expected))
          (is (= 3 (count actual))))))

    (testing "when querying with a limit"
      (let [num-events (count (:resource-events basic))]
        (testing "should succeed if the number of returned events is less than the limit"
          (is (= num-events
                (count (resource-events-limited-query-result (inc num-events) ["=" "report" report-hash])))))
        (testing "should fail if the number of returned events would exceed the limit"
          (is (thrown-with-msg?
            IllegalStateException #"Query returns more than the maximum number of results"
            (resource-events-limited-query-result (dec num-events) ["=" "report" report-hash]))))))

    (testing "equality queries"
      (doseq [[field value num-matches]
                  [[:resource-type  "Notify"              3]
                   [:resource-title "notify, yo"          1]
                   [:status         "success"             2]
                   [:property       "message"             2]
                   [:old-value      ["what" "the" "woah"] 1]
                   [:new-value      "notify, yo"          1]
                   [:message        "defined 'message' as 'notify, yo'" 2]
                   [:resource-title "bunk"                0]
                   [:certname       "foo.local"           3]
                   [:certname       "bunk.remote"         0]]]
        (testing (format "equality query on field '%s'" field)
          (let [expected  (expected-resource-events
                            (filter #(= value (% field))
                              (:resource-events basic))
                            report-hash)
                actual    (resource-events-query-result ["=" (name field) value])]
            (is (= actual expected))
            (is (= (count actual) num-matches))))))

    (testing "compound queries"
      (testing "'or' equality queries"
        (doseq [[terms num-matches]
                  [[[[:resource-title "notify, yo"]
                     [:status         "skipped"]]       2]
                   [[[:resource-type  "bunk"]
                     [:resource-title "notify, yar"]]   1]
                   [[[:resource-type  "bunk"]
                     [:status         "bunk"]]          0]
                   [[[:new-value      "notify, yo"]
                     [:resource-title "notify, yar"]
                     [:resource-title "hi"]]            3]]]
          (let [equality-fn (fn [m [k v]] (= v (m k)))
                expected    (expected-resource-events
                              (filter #(some identity (map (partial equality-fn %) terms))
                                (:resource-events basic))
                              report-hash)
                term-fn     (fn [[field value]] ["=" (name field) value])
                actual      (resource-events-query-result
                              (vec (cons "or" (map term-fn terms))))]
            (is (= actual expected))
            (is (= (count actual) num-matches))))))

      (testing "'and' equality queries"
        (doseq [[terms num-matches]
                [[[[:resource-type  "Notify"]
                   [:status         "success"]]       2]
                 [[[:resource-type  "bunk"]
                   [:resource-title "notify, yar"]]   0]
                 [[[:resource-title "notify, yo"]
                   [:status         "skipped"]]       0]
                 [[[:new-value      "notify, yo"]
                   [:resource-type  "Notify"]
                   [:certname       "foo.local"]]     1]
                 [[[:certname       "foo.local"]
                   [:resource-type  "Notify"]]        3]]]
          (let [equality-fn (fn [m [k v]] (= v (m k)))
                expected    (expected-resource-events
                              (filter #(every? identity (map (partial equality-fn %) terms))
                                (:resource-events basic))
                              report-hash)
                term-fn     (fn [[field value]] ["=" (name field) value])
                query       (vec (cons "and" (map term-fn terms)))
                actual      (resource-events-query-result query)]
            (is (= actual expected))
            (is (= (count actual) num-matches)
              (format "Counts didn't match for query '%s'" query)))))))

Add tests for 'and' queries

Add tests for 'and' queries


(ns reabledit.keyboard
  (:require [reabledit.util :as util]))

(defn handle-key-down
  [e columns data state row-change-fn element-id]
  (let [keycode (.-keyCode e)
        shift? (.-shiftKey e)
        current-row (-> @state :selected first)
        current-col (-> @state :selected second)
        rows (-> data count dec)
        cols (-> columns count dec)
        f (partial util/set-selected! state)]
    (cond

      ;; Shift + tab always moves one cell backwards (and disabled editing)
      (and shift? (= keycode 9))
      (do
        (.preventDefault e)
        (util/disable-edit! state element-id)
        (f current-row (max 0 (dec current-col))))

      ;; Tab always moves one cell forward (and disabled editing)
      (= keycode 9)
      (do
        (.preventDefault e)
        (util/disable-edit! state element-id)
        (f current-row (min cols (inc current-col))))

      ;; Enter in editing mode disables editing and invokes the callback
      (and (:edit @state) (= keycode 13))
      (do
        (.preventDefault e)
        (row-change-fn (first (:selected @state))
                       (get-in @state [:edit :initial])
                       (get-in @state [:edit :updated]))
        (util/disable-edit! state element-id))

      ;; Arrow keys in navigation mode change the selection
      ;; Enter and F2 in navigation mode enables editing mode
      (nil? (:edit @state))
      (do
        (.preventDefault e)
        (case keycode
          37 (f current-row (max 0 (dec current-col)))
          38 (f (max 0 (dec current-row)) current-col)
          39 (f current-row (min cols (inc current-col)))
          40 (f (min rows (inc current-row)) current-col)
          9 (f current-row (min cols (inc current-col)))
          13 (util/enable-edit! columns data state)
          113 (util/enable-edit! columns data state)
          nil)))))

(ns reabledit.keyboard
  (:require [reabledit.util :as util]))

(defn handle-key-down
  [e columns data state row-change-fn element-id]
  (let [keycode (.-keyCode e)
        shift? (.-shiftKey e)
        current-row (-> @state :selected first)
        current-col (-> @state :selected second)
        rows (-> data count dec)
        cols (-> columns count dec)
        f (partial util/set-selected! state)]
    (cond

      ;; Shift + tab always moves one cell backwards (and disabled editing)
      (and shift? (= keycode 9))
      (do
        (.preventDefault e)
        (util/disable-edit! state element-id)
        (f current-row (max 0 (dec current-col))))

      ;; Tab always moves one cell forward (and disabled editing)
      (= keycode 9)
      (do
        (.preventDefault e)
        (util/disable-edit! state element-id)
        (f current-row (min cols (inc current-col))))

      ;; Enter in editing mode disables editing and invokes the callback
      (and (:edit @state) (= keycode 13))
      (do
        (.preventDefault e)
        (row-change-fn (first (:selected @state))
                       (get-in @state [:edit :initial])
                       (get-in @state [:edit :updated]))
        (util/disable-edit! state element-id))

      ;; Arrow keys in navigation mode change the selection
      ;; Enter and F2 in navigation mode enables editing mode
      (nil? (:edit @state))
      (do
        (.preventDefault e)
        (case keycode
          37 (f current-row (max 0 (dec current-col)))
          38 (f (max 0 (dec current-row)) current-col)
          39 (f current-row (min cols (inc current-col)))
          40 (f (min rows (inc current-row)) current-col)
          13 (util/enable-edit! columns data state)
          113 (util/enable-edit! columns data state)
          nil)))))

Remove dead code

Remove dead code