import qualified Sound.Alsa.Sequencer as ALSA
import Sound.Alsa.Sequencer (
   caps, cap_read, cap_subs_read, cap_write,
   types, type_midi_generic, type_application,
   set_client_name, get_client_id,
   event_input,
   event_output, event_output_pending, drain_output, control_queue,

   Addr(Addr), addr_client, addr_port, addr_subscribers,
   Event(Event),
   ev_high_priority, ev_tag, ev_queue, ev_timestamp,
   ev_source, ev_dest, ev_data,
   TimeStamp(TickTime),
   EventData(NoteEv, CustomEv), NoteEv(NoteOn), simple_note,
   QueueEv(QueueStart,QueueTempo),
   CustomEv(Echo), Custom(Custom),
   alsa_catch, exception_description, exception_code,
   )

import Control.Monad (zipWithM_, )


main :: IO ()
main = (do
  ALSA.with ALSA.default_seq_name ALSA.Block $ \h -> do
  set_client_name (h :: ALSA.SndSeq ALSA.DuplexMode) "HS5"
  ALSA.with_simple_port h "1"
     (caps [cap_read,cap_subs_read,cap_write])
     (types [type_midi_generic,type_application]) $ \p -> do
  c <- get_client_id h
  ALSA.with_queue h $ \q -> do
  let ev t e = Event
                 { ev_high_priority = False
                 , ev_tag = 0
                 , ev_queue = q
                 , ev_timestamp = TickTime t
                 , ev_source = Addr { addr_client = c, addr_port = p }
                 , ev_dest = addr_subscribers
                 , ev_data = e
                 }
      play t chan pitch vel =
           do print =<< event_output h (ev t $
                 NoteEv NoteOn $ simple_note chan pitch vel)

              print =<< event_output h (ev (t+1) $
                 NoteEv NoteOn $ simple_note chan pitch 0)

      echo t =
         print =<< event_output h
            ((ev t $ CustomEv Echo $ Custom 0 0 0){
               ev_dest = Addr { addr_client = c, addr_port = p }
            })

  putStrLn "Please connect me to a synth"
  getChar
  control_queue h q QueueStart 0 Nothing
  control_queue h q QueueTempo 10000000 Nothing
  zipWithM_ (\t ->
        maybe (echo t) (\n -> play t 0 n 127)) [0..] $
     (++[Nothing]) $
     concat $ concatMap (replicate 4 . map Just) $
        [57, 59, 60, 64] :
        [57, 59, 60, 65] :
        [57, 62, 64, 65] :
        [57, 59, 60, 64] :
        []
  drain_output h
  print =<< event_output_pending h

--          threadDelay 10000000
  let waitForEcho = do
         event <- event_input h
         print event
         case ev_data event of
            CustomEv e _d ->
               case e of
                  Echo -> return ()
                  _ -> waitForEcho
            _ -> waitForEcho
  waitForEcho)

  `alsa_catch` \e -> putStrLn $ "alsa_exception: (" ++ show (exception_code e)
                             ++ ") " ++ exception_description e