;; Copyright 2008-2013 Red Hat, Inc, and individual contributors.
;;
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU Lesser General Public License as
;; published by the Free Software Foundation; either version 2.1 of
;; the License, or (at your option) any later version.
;;
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; if not, write to the Free
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA, or see the FSF site: http://www.fsf.org.

(ns test.immutant.cache
  (:use immutant.cache
        clojure.test)
  (:require [clojure.core.cache :as core]
            [clojure.java.io :as io])
  (:import java.util.concurrent.TimeUnit))

(deftest test-lookup-by-list
  (is (= :foo (core/lookup (core/miss (create "foo") '(bar) :foo) '(bar)))))

(deftest test-local-infinispan-cache
  (testing "counts"
    (is (= 0 (count (create "0"))))
    (is (= 1 (count (create "1" :seed {:a 1})))))
  (testing "lookup using keywords"
    (let [c (create "keywords" :seed {:a 1 :b 2})]
      (are [expect actual] (= expect actual)
           1   (:a c)
           2   (:b c)
           42  (:X c 42)
           nil (:X c))))
  (testing "lookups using .lookup"
    (let [c (create "lookups" :seed {:a 1 :b 2})]
      (are [expect actual] (= expect actual)
           1   (.lookup c :a)
           2   (.lookup c :b)
           ;; 42  (.lookup c :c 42)
           nil (.lookup c :c))))
  (testing "gets and cascading gets"
    (let [c (create "gets" :seed {:a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5}})]
      (are [actual expect] (= expect actual)
           (get c :a) 1
           (get c :e) nil
           (get c :e 0) 0
           (get c :b 0) 2
           (get c :f 0) nil
           (get-in c [:c :e]) 4
           (get-in c '(:c :e)) 4
           (get-in c [:c :x]) nil
           (get-in c [:f]) nil
           (get-in c [:g]) false
           (get-in c [:h]) nil
           (get-in c []) c
           (get-in c nil) c
           (get-in c [:c :e] 0) 4
           (get-in c '(:c :e) 0) 4
           (get-in c [:c :x] 0) 0
           (get-in c [:b] 0) 2
           (get-in c [:f] 0) nil
           (get-in c [:g] 0) false
           (get-in c [:h] 0) 0
           (get-in c [:x :y] {:y 1}) {:y 1}
           (get-in c [] 0) c
           (get-in c nil 0) c)))
  (testing "that finding works for cache"
    (let [c (create "finding" :seed {:a 1 :b 2})]
      (are [expect actual] (= expect actual)
           (find c :a) [:a 1]
           (find c :b) [:b 2]
           (find c :c) nil
           (find c nil) nil)))
  (testing "that contains? works for cache"
    (let [c (create "contains" :seed {:a 1 :b 2})]
      (are [expect actual] (= expect actual)
           (contains? c :a) true
           (contains? c :b) true
           (contains? c :c) false
           (contains? c nil) false))))

(deftest test-put
  (let [c (create "puts")
        v {:foo [1 2 3] "p" "q"}]
    (is (nil? (put c :a v)))
    (is (= v (get c :a)))
    (is (= v (put c :a "next")))))

(deftest test-put-nil
  (let [c (create "nilly")]
    (is (= :right (:a c :right)))
    (is (nil? (put c :a nil)))
    (is (nil? (:a c :wrong)))
    (is (nil? (put c nil :right)))
    (is (= :right (get c nil :wrong)))))

(deftest test-put-ttl
  (let [c (create "ttl" :seed {})]
    (put c :a 1 {:ttl [500 :milliseconds]})
    (is (= 1 (get c :a)))
    (Thread/sleep 550)
    (is (nil? (get c :a)))))

(deftest test-put-default-ttl
  (let [c (create "ttl" :seed {} :ttl 500 :units :days)]
    (put c :a 1 {:units :milliseconds})
    (is (= 1 (get c :a)))
    (Thread/sleep 550)
    (is (nil? (get c :a)))))

(deftest test-put-idle
  (let [c (create "idle")]
    (put c :a 1 {:idle [500 :milliseconds]})
    (Thread/sleep 300)
    (is (= 1 (get c :a)))
    (Thread/sleep 300)
    (is (= 1 (get c :a)))
    (Thread/sleep 550)
    (is (nil? (get c :a)))))

(deftest test-put-if-absent-ttl
  (let [c (create "absent")]
    (is (nil? (:a c)))
    (is (nil? (put-if-absent c :a 1 {:ttl [300 :milliseconds]})))
    (is (= 1 (:a c)))
    (is (= 1 (put-if-absent c :a 2)))
    (is (= 1 (:a c)))
    (Thread/sleep 350)
    (is (nil? (:a c)))))

(deftest test-put-all-ttl
  (let [c (create "all")]
    (is (= 0 (count c)))
    (put-all c {:a 1 :b 2} {:ttl [300 :milliseconds]})
    (is (= 1 (:a c)))
    (is (= 2 (:b c)))
    (Thread/sleep 400)
    (is (nil? (:a c)))
    (is (nil? (:b c)))))

(deftest test-put-if-present
  (let [c (create "present" :seed {:a 1})]
    (is (nil? (put-if-present c :b 2)))
    (is (nil? (:b c)))
    (is (= 1 (put-if-present c :a 2)))
    (is (= 2 (:a c)))))

(deftest test-put-if-replace
  (let [c (create "replace" :seed {:a 1})]
    (is (false? (put-if-replace c :a 2 3)))
    (is (= 1 (:a c)))
    (is (true? (put-if-replace c :a 1 2)))
    (is (= 2 (:a c)))))

(deftest test-delete
  (let [c (create "delete" :seed {:a 1 :b 2})]
    (is (false? (delete c :a 2)))
    (is (= 2 (count c)))
    (is (true? (delete c :a 1)))
    (is (= 1 (count c)))
    (is (nil? (delete c :missing)))
    (is (= 2 (delete c :b)))
    (is (empty? c))))

(deftest test-delete-all
  (let [c (create "clear" :seed {:a 1 :b 2})]
    (is (= 2 (count c)))
    (is (= 0 (count (delete-all c))))
    (is (= 0 (count c)))))

(deftest test-seeding
  (let [c (create "foo" :seed {:a 1})
        d (lookup "foo")]
    (is (= (:a c) (:a d) 1))
    (put c :b 2)
    (is (= (:b c) (:b d) 2))
    (let [e (create "foo" :seed {})]
      (is (every? empty? [c d e])))))

(deftest test-persistent-seeding
  (let [c (create "cachey" :persist "src/test/resources/cache-store")
        cn (create "cachey-none" :encoding :none, :persist "src/test/resources/cache-store")]
    (is (= (:key c) 42))
    (is (= (:key cn) 42))))

(deftest test-persist-file-store
  (try
    (create "mike" :persist true)
    (is (.exists (io/file "Infinispan-FileCacheStore/mike")))
    (finally
     (io/delete-file "Infinispan-FileCacheStore/mike")
     (io/delete-file "Infinispan-FileCacheStore"))))

(deftest test-create-restarts
  (let [c (create "terrence")]
    (put c :a 1)
    (is (= 1 (:a c)))
    (create "terrence")
    (is (empty? c))))

(deftest test-eviction
  (let [c (create "nelly" :max-entries 2)]
    (put c :a 1)
    (put c :b 2)
    (put c :c 3)
    (is (nil? (:a c)))
    (is (= 2 (count c)))))

(deftest test-seqable
  (let [seed {:a 1, :b {:c 42}}
        c (create "seedy" :seed seed)]
    (is (= seed (into {} (seq c))))))

(deftest default-to-local "should not raise exception"
  (create "remote" :mode :replicated))

(deftest lookup-of-stopped-cache "should return nil"
  (let [c (create "stopped")]
    (.stop (.cache c))
    (is (nil? (lookup "stopped")))))

;; Copyright 2008-2013 Red Hat, Inc, and individual contributors.
;;
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU Lesser General Public License as
;; published by the Free Software Foundation; either version 2.1 of
;; the License, or (at your option) any later version.
;;
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; if not, write to the Free
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA, or see the FSF site: http://www.fsf.org.

(ns test.immutant.cache
  (:use immutant.cache
        clojure.test)
  (:require [clojure.core.cache :as core]
            [clojure.java.io :as io])
  (:import java.util.concurrent.TimeUnit))

(deftest test-lookup-by-list
  (is (= :foo (core/lookup (core/miss (create "foo") '(bar) :foo) '(bar)))))

(deftest test-local-infinispan-cache
  (testing "counts"
    (is (= 0 (count (create "0"))))
    (is (= 1 (count (create "1" :seed {:a 1})))))
  (testing "lookup using keywords"
    (let [c (create "keywords" :seed {:a 1 :b 2})]
      (are [expect actual] (= expect actual)
           1   (:a c)
           2   (:b c)
           42  (:X c 42)
           nil (:X c))))
  (testing "lookups using .lookup"
    (let [c (create "lookups" :seed {:a 1 :b 2})]
      (are [expect actual] (= expect actual)
           1   (.lookup c :a)
           2   (.lookup c :b)
           ;; 42  (.lookup c :c 42)
           nil (.lookup c :c))))
  (testing "gets and cascading gets"
    (let [c (create "gets" :seed {:a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5}})]
      (are [actual expect] (= expect actual)
           (get c :a) 1
           (get c :e) nil
           (get c :e 0) 0
           (get c :b 0) 2
           (get c :f 0) nil
           (get-in c [:c :e]) 4
           (get-in c '(:c :e)) 4
           (get-in c [:c :x]) nil
           (get-in c [:f]) nil
           (get-in c [:g]) false
           (get-in c [:h]) nil
           (get-in c []) c
           (get-in c nil) c
           (get-in c [:c :e] 0) 4
           (get-in c '(:c :e) 0) 4
           (get-in c [:c :x] 0) 0
           (get-in c [:b] 0) 2
           (get-in c [:f] 0) nil
           (get-in c [:g] 0) false
           (get-in c [:h] 0) 0
           (get-in c [:x :y] {:y 1}) {:y 1}
           (get-in c [] 0) c
           (get-in c nil 0) c)))
  (testing "that finding works for cache"
    (let [c (create "finding" :seed {:a 1 :b 2})]
      (are [expect actual] (= expect actual)
           (find c :a) [:a 1]
           (find c :b) [:b 2]
           (find c :c) nil
           (find c nil) nil)))
  (testing "that contains? works for cache"
    (let [c (create "contains" :seed {:a 1 :b 2})]
      (are [expect actual] (= expect actual)
           (contains? c :a) true
           (contains? c :b) true
           (contains? c :c) false
           (contains? c nil) false))))

(deftest test-put
  (let [c (create "puts")
        v {:foo [1 2 3] "p" "q"}]
    (is (nil? (put c :a v)))
    (is (= v (get c :a)))
    (is (= v (put c :a "next")))))

(deftest test-put-nil
  (let [c (create "nilly")]
    (is (= :right (:a c :right)))
    (is (nil? (put c :a nil)))
    (is (nil? (:a c :wrong)))
    (is (nil? (put c nil :right)))
    (is (= :right (get c nil :wrong)))))

(deftest test-put-ttl
  (let [c (create "ttl" :seed {})]
    (put c :a 1 {:ttl [500 :milliseconds]})
    (is (= 1 (get c :a)))
    (Thread/sleep 550)
    (is (nil? (get c :a)))))

(deftest test-put-default-ttl
  (let [c (create "ttl" :seed {} :ttl 500 :units :days)]
    (put c :a 1 {:units :milliseconds})
    (is (= 1 (get c :a)))
    (Thread/sleep 550)
    (is (nil? (get c :a)))))

(deftest test-put-idle
  (let [c (create "idle")]
    (put c :a 1 {:idle [500 :milliseconds]})
    (Thread/sleep 300)
    (is (= 1 (get c :a)))
    (Thread/sleep 300)
    (is (= 1 (get c :a)))
    (Thread/sleep 550)
    (is (nil? (get c :a)))))

(deftest test-put-if-absent-ttl
  (let [c (create "absent")]
    (is (nil? (:a c)))
    (is (nil? (put-if-absent c :a 1 {:ttl [300 :milliseconds]})))
    (is (= 1 (:a c)))
    (is (= 1 (put-if-absent c :a 2)))
    (is (= 1 (:a c)))
    (Thread/sleep 350)
    (is (nil? (:a c)))))

(deftest test-put-all-ttl
  (let [c (create "all")]
    (is (= 0 (count c)))
    (put-all c {:a 1 :b 2} {:ttl [300 :milliseconds]})
    (is (= 1 (:a c)))
    (is (= 2 (:b c)))
    (Thread/sleep 400)
    (is (nil? (:a c)))
    (is (nil? (:b c)))))

(deftest test-put-if-present
  (let [c (create "present" :seed {:a 1})]
    (is (nil? (put-if-present c :b 2)))
    (is (nil? (:b c)))
    (is (= 1 (put-if-present c :a 2)))
    (is (= 2 (:a c)))))

(deftest test-put-if-replace
  (let [c (create "replace" :seed {:a 1})]
    (is (false? (put-if-replace c :a 2 3)))
    (is (= 1 (:a c)))
    (is (true? (put-if-replace c :a 1 2)))
    (is (= 2 (:a c)))))

(deftest test-delete
  (let [c (create "delete" :seed {:a 1 :b 2})]
    (is (false? (delete c :a 2)))
    (is (= 2 (count c)))
    (is (true? (delete c :a 1)))
    (is (= 1 (count c)))
    (is (nil? (delete c :missing)))
    (is (= 2 (delete c :b)))
    (is (empty? c))))

(deftest test-delete-all
  (let [c (create "clear" :seed {:a 1 :b 2})]
    (is (= 2 (count c)))
    (is (= 0 (count (delete-all c))))
    (is (= 0 (count c)))))

(deftest test-seeding
  (let [c (create "foo" :seed {:a 1})
        d (lookup "foo")]
    (is (= (:a c) (:a d) 1))
    (put c :b 2)
    (is (= (:b c) (:b d) 2))
    (let [e (create "foo" :seed {})]
      (is (every? empty? [c d e])))))

(deftest test-persistent-seeding
  (let [c (create "cachey" :persist "src/test/resources/cache-store")
        cn (create "cachey-none" :encoding :none, :persist "src/test/resources/cache-store")]
    (is (= (:key c) 42))
    (is (= (:key cn) 42))))

(deftest test-persist-file-store
  (try
    (create "mike" :persist true)
    (is (.exists (io/file "Infinispan-FileCacheStore/mike")))
    (finally
     (io/delete-file "Infinispan-FileCacheStore/mike")
     (io/delete-file "Infinispan-FileCacheStore"))))

(deftest test-persist-file-store-with-parents
  (let [dir (io/file "target/gin/tonic")]
    (try
      (create "chas" :persist (str dir))
      (is (.exists dir))
      (finally
        (io/delete-file (io/file dir "chas"))
        (io/delete-file dir)
        (io/delete-file (.getParent dir))))))

(deftest test-create-restarts
  (let [c (create "terrence")]
    (put c :a 1)
    (is (= 1 (:a c)))
    (create "terrence")
    (is (empty? c))))

(deftest test-eviction
  (let [c (create "nelly" :max-entries 2)]
    (put c :a 1)
    (put c :b 2)
    (put c :c 3)
    (is (nil? (:a c)))
    (is (= 2 (count c)))))

(deftest test-seqable
  (let [seed {:a 1, :b {:c 42}}
        c (create "seedy" :seed seed)]
    (is (= seed (into {} (seq c))))))

(deftest default-to-local "should not raise exception"
  (create "remote" :mode :replicated))

(deftest lookup-of-stopped-cache "should return nil"
  (let [c (create "stopped")]
    (.stop (.cache c))
    (is (nil? (lookup "stopped")))))

Add a test to affirm [IMMUTANT-342]

Add a test to affirm [IMMUTANT-342]


(ns
    ^{:doc "Overtone mixers for left, right and mono channels"
      :author "Sam Aaron"}
  overtone.sc.mixer
  (:use [overtone.libs deps event]
        [overtone.helpers file]
        [overtone.sc synth ugens server info node buffer]
        [overtone.sc.machinery defaults]))

(defonce master-vol*  (ref MASTER-VOL))
(defonce master-gain* (ref MASTER-GAIN))
(defonce bus-mixers*  (ref {:in [] :out []}))

(add-watch master-vol*
           ::update-vol-on-server
           (fn [k r old new-vol]
             (ctl (main-mixer-group) :master-volume new-vol)))

(add-watch master-gain*
           ::update-gain-on-server
           (fn [k r old new-gain]
             (ctl (main-input-group) :master-gain new-gain)))

(on-event "/server-audio-clipping-rogue-vol"
          (fn [msg]
            (println "TOO LOUD!! (clipped) Bus:"
                     (int (nth (:args msg) 2))
                     "- lower master vol") )
          ::server-audio-clipping-warner-vol)

(defonce __BUS-MIXERS__
  (do
    (defsynth out-bus-mixer [out-bus 0
                             volume 0.5 master-volume @master-vol*
                             safe-recovery-time 3]
      (let [source    (in out-bus)
            source    (* volume master-volume source)
            not-safe? (trig1 (a2k (> source 1)) safe-recovery-time)
            safe-snd  (limiter source 0.99 0.001)]
        (send-reply not-safe?
                    "/server-audio-clipping-rogue-vol"
                    out-bus)
        (replace-out out-bus safe-snd)))

    (comment defsynth out-bus-mixer [out-bus 0
                             volume 0.5 master-volume @master-vol*
                             safe-recovery-time 3]
      (let [source    (in out-bus)
            source    (* volume master-volume source)
            not-safe? (trig1 (a2k (> source 1)) safe-recovery-time)
            safe-vol  (+ 0.1 (abs (- 1 not-safe?)))
            safe-vol  (lag2-ud safe-vol 1 0.1)
            snd-idx   (< safe-vol 0.5)
            snd       (select snd-idx [source (pink-noise)])
            safe-snd  (* safe-vol (clip2 snd 1))]
        (send-reply not-safe?
                    "/server-audio-clipping-rogue-vol"
                    out-bus)
        (replace-out out-bus safe-snd)))

    (defsynth in-bus-mixer [in-bus 0
                            gain 1 master-gain @master-gain*]
      (let [source  (in in-bus)
            source  (* gain master-gain source)]
        (replace-out in-bus source)))))

(defn- start-mixers
  []
  (ensure-connected!)
  (let [in-cnt     (with-server-sync #(server-num-input-buses))
        out-cnt    (with-server-sync #(server-num-output-buses))
        out-mixers (doall
                    (map
                     (fn [out-bus]
                       (out-bus-mixer :pos :head
                                      :target (main-mixer-group)
                                      :out-bus out-bus))
                     (range out-cnt)))
        in-mixers  (doall
                    (map
                     (fn [in-bus]
                       (in-bus-mixer :pos :head
                                     :target (main-input-group)
                                     :in-bus (+ out-cnt in-bus)))
                     (range in-cnt)))]

    (dosync
     (ref-set bus-mixers* {:in in-mixers :out out-mixers}))))

(on-deps [:core-groups-created :synthdefs-loaded] ::start-bus-mixers start-mixers)
(on-sync-event :shutdown ::reset-bus-mixers (fn [event-info]
                                              (dosync
                                               (ref-set bus-mixers* {:in [] :out []}))))

(defn volume
  "Set the volume on the master mixer. When called with no params, retrieves the
   current value"
  ([] @master-vol*)
  ([vol] (dosync (ref-set master-vol* vol))))

(defn input-gain
  "Set the input gain on the master mixer. When called with no params, retrieves
  the current value"
  ([] @master-gain*)
  ([gain] (dosync (ref-set master-gain* gain))))

(defonce __RECORDER__
  (defsynth master-recorder
    [out-buf 0]
    (disk-out out-buf (in 0 2))))

(defonce recorder-info* (ref nil))

(defn recording-start
  "Start recording a wav file to a new file at wav-path. Be careful -
  may generate very large files. See buffer-stream for a list of
  output options."
  [path & args]
  (if-let [info @recorder-info*]
    (throw (Exception. (str "Recording already taking place to: "
                            (get-in info [:buf-stream :path])))))

  (let [path (resolve-tilde-path path)
        bs   (apply buffer-stream path args)
        rec  (master-recorder :target (main-monitor-group) bs)]
    (dosync
     (ref-set recorder-info* {:rec-id rec
                              :buf-stream bs}))
    :recording-started))

(defn recording-stop
  "Stop system-wide recording. This frees the file and writes the wav headers.
  Returns the path of the file created."
  []
  (when-let [info (dosync
                   (let [old @recorder-info*]
                     (ref-set recorder-info* nil)
                     old))]
    (kill (:rec-id info))
    (buffer-stream-close (:buf-stream info))
    (get-in info [:buf-stream :path])))

(defn recording?
  []
  (not (nil? @recorder-info*)))

(ns
    ^{:doc "Overtone mixers for left, right and mono channels"
      :author "Sam Aaron"}
  overtone.sc.mixer
  (:use [overtone.libs deps event]
        [overtone.helpers file]
        [overtone.sc synth ugens server info node buffer]
        [overtone.sc.machinery defaults]
        [overtone.sc.machinery.server comms]))

(defonce master-vol*  (ref MASTER-VOL))
(defonce master-gain* (ref MASTER-GAIN))
(defonce bus-mixers*  (ref {:in [] :out []}))

(add-watch master-vol*
           ::update-vol-on-server
           (fn [k r old new-vol]
             (ctl (main-mixer-group) :master-volume new-vol)))

(add-watch master-gain*
           ::update-gain-on-server
           (fn [k r old new-gain]
             (ctl (main-input-group) :master-gain new-gain)))

(on-event "/server-audio-clipping-rogue-vol"
          (fn [msg]
            (println "TOO LOUD!! (clipped) Bus:"
                     (int (nth (:args msg) 2))
                     "- lower master vol") )
          ::server-audio-clipping-warner-vol)

(defonce __BUS-MIXERS__
  (do
    (defsynth out-bus-mixer [out-bus 0
                             volume 0.5 master-volume @master-vol*
                             safe-recovery-time 3]
      (let [source    (in out-bus)
            source    (* volume master-volume source)
            not-safe? (trig1 (a2k (> source 1)) safe-recovery-time)
            safe-snd  (limiter source 0.99 0.001)]
        (send-reply not-safe?
                    "/server-audio-clipping-rogue-vol"
                    out-bus)
        (replace-out out-bus safe-snd)))

    (comment defsynth out-bus-mixer [out-bus 0
                             volume 0.5 master-volume @master-vol*
                             safe-recovery-time 3]
      (let [source    (in out-bus)
            source    (* volume master-volume source)
            not-safe? (trig1 (a2k (> source 1)) safe-recovery-time)
            safe-vol  (+ 0.1 (abs (- 1 not-safe?)))
            safe-vol  (lag2-ud safe-vol 1 0.1)
            snd-idx   (< safe-vol 0.5)
            snd       (select snd-idx [source (pink-noise)])
            safe-snd  (* safe-vol (clip2 snd 1))]
        (send-reply not-safe?
                    "/server-audio-clipping-rogue-vol"
                    out-bus)
        (replace-out out-bus safe-snd)))

    (defsynth in-bus-mixer [in-bus 0
                            gain 1 master-gain @master-gain*]
      (let [source  (in in-bus)
            source  (* gain master-gain source)]
        (replace-out in-bus source)))))

(defn- start-mixers
  []
  (ensure-connected!)
  (let [in-cnt     (with-server-sync #(server-num-input-buses))
        out-cnt    (with-server-sync #(server-num-output-buses))
        out-mixers (doall
                    (map
                     (fn [out-bus]
                       (out-bus-mixer :pos :head
                                      :target (main-mixer-group)
                                      :out-bus out-bus))
                     (range out-cnt)))
        in-mixers  (doall
                    (map
                     (fn [in-bus]
                       (in-bus-mixer :pos :head
                                     :target (main-input-group)
                                     :in-bus (+ out-cnt in-bus)))
                     (range in-cnt)))]

    (dosync
     (ref-set bus-mixers* {:in in-mixers :out out-mixers}))))

(on-deps [:core-groups-created :synthdefs-loaded] ::start-bus-mixers start-mixers)
(on-sync-event :shutdown ::reset-bus-mixers (fn [event-info]
                                              (dosync
                                               (ref-set bus-mixers* {:in [] :out []}))))

(defn volume
  "Set the volume on the master mixer. When called with no params, retrieves the
   current value"
  ([] @master-vol*)
  ([vol] (dosync (ref-set master-vol* vol))))

(defn input-gain
  "Set the input gain on the master mixer. When called with no params, retrieves
  the current value"
  ([] @master-gain*)
  ([gain] (dosync (ref-set master-gain* gain))))

(defonce __RECORDER__
  (defsynth master-recorder
    [out-buf 0]
    (disk-out out-buf (in 0 2))))

(defonce recorder-info* (ref nil))

(defn recording-start
  "Start recording a wav file to a new file at wav-path. Be careful -
  may generate very large files. See buffer-stream for a list of
  output options."
  [path & args]
  (if-let [info @recorder-info*]
    (throw (Exception. (str "Recording already taking place to: "
                            (get-in info [:buf-stream :path])))))

  (let [path (resolve-tilde-path path)
        bs   (apply buffer-stream path args)
        rec  (master-recorder :target (main-monitor-group) bs)]
    (dosync
     (ref-set recorder-info* {:rec-id rec
                              :buf-stream bs}))
    :recording-started))

(defn recording-stop
  "Stop system-wide recording. This frees the file and writes the wav headers.
  Returns the path of the file created."
  []
  (when-let [info (dosync
                   (let [old @recorder-info*]
                     (ref-set recorder-info* nil)
                     old))]
    (kill (:rec-id info))
    (buffer-stream-close (:buf-stream info))
    (get-in info [:buf-stream :path])))

(defn recording?
  []
  (not (nil? @recorder-info*)))

Add missing :use clause

Add missing :use clause


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

(ns tailrecursion.boot.loader
  (:require
   [clojure.java.io      :as io]
   [clojure.string       :as string]
   [cemerick.pomegranate :as pom])
  (:gen-class))

(defmacro guard [expr & [default]]
  `(try ~expr (catch Throwable _# ~default)))

(defn info
  "Returns a map of version information for tailrecursion.boot.loader"
  []
  (let [[_ proj vers & kvs] (guard (read-string (slurp (io/resource "project.clj"))))
        {:keys [description url license]} (->> (partition 2 kvs)
                                               (map (partial apply vector))
                                               (into {}))]
    {:proj proj :vers vers :description description :url url :license license}))

(defn index-of [v val]
  (ffirst (filter (comp #{val} second) (map vector (range) v))))

(defn exclude [syms coordinate]
  (if-let [idx (index-of coordinate :exclusions)]
    (let [exclusions (get coordinate (inc idx))]
      (assoc coordinate (inc idx) (into exclusions syms)))
    (into coordinate [:exclusions syms])))

(defn transfer-listener
  [{type :type meth :method {name :name repo :repository} :resource err :error}]
  (when (.endsWith name ".jar")
    (case type
      :started              (printf "Retrieving %s from %s\n" name repo)
      (:corrupted :failed)  (when err (printf "Error: %s\n" (.getMessage err)))
      nil)
    (flush)))

(defn ^:from-leiningen build-url
  "Creates java.net.URL from string"
  [url]
  (try (java.net.URL. url)
       (catch java.net.MalformedURLException _
         (java.net.URL. (str "http://" url)))))

(defn ^:from-leiningen get-non-proxy-hosts []
  (let [system-no-proxy (System/getenv "no_proxy")]
    (if (not-empty system-no-proxy)
      (->> (string/split system-no-proxy #",")
           (map #(str "*" %))
           (string/join "|")))))

(defn ^:from-leiningen get-proxy-settings
  "Returns a map of the JVM proxy settings"
  ([] (get-proxy-settings "http_proxy"))
  ([key]
     (if-let [proxy (System/getenv key)]
       (let [url (build-url proxy)
             user-info (.getUserInfo url)
             [username password] (and user-info (.split user-info ":"))]
         {:host            (.getHost url)
          :port            (.getPort url)
          :username        username
          :password        password
          :non-proxy-hosts (get-non-proxy-hosts)}))))

(defn add-dependencies! [deps repos]
  (let [deps (mapv (partial exclude ['org.clojure/clojure]) deps)]
    (pom/add-dependencies :coordinates        deps
                          :repositories       (zipmap repos repos)
                          :transfer-listener  transfer-listener
                          :proxy              (get-proxy-settings))))

(defn -main [core-version arg0 & args]
  (add-dependencies!
    [['tailrecursion/boot.core core-version]]
    #{"http://repo1.maven.org/maven2/" "http://clojars.org/repo/"})
  (require 'tailrecursion.boot)
  (let [main (find-var (symbol "tailrecursion.boot" "-main"))]
    (try (apply main (info) arg0 args)
      (catch Throwable e (.printStackTrace e) (System/exit 1)))
    (System/exit 0)))

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

(ns tailrecursion.boot.loader
  (:require
   [clojure.java.io      :as io]
   [clojure.string       :as string]
   [cemerick.pomegranate :as pom])
  (:gen-class))

(defmacro guard [expr & [default]]
  `(try ~expr (catch Throwable _# ~default)))

(defn info
  "Returns a map of version information for tailrecursion.boot.loader"
  []
  (let [[_ & kvs] (guard (read-string (slurp (io/resource "project.clj"))))]
    (->> kvs (partition 2) (map (partial apply vector)) (into {}))))

(defn index-of [v val]
  (ffirst (filter (comp #{val} second) (map vector (range) v))))

(defn exclude [syms coordinate]
  (if-let [idx (index-of coordinate :exclusions)]
    (let [exclusions (get coordinate (inc idx))]
      (assoc coordinate (inc idx) (into exclusions syms)))
    (into coordinate [:exclusions syms])))

(defn transfer-listener
  [{type :type meth :method {name :name repo :repository} :resource err :error}]
  (when (.endsWith name ".jar")
    (case type
      :started              (printf "Retrieving %s from %s\n" name repo)
      (:corrupted :failed)  (when err (printf "Error: %s\n" (.getMessage err)))
      nil)
    (flush)))

(defn ^:from-leiningen build-url
  "Creates java.net.URL from string"
  [url]
  (try (java.net.URL. url)
       (catch java.net.MalformedURLException _
         (java.net.URL. (str "http://" url)))))

(defn ^:from-leiningen get-non-proxy-hosts []
  (let [system-no-proxy (System/getenv "no_proxy")]
    (if (not-empty system-no-proxy)
      (->> (string/split system-no-proxy #",")
           (map #(str "*" %))
           (string/join "|")))))

(defn ^:from-leiningen get-proxy-settings
  "Returns a map of the JVM proxy settings"
  ([] (get-proxy-settings "http_proxy"))
  ([key]
     (if-let [proxy (System/getenv key)]
       (let [url (build-url proxy)
             user-info (.getUserInfo url)
             [username password] (and user-info (.split user-info ":"))]
         {:host            (.getHost url)
          :port            (.getPort url)
          :username        username
          :password        password
          :non-proxy-hosts (get-non-proxy-hosts)}))))

(defn add-dependencies! [deps repos]
  (let [deps (mapv (partial exclude ['org.clojure/clojure]) deps)]
    (pom/add-dependencies :coordinates        deps
                          :repositories       (zipmap repos repos)
                          :transfer-listener  transfer-listener
                          :proxy              (get-proxy-settings))))

(defn -main [core-version arg0 & args]
  (add-dependencies!
    [['tailrecursion/boot.core core-version]]
    #{"http://repo1.maven.org/maven2/" "http://clojars.org/repo/"})
  (require 'tailrecursion.boot)
  (let [main (find-var (symbol "tailrecursion.boot" "-main"))]
    (try (apply main (info) arg0 args)
      (catch Throwable e (.printStackTrace e) (System/exit 1)))
    (System/exit 0)))

put entire project.clj in loader-info

put entire project.clj in loader-info


(ns mdr2.views
  (:require [ring.util.response :as response]
            [hiccup.form :as form]
            [hiccup.element :refer [link-to]]
            [cemerick.friend :as friend]
            [me.raynes.fs :as fs]
            [immutant.messaging :as msg]
            [mdr2.queues :as queues]
            [mdr2.production :as prod]
            [mdr2.state :as state]
            [mdr2.vubis :as vubis]
            [mdr2.layout :as layout]
            [mdr2.dtbook :refer [dtbook]]
            [mdr2.dtbook.validation :refer [validate-metadata]]
            [mdr2.pipeline1 :as pipeline]))

(defn home [request]
  (let [identity (friend/identity request)
        user (friend/current-authentication request)]
    (layout/common user
     [:h1 "Productions"]
     (layout/button-group
      [(layout/button "/production/upload" (layout/glyphicon "upload"))])
     [:table.table.table-striped
      [:thead [:tr [:th "Title"] [:th "State"] [:th "Action"]]]
      [:tbody
       (for [{:keys [id title state] :as production} (prod/find-all)]
         [:tr
          [:td (link-to (str "/production/" id) title)]
          [:td (state/to-str state)]
          [:td
           (layout/button-group
            (remove
             nil?
             [(layout/button (str "/production/" id ".xml")
                             (layout/glyphicon "download"))
              (layout/button (str "/production/" id "/upload")
                             (layout/glyphicon "upload"))
              (when-let [next-state (first (state/next-states state))]
                (form/form-to {:class "btn-group"}
                              [:post (str "/production/" id "/state")]
                              (form/hidden-field :state next-state)
                              [:button.btn.btn-default
                               ;; only allow setting the state to
                               ;; recorded if there is a DAISY export
                               (when (and (= next-state :recorded)
                                          (not (prod/manifest? production)))
                                 {:disabled "disabled"})
                               (layout/glyphicon "transfer") " " (state/to-str next-state)]))
              ;; (layout/dropdown (for [next (state/next-states state)]
              ;;                    (layout/menu-item "#" (state/to-str next)))
              ;;                  (layout/glyphicon "transfer"))
              (when (friend/authorized? #{:admin} identity)
                (layout/button (str "/production/" id "/delete")
                               (layout/glyphicon "trash")))]))]])]])))
(defn production [request id]
  (let [p (prod/find id)
        user (friend/current-authentication request)]
    (layout/common user
     [:h1 (str "Production: " (:title p))]
     (for [[k v] (sort-by first (seq p))]
       [:p [:b (layout/key-to-label k) ":"] " " v]))))

(defn production-xml [id]
  (let [production (prod/find id)]
    (-> (dtbook production)
        response/response
        (response/content-type "text/xml"))))

(defn file-upload-form [request id & [errors]]
  (let [p (prod/find id)
        user (friend/current-authentication request)]
    (layout/common user
     [:h1 "Upload"]
     [:p (str "Upload structure for " (:title p))]
     (when (seq? errors)
       [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
     (form/form-to
      {:enctype "multipart/form-data"}
      [:post (str "/production/" id "/upload")]
      (form/file-upload "file")
      (form/submit-button "Upload")))))

(defn production-add-xml [request id file]
  (let [{tempfile :tempfile} file
        path (.getPath tempfile)
        production (prod/find id)
        errors (concat
                (pipeline/validate path) ; validate XML
                (validate-metadata path production))] ; validate meta data
    (if (seq errors)
      (file-upload-form request id errors)
      (do
        ;; add the file
        (prod/add-structure production tempfile)
        ;; and redirect to the index
        (response/redirect "/")))))

(defn catalog [request]
  (let [identity (friend/identity request)
        user (friend/current-authentication request)]
    (layout/common user
                   [:h1 "Productions"]
     [:table.table.table-striped
      [:thead [:tr [:th "Title"] [:th "Product Number"] [:th "DAM Number"] [:th "Duration"] [:th "Number of CDs"] [:th "Depth"] [:th "Narrator"] [:th "Date of Production"] [:th "Libary signature"]]]
      [:tbody
       (for [{:keys [id title product_number total_time volumes depth narrator produced_date]
              :as production} (prod/find-by-state :encoded)]
         [:tr
          [:td (link-to (str "/production/" id) title)]
          [:td product_number]
          [:td (prod/dam-number production)]
          [:td total_time]
          [:td volumes]
          [:td depth]
          [:td narrator]
          [:td produced_date]
          [:td
           (form/form-to {:class "form-inline" :role "form"}
                         [:post (str "/catalog/" id)]
                         [:div.form-group
                          (form/label {:class "sr-only"} :library_signature "Signature")
                          (form/text-field
                           {:class "form-control" :placeholder "Enter Signature"}
                           :library_signature)
                          [:button.btn.btn-default
                           (layout/glyphicon "transfer")]])]])]])))

(defn production-catalog [request id library_signature]
  (let [user (friend/current-authentication request)
        p (assoc (prod/find id)
            :library_signature library_signature
            ;; the state is implicitly set to :cataloged if the
            ;; library_signature is set
            :state :cataloged)]
    (prod/update! p)
    ;; put the production on the archive queue
    (msg/publish (queues/archive) p)
    (response/redirect "/")))

(defn production-delete [id]
  (prod/delete id)
  (response/redirect "/"))

(defn production-bulk-import-form [request & [errors]]
  (let [user (friend/current-authentication request)]
    (layout/common user
     [:h1 "Upload new productions from Vubis XML"]
     (when (seq? errors)
       [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
     (form/form-to
      {:enctype "multipart/form-data"}
      [:post (str "/production/upload-confirm")]
      (form/file-upload "file")
      (form/submit-button "Upload")))))

(defn production-bulk-import-confirm-form [request productions]
  (let [user (friend/current-authentication request)
        keys [:title :creator :source :description :library_number :source_publisher :source_date]]
    (layout/common
     user
     [:h1 "Productions to import"]
     [:table.table.table-striped
      [:thead [:tr (for [k keys]
                     [:th (layout/key-to-label k)])]]
      [:tbody
       (for [p productions]
         [:tr (for [k keys]
                [:td (get p k)])])]]
     (form/form-to
      [:post "/production/upload"]
        (for [p productions]
          (for [k keys]
            (form/with-group "productions"
              (form/with-group (:library_number p)
                (form/hidden-field k (get p k))))))
      (form/submit-button {:class "btn btn-default"} "Confirm")))))

(defn production-bulk-import-confirm
  [request file]
  (let [{tempfile :tempfile} file
        errors (vubis/validate (.getPath tempfile))]
    (if (seq errors)
      (production-bulk-import-form request errors)
      (production-bulk-import-confirm-form request (vubis/read-file tempfile)))))

(defn production-bulk-import
  [request productions]
  (let [user (friend/current-authentication request)]
    (doseq [[_ p] productions]
      (prod/update-or-create! p))
    (response/redirect "/")))

(defn production-set-state [request id state-name]
  (let [user (friend/current-authentication request)
        state (state/from-str state-name)
        p (assoc (prod/find id) :state state)]
    (prod/update! p)
    (when (= state :recorded)
      (msg/publish (queues/encode) p))
    (response/redirect "/")))

(defn login-form []
  (layout/common nil
   [:h3 "Login"]
   (form/form-to
    [:post "/login"]
    [:div.form-group
     (form/label "username" "Username:")
     (form/text-field {:class "form-control"} "username")]
    [:div.form-group
     (form/label "password" "Password:")
     (form/password-field {:class "form-control"} "password")]
    (form/submit-button {:class "btn btn-default"} "Login"))))

(defn unauthorized [request]
  (let [user (friend/current-authentication request)]
    (->
     (layout/common user
      [:h2
       [:div.alert.alert-danger
        "Sorry, you do not have sufficient privileges to access "
        (:uri request)]]
      [:p "Please ask an administrator for help"])
     response/response
     (response/status 401))))

(ns mdr2.views
  (:require [ring.util.response :as response]
            [hiccup.form :as form]
            [hiccup.element :refer [link-to]]
            [cemerick.friend :as friend]
            [me.raynes.fs :as fs]
            [immutant.messaging :as msg]
            [mdr2.queues :as queues]
            [mdr2.production :as prod]
            [mdr2.state :as state]
            [mdr2.vubis :as vubis]
            [mdr2.layout :as layout]
            [mdr2.dtbook :refer [dtbook]]
            [mdr2.dtbook.validation :refer [validate-metadata]]
            [mdr2.pipeline1 :as pipeline]))

(defn home [request]
  (let [identity (friend/identity request)
        user (friend/current-authentication request)]
    (layout/common user
     [:h1 "Productions"]
     (layout/button-group
      [(layout/button "/production/upload" (layout/glyphicon "upload"))])
     [:table.table.table-striped
      [:thead [:tr [:th "Title"] [:th "State"] [:th "Action"]]]
      [:tbody
       (for [{:keys [id title state] :as production} (prod/find-all)]
         [:tr
          [:td (link-to (str "/production/" id) title)]
          [:td (state/to-str state)]
          [:td
           (layout/button-group
            (remove
             nil?
             [(layout/button (str "/production/" id ".xml")
                             (layout/glyphicon "download"))
              (layout/button (str "/production/" id "/upload")
                             (layout/glyphicon "upload"))
              (when-let [next-state (first (state/next-states state))]
                (form/form-to {:class "btn-group"}
                              [:post (str "/production/" id "/state")]
                              (form/hidden-field :state next-state)
                              [:button.btn.btn-default
                               ;; only allow setting the state to
                               ;; recorded if there is a DAISY export
                               (when (and (= next-state :recorded)
                                          (not (prod/manifest? production)))
                                 {:disabled "disabled"})
                               (layout/glyphicon "transfer") " " (state/to-str next-state)]))
              ;; (layout/dropdown (for [next (state/next-states state)]
              ;;                    (layout/menu-item "#" (state/to-str next)))
              ;;                  (layout/glyphicon "transfer"))
              (when (friend/authorized? #{:admin} identity)
                (layout/button (str "/production/" id "/delete")
                               (layout/glyphicon "trash")))]))]])]])))
(defn production [request id]
  (let [p (prod/find id)
        user (friend/current-authentication request)]
    (layout/common user
     [:h1 (str "Production: " (:title p))]
     (for [[k v] (sort-by first (seq p))]
       [:p [:b (layout/key-to-label k) ":"] " " v]))))

(defn production-xml [id]
  (let [production (prod/find id)]
    (-> (dtbook production)
        response/response
        (response/content-type "text/xml"))))

(defn file-upload-form [request id & [errors]]
  (let [p (prod/find id)
        user (friend/current-authentication request)]
    (layout/common user
     [:h1 "Upload"]
     [:p (str "Upload structure for " (:title p))]
     (when (seq errors)
       [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
     (form/form-to
      {:enctype "multipart/form-data"}
      [:post (str "/production/" id "/upload")]
      (form/file-upload "file")
      (form/submit-button "Upload")))))

(defn production-add-xml [request id file]
  (let [{tempfile :tempfile} file
        path (.getPath tempfile)
        production (prod/find id)
        errors (concat
                (pipeline/validate path) ; validate XML
                (validate-metadata path production))] ; validate meta data
    (if (seq errors)
      (file-upload-form request id errors)
      (do
        ;; add the file
        (prod/add-structure production tempfile)
        ;; and redirect to the index
        (response/redirect "/")))))

(defn catalog [request]
  (let [identity (friend/identity request)
        user (friend/current-authentication request)]
    (layout/common user
                   [:h1 "Productions"]
     [:table.table.table-striped
      [:thead [:tr [:th "Title"] [:th "Product Number"] [:th "DAM Number"] [:th "Duration"] [:th "Number of CDs"] [:th "Depth"] [:th "Narrator"] [:th "Date of Production"] [:th "Libary signature"]]]
      [:tbody
       (for [{:keys [id title product_number total_time volumes depth narrator produced_date]
              :as production} (prod/find-by-state :encoded)]
         [:tr
          [:td (link-to (str "/production/" id) title)]
          [:td product_number]
          [:td (prod/dam-number production)]
          [:td total_time]
          [:td volumes]
          [:td depth]
          [:td narrator]
          [:td produced_date]
          [:td
           (form/form-to {:class "form-inline" :role "form"}
                         [:post (str "/catalog/" id)]
                         [:div.form-group
                          (form/label {:class "sr-only"} :library_signature "Signature")
                          (form/text-field
                           {:class "form-control" :placeholder "Enter Signature"}
                           :library_signature)
                          [:button.btn.btn-default
                           (layout/glyphicon "transfer")]])]])]])))

(defn production-catalog [request id library_signature]
  (let [user (friend/current-authentication request)
        p (assoc (prod/find id)
            :library_signature library_signature
            ;; the state is implicitly set to :cataloged if the
            ;; library_signature is set
            :state :cataloged)]
    (prod/update! p)
    ;; put the production on the archive queue
    (msg/publish (queues/archive) p)
    (response/redirect "/")))

(defn production-delete [id]
  (prod/delete id)
  (response/redirect "/"))

(defn production-bulk-import-form [request & [errors]]
  (let [user (friend/current-authentication request)]
    (layout/common user
     [:h1 "Upload new productions from Vubis XML"]
     (when (seq errors)
       [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
     (form/form-to
      {:enctype "multipart/form-data"}
      [:post (str "/production/upload-confirm")]
      (form/file-upload "file")
      (form/submit-button "Upload")))))

(defn production-bulk-import-confirm-form [request productions]
  (let [user (friend/current-authentication request)
        keys [:title :creator :source :description :library_number :source_publisher :source_date]]
    (layout/common
     user
     [:h1 "Productions to import"]
     [:table.table.table-striped
      [:thead [:tr (for [k keys]
                     [:th (layout/key-to-label k)])]]
      [:tbody
       (for [p productions]
         [:tr (for [k keys]
                [:td (get p k)])])]]
     (form/form-to
      [:post "/production/upload"]
        (for [p productions]
          (for [k keys]
            (form/with-group "productions"
              (form/with-group (:library_number p)
                (form/hidden-field k (get p k))))))
      (form/submit-button {:class "btn btn-default"} "Confirm")))))

(defn production-bulk-import-confirm
  [request file]
  (let [{tempfile :tempfile} file
        errors (vubis/validate (.getPath tempfile))]
    (if (seq errors)
      (production-bulk-import-form request errors)
      (production-bulk-import-confirm-form request (vubis/read-file tempfile)))))

(defn production-bulk-import
  [request productions]
  (let [user (friend/current-authentication request)]
    (doseq [[_ p] productions]
      (prod/update-or-create! p))
    (response/redirect "/")))

(defn production-set-state [request id state-name]
  (let [user (friend/current-authentication request)
        state (state/from-str state-name)
        p (assoc (prod/find id) :state state)]
    (prod/update! p)
    (when (= state :recorded)
      (msg/publish (queues/encode) p))
    (response/redirect "/")))

(defn login-form []
  (layout/common nil
   [:h3 "Login"]
   (form/form-to
    [:post "/login"]
    [:div.form-group
     (form/label "username" "Username:")
     (form/text-field {:class "form-control"} "username")]
    [:div.form-group
     (form/label "password" "Password:")
     (form/password-field {:class "form-control"} "password")]
    (form/submit-button {:class "btn btn-default"} "Login"))))

(defn unauthorized [request]
  (let [user (friend/current-authentication request)]
    (->
     (layout/common user
      [:h2
       [:div.alert.alert-danger
        "Sorry, you do not have sufficient privileges to access "
        (:uri request)]]
      [:p "Please ask an administrator for help"])
     response/response
     (response/status 401))))

Use seq when you mean "not empty" instead of seq?


(ns frontend.controllers.ws
  "Websocket controllers"
  (:require [clojure.set]
            [frontend.api :as api]
            [frontend.favicon]
            [frontend.models.action :as action-model]
            [frontend.models.build :as build-model]
            [frontend.pusher :as pusher]
            [frontend.utils.seq :refer [find-index]]
            [frontend.state :as state]
            [frontend.utils :as utils :refer [mlog]])
  (:require-macros [frontend.utils :refer [inspect]]
                   [frontend.controllers.ws :refer [with-swallow-ignored-build-channels]]))

;; To subscribe to a channel, put a subscribe message in the websocket channel
;; with the channel name and the messages you want to listen to. That will be
;; handled in the post-ws controller.
;; Example: (put! ws-ch [:subscribe {:channel-name "my-channel" :messages [:my-message]}])
;;
;; Unsubscribe by putting an unsubscribe message in the channel with the channel name
;; Exampel: (put! ws-ch [:unsubscribe "my-channel"])
;; the api-post-controller can do any other actions

(defn fresh-channels
  "Returns all of the channels that a user should not be unsubscribed from"
  [state]
  (let [build (get-in state state/build-path)
        user (get-in state state/user-path)
        navigation-point (:navigation-point state)
        navigation-data (:navigation-data state)]
    (set (concat []
                 (when user [(pusher/user-channel user)])
                 (when build [(pusher/build-channel build)])
                 ;; Don't unsubscribe if the build takes a second to load
                 (when (= navigation-point :build)
                   [(pusher/build-channel-from-parts {:project-name (:project navigation-data)
                                                      :build-num (:build-num navigation-data)})])))))

(defn ignore-build-channel?
  "Returns true if we should ignore pusher updates for the given channel-name. This will be
  true if the channel is stale or if the build hasn't finished loading."
  [state channel-name]
  (and (get-in state state/build-path)
       (not= channel-name (pusher/build-channel (get-in state state/build-path)))))

(defn usage-queue-build-index-from-channel-name [state channel-name]
  "Returns index if there is a usage-queued build showing with the given channel name"
  (when-let [builds (seq (get-in state state/usage-queue-path))]
    (find-index #(= channel-name (pusher/build-channel %)) builds)))

;; --- Navigation Multimethod Declarations ---

(defmulti ws-event
  (fn [pusher-imp message args state] message))

(defmulti post-ws-event!
  (fn [pusher-imp message args previous-state current-state] message))

;; --- Navigation Mutlimethod Implementations ---

(defmethod ws-event :default
  [pusher-imp message args state]
  (mlog "Unknown ws event: " (pr-str message))
  state)

(defmethod post-ws-event! :default
  [pusher-imp message args previous-state current-state]
  (mlog "No post-ws for: " message))

(defmethod ws-event :build/update
  [pusher-imp message {:keys [data channel-name]} state]
  (if-not (ignore-build-channel? state channel-name)
    (update-in state state/build-path merge (utils/js->clj-kw data))
    (if-let [index (usage-queue-build-index-from-channel-name state channel-name)]
      (update-in state (state/usage-queue-build-path index) merge (utils/js->clj-kw data))
      state)))

(defmethod post-ws-event! :build/update
  [pusher-imp message {:keys [data channel-name]} previous-state current-state]
  (when-not (ignore-build-channel? current-state channel-name)
    (frontend.favicon/set-color! (build-model/favicon-color (utils/js->clj-kw data)))))

(defmethod ws-event :build/new-action
  [pusher-imp message {:keys [data channel-name]} state]
  (with-swallow-ignored-build-channels state channel-name
    (reduce (fn [state {action-index :step container-index :index action-log :log}]
              (-> state
                  (build-model/fill-containers container-index action-index)
                  (assoc-in (state/action-path container-index action-index) action-log)
                  (update-in (state/action-path container-index action-index) action-model/format-latest-output)))
            state (utils/js->clj-kw data))))

(defmethod ws-event :build/update-action
  [pusher-imp message {:keys [data channel-name]} state]
  (with-swallow-ignored-build-channels state channel-name
    (reduce (fn [state {action-index :step container-index :index action-log :log}]
              (-> state
                  (build-model/fill-containers container-index action-index)
                  (update-in (state/action-path container-index action-index) merge action-log)))
            state (utils/js->clj-kw data))))

(defmethod ws-event :build/append-action
  [pusher-imp message {:keys [data channel-name]} state]
  (with-swallow-ignored-build-channels state channel-name
    (reduce (fn [state data]
              (let [container-index (aget data "index")
                    action-index (aget data "step")]
                (if (not= container-index (get-in state state/current-container-path 0))
                  (do (mlog "Ignoring output for inactive container: " container-index)
                      (update-in state (state/action-path container-index action-index) assoc :missing-pusher-output true :has_output true))

                  (let [output (utils/js->clj-kw (aget data "out"))]
                    (-> state
                        (build-model/fill-containers container-index action-index)
                        (update-in (state/action-output-path container-index action-index) vec)
                        (update-in (state/action-output-path container-index action-index) conj output)
                        (update-in (state/action-path container-index action-index) action-model/format-latest-output))))))
            state data)))

(defmethod ws-event :build/add-messages
  [pusher-imp message {:keys [data channel-name]} state]
  (let [build (get-in state state/build-path)
        new-messages (set (utils/js->clj-kw data))]
    (with-swallow-ignored-build-channels state channel-name
      (update-in state (conj state/build-path :messages)
                 (fn [messages] (-> messages
                                    set ;; careful not to add the same message twice
                                    (clojure.set/union new-messages)))))))

(defmethod post-ws-event! :subscribe
  [pusher-imp message {:keys [channel-name messages context]} previous-state current-state]
  (let [ws-ch (get-in current-state [:comms :ws])]
    (mlog "subscribing to " channel-name)
    (pusher/subscribe pusher-imp channel-name ws-ch :messages messages :context context)))

(defmethod post-ws-event! :unsubscribe
  [pusher-imp message channel-name previous-state current-state]
  (pusher/unsubscribe pusher-imp channel-name))

(defmethod post-ws-event! :unsubscribe-stale-channels
  [pusher-imp message _ previous-state current-state]
  (doseq [channel-name (clojure.set/difference (pusher/subscribed-channels pusher-imp)
                                               (fresh-channels current-state))]
    (mlog "unsubscribing from " channel-name)
    (pusher/unsubscribe pusher-imp channel-name)))

(defmethod post-ws-event! :refresh
  [pusher-imp message _ previous-state current-state]
  (let [navigation-point (:navigation-point current-state)
        api-ch (get-in current-state [:comms :api])]
    (api/get-projects api-ch)
    (condp = navigation-point
      :build (when (get-in current-state state/show-usage-queue-path)
               (api/get-usage-queue (get-in current-state state/build-path) api-ch))
      :dashboard (api/get-dashboard-builds (assoc (:navigation-data current-state)
                                             :builds-per-page (:builds-per-page current-state))
                                           api-ch)
      nil)))

(ns frontend.controllers.ws
  "Websocket controllers"
  (:require [clojure.set]
            [frontend.api :as api]
            [frontend.favicon]
            [frontend.models.action :as action-model]
            [frontend.models.build :as build-model]
            [frontend.pusher :as pusher]
            [frontend.utils.seq :refer [find-index]]
            [frontend.state :as state]
            [frontend.utils :as utils :refer [mlog]])
  (:require-macros [frontend.utils :refer [inspect]]
                   [frontend.controllers.ws :refer [with-swallow-ignored-build-channels]]))

;; To subscribe to a channel, put a subscribe message in the websocket channel
;; with the channel name and the messages you want to listen to. That will be
;; handled in the post-ws controller.
;; Example: (put! ws-ch [:subscribe {:channel-name "my-channel" :messages [:my-message]}])
;;
;; Unsubscribe by putting an unsubscribe message in the channel with the channel name
;; Exampel: (put! ws-ch [:unsubscribe "my-channel"])
;; the api-post-controller can do any other actions

(defn fresh-channels
  "Returns all of the channels that a user should not be unsubscribed from"
  [state]
  (let [build (get-in state state/build-path)
        user (get-in state state/user-path)
        navigation-point (:navigation-point state)
        navigation-data (:navigation-data state)]
    (set (concat []
                 (when user [(pusher/user-channel user)])
                 (when build [(pusher/build-channel build)])
                 ;; Don't unsubscribe if the build takes a second to load
                 (when (= navigation-point :build)
                   [(pusher/build-channel-from-parts {:project-name (:project navigation-data)
                                                      :build-num (:build-num navigation-data)})])))))

(defn ignore-build-channel?
  "Returns true if we should ignore pusher updates for the given channel-name. This will be
  true if the channel is stale or if the build hasn't finished loading."
  [state channel-name]
  (if-let [build (get-in state state/build-path)]
    (not= channel-name (pusher/build-channel build))
    true))

(defn usage-queue-build-index-from-channel-name [state channel-name]
  "Returns index if there is a usage-queued build showing with the given channel name"
  (when-let [builds (seq (get-in state state/usage-queue-path))]
    (find-index #(= channel-name (pusher/build-channel %)) builds)))

;; --- Navigation Multimethod Declarations ---

(defmulti ws-event
  (fn [pusher-imp message args state] message))

(defmulti post-ws-event!
  (fn [pusher-imp message args previous-state current-state] message))

;; --- Navigation Mutlimethod Implementations ---

(defmethod ws-event :default
  [pusher-imp message args state]
  (mlog "Unknown ws event: " (pr-str message))
  state)

(defmethod post-ws-event! :default
  [pusher-imp message args previous-state current-state]
  (mlog "No post-ws for: " message))

(defmethod ws-event :build/update
  [pusher-imp message {:keys [data channel-name]} state]
  (if-not (ignore-build-channel? state channel-name)
    (update-in state state/build-path merge (utils/js->clj-kw data))
    (if-let [index (usage-queue-build-index-from-channel-name state channel-name)]
      (update-in state (state/usage-queue-build-path index) merge (utils/js->clj-kw data))
      state)))

(defmethod post-ws-event! :build/update
  [pusher-imp message {:keys [data channel-name]} previous-state current-state]
  (when-not (ignore-build-channel? current-state channel-name)
    (frontend.favicon/set-color! (build-model/favicon-color (utils/js->clj-kw data)))))

(defmethod ws-event :build/new-action
  [pusher-imp message {:keys [data channel-name]} state]
  (with-swallow-ignored-build-channels state channel-name
    (reduce (fn [state {action-index :step container-index :index action-log :log}]
              (-> state
                  (build-model/fill-containers container-index action-index)
                  (assoc-in (state/action-path container-index action-index) action-log)
                  (update-in (state/action-path container-index action-index) action-model/format-latest-output)))
            state (utils/js->clj-kw data))))

(defmethod ws-event :build/update-action
  [pusher-imp message {:keys [data channel-name]} state]
  (with-swallow-ignored-build-channels state channel-name
    (reduce (fn [state {action-index :step container-index :index action-log :log}]
              (-> state
                  (build-model/fill-containers container-index action-index)
                  (update-in (state/action-path container-index action-index) merge action-log)))
            state (utils/js->clj-kw data))))

(defmethod ws-event :build/append-action
  [pusher-imp message {:keys [data channel-name]} state]
  (with-swallow-ignored-build-channels state channel-name
    (reduce (fn [state data]
              (let [container-index (aget data "index")
                    action-index (aget data "step")]
                (if (not= container-index (get-in state state/current-container-path 0))
                  (do (mlog "Ignoring output for inactive container: " container-index)
                      (update-in state (state/action-path container-index action-index) assoc :missing-pusher-output true :has_output true))

                  (let [output (utils/js->clj-kw (aget data "out"))]
                    (-> state
                        (build-model/fill-containers container-index action-index)
                        (update-in (state/action-output-path container-index action-index) vec)
                        (update-in (state/action-output-path container-index action-index) conj output)
                        (update-in (state/action-path container-index action-index) action-model/format-latest-output))))))
            state data)))

(defmethod ws-event :build/add-messages
  [pusher-imp message {:keys [data channel-name]} state]
  (let [build (get-in state state/build-path)
        new-messages (set (utils/js->clj-kw data))]
    (with-swallow-ignored-build-channels state channel-name
      (update-in state (conj state/build-path :messages)
                 (fn [messages] (-> messages
                                    set ;; careful not to add the same message twice
                                    (clojure.set/union new-messages)))))))

(defmethod post-ws-event! :subscribe
  [pusher-imp message {:keys [channel-name messages context]} previous-state current-state]
  (let [ws-ch (get-in current-state [:comms :ws])]
    (mlog "subscribing to " channel-name)
    (pusher/subscribe pusher-imp channel-name ws-ch :messages messages :context context)))

(defmethod post-ws-event! :unsubscribe
  [pusher-imp message channel-name previous-state current-state]
  (pusher/unsubscribe pusher-imp channel-name))

(defmethod post-ws-event! :unsubscribe-stale-channels
  [pusher-imp message _ previous-state current-state]
  (doseq [channel-name (clojure.set/difference (pusher/subscribed-channels pusher-imp)
                                               (fresh-channels current-state))]
    (mlog "unsubscribing from " channel-name)
    (pusher/unsubscribe pusher-imp channel-name)))

(defmethod post-ws-event! :refresh
  [pusher-imp message _ previous-state current-state]
  (let [navigation-point (:navigation-point current-state)
        api-ch (get-in current-state [:comms :api])]
    (api/get-projects api-ch)
    (condp = navigation-point
      :build (when (get-in current-state state/show-usage-queue-path)
               (api/get-usage-queue (get-in current-state state/build-path) api-ch))
      :dashboard (api/get-dashboard-builds (assoc (:navigation-data current-state)
                                             :builds-per-page (:builds-per-page current-state))
                                           api-ch)
      nil)))

fix ignore-build-channel?

fix ignore-build-channel?


(ns elephantdb.keyval.core
  "Functions for connecting the an ElephantDB (key-value) service via
  Thrift."
  (:use [elephantdb.common.domain :only (loaded?)]
        [metrics.timers :only (timer time! time-fn!)]
        [metrics.meters :only (meter mark!)]
        [elephantdb.common.graphite :only (report-to-graphite)])
  (:require [jackknife.core :as u]
            [jackknife.logging :as log]
            [elephantdb.common.database :as db]
            [elephantdb.common.status :as status]
            [elephantdb.common.thrift :as thrift]
            [elephantdb.common.config :as conf]
            [elephantdb.keyval.domain :as dom])
  (:import [java.nio ByteBuffer]
           [org.apache.thrift.protocol TBinaryProtocol]
           [org.apache.thrift.transport TTransport]
           [org.apache.thrift TException]
           [elephantdb.common.database Database]
           [elephantdb.common.domain Domain]
           [elephantdb.generated DomainNotFoundException
            DomainNotLoadedException WrongHostException]
           [elephantdb.generated.keyval ElephantDB$Client
            ElephantDB$Iface ElephantDB$Processor])
  (:gen-class))

;; ## Metrics

(def multi-get-response-time (timer ["elephantdb" "keyval" "multi-get-response-time"]))
(def direct-get-response-time (timer ["elephantdb" "keyval" "direct-get-response-time"]))

(def multi-get-requests (meter ["elephantdb" "keyval" "multi-get-requests"] "requests"))
(def direct-get-requests (meter ["elephantdb" "keyval" "direct-get-requests"] "requests"))

;; ## Thrift Connection

(defn kv-client [transport]
  (ElephantDB$Client. (TBinaryProtocol. transport)))

(defn kv-processor
  "Returns a key-value thrift processor suitable for passing into
  launch-server!"
  [service-handler]
  (ElephantDB$Processor. service-handler))

(defmacro with-kv-connection
  [host port client-sym & body]
  `(with-open [^TTransport conn# (doto (thrift/thrift-transport ~host ~port)
                                   (.open))]
     (let [^ElephantDB$Client ~client-sym (kv-client conn#)]
       ~@body)))

;; ## Service Handler

(defn byte-buffer-wrap
  "Wraps a collection of byte arrays in ByteBuffers."
  [coll]
  (map (fn [^bytes x]
         (ByteBuffer/wrap x)) coll))

(defn byte-buffer-unwrap
  "Unwraps a collection of byte arrays from inside Byte Buffers."
  [coll]
  (map (fn [^ByteBuffer x]
         (let [ret (byte-array (.remaining x))]
           (.get x ret)
           ret))
       coll))

(defn update-keys
  "Returns a map with f applied to the keys of amap."
  [amap f]
  (into {} (for [[k v] amap]
             [(f k) v])))

(defn try-direct-multi-get
  "Attempts a direct multi-get to the supplied service for each of the
  keys in the supplied `key-seq`."
  [^ElephantDB$Iface service domain-name error-suffix key-seq]
  (let [key-set (into #{} (byte-buffer-wrap key-seq))]
    (try (.directMultiGet service domain-name key-set)
         (catch TException e
           (log/error e "Thrift exception on " error-suffix "trying next host")) ;; try next host
         (catch WrongHostException e
           (log/error e "Fatal exception on " error-suffix)
           (throw (TException. "Fatal exception when performing get" e)))
         (catch DomainNotFoundException e
           (log/error e "Could not find domain when executing read on " error-suffix)
           (throw e))
         (catch DomainNotLoadedException e
           (log/error e "Domain not loaded when executing read on " error-suffix)
           (throw e)))))

;; multi-get* recieves a sequence of indexed-keys. Each of these is a
;; map with :index, :key and :host keys. On success, it returns the
;; indexed-keys input with :value keys associated onto every map. On
;; failure it throws an exception, or returns nil.

(defn multi-get*
  [service domain-name database localhost hostname indexed-keys]
  (let [port     (:port database)
        key-seq (map :key indexed-keys)
        suffix   (format "%s:%s/%s" hostname domain-name key-seq)]
    (when-let [results-map (if (= localhost hostname)
                             (try-direct-multi-get service
                                                   domain-name
                                                   suffix
                                                   key-seq)
                             (with-kv-connection hostname port remote-service
                               (try-direct-multi-get remote-service
                                                     domain-name
                                                     suffix
                                                     key-seq)))]
      results-map)))

;; TODO: Perfect example of a spot where we could throw a data
;; structure warning up with throw+ if the database isn't loaded.

(defn direct-multiget [database domain-name key-seq]
  (let [domain (db/domain-get database domain-name)]
    (when (loaded? domain)
      (into {} (for [key key-seq]
                    {key (thrift/mk-value (dom/kv-get domain key))})))))

;; ## MultiGet

(defn multi-get
  [get-fn database domain-name key-seq]
  (let [indexed-keys (-> (db/domain-get database domain-name)
                         (dom/index-keys key-seq))]
    (if-let [bad-key (some (comp empty? :hosts) indexed-keys)]
      (throw (thrift/hosts-down-ex (:all-hosts bad-key)))
      (let [host-map (group-by :hosts indexed-keys)
            promises (u/do-pmap
                      (fn [[hosts indexed-keys]]
                        (let [p (promise)]
                          (u/do-pmap (fn [host]
                                       (when-not (realized? p)
                                         (deliver p (get-fn host indexed-keys)))) hosts)
                          p))
                      host-map)]
        (update-keys (apply into {} (map deref promises)) #(ByteBuffer/wrap %))))))

(defn kv-get-fn
  [service domain-name database]
  (partial multi-get*
           service
           domain-name
           database
           (u/local-hostname)))

;; TODO: Catch errors if we're not dealing specifically with a byte array.

(defn kv-service [database]
  (reify ElephantDB$Iface
    (directMultiGet [_ domain-name key-set]
      (thrift/assert-domain database domain-name)
      (let [key-seq (byte-buffer-unwrap key-set)]
        (mark! direct-get-requests)
        (try (if-let [results-map (time! direct-get-response-time (direct-multiget database domain-name key-seq))]
               results-map
               (throw (thrift/domain-not-loaded-ex)))
             (catch RuntimeException _
               (throw (thrift/wrong-host-ex))))))

    (multiGet [this domain-name key-set]
      (thrift/assert-domain database domain-name)
      (let [get-fn (kv-get-fn this domain-name database)]
        (mark! multi-get-requests)
        (time! multi-get-response-time
               (multi-get get-fn
                          database
                          domain-name
                          (byte-buffer-unwrap key-set)))))

    (get [this domain-name key]
      (thrift/assert-domain database domain-name)
      (let [get-fn (kv-get-fn this domain-name database)
            ret (byte-array (.remaining key))]
        (.get key ret)
        (first (multi-get get-fn database domain-name [ret]))))

    (getDomainStatus [_ domain-name]
      "Returns the thrift status of the supplied domain-name."
      (thrift/assert-domain database domain-name)
      (-> (db/domain-get database domain-name)
          (status/get-status)
          (thrift/to-thrift)))

    (getDomains [_]
      "Returns a sequence of all domain names being served."
      (db/domain-names database))

    (getStatus [_]
      "Returns a map of domain-name->status for each domain."
      (thrift/elephant-status
       (u/update-vals (db/domain->status database)
                      (fn [_ status] (thrift/to-thrift status)))))

    (isFullyLoaded [_]
      "Are all domains loaded properly?"
      (db/fully-loaded? database))

    (isUpdating [_]
      "Is some domain currently updating?"
      (db/some-loading? database))

    (update [_ domain-name]
      "If an update is available, updates the named domain and
         hotswaps the new version."
      (thrift/assert-domain database domain-name)
      (u/with-ret true
        (db/attempt-update! database domain-name)))

    (updateAll [_]
      "If an update is available on any domain, updates the domain's
         shards from its remote store and hotswaps in the new versions."
      (u/with-ret true
        (db/update-all! database)))

    (getCount [_ domain-name]
      "Returns the total count of KeyValDocuments in the supplied domain-name."
      (thrift/assert-domain database domain-name)
      (-> (db/domain-get database domain-name)
          (dom/kv-count)))))

;; # Main Access
;;
;; This namespace is the main access point to the edb
;; code. elephantdb.keyval/-main Boots up the ElephantDB service and
;; an updater process that watches all domains and trigger an atomic
;; update in the background when some new version appears.
;;
;; TODO: Booting needs a little work; I'll do this along with the
;; deploy.

(defn -main
  "Main booting function for all of EDB. Pass in:

  `global-config-hdfs-path`: the hdfs path of `global-config.clj`

  `local-config-path`: the path to `local-config.clj` on this machine."
  [global-config-hdfs-path local-config-path]
  (log/configure-logging "log4j/log4j.properties")
  (let [local-config   (conf/read-local-config  local-config-path)
        global-config  (conf/read-global-config global-config-hdfs-path
                                                local-config)
        conf-map (merge global-config local-config)
        database (db/build-database conf-map)]
    (doto database
      (db/prepare)
      (db/launch-updater! (:update-interval-s conf-map)))
    (when-let [graphite-conf (:graphite-conf local-config)]
      (log/info "Graphite reporter started.")
      (report-to-graphite (:host graphite-conf) (:port graphite-conf)))
    (thrift/launch-server! kv-processor
                           (kv-service database)
                           (:port conf-map))))

;; For debugging in the a repl

(defn debug-database
  "Main booting function for all of EDB. Pass in:

  `global-config-hdfs-path`: the hdfs path of `global-config.clj`

  `local-config-path`: the path to `local-config.clj` on this machine."
  [global-config-hdfs-path local-config-path]
  (log/configure-logging "log4j/log4j.properties")
  (let [local-config   (conf/read-local-config  local-config-path)
        global-config  (conf/read-global-config global-config-hdfs-path
                                                local-config)
        conf-map (merge global-config local-config)
        database (db/build-database conf-map)]
    (doto database
      (db/prepare)
      (db/launch-updater! (:update-interval-s conf-map)))))

(ns elephantdb.keyval.core
  "Functions for connecting the an ElephantDB (key-value) service via
  Thrift."
  (:use [elephantdb.common.domain :only (loaded?)]
        [metrics.timers :only (timer time! time-fn!)]
        [metrics.meters :only (meter mark!)]
        [elephantdb.common.graphite :only (report-to-graphite)])
  (:require [jackknife.core :as u]
            [jackknife.logging :as log]
            [elephantdb.common.database :as db]
            [elephantdb.common.status :as status]
            [elephantdb.common.thrift :as thrift]
            [elephantdb.common.config :as conf]
            [elephantdb.keyval.domain :as dom])
  (:import [java.nio ByteBuffer]
           [org.apache.thrift.protocol TBinaryProtocol]
           [org.apache.thrift.transport TTransport]
           [org.apache.thrift TException]
           [elephantdb.common.database Database]
           [elephantdb.common.domain Domain]
           [elephantdb.generated DomainNotFoundException
            DomainNotLoadedException WrongHostException]
           [elephantdb.generated.keyval ElephantDB$Client
            ElephantDB$Iface ElephantDB$Processor])
  (:gen-class))

;; ## Metrics

(def multi-get-response-time (timer ["elephantdb" "keyval" "multi-get-response-time"]))
(def direct-get-response-time (timer ["elephantdb" "keyval" "direct-get-response-time"]))

(def multi-get-requests (meter ["elephantdb" "keyval" "multi-get-requests"] "requests"))
(def direct-get-requests (meter ["elephantdb" "keyval" "direct-get-requests"] "requests"))

;; ## Thrift Connection

(defn kv-client [transport]
  (ElephantDB$Client. (TBinaryProtocol. transport)))

(defn kv-processor
  "Returns a key-value thrift processor suitable for passing into
  launch-server!"
  [service-handler]
  (ElephantDB$Processor. service-handler))

(defmacro with-kv-connection
  [host port client-sym & body]
  `(with-open [^TTransport conn# (doto (thrift/thrift-transport ~host ~port)
                                   (.open))]
     (let [^ElephantDB$Client ~client-sym (kv-client conn#)]
       ~@body)))

;; ## Service Handler

(defn byte-buffer-wrap
  "Wraps a collection of byte arrays in ByteBuffers."
  [coll]
  (map (fn [^bytes x]
         (ByteBuffer/wrap x)) coll))

(defn byte-buffer-unwrap
  "Unwraps a collection of byte arrays from inside Byte Buffers."
  [coll]
  (map (fn [^ByteBuffer x]
         (let [ret (byte-array (.remaining x))]
           (.get x ret)
           ret))
       coll))

(defn update-keys
  "Returns a map with f applied to the keys of amap."
  [amap f]
  (into {} (for [[k v] amap]
             [(f k) v])))

(defn try-direct-multi-get
  "Attempts a direct multi-get to the supplied service for each of the
  keys in the supplied `key-seq`."
  [^ElephantDB$Iface service domain-name error-suffix key-seq]
  (let [key-set (into #{} (byte-buffer-wrap key-seq))]
    (try (.directMultiGet service domain-name key-set)
         (catch TException e
           (log/error e "Thrift exception on " error-suffix "trying next host")) ;; try next host
         (catch WrongHostException e
           (log/error e "Fatal exception on " error-suffix)
           (throw (TException. "Fatal exception when performing get" e)))
         (catch DomainNotFoundException e
           (log/error e "Could not find domain when executing read on " error-suffix)
           (throw e))
         (catch DomainNotLoadedException e
           (log/error e "Domain not loaded when executing read on " error-suffix)
           (throw e)))))

;; multi-get* recieves a sequence of indexed-keys. Each of these is a
;; map with :index, :key and :host keys. On success, it returns the
;; indexed-keys input with :value keys associated onto every map. On
;; failure it throws an exception, or returns nil.

(defn multi-get*
  [service domain-name database localhost hostname indexed-keys]
  (let [port     (:port database)
        key-seq (map :key indexed-keys)
        suffix   (format "%s:%s/%s" hostname domain-name key-seq)]
    (when-let [results-map (if (= localhost hostname)
                             (try-direct-multi-get service
                                                   domain-name
                                                   suffix
                                                   key-seq)
                             (with-kv-connection hostname port remote-service
                               (try-direct-multi-get remote-service
                                                     domain-name
                                                     suffix
                                                     key-seq)))]
      results-map)))

;; TODO: Perfect example of a spot where we could throw a data
;; structure warning up with throw+ if the database isn't loaded.

(defn direct-multiget [database domain-name key-seq]
  (let [domain (db/domain-get database domain-name)]
    (when (loaded? domain)
      (into {} (map (fn [key]
                      {(ByteBuffer/wrap key) (thrift/mk-value (dom/kv-get domain key))}) key-seq)))))

;; ## MultiGet

(defn multi-get
  [get-fn database domain-name key-seq]
  (let [indexed-keys (-> (db/domain-get database domain-name)
                         (dom/index-keys key-seq))]
    (if-let [bad-key (some (comp empty? :hosts) indexed-keys)]
      (throw (thrift/hosts-down-ex (:all-hosts bad-key)))
      (let [host-map (group-by :hosts indexed-keys)
            promises (u/do-pmap
                      (fn [[hosts indexed-keys]]
                        (let [p (promise)]
                          (u/do-pmap (fn [host]
                                       (when-not (realized? p)
                                         (deliver p (get-fn host indexed-keys)))) hosts)
                          p))
                      host-map)]
        (into {} (map deref promises))))))

(defn kv-get-fn
  [service domain-name database]
  (partial multi-get*
           service
           domain-name
           database
           (u/local-hostname)))

;; TODO: Catch errors if we're not dealing specifically with a byte array.

(defn kv-service [database]
  (reify ElephantDB$Iface
    (directMultiGet [_ domain-name key-set]
      (thrift/assert-domain database domain-name)
      (let [key-seq (byte-buffer-unwrap key-set)]
        (mark! direct-get-requests)
        (try (if-let [results-map (time! direct-get-response-time (direct-multiget database domain-name key-seq))]
               results-map
               (throw (thrift/domain-not-loaded-ex)))
             (catch RuntimeException _
               (throw (thrift/wrong-host-ex))))))

    (multiGet [this domain-name key-set]
      (thrift/assert-domain database domain-name)
      (let [get-fn (kv-get-fn this domain-name database)]
        (mark! multi-get-requests)
        (time! multi-get-response-time
               (multi-get get-fn
                          database
                          domain-name
                          (byte-buffer-unwrap key-set)))))

    (get [this domain-name key]
      (thrift/assert-domain database domain-name)
      (let [get-fn (kv-get-fn this domain-name database)
            ret (byte-array (.remaining key))]
        (.get key ret)
        (clojure.core/get (multi-get get-fn database domain-name [ret]) key)))

    (getDomainStatus [_ domain-name]
      "Returns the thrift status of the supplied domain-name."
      (thrift/assert-domain database domain-name)
      (-> (db/domain-get database domain-name)
          (status/get-status)
          (thrift/to-thrift)))

    (getDomains [_]
      "Returns a sequence of all domain names being served."
      (db/domain-names database))

    (getStatus [_]
      "Returns a map of domain-name->status for each domain."
      (thrift/elephant-status
       (u/update-vals (db/domain->status database)
                      (fn [_ status] (thrift/to-thrift status)))))

    (isFullyLoaded [_]
      "Are all domains loaded properly?"
      (db/fully-loaded? database))

    (isUpdating [_]
      "Is some domain currently updating?"
      (db/some-loading? database))

    (update [_ domain-name]
      "If an update is available, updates the named domain and
         hotswaps the new version."
      (thrift/assert-domain database domain-name)
      (u/with-ret true
        (db/attempt-update! database domain-name)))

    (updateAll [_]
      "If an update is available on any domain, updates the domain's
         shards from its remote store and hotswaps in the new versions."
      (u/with-ret true
        (db/update-all! database)))

    (getCount [_ domain-name]
      "Returns the total count of KeyValDocuments in the supplied domain-name."
      (thrift/assert-domain database domain-name)
      (-> (db/domain-get database domain-name)
          (dom/kv-count)))))

;; # Main Access
;;
;; This namespace is the main access point to the edb
;; code. elephantdb.keyval/-main Boots up the ElephantDB service and
;; an updater process that watches all domains and trigger an atomic
;; update in the background when some new version appears.
;;
;; TODO: Booting needs a little work; I'll do this along with the
;; deploy.

(defn -main
  "Main booting function for all of EDB. Pass in:

  `global-config-hdfs-path`: the hdfs path of `global-config.clj`

  `local-config-path`: the path to `local-config.clj` on this machine."
  [global-config-hdfs-path local-config-path]
  (log/configure-logging "log4j/log4j.properties")
  (let [local-config   (conf/read-local-config  local-config-path)
        global-config  (conf/read-global-config global-config-hdfs-path
                                                local-config)
        conf-map (merge global-config local-config)
        database (db/build-database conf-map)]
    (doto database
      (db/prepare)
      (db/launch-updater! (:update-interval-s conf-map)))
    (when-let [graphite-conf (:graphite-conf local-config)]
      (log/info "Graphite reporter started.")
      (report-to-graphite (:host graphite-conf) (:port graphite-conf)))
    (thrift/launch-server! kv-processor
                           (kv-service database)
                           (:port conf-map))))

;; For debugging in the a repl

(defn debug-database
  "Main booting function for all of EDB. Pass in:

  `global-config-hdfs-path`: the hdfs path of `global-config.clj`

  `local-config-path`: the path to `local-config.clj` on this machine."
  [global-config-hdfs-path local-config-path]
  (log/configure-logging "log4j/log4j.properties")
  (let [local-config   (conf/read-local-config  local-config-path)
        global-config  (conf/read-global-config global-config-hdfs-path
                                                local-config)
        conf-map (merge global-config local-config)
        database (db/build-database conf-map)]
    (doto database
      (db/prepare)
      (db/launch-updater! (:update-interval-s conf-map)))))

fix directMultiGet to return bytebuffer wrapped keys


(ns proto-facade.core
  (:import [com.google.protobuf Descriptors$Descriptor MessageOrBuilder Descriptors$FieldDescriptor]
           [java.util Map Map$Entry]
           [protofacade ProtoMap]
           [clojure.lang MapEntry]
           [com.google.protobuf ByteString]))

(defn entry-set [k v]
  (let [h (hash [k v])]
	  (reify Map$Entry
	    (getKey [this]
	      k)
	    (getValue [this]
	      v)
      (equals [this o]
        (and (instance? Map$Entry o)
             (= (.getKey ^Map$Entry o) k)
             (= (.getValue ^Map$Entry o) v)))
      (setValue [this v]
        (UnsupportedOperationException. "setValue not supported"))
	    (hashCode [this]
        h))))

(declare convert-to-map)

(defn resolve-value [obj convert-f]
  "Treat nested messages correctly, by calling convert-to-map and for lists (map resolve-value obj)"
  (cond
    (instance? MessageOrBuilder obj)
    (convert-to-map obj)
    (instance? java.util.Collection obj)
    (map resolve-value obj)
    (instance? ByteString obj)
    (if (nil? obj)
      nil
      (convert-f (.toByteArray ^ByteString obj)))
    :else
     (convert-f obj)))

(defn convert-to-map
  "Take a Message and wraps it in an object that will pose the message as a map."
  ([^MessageOrBuilder message]
    (convert-to-map (.getDescriptorForType message) message {} {}))
  ([^MessageOrBuilder message conf]
    (convert-to-map (.getDescriptorForType message) message {} conf))
  ([^Descriptors$Descriptor descriptor ^MessageOrBuilder message assoced-vals {:keys [convert-f] :or {convert-f identity} :as conf}]
    (let [
          get-f (fn [^Descriptors$FieldDescriptor field]
                        (let [n (.getName field)]
                            (if-let [x (get assoced-vals n)]
                              x
                              (resolve-value (.getField message field) convert-f))))
          get-name (fn [v]
                     (if
                       (instance? Descriptors$FieldDescriptor v)
                       (.getName ^Descriptors$FieldDescriptor v)
                       v))

          get-f2 (fn [k]
                   (if
                     (instance? Descriptors$FieldDescriptor k)
                     (get-f k)
                     (get assoced-vals k)))

          mixed-keys (apply conj (keys assoced-vals) (.getFields descriptor))
          key-set (apply conj (keys assoced-vals) (map (fn [^Descriptors$FieldDescriptor field] (.getName field)) (.getFields descriptor)))
          values  (map (fn [field] (get-f2 field)) mixed-keys)
          entry-set (map (fn [field] (entry-set (get-name field) (get-f2 field))) mixed-keys)
          imap-entries (map (fn [field] (MapEntry. (get-name field) (get-f2 field))) mixed-keys)]

		    (reify ProtoMap

         (containsKey [this k]
		        (let [v (-> descriptor (.findFieldByName k) nil? not)]
              (if v v (not (nil? (get assoced-vals k))))))

		      (containsValue [this k]
             (true? (some #(= % k)
                       values)))

		      (entrySet [this] (set entry-set))

		      (get [this k]
		        (try ;if a field of the ProtoBuf get the value otherwise lookup in the assoced map
              (if (string? k)
	              (if-let [field (.findFieldByName descriptor k)]
	                  (get-f field)
	                  (get-f2 k))
                (get-f2 k))
                (catch NullPointerException npe nil)))
		      (hashCode [this]
		          (hash [assoced-vals message]))
		      (isEmpty [this] false)
		      (keySet [this]
		        (set key-set))
		      (put [this k val]
		        (throw (UnsupportedOperationException. "put not supported")))
		      (putAll [this m]
		        (throw (UnsupportedOperationException. "put not supported")))
		      (remove [this k]
		        (throw (UnsupportedOperationException. "put not supported")))
		      (size [this]
		        (count key-set))
		      (values [this]
		        values)
		      (clear [this]
		        (throw (UnsupportedOperationException. "put not supported")))
          (toString [this]
            ;better java interop
            (clojure.lang.RT/printString this))

          (assoc [this k v]
            (convert-to-map descriptor message (assoc assoced-vals k v) conf))

          (entryAt [this k]
            (MapEntry. k (.get this k)))

          (valAt [this k]
            (.get this k))

          (count [this]
            (.size this))

          (cons [this v]
            (cons v imap-entries))

          (empty [this]
            this)
          (equiv [this obj]
            (= (hash obj) (.hashCode this)))

          (seq [this]
            imap-entries)))))

(ns proto-facade.core
  (:import [com.google.protobuf Descriptors$Descriptor MessageOrBuilder Descriptors$FieldDescriptor]
           [java.util Map Map$Entry]
           [protofacade ProtoMap]
           [clojure.lang MapEntry]
           [com.google.protobuf ByteString]))

(defn entry-set [k v]
  (let [h (hash [k v])]
	  (reify Map$Entry
	    (getKey [this]
	      k)
	    (getValue [this]
	      v)
      (equals [this o]
        (and (instance? Map$Entry o)
             (= (.getKey ^Map$Entry o) k)
             (= (.getValue ^Map$Entry o) v)))
      (setValue [this v]
        (UnsupportedOperationException. "setValue not supported"))
	    (hashCode [this]
        h))))

(declare convert-to-map)

(defn resolve-value [obj convert-f]
  "Treat nested messages correctly, by calling convert-to-map and for lists (map resolve-value obj)"
  (cond
    (instance? MessageOrBuilder obj)
    (convert-to-map obj)
    (instance? java.util.Collection obj)
    (map #(resolve-value % convert-f) obj)
    (instance? ByteString obj)
    (if (nil? obj)
      nil
      (convert-f (.toByteArray ^ByteString obj)))
    :else
     (convert-f obj)))

(defn convert-to-map
  "Take a Message and wraps it in an object that will pose the message as a map."
  ([^MessageOrBuilder message]
    (convert-to-map (.getDescriptorForType message) message {} {}))
  ([^MessageOrBuilder message conf]
    (convert-to-map (.getDescriptorForType message) message {} conf))
  ([^Descriptors$Descriptor descriptor ^MessageOrBuilder message assoced-vals {:keys [convert-f] :or {convert-f identity} :as conf}]
    (let [
          get-f (fn [^Descriptors$FieldDescriptor field]
                        (let [n (.getName field)]
                            (if-let [x (get assoced-vals n)]
                              x
                              (resolve-value (.getField message field) convert-f))))
          get-name (fn [v]
                     (if
                       (instance? Descriptors$FieldDescriptor v)
                       (.getName ^Descriptors$FieldDescriptor v)
                       v))

          get-f2 (fn [k]
                   (if
                     (instance? Descriptors$FieldDescriptor k)
                     (get-f k)
                     (get assoced-vals k)))

          mixed-keys (apply conj (keys assoced-vals) (.getFields descriptor))
          key-set (apply conj (keys assoced-vals) (map (fn [^Descriptors$FieldDescriptor field] (.getName field)) (.getFields descriptor)))
          values  (map (fn [field] (get-f2 field)) mixed-keys)
          entry-set (map (fn [field] (entry-set (get-name field) (get-f2 field))) mixed-keys)
          imap-entries (map (fn [field] (MapEntry. (get-name field) (get-f2 field))) mixed-keys)]

		    (reify ProtoMap

         (containsKey [this k]
		        (let [v (-> descriptor (.findFieldByName k) nil? not)]
              (if v v (not (nil? (get assoced-vals k))))))

		      (containsValue [this k]
             (true? (some #(= % k)
                       values)))

		      (entrySet [this] (set entry-set))

		      (get [this k]
		        (try ;if a field of the ProtoBuf get the value otherwise lookup in the assoced map
              (if (string? k)
	              (if-let [field (.findFieldByName descriptor k)]
	                  (get-f field)
	                  (get-f2 k))
                (get-f2 k))
                (catch NullPointerException npe nil)))
		      (hashCode [this]
		          (hash [assoced-vals message]))
		      (isEmpty [this] false)
		      (keySet [this]
		        (set key-set))
		      (put [this k val]
		        (throw (UnsupportedOperationException. "put not supported")))
		      (putAll [this m]
		        (throw (UnsupportedOperationException. "put not supported")))
		      (remove [this k]
		        (throw (UnsupportedOperationException. "put not supported")))
		      (size [this]
		        (count key-set))
		      (values [this]
		        values)
		      (clear [this]
		        (throw (UnsupportedOperationException. "put not supported")))
          (toString [this]
            ;better java interop
            (clojure.lang.RT/printString this))

          (assoc [this k v]
            (convert-to-map descriptor message (assoc assoced-vals k v) conf))

          (entryAt [this k]
            (MapEntry. k (.get this k)))

          (valAt [this k]
            (.get this k))

          (count [this]
            (.size this))

          (cons [this v]
            (cons v imap-entries))

          (empty [this]
            this)
          (equiv [this obj]
            (= (hash obj) (.hashCode this)))

          (seq [this]
            imap-entries)))))

fix tests

fix tests


(ns tesq.utils
  (:require	[clojure.string :refer [replace capitalize]]))

(defn prettify
  "Turn table name into something more human friendly."
  [s]
  (-> s capitalize (replace #"_" " ")))

(defn singularise
  "Turn plural string into singular."
  [s]
  (replace s #"s$" ""))

(ns tesq.utils
  (:require	[clojure.string :refer [replace capitalize]]))

(defn prettify
  "Turn table name into something more human friendly."
  [s]
  (-> s capitalize (replace #"_" " ")))

(defn singularise
  "Turn plural string into singular."
  [s]
  (cond

   (re-find #"ies$" s)
   (replace s #"ies$" "y")

   :else
   (replace s #"s$" "")

   ))

Handle 'ies' words in singularise fn

Handle 'ies' words in singularise fn