Cleaning up after that fix

2 files changed, 60 insertions, 173 deletions

diff --git a/.nrepl-port b/.nrepl-port
index b5f17a7..fc3bddb 100644
--- a/.nrepl-port
+++ b/.nrepl-port
@@ -1 +1 @@
-59942
\ No newline at end of file
+60589
\ No newline at end of file
diff --git a/src/midi.clj b/src/midi.clj
index 57e7705..bb9ffbc 100644
--- a/src/midi.clj
+++ b/src/midi.clj
@@ -1,8 +1,7 @@
 (ns midi
   (:require [missionary.core :as m])
   (:import [javax.sound.midi MidiSystem Receiver ShortMessage MidiDevice$Info MidiDevice Transmitter MidiMessage]
-           [uk.co.xfactorylibrarians.coremidi4j CoreMidiDeviceProvider]
-           [missionary Cancelled]))
+           [uk.co.xfactorylibrarians.coremidi4j CoreMidiDeviceProvider]))
 
 (defn get-all-midi-device-info []
   (CoreMidiDeviceProvider/getMidiDeviceInfo))
@@ -26,20 +25,14 @@
   [^MidiDevice device tfn]
   (m/sp
    (try
-     (.open device)
-     #_
      (m/? (m/via m/blk (.open device)))
      (println "Device opened" device)
      (m/? (tfn device))
-     (catch Cancelled e (println "with-device received cancellation signal") (throw e))
-     (catch Exception e (println "with-device received exception") (throw e))
      (finally
-       ;; HERE:
-       ;; For some reason, closing device is hanging.
        (println "Closing device...")
-       (.close ^MidiDevice device)
-       (println "Device closed.")
-       #_
+       ;; 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)))
        (println "Device closed" device)))))
 
@@ -57,59 +50,38 @@
   [^MidiDevice device t]
   (m/sp
    (let [^Transmitter transmitter
-          (.getTransmitter device)
-         #_
          (m/? (m/via m/blk (.getTransmitter device)))
-         _ (println "tx mounted")
          rv (m/mbx)
          receiver
          (reify Receiver
            (send [_this midi-message _timestamp]
              (println "Sending message")
-             ;; NOTE: RV CANNOT BLOCK!
-             ;; If it does, you can end up with a deadlock during cancellation.
-              (rv midi-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)
              (println "Message sent"))
            (close [_this]))]
      (println "RX object defined:" receiver)
      (try
        (println "Setting receiver...")
-       (.setReceiver transmitter receiver)
-       #_
        (m/? (m/via m/blk (.setReceiver transmitter receiver)))
        (println "Receiver set")
-       (try
-         (m/?
-          (t (m/ap
-               (m/amb=
-                ;; TODO This might not be necessary
-                (m/? m/never)
-                (loop []
-                  (m/amb
-                   (do
-                     (println "tx awaiting value from device...")
-                     (m/amb))
-
-                   ;; TODO:
-                   ;; As far as I can tell, rx is closing but tx is not.
-                   ;; I think we're hanging on the take here
-                   ;; Probably need to raise an exception somehow
-
-                   ;; Looks like my m/amb= calls are good?
-                   (let [v (m/? rv)]
-                     (println "tx received value" v)
-                     v)
-                   (recur)))))))
-         (catch Cancelled e (println "cancellation signal receved prior to loop exit") (throw e))
-         (catch Exception e (println "exception receved prior to loop exit") (throw e))
-         (finally
-           (println "Loop exited")))
-       (catch Cancelled e (println "cancellation signal receved prior to closing tx") (throw e))
-       (catch Exception e (println "exception receved prior to closing tx") (throw e))
+       (m/?
+        (t (m/ap
+            (loop []
+              (m/amb
+               (do
+                 (println "tx awaiting value from device...")
+                 (m/amb))
+               (let [v (m/? rv)]
+                 (println "tx received value" v)
+                 v)
+               (recur))))))
        (finally
          (println "Closing tx")
-         (.close transmitter)
-         #_
          (m/? (m/via m/blk (.close transmitter)))
          (println "Tx closed"))))))
 
@@ -128,39 +100,24 @@
   "
   [^MidiDevice device f]
   (m/sp
-    ;; TODO Try finally
-    ;; TODO blocking APIs everywhere
-    ;; TODO mailbox -> rdv
    (let [^Receiver receiver
-         (.getReceiver device)
-         #_
          (m/? (m/via m/blk (.getReceiver device)))]
      (println "receiver mounted")
      (try
        (m/?
         (m/reduce {} nil
                   (m/ap
-                    (try
-                      (let [^MidiMessage v (m/?< f)]
-                        (println "rx received value" v)
-                        (.send receiver v UNSCHEDULED-EVENT)
-                        #_
-                        (m/? (m/via m/blk (.send receiver v UNSCHEDULED-EVENT)))
-                        (println ".send returned"))
-                      (catch Cancelled e (println "cancellation signal receved prior to rx flow exit") (throw e))
-                      (catch Exception e (println "exception receved prior to rx flow exit") (throw e))
-                      (finally (println "RX flow exited"))))))
-       (catch Cancelled e (println "cancellation signal receved prior to rx closure") (throw e))
-       (catch Exception e (println "exception receved prior to rx closure") (throw e))
+                   (let [^MidiMessage v (m/?< f)]
+                     (println "rx received value" v)
+                     (m/? (m/via m/blk (.send receiver v UNSCHEDULED-EVENT)))
+                     (println ".send returned")))))
        (finally
          (println "Closing rx")
-         (.close receiver)
-         #_
          (m/? (m/via m/blk (.close receiver)))
          (println "rx closed"))))))
 
