(ns clj-gatling.core
  (:import [org.joda.time LocalDateTime])
  (:require [clojure-csv.core :as csv]
            [clj-gatling.chart :as chart]
            [clj-gatling.report :as report]
            [clj-gatling.simulation-util :refer [create-dir
                                                 weighted-scenarios
                                                 choose-runner
                                                 timestamp-str]]
            [clj-gatling.simulation :as simulation]))

(def buffer-size 20000)

(defn- gatling-csv-writer [path idx result-lines]
  (let [csv (csv/write-csv result-lines :delimiter "\t" :end-of-line "\n")]
   (spit (str path "/simulation" idx ".log") csv)))

(defn run-simulation [scenarios concurrency & [options]]
  (let [start-time (LocalDateTime.)
        results-dir (str (or (:root options) "target/results")
                         "/"
                         (timestamp-str))
        step-timeout (or (:timeout-in-ms options) 5000)
        result (simulation/run-scenarios {:runner (choose-runner scenarios concurrency options)
                                          :timeout step-timeout
                                          :context (:context options)}
                                         (weighted-scenarios (range concurrency) scenarios))]
    (create-dir (str results-dir "/input"))
    (let [summary (report/create-result-lines start-time
                                              buffer-size
                                              result
                                              (partial gatling-csv-writer (str results-dir "/input")))]
      (chart/create-chart results-dir)
      (println (str "Open " results-dir "/index.html"))
      summary)))

(ns clj-gatling.core
  (:import [org.joda.time LocalDateTime])
  (:require [clojure-csv.core :as csv]
            [clj-gatling.chart :as chart]
            [clj-gatling.report :as report]
            [clj-gatling.simulation-util :refer [create-dir
                                                 weighted-scenarios
                                                 choose-runner
                                                 timestamp-str]]
            [clj-gatling.simulation :as simulation]))

(def buffer-size 20000)

(defn- gatling-csv-writer [path idx result-lines]
  (let [csv (csv/write-csv result-lines :delimiter "\t" :end-of-line "\n")]
   (spit (str path "/simulation" idx ".log") csv)))

(defn- create-results-dir [root]
  (let [results-dir (str root "/" (timestamp-str))]
    (create-dir (str results-dir "/input"))
    results-dir))

(defn run-simulation [scenarios concurrency & [options]]
  (let [start-time (LocalDateTime.)
        results-dir (create-results-dir (or (:root options) "target/results"))
        step-timeout (or (:timeout-in-ms options) 5000)
        result (simulation/run-scenarios {:runner (choose-runner scenarios concurrency options)
                                          :timeout-in-ms step-timeout
                                          :context (:context options)}
                                         (weighted-scenarios (range concurrency) scenarios)
                                         true)]
    (let [summary (report/create-result-lines start-time
                                              buffer-size
                                              result
                                              (partial gatling-csv-writer (str results-dir "/input")))]
      (chart/create-chart results-dir)
      (println (str "Open " results-dir "/index.html"))
      summary)))

(defn run [simulation {:keys [concurrency root timeout-in-ms context requests duration]
                       :or {concurrency 1
                            root "target/results"
                            timeout-in-ms 5000
                            context {}}}]
  (let [start-time (LocalDateTime.)
        results-dir (create-results-dir root)
        result (simulation/run simulation {:concurrency concurrency
                                           :timeout-in-ms timeout-in-ms
                                           :context context
                                           :requests requests
                                           :duration duration})
        summary (report/create-result-lines start-time
                                            buffer-size
                                            result
                                            (partial gatling-csv-writer (str results-dir "/input")))]
    (chart/create-chart results-dir)
    (println (str "Open file://" results-dir "/index.html"))
    summary))

Add main function `run` for executing clj-gatling using new schema


(ns cs95.views
  (:require [re-frame.core :as re-frame]
            [cs95.components.bootstrap :as bs]
            [cs95.components.alert :as alert]
            [cs95.components.frame :as frame]
            [cs95.views.todo :as todo]
            [cs95.views.not-found :as not-found]
            [cs95.views.candy :as candy]
            [cs95.views.landing :as landing]
            [cs95.views.lectures :as lectures]
            [cs95.views.markdown :as markdown])
  (:require-macros [cs95.utils.re-frame :refer [with-subs]]
                   [cs95.utils.helper :refer [slurp-dep]]))

