(ns unheard.midi
  (:require [missionary.core :as m]
            [taoensso.trove :as log])
  (:import [javax.sound.midi MidiSystem Receiver ShortMessage MidiDevice$Info
            MidiDevice Transmitter MidiMessage]
           [uk.co.xfactorylibrarians.coremidi4j CoreMidiDeviceProvider
            CoreMidiNotification]))

(defn get-all-midi-device-info [] (CoreMidiDeviceProvider/getMidiDeviceInfo))

(def device-infos
  "A publisher containing the latest result of MidiSystem#getMidiDeviceInfo."
  (m/signal
    (m/cp
      (m/?<
        (m/ap
          ;; TODO: getMidiDeviceInfo could theoretically block. Move to
          ;; m/blk
          (let [devices (atom (CoreMidiDeviceProvider/getMidiDeviceInfo))
                >devices (m/watch devices)
                notification-listener
                  (reify
                    CoreMidiNotification
                      (midiSystemUpdated [_this]
                        (reset! devices
                          (CoreMidiDeviceProvider/getMidiDeviceInfo))))]
            (m/amb=
              (do (m/? (m/via m/blk
                              (CoreMidiDeviceProvider/addNotificationListener
                                notification-listener)))
                  (m/amb))
              (m/?< >devices)
              (try (m/? m/never)
                   (finally
                     (m/? (m/via
                            m/blk
                            (CoreMidiDeviceProvider/removeNotificationListener
                              notification-listener))))))))))))

;; Move to tools.repl
(defn print-all-midi-devices
  "Prints the names of all MIDI devices attached to the computer."
  []
  (doseq [^MidiDevice$Info device-info (get-all-midi-device-info)]
    (println (.getName device-info))))

(comment
  (print-all-midi-devices))

