-- Haskell bindings to the JACK Audio Connection Kit -- -- Copyright (c) 2010 Philipp Balzarek (p.balzarek@googlemail.com) -- -- License: MIT; see LICENSE file -- -- Description -- -- Language : GHC Haskell -- -- This module provides a monad interface to the JACK bindings. -- The client is handled by a Reader Monad to prevent leaking it {-# LANGUAGE GeneralizedNewtypeDeriving, NoMonomorphismRestriction #-} -- | A monadic interface to the JACK api. The client handle is -- hidden in a Reader so you don't have to touch it. -- -- For now please refer to the documentation of the C library found at -- -- -- -- for a complete description -- -- Unlifted versions can be found in "Sound.Jack.Bindings" module Sound.Jack.JackMonad ( runWithNewClient , runWithNewClientDefaultServer , JackAction , getClientName , activate , deactivate , clientThreadId , isRealtime , cycleWait , cycleSignal , setProcessThread , setThreadInitCallback , setProcessCallback , setFreewheelCallback , setBufferSizeCallback , setSampleRateCallback , setClientRegistrationCallback , setPortRegistrationCallback , setPortConnectCallback , setGraphOrderCallback , setXrunCallback , setFreewheel , setBufferSize , getSampleRate , getBufferSize , engineTakeoverTimebase , cpuLoad , portRegister , portUnregister , portIsMine , portGetAllConnections , jackPortGetTotalLatency , recomputeTotalLatencies , portRequestMonitorByName , connect , disconnect , portDisconnect , getPorts , portByName , portById , framesSinceCycleStart , frameTime , framesToTime , timeToFrames , unsafeAskClient , unsafeClientClose -- lifted , clientNameSize , internalClientNew , internalClientClose , portGetBuffer , portName , portShortName , portFlags , portType , portConnected , portGetConnections , jackPortGetLatency , portSetLatency , portSetName , portSetAlias , portUnsetAlias , portRequestMonitor , portEnsureMonitor , portMonitoringInput , portNameSize , portTypeSize , getTime -- reexports from Bindings , FFI.Port , FFI.PortFlags(..) , FFI.AudioSample , FFI.BufferSizeCallback , FFI.ClientRegistrationCallback , FFI.FreewheelCallback , FFI.GraphOrderCallback , FFI.PortConnectCallback , FFI.PortRegistrationCallback , FFI.ProcessCallback , FFI.SampleRateCallback , FFI.ThreadCallback , FFI.ThreadInitCallback , FFI.XRunCallback , FFI.Options(..) , FFI.Client -- opaque , FFI.Status(..) , FFI.PortID -- opaque , FFI.defaultAudioType , FFI.defaultMidiType , FFI.fromThread , FFI.NFrames , FFI.Thread , FFI.Time ) where --import qualified Sound.Jack as Jack import qualified Sound.Jack.Bindings as FFI import Data.Word import Foreign.Ptr import Foreign.C import Control.Monad.Trans import Control.Monad.Reader -- import Control.Monad -- import Control.Exception -- import Control.Applicative -- | JackAction is a ReaderT Client over IO -- -- Run it with runWithNewClient[DefaultServer] newtype JackAction a = JA {unJA :: (ReaderT FFI.Client IO a) } deriving (Monad, Functor, MonadIO) runWithClient :: FFI.Client -> JackAction a -> IO a runWithClient client action = runReaderT (unJA action) client -- | create a new Client, install Exception handlers and run the supplied action -- -- Takes the server name, creation options, the name of the client -- , the action to run and the action to run the client could not be created runWithNewClient :: String -> [FFI.Options] -> String -> ([FFI.Status] -> JackAction a) -> ([FFI.Status] -> IO a) -> IO a runWithNewClient serverName options clientName action = FFI.withOpenClient serverName options clientName (\client flags -> runWithClient client (action flags) ) -- | create a new Client, install Exception handlers and run the supplied action -- -- Takes creation options, the name of the client, the action to run and the action to run the client could not be created runWithNewClientDefaultServer :: [FFI.Options] -> String -> ([FFI.Status] -> JackAction a) -> ([FFI.Status] -> IO a) -> IO a runWithNewClientDefaultServer options clientName action = FFI.withOpenClientDefaultServer options clientName (\client flags -> runWithClient client (action flags) ) -- brings the first Argument into the last position flip1 :: (t -> t1) -> t -> t1 flip1 f z = f z flip2 :: (t1 -> t -> t2) -> t -> t1 -> t2 flip2 f y z = f z y flip3 :: (t2 -> t -> t1 -> t3) -> t -> t1 -> t2 -> t3 flip3 f x y z = f z x y flip4 :: (t3 -> t -> t1 -> t2 -> t4) -> t -> t1 -> t2 -> t3 -> t4 flip4 f w x y z = f z w x y flip5 :: (t4 -> t -> t1 -> t2 -> t3 -> t5) -> t -> t1 -> t2 -> t3 -> t4 -> t5 flip5 f v w x y z = f z v w x y readerT1 :: (FFI.Client -> IO a) -> JackAction a readerT1 f = JA . ReaderT $ flip1 f readerT2 :: (FFI.Client -> t -> IO a) -> t -> JackAction a readerT2 f x = JA . ReaderT $ flip2 f x readerT3 :: (FFI.Client -> t -> t1 -> IO a) -> t -> t1 -> JackAction a readerT3 f x y = JA . ReaderT $ flip3 f x y readerT4 :: (FFI.Client -> t -> t1 -> t2 -> IO a) -> t -> t1 -> t2 -> JackAction a readerT4 f x y z = JA . ReaderT $ flip4 f x y z readerT5 :: (FFI.Client -> t -> t1 -> t2 -> t3 -> IO a) -> t -> t1 -> t2 -> t3 -> JackAction a readerT5 f x y z u= JA . ReaderT $ flip5 f x y z u -- semi-automatically generated from the types ----------------------------------------------- -- | Read the client handle from the reader. -- You shouldn't need that. unsafeAskClient :: JackAction FFI.Client unsafeAskClient = JA ask -- | close the Client. RunWithNewClient should normally do that for you. unsafeClientClose :: JackAction () unsafeClientClose = readerT1 FFI.clientClose getClientName :: JackAction String getClientName = readerT1 FFI.getClientName activate :: JackAction Int activate = readerT1 FFI.activate deactivate :: JackAction Int deactivate = readerT1 FFI.deactivate clientThreadId :: JackAction FFI.Thread clientThreadId = readerT1 FFI.clientThreadId isRealtime :: JackAction Bool isRealtime = readerT1 FFI.isRealtime cycleWait :: JackAction Word32 cycleWait = readerT1 FFI.cycleWait cycleSignal :: Int -> JackAction () cycleSignal = readerT2 FFI.cycleSignal setProcessThread :: FFI.ThreadCallback -> Ptr () -> JackAction Int setProcessThread = readerT3 FFI.setProcessThread setThreadInitCallback :: FFI.ThreadInitCallback -> Ptr () -> JackAction Int setThreadInitCallback = readerT3 FFI.setThreadInitCallback setProcessCallback :: FFI.ProcessCallback -> Ptr () -> JackAction Int setProcessCallback = readerT3 FFI.setProcessCallback setFreewheelCallback :: FFI.FreewheelCallback -> Ptr () -> JackAction Int setFreewheelCallback = readerT3 FFI.setFreewheelCallback setBufferSizeCallback :: FFI.BufferSizeCallback -> Ptr () -> JackAction Int setBufferSizeCallback = readerT3 FFI.setBufferSizeCallback setSampleRateCallback :: FFI.SampleRateCallback -> Ptr () -> JackAction Int setSampleRateCallback = readerT3 FFI.setSampleRateCallback setClientRegistrationCallback :: FFI.ClientRegistrationCallback -> Ptr () -> JackAction Int setClientRegistrationCallback = readerT3 FFI.setClientRegistrationCallback setPortRegistrationCallback :: FFI.PortRegistrationCallback -> Ptr () -> JackAction Int setPortRegistrationCallback = readerT3 FFI.setPortRegistrationCallback setPortConnectCallback :: FFI.PortConnectCallback -> Ptr () -> JackAction Int setPortConnectCallback = readerT3 FFI.setPortConnectCallback setGraphOrderCallback :: FFI.GraphOrderCallback -> Ptr () -> JackAction Int setGraphOrderCallback = readerT3 FFI.setGraphOrderCallback setXrunCallback :: FFI.XRunCallback -> Ptr () -> JackAction Int setXrunCallback = readerT3 FFI.setXrunCallback setFreewheel :: Bool -> JackAction Int setFreewheel = readerT2 FFI.setFreewheel setBufferSize :: Word32 -> JackAction Int setBufferSize = readerT2 FFI.setBufferSize getSampleRate :: JackAction CUInt getSampleRate = readerT1 FFI.getSampleRate getBufferSize :: JackAction Word32 getBufferSize = readerT1 FFI.getBufferSize engineTakeoverTimebase :: JackAction Int engineTakeoverTimebase = readerT1 FFI.engineTakeoverTimebase cpuLoad :: JackAction Float cpuLoad = readerT1 FFI.cpuLoad portRegister :: String -> String -> [FFI.PortFlags] -> Int -> JackAction FFI.Port portRegister = readerT5 FFI.portRegister portUnregister :: FFI.Port -> JackAction Int portUnregister = readerT2 FFI.portUnregister portIsMine :: FFI.Port -> JackAction Bool portIsMine = readerT2 FFI.portIsMine portGetAllConnections :: FFI.Port -> JackAction [String] portGetAllConnections = readerT2 FFI.portGetAllConnections jackPortGetTotalLatency :: FFI.Port -> JackAction Word32 jackPortGetTotalLatency = readerT2 FFI.jackPortGetTotalLatency recomputeTotalLatencies :: JackAction Int recomputeTotalLatencies = readerT1 FFI.recomputeTotalLatencies portRequestMonitorByName :: String -> Bool -> JackAction Int portRequestMonitorByName = readerT3 FFI.portRequestMonitorByName connect :: String -> String -> JackAction Int connect = readerT3 FFI.connect disconnect :: String -> String -> JackAction Int disconnect = readerT3 FFI.disconnect portDisconnect :: FFI.Port -> JackAction Int portDisconnect = readerT2 FFI.portDisconnect getPorts :: String -> String -> [FFI.PortFlags] -> JackAction [String] getPorts = readerT4 FFI.getPorts portByName :: String -> JackAction FFI.Port portByName = readerT2 FFI.portByName portById :: FFI.PortID -> JackAction FFI.Port portById = readerT2 FFI.portById framesSinceCycleStart :: JackAction Word32 framesSinceCycleStart = readerT1 FFI.framesSinceCycleStart frameTime :: JackAction Word32 frameTime = readerT1 FFI.frameTime framesToTime :: Word32 -> JackAction FFI.Time framesToTime = readerT2 FFI.framesToTime timeToFrames :: FFI.Time -> JackAction Word32 timeToFrames = readerT2 FFI.timeToFrames liftIO0 :: IO a -> JackAction a liftIO0 f = JA . ReaderT . const $ f liftIO1 :: (t -> IO a) -> t -> JackAction a liftIO1 f x = JA . ReaderT . const $ f x liftIO2 :: (t -> t1 -> IO a) -> t -> t1 -> JackAction a liftIO2 f x y = JA . ReaderT . const $ f x y liftIO3 :: (t -> t1 -> t2 -> IO a) -> t -> t1 -> t2 -> JackAction a liftIO3 f x y z = JA . ReaderT . const $ f x y z clientNameSize :: JackAction Int clientNameSize = liftIO0 FFI.clientNameSize internalClientNew :: String -> String -> String -> JackAction Int internalClientNew = liftIO3 FFI.internalClientNew internalClientClose :: String -> JackAction () internalClientClose = liftIO1 FFI.internalClientClose portGetBuffer :: FFI.Port -> Word32 -> JackAction (Ptr FFI.AudioSample) portGetBuffer = liftIO2 FFI.portGetBuffer portName :: FFI.Port -> JackAction String portName = liftIO1 FFI.portName portShortName :: FFI.Port -> JackAction String portShortName = liftIO1 FFI.portShortName portFlags :: FFI.Port -> JackAction [FFI.PortFlags] portFlags = liftIO1 FFI.portFlags portType :: FFI.Port -> JackAction String portType = liftIO1 FFI.portType portConnected :: FFI.Port -> JackAction Int portConnected = liftIO1 FFI.portConnected portGetConnections :: FFI.Port -> JackAction [String] portGetConnections = liftIO1 FFI.portGetConnections jackPortGetLatency :: FFI.Port -> JackAction Word32 jackPortGetLatency = liftIO1 FFI.jackPortGetLatency portSetLatency :: FFI.Port -> Word32 -> JackAction () portSetLatency = liftIO2 FFI.portSetLatency portSetName :: FFI.Port -> String -> JackAction Int portSetName = liftIO2 FFI.portSetName portSetAlias :: FFI.Port -> String -> JackAction Int portSetAlias = liftIO2 FFI.portSetAlias portUnsetAlias :: FFI.Port -> String -> JackAction Int portUnsetAlias = liftIO2 FFI.portUnsetAlias portRequestMonitor :: FFI.Port -> Bool -> JackAction Int portRequestMonitor = liftIO2 FFI.portRequestMonitor portEnsureMonitor :: FFI.Port -> Bool -> JackAction Int portEnsureMonitor = liftIO2 FFI.portEnsureMonitor portMonitoringInput :: FFI.Port -> JackAction Int portMonitoringInput = liftIO1 FFI.portMonitoringInput portNameSize :: JackAction Int portNameSize = liftIO0 FFI.portNameSize portTypeSize :: JackAction Int portTypeSize = liftIO0 FFI.portTypeSize getTime :: JackAction FFI.Time getTime = liftIO0 FFI.getTime