{-# LANGUAGE FlexibleContexts #-}

-- 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           Control.Applicative                 ((<**>))
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 qualified Data.EventList.Absolute.TimeBody    as EventListAbs
import           Data.ReactiveValue
import qualified Foreign.C.Error                     as E
import           Hails.Yampa
import           RMCA.Auxiliary.RV
import           RMCA.Semantics
import           RMCA.Translator.Filter
import           RMCA.Translator.Message
import           RMCA.Translator.RV
import           RMCA.Translator.Translator
import qualified Sound.JACK                          as Jack
import qualified Sound.JACK.Exception                as JExc
import qualified Sound.JACK.MIDI                     as JMIDI

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 :: ( ReactiveValueRead tempo LTempo IO
             , ReactiveValueRead channel Int IO
             , ReactiveValueReadWrite board [Note] IO) =>
             tempo
          -> channel
          -> board
          -> IO ()
jackSetup tempoRV chanRV boardInRV = Jack.handleExceptions $ do
  toProcessRV <- Trans.lift $ toProcess <$> newCBMVar []
  Jack.withClientDefault rmcaName $ \client ->
    Jack.withPort client outPortName $ \output ->
    Jack.withPort client inPortName  $ \input ->
    Jack.withProcess client (jackCallBack client input output
                              toProcessRV tempoRV chanRV boardInRV) $
    Jack.withActivation client $ Trans.lift $ do
    putStrLn $ "Started " ++ rmcaName ++ " JACK client."
    Jack.waitForBreak

{-
-- Loop that does nothing except setting up a callback function
-- (called when Jack is ready to take new inputs).
jackRun :: (JExc.ThrowsErrno e) =>
           Jack.Client
        -> (Jack.NFrames -> Sync.ExceptionalT E.Errno IO ())
        -> Sync.ExceptionalT e IO ()
jackRun client callback =
  Jack.withProcess client callback $ do
  Trans.lift $ putStrLn $ "Startedbbb " ++ rmcaName
  Trans.lift $ Jack.waitForBreak
-}
defaultTempo :: Tempo
defaultTempo = 96

-- 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
                , ReactiveValueRead tempo LTempo IO
                , ReactiveValueRead channel Int IO
                , ReactiveValueReadWrite board [Note] IO) =>
                Jack.Client
             -> JMIDI.Port Jack.Input
             -> JMIDI.Port Jack.Output
             -> toProcess
             -> tempo
             -> channel
             -> board
             -> Jack.NFrames
             -> Sync.ExceptionalT E.Errno IO ()
jackCallBack client input output toProcessRV tempoRV chanRV outBoard
  nframes@(Jack.NFrames nframesInt') = do
  let inMIDIRV = inMIDIEvent input nframes
      outMIDIRV = outMIDIEvent output nframes
      nframesInt = fromIntegral nframesInt' :: Int
  -- This gets the sample rate of the client and the last frame number
  -- it processed. We then use it to calculate the current absolute time
  sr <- Trans.lift $ Jack.getSampleRate client
  (Jack.NFrames lframeInt) <- Trans.lift $ Jack.lastFrameTime client
  --Trans.lift (reactiveValueRead inMIDIRV >>= (print . map (fst)))
  -- We write the content of the input buffer to the input of a
  -- translation signal function.
  -- /!\ Should maybe be moved elsewhere
  (inRaw, outPure) <- Trans.lift $ yampaReactiveDual [] readMessages
  Trans.lift (inMIDIRV =:> inRaw)
  tempo <- Trans.lift $ reactiveValueRead tempoRV
  chan <- Trans.lift $ reactiveValueRead chanRV
  boardIn' <- Trans.lift $ reactiveValueRead outBoard
  Trans.lift $ emptyRW outBoard
  let boardIn = (zip (repeat 0) boardIn',[],[])
  outMIDI <- Trans.lift $ reactiveValueRead outPure
  -- We translate all signals to be sent into low level signals and
  -- write them to the output buffer.
  (inPure, outRaw) <- Trans.lift $ yampaReactiveDual
                      (defaultTempo, sr, chan, ([],[],[])) gatherMessages
  -- This should all go in its own IO action
  Trans.lift $ do
    reactiveValueWrite inPure (tempo, sr, chan, boardIn `mappend` outMIDI)
    reactiveValueRead outRaw <**>
      (mappend <$> reactiveValueRead toProcessRV) >>=
      reactiveValueWrite toProcessRV
    --map fst <$> reactiveValueRead toProcessRV >>= print . ("toProcess " ++) . show
    (go, old') <- schedule nframesInt <$> reactiveValueRead toProcessRV
    let old = map (BF.first (+ (- nframesInt))) old'
    reactiveValueWrite outMIDIRV go
    reactiveValueWrite toProcessRV old
  --------------