module Sound.JACK.Audio (
    Sample, Port, withPort,

    setProcessMono,
    setProcessStereo,

    getBufferArray,

    mainMono,
    mainStereo,
    ) where

import qualified Sound.JACK.Private as Priv
import qualified Sound.JACK as Jack
import Sound.JACK.Private (Client, )
import Sound.JACK (Direction, Input, Output, )

import qualified Sound.JACK.Exception as JackExc
import Sound.JACK.FFI (NFrames, nframesIndices, nframesBounds, Process, )

import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans

import Foreign.ForeignPtr (newForeignPtr_, )
import Foreign.C.Error (eOK, )
import qualified Foreign.C.Types as C

import System.Environment (getProgName)

import Data.Array.Storable
          (StorableArray, readArray, writeArray,
           unsafeForeignPtrToStorableArray)


type Sample = C.CFloat

type Port = Priv.Port Sample


withPort ::
    (Direction dir,
     JackExc.ThrowsPortRegister e,
     JackExc.ThrowsErrno e) =>
       Client -- ^ Jack client
    -> String -- ^ name of the input port
    -> (Port dir -> Sync.ExceptionalT e IO a)
    -> Sync.ExceptionalT e IO a
withPort = Jack.withPort


getBufferArray ::
    (Direction dir) =>
    Port dir -> NFrames -> IO (StorableArray NFrames Sample)
getBufferArray port nframes = do
    flip unsafeForeignPtrToStorableArray (nframesBounds nframes)
        =<< newForeignPtr_
        =<< Priv.portGetBuffer port nframes


mainMono :: (Sample -> IO Sample) -> IO ()
mainMono fun = do
    name <- getProgName
    Jack.handleExceptions $
        Jack.withClientDefault name $ \client ->
        Jack.withPort client "input" $ \input ->
        Jack.withPort client "output" $ \output -> do
            setProcessMono client input fun output
            Jack.withActivation client $ Trans.lift $ do
                putStrLn $ "started " ++ name ++ "..."
                Jack.waitForBreak

setProcessMono ::
    (JackExc.ThrowsErrno e) =>
    Client ->
    Port Input -> (Sample -> IO Sample) ->
    Port Output ->
    Sync.ExceptionalT e IO ()
setProcessMono client input fun output =
    Jack.setProcess client =<<
    (Trans.lift $ Jack.mkProcess $ wrapMonoFun input fun output)

wrapMonoFun ::
    Port Input -> (Sample -> IO Sample) ->
    Port Output -> Process
wrapMonoFun input fun output nframes _args = do
    inArr <- getBufferArray input nframes
    outArr <- getBufferArray output nframes
    mapM_ (applyToArraysMono inArr fun outArr) (nframesIndices nframes)
    return eOK

applyToArraysMono ::
       StorableArray NFrames Sample -> (Sample -> IO Sample)
    -> StorableArray NFrames Sample
    -> NFrames -> IO ()
applyToArraysMono inArr fun outArr i =
    readArray inArr i >>= fun >>= writeArray outArr i

mainStereo :: ((Sample, Sample) -> IO (Sample, Sample)) -> IO ()
mainStereo fun = do
    name <- getProgName
    Jack.handleExceptions $
        Jack.withClientDefault name $ \client ->
        Jack.withPort client "inputLeft" $ \inputLeft ->
        Jack.withPort client "inputRight" $ \inputRight ->
        Jack.withPort client "outputLeft" $ \outputLeft ->
        Jack.withPort client "outputRight" $ \outputRight -> do
            setProcessStereo client
                inputLeft inputRight fun
                outputLeft outputRight
            Jack.withActivation client $ Trans.lift $ do
                putStrLn $ "started " ++ name ++ "..."
                Jack.waitForBreak


setProcessStereo ::
    (JackExc.ThrowsErrno e) =>
    Client ->
    Port Input -> Port Input ->
    ((Sample, Sample) -> IO (Sample, Sample)) ->
    Port Output -> Port Output ->
    Sync.ExceptionalT e IO ()
setProcessStereo client inputLeft inputRight fun outputLeft outputRight =
    Jack.setProcess client =<<
    (Trans.lift $ Jack.mkProcess $
     wrapStereoFun inputLeft inputRight fun outputLeft outputRight)


wrapStereoFun ::
       Port Input -> Port Input
    -> ((Sample, Sample) -> IO (Sample, Sample))
    -> Port Output -> Port Output
    -> Process
wrapStereoFun iL iR fun oL oR nframes _args = do
    inLArr <- getBufferArray iL nframes
    inRArr <- getBufferArray iR nframes
    outLArr <- getBufferArray oL nframes
    outRArr <- getBufferArray oR nframes
    mapM_ (applyToArraysStereo inLArr inRArr fun outLArr outRArr) (nframesIndices nframes)
    return eOK

applyToArraysStereo :: StorableArray NFrames Sample
    -> StorableArray NFrames Sample
    -> ((Sample, Sample) -> IO (Sample, Sample))
    -> StorableArray NFrames Sample
    -> StorableArray NFrames Sample
    -> NFrames -> IO ()
applyToArraysStereo iL iR fun oL oR i = do
    l <- readArray iL i
    r <- readArray iR i
    (l', r') <- fun (l, r)
    writeArray oL i l'
    writeArray oR i r'