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,
mkProcess,
setProcess,
JackFFI.CallbackArg,
getSampleRate,
mkClientRegistration,
setClientRegistration,
JackFFI.PortId,
mkPortRegistration,
setPortRegistration,
mkPortConnect,
setPortConnect,
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, nframesIndices, nframesBounds, )
import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans
import Control.Exception (finally, )
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, )
import Foreign.C.String (CString, peekCString, )
import Foreign.C.Error (Errno(Errno), )
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
data Input = Input
instance Direction Input where
dirToFlags ~Input = JackFFI.portIsInput
data Output = Output
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" mkProcess :: Process -> IO (FunPtr Process)
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 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
setProcess ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr Process ->
Sync.ExceptionalT e IO ()
setProcess client procPtr =
liftErrno $ JackFFI.set_process_callback (getClient client) procPtr nullPtr
getSampleRate :: Client -> IO Int
getSampleRate (Client ptr) =
fmap fromIntegral $ JackFFI.get_sample_rate ptr
foreign import ccall "wrapper" mkClientRegistration :: JackFFI.ClientRegistration -> IO (FunPtr JackFFI.ClientRegistration)
setClientRegistration ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr JackFFI.ClientRegistration ->
Sync.ExceptionalT e IO ()
setClientRegistration client procPtr =
liftErrno $ JackFFI.set_client_registration_callback (getClient client) procPtr nullPtr
foreign import ccall "wrapper" mkPortRegistration :: JackFFI.PortRegistration -> IO (FunPtr JackFFI.PortRegistration)
setPortRegistration ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr JackFFI.PortRegistration ->
Sync.ExceptionalT e IO ()
setPortRegistration client procPtr =
liftErrno $ JackFFI.set_port_registration_callback (getClient client) procPtr nullPtr
foreign import ccall "wrapper" mkPortConnect :: JackFFI.PortConnect -> IO (FunPtr JackFFI.PortConnect)
setPortConnect ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr JackFFI.PortConnect ->
Sync.ExceptionalT e IO ()
setPortConnect client procPtr =
liftErrno $ JackFFI.set_port_connect_callback (getClient client) procPtr nullPtr
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