(ns mdr2.productions.in-production
  (:require [ajax.core :as ajax]
            [mdr2.auth :as auth]
            [mdr2.ajax :refer [as-transit]]
            [mdr2.i18n :refer [tr]]
            [mdr2.pagination :as pagination]
            [mdr2.productions.production :as production]
            [mdr2.productions.notifications :as notifications]
            [re-frame.core :as rf]))

(rf/reg-event-fx
  ::fetch-productions
  (fn [{:keys [db]} [_]]
    (let [search @(rf/subscribe [::search])
          offset (pagination/offset db :in-production)]
      {:db (assoc-in db [:loading :in-production] true)
       :http-xhrio
       (as-transit {:method          :get
                    :uri             "/api/productions"
                    :params          {:search (if (nil? search) "" search)
                                      :offset offset
                                      :limit pagination/page-size}
                    :on-success      [::fetch-productions-success]
                    :on-failure      [::fetch-productions-failure]})})))

(rf/reg-event-db
 ::fetch-productions-success
 (fn [db [_ productions]]
   (let [productions (->> productions
                    (map #(assoc % :uuid (str (random-uuid)))))
         next? (-> productions count (= pagination/page-size))]
     (-> db
         (assoc-in [:productions :in-production] (zipmap (map :uuid productions) productions))
         (pagination/update-next :in-production next?)
         (assoc-in [:loading :in-production] false)
         ;; clear all button loading states
         (update-in [:loading] dissoc :buttons)))))

(rf/reg-event-db
 ::fetch-productions-failure
 (fn [db [_ response]]
   (-> db
       (notifications/set-errors :fetch-in-production-productions (get response :status-text))
       (assoc-in [:loading :in-production] false))))

(rf/reg-event-fx
  ::delete-production
  (fn [{:keys [db]} [_ id]]
    (let [production (get-in db [:productions :in-production id])]
      {:db (notifications/set-button-state db id :delete)
       :http-xhrio
       (as-transit {:method          :delete
                    :headers 	     (auth/auth-header db)
                    :uri             (str "/api/productions/" (:id production))
                    :on-success      [::ack-delete id]
                    :on-failure      [::ack-failure id :delete]
                    })})))

(rf/reg-event-db
  ::ack-save
  (fn [db [_ id]]
    (notifications/clear-button-state db id :save)))

(rf/reg-event-fx
  ::ack-delete
  (fn [{:keys [db]} [_ id]]
    (let [db (-> db
                 (update-in [:productions :in-production] dissoc id)
                 (notifications/clear-button-state id :delete))
          empty? (-> db (get-in [:productions :in-production]) count (< 1))]
      (if empty?
        {:db db :dispatch [::fetch-productions]}
        {:db db}))))

(rf/reg-event-db
 ::ack-failure
 (fn [db [_ id request-type response]]
   (let [message (or (get-in response [:response :status-text])
                     (get response :status-text))]
     (-> db
         (notifications/set-errors request-type message)
         (notifications/clear-button-state id request-type)))))

(rf/reg-sub
 ::productions
 (fn [db _] (->> db :productions :in-production vals)))

(rf/reg-sub
 ::productions-sorted
 :<- [::productions]
 (fn [productions] (->> productions (sort-by :id >))))

(rf/reg-sub
  ::search
  (fn [db _] (get-in db [:search :in-production])))

(rf/reg-event-fx
   ::set-search
   (fn [{:keys [db]} [_ new-search-value]]
     (cond-> {:db (assoc-in db [:search :in-production] new-search-value)}
       (> (count new-search-value) 2)
       ;; if the string has more than 2 characters fetch the productions
       ;; from the server
       (assoc :dispatch-n
              (list
               ;; when searching for a new production reset the pagination
               [::pagination/reset :in-production]
               [::fetch-productions])))))

(defn productions-search []
  (let [get-value (fn [e] (-> e .-target .-value))
        reset!    #(rf/dispatch [::set-search ""])
        save!     #(rf/dispatch [::set-search %])]
    [:div.field
     [:div.control
      [:input.input {:type "text"
                     :placeholder (tr [:search])
                     :aria-label (tr [:search])
                     :value @(rf/subscribe [::search])
                     :on-change #(save! (get-value %))
                     :on-key-down #(when (= (.-which %) 27) (reset!))}]]]))

(defn productions-filter []
  [:div.field.is-horizontal
   [:div.field-body
    [productions-search]]])

(rf/reg-sub
 ::production
 (fn [db [_ id]]
   (get-in db [:productions :in-production id])))

(rf/reg-event-fx
  ::upload-dtbook
  (fn [{:keys [db]} [_ js-file-value]]
    (let [form-data (doto (js/FormData.)
                      (.append "file" js-file-value "filename.txt"))
          id (get-in db [:current-production :id])]
      {:db (-> db
               (notifications/set-button-state :in-production :upload-file))
       :http-xhrio (as-transit
                    {:method          :post
                     :headers 	      (auth/auth-header db)
                     :uri             (str "/api/productions/" id "/xml")
                     :body            form-data
                     :on-success      [::ack-upload-dtbook]
                     :on-failure      [::ack-upload-failure]})})))

(rf/reg-event-fx
  ::ack-upload-dtbook
  (fn [{:keys [db]} [_]]
    {:db (notifications/clear-button-state db :in-production :upload-file)
     :common/navigate-fx! [:in-production]}))

(rf/reg-event-db
 ::ack-upload-failure
 (fn [db [_ response]]
   (let [message (or (get-in response [:response :status-text])
                     (get response :status-text))
         errors (get-in response [:response :errors])]
     (-> db
         (notifications/set-errors :dtbook-upload message errors)
         (notifications/clear-button-state :in-production :upload-file)))))

(rf/reg-sub
 ::upload-file
 (fn [db _] (get-in db [:upload :in-production])))

(rf/reg-event-db
  ::set-upload-file
  (fn [db [_ file]] (assoc-in db [:upload :in-production] file)))

(rf/reg-event-db
  ::clear-upload-file
  (fn [db [_]] (update-in db [:upload] dissoc :in-production)))

(defn- file-input []
  (let [get-value (fn [e] (-> e .-target .-files (aget 0)))
        save!     #(rf/dispatch [::set-upload-file %])
        file      @(rf/subscribe [::upload-file])]
    [:p.control
     [:div.file.has-name
      [:label.file-label
       [:input.file-input
        {:type "file"
         :accept ".xml"
         :files file
         :on-change #(save! (get-value %))}]
       [:span.file-cta
        [:span.file-label (tr [:choose-structure])]]
       [:span.file-name (if file (.-name file) (tr [:no-file]))]]]]))

(defn- structure-upload []
  (let [klass (when @(rf/subscribe [::notifications/button-loading? :in-production :upload-file]) "is-loading")
        admin? @(rf/subscribe [::auth/is-admin?])
        file @(rf/subscribe [::upload-file])
        current @(rf/subscribe [::production/current])]
    [:<>
     [:div.field
      [:label.label (tr [:upload-structure] [(:title current) (:id current)])]
      [file-input]]
     [:div.field.is-grouped
      [:p.control
       [:button.button
        {:disabled (or (nil? file) (not admin?))
         :class klass
         :on-click (fn [e] (rf/dispatch [::upload-dtbook file]))}
        [:span (tr [:upload])]
        [:span.icon
         [:span.material-icons "upload_file"]]]]]]))

(defn buttons [{:keys [uuid id state] :as production}]
  (let [admin? @(rf/subscribe [::auth/is-admin?])]
    [:div.buttons.has-addons
     [:a.button
      {:href (str "/api/productions/" id "/xml")
       :download (str id ".xml")
       ;; allow dtbook download only for state new and structured
       :disabled (not (#{"new" "structured"} state))}
      [:span.icon.is-small
       [:span.material-icons "file_download"]]]
     [:a.button
      {:disabled (not admin?)
       :href (str "#/productions/" id "/upload")
       :on-click (fn [e] (rf/dispatch [::production/set-current production]))}
      [:span.icon.is-small
       [:span.material-icons "file_upload"]]]
     (if @(rf/subscribe [::notifications/button-loading? uuid :delete])
       [:button.button.is-danger.is-loading]
       [:button.button.is-danger
        {:disabled (not admin?)
         :on-click (fn [e] (rf/dispatch [::delete-production uuid]))}
        [:span.icon.is-small
         [:span.material-icons "delete"]]])]))

(defn production-link [{:keys [id title] :as production}]
  [:a {:href (str "#/productions/" id)
       :on-click (fn [_] (rf/dispatch [::production/set-current production]))}
   title])

(defn production [id]
  (let [{:keys [uuid id production_type state] :as production} @(rf/subscribe [::production id])]
    [:tr
     [:td id]
     [:td [production-link production]]
     [:td production_type]
     [:td state]
     [:td {:width "14%"} [buttons production]]]))

(defn productions []
  (let [productions @(rf/subscribe [::productions-sorted])]
    [:<>
     [:table.table.is-striped
      [:thead
       [:tr
        [:th (tr [:dam])]
        [:th (tr [:title])]
        [:th (tr [:production_type])]
        [:th (tr [:state])]
        [:th (tr [:action])]]]
      [:tbody
       (for [{:keys [uuid]} productions]
         ^{:key uuid} [production uuid])]]
     [pagination/pagination :in-production [::fetch-productions]]]))

(defn upload-page []
  (let [loading? @(rf/subscribe [::notifications/loading? :in-production])
        errors? @(rf/subscribe [::notifications/errors?])]
    [:section.section>div.container>div.content
     [:<>
      (cond
        errors? [notifications/error-notification]
        loading? [notifications/loading-spinner]
        :else [structure-upload])]])  )

(defn page []
  (let [loading? @(rf/subscribe [::notifications/loading? :in-production])
        errors? @(rf/subscribe [::notifications/errors?])]
    [:section.section>div.container>div.content
     [:<>
      [productions-filter]
      (cond
        errors? [notifications/error-notification]
        loading? [notifications/loading-spinner]
        :else [productions])]]))

(ns mdr2.productions.in-production
  (:require [ajax.core :as ajax]
            [mdr2.auth :as auth]
            [mdr2.ajax :refer [as-transit]]
            [mdr2.i18n :refer [tr]]
            [mdr2.pagination :as pagination]
            [mdr2.productions.production :as production]
            [mdr2.productions.notifications :as notifications]
            [re-frame.core :as rf]))

(rf/reg-event-fx
  ::fetch-productions
  (fn [{:keys [db]} [_]]
    (let [search @(rf/subscribe [::search])
          offset (pagination/offset db :in-production)]
      {:db (assoc-in db [:loading :in-production] true)
       :http-xhrio
       (as-transit {:method          :get
                    :uri             "/api/productions"
                    :params          {:search (if (nil? search) "" search)
                                      :offset offset
                                      :limit pagination/page-size}
                    :on-success      [::fetch-productions-success]
                    :on-failure      [::fetch-productions-failure]})})))

(rf/reg-event-db
 ::fetch-productions-success
 (fn [db [_ productions]]
   (let [productions (->> productions
                    (map #(assoc % :uuid (str (random-uuid)))))
         next? (-> productions count (= pagination/page-size))]
     (-> db
         (assoc-in [:productions :in-production] (zipmap (map :uuid productions) productions))
         (pagination/update-next :in-production next?)
         (assoc-in [:loading :in-production] false)
         ;; clear all button loading states
         (update-in [:loading] dissoc :buttons)))))

(rf/reg-event-db
 ::fetch-productions-failure
 (fn [db [_ response]]
   (-> db
       (notifications/set-errors :fetch-in-production-productions (get response :status-text))
       (assoc-in [:loading :in-production] false))))

(rf/reg-event-fx
  ::delete-production
  (fn [{:keys [db]} [_ id]]
    (let [production (get-in db [:productions :in-production id])]
      {:db (notifications/set-button-state db id :delete)
       :http-xhrio
       (as-transit {:method          :delete
                    :headers 	     (auth/auth-header db)
                    :uri             (str "/api/productions/" (:id production))
                    :on-success      [::ack-delete id]
                    :on-failure      [::ack-failure id :delete]
                    })})))

(rf/reg-event-db
  ::ack-save
  (fn [db [_ id]]
    (notifications/clear-button-state db id :save)))

(rf/reg-event-fx
  ::ack-delete
  (fn [{:keys [db]} [_ id]]
    (let [db (-> db
                 (update-in [:productions :in-production] dissoc id)
                 (notifications/clear-button-state id :delete))
          empty? (-> db (get-in [:productions :in-production]) count (< 1))]
      (if empty?
        {:db db :dispatch [::fetch-productions]}
        {:db db}))))

(rf/reg-event-db
 ::ack-failure
 (fn [db [_ id request-type response]]
   (let [message (or (get-in response [:response :status-text])
                     (get response :status-text))]
     (-> db
         (notifications/set-errors request-type message)
         (notifications/clear-button-state id request-type)))))

(rf/reg-sub
 ::productions
 (fn [db _] (->> db :productions :in-production vals)))

(rf/reg-sub
 ::productions-sorted
 :<- [::productions]
 (fn [productions] (->> productions (sort-by :id >))))

(rf/reg-sub
  ::search
  (fn [db _] (get-in db [:search :in-production])))

(rf/reg-event-fx
   ::set-search
   (fn [{:keys [db]} [_ new-search-value]]
     (cond-> {:db (assoc-in db [:search :in-production] new-search-value)}
       (> (count new-search-value) 2)
       ;; if the string has more than 2 characters fetch the productions
       ;; from the server
       (assoc :dispatch-n
              (list
               ;; when searching for a new production reset the pagination
               [::pagination/reset :in-production]
               [::fetch-productions])))))

(defn productions-search []
  (let [get-value (fn [e] (-> e .-target .-value))
        reset!    #(rf/dispatch [::set-search ""])
        save!     #(rf/dispatch [::set-search %])]
    [:div.field
     [:div.control
      [:input.input {:type "text"
                     :placeholder (tr [:search])
                     :aria-label (tr [:search])
                     :value @(rf/subscribe [::search])
                     :on-change #(save! (get-value %))
                     :on-key-down #(when (= (.-which %) 27) (reset!))}]]]))

(defn productions-filter []
  [:div.field.is-horizontal
   [:div.field-body
    [productions-search]]])

(rf/reg-sub
 ::production
 (fn [db [_ id]]
   (get-in db [:productions :in-production id])))

(rf/reg-event-fx
  ::upload-dtbook
  (fn [{:keys [db]} [_ js-file-value]]
    (let [form-data (doto (js/FormData.)
                      (.append "file" js-file-value "filename.txt"))
          id (get-in db [:current-production :id])]
      {:db (-> db
               (notifications/set-button-state :in-production :upload-file))
       :http-xhrio (as-transit
                    {:method          :post
                     :headers 	      (auth/auth-header db)
                     :uri             (str "/api/productions/" id "/xml")
                     :body            form-data
                     :on-success      [::ack-upload-dtbook]
                     :on-failure      [::ack-upload-failure]})})))

(rf/reg-event-fx
  ::ack-upload-dtbook
  (fn [{:keys [db]} [_]]
    {:db (notifications/clear-button-state db :in-production :upload-file)
     :common/navigate-fx! [:in-production]}))

(rf/reg-event-db
 ::ack-upload-failure
 (fn [db [_ response]]
   (let [message (or (get-in response [:response :status-text])
                     (get response :status-text))
         errors (get-in response [:response :errors])]
     (-> db
         (notifications/set-errors :dtbook-upload message errors)
         (notifications/clear-button-state :in-production :upload-file)))))

(rf/reg-sub
 ::upload-file
 (fn [db _] (get-in db [:upload :in-production])))

(rf/reg-event-db
  ::set-upload-file
  (fn [db [_ file]] (assoc-in db [:upload :in-production] file)))

(rf/reg-event-db
  ::clear-upload-file
  (fn [db [_]] (update-in db [:upload] dissoc :in-production)))

(defn- file-input []
  (let [get-value (fn [e] (-> e .-target .-files (aget 0)))
        save!     #(rf/dispatch [::set-upload-file %])
        file      @(rf/subscribe [::upload-file])]
    [:p.control
     [:div.file.has-name
      [:label.file-label
       [:input.file-input
        {:type "file"
         :accept ".xml"
         :files file
         :on-change #(save! (get-value %))}]
       [:span.file-cta
        [:span.file-label (tr [:choose-structure])]]
       [:span.file-name (if file (.-name file) (tr [:no-file]))]]]]))

(defn- structure-upload []
  (let [klass (when @(rf/subscribe [::notifications/button-loading? :in-production :upload-file]) "is-loading")
        admin? @(rf/subscribe [::auth/is-admin?])
        file @(rf/subscribe [::upload-file])
        current @(rf/subscribe [::production/current])]
    [:<>
     [:div.field
      [:label.label (tr [:upload-structure] [(:title current) (:id current)])]
      [file-input]]
     [:div.field.is-grouped
      [:p.control
       [:button.button
        {:disabled (or (nil? file) (not admin?))
         :class klass
         :on-click (fn [e] (rf/dispatch [::upload-dtbook file]))}
        [:span (tr [:upload])]
        [:span.icon
         [:span.material-icons "upload_file"]]]]]]))

(defn buttons [{:keys [uuid id state] :as production}]
  (let [admin? @(rf/subscribe [::auth/is-admin?])]
    [:div.buttons.has-addons
     [:a.button
      {:href (str "/api/productions/" id "/xml")
       :download (str id ".xml")
       ;; allow dtbook download only for state new and structured
       :disabled (not (and admin? (#{"new" "structured"} state)))}
      [:span.icon.is-small
       [:span.material-icons "file_download"]]]
     [:a.button
      {:disabled (not (and admin? (#{"new" "structured"} state)))
       :href (str "#/productions/" id "/upload")
       :on-click (fn [e] (rf/dispatch [::production/set-current production]))}
      [:span.icon.is-small
       [:span.material-icons "file_upload"]]]
     ;; show the "Recorded" button if the next state is "recorded",
     ;; the user is authorized, and the production has been imported
     ;; from the libary, i.e. is not handled via ABACUS or the
     ;; production has a revision greater than zero as is the case
     ;; with productions that are repaired
     (when (and admin? (#{"structured"} state)
                (or (:library_number production) (> (:revision production) 0)))
       (if @(rf/subscribe [::notifications/button-loading? uuid :recorded])
         [:button.button.is-loading]
         [:button.button
          {:on-click (fn [e] (rf/dispatch [::recorded-production uuid]))}
          [:span.icon.is-small
           [:span.material-icons "mic"]]]))
     ;; show the "Split" button if the next state is "split" and the user is
     ;; authorized
     (when (and admin? (#{"pending-split"} state))
         (if @(rf/subscribe [::notifications/button-loading? uuid :split])
           [:button.button.is-loading]
           [:button.button
            {:on-click (fn [e] (rf/dispatch [::split-production uuid]))}
            [:span.icon.is-small
             [:span.material-icons "call_split"]]]))
     (if @(rf/subscribe [::notifications/button-loading? uuid :delete])
       [:button.button.is-danger.is-loading]
       [:button.button.is-danger
        {:disabled (not admin?)
         :on-click (fn [e] (rf/dispatch [::delete-production uuid]))}
        [:span.icon.is-small
         [:span.material-icons "delete"]]])]))

(defn production-link [{:keys [id title] :as production}]
  [:a {:href (str "#/productions/" id)
       :on-click (fn [_] (rf/dispatch [::production/set-current production]))}
   title])

(defn production [id]
  (let [{:keys [uuid id production_type state] :as production} @(rf/subscribe [::production id])]
    [:tr
     [:td id]
     [:td [production-link production]]
     [:td production_type]
     [:td state]
     [:td {:width "14%"} [buttons production]]]))

(defn productions []
  (let [productions @(rf/subscribe [::productions-sorted])]
    [:<>
     [:table.table.is-striped
      [:thead
       [:tr
        [:th (tr [:dam])]
        [:th (tr [:title])]
        [:th (tr [:production_type])]
        [:th (tr [:state])]
        [:th (tr [:action])]]]
      [:tbody
       (for [{:keys [uuid]} productions]
         ^{:key uuid} [production uuid])]]
     [pagination/pagination :in-production [::fetch-productions]]]))

(defn upload-page []
  (let [loading? @(rf/subscribe [::notifications/loading? :in-production])
        errors? @(rf/subscribe [::notifications/errors?])]
    [:section.section>div.container>div.content
     [:<>
      (cond
        errors? [notifications/error-notification]
        loading? [notifications/loading-spinner]
        :else [structure-upload])]])  )

(defn page []
  (let [loading? @(rf/subscribe [::notifications/loading? :in-production])
        errors? @(rf/subscribe [::notifications/errors?])]
    [:section.section>div.container>div.content
     [:<>
      [productions-filter]
      (cond
        errors? [notifications/error-notification]
        loading? [notifications/loading-spinner]
        :else [productions])]]))

Add the "recorded" and "split buttons"

Add the "recorded" and "split buttons"

but only show them if the user is authorized and the production has
the right state


(ns test-writer
  #+cljs
  (:require [cemerick.cljs.test :as ts]
            [cats.core :as m]
            [cats.protocols :as p]
            [cats.data :as d]
            [cats.monad.writer :as writer])
   #+cljs
  (:require-macros [cemerick.cljs.test
                    :refer (is deftest with-test run-tests testing test-var)]
                   [cats.core :refer (mlet with-monad)])
  #+clj
  (:require [clojure.test :refer :all]
            [cats.core :as m :refer [mlet with-monad]]
            [cats.builtin :as b]
            [cats.protocols :as p]
            [cats.data :as d]
            [cats.monad.writer :as writer]))

; FIXME: functions for extracting either log or value more state-monad like

(deftest test-writer-monad
  (testing "Putting a value in a writer context yields an empty log"
    (is (= 42
           (writer/value (p/mreturn writer/writer-monad 42)))))

  (testing "The `tell` function adds the given value to the log"
    (is (= ["Hello" "world"]
           (with-monad writer/writer-monad
             (writer/log (m/>> (writer/tell "Hello")
                               (writer/tell "world")))))))

  (testing "The `listen` function yields a pair with the value and the log"
    (let [w (with-monad writer/writer-monad
              (m/>> (writer/tell "Hello")
                    (writer/tell "world")
                    (m/return 42)))
          w (writer/listen w)]
        (is (= (d/pair 42 ["Hello" "world"])
               (first w)))
        (is (= ["Hello" "world"]
               (second w)))))

  (testing "The `listen` function yields a pair with the value and the log"
    (let [w (with-monad writer/writer-monad
              (m/>> (writer/tell "Hello")
                    (writer/tell "world")
                    (m/return [42 reverse])))
          w (writer/listen (writer/pass w))]
        (is (= (d/pair 42 ["world" "Hello"])
               (first w)))
        (is (= ["world" "Hello"]
               (second w)))))
)

(ns test-writer
  #+cljs
  (:require [cemerick.cljs.test :as ts]
            [cats.core :as m]
            [cats.protocols :as p]
            [cats.data :as d]
            [cats.monad.writer :as writer])
   #+cljs
  (:require-macros [cemerick.cljs.test
                    :refer (is deftest with-test run-tests testing test-var)]
                   [cats.core :refer (mlet with-monad)])
  #+clj
  (:require [clojure.test :refer :all]
            [cats.core :as m :refer [mlet with-monad]]
            [cats.builtin :as b]
            [cats.protocols :as p]
            [cats.data :as d]
            [cats.monad.writer :as writer]))

; FIXME: functions for extracting either log or value more state-monad like

(deftest test-writer-monad
  (testing "Putting a value in a writer context yields an empty log"
    (is (= 42
           (writer/value (p/mreturn writer/writer-monad 42)))))

  (testing "The `tell` function adds the given value to the log"
    (is (= ["Hello" "world"]
           (with-monad writer/writer-monad
             (writer/log (m/>> (writer/tell "Hello")
                               (writer/tell "world")))))))

  (testing "The `listen` function yields a pair with the value and the log"
    (let [w (with-monad writer/writer-monad
              (m/>> (writer/tell "Hello")
                    (writer/tell "world")
                    (m/return 42)))
          w (writer/listen w)]
        (is (= (d/pair 42 ["Hello" "world"])
               (first w)))
        (is (= ["Hello" "world"]
               (second w)))))

  (testing "The `pass` function can be used to apply a function to the log"
    (let [w (with-monad writer/writer-monad
              (m/>> (writer/tell "Hello")
                    (writer/tell "world")
                    (m/return [42 reverse])))
          w (writer/listen (writer/pass w))]
        (is (= (d/pair 42 ["world" "Hello"])
               (first w)))
        (is (= ["world" "Hello"]
               (second w)))))
)

Fix test description

Fix test description


(ns videotest.hex.core
  (:require
   [quil.applet :as qa :refer [applet-close]]
   [quil.core :as q]
   [quil.middleware :as m]))

;; Optoma Projector
;; (def DISPLAY-WIDTH 1280.0)
;; (def DISPLAY-HEIGHT 800.0)

;; Lenovo
(def DISPLAY-WIDTH 1366.0)
(def DISPLAY-HEIGHT 768.0)

;; 32 works
(def NUM-COL-BINS 64.0)
(def DISPLAY-BIN-SIZE (/ DISPLAY-WIDTH NUM-COL-BINS))
(def NUM-ROW-BINS (/ DISPLAY-HEIGHT DISPLAY-BIN-SIZE))

(def DISPLAY-BIN-SIZE-X2  (* DISPLAY-BIN-SIZE 2.0))
(def DISPLAY-BIN-SIZE-2   (/ DISPLAY-BIN-SIZE 2.0))

(defn grid-coords [col-bins row-bins]
  (doall
   (vec
    (for [row (range 0 row-bins)
          col (range 0 col-bins)]
      [col row]))))

(defn draw-cell [col row w half-w]
  (q/push-matrix)
  (q/rect (+ (* col w) half-w)
          (+ (* row w) half-w)
          w w)
  (q/pop-matrix))

(defn draw-hex-grid [{:keys [grid-coords]}]
  (q/rect-mode :center)
  (q/no-fill)
  (q/stroke-weight 1)
  (q/stroke 0 255 255 255)
  (dorun
   (map (fn [[col row]]
          (draw-cell col row DISPLAY-BIN-SIZE DISPLAY-BIN-SIZE-2))
        grid-coords)))

(defn setup []
  {:grid-coords (grid-coords NUM-COL-BINS NUM-ROW-BINS)
   :hex-cells {}})

(defn update [state]
  state)

(defn draw [state]
  (let [x 1]
    (q/background 255)
    (q/push-matrix)
    (q/translate DISPLAY-WIDTH 0)
    (q/scale -1 1)
    (draw-hex-grid state)
    (q/pop-matrix)))

(defn on-close [state]
  )

(q/defsketch videotest
  :title "hex"
  :size [DISPLAY-WIDTH DISPLAY-HEIGHT]
  :setup setup
  :update update
  :draw draw
  :on-close on-close
  :middleware [m/fun-mode])

(.setResizable (.frame videotest) true)

(ns videotest.hex.core
  (:require
   [quil.applet :as qa :refer [applet-close]]
   [quil.core :as q]
   [quil.middleware :as m]))

;; Optoma Projector
;; (def DISPLAY-WIDTH 1280.0)
;; (def DISPLAY-HEIGHT 800.0)

;; Lenovo
(def DISPLAY-WIDTH 1366.0)
(def DISPLAY-HEIGHT 768.0)

;; 32 works
(def NUM-COL-BINS 64.0)
(def DISPLAY-BIN-SIZE (/ DISPLAY-WIDTH NUM-COL-BINS))
(def NUM-ROW-BINS (/ DISPLAY-HEIGHT DISPLAY-BIN-SIZE))

(def DISPLAY-BIN-SIZE-X2  (* DISPLAY-BIN-SIZE 2.0))
(def DISPLAY-BIN-SIZE-2   (/ DISPLAY-BIN-SIZE 2.0))

(def HEX-W 10.0)
(def HEX-W-2 (/ HEX-W 2.0))

(defn grid-coords [col-bins row-bins]
  (doall
   (vec
    (for [row (range 0 row-bins)
          col (range 0 col-bins)]
      [col row]))))

(defn draw-cell [col row w half-w]
  (q/push-style)
  (when (= 5 col row)
    (q/fill 255 0 0 100)
    (q/stroke 255 0 0))
  (let [x (+ (* col w) half-w)
        y (+ (* row w) half-w)
        y (if (odd? col)
            (+ y half-w)
            y)]
    (q/rect x y w w))
  (q/pop-style))

(defn draw-hex-cell-dot [col row w half-w]
  (q/push-matrix)
  (let [x (+ (* col w) half-w)
        y (+ (* row w) half-w)
        y (if (odd? col)
            (+ y half-w)
            y)]
    (q/with-translation [x y]
      (q/ellipse 0 0 half-w half-w)))
  (q/pop-matrix))

(defn hex-y-offset [hex-w]
  (* (Math/sin (Math/toRadians 60))
     hex-w))

(defn draw-hex-cell [col row w half-w hex-w half-hex-w y-offset]
  (q/push-matrix)
  (let [x (+ (* col w) half-w)
        y (+ (* row w) half-w)
        y (if (odd? col)
            (+ y half-w)
            y)]
    (q/with-translation [x y]
      (q/begin-shape)
      (q/vertex (- hex-w) 0)
      (q/vertex (- half-hex-w) (- y-offset))
      (q/vertex half-hex-w (- y-offset))
      (q/vertex hex-w 0)
      (q/vertex half-hex-w y-offset)
      (q/vertex (- half-hex-w) y-offset)
      (q/vertex (- hex-w) 0)
      (q/end-shape)))
  (q/pop-matrix))

(defn draw-hex-grid [{:keys [grid-coords]}]
  (q/push-matrix)
  (q/push-style)
  (q/rect-mode :center)
  (q/ellipse-mode :center)
  (q/no-fill)
  (q/stroke-weight 1)
  (let [y-offset (hex-y-offset HEX-W)]
   (dorun
    (map (fn [[col row]]
           (do
             (q/stroke 0 255 255 100)
             #_(draw-cell         col row DISPLAY-BIN-SIZE DISPLAY-BIN-SIZE-2)
             #_(draw-hex-cell-dot col row DISPLAY-BIN-SIZE DISPLAY-BIN-SIZE-2)
             (q/stroke 0 255 0 255)
             (draw-hex-cell col row DISPLAY-BIN-SIZE DISPLAY-BIN-SIZE-2 HEX-W HEX-W-2 y-offset)))
         grid-coords)))
  (q/pop-style)
  (q/pop-matrix))

(defn setup []
  {:grid-coords (grid-coords NUM-COL-BINS NUM-ROW-BINS)
   :hex-cells {}})

(defn update [state]
  state)

(defn draw [state]
  (let [x 1]
    (q/background 255)
    (q/push-matrix)
    (q/translate DISPLAY-WIDTH 0)
    (q/scale -1 1)
    (draw-hex-grid state)
    (q/pop-matrix)))

(defn on-close [state]
  )

(q/defsketch videotest
  :title "hex"
  :size [DISPLAY-WIDTH DISPLAY-HEIGHT]
  :setup setup
  :update update
  :draw draw
  :on-close on-close
  :middleware [m/fun-mode])

(.setResizable (.frame videotest) true)

Add coral hex bin test.

Add coral hex bin test.


(require '[clojure [set :as set]
                   [string :as str]]
         '[clojure.java browse
                        javadoc]
         '[dragon [clipboard :as clipboard]
                  [core :refer :all]
                  [maths :as maths]])

(let [fix #(str/replace
            %
            #"http://java\.sun\.com/javase/7/"
            "https://docs.oracle.com/javase/8/")]
  (intern 'clojure.java.javadoc
          '*core-java-api*
          (fix clojure.java.javadoc/*core-java-api*))
  (intern 'clojure.java.javadoc
          '*remote-javadocs*
          (ref (into (sorted-map)
                     (map (fn
                           [[k v]]
                           [k (fix v)])
                          @clojure.java.javadoc/*remote-javadocs*)))))

(require '[clojure [set :as set]
                   [string :as str]]
         '[clojure.java browse
                        javadoc]
         '[dragon [clipboard :as clipboard]
                  [core :refer :all]
                  [maths :as maths]])

(let [uri (str "https://docs.oracle.com/javase/"
               (System/getProperty "java.specification.version")
               "/")
      fix #(str/replace
            %
            #"http://java\.sun\.com/javase/7/"
            uri)]
  (intern 'clojure.java.javadoc
          '*core-java-api*
          (fix clojure.java.javadoc/*core-java-api*))
  (intern 'clojure.java.javadoc
          '*remote-javadocs*
          (ref (into (sorted-map)
                     (map (fn
                           [[k v]]
                           [k (fix v)])
                          @clojure.java.javadoc/*remote-javadocs*)))))

Make javadoc URI dynamic

lein: Make javadoc URI dynamic


(defproject replete "0.1.0"
  :dependencies [[andare "0.9.0"]                           ; Update in script/build also
                 [chivorcam "0.3.0"]
                 [cljsjs/parinfer "1.8.1-0"]
                 [com.cognitect/transit-clj "0.8.309"]
                 [com.cognitect/transit-cljs "0.8.248"]
                 [fipp "0.6.8"]
                 [tailrecursion/cljson "1.0.7"]
                 [malabarba/lazy-map "1.3"]
                 [org.clojure/clojure "1.9.0"]
                 [org.clojure/clojurescript "1.10.439"]
                 [org.clojure/test.check "0.10.0-alpha2"]]
  :clean-targets ["out" "target"]
  :plugins [[lein-cljsbuild "1.1.7"]]
  :cljsbuild {:builds {:test {:source-paths ["src" "test"]
                              :compiler {:output-to "test/resources/compiled.js"
                                         :optimizations :whitespace
                                         :pretty-print true}}}
              :test-commands {"test" ["phantomjs"
                                      "test/resources/test.js"
                                      "test/resources/test.html"]}})

(defproject replete "0.1.0"
  :dependencies [[andare "0.9.0"]                           ; Update in script/build also
                 [chivorcam "0.3.0"]
                 [cljsjs/parinfer "1.8.1-0"]
                 [com.cognitect/transit-clj "0.8.309"]
                 [com.cognitect/transit-cljs "0.8.248"]
                 [fipp "0.6.8"]
                 [tailrecursion/cljson "1.0.7"]
                 [malabarba/lazy-map "1.3"]
                 [org.clojure/clojure "1.9.0"]
                 [org.clojure/clojurescript "1.10.439"]
                 [org.clojure/test.check "0.10.0-alpha3"]]
  :clean-targets ["out" "target"]
  :plugins [[lein-cljsbuild "1.1.7"]]
  :cljsbuild {:builds {:test {:source-paths ["src" "test"]
                              :compiler {:output-to "test/resources/compiled.js"
                                         :optimizations :whitespace
                                         :pretty-print true}}}
              :test-commands {"test" ["phantomjs"
                                      "test/resources/test.js"
                                      "test/resources/test.html"]}})

Update to test.check 0.10.0-alpha3

Update to test.check 0.10.0-alpha3


;   Copyright (c) Rich Hickey, Stuart Halloway, and contributors.
;   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 clojure.test.generative.runner
  (:require
   [clojure.java.io :as jio]
   [clojure.pprint :as pprint]
   [clojure.tools.namespace :as ns]
   [clojure.test.generative.config :as config]
   [clojure.test.generative.event :as event]
   [clojure.test.generative.generators :as gen]
   [clojure.test.generative.io :as io]
   [clojure.test :as ctest]))

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

;; non-nil binding means running inside the framework
(def ^:dynamic *failed* nil)

(defn failed!
  "Tell the runner that a test failed"
  []
  (when *failed*
    (deliver *failed* :failed)))

(defmulti ctevent->event
  "Convert a clojure.test reporting event to an event."
  :type)

(defmethod ctevent->event :default
  [e]
  (event/create :clojure.test/unknown e))

(defmethod ctevent->event :pass
  [e]
  (event/create :type :assert/pass))

(defmethod ctevent->event :fail
  [e]
  (failed!)
  (event/create :type :assert/fail
                :level :warn
                :message (:message e)
                :test/actual (:actual e)
                :test/expected (:expected e)
                :file (:file e)
                :line (:line e)
                ::ctest/contexts (seq ctest/*testing-contexts*)
                ::ctest/vars (reverse (map #(:name (meta %)) ctest/*testing-vars*))))

(defmethod ctevent->event :error
  [e]
  (event/create :level :error
                :type :error
                ::ctest/contexts (seq ctest/*testing-contexts*)
                :message (:message e)
                :test/expected (:expected e)
                :exception (:actual e)
                :file (:file e)
                :line (:line e)
                ::ctest/vars (reverse (map #(:name (meta %)) ctest/*testing-vars*))))

(defmethod ctevent->event :summary
  [e]
  nil)

(defmethod ctevent->event :begin-test-ns
  [e]
  (event/create :type :test/group
                :tags #{:begin}
                :name (ns-name (:ns e))))

(defmethod ctevent->event :end-test-ns
  [e]
  (event/create :type :test/group
                :tags #{:end}
                :name (ns-name (:ns e))))

(defmethod ctevent->event :begin-test-var
  [e]
  (event/create :type :test/test
                :tags #{:begin}
                :name (event/fqname (:var e))))

(defmethod ctevent->event :end-test-var
  [e]
  (event/create :type :test/test
                :tags #{:end}
                :name (event/fqname (:var e))))

(defn ct-adapter
  "Adapt clojure.test event model to fire c.t.g events."
  [m]
  (when-let [e (ctevent->event m)]
    (event/report-fn e)))

(defprotocol Test
  (test-name [_])
  (test-fn [_])
  (test-input [_]))

(extend-protocol Test
  clojure.lang.Var
  (test-name
   [v]
   (-> (when-let [ns (.ns v)]
         (str ns "/" (.sym v))
         (.sym v))
       symbol))
  (test-fn
   [this]
   @this)
  (test-input
   [v]
   (map #(%) (:clojure.test.generative/inputs (meta v)))))

(defn run-iter
  "Run a single test iteration"
  [test]
  (let [name (test-name test)
        f (test-fn test)
        input (test-input test)]
    (event/report :test/iter :level :debug :name name :args input :tags #{:begin})
    (try
     (let [result (apply f input)]
       (when-not (realized? *failed*)
         (event/report :test/iter :level :debug :name name :return result :tags #{:end})))
     (catch Throwable t
       (deliver *failed* :error)
       (event/report :error :name name :exception t)))))

(defn run-for
  "Run f (presumably for side effects) repeatedly on n threads,
   until msec has passed or somebody signals *failed*"
  [test nthreads msec]
  (let [start (System/currentTimeMillis)
        futs (doall
              (map
               #(future
                 (try
                  (binding [gen/*seed* (+ % 42)
                            gen/*rnd* (java.util.Random. gen/*seed*)
                            *failed* (promise)]
                    (event/report :test/test :tags #{:begin} :test/seed (+ % 42) :name (test-name test))
                    (loop [iter 0]
                      (let [result (run-iter test)
                            now (System/currentTimeMillis)
                            failed? (realized? *failed*)]
                        (if (and (< now (+ start msec))
                                   (not failed?))
                          (recur (inc iter))
                          (event/report :test/test
                                        :msec (- now start)
                                        :count (inc iter)
                                        :tags #{:end}
                                        :test/result (if failed? :test/fail :test/pass)
                                        :level (if failed? :warn :info)
                                        :name (test-name test))))))
                  (catch Throwable t
                    (event/report :error :level :error :exception t :name (test-name test)))))
               (range nthreads)))]
    (doseq [f futs] @f)))

(defn run-batch
  "Run a batch of fs on nthreads each. Call each f repeatedly
   for up to test-msec"
  [tests nthreads test-msec]
  (when (seq tests)
    (doseq [test tests]
      (run-for test nthreads test-msec))))

#_(defn set-seed
  [n]
  (set! gen/*rnd* (java.util.Random. n)))

(defn gentest?
  [v]
  (boolean (:clojure.test.generative/inputs (meta v))))

(defn find-vars-in-namespaces
  [& nses]
  (when nses
    (reduce (fn [v ns] (into v (vals (ns-interns ns)))) [] nses)))

(defn find-vars-in-dirs
  [& dirs]
  (let [nses (mapcat #(ns/find-namespaces-in-dir (java.io.File. ^String %)) dirs)]
    (doseq [ns nses] (require ns))
    (apply find-vars-in-namespaces nses)))

(defn find-gentests-in-vars
  [& vars]
  (filter gentest? vars))

(defn run-generative-tests
  "Run generative tests."
  [nses nthreads msec]
  (let [c (count (->> (apply find-vars-in-namespaces nses)
                      (filter gentest?)))]
    (when-not (zero? c)
      (let [test-msec (quot msec c)]
        (doseq [ns nses]
          (when-let [fs (->> (find-vars-in-namespaces ns)
                             (filter gentest?)
                             seq)]
            (event/report :test/group
                          :name ns
                          :tags #{:begin}
                          :test/threads nthreads
                          :test/count (count fs))
            (try
             (run-batch
              fs
              nthreads
              test-msec)
             (finally
              (event/report :test/group :tags #{:end} :test/threads nthreads :test/count (count fs))))))))))

(defn has-clojure-test-tests?
  [ns]
  (or (contains? (ns-interns ns) 'test-ns-hook)
      (some (comp :test meta) (vals (ns-interns ns)))))

(defn run-all-tests
  "Run generative tests and clojure.test tests"
  [nses threads msec]
  (binding [ctest/report ct-adapter]
    (let [run-with-counts
          (fn [lib f]
            (let [event-counts (atom {})
                  event-counter #(when-not (contains? (:tags %) :begin)
                                   (when-let [type (:type %)]
                                     (swap! event-counts update-in [type] (fnil inc 0))))]
              (event/report :test/library :name lib)
              (event/with-handler event-counter (f))
              @event-counts))
          ct-results (run-with-counts 'clojure.test
                       #(when-let [ctnses (seq (filter has-clojure-test-tests? nses))]
                          (apply ctest/run-tests ctnses)))
          ctg-results (run-with-counts 'clojure.test.generative
                        #(run-generative-tests nses threads msec))]
      (io/await)
      {'clojure.test ct-results
       'clojure.test.generative ctg-results})))

(defn failed?
  [result]
  (or (:assert/fail result)
      (:test/fail result)
      (:error result)))

(def process-id
  (delay
   (java.util.UUID/randomUUID)))

(def storage-writer
  (delay
   (let [f (str ".tg/" @process-id)]
     (jio/make-parents f)
     (jio/writer f :append true))))

(def store-agent (agent nil))

(def store
  "store data in .tg/{process-id}"
  (io/serialized
   (fn [e]
     (binding [*print-length* nil
               *print-level* nil
               *out* @storage-writer]
       (println e)))
   store-agent))

(defn save
  "Save results at info level or higher, using store."
  [e]
  (when (event/level-enabled? (:level e) :info)
    (store e)))

(defn test-dirs
  "Runs tests in dirs, returning a map of test lib keyword
   to summary data"
  [& dirs]
  (let [nses (mapcat #(ns/find-namespaces-in-dir (java.io.File. ^String %)) dirs)
        conf (config/config)]
    (doseq [ns nses] (require ns))
    (event/install-default-handlers)
    (run-all-tests nses (:threads conf) (:msec conf))))

(defn -main
  "Command line entry point, runs all tests in dirs using clojure.test and
   test.generative. Calls System.exit!"
  [& dirs]
  (if (seq dirs)
    (try
     (let [results (apply test-dirs dirs)]
       (doseq [[k v] results]
         (println (str "\nFramework " k))
         (println v))
       (System/exit (if (some failed? (vals results)) 1 0)))
     (catch Throwable t
       (.printStackTrace t)
       (System/exit -1))
     (finally
      (shutdown-agents)))
    (do
      (println "Specify at least one directory with tests")
      (System/exit -1))))

;   Copyright (c) Rich Hickey, Stuart Halloway, and contributors.
;   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 clojure.test.generative.runner
  (:require
   [clojure.java.io :as jio]
   [clojure.pprint :as pprint]
   [clojure.tools.namespace :as ns]
   [clojure.test.generative.config :as config]
   [clojure.test.generative.event :as event]
   [clojure.test.generative.generators :as gen]
   [clojure.test.generative.io :as io]
   [clojure.test :as ctest]))

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

;; non-nil binding means running inside the framework
(def ^:dynamic *failed* nil)

(defn failed!
  "Tell the runner that a test failed"
  []
  (when *failed*
    (deliver *failed* :failed)))

(defmulti ctevent->event
  "Convert a clojure.test reporting event to an event."
  :type)

(defmethod ctevent->event :default
  [e]
  (event/create :clojure.test/unknown e))

(defmethod ctevent->event :pass
  [e]
  (event/create :type :assert/pass))

(defmethod ctevent->event :fail
  [e]
  (failed!)
  (event/create :type :assert/fail
                :level :warn
                :message (:message e)
                :test/actual (:actual e)
                :test/expected (:expected e)
                :file (:file e)
                :line (:line e)
                ::ctest/contexts (seq ctest/*testing-contexts*)
                ::ctest/vars (reverse (map #(:name (meta %)) ctest/*testing-vars*))))

(defmethod ctevent->event :error
  [e]
  (event/create :level :error
                :type :error
                ::ctest/contexts (seq ctest/*testing-contexts*)
                :message (:message e)
                :test/expected (:expected e)
                :exception (:actual e)
                :file (:file e)
                :line (:line e)
                ::ctest/vars (reverse (map #(:name (meta %)) ctest/*testing-vars*))))

(defmethod ctevent->event :summary
  [e]
  nil)

(defmethod ctevent->event :begin-test-ns
  [e]
  (event/create :type :test/group
                :tags #{:begin}
                :name (ns-name (:ns e))))

(defmethod ctevent->event :end-test-ns
  [e]
  (event/create :type :test/group
                :tags #{:end}
                :name (ns-name (:ns e))))

(defmethod ctevent->event :begin-test-var
  [e]
  (event/create :type :test/test
                :tags #{:begin}
                :name (event/fqname (:var e))))

(defmethod ctevent->event :end-test-var
  [e]
  (event/create :type :test/test
                :tags #{:end}
                :name (event/fqname (:var e))))

(defn ct-adapter
  "Adapt clojure.test event model to fire c.t.g events."
  [m]
  (when-let [e (ctevent->event m)]
    (event/report-fn e)))

(defprotocol Test
  (test-name [_])
  (test-fn [_])
  (test-input [_]))

(extend-protocol Test
  clojure.lang.Var
  (test-name
   [v]
   (-> (when-let [ns (.ns v)]
         (str ns "/" (.sym v))
         (.sym v))
       symbol))
  (test-fn
   [this]
   @this)
  (test-input
   [v]
   (map #(%) (:clojure.test.generative/inputs (meta v)))))

(defn run-iter
  "Run a single test iteration"
  [test]
  (let [name (test-name test)
        f (test-fn test)
        input (test-input test)]
    (event/report :test/iter :level :debug :name name :args input :tags #{:begin})
    (try
     (let [result (apply f input)]
       (when-not (realized? *failed*)
         (event/report :test/iter :level :debug :name name :return result :tags #{:end})))
     (catch Throwable t
       (deliver *failed* :error)
       (event/report :error :name name :exception t)))))

(defn run-for
  "Run f (presumably for side effects) repeatedly on n threads,
   until msec has passed or somebody signals *failed*"
  [test nthreads msec]
  (let [start (System/currentTimeMillis)
        futs (doall
              (map
               #(future
                 (try
                  (let [seed (+ % 42)]
                    (binding [gen/*seed* seed
                              gen/*rnd* (java.util.Random. seed)
                              *failed* (promise)]
                      (event/report :test/test :tags #{:begin} :test/seed gen/*seed* :name (test-name test))
                      (loop [iter 0]
                        (let [result (run-iter test)
                              now (System/currentTimeMillis)
                              failed? (realized? *failed*)]
                          (if (and (< now (+ start msec))
                                   (not failed?))
                            (recur (inc iter))
                            (event/report :test/test
                                          :msec (- now start)
                                          :count (inc iter)
                                          :tags #{:end}
                                          :test/result (if failed? :test/fail :test/pass)
                                          :level (if failed? :warn :info)
                                          :name (test-name test)))))))
                  (catch Throwable t
                    (event/report :error :level :error :exception t :name (test-name test)))))
               (range nthreads)))]
    (doseq [f futs] @f)))

(defn run-batch
  "Run a batch of fs on nthreads each. Call each f repeatedly
   for up to test-msec"
  [tests nthreads test-msec]
  (when (seq tests)
    (doseq [test tests]
      (run-for test nthreads test-msec))))

#_(defn set-seed
  [n]
  (set! gen/*rnd* (java.util.Random. n)))

(defn gentest?
  [v]
  (boolean (:clojure.test.generative/inputs (meta v))))

(defn find-vars-in-namespaces
  [& nses]
  (when nses
    (reduce (fn [v ns] (into v (vals (ns-interns ns)))) [] nses)))

(defn find-vars-in-dirs
  [& dirs]
  (let [nses (mapcat #(ns/find-namespaces-in-dir (java.io.File. ^String %)) dirs)]
    (doseq [ns nses] (require ns))
    (apply find-vars-in-namespaces nses)))

(defn find-gentests-in-vars
  [& vars]
  (filter gentest? vars))

(defn run-generative-tests
  "Run generative tests."
  [nses nthreads msec]
  (let [c (count (->> (apply find-vars-in-namespaces nses)
                      (filter gentest?)))]
    (when-not (zero? c)
      (let [test-msec (quot msec c)]
        (doseq [ns nses]
          (when-let [fs (->> (find-vars-in-namespaces ns)
                             (filter gentest?)
                             seq)]
            (event/report :test/group
                          :name ns
                          :tags #{:begin}
                          :test/threads nthreads
                          :test/count (count fs))
            (try
             (run-batch
              fs
              nthreads
              test-msec)
             (finally
              (event/report :test/group :tags #{:end} :test/threads nthreads :test/count (count fs))))))))))

(defn has-clojure-test-tests?
  [ns]
  (or (contains? (ns-interns ns) 'test-ns-hook)
      (some (comp :test meta) (vals (ns-interns ns)))))

(defn run-all-tests
  "Run generative tests and clojure.test tests"
  [nses threads msec]
  (binding [ctest/report ct-adapter]
    (let [run-with-counts
          (fn [lib f]
            (let [event-counts (atom {})
                  event-counter #(when-not (contains? (:tags %) :begin)
                                   (when-let [type (:type %)]
                                     (swap! event-counts update-in [type] (fnil inc 0))))]
              (event/report :test/library :name lib)
              (event/with-handler event-counter (f))
              @event-counts))
          ct-results (run-with-counts 'clojure.test
                       #(when-let [ctnses (seq (filter has-clojure-test-tests? nses))]
                          (apply ctest/run-tests ctnses)))
          ctg-results (run-with-counts 'clojure.test.generative
                        #(run-generative-tests nses threads msec))]
      (io/await)
      {'clojure.test ct-results
       'clojure.test.generative ctg-results})))

(defn failed?
  [result]
  (or (:assert/fail result)
      (:test/fail result)
      (:error result)))

(def process-id
  (delay
   (java.util.UUID/randomUUID)))

(def storage-writer
  (delay
   (let [f (str ".tg/" @process-id)]
     (jio/make-parents f)
     (jio/writer f :append true))))

(def store-agent (agent nil))

(def store
  "store data in .tg/{process-id}"
  (io/serialized
   (fn [e]
     (binding [*print-length* nil
               *print-level* nil
               *out* @storage-writer]
       (println e)))
   store-agent))

(defn save
  "Save results at info level or higher, using store."
  [e]
  (when (event/level-enabled? (:level e) :info)
    (store e)))

(defn test-dirs
  "Runs tests in dirs, returning a map of test lib keyword
   to summary data"
  [& dirs]
  (let [nses (mapcat #(ns/find-namespaces-in-dir (java.io.File. ^String %)) dirs)
        conf (config/config)]
    (doseq [ns nses] (require ns))
    (event/install-default-handlers)
    (run-all-tests nses (:threads conf) (:msec conf))))

(defn -main
  "Command line entry point, runs all tests in dirs using clojure.test and
   test.generative. Calls System.exit!"
  [& dirs]
  (if (seq dirs)
    (try
     (let [results (apply test-dirs dirs)]
       (doseq [[k v] results]
         (println (str "\nFramework " k))
         (println v))
       (System/exit (if (some failed? (vals results)) 1 0)))
     (catch Throwable t
       (.printStackTrace t)
       (System/exit -1))
     (finally
      (shutdown-agents)))
    (do
      (println "Specify at least one directory with tests")
      (System/exit -1))))

bugfix: make different threads use different seeds


(ns faceboard.views.boards.people
  (:require [om.core :as om]
            [om-tools.core :refer-macros [defcomponent]]
            [om-tools.dom :as dom]
            [faceboard.animator :refer [animate anim-phase anim-class]]
            [faceboard.controller :refer [perform!]]
            [faceboard.shared.anims :as anims]
            [faceboard.helpers.social :refer [parse-social social-info]]
            [faceboard.helpers.countries :refer [lookup-country-name]]
            [faceboard.helpers.utils :refer [non-sanitized-div]]
            [faceboard.helpers.filters :refer [build-countries-tally build-tags-tally]]
            [faceboard.logging :refer [log log-err log-warn log-info]]
            [cemerick.pprng]))

(defcomponent social-section-item-component [data _ _]
  (render [_]
    (let [{:keys [type label content icon url]} (social-info data)]
      (dom/div {:class (str "social-item" (if type (str " " type) " link"))}
        (dom/a {:href url}
          (dom/i {:class (str "icon fa " icon)
                  :title (when type (str content " @ " label))})
          (dom/span {:class "content"} (str " " content)))))))

(defcomponent social-section-component [data _ _]
  (render [_]
    (dom/div {:class "extended-info-section social"}
      (dom/div {:class "info-title"} "social")
      (om/build-all social-section-item-component data)
      (dom/div {:class "clear"}))))

(defcomponent tags-section-item-component [data _ _]
  (render [_]
    (let [tag data]
      (dom/span {:class "tags-item"}
        tag))))

(defcomponent tags-section-component [data _ _]
  (render [_]
    (dom/div {:class "extended-info-section tags"}
      (dom/div {:class "info-title"} "tags")
      (om/build-all tags-section-item-component data)
      (dom/div {:class "clear"}))))

(defcomponent about-section-component [data _ _]
  (render [_]
    (dom/div {:class "extended-info-section about"}
      (dom/div {:class "info-title"} "about")
      (non-sanitized-div (:about data))
      (dom/div {:class "clear"}))))

(defcomponent contact-section-component [data _ _]
  (render [_]
    (let [{:keys [phone email]} data]
      (dom/div {:class "extended-info-section contact"}
        (dom/div {:class "info-title"} "contact")
        (when email
          (dom/div {:class "email"}
            (dom/a {:href (str "mailto:" email)} email)))
        (when phone
          (dom/div {:class "phone"}
            (dom/span {} "phone: ")
            (dom/span {:class "number"} phone)))
        (dom/div {:class "clear"})))))

(defcomponent person-extended-info-component [data _ _]
  (render [_]
    (let [{:keys [bio social tags]} data]
      (dom/div {:class "person-extended-info"}
        (when (:about bio)
          (om/build about-section-component bio))
        (when (or (:email bio) (:phone bio))
          (om/build contact-section-component bio))
        (when (and social (> (count social) 0))
          (om/build social-section-component social))
        (when (and tags (> (count tags) 0))
          (om/build tags-section-component tags))))))

(defcomponent person-info-component [data _ _]
  (render [_]
    (let [person (:person data)
          bio (:bio person)
          id (:id data)
          extended? (:extended? data)
          random-generator (cemerick.pprng/rng (hash id))
          angle (- (cemerick.pprng/int random-generator 20) 10)
          country-code (:country bio)
          country-name (lookup-country-name country-code)]
      (dom/div {:class (str "person" (when (:hide? data) " hide"))}
        (dom/div {:class "polaroid-frame"
                  :style {:transform (str "rotate(" angle "deg)")}}
          (dom/div {:class "left-part"}
            (dom/div {:class "photo"}
              (dom/img {:src (or (get-in bio [:photo :url] nil) "/images/unknown.jpg")}))
            (dom/div {:class "name f16"
                      :title (:full-name bio)}
              (:name bio)
              (when-not (nil? country-code)
                (dom/div {:class (str "flag " country-code)
                          :title country-name}))))
          (when extended?
            (dom/div {:class "right-part"}
              (om/build person-extended-info-component person)))
          (dom/div {:class "clear"}))))))

(defcomponent person-component [data _ _]
  (render [_]
    (let [person (:person data)
          index (:index data)
          id (:id person)
          expansion-anim (anims/person-expanding index)
          shrinking-anim (anims/person-shrinking index)
          extended? (or (:extended? data) (= (anim-phase shrinking-anim) 0) (= (anim-phase shrinking-anim) 1))]
      (dom/div {:class    (str "person-box"
                            (anim-class expansion-anim " expanding")
                            (anim-class shrinking-anim " shrinking")
                            (when extended? " extended"))
                :on-click (fn [e]
                            (.stopPropagation e)
                            (perform! :change-extended-set (if-not extended? (set [index]) #{})))}
        (dom/div {:class "person-extended-wrapper"}
          (om/build person-info-component {:hide?     (not extended?)
                                           :extended? extended?
                                           :id        id
                                           :person    person}))
        (dom/div {:class "person-essentials-wrapper"}
          (om/build person-info-component {:hide?  extended? ; acts as a hidden placeholder when extended
                                           :id     id
                                           :person person}))))))

(defcomponent countries-filter-item-component [data _ _]
  (render [_]
    (let [{:keys [country-code report]} data
          country-name (lookup-country-name country-code)
          count (:count report)]
      (dom/div {:class "countries-filter-item f16"}
        (dom/div {:class "countries-filter-item-body"}
          (when-not (nil? country-code)
            (dom/span {:class (str "flag " country-code) :title country-name}))
          (dom/span {:class "country"} country-name)
          (dom/span {:class "count"} (str "(" count "x)")))))))

(defcomponent countries-filter-component [data _ _]
  (render [_]
    (let [people (:content data)
          countries-tally (build-countries-tally people)
          sorted-countries (:countries-by-size countries-tally)]
      (dom/div {:class "countries-filter-wrapper"}
        (when (> (count sorted-countries) 1)
          (dom/div {:class "countries-filter filter-section"}
            (dom/div {:class "filter-section-label"
                      :title "filtering by country"}
              "countries"
              (dom/span {:class "fa fa-filter"}))
            (dom/div {:class "filter-section-body"}
              (for [country-code sorted-countries]
                (let [report (get-in countries-tally [:tally country-code])]
                  (om/build countries-filter-item-component {:country-code country-code
                                                             :report       report}))))))))))

(defcomponent tags-filter-item-component [data _ _]
  (render [_]
    (let [{:keys [tag report]} data
          count (:count report)]
      (dom/div {:class "tags-filter-item f16"}
        (dom/span {:class "tag"
                   :title (str "(" count "x)")} tag)))))

(defcomponent tags-filter-component [data _ _]
  (render [_]
    (let [people (:content data)
          tags-tally (build-tags-tally people)
          sorted-tags (:tags-by-size tags-tally)]
      (dom/div {:class "tags-filter-wrapper"}
        (when (> (count sorted-tags) 0)
          (dom/div {:class "tags-filter filter-section"}
            (dom/div {:class "filter-section-label"
                      :title "filtering by interest"}
              "interests"
              (dom/span {:class "fa fa-filter"}))
            (dom/div {:class "filter-section-body"}
              (for [tag sorted-tags]
                (let [report (get-in tags-tally [:tally tag])]
                  (om/build tags-filter-item-component {:tag    tag
                                                        :report report}))))))))))

(defcomponent filters-component [data _ _]
  (render [_]
    (dom/div {:class "people-filters no-select"}
      (om/build countries-filter-component data)
      (om/build tags-filter-component data))))

(defcomponent people-component [data _ _]
  (render [_]
    (let [{:keys [ui anims]} data
          people (:content data)
          sorted-people (sort #(compare (get-in %1 [:bio :name]) (get-in %2 [:bio :name])) people)
          extended-set (:extended-set ui)]
      (dom/div {:class "clearfix no-select"}
        (om/build filters-component data)
        (dom/div {:class "people-desk clearfix"}
          (for [i (range (count sorted-people))]
            (let [person (nth sorted-people i)
                  data {:person    person
                        :extended? (contains? extended-set i)
                        :anim      (:person anims)
                        :index     i}]
              (om/build person-component data))))))))

(ns faceboard.views.boards.people
  (:require [om.core :as om]
            [om-tools.core :refer-macros [defcomponent]]
            [om-tools.dom :as dom]
            [faceboard.animator :refer [animate anim-phase anim-class]]
            [faceboard.controller :refer [perform!]]
            [faceboard.shared.anims :as anims]
            [faceboard.helpers.social :refer [parse-social social-info]]
            [faceboard.helpers.countries :refer [lookup-country-name]]
            [faceboard.helpers.utils :refer [non-sanitized-div]]
            [faceboard.helpers.filters :refer [build-countries-tally build-tags-tally]]
            [faceboard.logging :refer [log log-err log-warn log-info]]
            [cemerick.pprng]))

(defcomponent social-section-item-component [data _ _]
  (render [_]
    (let [{:keys [type label content icon url]} (social-info data)]
      (dom/div {:class (str "social-item" (if type (str " " type) " link"))}
        (dom/a {:href url}
          (dom/i {:class (str "icon fa " icon)
                  :title (when type (str content " @ " label))})
          (dom/span {:class "content"} (str " " content)))))))

(defcomponent social-section-component [data _ _]
  (render [_]
    (dom/div {:class "extended-info-section social"}
      (dom/div {:class "info-title"} "social")
      (om/build-all social-section-item-component data)
      (dom/div {:class "clear"}))))

(defcomponent tags-section-item-component [data _ _]
  (render [_]
    (let [tag data]
      (dom/span {:class "tags-item"}
        tag))))

(defcomponent tags-section-component [data _ _]
  (render [_]
    (dom/div {:class "extended-info-section tags"}
      (dom/div {:class "info-title"} "interests")
      (om/build-all tags-section-item-component data)
      (dom/div {:class "clear"}))))

(defcomponent about-section-component [data _ _]
  (render [_]
    (dom/div {:class "extended-info-section about"}
      (dom/div {:class "info-title"} "about")
      (non-sanitized-div (:about data))
      (dom/div {:class "clear"}))))

(defcomponent contact-section-component [data _ _]
  (render [_]
    (let [{:keys [phone email]} data]
      (dom/div {:class "extended-info-section contact"}
        (dom/div {:class "info-title"} "contact")
        (when email
          (dom/div {:class "email"}
            (dom/a {:href (str "mailto:" email)} email)))
        (when phone
          (dom/div {:class "phone"}
            (dom/span {} "phone: ")
            (dom/span {:class "number"} phone)))
        (dom/div {:class "clear"})))))

(defcomponent person-extended-info-component [data _ _]
  (render [_]
    (let [{:keys [bio social tags]} data]
      (dom/div {:class "person-extended-info"}
        (when (:about bio)
          (om/build about-section-component bio))
        (when (or (:email bio) (:phone bio))
          (om/build contact-section-component bio))
        (when (and social (> (count social) 0))
          (om/build social-section-component social))
        (when (and tags (> (count tags) 0))
          (om/build tags-section-component tags))))))

(defcomponent person-info-component [data _ _]
  (render [_]
    (let [person (:person data)
          bio (:bio person)
          id (:id data)
          extended? (:extended? data)
          random-generator (cemerick.pprng/rng (hash id))
          angle (- (cemerick.pprng/int random-generator 20) 10)
          country-code (:country bio)
          country-name (lookup-country-name country-code)]
      (dom/div {:class (str "person" (when (:hide? data) " hide"))}
        (dom/div {:class "polaroid-frame"
                  :style {:transform (str "rotate(" angle "deg)")}}
          (dom/div {:class "left-part"}
            (dom/div {:class "photo"}
              (dom/img {:src (or (get-in bio [:photo :url] nil) "/images/unknown.jpg")}))
            (dom/div {:class "name f16"
                      :title (:full-name bio)}
              (:name bio)
              (when-not (nil? country-code)
                (dom/div {:class (str "flag " country-code)
                          :title country-name}))))
          (when extended?
            (dom/div {:class "right-part"}
              (om/build person-extended-info-component person)))
          (dom/div {:class "clear"}))))))

(defcomponent person-component [data _ _]
  (render [_]
    (let [person (:person data)
          index (:index data)
          id (:id person)
          expansion-anim (anims/person-expanding index)
          shrinking-anim (anims/person-shrinking index)
          extended? (or (:extended? data) (= (anim-phase shrinking-anim) 0) (= (anim-phase shrinking-anim) 1))]
      (dom/div {:class    (str "person-box"
                            (anim-class expansion-anim " expanding")
                            (anim-class shrinking-anim " shrinking")
                            (when extended? " extended"))
                :on-click (fn [e]
                            (.stopPropagation e)
                            (perform! :change-extended-set (if-not extended? (set [index]) #{})))}
        (dom/div {:class "person-extended-wrapper"}
          (om/build person-info-component {:hide?     (not extended?)
                                           :extended? extended?
                                           :id        id
                                           :person    person}))
        (dom/div {:class "person-essentials-wrapper"}
          (om/build person-info-component {:hide?  extended? ; acts as a hidden placeholder when extended
                                           :id     id
                                           :person person}))))))

(defcomponent countries-filter-item-component [data _ _]
  (render [_]
    (let [{:keys [country-code report]} data
          country-name (lookup-country-name country-code)
          count (:count report)]
      (dom/div {:class "countries-filter-item f16"}
        (dom/div {:class "countries-filter-item-body"}
          (when-not (nil? country-code)
            (dom/span {:class (str "flag " country-code) :title country-name}))
          (dom/span {:class "country"} country-name)
          (dom/span {:class "count"} (str "(" count "x)")))))))

(defcomponent countries-filter-component [data _ _]
  (render [_]
    (let [people (:content data)
          countries-tally (build-countries-tally people)
          sorted-countries (:countries-by-size countries-tally)]
      (dom/div {:class "countries-filter-wrapper"}
        (when (> (count sorted-countries) 1)
          (dom/div {:class "countries-filter filter-section"}
            (dom/div {:class "filter-section-label"
                      :title "filtering by country"}
              "countries"
              (dom/span {:class "fa fa-filter"}))
            (dom/div {:class "filter-section-body"}
              (for [country-code sorted-countries]
                (let [report (get-in countries-tally [:tally country-code])]
                  (om/build countries-filter-item-component {:country-code country-code
                                                             :report       report}))))))))))

(defcomponent tags-filter-item-component [data _ _]
  (render [_]
    (let [{:keys [tag report]} data
          count (:count report)]
      (dom/div {:class "tags-filter-item f16"}
        (dom/span {:class "tag"
                   :title (str "(" count "x)")} tag)))))

(defcomponent tags-filter-component [data _ _]
  (render [_]
    (let [people (:content data)
          tags-tally (build-tags-tally people)
          sorted-tags (:tags-by-size tags-tally)]
      (dom/div {:class "tags-filter-wrapper"}
        (when (> (count sorted-tags) 0)
          (dom/div {:class "tags-filter filter-section"}
            (dom/div {:class "filter-section-label"
                      :title "filtering by interest"}
              "interests"
              (dom/span {:class "fa fa-filter"}))
            (dom/div {:class "filter-section-body"}
              (for [tag sorted-tags]
                (let [report (get-in tags-tally [:tally tag])]
                  (om/build tags-filter-item-component {:tag    tag
                                                        :report report}))))))))))

(defcomponent filters-component [data _ _]
  (render [_]
    (dom/div {:class "people-filters no-select"}
      (om/build countries-filter-component data)
      (om/build tags-filter-component data))))

(defcomponent people-component [data _ _]
  (render [_]
    (let [{:keys [ui anims]} data
          people (:content data)
          sorted-people (sort #(compare (get-in %1 [:bio :name]) (get-in %2 [:bio :name])) people)
          extended-set (:extended-set ui)]
      (dom/div {:class "clearfix no-select"}
        (om/build filters-component data)
        (dom/div {:class "people-desk clearfix"}
          (for [i (range (count sorted-people))]
            (let [person (nth sorted-people i)
                  data {:person    person
                        :extended? (contains? extended-set i)
                        :anim      (:person anims)
                        :index     i}]
              (om/build person-component data))))))))

Rename "tags" to "interests"

Rename "tags" to "interests"


(ns chat.client.dispatcher
  (:require [clojure.string :as string]
            [cljs-uuid-utils.core :as uuid]
            [chat.client.store :as store]
            [chat.client.sync :as sync]
            [chat.client.schema :as schema]
            [cljs-utils.core :refer [edn-xhr]]))

(defmulti dispatch! (fn [event data] event))

(defmethod dispatch! :new-message [_ data]
  (when-not (string/blank? (data :content))
    (let [message (schema/make-message {:user-id (get-in @store/app-state [:session :user-id])
                                        :content (data :content)
                                        :thread-id (data :thread-id)})]
      (store/add-message! message)
      (sync/chsk-send! [:chat/new-message message])
      (when-let [mentioned-names (->> (re-seq #"(?:^|\s)@(\S+)" (message :content))
                                      (map second))]
        (let [nick->id (reduce (fn [m [id {:keys [email nickname]}]] (assoc m (or nickname email) id))
                               {}
                               (@store/app-state :users))
              mentioned (into () (comp (remove nil?) (map nick->id)) mentioned-names)]
          (println "nick->id" nick->id "mentioned " mentioned-names)
          (doseq [mention mentioned]
            (sync/chsk-send! [:thread/add-mention {:thread-id (message :thread-id)
                                                   :mentioned-id mention}])
            (store/add-mention-to-thread! mention (message :thread-id))))))))

(defmethod dispatch! :hide-thread [_ data]
  (sync/chsk-send! [:chat/hide-thread (data :thread-id)])
  (store/hide-thread! (data :thread-id)))

(defmethod dispatch! :create-tag [_ [tag-name group-id]]
  (let [tag (schema/make-tag {:name tag-name :group-id group-id})]
    (store/add-tag! tag)
    (sync/chsk-send! [:chat/create-tag tag])
    (dispatch! :subscribe-to-tag (tag :id))))

(defmethod dispatch! :unsubscribe-from-tag [_ tag-id]
  (sync/chsk-send! [:user/unsubscribe-from-tag tag-id])
  (store/unsubscribe-from-tag! tag-id))

(defmethod dispatch! :subscribe-to-tag [_ tag-id]
  (sync/chsk-send! [:user/subscribe-to-tag tag-id])
  (store/subscribe-to-tag! tag-id))

(defmethod dispatch! :tag-thread [_ attr]
  (when-let [tag-id (or (attr :id) (store/tag-id-for-name (attr :tag-name)))]
    (sync/chsk-send! [:thread/add-tag {:thread-id (attr :thread-id)
                                       :tag-id tag-id}])
    (store/add-tag-to-thread! tag-id (attr :thread-id))))

(defmethod dispatch! :mention-user [_ [thread-id user-id]]
  (sync/chsk-send! [:thread/add-mention {:thread-id thread-id
                                         :mentioned-id user-id}])
  (store/add-mention-to-thread! user-id thread-id))

(defmethod dispatch! :create-group [_ group]
  (let [group (schema/make-group group)]
    (sync/chsk-send!
      [:chat/create-group group]
      1000
      (fn [reply]
        (when-let [msg (reply :error)]
          (.error js/console msg)
          (store/display-error! msg)
          (store/remove-group! group))))
    (store/add-group! group)))

(defmethod dispatch! :set-nickname [_ [nickname on-error]]
  (sync/chsk-send!
    [:user/set-nickname {:nickname nickname}]
    1000
    (fn [reply]
      (if (reply :error)
        (on-error)
        (store/set-nickname! nickname)))))

(defmethod dispatch! :search-history [_ query]
  (sync/chsk-send!
    [:chat/search query]
    2000
    (fn [reply]
      (when-let [results (:threads reply)]
       (store/set-search-results! results)))))

(defmethod dispatch! :invite [_ data]
  (let [invite (schema/make-invitation data)]
    (sync/chsk-send! [:chat/invite-to-group invite])))

(defmethod dispatch! :accept-invite [_ invite]
  (sync/chsk-send! [:chat/invitation-accept invite])
  (store/remove-invite! invite))

(defmethod dispatch! :decline-invite [_ invite]
  (sync/chsk-send! [:chat/invitation-decline invite])
  (store/remove-invite! invite))

(defmethod dispatch! :auth [_ data]
  (edn-xhr {:url "/auth"
            :method :post
            :data {:email (data :email)
                   :password (data :password)
                   :csrf-token (:csrf-token @sync/chsk-state)}
            :on-error (fn [e]
                        (when-let [cb (data :on-error)]
                          (cb)))
            :on-complete (fn [data]
                           (sync/reconnect!))}))

(defmethod dispatch! :logout [_ _]
  (edn-xhr {:url "/logout"
            :method :post
            :data {:csrf-token (:csrf-token @sync/chsk-state)}
            :on-complete (fn [data]
                           (store/clear-session!))}))

; Websocket Events

(defmethod sync/event-handler :chat/thread
  [[_ data]]
  (store/add-thread! data))

(defmethod sync/event-handler :session/init-data
  [[_ data]]
  (store/set-session! {:user-id (data :user-id) :nickname (data :user-nickname)})
  (store/add-users! (data :users))
  (store/add-tags! (data :tags))
  (store/set-user-subscribed-tag-ids! (data :user-subscribed-tag-ids))
  (store/set-user-joined-groups! (data :user-groups))
  (store/set-invitations! (data :invitations))
  (store/set-threads! (data :user-threads)))

(defmethod sync/event-handler :socket/connected
  [[_ _]]
  (sync/chsk-send! [:session/start nil]))

(defmethod sync/event-handler :chat/create-tag
  [[_ data]]
  (store/add-tag! data)
  (dispatch! :subscribe-to-tag (data :id)))

(defmethod sync/event-handler :chat/joined-group
  [[_ data]]
  (store/add-group! (data :group))
  (store/add-tags! (data :tags))
  (doseq [t (data :tags)]
    (store/subscribe-to-tag! (t :id))))

(defmethod sync/event-handler :chat/update-users
  [[_ data]]
  (store/add-users! data))

(defmethod sync/event-handler :chat/invitation-recieved
  [[_ invite]]
  (store/add-invite! invite))

(ns chat.client.dispatcher
  (:require [clojure.string :as string]
            [cljs-uuid-utils.core :as uuid]
            [chat.client.store :as store]
            [chat.client.sync :as sync]
            [chat.client.schema :as schema]
            [cljs-utils.core :refer [edn-xhr]]))

(defmulti dispatch! (fn [event data] event))

(defmethod dispatch! :new-message [_ data]
  (when-not (string/blank? (data :content))
    (let [message (schema/make-message {:user-id (get-in @store/app-state [:session :user-id])
                                        :content (data :content)
                                        :thread-id (data :thread-id)})]
      (store/add-message! message)
      (sync/chsk-send! [:chat/new-message message])
      (when-let [mentioned-names (->> (re-seq #"(?:^|\s)@(\S+)" (message :content))
                                      (map second))]
        (let [nick->id (reduce (fn [m [id {:keys [email nickname]}]] (assoc m (or nickname email) id))
                               {}
                               (@store/app-state :users))
              mentioned (->> mentioned-names (map nick->id) (remove nil?))]
          (doseq [mention mentioned]
            (sync/chsk-send! [:thread/add-mention {:thread-id (message :thread-id)
                                                   :mentioned-id mention}])
            (store/add-mention-to-thread! mention (message :thread-id))))))))

(defmethod dispatch! :hide-thread [_ data]
  (sync/chsk-send! [:chat/hide-thread (data :thread-id)])
  (store/hide-thread! (data :thread-id)))

(defmethod dispatch! :create-tag [_ [tag-name group-id]]
  (let [tag (schema/make-tag {:name tag-name :group-id group-id})]
    (store/add-tag! tag)
    (sync/chsk-send! [:chat/create-tag tag])
    (dispatch! :subscribe-to-tag (tag :id))))

(defmethod dispatch! :unsubscribe-from-tag [_ tag-id]
  (sync/chsk-send! [:user/unsubscribe-from-tag tag-id])
  (store/unsubscribe-from-tag! tag-id))

(defmethod dispatch! :subscribe-to-tag [_ tag-id]
  (sync/chsk-send! [:user/subscribe-to-tag tag-id])
  (store/subscribe-to-tag! tag-id))

(defmethod dispatch! :tag-thread [_ attr]
  (when-let [tag-id (or (attr :id) (store/tag-id-for-name (attr :tag-name)))]
    (sync/chsk-send! [:thread/add-tag {:thread-id (attr :thread-id)
                                       :tag-id tag-id}])
    (store/add-tag-to-thread! tag-id (attr :thread-id))))

(defmethod dispatch! :mention-user [_ [thread-id user-id]]
  (sync/chsk-send! [:thread/add-mention {:thread-id thread-id
                                         :mentioned-id user-id}])
  (store/add-mention-to-thread! user-id thread-id))

(defmethod dispatch! :create-group [_ group]
  (let [group (schema/make-group group)]
    (sync/chsk-send!
      [:chat/create-group group]
      1000
      (fn [reply]
        (when-let [msg (reply :error)]
          (.error js/console msg)
          (store/display-error! msg)
          (store/remove-group! group))))
    (store/add-group! group)))

(defmethod dispatch! :set-nickname [_ [nickname on-error]]
  (sync/chsk-send!
    [:user/set-nickname {:nickname nickname}]
    1000
    (fn [reply]
      (if (reply :error)
        (on-error)
        (store/set-nickname! nickname)))))

(defmethod dispatch! :search-history [_ query]
  (sync/chsk-send!
    [:chat/search query]
    2000
    (fn [reply]
      (when-let [results (:threads reply)]
       (store/set-search-results! results)))))

(defmethod dispatch! :invite [_ data]
  (let [invite (schema/make-invitation data)]
    (sync/chsk-send! [:chat/invite-to-group invite])))

(defmethod dispatch! :accept-invite [_ invite]
  (sync/chsk-send! [:chat/invitation-accept invite])
  (store/remove-invite! invite))

(defmethod dispatch! :decline-invite [_ invite]
  (sync/chsk-send! [:chat/invitation-decline invite])
  (store/remove-invite! invite))

(defmethod dispatch! :auth [_ data]
  (edn-xhr {:url "/auth"
            :method :post
            :data {:email (data :email)
                   :password (data :password)
                   :csrf-token (:csrf-token @sync/chsk-state)}
            :on-error (fn [e]
                        (when-let [cb (data :on-error)]
                          (cb)))
            :on-complete (fn [data]
                           (sync/reconnect!))}))

(defmethod dispatch! :logout [_ _]
  (edn-xhr {:url "/logout"
            :method :post
            :data {:csrf-token (:csrf-token @sync/chsk-state)}
            :on-complete (fn [data]
                           (store/clear-session!))}))

; Websocket Events

(defmethod sync/event-handler :chat/thread
  [[_ data]]
  (store/add-thread! data))

(defmethod sync/event-handler :session/init-data
  [[_ data]]
  (store/set-session! {:user-id (data :user-id) :nickname (data :user-nickname)})
  (store/add-users! (data :users))
  (store/add-tags! (data :tags))
  (store/set-user-subscribed-tag-ids! (data :user-subscribed-tag-ids))
  (store/set-user-joined-groups! (data :user-groups))
  (store/set-invitations! (data :invitations))
  (store/set-threads! (data :user-threads)))

(defmethod sync/event-handler :socket/connected
  [[_ _]]
  (sync/chsk-send! [:session/start nil]))

(defmethod sync/event-handler :chat/create-tag
  [[_ data]]
  (store/add-tag! data)
  (dispatch! :subscribe-to-tag (data :id)))

(defmethod sync/event-handler :chat/joined-group
  [[_ data]]
  (store/add-group! (data :group))
  (store/add-tags! (data :tags))
  (doseq [t (data :tags)]
    (store/subscribe-to-tag! (t :id))))

(defmethod sync/event-handler :chat/update-users
  [[_ data]]
  (store/add-users! data))

(defmethod sync/event-handler :chat/invitation-recieved
  [[_ invite]]
  (store/add-invite! invite))

fix filtering mentions

fix filtering mentions


(ns searchbot.parsets
  (:require-macros [cljs.core.async.macros :refer [go go-loop alt!]])
  (:require [om.core :as om :include-macros true]
            [om-tools.core :refer-macros [defcomponent]]
            [sablono.core :as html :refer-macros [html]]
            [cljs.core.async :refer [put! <! >! chan timeout close!]]
            [searchbot.es :refer [es-agg filtered-agg]]
            [searchbot.input.labels :as labels]))

(defn- build-parsets-agg
  [terms sub-aggs]
  (reduce (fn [agg-query a-term]
            {:aggs {(keyword a-term) (merge {:terms {:field a-term}} agg-query)}})
          (if sub-aggs {:aggs sub-aggs} {}) terms))

(defn- walk-buckets [de-buck bucket prefix steps value-path]
  (map #(de-buck % de-buck prefix (first steps) (rest steps) value-path)
           (get-in bucket [(first steps) :buckets])))

(defn- <-buckets [bucket de-buck prefix current-step steps value-path]
  (if (= 0 (count steps))
    (merge prefix {current-step (:key bucket) :value (get-in bucket value-path)})
    (let [prefix (merge prefix {current-step (:key bucket)})]
      (walk-buckets <-buckets bucket prefix steps value-path))))

(defn- agg->parsets [agg-result all-steps value-path]
  (vec (flatten (walk-buckets <-buckets agg-result {} all-steps value-path))))

(defn- new-svg [graph-id w h]
  (-> js/d3 (.select graph-id) (.append "svg") (.attr "width" w) (.attr "height" h)))

(defn- ->query
  [{:keys [agg-terms sub-aggs default-filter]}]
  (let [agg-query (build-parsets-agg (reverse agg-terms) sub-aggs)
        agg-query (filtered-agg {:body agg-query
                                 :filter default-filter})]
    agg-query))

(defn- do-parsets-agg
  [owner]
  (let [{:keys [continue? comm url get-agg-terms make-agg-query value-path]} (om/get-state owner)
        {es-settings :es-settings} (om/get-shared owner)]
    (when continue?
      (go (.log js/console "# running parsets aggregation:" (pr-str (get-agg-terms)))
          (let [{agg-result :aggregations} (<! (es-agg (or url (:url-agg (es-settings))) (make-agg-query)))]
            (>! comm (agg->parsets agg-result (get-agg-terms) value-path)))))))

(defn- update-agg-terms-with-label
  [owner label-string]
  (let [agg-terms (labels/labelize label-string)
        agg-terms (map :name agg-terms)
        agg-terms (map keyword agg-terms)]
    (.log js/console "@ label-updated:" (pr-str agg-terms))
    (om/update-state! owner #(assoc % :parsets-agg agg-terms))
    (do-parsets-agg owner)
    ))

(defn- make-parsets-chart [{:keys [height width get-parsets-agg]}]
  (-> js/d3
      .parsets
      (.tension 0.8)
      (.width width)
      (.height height)
      (.dimensions (clj->js (map name (get-parsets-agg))))
      (.value (fn [d i] (. d -value)))))

(defcomponent parsets [cursor owner {:keys [agg value-path url height] :or {height 600 value-path ["doc_count"]} :as opts}]
  (init-state [_]
              {:continue? true
               :comm (chan)
               :url url
               :parsets-agg (map keyword (:terms agg))
               :get-agg-terms #(:parsets-agg (om/get-state owner))
               :make-agg-query #(->query {:agg-terms ((:get-agg-terms (om/get-state owner)))
                                          :sub-aggs (:sub agg)
                                          :default-filter (get-in ((:es-settings (om/get-shared owner))) [:default :filter])})
               :value-path (apply vector (map keyword value-path))
               :svg nil})
  (will-mount [_]
              (do-parsets-agg owner))
  (render [_]
          (html
           [:.card {:ref "parsets-card"}
            [:.card-content
             [:div.right {:style {:max-width "50%"}}
              (let [get-agg-terms #(:parsets-agg (om/get-state owner))
                    label-string (->> (get-agg-terms)
                                      (map name)
                                      (clojure.string/join " "))]
                (om/build labels/labels cursor
                          {:opts {:labels (labels/labelize label-string)
                                  :on-label-updated! (partial update-agg-terms-with-label owner)}}))]
             [:span.card-title.black-text
              "# PARSETS [ "
              [:strong (->> (:parsets-agg (om/get-state owner))
                            (map name)
                            (clojure.string/join " > "))]
              " ]"]
             [:div#parsets {:ref "parsets-div"}]]]))
  (did-mount [_]
             (let [{:keys [comm parsets-agg]} (om/get-state owner)
                   parsets-div (om/get-node owner "parsets-div")
                   card-width (.-offsetWidth parsets-div)
                   get-svg #(new-svg "#parsets" card-width height)
                   chart #(make-parsets-chart
                           {:height height :width card-width
                            :get-parsets-agg (fn [_] (:parsets-agg (om/get-state owner)))})]
               (.attach js/Waves (om/get-node owner "parsets-div") "waves-yellow")
               (go (while (:continue? (om/get-state owner))
                     (let [parsets-data (<! comm)
                           _ (-> js/d3 (.select "#parsets > svg") .remove)
                           svg (get-svg)]
                       (.log js/console "# parsets aggregation:" (count parsets-data))
                       (-> svg (.datum (clj->js parsets-data))
                           (.call (chart)))
                       (.ripple js/Waves (om/get-node owner "parsets-div")))))
               ))
  (will-unmount [_]
                (let [{:keys [comm]} (om/get-state owner)]
                  (.log js/console "### unmounting parsets")
                  (close! comm)
                  (om/update-state! owner #(assoc % :continue? false))
                  (om/update-state! owner #(assoc % :svg nil))
                  ))
  )

(ns searchbot.parsets
  (:require-macros [cljs.core.async.macros :refer [go go-loop alt!]])
  (:require [om.core :as om :include-macros true]
            [om-tools.core :refer-macros [defcomponent]]
            [sablono.core :as html :refer-macros [html]]
            [cljs.core.async :refer [put! <! >! chan timeout close!]]
            [searchbot.es :refer [es-agg filtered-agg]]
            [searchbot.input.labels :as labels]))

(defn- build-parsets-agg
  [terms sub-aggs]
  (reduce (fn [agg-query a-term]
            {:aggs {(keyword a-term) (merge {:terms {:field a-term}} agg-query)}})
          (if sub-aggs {:aggs sub-aggs} {}) terms))

(defn- walk-buckets [de-buck bucket prefix steps value-path]
  (map #(de-buck % de-buck prefix (first steps) (rest steps) value-path)
           (get-in bucket [(first steps) :buckets])))

(defn- <-buckets [bucket de-buck prefix current-step steps value-path]
  (if (= 0 (count steps))
    (merge prefix {current-step (:key bucket) :value (get-in bucket value-path)})
    (let [prefix (merge prefix {current-step (:key bucket)})]
      (walk-buckets <-buckets bucket prefix steps value-path))))

(defn- agg->parsets [agg-result all-steps value-path]
  (vec (flatten (walk-buckets <-buckets agg-result {} all-steps value-path))))

(defn- new-svg [graph-id w h]
  (-> js/d3 (.select graph-id) (.append "svg") (.attr "width" w) (.attr "height" h)))

(defn- ->query
  [{:keys [agg-terms sub-aggs default-filter]}]
  (let [agg-query (build-parsets-agg (reverse agg-terms) sub-aggs)
        agg-query (filtered-agg {:body agg-query
                                 :filter default-filter})]
    agg-query))

(defn- do-parsets-agg
  [owner]
  (let [{:keys [continue? comm url get-agg-terms make-agg-query value-path]} (om/get-state owner)
        {es-settings :es-settings} (om/get-shared owner)]
    (when continue?
      (go (.log js/console "# running parsets aggregation:" (pr-str (get-agg-terms)))
          (let [{agg-result :aggregations} (<! (es-agg (or url (:url-agg (es-settings))) (make-agg-query)))]
            (>! comm (agg->parsets agg-result (get-agg-terms) value-path)))))))

(defn- update-agg-terms-with-label
  [owner label-string]
  (let [agg-terms (labels/labelize label-string)
        agg-terms (map :name agg-terms)
        agg-terms (map keyword agg-terms)]
    (.log js/console "@ label-updated:" (pr-str agg-terms))
    (om/update-state! owner #(assoc % :parsets-agg agg-terms))
    (do-parsets-agg owner)
    ))

(defn- make-parsets-chart [{:keys [height width get-parsets-agg]}]
  (-> js/d3
      .parsets
      (.tension 0.8)
      (.width width)
      (.height height)
      (.dimensions (clj->js (map name (get-parsets-agg))))
      (.value (fn [d i] (. d -value)))))

(defcomponent parsets [cursor owner {:keys [agg value-path url height] :or {height 600 value-path ["doc_count"]} :as opts}]
  (init-state [_]
              {:continue? true
               :comm (chan)
               :url url
               :parsets-agg (map keyword (:terms agg))
               :get-agg-terms #(:parsets-agg (om/get-state owner))
               :make-agg-query #(->query {:agg-terms ((:get-agg-terms (om/get-state owner)))
                                          :sub-aggs (:sub agg)
                                          :default-filter (get-in ((:es-settings (om/get-shared owner))) [:default :filter])})
               :value-path (apply vector (map keyword value-path))
               :svg nil})
  (will-mount [_]
              (do-parsets-agg owner))
  (render [_]
          (html
           [:.card {:ref "parsets-card"}
            [:.card-content
             [:div.right {:style {:max-width "50%"}}
              (let [get-agg-terms #(:parsets-agg (om/get-state owner))
                    label-string (->> (get-agg-terms)
                                      (map name)
                                      (clojure.string/join " "))]
                (om/build labels/labels cursor
                          {:opts {:labels (labels/labelize label-string)
                                  :on-label-updated! (partial update-agg-terms-with-label owner)}}))]
             [:span.card-title.black-text
              "# PARSETS [ "
              [:strong (->> (:parsets-agg (om/get-state owner))
                            (map name)
                            (clojure.string/join " > "))]
              " ]"]
             [:div#parsets {:ref "parsets-div"}]]]))
  (did-mount [_]
             (let [{:keys [comm parsets-agg]} (om/get-state owner)
                   parsets-div (om/get-node owner "parsets-div")
                   card-width (.-offsetWidth parsets-div)
                   get-svg #(new-svg "#parsets" card-width height)
                   chart #(make-parsets-chart
                           {:height height :width card-width
                            :get-parsets-agg (fn [_] (:parsets-agg (om/get-state owner)))})]
               (.attach js/Waves (om/get-node owner "parsets-div") "waves-yellow")
               (go (while (:continue? (om/get-state owner))
                     (let [parsets-data (<! comm)
                           _ (-> js/d3 (.select "#parsets > svg") .remove)
                           svg (get-svg)]
                       (when (< 0 (count parsets-data))
                         (.log js/console "# parsets aggregation:" (count parsets-data))
                         (-> svg (.datum (clj->js parsets-data))
                             (.call (chart)))
                         (.ripple js/Waves (om/get-node owner "parsets-div"))))))
               ))
  (will-unmount [_]
                (let [{:keys [comm]} (om/get-state owner)]
                  (.log js/console "### unmounting parsets")
                  (close! comm)
                  (om/update-state! owner #(assoc % :continue? false))
                  (om/update-state! owner #(assoc % :svg nil))
                  ))
  )

fix parsets unmounting issue

fix parsets unmounting issue