-
-(defn echo [tx-device rx-device]
+(defn echo
+  [tx-device rx-device from-ch to-ch]
   (m/sp
    (let [rv (m/rdv)]
      (m/?
@@ -169,48 +126,41 @@
                 (fn [d]
                   (println "Have tx device")
                   (m/sp
-                    (try
-                      (m/?
-                       (with-tx d
-                         (fn [f]
-                           (m/sp
-                             (println "Have transmitter")
-                             (m/?
-                              (m/reduce prn nil
-                                        (m/ap
-                                          (let [^MidiMessage v (m/?< f)
-                                                _ (println "Echo received value from flow:" v)
-                                                new-msg (ShortMessage. ShortMessage/NOTE_ON 9 (.getData1 ^ShortMessage v) (.getData2 ^ShortMessage v))]
-                                            (println "sending v to rdv.")
-                                            (m/?
-                                             (rv new-msg))
-                                            (println "Value sent.")))))))))
-                      (catch Cancelled e (println "cancellation signal receved prior transmitter completion") (throw e))
-                      (catch Exception e (println "exception receved prior transmitter completion") (throw e))
-                      (finally
-                        (println "Done with transmitter"))))))
+                   (m/?
+                    (with-tx d
+                      (fn [f]
+                        (m/sp
+                         (println "Have transmitter")
+                         (m/?
+                          (m/reduce prn nil
+                                    (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)))
+
+                                     (println "Value sent.")))))))))))
               (with-device rx-device
                 (fn [d]
                   (println "Have rx device")
                   (m/sp
-                    (try
-                      (m/?
-                       (with-rx d
-                         (m/ap
-                           (m/amb=
-                            (m/? m/never)
-                            (loop []
-                              (println "Echo rx awaiting value...")
-                              (m/amb
-                               (let [v (m/? rv)]
-                                 (println "Echo received value:" v)
-                                 v)
-                               ;; I think that what is happening here is a deadlock on either give or take of the rdv
-                               (recur)))))))
-                      (catch Cancelled e (println "cancellation signal receved prior receiver completion") (throw e))
-                      (catch Exception e (println "exception receved prior receiver completion") (throw e))
-                      (finally
-                        (println "Done with receiver")))))))))))
+                   (m/?
+                    (with-rx d
+                      (m/ap
+                       (m/amb=
+                        (m/? m/never)
+                        (loop []
+                          (println "Echo rx awaiting value...")
+                          (m/amb
+                           (m/? rv)
+                           (recur)))))))))))))))
 (def run
   (m/sp
    (let [txd
@@ -223,10 +173,7 @@
           (select-devices (get-all-midi-device-info)
                           "CoreMIDI4J - IAC Bus" false true))]
 
-     (def txd txd)
-     (def rxd rxd)
-
-     (m/? (echo txd rxd)))))
+     (m/? (echo txd rxd 0 0)))))
 
 ;; CoreMidiSource is TX Device
 ;; CoreMidiDestination is RX Device
@@ -271,63 +218,3 @@
 ;; `val` is a signal of sets representing active notes on that channel.
 ;;
 
-(let [_ (println "getting device")
-      txd (first
-              (select-devices (get-all-midi-device-info)
-                              "CoreMIDI4J - IAC Bus" true false))
-      rxd (first
-              (select-devices (get-all-midi-device-info)
-                              "CoreMIDI4J - IAC Bus" false true)) 
-      _ (println "getting transmitter")
-      transmitter (.getTransmitter txd)
-      _ (.setReceiver transmitter
-                      (reify Receiver
-                        (send [_this midi-message _timestamp]
-                          (println "Message received:")
-                          (println midi-message))
-                        (close [_this] (println "Closing!"))))
-      receiver (.getReceiver rxd)]
-  (println "opening txd")
-  (.open txd)
-  (println "Opening rxd")
-  (.open rxd)
-  (println "setting receiver")
-  (def txd txd)
-  (def rxd rxd)
-  (def t transmitter)
-  (def r receiver))
-
-(.send r (ShortMessage. ShortMessage/NOTE_ON 0 0 0) -1)
-
-(.close txd)
-(.close rxd)
-(.close t)
-(.close r)
-
-(def t
-  (m/sp
-    (try
-      (println "A")
-      (m/? (m/sp
-             (try
-               (println "AA")
-               (m/?  (m/sleep 10000000))
-               (println "BB")
-               (catch missionary.Cancelled e
-                 (println "Catch Inner") (throw e))
-               (catch Exception e
-                 (println "E" e)
-                 (println "Exception Inner") (throw e))
-               (finally
-                 (println "Finally Inner")))))
-      (catch missionary.Cancelled e
-        (println "Catch Outer") (throw e))
-      (catch Exception e
-        (println "Exception Outer") (throw e))
-      (finally
-        (println "Finally Outer")))
-    (println "B")))
-
-(def cancel (t {} {}))
-
-(cancel)