module Sound.JACK
(
Client,
newClient,
newClientDefault,
disposeClient,
withClient,
withClientDefault,
clientClose,
activate,
deactivate,
withActivation,
PortType,
Direction, Input, Output,
JackFFI.UnknownType, UnknownDirection,
Port,
newPort,
disposePort,
withPort,
PortSet,
setOfPort,
setOfPorts,
Process,
connect,
makeProcess,
setProcess,
withProcess,
getSampleRate,
lastFrameTime,
makeClientRegistration,
setClientRegistration,
withClientRegistration,
JackFFI.PortId,
makePortRegistration,
setPortRegistration,
withPortRegistration,
makePortConnect,
setPortConnect,
withPortConnect,
portById,
portByName,
portName,
portShortName,
getPorts,
portGetAllConnections,
narrowPort,
narrowPortType,
narrowPortDirection,
switchUnknownTypePort,
switchUnknownDirectionPort,
JackFFI.NFrames(JackFFI.NFrames),
nframesIndices, nframesBounds,
quit, waitForBreakAndClose,
waitForBreak,
handleExceptions,
)
where
import Sound.JACK.Private
import qualified Sound.JACK.Exception as JackExc
import qualified Sound.JACK.FFI as JackFFI
import qualified Sound.JACK.FFIFree as JackFFIFree
import Sound.JACK.FFI.MIDI (EventBuffer, )
import Sound.JACK.FFI
(Process, Input(Input), Output(Output), nframesIndices, nframesBounds, )
import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans
import qualified Control.Exception as Exc
import qualified Foreign.Marshal.Array as Array
import qualified Foreign.C.String as CString
import qualified Foreign.C.Types as C
import Foreign.Storable (Storable, peek, )
import Foreign.Ptr (Ptr, FunPtr, nullPtr, castPtr, freeHaskellFunPtr, nullFunPtr, )
import Foreign.C.String (CString, peekCString, )
import Foreign.C.Error (Errno(Errno), eOK)
import qualified Data.EnumSet as ES
import Control.Concurrent (MVar, putMVar, newEmptyMVar, takeMVar, threadDelay)
import qualified System.IO as IO
import System.Posix.Signals (installHandler, keyboardSignal, Handler(Catch))
import Data.Monoid (Monoid, mempty, mappend, )
class Direction dir where
dirToFlags :: dir -> JackFFI.PortFlagSet
instance Direction Input where
dirToFlags ~Input = JackFFI.portIsInput
instance Direction Output where
dirToFlags ~Output = JackFFI.portIsOutput
data UnknownDirection = UnknownDirection
_dummyUnknownDirection :: UnknownDirection
_dummyUnknownDirection = UnknownDirection
newClient ::
(JackExc.ThrowsStatus e) =>
String
-> String
-> Sync.ExceptionalT e IO Client
newClient server name =
withCString server $ \cserverS ->
withCString name $ \cclientS ->
alloca $ \status -> do
let opt = ES.fromEnums [JackFFI.ServerName, JackFFI.NoStartServer]
client <- Trans.lift $ JackFFI.client_open cclientS opt status cserverS
_ <- checkStatus client status
return (Client client)
newClientDefault ::
(JackExc.ThrowsStatus e) =>
String
-> Sync.ExceptionalT e IO Client
newClientDefault name = newClient defaultServer name
defaultServer :: String
defaultServer = "default"
disposeClient ::
(JackExc.ThrowsErrno e) =>
Client -> Sync.ExceptionalT e IO ()
disposeClient client =
liftErrno $ JackFFI.client_close (getClient client)
withClient ::
(JackExc.ThrowsStatus e) =>
String
-> String
-> (Client -> Sync.ExceptionalT e IO a)
-> Sync.ExceptionalT e IO a
withClient server name =
bracket
(newClient server name)
(Trans.lift . fmap (const ()) .
JackFFI.client_close . getClient)
withClientDefault ::
(JackExc.ThrowsStatus e) =>
String
-> (Client -> Sync.ExceptionalT e IO a)
-> Sync.ExceptionalT e IO a
withClientDefault =
withClient defaultServer
checkStatus ::
(JackExc.ThrowsStatus e) =>
Ptr a
-> Ptr JackFFI.StatusSet
-> Sync.ExceptionalT e IO JackFFI.StatusSet
checkStatus c s = do
errCode <- Trans.lift $ peek s
Sync.assertT (JackExc.status errCode) (c /= nullPtr)
return errCode
newPortByType ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e) =>
JackFFI.PortFlagSet -> Client -> String ->
Sync.ExceptionalT e IO (Port typ dir)
newPortByType flags (Client client) name =
let aux ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e) =>
typ -> dir -> Sync.ExceptionalT e IO (Port typ dir)
aux portType dir =
withPortName name $ \cPortName ->
withCString (portTypeToCString portType) $ \pType -> do
port <- Trans.lift $
JackFFI.port_register client cPortName pType (dirToFlags dir ES..|. flags) 0
Sync.assertT JackExc.portRegister (port/=nullPtr)
return $ Port port
in aux undefined undefined
newPort ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e) =>
Client
-> String
-> Sync.ExceptionalT e IO (Port typ dir)
newPort client name =
newPortByType ES.empty client name
disposePort ::
(PortType typ, Direction dir,
JackExc.ThrowsErrno e) =>
Client -> Port typ dir -> Sync.ExceptionalT e IO ()
disposePort client =
liftErrno . JackFFI.port_unregister (getClient client) . getPort
withPort ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e,
JackExc.ThrowsErrno e) =>
Client
-> String
-> (Port typ dir -> Sync.ExceptionalT e IO a)
-> Sync.ExceptionalT e IO a
withPort client name =
bracket (newPort client name) (disposePort client)
activate ::
(JackExc.ThrowsErrno e) =>
Client -> Sync.ExceptionalT e IO ()
activate client =
liftErrno $ JackFFI.activate $ getClient client
deactivate ::
(JackExc.ThrowsErrno e) =>
Client -> Sync.ExceptionalT e IO ()
deactivate client =
liftErrno $ JackFFI.deactivate $ getClient client
withActivation ::
(JackExc.ThrowsErrno e) =>
Client ->
Sync.ExceptionalT e IO () ->
Sync.ExceptionalT e IO ()
withActivation client =
bracket_ (activate client) (deactivate client)
clientClose ::
(JackExc.ThrowsErrno e) =>
Client -> PortSet ->
Sync.ExceptionalT e IO ()
clientClose client (PortSet ports) = do
mapM_ (liftErrno . JackFFI.port_unregister (getClient client)) ports
deactivate client
disposeClient client
_dummy :: C.CInt
_dummy = undefined
foreign import ccall "wrapper" makeProcess :: Process arg -> IO (FunPtr (Process arg))
getClient :: Client -> Ptr JackFFI.Client
getClient (Client x) = x
getPort :: Port typ dir -> Ptr (JackFFI.Port typ)
getPort (Port x) = x
withPortName ::
String -> (JackFFI.PortName -> Sync.ExceptionalT e IO a) ->
Sync.ExceptionalT e IO a
withPortName name f =
withCString name $ f . JackFFI.PortName
peekPortNameArray :: Ptr CString -> IO [String]
peekPortNameArray a =
if a == nullPtr
then return []
else Exc.finally
(mapM peekCString =<< Array.peekArray0 nullPtr a)
(JackFFIFree.freePortNameArray a)
getPorts :: Client
-> IO [String]
getPorts client =
CString.withCString "" $ \empty -> do
JackFFI.get_ports (getClient client) empty empty 0
>>= peekPortNameArray
connect ::
(JackExc.ThrowsErrno e) =>
Client -> String -> String ->
Sync.ExceptionalT e IO ()
connect client outport inport =
withPortName outport $ \ outCString ->
withPortName inport $ \ inCString ->
liftErrno $ JackFFI.connect (getClient client) outCString inCString
newtype PortSet = PortSet [Ptr (JackFFI.Port ())]
instance Monoid PortSet where
mempty = PortSet mempty
mappend (PortSet a) (PortSet b) = PortSet (mappend a b)
setOfPort ::
(PortType typ, Direction dir) =>
Port typ dir -> PortSet
setOfPort =
PortSet . (:[]) . castPtr . getPort
setOfPorts ::
(PortType typ, Direction dir) =>
[Port typ dir] -> PortSet
setOfPorts =
PortSet . map (castPtr . getPort)
quit ::
MVar () -> Client -> PortSet -> IO ()
quit mvar client ports = do
putStrLn "quitting..."
Sync.resolveT
(\(Errno e) ->
IO.hPutStrLn IO.stderr $
"exception when closing with errno: " ++ show e)
(clientClose client ports)
threadDelay 1000000
putMVar mvar ()
waitForBreakAndClose ::
Client -> PortSet -> IO ()
waitForBreakAndClose client ports = do
mvar <- newEmptyMVar
_ <- installHandler keyboardSignal
(Catch $ quit mvar client ports)
Nothing
takeMVar mvar
waitForBreak :: IO ()
waitForBreak = do
mvar <- newEmptyMVar
_ <- installHandler keyboardSignal
(Catch $ do
putStrLn "quitting..."
threadDelay 1000000
putMVar mvar ())
Nothing
takeMVar mvar
handleExceptions ::
Sync.ExceptionalT JackExc.All IO () ->
IO ()
handleExceptions =
Sync.resolveT $ IO.hPutStrLn IO.stderr . JackExc.toStringWithHead
withCallback ::
(JackExc.ThrowsErrno e) =>
(callback -> IO (FunPtr callbackExt)) ->
(Client -> FunPtr callbackExt -> Ptr () -> Sync.ExceptionalT e IO ()) ->
Client -> callback ->
Sync.ExceptionalT e IO a ->
Sync.ExceptionalT e IO a
withCallback makeCallback setCallback client proc act =
bracket
(do
procPtr <- Trans.lift $ makeCallback proc
setCallback client procPtr nullPtr
return procPtr)
(\procPtr -> do
setCallback client nullFunPtr nullPtr
Trans.lift $ freeHaskellFunPtr procPtr)
(const act)
setProcess ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr (Process arg) ->
Ptr arg ->
Sync.ExceptionalT e IO ()
setProcess client procPtr arg =
liftErrno $ JackFFI.set_process_callback (getClient client) procPtr arg
withProcess ::
(JackExc.ThrowsErrno e) =>
Client ->
(JackFFI.NFrames -> Sync.ExceptionalT Errno IO ()) ->
Sync.ExceptionalT e IO a ->
Sync.ExceptionalT e IO a
withProcess =
withCallback
(\proc ->
makeProcess $ \ nframes _arg ->
Sync.switchT return (\() -> return eOK) $ proc nframes)
setProcess
getSampleRate :: Client -> IO Int
getSampleRate (Client ptr) =
fmap fromIntegral $ JackFFI.get_sample_rate ptr
lastFrameTime :: Client -> IO JackFFI.NFrames
lastFrameTime (Client client) =
JackFFI.last_frame_time client
foreign import ccall "wrapper" makeClientRegistration :: JackFFI.ClientRegistration arg -> IO (FunPtr (JackFFI.ClientRegistration arg))
setClientRegistration ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr (JackFFI.ClientRegistration arg) ->
Ptr arg ->
Sync.ExceptionalT e IO ()
setClientRegistration client procPtr arg =
liftErrno $ JackFFI.set_client_registration_callback (getClient client) procPtr arg
withClientRegistration ::
(JackExc.ThrowsErrno e) =>
Client ->
(String -> Bool -> IO ()) ->
Sync.ExceptionalT e IO a ->
Sync.ExceptionalT e IO a
withClientRegistration =
withCallback
(\proc -> makeClientRegistration $
\ namePtr registered _arg -> do
name <- peekCString namePtr
proc name (registered/=0))
setClientRegistration
foreign import ccall "wrapper" makePortRegistration :: JackFFI.PortRegistration arg -> IO (FunPtr (JackFFI.PortRegistration arg))
setPortRegistration ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr (JackFFI.PortRegistration arg) ->
Ptr arg ->
Sync.ExceptionalT e IO ()
setPortRegistration client procPtr arg =
liftErrno $ JackFFI.set_port_registration_callback (getClient client) procPtr arg
withPortRegistration ::
(JackExc.ThrowsErrno e) =>
Client ->
(JackFFI.PortId -> Bool -> IO ()) ->
Sync.ExceptionalT e IO a ->
Sync.ExceptionalT e IO a
withPortRegistration =
withCallback
(\proc -> makePortRegistration $
\ portA registered _arg ->
proc portA (registered/=0))
setPortRegistration
foreign import ccall "wrapper" makePortConnect :: JackFFI.PortConnect arg -> IO (FunPtr (JackFFI.PortConnect arg))
setPortConnect ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr (JackFFI.PortConnect arg) ->
Ptr arg ->
Sync.ExceptionalT e IO ()
setPortConnect client procPtr arg =
liftErrno $ JackFFI.set_port_connect_callback (getClient client) procPtr arg
withPortConnect ::
(JackExc.ThrowsErrno e) =>
Client ->
(JackFFI.PortId -> JackFFI.PortId -> Bool -> IO ()) ->
Sync.ExceptionalT e IO a ->
Sync.ExceptionalT e IO a
withPortConnect =
withCallback
(\proc -> makePortConnect $
\ portA portB connected _arg ->
proc portA portB (connected/=0))
setPortConnect
portById ::
Client -> JackFFI.PortId ->
IO (Port JackFFI.UnknownType UnknownDirection)
portById client portId =
fmap Port $
JackFFI.port_by_id (getClient client) portId
portByName ::
Client -> String ->
IO (Port JackFFI.UnknownType UnknownDirection)
portByName client name =
fmap Port $
CString.withCString name $ JackFFI.port_by_name (getClient client) . JackFFI.PortName
portName :: Port typ dir -> IO String
portName (Port port) = JackFFI.port_name port >>= peekCString
portShortName :: Port typ dir -> IO String
portShortName (Port port) = JackFFI.port_short_name port >>= peekCString
portGetAllConnections ::
Client -> Port typ dir -> IO [String]
portGetAllConnections client (Port port) =
JackFFI.port_get_all_connections (getClient client) port
>>= peekPortNameArray
narrowPort ::
(PortType typ, Direction dir, JackExc.ThrowsPortMismatch e) =>
Port JackFFI.UnknownType UnknownDirection ->
Sync.ExceptionalT e IO (Port typ dir)
narrowPort port =
narrowPortType =<< narrowPortDirection port
narrowPortType ::
(PortType typ, JackExc.ThrowsPortMismatch e) =>
Port JackFFI.UnknownType dir ->
Sync.ExceptionalT e IO (Port typ dir)
narrowPortType =
let aux ::
(PortType typ,
JackExc.ThrowsPortMismatch e) =>
typ -> Port JackFFI.UnknownType dir ->
Sync.ExceptionalT e IO (Port typ dir)
aux portType (Port port) = do
typ <-
Trans.lift $
peekCString . JackFFI.deconsPortName =<< JackFFI.port_type port
Sync.assertT (JackExc.portMismatch JackExc.TypeMismatch) $
portTypeToCString portType == typ
return $ Port $ castPtr port
in aux undefined
narrowPortDirection ::
(Direction dir, JackExc.ThrowsPortMismatch e) =>
Port typ UnknownDirection ->
Sync.ExceptionalT e IO (Port typ dir)
narrowPortDirection =
let aux ::
(Direction dir,
JackExc.ThrowsPortMismatch e) =>
dir -> Port typ UnknownDirection ->
Sync.ExceptionalT e IO (Port typ dir)
aux dir (Port port) = do
flags <- Trans.lift $ JackFFI.port_flags port
Sync.assertT (JackExc.portMismatch JackExc.DirectionMismatch) $
not $ ES.disjoint flags $ dirToFlags dir
return $ Port port
in aux undefined
switchUnknownTypePort ::
(JackExc.ThrowsPortMismatch e) =>
Port JackFFI.UnknownType dir ->
(Port C.CFloat dir -> Sync.ExceptionalT e IO a) ->
(Port EventBuffer dir -> Sync.ExceptionalT e IO a) ->
Sync.ExceptionalT e IO a
switchUnknownTypePort (Port port) audio midi = do
typ <-
Trans.lift $
peekCString . JackFFI.deconsPortName
=<< JackFFI.port_type port
let ifMatch ::
(PortType typ, Monad m) =>
typ -> (Port typ dir -> m a) ->
Port typ dir -> m a -> m a
ifMatch portType trueAct p falseAct =
if portTypeToCString portType == typ
then trueAct p
else falseAct
case Port $ castPtr port of
audioPort ->
ifMatch undefined audio audioPort $
case Port $ castPtr port of
midiPort ->
ifMatch undefined midi midiPort $
Sync.throwT $ JackExc.portMismatch JackExc.TypeMismatch
switchUnknownDirectionPort ::
(JackExc.ThrowsPortMismatch e) =>
Port typ UnknownDirection ->
(Port typ Input -> Sync.ExceptionalT e IO a) ->
(Port typ Output -> Sync.ExceptionalT e IO a) ->
Sync.ExceptionalT e IO a
switchUnknownDirectionPort (Port port) input output = do
flags <- Trans.lift $ JackFFI.port_flags port
let ifMatch ::
(Direction dir, Monad m) =>
dir -> (Port typ dir -> m a) ->
Port typ dir -> m a -> m a
ifMatch dir trueAct p falseAct =
if not $ ES.disjoint flags $ dirToFlags dir
then trueAct p
else falseAct
case Port port of
inPort ->
ifMatch undefined input inPort $
case Port port of
outPort ->
ifMatch undefined output outPort $
Sync.throwT $ JackExc.portMismatch JackExc.DirectionMismatch