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,
disconnect,
makeProcess,
setProcess,
withProcess,
getBufferSize,
getSampleRate,
lastFrameTime,
makeClientRegistration,
setClientRegistration,
withClientRegistration,
JackFFI.PortId,
makePortRegistration,
setPortRegistration,
withPortRegistration,
makePortConnect,
setPortConnect,
withPortConnect,
portById,
portByName,
portName,
portShortName,
portAliases,
getPorts,
portGetAllConnections,
narrowPort,
narrowPortType,
narrowPortDirection,
switchUnknownTypePort,
switchUnknownDirectionPort,
JackFFI.NFrames(JackFFI.NFrames),
nframesIndices, nframesBounds,
quit, waitForBreakAndClose,
waitForBreak,
handleExceptions,
) where
import Sound.JACK.Private
(Port(Port), PortType, PortTypeString, portTypeString, Client(Client),
bracket, bracket_, liftErrno, withCString, alloca, )
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, 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 Control.Monad (join)
import Control.Applicative (Const(Const), (<$>), (<$), )
import qualified Foreign.Marshal.Array as Array
import qualified Foreign.C.String as CString
import qualified Foreign.C.Types as C
import Foreign.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 Data.Monoid (Monoid, mempty, mappend, )
class Direction dir where
switchDir :: f Input -> f Output -> f dir
instance Direction Input where switchDir f _ = f
instance Direction Output where switchDir _ f = f
type DirFlagSet = Const JackFFI.PortFlagSet
dirFlags :: Direction dir => Const JackFFI.PortFlagSet dir
dirFlags = switchDir (Const JackFFI.portIsInput) (Const 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) =>
PortTypeString typ -> DirFlagSet dir -> Client -> String ->
Sync.ExceptionalT e IO (Port typ dir)
newPortByType (Const portTyp) (Const dir) (Client client) name =
withPortName name $ \cPortName ->
withCString portTyp $ \pType -> do
port <-
Trans.lift $
JackFFI.port_register client cPortName
(JackFFI.PortType pType) dir 0
Sync.assertT JackExc.portRegister (port/=nullPtr)
return $ Port port
newPort ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e) =>
Client
-> String
-> Sync.ExceptionalT e IO (Port typ dir)
newPort = newPortByType portTypeString dirFlags
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
disconnect ::
(JackExc.ThrowsErrno e) =>
Client -> String -> String ->
Sync.ExceptionalT e IO ()
disconnect client outport inport =
withPortName outport $ \ outCString ->
withPortName inport $ \ inCString ->
liftErrno $ JackFFI.disconnect (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
Exc.finally waitForBreak (quit mvar client ports)
takeMVar mvar
waitForBreak :: IO ()
waitForBreak =
let go = getLine >> go
in go
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
getBufferSize :: Client -> IO Int
getBufferSize (Client ptr) =
fmap fromIntegral $ JackFFI.get_buffer_size ptr
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) =
peekCString . JackFFI.deconsPortName =<< JackFFI.port_name port
portShortName :: Port typ dir -> IO String
portShortName (Port port) = JackFFI.port_short_name port >>= peekCString
portType :: Port JackFFI.UnknownType dir -> IO String
portType (Port port) =
peekCString . JackFFI.deconsPortType =<< JackFFI.port_type port
castPort :: Port typ0 dir0 -> Port typ1 dir1
castPort (Port port) = Port $ castPtr port
portAliases :: Port typ dir -> IO [String]
portAliases (Port port) = do
sz <- fmap fromIntegral JackFFI.port_name_size
Array.allocaArray sz $ \s1 ->
Array.allocaArray sz $ \s2 -> do
let ss = [s1, s2]
Array.withArray ss $ \ptr -> do
cnt <- JackFFI.port_get_aliases port ptr
if cnt <= 2
then mapM peekCString $ take (fromIntegral cnt) ss
else error $ "port_get_aliases returned " ++ show cnt ++ " aliases"
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 port = do
typ <- Trans.lift $ portType port
liftExc $ narrowPortTypeMaybe portTypeString typ port
narrowPortDirection ::
(Direction dir, JackExc.ThrowsPortMismatch e) =>
Port typ UnknownDirection ->
Sync.ExceptionalT e IO (Port typ dir)
narrowPortDirection (Port port) = do
flags <- Trans.lift $ JackFFI.port_flags port
liftExc $ narrowPortDirectionMaybe dirFlags flags (Port port)
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 audio midi = do
typ <- Trans.lift $ portType port
join $ liftExc $
altExc
(audio <$> narrowPortTypeMaybe portTypeString typ port)
(midi <$> narrowPortTypeMaybe portTypeString typ port)
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
join $ liftExc $
altExc
(input <$> narrowPortDirectionMaybe dirFlags flags (Port port))
(output <$> narrowPortDirectionMaybe dirFlags flags (Port port))
narrowPortTypeMaybe ::
(PortType typ, JackExc.ThrowsPortMismatch e) =>
PortTypeString typ -> String -> Port JackFFI.UnknownType dir ->
Sync.Exceptional e (Port typ dir)
narrowPortTypeMaybe (Const portTyp) typ port =
castPort port <$
Sync.assert (JackExc.portMismatch JackExc.TypeMismatch) (portTyp == typ)
narrowPortDirectionMaybe ::
(Direction dir, JackExc.ThrowsPortMismatch e) =>
DirFlagSet dir -> JackFFI.PortFlagSet -> Port typ UnknownDirection ->
Sync.Exceptional e (Port typ dir)
narrowPortDirectionMaybe (Const dir) flags (Port port) =
Port port <$
Sync.assert
(JackExc.portMismatch JackExc.DirectionMismatch)
(not $ ES.disjoint flags dir)
liftExc :: (Monad m) => Sync.Exceptional e a -> Sync.ExceptionalT e m a
liftExc = Sync.ExceptionalT . return
altExc :: Sync.Exceptional e a -> Sync.Exceptional e a -> Sync.Exceptional e a
altExc x y = Sync.switch (const y) Sync.Success x