(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]))

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

;; 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))))

(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/mbx)
         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
             (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/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]
  (let [device
        (first
         (select-devices (get-all-midi-device-info)
                         name false true))]
    (with-device device
      (fn [d]
        (with-rx d flow)))))

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

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

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

(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)))))))))))

;; CoreMidiSource is TX Device
;; CoreMidiDestination is RX Device

(defn |short-messages
  "Filter down to midi short messages"
  [>messages]
  (m/eduction (filter #(instance? ShortMessage %)) >messages))

(defn |group-by-channel
  [>messages]
  (m/group-by #(.getChannel ^ShortMessage %) >messages))

(defn |group-by-data-1
  [>messages]
  (m/group-by #(.getData1 ^ShortMessage %) >messages))

(defn |matching-commands
  [>messages commands]
  (m/eduction (filter (fn [^ShortMessage v]
                        (contains? commands (.getCommand v)))) >messages))

(def note-commands
  #{ShortMessage/NOTE_OFF
    ShortMessage/NOTE_ON
    ShortMessage/POLY_PRESSURE})

(def control-commands
  #{ShortMessage/CONTROL_CHANGE})

(defn keyboard
  [f]
  (m/relieve
   (m/group-by
    first
    (m/ap
      (let [[ch ch-messages]
            (m/?> 128 (|group-by-channel (|short-messages (m/stream f))))
            ch-messages (m/stream ch-messages)]
        (m/amb=
         (let [[note note-messages]
               (m/?> 128 (-> ch-messages
                             (|matching-commands note-commands)
                             (|group-by-data-1)))]
           ;; TODO: Where to relieve in here?
           [:key ch note
            (m/?<
             (m/reductions
              (fn [_prev curr]
                (when (some? curr)
                  (let [cmd (.getCommand ^ShortMessage curr)]
                    (cond
                      (= cmd ShortMessage/NOTE_ON)
                      (.getData2 ^ShortMessage curr)
                      (= cmd ShortMessage/POLY_PRESSURE)
                      (.getData2 ^ShortMessage curr)
                      (= cmd ShortMessage/NOTE_OFF)
                      nil)))) nil note-messages))])

         (let [[control-number control-messages]
               (m/?> 128 (-> ch-messages
                             (|matching-commands control-commands)
                             (|group-by-data-1)))]
           [:control ch control-number (.getData2 ^ShortMessage (m/?< control-messages))])))))))

#_(defn >ch-stream [>device ch]
    (m/cp (m/?< (second (get >device ch)))))

#_{ch {:notes {note aftertouch}
       :pitch v
       :control {controller value}
       :program program}}

;; Goal:
;; Create function called `(receive-from-bus bus-name)`.
;; `bus-name` is the name of a midi bus on this machine. If a bus with that name
;; exists, the signal returned by `bus` will contain a map of {ch val}, where ch
;; is a midi channel number and val is a signal of sets representing active
;; notes on that channel.
;;
;; Create another function, `(send-to-bus bus-name sigs)`. `bus-name` is the
;; name of a midi bus on this machine.  If a bus with that name exists, it will
;; start reading note values from `sigs`.
;;
;; Here, `sigs` is a map of {ch val}, where `ch` is a midi channel number and
;; `val` is a signal of sets representing active notes on that channel.
;;