{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}

-- Contains all the information and functions necessary to run a Jack
-- port and exchange information through reactive values and Yampa.
module RMCA.Translator.Jack ( jackSetup
                            ) where

import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class           as Trans
import qualified Data.Bifunctor                      as BF
import           Data.CBMVar
import           Data.Foldable
import qualified Data.IntMap                         as M
import           Data.ReactiveValue
import qualified Foreign.C.Error                     as E
import           Hails.Yampa
import           RMCA.Auxiliary
import           RMCA.Semantics
import           RMCA.Translator.Message
import           RMCA.Translator.RV
import           RMCA.Translator.Translator
import qualified Sound.JACK                          as Jack
import qualified Sound.JACK.MIDI                     as JMIDI

import           Control.Arrow
import           Debug.Trace

rmcaName :: String
rmcaName = "RMCA"

inPortName :: String
inPortName = "input"

outPortName :: String
outPortName = "output"

-- Starts a default client with an input and an output port. Doesn't
-- do anything as such.
jackSetup :: (ReactiveValueReadWrite board
              (M.IntMap ([(LTempo,Note)],[Message])) IO) =>
             board
          -> IO ()
jackSetup boardQueue = Jack.handleExceptions $ do
  toProcessRV <- Trans.lift $ newCBMVarRW []
  Jack.withClientDefault rmcaName $ \client ->
    Jack.withPort client outPortName $ \output ->
    Jack.withPort client inPortName  $ \input ->
    Jack.withProcess client (jackCallBack client input output
                              toProcessRV boardQueue) $
    Jack.withActivation client $ Trans.lift $ do
    putStrLn $ "Started " ++ rmcaName ++ " JACK client."
    Jack.waitForBreak

defaultTempo :: Tempo
defaultTempo = 120

-- The callback function. It pumps value out of the input port, mix
-- them with value coming from the machine itself and stuff them into
-- the output port. When this function is not running, events are
-- processed.
jackCallBack :: ( ReactiveValueReadWrite toProcess [(Frames, RawMessage)] IO
                , ReactiveValueReadWrite board
                  (M.IntMap ([(LTempo,Note)],[Message])) IO) =>
                Jack.Client
             -> JMIDI.Port Jack.Input
             -> JMIDI.Port Jack.Output
             -> toProcess
             -> board
             -> Jack.NFrames
             -> Sync.ExceptionalT E.Errno IO ()
jackCallBack client input output toProcessRV boardQueue nframes@(Jack.NFrames nframesInt') = do
  let inMIDIRV = inMIDIEvent input nframes
      outMIDIRV = outMIDIEvent output nframes
      nframesInt = fromIntegral nframesInt' :: Int
  Trans.lift $ do
    concat . toList . gatherMessages nframesInt <$>
      reactiveValueRead boardQueue >>=
      reactiveValueAppend toProcessRV
    reactiveValueEmpty  boardQueue
    (go, old') <- schedule nframesInt <$> reactiveValueRead toProcessRV
    let old = map (BF.first (+ (- nframesInt))) old'
    print $ map fst go
    reactiveValueWrite outMIDIRV go
    reactiveValueWrite toProcessRV old
  --------------