(defmulti panels #(if (coll? %) (first %) %)) ;; identity
(defmethod panels :candy [] [candy/view])
(defmethod panels :home [] [landing/view])
(defmethod panels :syllabus [] [markdown/view (slurp-dep "./doc/syllabus.md")])
(defmethod panels :lectures [] [lectures/view])
(defmethod panels :assignments [] [todo/view])
(defmethod panels :resources [] [markdown/view (slurp-dep "./doc/resources.md")])
(defmethod panels :why-lisp [] [markdown/view (slurp-dep "./doc/why_lisp.md")])
(defmethod panels :default [] [not-found/view])

(def nav-data
  [{:event-key :home :href "#/" :title "Overview"}
   {:event-key :syllabus :href "#/syllabus" :title "Syllabus"}
   {:event-key :lectures :href "#/lectures" :title "Lectures"}
   #_{:event-key :assignments :href "#/assignments" :title "Assignments"}
   {:event-key :resources :href "#/resources" :title "Resources"}
   {:event-key :candy :href "#/candy" :title "Candy"}])

(defn main-panel []
  (with-subs [active-panel [:active-panel]]
    [:div
     [frame/navbar nav-data active-panel]
     [bs/Grid
      [panels active-panel]]]))

(ns cs95.views
  (:require [re-frame.core :as re-frame]
            [cs95.components.bootstrap :as bs]
            [cs95.components.alert :as alert]
            [cs95.components.frame :as frame]
            [cs95.views.todo :as todo]
            [cs95.views.not-found :as not-found]
            [cs95.views.candy :as candy]
            [cs95.views.landing :as landing]
            [cs95.views.lectures :as lectures]
            [cs95.views.markdown :as markdown])
  (:require-macros [cs95.utils.re-frame :refer [with-subs]]
                   [cs95.utils.helper :refer [slurp-dep]]))

(defmulti panels #(if (coll? %) (first %) %)) ;; identity
(defmethod panels :candy [] [candy/view])
(defmethod panels :home [] [landing/view])
(defmethod panels :syllabus [] [markdown/view (slurp-dep "./doc/syllabus.md")])
(defmethod panels :lectures [] [lectures/view])
(defmethod panels :assignments [] [todo/view])
(defmethod panels :resources [] [markdown/view (slurp-dep "./doc/resources.md")])
(defmethod panels :why-lisp [] [markdown/view (slurp-dep "./doc/why_lisp.md")])
(defmethod panels :default [] [not-found/view])

(def nav-data
  [{:event-key :home :href "#/" :title "Overview"}
   {:event-key :syllabus :href "#/syllabus" :title "Syllabus"}
   #_{:event-key :lectures :href "#/lectures" :title "Lectures"}
   #_{:event-key :assignments :href "#/assignments" :title "Assignments"}
   {:event-key :resources :href "#/resources" :title "Resources"}
   {:event-key :candy :href "#/candy" :title "Candy"}])

(defn main-panel []
  (with-subs [active-panel [:active-panel]]
    [:div
     [frame/navbar nav-data active-panel]
     [bs/Grid
      [panels active-panel]]]))

remove lectures temporarily

remove lectures temporarily


{:npm-dev-deps {"shadow-cljs"           "2.11.0"
                "karma"                 "4.4.1"
                "karma-chrome-launcher" "3.1.0"
                "karma-cljs-test"       "0.1.0"
                "karma-junit-reporter"  "2.0.1"}}

{:npm-dev-deps {"shadow-cljs"           "2.11.0"
                "karma"                 "5.1.1"
                "karma-chrome-launcher" "3.1.0"
                "karma-cljs-test"       "0.1.0"
                "karma-junit-reporter"  "2.0.1"}}

Upgrade karma to 5.1.1

Upgrade karma to 5.1.1


(ns constraint.edit
  (:require [constraint.common :refer [edge-id
                                       vert-id]]))

(def vertex-regex (re-pattern (str vert-id ".*")))
(def edge-regex (re-pattern (str edge-id ".*")))

(defn where-svg-was-clicked [event]
  (let [svg-rect (.getBoundingClientRect (dommy.core/sel1 :svg))
        click-position [(.-clientX event) (.-clientY event)]
        rect-position [(.-left svg-rect) (.-top svg-rect)]]
    (map - click-position rect-position)))

(defn move-the-vertex [event world-state]
  (let [moving (:selected world-state)
        position-to-update [:vertices moving 1]
        where (where-svg-was-clicked event)]
    (update-in world-state position-to-update (constantly where))))

(defn get-key [len edge-str]
  (->> edge-str
       (drop len)
       (apply str)
       (js/parseInt)))

(defn largest-key [id coll]
  (let [get-number-part (partial get-key (count id))]
    (-> (map get-number-part (keys coll))
        (sort)
        (reverse)
        (first))))

(defn inc-key [id key-num]
  (str id (inc key-num)))

(defn next-key [id coll]
  (inc-key id (largest-key id coll)))

(defn get-vertex-connections [from to {:keys [edges]}]
  (let [connected-either-way? #{[from to] [to from]}
        get-edge-ends (comp (partial take 2) second)
        connected? (comp connected-either-way? get-edge-ends)]
    (filter connected? edges)))

(defn make-new-edge [from to {:keys [edges]}]
  (let [new-key (next-key edge-id edges)]
    [new-key [from to :red]]))

(def first-connection-id
  (comp first first get-vertex-connections))

(defn add-or-delete-edge [from to world-state]
  (let [connection-id (first-connection-id from to world-state)
        add-new-edge #(conj % (make-new-edge from to world-state))
        delete-edge #(dissoc % connection-id)
        add-or-delete (if (nil? connection-id) add-new-edge delete-edge)]
    (update-in world-state [:edges] add-or-delete)))

(defn cycle-vertex-size [selected world-state]
  (let [cycle-between-sizes #(mod (inc %) 3)
        selected-vertex-size [:vertices selected 0]]
    (update-in world-state
               selected-vertex-size
               cycle-between-sizes)))

(defn edit-vertex-or-connections [clicked-vertex world-state]
  (let [selected (:selected world-state)]
    (if (= selected clicked-vertex)
      (cycle-vertex-size selected world-state)
      (add-or-delete-edge selected clicked-vertex world-state))))

(defn event->class [e]
  (-> e
      (js->clj)
      (.-target)
      (.-className)
      (.-baseVal)))

(defn is-connected? [vertex [_ [from to _]]]
  (or (= vertex from)
      (= vertex to)))

(defn all-edge-ids-connected-to [vertex world-state]
  (let [edges (:edges world-state)
        connected-edges (filter (partial is-connected? vertex) edges)]
    (map first connected-edges)))

(defn dissoc-edge [world-state edge-id]
  (update-in world-state [:edges] #(dissoc % edge-id)))

(defn delete-all-connected [id world-state]
  (reduce
    dissoc-edge
    world-state
    (all-edge-ids-connected-to id world-state)))

(defn delete-vertex [id world-state]
  (let [deleted-edges (delete-all-connected id world-state)]
    (update-in deleted-edges
               [:vertices]
               #(dissoc % id))))

(defn handle-selected [clicked-what event world-state]
  (let [clicked-vertex? (re-matches vertex-regex clicked-what)
        clicked-delete? (= "delete" (event->class event))]
    (cond
      clicked-delete? (delete-vertex clicked-what world-state )
      clicked-vertex? (edit-vertex-or-connections clicked-what world-state)
      :else (move-the-vertex event world-state))))

(defn select-vertex [world-state clicked-vertex]
  (merge world-state {:selected clicked-vertex}))

(defn toggle-edge-value [world-state clicked-edge]
  (let [clicked-edge-color [:edges clicked-edge 2]
        toggle-color {:red :blue :blue :red}]
    (update-in world-state clicked-edge-color toggle-color)))

(defn make-new-vertex [where {:keys [vertices]}]
  (let [new-key (next-key vert-id vertices)]
    [new-key [1 where]]))

(defn add-vertex [event world-state]
  (let [where (where-svg-was-clicked event)
        new-vertex (make-new-vertex where world-state)
        add-the-new #(conj % new-vertex)]
    (update-in world-state [:vertices] add-the-new)))

(defn is-ctrl+click? [event]
  (-> event
      (js->clj)
      (.-ctrlKey)))

(defn cycle-player-no-nils [p]
  (mod (inc p) 3))

(def cycle-player (fnil cycle-player-no-nils 0))

(defn cycle-edge-player [world-state clicked-what]
  (let [selected-edge-player [:edges clicked-what 3]]
    (update-in world-state selected-edge-player cycle-player)))

(defn handle-unslected [clicked-what event world-state]
  (let [clicked-edge? (re-matches edge-regex clicked-what)
        clicked-vertex? (re-matches vertex-regex clicked-what)
        ctrl? (is-ctrl+click? event)
        ctrl+clicked-edge? (and ctrl? clicked-edge?)
        ctrl+clicked-vertex? (and ctrl? clicked-vertex?)]
    (cond
      ctrl+clicked-edge? (cycle-edge-player world-state clicked-what)
      ctrl+clicked-vertex? (delete-vertex clicked-what world-state)
      clicked-edge? (toggle-edge-value world-state clicked-what)
      clicked-vertex? (select-vertex world-state clicked-what)
      :else (add-vertex event world-state))))

(defn handle-editing [clicked-what event world-state]
  (let [unselect #(merge % {:selected nil})]
    (if (:selected world-state)
      (unselect (handle-selected clicked-what event world-state))
      (handle-unslected clicked-what event world-state))))

(ns constraint.edit
  (:require [constraint.common :refer [edge-id
                                       vert-id]]))

(def vertex-regex (re-pattern (str vert-id ".*")))
(def edge-regex (re-pattern (str edge-id ".*")))

(defn where-svg-was-clicked [event]
  (let [svg-rect (.getBoundingClientRect (dommy.core/sel1 :svg))
        click-position [(.-clientX event) (.-clientY event)]
        rect-position [(.-left svg-rect) (.-top svg-rect)]]
    (map - click-position rect-position)))

(defn move-the-vertex [event world-state]
  (let [moving (:selected world-state)
        position-to-update [:vertices moving 1]
        where (where-svg-was-clicked event)]
    (update-in world-state position-to-update (constantly where))))

(defn get-key [len edge-str]
  (->> edge-str
       (drop len)
       (apply str)
       (js/parseInt)))

(defn largest-key [id coll]
  (let [get-number-part (partial get-key (count id))]
    (-> (map get-number-part (keys coll))
        (sort)
        (reverse)
        (first))))

(defn inc-key [id key-num]
  (str id (inc key-num)))

(defn next-key [id coll]
  (inc-key id (largest-key id coll)))

(defn get-vertex-connections [from to {:keys [edges]}]
  (let [connected-either-way? #{[from to] [to from]}
        get-edge-ends (comp (partial take 2) second)
        connected? (comp connected-either-way? get-edge-ends)]
    (filter connected? edges)))

(defn make-new-edge [from to {:keys [edges]}]
  (let [new-key (next-key edge-id edges)]
    [new-key [from to :red]]))

(def first-connection-id
  (comp first first get-vertex-connections))

(defn add-or-delete-edge [from to world-state]
  (let [connection-id (first-connection-id from to world-state)
        add-new-edge #(conj % (make-new-edge from to world-state))
        delete-edge #(dissoc % connection-id)
        add-or-delete (if (nil? connection-id) add-new-edge delete-edge)]
    (update-in world-state [:edges] add-or-delete)))

(defn cycle-vertex-size [selected world-state]
  (let [cycle-between-sizes #(mod (inc %) 3)
        selected-vertex-size [:vertices selected 0]]
    (update-in world-state
               selected-vertex-size
               cycle-between-sizes)))

(defn edit-vertex-or-connections [clicked-vertex world-state]
  (let [selected (:selected world-state)]
    (if (= selected clicked-vertex)
      (cycle-vertex-size selected world-state)
      (add-or-delete-edge selected clicked-vertex world-state))))

(defn event->class [e]
  (.item (-> e
             (js->clj)
             (.-target)
             (.-classList)) 0))

(defn is-connected? [vertex [_ [from to _]]]
  (or (= vertex from)
      (= vertex to)))

(defn all-edge-ids-connected-to [vertex world-state]
  (let [edges (:edges world-state)
        connected-edges (filter (partial is-connected? vertex) edges)]
    (map first connected-edges)))

(defn dissoc-edge [world-state edge-id]
  (update-in world-state [:edges] #(dissoc % edge-id)))

(defn delete-all-connected [id world-state]
  (reduce
    dissoc-edge
    world-state
    (all-edge-ids-connected-to id world-state)))

(defn delete-vertex [id world-state]
  (let [deleted-edges (delete-all-connected id world-state)]
    (update-in deleted-edges
               [:vertices]
               #(dissoc % id))))

(defn handle-selected [clicked-what event world-state]
  (let [clicked-vertex? (re-matches vertex-regex clicked-what)
        clicked-delete? (= "delete" (event->class event))]
    (cond
      clicked-delete? (delete-vertex clicked-what world-state )
      clicked-vertex? (edit-vertex-or-connections clicked-what world-state)
      :else (move-the-vertex event world-state))))

(defn select-vertex [world-state clicked-vertex]
  (merge world-state {:selected clicked-vertex}))

(defn toggle-edge-value [world-state clicked-edge]
  (let [clicked-edge-color [:edges clicked-edge 2]
        toggle-color {:red :blue :blue :red}]
    (update-in world-state clicked-edge-color toggle-color)))

(defn make-new-vertex [where {:keys [vertices]}]
  (let [new-key (next-key vert-id vertices)]
    [new-key [1 where]]))

(defn add-vertex [event world-state]
  (let [where (where-svg-was-clicked event)
        new-vertex (make-new-vertex where world-state)
        add-the-new #(conj % new-vertex)]
    (update-in world-state [:vertices] add-the-new)))

(defn is-ctrl+click? [event]
  (-> event
      (js->clj)
      (.-ctrlKey)))

(defn cycle-player-no-nils [p]
  (mod (inc p) 3))

(def cycle-player (fnil cycle-player-no-nils 0))

(defn cycle-edge-player [world-state clicked-what]
  (let [selected-edge-player [:edges clicked-what 3]]
    (update-in world-state selected-edge-player cycle-player)))

(defn handle-unslected [clicked-what event world-state]
  (let [clicked-edge? (re-matches edge-regex clicked-what)
        clicked-vertex? (re-matches vertex-regex clicked-what)
        ctrl? (is-ctrl+click? event)
        ctrl+clicked-edge? (and ctrl? clicked-edge?)
        ctrl+clicked-vertex? (and ctrl? clicked-vertex?)]
    (cond
      ctrl+clicked-edge? (cycle-edge-player world-state clicked-what)
      ctrl+clicked-vertex? (delete-vertex clicked-what world-state)
      clicked-edge? (toggle-edge-value world-state clicked-what)
      clicked-vertex? (select-vertex world-state clicked-what)
      :else (add-vertex event world-state))))

(defn handle-editing [clicked-what event world-state]
  (let [unselect #(merge % {:selected nil})]
    (if (:selected world-state)
      (unselect (handle-selected clicked-what event world-state))
      (handle-unslected clicked-what event world-state))))

Fix production not finding the clicked event class


(ns hatti.views.dataview-test
  (:require-macros [cljs.test :refer (is deftest testing)]
                   [dommy.macros :refer [sel1]])
  (:require [cljs.test :as t]
            [dommy.core :as dommy]
            [hatti.shared :as shared]
            [hatti.views :refer [tabbed-dataview]]
            [hatti.test-utils :refer [big-thin-data
                                      data-gen
                                      format
                                      new-container!
                                      thin-form]]
            [om.core :as om :include-macros true]))

;; INITIAL STATE TESTS
(deftest initial-state
  (let [_ (shared/update-app-data! shared/app-state big-thin-data :rerank? true)
        data-100 (get-in @shared/app-state [:data])
        dget (fn [k d] (map #(get % k) d))]
    (testing "data is initialized properly"
      (is (= (-> data-100 first count) (-> big-thin-data first count)))
      (is (= 100 (count data-100))))
    (testing "data has correct _rank attributes"
      (is (= (dget "_rank" data-100) (map inc (range 100)))))
    (testing "data is in sorted order by _submission_time"
      (let [test-dates (map #(.format (js/moment %))
                            ["2012-01-01" "2013-01-01" "2011-01-01"])
            s100 (map #(.format (js/moment %))
                      (dget "_submission_time" data-100))]
        (is (= (sort test-dates) (conj (take 2 test-dates) (last test-dates))))
        (is (= s100 (sort s100)))))))

;;TABBED DATAVIEW TESTS
(defn- tabbed-dataview-container
  [app-state]
  (let [c (new-container!)
        _ (om/root tabbed-dataview
                   app-state
                   {:shared {:flat-form thin-form
                             :project-id "1"
                             :project-name "Project"
                             :dataset-id "2"
                             :username "user"
                             :view-type :default}
                    :target c})]
    c))

(deftest tabbed-dataview-tests
  (let [tabbed-view (tabbed-dataview-container shared/app-state)]
    (testing "All tabs are rendered when none is disabled"
      (is (re-find #"inactive" (dommy/html tabbed-view))))))

(ns hatti.views.dataview-test
  (:require-macros [cljs.test :refer (is deftest testing)]
                   [dommy.macros :refer [sel1]])
  (:require [cljs.test :as t]
            [dommy.core :as dommy]
            [hatti.shared :as shared]
            [hatti.views :refer [tabbed-dataview]]
            [hatti.test-utils :refer [big-thin-data
                                      data-gen
                                      format
                                      new-container!
                                      thin-form]]
            [om.core :as om :include-macros true]))

;; INITIAL STATE TESTS
(deftest initial-state
  (let [_ (shared/update-app-data! shared/app-state big-thin-data :rerank? true)
        data-100 (get-in @shared/app-state [:data])
        dget (fn [k d] (map #(get % k) d))]
    (testing "data is initialized properly"
      (is (= (-> data-100 first count) (-> big-thin-data first count)))
      (is (= 100 (count data-100))))
    (testing "data has correct _rank attributes"
      (is (= (dget "_rank" data-100) (map inc (range 100)))))
    (testing "data is in sorted order by _submission_time"
      (let [test-dates (map #(.format (js/moment %))
                            ["2012-01-01" "2013-01-01" "2011-01-01"])
            s100 (map #(.format (js/moment %))
                      (dget "_submission_time" data-100))]
        (is (= (sort test-dates) (conj (take 2 test-dates) (last test-dates))))
        (is (= s100 (sort s100)))))))

;;TABBED DATAVIEW TESTS
(defn- tabbed-dataview-container
  [app-state]
  (let [c (new-container!)
        _ (om/root tabbed-dataview
                   app-state
                   {:shared {:flat-form thin-form
                             :project-id "1"
                             :project-name "Project"
                             :dataset-id "2"
                             :username "user"
                             :view-type :default}
                    :target c})]
    c))

(deftest tabbed-dataview-tests
  (let [tabbed-view (tabbed-dataview-container shared/app-state)]
    (testing "Map tab is not rendered when there is no geodata"
      (is (= "map"
             (-> tabbed-view (sel1 :div.tab-bar) (sel1 :.inactive) (dommy/html)))))
    #_(testing "Map, Chart and Table tabs are disabled"
      (let [_ (shared/transact-app-state! shared/app-state
                                                [:views :disabled]
                                                [:map :chart :table])
            tabbed-view (tabbed-dataview-container shared/app-state)]
        (is (= "map chart table"
               (-> tabbed-view (sel1 :div.tab-bar) (sel1 :.inactive) (dommy/html))))))))

Add inactive tab test

GM: Add inactive tab test


(ns onyx.peer.fn-grouping-test
  (:require [clojure.core.async :refer [chan >!! <!! close! sliding-buffer]]
            [midje.sweet :refer :all]
            [onyx.peer.task-lifecycle-extensions :as l-ext]
            [onyx.plugin.core-async :refer [take-segments!]]
            [onyx.api]))

(def id (java.util.UUID/randomUUID))

(def config (read-string (slurp (clojure.java.io/resource "test-config.edn"))))

(def env-config (assoc (:env-config config) :onyx/id id))

(def peer-config
  (assoc (:peer-config config)
    :onyx/id id
    :onyx.peer/job-scheduler :onyx.job-scheduler/round-robin))

(def env (onyx.api/start-env env-config))

(def output (atom []))

(def in-chan (chan 1000000))

(def out-chan (chan (sliding-buffer 1000000)))

(defmethod l-ext/inject-lifecycle-resources :in
  [_ _] {:core.async/chan in-chan})

(defmethod l-ext/inject-lifecycle-resources :out
  [_ _] {:core.async/chan out-chan})

(defmethod l-ext/inject-lifecycle-resources
  :onyx.peer.fn-grouping-test/sum-balance
  [_ event]
  (let [balance (atom {})]
    {:onyx.core/params [balance]
     :test/balance balance}))

(defmethod l-ext/close-lifecycle-resources
  :onyx.peer.fn-grouping-test/sum-balance
  [_ {:keys [test/balance]}]
  (swap! output conj @balance)
  {})

(defn sum-balance [state {:keys [name amount] :as segment}]
  (swap! state (fn [v] (assoc v name (+ (get v name 0) amount))))
  [])

(defn group-by-name [{:keys [name]}]
  name)

(def workflow
  [[:in :sum-balance]
   [:sum-balance :out]])

(def catalog
  [{:onyx/name :in
    :onyx/ident :core.async/read-from-chan
    :onyx/type :input
    :onyx/medium :core.async
    :onyx/batch-size 40
    :onyx/max-peers 1
    :onyx/doc "Reads segments from a core.async channel"}

   {:onyx/name :sum-balance
    :onyx/ident :onyx.peer.fn-grouping-test/sum-balance
    :onyx/fn :onyx.peer.fn-grouping-test/sum-balance
    :onyx/type :function
    :onyx/group-by-fn :onyx.peer.fn-grouping-test/group-by-name
    :onyx/batch-size 40}

   {:onyx/name :out
    :onyx/ident :core.async/write-to-chan
    :onyx/type :output
    :onyx/medium :core.async
    :onyx/batch-size 40
    :onyx/max-peers 1
    :onyx/doc "Writes segments to a core.async channel"}])

(def size 3000)

(def data
  (concat
   (map (fn [_] {:name "Mike" :amount 10}) (range size))
   (map (fn [_] {:name "Dorrene" :amount 10}) (range size))
   (map (fn [_] {:name "Benti" :amount 10}) (range size))
   (map (fn [_] {:name "John" :amount 10}) (range size))
   (map (fn [_] {:name "Shannon" :amount 10}) (range size))
   (map (fn [_] {:name "Kristen" :amount 10}) (range size))
   (map (fn [_] {:name "Benti" :amount 10}) (range size))
   (map (fn [_] {:name "Mike" :amount 10}) (range size))
   (map (fn [_] {:name "Steven" :amount 10}) (range size))
   (map (fn [_] {:name "Dorrene" :amount 10}) (range size))
   (map (fn [_] {:name "John" :amount 10}) (range size))
   (map (fn [_] {:name "Shannon" :amount 10}) (range size))
   (map (fn [_] {:name "Santana" :amount 10}) (range size))
   (map (fn [_] {:name "Roselyn" :amount 10}) (range size))
   (map (fn [_] {:name "Krista" :amount 10}) (range size))
   (map (fn [_] {:name "Starla" :amount 10}) (range size))
   (map (fn [_] {:name "Derick" :amount 10}) (range size))
   (map (fn [_] {:name "Orlando" :amount 10}) (range size))
   (map (fn [_] {:name "Rupert" :amount 10}) (range size))
   (map (fn [_] {:name "Kareem" :amount 10}) (range size))
   (map (fn [_] {:name "Lesli" :amount 10}) (range size))
   (map (fn [_] {:name "Carol" :amount 10}) (range size))
   (map (fn [_] {:name "Willie" :amount 10}) (range size))
   (map (fn [_] {:name "Noriko" :amount 10}) (range size))
   (map (fn [_] {:name "Corine" :amount 10}) (range size))
   (map (fn [_] {:name "Leandra" :amount 10}) (range size))
   (map (fn [_] {:name "Chadwick" :amount 10}) (range size))
   (map (fn [_] {:name "Teressa" :amount 10}) (range size))
   (map (fn [_] {:name "Tijuana" :amount 10}) (range size))
   (map (fn [_] {:name "Verna" :amount 10}) (range size))
   (map (fn [_] {:name "Alona" :amount 10}) (range size))
   (map (fn [_] {:name "Wilson" :amount 10}) (range size))
   (map (fn [_] {:name "Carly" :amount 10}) (range size))
   (map (fn [_] {:name "Nubia" :amount 10}) (range size))
   (map (fn [_] {:name "Hollie" :amount 10}) (range size))
   (map (fn [_] {:name "Allison" :amount 10}) (range size))
   (map (fn [_] {:name "Edwin" :amount 10}) (range size))
   (map (fn [_] {:name "Zola" :amount 10}) (range size))
   (map (fn [_] {:name "Britany" :amount 10}) (range size))
   (map (fn [_] {:name "Courtney" :amount 10}) (range size))
   (map (fn [_] {:name "Mathew" :amount 10}) (range size))
   (map (fn [_] {:name "Luz" :amount 10}) (range size))
   (map (fn [_] {:name "Tyesha" :amount 10}) (range size))
   (map (fn [_] {:name "Eusebia" :amount 10}) (range size))
   (map (fn [_] {:name "Fletcher" :amount 10}) (range size))))

(doseq [x data]
  (>!! in-chan x))

(>!! in-chan :done)
(close! in-chan)

(def v-peers (onyx.api/start-peers 3 peer-config))

(onyx.api/submit-job
 peer-config
 {:catalog catalog :workflow workflow
  :task-scheduler :onyx.task-scheduler/round-robin})

(def results (take-segments! out-chan))

(def out-val @output)

;;; Scan the key set, dropping any nils. Count the distinct keys.
;;; Do the same for the right hand side of the expression, but turn it into a set.
;;; If there's the same number of elements, then the grouping was mutually exclusive.
(fact (count (filter identity (mapcat keys out-val))) =>
      (count (into #{} (filter identity (mapcat keys out-val)))))

(fact results => [:done])

(doseq [v-peer v-peers]
  (onyx.api/shutdown-peer v-peer))

(onyx.api/shutdown-env env)

(ns onyx.peer.fn-grouping-test
  (:require [clojure.core.async :refer [chan >!! <!! close! sliding-buffer]]
            [midje.sweet :refer :all]
            [onyx.peer.task-lifecycle-extensions :as l-ext]
            [onyx.plugin.core-async :refer [take-segments!]]
            [onyx.api]))

(def id (java.util.UUID/randomUUID))

(def config (read-string (slurp (clojure.java.io/resource "test-config.edn"))))

(def env-config (assoc (:env-config config) :onyx/id id))

(def peer-config
  (assoc (:peer-config config)
    :onyx/id id
    :onyx.peer/job-scheduler :onyx.job-scheduler/round-robin))

(def env (onyx.api/start-env env-config))

(def peer-group (onyx.api/start-peer-group peer-config))

(def output (atom []))

(def in-chan (chan 1000000))

(def out-chan (chan (sliding-buffer 1000000)))

(defmethod l-ext/inject-lifecycle-resources :in
  [_ _] {:core.async/chan in-chan})

(defmethod l-ext/inject-lifecycle-resources :out
  [_ _] {:core.async/chan out-chan})

(defmethod l-ext/inject-lifecycle-resources
  :onyx.peer.fn-grouping-test/sum-balance
  [_ event]
  (let [balance (atom {})]
    {:onyx.core/params [balance]
     :test/balance balance}))

(defmethod l-ext/close-lifecycle-resources
  :onyx.peer.fn-grouping-test/sum-balance
  [_ {:keys [test/balance]}]
  (swap! output conj @balance)
  {})

(defn sum-balance [state {:keys [name amount] :as segment}]
  (swap! state (fn [v] (assoc v name (+ (get v name 0) amount))))
  [])

(defn group-by-name [{:keys [name]}]
  name)

(def workflow
  [[:in :sum-balance]
   [:sum-balance :out]])

(def catalog
  [{:onyx/name :in
    :onyx/ident :core.async/read-from-chan
    :onyx/type :input
    :onyx/medium :core.async
    :onyx/batch-size 40
    :onyx/max-peers 1
    :onyx/doc "Reads segments from a core.async channel"}

   {:onyx/name :sum-balance
    :onyx/ident :onyx.peer.fn-grouping-test/sum-balance
    :onyx/fn :onyx.peer.fn-grouping-test/sum-balance
    :onyx/type :function
    :onyx/group-by-fn :onyx.peer.fn-grouping-test/group-by-name
    :onyx/batch-size 40}

   {:onyx/name :out
    :onyx/ident :core.async/write-to-chan
    :onyx/type :output
    :onyx/medium :core.async
    :onyx/batch-size 40
    :onyx/max-peers 1
    :onyx/doc "Writes segments to a core.async channel"}])

(def size 3000)

(def data
  (concat
   (map (fn [_] {:name "Mike" :amount 10}) (range size))
   (map (fn [_] {:name "Dorrene" :amount 10}) (range size))
   (map (fn [_] {:name "Benti" :amount 10}) (range size))
   (map (fn [_] {:name "John" :amount 10}) (range size))
   (map (fn [_] {:name "Shannon" :amount 10}) (range size))
   (map (fn [_] {:name "Kristen" :amount 10}) (range size))
   (map (fn [_] {:name "Benti" :amount 10}) (range size))
   (map (fn [_] {:name "Mike" :amount 10}) (range size))
   (map (fn [_] {:name "Steven" :amount 10}) (range size))
   (map (fn [_] {:name "Dorrene" :amount 10}) (range size))
   (map (fn [_] {:name "John" :amount 10}) (range size))
   (map (fn [_] {:name "Shannon" :amount 10}) (range size))
   (map (fn [_] {:name "Santana" :amount 10}) (range size))
   (map (fn [_] {:name "Roselyn" :amount 10}) (range size))
   (map (fn [_] {:name "Krista" :amount 10}) (range size))
   (map (fn [_] {:name "Starla" :amount 10}) (range size))
   (map (fn [_] {:name "Derick" :amount 10}) (range size))
   (map (fn [_] {:name "Orlando" :amount 10}) (range size))
   (map (fn [_] {:name "Rupert" :amount 10}) (range size))
   (map (fn [_] {:name "Kareem" :amount 10}) (range size))
   (map (fn [_] {:name "Lesli" :amount 10}) (range size))
   (map (fn [_] {:name "Carol" :amount 10}) (range size))
   (map (fn [_] {:name "Willie" :amount 10}) (range size))
   (map (fn [_] {:name "Noriko" :amount 10}) (range size))
   (map (fn [_] {:name "Corine" :amount 10}) (range size))
   (map (fn [_] {:name "Leandra" :amount 10}) (range size))
   (map (fn [_] {:name "Chadwick" :amount 10}) (range size))
   (map (fn [_] {:name "Teressa" :amount 10}) (range size))
   (map (fn [_] {:name "Tijuana" :amount 10}) (range size))
   (map (fn [_] {:name "Verna" :amount 10}) (range size))
   (map (fn [_] {:name "Alona" :amount 10}) (range size))
   (map (fn [_] {:name "Wilson" :amount 10}) (range size))
   (map (fn [_] {:name "Carly" :amount 10}) (range size))
   (map (fn [_] {:name "Nubia" :amount 10}) (range size))
   (map (fn [_] {:name "Hollie" :amount 10}) (range size))
   (map (fn [_] {:name "Allison" :amount 10}) (range size))
   (map (fn [_] {:name "Edwin" :amount 10}) (range size))
   (map (fn [_] {:name "Zola" :amount 10}) (range size))
   (map (fn [_] {:name "Britany" :amount 10}) (range size))
   (map (fn [_] {:name "Courtney" :amount 10}) (range size))
   (map (fn [_] {:name "Mathew" :amount 10}) (range size))
   (map (fn [_] {:name "Luz" :amount 10}) (range size))
   (map (fn [_] {:name "Tyesha" :amount 10}) (range size))
   (map (fn [_] {:name "Eusebia" :amount 10}) (range size))
   (map (fn [_] {:name "Fletcher" :amount 10}) (range size))))

(doseq [x data]
  (>!! in-chan x))

(>!! in-chan :done)
(close! in-chan)

(def v-peers (onyx.api/start-peers 3 peer-group))

(onyx.api/submit-job
 peer-config
 {:catalog catalog :workflow workflow
  :task-scheduler :onyx.task-scheduler/round-robin})

(def results (take-segments! out-chan))

(def out-val @output)

;;; Scan the key set, dropping any nils. Count the distinct keys.
;;; Do the same for the right hand side of the expression, but turn it into a set.
;;; If there's the same number of elements, then the grouping was mutually exclusive.
(fact (count (filter identity (mapcat keys out-val))) =>
      (count (into #{} (filter identity (mapcat keys out-val)))))

(fact results => [:done])

(doseq [v-peer v-peers]
  (onyx.api/shutdown-peer v-peer))

(onyx.api/shutdown-peer-group peer-group)

(onyx.api/shutdown-env env)

Use peer group

Use peer group


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at https://mozilla.org/MPL/2.0/

(ns org.akvo.resumed
  (:require [clojure.string :as str]
            [clojure.java.io :as io])
  (:import [java.io File FileOutputStream ByteArrayOutputStream]
           java.util.UUID
           javax.xml.bind.DatatypeConverter))

(def tus-headers
  {"Tus-Resumable" "1.0.0"
   "Tus-Version" "1.0.0"
   "Tus-Extension" "creation"
   "Tus-Max-Size" (str (* 1024 1024 50))})

(defonce current-uploads (atom {}))

(defn gen-id []
  (.replaceAll (str (UUID/randomUUID)) "-" ""))

(defn default-headers []
  tus-headers)

(defn options-headers []
  (select-keys tus-headers ["Tus-Version" "Tus-Extension" "Tus-Max-Size"]))

(defn get-header [req header]
  (get-in req [:headers (.toLowerCase ^String header)]))

(defn to-number
  "Returns a numeric representation of a String.
  Returns -1 on unparseable String, blank or nil"
  [s]
  (if (not (str/blank? s))
    (try
      (Long/valueOf ^String s)
      (catch Exception _
        -1))
    -1))

(defmulti handle-request
  (fn [req opts]
    (:request-method req)))

(defmethod handle-request :default
  [req opts]
  {:status 400})

(defmethod handle-request :options
  [req opts]
  {:status 204
   :headers (options-headers)})

(defmethod handle-request :head
  [req opts]
  (let [upload-id (last (str/split (:uri req) #"/"))]
    (if-let [found (@current-uploads upload-id)]
      {:status 200
       :headers (assoc tus-headers
                       "Upload-Offset" (str (:offset found))
                       "Upload-Length" (str (:length found))
                       "Upload-Metadata" (:metadata found))}
      {:status 404
       :body "Not Found"})))

(defn patch
  [req opts]
  (let [id (last (str/split (:uri req) #"/"))
        found (@current-uploads id)]
    (if found
      (let [len (-> req (get-header "content-length") to-number)
            off (-> req (get-header "upload-offset") to-number)
            ct (get-header req "content-type")]
        (if (not= "application/offset+octet-stream" ct)
          {:status 400 ;; FIXME: is this the right code?
           :body "Bad request"}
          (if (not= (:offset found) off)
            {:status 409
             :body "Conflict"}
            (with-open [tmp (ByteArrayOutputStream.)
                        fos (FileOutputStream. ^String (:file found) true)]
              (io/copy (:body req) tmp)
              (.write fos (.toByteArray tmp))
              (swap! current-uploads update-in [id :offset] + len)
              {:status 204
               :headers (assoc tus-headers
                               "Upload-Offset" (str (:offset (@current-uploads id))))}))))
      {:status 404
       :body "Not Found"})))

(defmethod handle-request :patch
  [req opts]
  (patch req opts))

(defn get-filename
  "Returns a file name decoding a base64 string of
  Upload-Metadata header.
  Attribution: http://stackoverflow.com/a/2054226"
  [s]
  (when-not (str/blank? s)
    (let [m (->> (str/split s #",")
                 (map #(str/split % #" "))
                 (into {}))]
      (when (contains? m "filename")
        (-> (m "filename")
            (DatatypeConverter/parseBase64Binary)
            (String.))))))

(defn get-location
  "Get Location string from request"
  [req]
  (format "%s://%s%s%s"
          (name (:scheme req))
          (:server-name req)
          (if (and (not= (:server-port req) 80)
                   (not= (:server-port req) 443))
            (str ":" (:server-port req))
            "")
          (:uri req)))

(defn post
  [req opts]
  (let [len (-> req (get-header "upload-length") to-number)]
    (if (> len (to-number (tus-headers "Tus-Max-Size")))
      {:status 413
       :body "Request Entity Loo Large"}
      (let [id (gen-id)
            um (get-header req "upload-metadata")
            fname (or (get-filename um)  "file")
            fpath (str (:save-path opts) "/" id)
            f (str fpath "/" fname)]
        (swap! current-uploads assoc id {:offset 0 :file f :length len :metadata um})
        (.mkdirs (File. fpath))
        (.createNewFile (File. f))
        {:status 201
         :headers {"Location" (str (get-location req) "/" id)
                   "Upload-Length" (str len) ;FIXME: potentially -1
                   "Upload-Metadata" um      ;FIXME: potentially ""
                   }}))))

(defmethod handle-request :post
  [req opts]
  (let [method-override (get-header req "x-http-method-override")]
    (if (= method-override "PATCH")
      (patch req opts)
      (post req opts))))

(defn make-handler
  "Returns a ring handler capable of responding to client requests from
  a `tus` client. An optional map with configuration can be used
  {:save-dir \"/path/to/save/dir\"} defaults to `java.io.tmpdir`"
  [& [opts]]
  (let [save-dir (or (:save-dir opts)
                     (System/getProperty "java.io.tmpdir"))
        save-path (File. (str save-dir "/resumed"))]
    (.mkdirs save-path)
    (fn [req]
      (handle-request req (assoc opts :save-path (str save-path))))))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at https://mozilla.org/MPL/2.0/

(ns org.akvo.resumed
  (:require [clojure.string :as str]
            [clojure.java.io :as io])
  (:import [java.io File FileOutputStream ByteArrayOutputStream]
           java.util.UUID
           javax.xml.bind.DatatypeConverter))

(def tus-headers
  {"Tus-Resumable" "1.0.0"
   "Tus-Version" "1.0.0"
   "Tus-Extension" "creation"
   "Tus-Max-Size" (str (* 1024 1024 50))})

(defonce current-uploads (atom {}))

(defn gen-id []
  (.replaceAll (str (UUID/randomUUID)) "-" ""))

(defn default-headers []
  tus-headers)

(defn options-headers []
  (select-keys tus-headers ["Tus-Version" "Tus-Extension" "Tus-Max-Size"]))

(defn get-header [req header]
  (get-in req [:headers (.toLowerCase ^String header)]))

(defn to-number
  "Returns a numeric representation of a String.
  Returns -1 on unparseable String, blank or nil"
  [s]
  (if (not (str/blank? s))
    (try
      (Long/valueOf ^String s)
      (catch Exception _
        -1))
    -1))

(defmulti handle-request
  (fn [req opts]
    (:request-method req)))

(defmethod handle-request :default
  [req opts]
  {:status 400})

(defmethod handle-request :options
  [req opts]
  {:status 204
   :headers (options-headers)})

(defmethod handle-request :head
  [req opts]
  (let [upload-id (last (str/split (:uri req) #"/"))]
    (if-let [found (@current-uploads upload-id)]
      {:status 200
       :headers (assoc tus-headers
                       "Upload-Offset" (str (:offset found))
                       "Upload-Length" (str (:length found))
                       "Upload-Metadata" (:metadata found))}
      {:status 404
       :body "Not Found"})))

(defn patch
  [req opts]
  (let [id (last (str/split (:uri req) #"/"))
        found (@current-uploads id)]
    (if found
      (let [len (-> req (get-header "content-length") to-number)
            off (-> req (get-header "upload-offset") to-number)
            ct (get-header req "content-type")]
        (if (not= "application/offset+octet-stream" ct)
          {:status 400 ;; FIXME: is this the right code?
           :body "Bad request"}
          (if (not= (:offset found) off)
            {:status 409
             :body "Conflict"}
            (with-open [tmp (ByteArrayOutputStream.)
                        fos (FileOutputStream. ^String (:file found) true)]
              (io/copy (:body req) tmp)
              (.write fos (.toByteArray tmp))
              (swap! current-uploads update-in [id :offset] + len)
              {:status 204
               :headers (assoc tus-headers
                               "Upload-Offset" (str (:offset (@current-uploads id))))}))))
      {:status 404
       :body "Not Found"})))

(defmethod handle-request :patch
  [req opts]
  (patch req opts))

(defn get-filename
  "Returns a file name decoding a base64 string of
  Upload-Metadata header.
  Attribution: http://stackoverflow.com/a/2054226"
  [s]
  (when-not (str/blank? s)
    (let [m (->> (str/split s #",")
                 (map #(str/split % #" "))
                 (into {}))]
      (when (contains? m "filename")
        (-> (m "filename")
            (DatatypeConverter/parseBase64Binary)
            (String.))))))

(defn get-location
  "Get Location string from request"
  [req]
  (let [origin (get-in req [:headers "origin"])]
    (if (not (str/blank? origin))
      (format "%s%s" origin (:uri req))
      (format "%s://%s%s%s"
              (name (:scheme req))
              (:server-name req)
              (if (and (not= (:server-port req) 80)
                       (not= (:server-port req) 443))
                (str ":" (:server-port req))
                "")
              (:uri req)))))

(defn post
  [req opts]
  (let [len (-> req (get-header "upload-length") to-number)]
    (if (> len (to-number (tus-headers "Tus-Max-Size")))
      {:status 413
       :body "Request Entity Loo Large"}
      (let [id (gen-id)
            um (get-header req "upload-metadata")
            fname (or (get-filename um)  "file")
            fpath (str (:save-path opts) "/" id)
            f (str fpath "/" fname)]
        (swap! current-uploads assoc id {:offset 0 :file f :length len :metadata um})
        (.mkdirs (File. fpath))
        (.createNewFile (File. f))
        {:status 201
         :headers {"Location" (str (get-location req) "/" id)
                   "Upload-Length" (str len) ;FIXME: potentially -1
                   "Upload-Metadata" um      ;FIXME: potentially ""
                   }}))))

(defmethod handle-request :post
  [req opts]
  (let [method-override (get-header req "x-http-method-override")]
    (if (= method-override "PATCH")
      (patch req opts)
      (post req opts))))

(defn make-handler
  "Returns a ring handler capable of responding to client requests from
  a `tus` client. An optional map with configuration can be used
  {:save-dir \"/path/to/save/dir\"} defaults to `java.io.tmpdir`"
  [& [opts]]
  (let [save-dir (or (:save-dir opts)
                     (System/getProperty "java.io.tmpdir"))
        save-path (File. (str save-dir "/resumed"))]
    (.mkdirs save-path)
    (fn [req]
      (handle-request req (assoc opts :save-path (str save-path))))))

Use origin header if present for building the location url


(ns overtone.sc.node
  (:require
    [overtone.log :as log])
  (:use
    [overtone util event deps]
    [overtone.sc core allocator bus]))

;; ## Node and Group Management

;; Synths, Busses, Controls and Groups are all Nodes.  Groups are linked lists
;; and group zero is the root of the graph.  Nodes can be added to a group in
;; one of these 5 positions relative to either the full list, or a specified node.

(def POSITION
  {:head         0
   :tail         1
   :before       2
   :after        3
   :replace      4})

(defn- bus->id
  "if val is a bus, return its ref id otherwise return val"
  [val]
  (if (bus? val)
    (:id val)
    val))

(defn- map-and-check-node-args
  [arg-map]
  (let [name-fn (fn [name]
                  (let [name (to-str name)]
                    (when (not (string? name))
                      (throw (Exception. (str "Incorrect arg. Was expecting a string and found " name ". Full arg map: " arg-map))))
                    name))
        val-fn (fn [val]
                 (let [val (bus->id val)
                       val (to-float val)]
                   (when (not (float? val))
                     (throw (Exception. (str "Incorrect arg. Was expecting a float and found " val ". Full arg map: " arg-map))))
                   val))]

    (zipmap (map name-fn (keys arg-map))
            (map val-fn (vals arg-map)))))

;; ### Node
;;
;; A Node is an addressable node in a tree of nodes run by the synth engine.
;; There are two types, Synths and Groups. The tree defines the order of
;; execution of all Synths. All nodes have an integer ID.

;; Sending a synth-id of -1 lets the server choose an ID
(defn node
  "Instantiate a synth node on the audio server.  Takes the synth name and a
  map of argument name/value pairs.  Optionally use target <node/group-id>
  and position <pos> to specify where the node should be located.  The
  position can be one of :head, :tail :before, :after, or :replace.

  (node \"foo\")
  (node \"foo\" {:pitch 60})
  (node \"foo\" {:pitch 60} {:target 0})
  (node \"foo\" {:pitch 60} {:target 2 :position :tail})
  "
  ([synth-name arg-map] (node synth-name arg-map {:position :tail, :target 0}))
  ([synth-name arg-map location]
     (if (not (connected?))
       (throw (Exception. "Not connected to synthesis engine.  Please boot or connect.")))
     (let [id       (alloc-id :node)
           position (or ((get location :position :tail) POSITION) 1)
           target   (get location :target 0)
           arg-map  (map-and-check-node-args arg-map)
           args     (flatten (seq arg-map))]

       ;; (println "node " synth-name id position target (vec args))
       (apply snd "/s_new" synth-name id position target args)
       id)))

;; ### Synth node callbacks
;;
;; The synth server sends an n_go event when a synth node is created and an
;; n_end event when a synth node is destroyed.

(defn node-free
  "Remove a synth node."
  [& node-ids]
  {:pre [(connected?)]}
  (apply snd "/n_free" node-ids)
  (doseq [id node-ids] (free-id :node id)))

(defn- node-destroyed
  "Frees up a synth node to keep in sync with the server."
  [id]
  (log/debug (format "node-destroyed: %d" id))
  (free-id :node id))

(defn- node-created
  "Called when a node is created on the synth."
  [id]
  (log/debug (format "node-created: %d" id)))

; Setup the feedback handlers with the audio server.
(on-event "/n_end" ::node-destroyer #(node-destroyed (first (:args %))))
(on-event "/n_go" ::node-creator #(node-created (first (:args %))))

;; ### Group
;;
;; A Group is a collection of Nodes represented as a linked list. A new Node
;; may be added to the head or tail of the group. The Nodes within a Group
;; may be controlled together. The Nodes in a Group may be both Synths and
;; other Groups. At startup there is a top level group with an ID of zero
;; that defines the root of the tree. If the server was booted from within
;; SCLang (as opposed to from the command line) there will also be a 'default
;; group' with an ID of 1 which is the default target for all new Nodes. See
;; RootNode and default_group for more info.

(defn group
  "Create a new synth group as a child of the target group."
  [position target-id]
  {:pre [(connected?)]}
  (let [id (alloc-id :node)
        pos (if (keyword? position) (get POSITION position) position)
        pos (or pos 1)]
    (snd "/g_new" id pos target-id)
    id))

(defn group-free
  "Free synth groups, releasing their resources."
  [& group-ids]
  {:pre [(connected?)]}
  (apply node-free group-ids))

(defn node-run
  "Start a stopped synth node."
  [node-id]
  {:pre [(connected?)]}
  (snd "/n_run" node-id 1))

(defn node-stop
  "Stop a running synth node."
  {:pre [(connected?)]}
  [node-id]
  (snd "/n_run" node-id 0))

(defn node-place
  "Place a node :before or :after another node."
  [node-id position target-id]
  {:pre [(connected?)]}
  (cond
    (= :before position) (snd "/n_before" node-id target-id)
    (= :after  position) (snd "/n_after" node-id target-id)))

(defn node-control
  "Set control values for a node."
  [node-id & name-values]
  {:pre [(connected?)]}
  (apply snd "/n_set" node-id (floatify (stringify (bus->id name-values))))
  node-id)

; This can be extended to support setting multiple ranges at once if necessary...
(defn node-control-range
  "Set a range of controls all at once, or if node-id is a group control
  all nodes in the group."
  [node-id ctl-start & ctl-vals]
  {:pre [(connected?)]}
  (apply snd "/n_setn" node-id ctl-start (count ctl-vals) ctl-vals))

(defn node-map-controls
  "Connect a node's controls to a control bus."
  [node-id & names-busses]
  {:pre [(connected?)]}
  (apply snd "/n_map" node-id names-busses))

(defn post-tree
  "Posts a representation of this group's node subtree, i.e. all the groups and
  synths contained within it, optionally including the current control values
  for synths."
  [id & [with-args?]]
  {:pre [(connected?)]}
  (snd "/g_dumpTree" id with-args?))

(defn prepend-node
  "Add a synth node to the end of a group list."
  [g n]
  (snd "/g_head" g n))

(defn append-node
  "Add a synth node to the end of a group list."
  [g n]
  (snd "/g_tail" g n))

(defn group-clear
  "Free all child synth nodes in a group."
  [group-id]
  (snd "/g_freeAll" group-id))

(defn- synth-kind
  "Resolve synth kind depending on type of arguments. Intended for use as a multimethod dispatch fn"
  [& args]
  (cond
   (number? (first args)) :number
   (associative? (first args)) (:type (first args))
   :else (type (first args))))

(defmulti ctl
  "Modify synth parameters for a synth node or group of nodes."
  synth-kind)

(defmethod ctl :number
  [synth-id & ctls]
  (apply node-control synth-id ctls))

(defmulti kill
  "Free one or more synth nodes.
  Functions that create instance of synth definitions, such as hit, return
  a handle for the synth node that was created.
  (let [handle (hit :sin)] ; returns => synth-handle
  (kill (+ 1000 (now)) handle))

  ; a single handle without a time kills immediately
  (kill handle)

  ; or a bunch of synth handles can be removed at once
  (kill (hit) (hit) (hit))

  ; or a seq of synth handles can be removed at once
  (kill [(hit) (hit) (hit)])
  "
  synth-kind)

(defmethod kill :number
  [& ids]
  (apply node-free (flatten ids))
  :killed)

;/g_queryTree				get a representation of this group's node subtree.
;	[
;		int - group ID
;		int - flag: if not 0 the current control (arg) values for synths will be included
;	] * N
;
; Request a representation of this group's node subtree, i.e. all the groups and
; synths contained within it. Replies to the sender with a /g_queryTree.reply
; message listing all of the nodes contained within the group in the following
; format:
;
;	int - flag: if synth control values are included 1, else 0
;	int - node ID of the requested group
;	int - number of child nodes contained within the requested group
;	then for each node in the subtree:
;	[
;		int - node ID
;		int - number of child nodes contained within this node. If -1this is a synth, if >=0 it's a group
;		then, if this node is a synth:
;		symbol - the SynthDef name for this node.
;		then, if flag (see above) is true:
;		int - numControls for this synth (M)
;		[
;			symbol or int: control name or index
;			float or symbol: value or control bus mapping symbol (e.g. 'c1')
;		] * M
;	] * the number of nodes in the subtree

(def *node-tree-data* nil)

(defn- parse-synth-tree
  [id ctls?]
  (let [sname (first *node-tree-data*)]
    (if ctls?
      (let [n-ctls (second *node-tree-data*)
            [ctl-data new-data] (split-at (* 2 n-ctls) (nnext *node-tree-data*))
            ctls (apply hash-map ctl-data)]
        (set! *node-tree-data* new-data)
        {:type :synth
         :name sname
         :id id
         :controls ctls})
      (do
        (set! *node-tree-data* (next *node-tree-data*))
        {:type :synth
         :name sname
         :id id}))))

(defn- parse-node-tree-helper [ctls?]
  (let [[id n-children & new-data] *node-tree-data*]
    (set! *node-tree-data* new-data)
    (cond
      (neg? n-children) (parse-synth-tree id ctls?) ; synth
      (= 0 n-children) {:type :group :id id :children nil}
      (pos? n-children)
      {:type :group :id id
       :children (doall (map (fn [i] (parse-node-tree-helper ctls?)) (range n-children)))})))

(defn parse-node-tree
  [data]
  (let [ctls? (= 1 (first data))]
    (binding [*node-tree-data* (next data)]
      (parse-node-tree-helper ctls?))))

(defn node-tree
  "Returns a data structure representing the current arrangement of groups and
  synthesizer instances residing on the audio server."
  ([] (node-tree 0))
  ([id & [ctls?]]
   (let [ctls? (if (or (= 1 ctls?) (= true ctls?)) 1 0)]
     (let [reply-p (recv "/g_queryTree.reply")
           _ (snd "/g_queryTree" id ctls?)
          tree (:args (await-promise! reply-p))]
       (with-meta (parse-node-tree tree)
         {:type ::node-tree})))))

(on-deps :connected ::create-synth-group #(dosync (ref-set synth-group* (group :head ROOT-GROUP))))

(on-sync-event :reset :reset-base
  (fn []
    (clear-msg-queue)
    (group-clear @synth-group*))) ; clear the synth group

(on-sync-event :shutdown ::free-all-nodes #(do (clear-msg-queue)
                                               (group-clear ROOT-GROUP)))

(ns overtone.sc.node
  (:require
    [overtone.log :as log])
  (:use
    [overtone util event deps]
    [overtone.sc core allocator bus]))

;; ## Node and Group Management

;; Synths, Busses, Controls and Groups are all Nodes.  Groups are linked lists
;; and group zero is the root of the graph.  Nodes can be added to a group in
;; one of these 5 positions relative to either the full list, or a specified node.

(def POSITION
  {:head         0
   :tail         1
   :before       2
   :after        3
   :replace      4})

(defn- bus->id
  "if val is a bus, return its ref id otherwise return val"
  [val]
  (if (bus? val)
    (:id val)
    val))

(defn node-id
  "Resolves the id of node. If it's an instrument, returns the group id, else
  just returns the node unchanged. Throws an exception if the id isn't an
  integer"
  [node]
  (let [id (if   (and (associative? node)
                      (= ::instrument (:type node))) (:group node) node)]
    (if-not (integer? id)
      (throw (Exception. (str "The following node id is not an integer:" id)))
      id)))

(defn map-ctl
  "Maps node's control param to the values in the control-bus"
  [node control control-bus]
  (let [n-id (node-id node)
        ctl (to-str control)
        bus (bus->id control-bus)]
    (snd "/n_map" n-id ctl bus)))

(defn- map-and-check-node-args
  [arg-map]
  (let [name-fn (fn [name]
                  (let [name (to-str name)]
                    (when (not (string? name))
                      (throw (Exception. (str "Incorrect arg. Was expecting a string and found " name ". Full arg map: " arg-map))))
                    name))
        val-fn (fn [val]
                 (let [val (bus->id val)
                       val (to-float val)]
                   (when (not (float? val))
                     (throw (Exception. (str "Incorrect arg. Was expecting a float and found " val ". Full arg map: " arg-map))))
                   val))]

    (zipmap (map name-fn (keys arg-map))
            (map val-fn (vals arg-map)))))

;; ### Node
;;
;; A Node is an addressable node in a tree of nodes run by the synth engine.
;; There are two types, Synths and Groups. The tree defines the order of
;; execution of all Synths. All nodes have an integer ID.

;; Sending a synth-id of -1 lets the server choose an ID
(defn node
  "Instantiate a synth node on the audio server.  Takes the synth name and a
  map of argument name/value pairs.  Optionally use target <node/group-id>
  and position <pos> to specify where the node should be located.  The
  position can be one of :head, :tail :before, :after, or :replace.

  (node \"foo\")
  (node \"foo\" {:pitch 60})
  (node \"foo\" {:pitch 60} {:target 0})
  (node \"foo\" {:pitch 60} {:target 2 :position :tail})
  "
  ([synth-name arg-map] (node synth-name arg-map {:position :tail, :target 0}))
  ([synth-name arg-map location]
     (if (not (connected?))
       (throw (Exception. "Not connected to synthesis engine.  Please boot or connect.")))
     (let [id       (alloc-id :node)
           position (or ((get location :position :tail) POSITION) 1)
           target   (get location :target 0)
           arg-map  (map-and-check-node-args arg-map)
           args     (flatten (seq arg-map))]

       ;; (println "node " synth-name id position target (vec args))
       (apply snd "/s_new" synth-name id position target args)
       id)))

;; ### Synth node callbacks
;;
;; The synth server sends an n_go event when a synth node is created and an
;; n_end event when a synth node is destroyed.

(defn node-free
  "Remove a synth node."
  [& node-ids]
  {:pre [(connected?)]}
  (apply snd "/n_free" node-ids)
  (doseq [id node-ids] (free-id :node id)))

(defn- node-destroyed
  "Frees up a synth node to keep in sync with the server."
  [id]
  (log/debug (format "node-destroyed: %d" id))
  (free-id :node id))

(defn- node-created
  "Called when a node is created on the synth."
  [id]
  (log/debug (format "node-created: %d" id)))

; Setup the feedback handlers with the audio server.
(on-event "/n_end" ::node-destroyer #(node-destroyed (first (:args %))))
(on-event "/n_go" ::node-creator #(node-created (first (:args %))))

;; ### Group
;;
;; A Group is a collection of Nodes represented as a linked list. A new Node
;; may be added to the head or tail of the group. The Nodes within a Group
;; may be controlled together. The Nodes in a Group may be both Synths and
;; other Groups. At startup there is a top level group with an ID of zero
;; that defines the root of the tree. If the server was booted from within
;; SCLang (as opposed to from the command line) there will also be a 'default
;; group' with an ID of 1 which is the default target for all new Nodes. See
;; RootNode and default_group for more info.

(defn group
  "Create a new synth group as a child of the target group."
  [position target-id]
  {:pre [(connected?)]}
  (let [id (alloc-id :node)
        pos (if (keyword? position) (get POSITION position) position)
        pos (or pos 1)]
    (snd "/g_new" id pos target-id)
    id))

(defn group-free
  "Free synth groups, releasing their resources."
  [& group-ids]
  {:pre [(connected?)]}
  (apply node-free group-ids))

(defn node-run
  "Start a stopped synth node."
  [node-id]
  {:pre [(connected?)]}
  (snd "/n_run" node-id 1))

(defn node-stop
  "Stop a running synth node."
  {:pre [(connected?)]}
  [node-id]
  (snd "/n_run" node-id 0))

(defn node-place
  "Place a node :before or :after another node."
  [node-id position target-id]
  {:pre [(connected?)]}
  (cond
    (= :before position) (snd "/n_before" node-id target-id)
    (= :after  position) (snd "/n_after" node-id target-id)))

(defn node-control
  "Set control values for a node."
  [node-id & name-values]
  {:pre [(connected?)]}
  (apply snd "/n_set" node-id (floatify (stringify (bus->id name-values))))
  node-id)

; This can be extended to support setting multiple ranges at once if necessary...
(defn node-control-range
  "Set a range of controls all at once, or if node-id is a group control
  all nodes in the group."
  [node-id ctl-start & ctl-vals]
  {:pre [(connected?)]}
  (apply snd "/n_setn" node-id ctl-start (count ctl-vals) ctl-vals))

(defn node-map-controls
  "Connect a node's controls to a control bus."
  [node-id & names-busses]
  {:pre [(connected?)]}
  (apply snd "/n_map" node-id names-busses))

(defn post-tree
  "Posts a representation of this group's node subtree, i.e. all the groups and
  synths contained within it, optionally including the current control values
  for synths."
  [id & [with-args?]]
  {:pre [(connected?)]}
  (snd "/g_dumpTree" id with-args?))

(defn prepend-node
  "Add a synth node to the end of a group list."
  [g n]
  (snd "/g_head" g n))

(defn append-node
  "Add a synth node to the end of a group list."
  [g n]
  (snd "/g_tail" g n))

(defn group-clear
  "Free all child synth nodes in a group."
  [group-id]
  (snd "/g_freeAll" group-id))

(defn- synth-kind
  "Resolve synth kind depending on type of arguments. Intended for use as a multimethod dispatch fn"
  [& args]
  (cond
   (number? (first args)) :number
   (associative? (first args)) (:type (first args))
   :else (type (first args))))

(defmulti ctl
  "Modify synth parameters for a synth node or group of nodes."
  synth-kind)

(defmethod ctl :number
  [synth-id & ctls]
  (apply node-control synth-id ctls))

(defmulti kill
  "Free one or more synth nodes.
  Functions that create instance of synth definitions, such as hit, return
  a handle for the synth node that was created.
  (let [handle (hit :sin)] ; returns => synth-handle
  (kill (+ 1000 (now)) handle))

  ; a single handle without a time kills immediately
  (kill handle)

  ; or a bunch of synth handles can be removed at once
  (kill (hit) (hit) (hit))

  ; or a seq of synth handles can be removed at once
  (kill [(hit) (hit) (hit)])
  "
  synth-kind)

(defmethod kill :number
  [& ids]
  (apply node-free (flatten ids))
  :killed)

;/g_queryTree				get a representation of this group's node subtree.
;	[
;		int - group ID
;		int - flag: if not 0 the current control (arg) values for synths will be included
;	] * N
;
; Request a representation of this group's node subtree, i.e. all the groups and
; synths contained within it. Replies to the sender with a /g_queryTree.reply
; message listing all of the nodes contained within the group in the following
; format:
;
;	int - flag: if synth control values are included 1, else 0
;	int - node ID of the requested group
;	int - number of child nodes contained within the requested group
;	then for each node in the subtree:
;	[
;		int - node ID
;		int - number of child nodes contained within this node. If -1this is a synth, if >=0 it's a group
;		then, if this node is a synth:
;		symbol - the SynthDef name for this node.
;		then, if flag (see above) is true:
;		int - numControls for this synth (M)
;		[
;			symbol or int: control name or index
;			float or symbol: value or control bus mapping symbol (e.g. 'c1')
;		] * M
;	] * the number of nodes in the subtree

(def *node-tree-data* nil)

(defn- parse-synth-tree
  [id ctls?]
  (let [sname (first *node-tree-data*)]
    (if ctls?
      (let [n-ctls (second *node-tree-data*)
            [ctl-data new-data] (split-at (* 2 n-ctls) (nnext *node-tree-data*))
            ctls (apply hash-map ctl-data)]
        (set! *node-tree-data* new-data)
        {:type :synth
         :name sname
         :id id
         :controls ctls})
      (do
        (set! *node-tree-data* (next *node-tree-data*))
        {:type :synth
         :name sname
         :id id}))))

(defn- parse-node-tree-helper [ctls?]
  (let [[id n-children & new-data] *node-tree-data*]
    (set! *node-tree-data* new-data)
    (cond
      (neg? n-children) (parse-synth-tree id ctls?) ; synth
      (= 0 n-children) {:type :group :id id :children nil}
      (pos? n-children)
      {:type :group :id id
       :children (doall (map (fn [i] (parse-node-tree-helper ctls?)) (range n-children)))})))

(defn parse-node-tree
  [data]
  (let [ctls? (= 1 (first data))]
    (binding [*node-tree-data* (next data)]
      (parse-node-tree-helper ctls?))))

(defn node-tree
  "Returns a data structure representing the current arrangement of groups and
  synthesizer instances residing on the audio server."
  ([] (node-tree 0))
  ([id & [ctls?]]
   (let [ctls? (if (or (= 1 ctls?) (= true ctls?)) 1 0)]
     (let [reply-p (recv "/g_queryTree.reply")
           _ (snd "/g_queryTree" id ctls?)
          tree (:args (await-promise! reply-p))]
       (with-meta (parse-node-tree tree)
         {:type ::node-tree})))))

(on-deps :connected ::create-synth-group #(dosync (ref-set synth-group* (group :head ROOT-GROUP))))

(on-sync-event :reset :reset-base
  (fn []
    (clear-msg-queue)
    (group-clear @synth-group*))) ; clear the synth group

(on-sync-event :shutdown ::free-all-nodes #(do (clear-msg-queue)
                                               (group-clear ROOT-GROUP)))

Add fns to resolve a node id and map a node's control params to a control bus


(ns clojars.test-helper
  (:require
   [clojars.config :as config]
   [clojars.db :as db]
   [clojars.db.migrate :as migrate]
   [clojars.email :as email]
   [clojars.errors :as errors]
   [clojars.oauth.service :as oauth-service]
   [clojars.remote-service :as remote-service]
   [clojars.s3 :as s3]
   [clojars.search :as search]
   [clojars.stats :as stats]
   [clojars.storage :as storage]
   [clojars.system :as system]
   [clojars.web :as web]
   [clojure.java.io :as io]
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [clojure.test :refer [is]]
   [clucy.core :as clucy]
   [com.stuartsierra.component :as component]
   [matcher-combinators.test])
  (:import
   (java.io
    File)
   (java.time
    ZonedDateTime)
   (java.util
    Date)))

(def tmp-dir (io/file (System/getProperty "java.io.tmpdir")))
(def local-repo (io/file tmp-dir "clojars" "test" "local-repo"))
(def local-repo2 (io/file tmp-dir "clojars" "test" "local-repo2"))

(defn delete-file-recursively
  "Delete file f. If it's a directory, recursively delete all its contents."
  [f]
  (let [f (io/file f)]
    (when (.exists f)
      (when (.isDirectory f)
        (doseq [child (.listFiles f)]
          (delete-file-recursively child)))
      (io/delete-file f))))

(defn with-local-repos
  [f]
  (delete-file-recursively local-repo)
  (delete-file-recursively local-repo2)
  (f))

(defn default-fixture [f]
  (binding [config/*profile* "test"]
    (let [cleanup (fn [] (run!
                          #(delete-file-recursively (io/file ((config/config) %)))
                          [:deletion-backup-dir :repo]))]
      (cleanup)
      (f)
      (cleanup))))

(defn quiet-reporter []
  (reify errors/ErrorReporter
    (-report-error [t e ex id]
      (println t e ex id))))

(declare ^:dynamic *db*)

(defn clear-database [db]
  (try
    (jdbc/db-do-commands db
                         "delete from deps"
                         "delete from groups"
                         "delete from jars"
                         "delete from users"
                         "delete from group_verifications"
                         "delete from audit")
    (catch Exception _)))

(defn with-clean-database [f]
  (binding [config/*profile* "test"]
    ;; double binding since ^ needs to be bound for config to load
    ;; properly
    (binding [*db* {:connection (jdbc/get-connection (:db (config/config)))}]
      (try
        (clear-database *db*)
        (with-out-str
          (migrate/migrate *db*))
        (f)
        (finally (.close (:connection *db*)))))))

(defrecord NoStats []
  stats/Stats
  (download-count [t group-id artifact-id] 0)
  (download-count [t group-id artifact-id version] 0)
  (total-downloads [t] 0))

(defn no-stats []
  (->NoStats))

(defn no-search []
  (reify search/Search))

(declare ^:dynamic *s3-repo-bucket*)

(defn with-s3-repo-bucket [f]
  (binding [*s3-repo-bucket* (s3/mock-s3-client)]
    (f)))

(declare ^:dynamic test-port)

(defn app
  ([] (app {}))
  ([{:keys [storage db error-reporter http-client stats search mailer github]
     :or {db {:spec *db*}
          storage (storage/fs-storage (:repo (config/config)))
          error-reporter (quiet-reporter)
          http-client (remote-service/new-mock-remote-service)
          stats (no-stats)
          search (no-search)
          mailer nil}}]
   (web/clojars-app
    {:db db
     :error-reporter error-reporter
     :http-client http-client
     :github github
     :mailer mailer
     :search search
     :stats stats
     :storage storage})))

(declare ^:dynamic system)

(defn app-from-system []
  (web/clojars-app system))

(defn with-test-system*
  [f]
  (binding [config/*profile* "test"]
    ;; double binding since ^ needs to be bound for config to load
    ;; properly
    (binding [system (component/start (assoc (system/new-system (config/config))
                                             :repo-bucket (s3/mock-s3-client)
                                             :error-reporter (quiet-reporter)
                                             :index-factory #(clucy/memory-index)
                                             :mailer (email/mock-mailer)
                                             :stats (no-stats)
                                             :github (oauth-service/new-mock-oauth-service "GitHub" {})))]
      (let [db (get-in system [:db :spec])]
        (try
          (clear-database db)
          (with-out-str
            (migrate/migrate db))
          (f)
          (finally
            (component/stop system)))))))

(defmacro with-test-system
  [& body]
  `(with-test-system* #(do ~@body)))

(defn run-test-app
  [f]
  (with-test-system*
    #(let [server (get-in system [:http :server])
           port (-> server .getConnectors first .getLocalPort)]
       (binding [test-port port]
         (f)))))

(defn get-content-type [resp]
  (some-> resp :headers (get "content-type") (str/split #";") first))

(defn assert-cors-header [resp]
  (some-> resp :headers
          (get "access-control-allow-origin")
          (= "*")))

(defn rewrite-pom [file m]
  (let [new-pom (doto (File/createTempFile (.getName file) ".pom")
                  .deleteOnExit)]
    (-> file
        slurp
        (as-> % (reduce (fn [accum [element new-value]]
                          (str/replace accum (re-pattern (format "<(%s)>.*?<" (name element)))
                                       (format "<$1>%s<" new-value)))
                        %
                        m))
        (->> (spit new-pom)))
    new-pom))

(defn date-from-iso-8601-str
  [iso-8601-date-string]
  (-> (ZonedDateTime/parse iso-8601-date-string)
      .toInstant
      (Date/from)))

(defn at-as-time-str
  "Adjusts the :at (or :created) Date to a millis-since-epoch string to
  match the search results."
  [data]
  (let [date->time-str #(str (.getTime %))]
    (cond-> data
      (:at data)      (update :at date->time-str)
      (:created data) (update :created date->time-str))))

(defn add-verified-group
  [account group]
  (db/add-group *db* account group)
  (db/verify-group! *db* account group))

(defmacro match-audit
  [params m]
  `(let [db# (:db (config/config))
         audit# (first (db/find-audit db# ~params))]
     (prn (db/find-audit db# ~params))
     (is (~'match? ~m audit#))))

(ns clojars.test-helper
  (:require
   [clojars.config :as config]
   [clojars.db :as db]
   [clojars.db.migrate :as migrate]
   [clojars.email :as email]
   [clojars.errors :as errors]
   [clojars.oauth.service :as oauth-service]
   [clojars.remote-service :as remote-service]
   [clojars.s3 :as s3]
   [clojars.search :as search]
   [clojars.stats :as stats]
   [clojars.storage :as storage]
   [clojars.system :as system]
   [clojars.web :as web]
   [clojure.java.io :as io]
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [clojure.test :refer [is]]
   [clucy.core :as clucy]
   [com.stuartsierra.component :as component]
   [matcher-combinators.test])
  (:import
   (java.io
    File)
   (java.time
    ZonedDateTime)
   (java.util
    Date)))

(def tmp-dir (io/file (System/getProperty "java.io.tmpdir")))
(def local-repo (io/file tmp-dir "clojars" "test" "local-repo"))
(def local-repo2 (io/file tmp-dir "clojars" "test" "local-repo2"))

(defn delete-file-recursively
  "Delete file f. If it's a directory, recursively delete all its contents."
  [f]
  (let [f (io/file f)]
    (when (.exists f)
      (when (.isDirectory f)
        (doseq [child (.listFiles f)]
          (delete-file-recursively child)))
      (io/delete-file f))))

(defn with-local-repos
  [f]
  (delete-file-recursively local-repo)
  (delete-file-recursively local-repo2)
  (f))

(defn default-fixture [f]
  (binding [config/*profile* "test"]
    (let [cleanup (fn [] (run!
                          #(delete-file-recursively (io/file ((config/config) %)))
                          [:deletion-backup-dir :repo]))]
      (cleanup)
      (f)
      (cleanup))))

(defn quiet-reporter []
  (reify errors/ErrorReporter
    (-report-error [t e ex id]
      (println t e ex id))))

(declare ^:dynamic *db*)

(defn clear-database [db]
  (try
    (jdbc/db-do-commands db
                         "delete from deps"
                         "delete from groups"
                         "delete from jars"
                         "delete from users"
                         "delete from group_verifications"
                         "delete from audit")
    (catch Exception _)))

(defn with-clean-database [f]
  (binding [config/*profile* "test"]
    ;; double binding since ^ needs to be bound for config to load
    ;; properly
    (binding [*db* {:connection (jdbc/get-connection (:db (config/config)))}]
      (try
        (clear-database *db*)
        (with-out-str
          (migrate/migrate *db*))
        (f)
        (finally (.close (:connection *db*)))))))

(defrecord NoStats []
  stats/Stats
  (download-count [t group-id artifact-id] 0)
  (download-count [t group-id artifact-id version] 0)
  (total-downloads [t] 0))

(defn no-stats []
  (->NoStats))

(defn no-search []
  (reify search/Search))

(declare ^:dynamic *s3-repo-bucket*)

(defn with-s3-repo-bucket [f]
  (binding [*s3-repo-bucket* (s3/mock-s3-client)]
    (f)))

(declare ^:dynamic test-port)

(defn app
  ([] (app {}))
  ([{:keys [storage db error-reporter http-client stats search mailer github]
     :or {db {:spec *db*}
          storage (storage/fs-storage (:repo (config/config)))
          error-reporter (quiet-reporter)
          http-client (remote-service/new-mock-remote-service)
          stats (no-stats)
          search (no-search)
          mailer nil}}]
   (web/clojars-app
    {:db db
     :error-reporter error-reporter
     :http-client http-client
     :github github
     :mailer mailer
     :search search
     :stats stats
     :storage storage})))

(declare ^:dynamic system)

(defn app-from-system []
  (web/clojars-app system))

(defn with-test-system*
  [f]
  (binding [config/*profile* "test"]
    ;; double binding since ^ needs to be bound for config to load
    ;; properly
    (binding [system (component/start (assoc (system/new-system (config/config))
                                             :repo-bucket (s3/mock-s3-client)
                                             :error-reporter (quiet-reporter)
                                             :index-factory #(clucy/memory-index)
                                             :mailer (email/mock-mailer)
                                             :stats (no-stats)
                                             :github (oauth-service/new-mock-oauth-service "GitHub" {})))]
      (let [db (get-in system [:db :spec])]
        (try
          (clear-database db)
          (with-out-str
            (migrate/migrate db))
          (f)
          (finally
            (component/stop system)))))))

(defmacro with-test-system
  [& body]
  `(with-test-system* #(do ~@body)))

(defn run-test-app
  [f]
  (with-test-system*
    #(let [server (get-in system [:http :server])
           port (-> server .getConnectors first .getLocalPort)]
       (binding [test-port port]
         (f)))))

(defn get-content-type [resp]
  (some-> resp :headers (get "content-type") (str/split #";") first))

(defn assert-cors-header [resp]
  (some-> resp :headers
          (get "access-control-allow-origin")
          (= "*")))

(defn rewrite-pom [file m]
  (let [new-pom (doto (File/createTempFile (.getName file) ".pom")
                  .deleteOnExit)]
    (-> file
        slurp
        (as-> % (reduce (fn [accum [element new-value]]
                          (str/replace accum (re-pattern (format "<(%s)>.*?<" (name element)))
                                       (format "<$1>%s<" new-value)))
                        %
                        m))
        (->> (spit new-pom)))
    new-pom))

(defn date-from-iso-8601-str
  [iso-8601-date-string]
  (-> (ZonedDateTime/parse iso-8601-date-string)
      .toInstant
      (Date/from)))

(defn at-as-time-str
  "Adjusts the :at (or :created) Date to a millis-since-epoch string to
  match the search results."
  [data]
  (let [date->time-str #(str (.getTime %))]
    (cond-> data
      (:at data)      (update :at date->time-str)
      (:created data) (update :created date->time-str))))

(defn add-verified-group
  [account group]
  (db/add-group *db* account group)
  (db/verify-group! *db* account group))

(defmacro match-audit
  [params m]
  `(let [db# (:db (config/config))
         audit# (first (db/find-audit db# ~params))]
     (is (~'match? ~m audit#))))

Remove test debugging output

Remove test debugging output


(ns spec-tools.impl
  (:refer-clojure :exclude [resolve])
  #?(:cljs (:require-macros [spec-tools.impl :refer [resolve]]))
  (:require
    #?(:cljs [cljs.analyzer.api])
    [clojure.spec.alpha :as s]
    [clojure.walk :as walk])
  (:import
    #?@(:clj
        [(clojure.lang Var)])))

(defn in-cljs? [env]
  (:ns env))

;; ClojureScript 1.9.655 and later have a resolve macro - maybe this can be
;; eventually converted to use it.
(defmacro resolve
  [env sym]
  `(if (in-cljs? ~env)
     ((clojure.core/resolve 'cljs.analyzer.api/resolve) ~env ~sym)
     (clojure.core/resolve ~env ~sym)))

(defn- cljs-sym [x]
  (if (map? x)
    (:name x)
    x))

(defn clojure-core-symbol-or-any [x]
  (or
    (if (symbol? x)
      (if-let [ns (get {"cljs.core" "clojure.core"
                        "cljs.spec.alpha" "clojure.spec.alpha"} (namespace x))]
        (symbol ns (name x))))
    x))

(defn- clj-sym [x]
  (if (var? x)
    (let [^Var v x]
      (symbol (str (.name (.ns v)))
              (str (.sym v))))
    x))

(defn ->sym [x]
  #?(:clj  (clj-sym x)
     :cljs (cljs-sym x)))

(defn- unfn [cljs? expr]
  (if (clojure.core/and (seq? expr)
                        (symbol? (first expr))
                        (= "fn*" (name (first expr))))
    (let [[[s] & form] (rest expr)]
      (conj (walk/postwalk-replace {s '%} form) '[%] (if cljs? 'cljs.core/fn 'clojure.core/fn)))
    expr))

#?(:clj
   (defn cljs-resolve [env symbol]
     (clojure.core/or (->> symbol (resolve env) cljs-sym) symbol)))

(defn polish [x]
  (cond
    (seq? x) (flatten (keep polish x))
    (symbol? x) nil
    :else x))

(defn polish-un [x]
  (-> x polish name keyword))

(defn extract-keys [form]
  (let [{:keys [req opt req-un opt-un]} (some->> form (rest) (apply hash-map))]
    (flatten (map polish (concat req opt req-un opt-un)))))

#?(:clj
   (defn resolve-form [env pred]
     (let [cljs? (in-cljs? env)
           res (if cljs? (partial cljs-resolve env) clojure.core/resolve)]
       (->> pred
            (walk/postwalk
             (fn [x]
               (if (symbol? x)
                 (or (some->> x res ->sym) x)
                 x)))
            (unfn cljs?)))))

(defn extract-pred-and-info [x]
  (if (map? x)
    [(:spec x) (dissoc x :spec)]
    [x {}]))

(defn nilable-spec? [spec]
  (boolean
    (some-> spec
            s/form
            seq
            first
            #{'clojure.spec.alpha/nilable
              'cljs.spec.alpha/nilable})))

(defn strip-fn-if-needed [form]
  (let [head (first form)]
    ;; Deal with the form (clojure.core/fn [%] (foo ... %))
    ;; We should just use core.match...
    (if (and (= (count form) 3) (= head #?(:clj 'clojure.core/fn :cljs 'cljs.core/fn)))
      (nth form 2)
      form)))

(defn normalize-symbol [kw]
  (case (and (symbol? kw) (namespace kw))
    "cljs.core" (symbol "clojure.core" (name kw))
    "cljs.spec.alpha" (symbol "clojure.spec.alpha" (name kw))
    kw))

(defn extract-form [spec]
  (if (seq? spec) spec (s/form spec)))

(defn qualified-name [key]
  (if key
    (if-let [nn (namespace key)]
      (str nn "/" (name key))
      (name key))))

(defn nilable-spec? [spec]
  (let [form (and spec (s/form spec))]
    (boolean
      (if-not (= form ::s/unknown)
        (some-> form
                seq
                first
                #{'clojure.spec.alpha/nilable
                  'cljs.spec.alpha/nilable})))))

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

;;
;; FIXME: using ^:skip-wiki functions from clojure.spec. might break.
;;

(defn register-spec! [k s]
  (s/def-impl k (s/form s) s))

(ns spec-tools.impl
  (:refer-clojure :exclude [resolve])
  #?(:cljs (:require-macros [spec-tools.impl :refer [resolve]]))
  (:require
    #?(:cljs [cljs.analyzer.api])
    [clojure.spec.alpha :as s]
    [clojure.walk :as walk])
  (:import
    #?@(:clj
        [(clojure.lang Var)])))

(defn in-cljs? [env]
  (:ns env))

;; ClojureScript 1.9.655 and later have a resolve macro - maybe this can be
;; eventually converted to use it.
(defmacro resolve
  [env sym]
  `(if (in-cljs? ~env)
     ((clojure.core/resolve 'cljs.analyzer.api/resolve) ~env ~sym)
     (clojure.core/resolve ~env ~sym)))

(defn- cljs-sym [x]
  (if (map? x)
    (:name x)
    x))

(defn clojure-core-symbol-or-any [x]
  (or
    (if (symbol? x)
      (if-let [ns (get {"cljs.core" "clojure.core"
                        "cljs.spec.alpha" "clojure.spec.alpha"} (namespace x))]
        (symbol ns (name x))))
    x))

(defn- clj-sym [x]
  (if (var? x)
    (let [^Var v x]
      (symbol (str (.name (.ns v)))
              (str (.sym v))))
    x))

(defn ->sym [x]
  #?(:clj  (clj-sym x)
     :cljs (cljs-sym x)))

(defn- unfn [cljs? expr]
  (if (clojure.core/and (seq? expr)
                        (symbol? (first expr))
                        (= "fn*" (name (first expr))))
    (let [[[s] & form] (rest expr)]
      (conj (walk/postwalk-replace {s '%} form) '[%] (if cljs? 'cljs.core/fn 'clojure.core/fn)))
    expr))

#?(:clj
   (defn cljs-resolve [env symbol]
     (clojure.core/or (->> symbol (resolve env) cljs-sym) symbol)))

(defn polish [x]
  (cond
    (seq? x) (flatten (keep polish x))
    (symbol? x) nil
    :else x))

(defn polish-un [x]
  (-> x polish name keyword))

(defn extract-keys [form]
  (let [{:keys [req opt req-un opt-un]} (some->> form (rest) (apply hash-map))]
    (flatten (map polish (concat req opt req-un opt-un)))))

#?(:clj
   (defn resolve-form [env pred]
     (let [cljs? (in-cljs? env)
           res (if cljs? (partial cljs-resolve env) clojure.core/resolve)]
       (->> pred
            (walk/postwalk
             (fn [x]
               (if (symbol? x)
                 (or (some->> x res ->sym) x)
                 x)))
            (unfn cljs?)))))

(defn extract-pred-and-info [x]
  (if (map? x)
    [(:spec x) (dissoc x :spec)]
    [x {}]))

(defn strip-fn-if-needed [form]
  (let [head (first form)]
    ;; Deal with the form (clojure.core/fn [%] (foo ... %))
    ;; We should just use core.match...
    (if (and (= (count form) 3) (= head #?(:clj 'clojure.core/fn :cljs 'cljs.core/fn)))
      (nth form 2)
      form)))

(defn normalize-symbol [kw]
  (case (and (symbol? kw) (namespace kw))
    "cljs.core" (symbol "clojure.core" (name kw))
    "cljs.spec.alpha" (symbol "clojure.spec.alpha" (name kw))
    kw))

(defn extract-form [spec]
  (if (seq? spec) spec (s/form spec)))

(defn qualified-name [key]
  (if key
    (if-let [nn (namespace key)]
      (str nn "/" (name key))
      (name key))))

(defn nilable-spec? [spec]
  (let [form (and spec (s/form spec))]
    (boolean
      (if-not (= form ::s/unknown)
        (some-> form
                seq
                first
                #{'clojure.spec.alpha/nilable
                  'cljs.spec.alpha/nilable})))))

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

;;
;; FIXME: using ^:skip-wiki functions from clojure.spec. might break.
;;

(defn register-spec! [k s]
  (s/def-impl k (s/form s) s))

remove extra nilable-spec

remove extra nilable-spec


(ns postal.test.message
  (:use [postal.message]
        [clojure.test :only [run-tests deftest is]]
        [postal.date :only [make-date]])
  (:import [java.util Properties UUID]
           [javax.mail Session Message$RecipientType]
           [javax.mail.internet MimeMessage InternetAddress
            AddressException]))

(deftest test-simple
  (let [m (message->str
           {:from "fee@bar.dom"
            :to "Foo Bar <foo@bar.dom>"
            :cc ["baz@bar.dom" "Quux <quux@bar.dom>"]
            :date (java.util.Date.)
            :subject "Test"
            :body "Test!"})]
    (is (.contains m "Subject: Test"))
    (is (.contains m "Cc: baz@bar.dom, Quux <quux@bar.dom>"))))

(deftest test-multipart
  (let [m (message->str
           {:from "foo@bar.dom"
            :to "baz@bar.dom"
            :subject "Test"
            :body [{:type "text/html"
                    :content "some html"}]})]
    (is (.contains m "multipart/mixed"))
    (is (.contains m "Content-Type: text/html"))
    (is (.contains m "some html"))))

(deftest test-inline
  (let [f (doto (java.io.File/createTempFile "_postal-" ".txt"))
        _ (doto (java.io.PrintWriter. f)
            (.println "tempfile contents") (.close))
        m (message->str
           {:from "foo@bar.dom"
            :to "baz@bar.dom"
            :subject "Test"
            :body [{:type :inline
                    :content f}]})]
    (is (.contains m "tempfile"))
    (.delete f)))

(deftest test-attachment
  (let [f1 (doto (java.io.File/createTempFile "_postal-" ".txt"))
        _ (doto (java.io.PrintWriter. f1)
            (.println "tempfile contents") (.close))
        f2 "/etc/resolv.conf"
        m (message->str
           {:from "foo@bar.dom"
            :to "baz@bar.dom"
            :subject "Test"
            :body [{:type :attachment
                    :content f1}
                   {:type :attachment
                    :content f2}]})]
    (is (.contains m "tempfile"))
    (.delete f1)))

(deftest test-nested
  (let [f (doto (java.io.File/createTempFile "_postal-" ".txt"))
        _ (doto (java.io.PrintWriter. f)
            (.println "tempfile contents") (.close))
        m (message->str
           {:from "foo@bar.dom"
            :to "baz@bar.dom"
            :subject "Test"
            :body [[:alternative
                    {:type "text/html"
                     :content "some html"}
                    {:type "text/plain"
                     :content "some text"}]
                   {:type :attachment
                    :content f}]})]
    (is (.contains m "multipart/mixed"))
    (is (.contains m "multipart/alternative"))
    (is (.contains m "Content-Type: text/html"))
    (is (.contains m "some html"))
    (is (.contains m "Content-Type: text/plain"))
    (is (.contains m "some text"))
    (is (.contains m "tempfile"))
    (.delete f)))

(deftest test-fixture
  (let [from "foo@bar.dom"
        to "baz@bar.dom"
        tag "[TEST]"]
    (is (zero? (.indexOf (:subject (make-fixture from to :tag tag)) "[TEST")))))

(deftest test-extra-headers
  (let [m {:from "foo@bar.dom"
           :to "baz@bar.dom"
           :subject "Test"
           :User-Agent "Lorem Ipsum"
           :body "Foo!"}]
    (is (.contains (message->str m) "User-Agent: Lorem Ipsum"))))

(deftest test-bad-addrs
  (let [m (message->str
           {:from "foo @bar.dom"
            :to "badddz@@@bar.dom"
            :subject "Test"
            :body "Bad recipient!"})]
    (is (not (.contains m "badddz")))
    (is (not (.contains m "foo @bar")))))

(deftest test-reply-to
  (let [m (message->str
           {:from "foo@bar.dom"
            :to "baz@bar.dom"
            :subject "Test"
            :body "Reply me!"
            :reply-to "yermom@bar.dom"})]
    (is (.contains m "Reply-To: yermom"))))

(deftest test-only-bcc
  (let [m (message->str
           {:from "foo@bar.dom"
            :bcc "baz@bar.dom"
            :subject "Test"
            :body "Only Bcc!!"})]
    (is (.contains m "Bcc: baz"))
    (is (not (.contains m "To: ")))))

Add test for sole Bcc: without To:.

Add test for sole Bcc: without To:.


;   Copyright (c) Shantanu Kumar. 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 LICENSE 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 preflex.either-test
  (:require
    [clojure.test :refer :all]
    [preflex.either :as either]))

(deftest test-basic
  (is (= :foo (either/deref-either (either/success :foo))) "deref success")
  (is (= :foo (either/deref-either (either/failure :foo))) "deref failure")
  (is (= :foo (either/deref-either (either/do-either :foo))) "deref do-either result"))

(deftest test-bind
  (is (= :foo (either/bind :foo identity)))
  (is (= :foo (-> (either/do-either :foo)
                (either/bind identity))))
  (is (thrown? IllegalStateException
        (-> (either/do-either (throw (IllegalStateException. "test error")))
          (either/bind #(throw %) identity))) "do-either throws exception")
  (is (= [210] (either/bind-deref 100
                 (fn [x] (* 2 x))
                 #(+ 10 %)
                 (either/either vector))))
  (is (thrown? IllegalStateException
        (either/bind-deref (either/do-either (throw (IllegalStateException. "test error")))
          [#(throw %) identity]))))

;   Copyright (c) Shantanu Kumar. 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 LICENSE 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 preflex.either-test
  (:require
    [clojure.test :refer :all]
    [preflex.either :as either]))

(deftest test-basic
  (is (= :foo (either/deref-either (either/success :foo))) "deref success")
  (is (= :foo (either/deref-either (either/failure :foo))) "deref failure")
  (is (= :foo (either/deref-either (either/do-either :foo))) "deref do-either result"))

(deftest test-bind
  (is (= :foo (either/bind :foo identity)))
  (is (= :foo (-> (either/do-either :foo)
                (either/bind identity))))
  (is (thrown? IllegalStateException
        (-> (either/do-either (throw (IllegalStateException. "test error")))
          (either/bind #(throw %) identity))) "do-either throws exception")
  (is (= [210] (either/bind-deref 100
                 (fn [^long x] (* 2 x))
                 #(+ 10 ^long %)
                 (either/either vector))))
  (is (thrown? IllegalStateException
        (either/bind-deref (either/do-either (throw (IllegalStateException. "test error")))
          [#(throw %) identity]))))

fix reflection warnings in either-test

fix reflection warnings in either-test


(ns swagger-gen.util
  (:require
    [clojure.string :refer [split replace-first lower-case capitalize join]]))

(defn camelize
  "Convert snake_case string into CamelCase"
  [input-string]
  (let [words (split input-string #"[\s_-]+")]
    (join ""
          (cons (lower-case (first words))
                (map capitalize (rest words))))))

(defn normalize-def
  "Normalize a definition like #/definitions/Card into Card"
  [type-ref]
  (replace-first type-ref #"#/definitions/" ""))

(defn seq-to-string
  ([xs]           (apply str xs))
  ([xs separator] (apply str (interpose separator xs))))

(defn quote-string
  [s]
  (format "\"%s\"" s))

(defn params-of-type
  "Extract swagger params of a given type i.e :body or :path"
  [swagger-route param-type]
  (->> swagger-route
       :parameters
       (filter #(= (:in %) param-type))
       (into [])))

(defn body-params
  "Extract one or more body params from a swagger path"
  [swagger-route]
  (params-of-type swagger-route "body"))

(defn query-params
  "Extract one or more query params from a swagger path"
  [swagger-route]
  (params-of-type swagger-route "query"))

(ns swagger-gen.util
  (:require
    [clojure.string :refer [split replace-first lower-case capitalize join]]))

(defn camelize
  "Convert snake_case string into CamelCase"
  [input-string]
  (let [words (split input-string #"[\s_-]+")]
    (join ""
          (cons (lower-case (first words))
                (map capitalize (rest words))))))

(defn normalize-def
  "Normalize a definition like #/definitions/Card into Card"
  [type-ref]
  (replace-first type-ref #"#/definitions/" ""))

(defn seq-to-string
  ([xs]           (apply str xs))
  ([xs separator] (apply str (interpose separator xs))))

(defn quote-string
  [s]
  (format "\"%s\"" s))

(defn params-of-type
  "Extract swagger params of a given type i.e :body or :path"
  [swagger-route param-type]
  (->> swagger-route
       :parameters
       (filter #(= (:in %) param-type))
       (into [])))

(defn body-params
  "Extract one or more body params from a swagger path"
  [swagger-route]
  (params-of-type swagger-route "body"))

(defn path-params
  "Extract one or more path params from a swagger path"
  [swagger-route]
  (params-of-type swagger-route "path"))

(defn query-params
  "Extract one or more query params from a swagger path"
  [swagger-route]
  (params-of-type swagger-route "query"))

Update util.clj

Update util.clj