(defn select-devices
  "Given device info list `devices`, return seq where device name is `device-name`.
  If tx? is true, returned devices will have unlimited transmitters.
  If rx? is true, returned devices will have unlimited receivers."
  [devices device-name tx? rx?]
  (->> devices
       (filter (fn [^MidiDevice$Info di]
                 (let [d (MidiSystem/getMidiDevice di)]
                   (and (= device-name (.getName di))
                        (or (not tx?) (= -1 (.getMaxTransmitters d)))
                        (or (not rx?) (= -1 (.getMaxReceivers d)))))))
       (map #(MidiSystem/getMidiDevice %))))

;; TODO: git-bug d317eca
(defn with-device
  "Open `device` and then run task returned by invoking `tfn` with `device` as its sole argument."
  [^MidiDevice device tfn]
  (m/sp (try (m/? (m/via m/blk (.open device)))
             (log/log! {:level :info,
                        :id :midi/device-opened,
                        :data {:device (str device)}})
             (m/? (tfn device))
             (finally (log/log! {:level :info, :id :midi/closing-device})
                      ;; NOTE:
                      ;; Be careful, (.close device) will wait for (.send
                      ;; receiver ...) to return. This can lead to
                      ;; deadlocks during cancellation.
                      (m/? (m/via m/blk (.close device)))
                      (log/log! {:level :info,
                                 :id :midi/device-closed,
                                 :data {:device (str device)}})))))

(defn with-tx
  "Feed a transmitter device (e.g. a MIDI keyboard) into a consumer `t`.

  `t` is a function taking a flow of MIDI ShortMessages as its sole argument
  and returning a task completing with consumption of that flow.

  When invoked, `with-tx` will open the transmitter.

  Upon cancellation or flow termination, the transmitter will be closed.

  Returns a task."
  [^MidiDevice device t]
  (m/sp
    (let [^Transmitter transmitter (m/? (m/via m/blk (.getTransmitter device)))
          rv (m/rdv)
          receiver (reify
                     Receiver
                       (send [_this midi-message _timestamp]
                         (log/log! {:level :debug, :id :midi/sending-message})
                         ;; NOTE:
                         ;; Be careful, (.close device) will wait for
                         ;; (.send receiver ...) to return. This can lead
                         ;; to deadlocks during cancellation.
                         ;;
                         ;; TODO: git-bug a1652f9
                         (m/? (rv midi-message))
                         (log/log! {:level :debug, :id :midi/message-sent}))
                       (close [_this]))]
      (log/log! {:level :debug,
                 :id :midi/rx-object-defined,
                 :data {:receiver (str receiver)}})
      (try (log/log! {:level :debug, :id :midi/setting-receiver})
           (m/? (m/via m/blk (.setReceiver transmitter receiver)))
           (log/log! {:level :debug, :id :midi/receiver-set})
           (m/? (t (m/stream
                     (m/ap (loop []
                             (m/amb (do (log/log! {:level :debug,
                                                   :id :midi/tx-awaiting-value})
                                        (m/amb))
                                    (let [v (m/? rv)]
                                      (log/log! {:level :debug,
                                                 :id :midi/tx-received-value,
                                                 :data {:value (str v)}})
                                      v)
                                    (recur)))))))
           (finally (log/log! {:level :info, :id :midi/closing-tx})
                    (m/? (m/via m/blk (.close transmitter)))
                    (log/log! {:level :info, :id :midi/tx-closed}))))))

(def UNSCHEDULED-EVENT -1)

(defn with-rx
  "Feed a flow of midi messages into a receiver device (e.g. a synthesizer).

  `f` is a flow of midi ShortMessages.

  When invoked, `with-rx` will open the receiver.

  Upon cancellation or flow termination, the receiver will be closed.

  Returns a task.
  "
  [^MidiDevice device f]
  (m/sp (let [^Receiver receiver (m/? (m/via m/blk (.getReceiver device)))]
          (log/log! {:level :info, :id :midi/receiver-mounted})
          (try (m/? (m/reduce {}
                      nil
                      (m/ap (let [^MidiMessage v (m/?< f)]
                              (log/log! {:level :debug,
                                         :id :midi/rx-received-value,
                                         :data {:value (str v)}})
                              (m/? (m/via m/blk
                                          (.send receiver v UNSCHEDULED-EVENT)))
                              (log/log! {:level :debug,
                                         :id :midi/send-returned})))))
               (finally (log/log! {:level :info, :id :midi/closing-rx})
                        (m/? (m/via m/blk (.close receiver)))
                        (log/log! {:level :info, :id :midi/rx-closed}))))))

(defn >bus
  "Opens device named `name`.

  Device will consume `flow`, a flow of Message objects."
  [>name flow]
  (m/ap (let [device (first (select-devices (get-all-midi-device-info)
                                            (m/?< name)
                                            false
                                            true))]
          (if device
            (m/? (with-device device (fn [d] (with-rx d flow))))
            (m/amb)))))

(defn <bus
  "Opens device named `name`.

  Calls `flow-handler` with a flow of midi messages.

  `flow-handler` should return a flow."
  [name flow-handler]
  (m/sp (let [device
                (first
                  (select-devices (get-all-midi-device-info) name true false))]
          (if device
            (m/? (with-device
                   device
                   (fn [d]
                     (with-tx d (fn [f] (m/reduce prn nil (flow-handler f)))))))
            (m/amb)))))

;; TODO: Move elsewhere
(defn echo
  "Echo test."
  [name from-ch to-ch]
  (m/sp
    (let [rv (m/rdv)]
      (m/?
        (m/join
          vector
          (<bus name
                (fn [f]
                  (m/ap (let [v (m/?< f)]
                          (if (= (class v) ShortMessage)
                            (let [v ^ShortMessage v]
                              (if (and (= from-ch (.getChannel v))
                                       (#{ShortMessage/NOTE_ON
                                          ShortMessage/NOTE_OFF}
                                        (.getCommand v)))
                                (let [new-msg (ShortMessage. (.getCommand v)
                                                             to-ch
                                                             (.getData1 v)
                                                             (.getData2 v))]
                                  (m/? (rv new-msg)))
                                (m/amb)))
                            (m/amb)))
                        (log/log! {:level :debug, :id :midi/value-sent}))))
          (>bus name
                (m/ap (m/amb= (m/? m/never)
                              (loop []
                                (log/log! {:level :debug,
                                           :id :midi/echo-rx-awaiting-value})
                                (m/amb (m/? rv) (recur)))))))))))

(defn controller
  ;; NOTE: The structure of `config` currently assumes a fairly specific
  ;; structure. It might be better for `config` to be a simple `kv`
  ;; structure, where `k` can be e.g. a tuple [:knob 1], a single value
  ;; [:mod-wheel], etc.
  "Given a flow `f` and a controller config `config`, return a map of
  controller flows taking from `f`.

  A `config` is a map of maps of type `group` -> `id` -> `flow-constructor`.
  Here, `group` is the name of a control type, e.g. :knob; `id` is a unique
  identifier for that control, e.g. `1`, and `flow-constructor` is a function
  accepting a flow of ShortMessages as its sole argument, and returning
  a flow of values associated with the control."
  [f config]
  (into {}
        (map (fn [[group instance]]
               {group (into {} (map (fn [[id flow]] {id (flow f)}) instance))})
          config)))

;; TODO git-bug c947320
(def short-message->notes
  "A transducer filtering ShortMessages down to note messages, and returning
  a set of active notes."
  (fn [rf]
    (let [prev (volatile! nil)]
      (fn
        ([] (rf))
        ([result] (rf result))
        ([result ^ShortMessage input]
         (let [command (.getCommand input)]
           (cond
             ;; Channel Mode Message "All notes off"
             (and (= ShortMessage/CONTROL_CHANGE command)
                  (= 123 (.getData1 input))
                  (= 0 (.getData2 input)))
               (do (vreset! prev #{}) (rf result #{}))
             (= ShortMessage/NOTE_ON command)
               (let [prev-v @prev
                     next (conj (into #{} prev-v) (.getData1 input))]
                 (vreset! prev next)
                 (rf result next))
             (= ShortMessage/NOTE_OFF command)
               (let [prev-v @prev
                     next (disj (into #{} prev-v) (.getData1 input))]
                 (vreset! prev next)
                 (rf result next))
             :else result)))))))

;; TODO: Move this logic into bus fn
(defn short-messages
  [>device-name]
  (m/stream
    (m/reductions
      {}
      nil
      (m/ap
        (let [device-name (m/?< >device-name)
              short-messages (atom nil)
              >short-messages (m/watch short-messages)]
          (m/amb= (do (reset! short-messages nil)
                      (m/? (<bus device-name
                                 (fn [v]
                                   (m/ap (try
                                           (let [msg (m/?< v)]
                                             (reset! short-messages msg))
                                           (catch missionary.Cancelled c
                                             ;; When the upstream flow is
                                             ;; cancelled, we emit "All
                                             ;; notes off" to consumers
                                             (doseq [ch (range 0 16)]
                                               (reset! short-messages
                                                 (ShortMessage.
                                                   ShortMessage/CONTROL_CHANGE
                                                   ch
                                                   123
                                                   0)))
                                             (throw c))))))))
                  (if-let [m (m/?< >short-messages)]
                    m
                    (m/amb))))))))

(defn notes
  [short-messages]
  (m/signal (m/ap (m/?< (m/ap (m/amb= #{}
                                      (m/?< (m/eduction short-message->notes
                                                        short-messages))))))))

(comment
  (def dn (atom "CoreMIDI4J - Minilab3 MIDI"))
  (def >dn (m/watch dn))
  (def cancel ((m/reduce prn nil (notes (short-messages >dn))) prn prn))
  (reset! dn "CoreMIDI4J - IAC Bus")
  (reset! dn nil)
  (cancel))