module Sound.RtMidi
( InputDevice
, OutputDevice
, IsDevice (getDeviceType)
, DeviceType (..)
, Api (..)
, Error (..)
, ready
, compiledApis
, openPort
, openVirtualPort
, closePort
, portCount
, portName
, listPorts
, findPort
, defaultInput
, createInput
, setCallback
, setForeignCallback
, cancelCallback
, ignoreTypes
, getMessage
, getMessageSized
, defaultOutput
, createOutput
, sendMessage
, currentApi
) where
import Control.Exception (Exception, throwIO)
import Control.Monad (unless, void)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.IO.Unlift (MonadUnliftIO (..))
import Data.Coerce (coerce)
import Data.Word (Word8)
import Foreign (FunPtr, Ptr, Storable (..), alloca, allocaArray, nullPtr, peekArray, with, withArrayLen)
import Foreign.C (CDouble (..), CInt (..), CSize, CString, CUChar (..), peekCString, withCString)
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)
import Sound.RtMidi.Foreign
defaultMessageSize :: Int
defaultMessageSize :: Int
defaultMessageSize = 4
data DeviceType =
InputDeviceType
| OutputDeviceType
deriving (DeviceType -> DeviceType -> Bool
(DeviceType -> DeviceType -> Bool)
-> (DeviceType -> DeviceType -> Bool) -> Eq DeviceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceType -> DeviceType -> Bool
$c/= :: DeviceType -> DeviceType -> Bool
== :: DeviceType -> DeviceType -> Bool
$c== :: DeviceType -> DeviceType -> Bool
Eq, Int -> DeviceType -> ShowS
[DeviceType] -> ShowS
DeviceType -> String
(Int -> DeviceType -> ShowS)
-> (DeviceType -> String)
-> ([DeviceType] -> ShowS)
-> Show DeviceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeviceType] -> ShowS
$cshowList :: [DeviceType] -> ShowS
show :: DeviceType -> String
$cshow :: DeviceType -> String
showsPrec :: Int -> DeviceType -> ShowS
$cshowsPrec :: Int -> DeviceType -> ShowS
Show)
newtype Device = Device { Device -> ForeignPtr Wrapper
unDevice :: ForeignPtr Wrapper }
deriving (Device -> Device -> Bool
(Device -> Device -> Bool)
-> (Device -> Device -> Bool) -> Eq Device
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c== :: Device -> Device -> Bool
Eq, Int -> Device -> ShowS
[Device] -> ShowS
Device -> String
(Int -> Device -> ShowS)
-> (Device -> String) -> ([Device] -> ShowS) -> Show Device
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Device] -> ShowS
$cshowList :: [Device] -> ShowS
show :: Device -> String
$cshow :: Device -> String
showsPrec :: Int -> Device -> ShowS
$cshowsPrec :: Int -> Device -> ShowS
Show)
class IsDevice d where
toDevice :: d -> Device
getDeviceType :: d -> DeviceType
newtype InputDevice = InputDevice { InputDevice -> Device
unInputDevice :: Device }
deriving (InputDevice -> InputDevice -> Bool
(InputDevice -> InputDevice -> Bool)
-> (InputDevice -> InputDevice -> Bool) -> Eq InputDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputDevice -> InputDevice -> Bool
$c/= :: InputDevice -> InputDevice -> Bool
== :: InputDevice -> InputDevice -> Bool
$c== :: InputDevice -> InputDevice -> Bool
Eq, Int -> InputDevice -> ShowS
[InputDevice] -> ShowS
InputDevice -> String
(Int -> InputDevice -> ShowS)
-> (InputDevice -> String)
-> ([InputDevice] -> ShowS)
-> Show InputDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputDevice] -> ShowS
$cshowList :: [InputDevice] -> ShowS
show :: InputDevice -> String
$cshow :: InputDevice -> String
showsPrec :: Int -> InputDevice -> ShowS
$cshowsPrec :: Int -> InputDevice -> ShowS
Show)
instance IsDevice InputDevice where
toDevice :: InputDevice -> Device
toDevice = InputDevice -> Device
unInputDevice
getDeviceType :: InputDevice -> DeviceType
getDeviceType _ = DeviceType
InputDeviceType
newInputDevice :: Ptr Wrapper -> IO InputDevice
newInputDevice :: Ptr Wrapper -> IO InputDevice
newInputDevice = (ForeignPtr Wrapper -> InputDevice)
-> IO (ForeignPtr Wrapper) -> IO InputDevice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Device -> InputDevice
InputDevice (Device -> InputDevice)
-> (ForeignPtr Wrapper -> Device)
-> ForeignPtr Wrapper
-> InputDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr Wrapper -> Device
Device) (IO (ForeignPtr Wrapper) -> IO InputDevice)
-> (Ptr Wrapper -> IO (ForeignPtr Wrapper))
-> Ptr Wrapper
-> IO InputDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr Wrapper -> Ptr Wrapper -> IO (ForeignPtr Wrapper)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Wrapper
rtmidi_in_free
newtype OutputDevice = OutputDevice { OutputDevice -> Device
unOutputDevice :: Device }
deriving (OutputDevice -> OutputDevice -> Bool
(OutputDevice -> OutputDevice -> Bool)
-> (OutputDevice -> OutputDevice -> Bool) -> Eq OutputDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputDevice -> OutputDevice -> Bool
$c/= :: OutputDevice -> OutputDevice -> Bool
== :: OutputDevice -> OutputDevice -> Bool
$c== :: OutputDevice -> OutputDevice -> Bool
Eq, Int -> OutputDevice -> ShowS
[OutputDevice] -> ShowS
OutputDevice -> String
(Int -> OutputDevice -> ShowS)
-> (OutputDevice -> String)
-> ([OutputDevice] -> ShowS)
-> Show OutputDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputDevice] -> ShowS
$cshowList :: [OutputDevice] -> ShowS
show :: OutputDevice -> String
$cshow :: OutputDevice -> String
showsPrec :: Int -> OutputDevice -> ShowS
$cshowsPrec :: Int -> OutputDevice -> ShowS
Show)
instance IsDevice OutputDevice where
toDevice :: OutputDevice -> Device
toDevice = OutputDevice -> Device
unOutputDevice
getDeviceType :: OutputDevice -> DeviceType
getDeviceType _ = DeviceType
OutputDeviceType
newOutputDevice :: Ptr Wrapper -> IO OutputDevice
newOutputDevice :: Ptr Wrapper -> IO OutputDevice
newOutputDevice = (ForeignPtr Wrapper -> OutputDevice)
-> IO (ForeignPtr Wrapper) -> IO OutputDevice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Device -> OutputDevice
OutputDevice (Device -> OutputDevice)
-> (ForeignPtr Wrapper -> Device)
-> ForeignPtr Wrapper
-> OutputDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr Wrapper -> Device
Device) (IO (ForeignPtr Wrapper) -> IO OutputDevice)
-> (Ptr Wrapper -> IO (ForeignPtr Wrapper))
-> Ptr Wrapper
-> IO OutputDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr Wrapper -> Ptr Wrapper -> IO (ForeignPtr Wrapper)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Wrapper
rtmidi_out_free
data Api
= UnspecifiedApi
| CoreMidiApi
| AlsaApi
| JackApi
| MultimediaApi
| KernelStreamingApi
| DummyApi
deriving (Api -> Api -> Bool
(Api -> Api -> Bool) -> (Api -> Api -> Bool) -> Eq Api
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Api -> Api -> Bool
$c/= :: Api -> Api -> Bool
== :: Api -> Api -> Bool
$c== :: Api -> Api -> Bool
Eq, Int -> Api -> ShowS
[Api] -> ShowS
Api -> String
(Int -> Api -> ShowS)
-> (Api -> String) -> ([Api] -> ShowS) -> Show Api
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Api] -> ShowS
$cshowList :: [Api] -> ShowS
show :: Api -> String
$cshow :: Api -> String
showsPrec :: Int -> Api -> ShowS
$cshowsPrec :: Int -> Api -> ShowS
Show)
instance Bounded Api where
minBound :: Api
minBound = Api
UnspecifiedApi
maxBound :: Api
maxBound = Api
DummyApi
instance Enum Api where
fromEnum :: Api -> Int
fromEnum UnspecifiedApi = 0
fromEnum CoreMidiApi = 1
fromEnum AlsaApi = 2
fromEnum JackApi = 3
fromEnum MultimediaApi = 4
fromEnum DummyApi = 5
toEnum :: Int -> Api
toEnum 0 = Api
UnspecifiedApi
toEnum 1 = Api
CoreMidiApi
toEnum 2 = Api
AlsaApi
toEnum 3 = Api
JackApi
toEnum 4 = Api
MultimediaApi
toEnum 5 = Api
DummyApi
newtype Error = Error String deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)
instance Exception Error
guardError :: Ptr Wrapper -> IO ()
guardError :: Ptr Wrapper -> IO ()
guardError dptr :: Ptr Wrapper
dptr = do
Wrapper
w <- Ptr Wrapper -> IO Wrapper
forall a. Storable a => Ptr a -> IO a
peek Ptr Wrapper
dptr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Wrapper -> Bool
ok Wrapper
w) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String
e <- CString -> IO String
peekCString (Wrapper -> CString
msg Wrapper
w)
Error -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> Error
Error String
e)
withDevicePtrUnguarded :: IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded :: d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded = ForeignPtr Wrapper -> (Ptr Wrapper -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (ForeignPtr Wrapper -> (Ptr Wrapper -> IO a) -> IO a)
-> (d -> ForeignPtr Wrapper) -> d -> (Ptr Wrapper -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> ForeignPtr Wrapper
unDevice (Device -> ForeignPtr Wrapper)
-> (d -> Device) -> d -> ForeignPtr Wrapper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Device
forall d. IsDevice d => d -> Device
toDevice
withDevicePtr :: IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr :: d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d :: d
d f :: Ptr Wrapper -> IO a
f = d -> (Ptr Wrapper -> IO a) -> IO a
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded d
d (\dptr :: Ptr Wrapper
dptr -> Ptr Wrapper -> IO a
f Ptr Wrapper
dptr IO a -> IO () -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr)
ready :: (MonadIO m, IsDevice d) => d -> m Bool
ready :: d -> m Bool
ready d :: d
d = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (d -> (Ptr Wrapper -> IO Bool) -> IO Bool
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d ((Wrapper -> Bool) -> IO Wrapper -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Wrapper -> Bool
ok (IO Wrapper -> IO Bool)
-> (Ptr Wrapper -> IO Wrapper) -> Ptr Wrapper -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wrapper -> IO Wrapper
forall a. Storable a => Ptr a -> IO a
peek))
compiledApis :: MonadIO m => m [Api]
compiledApis :: m [Api]
compiledApis = IO [Api] -> m [Api]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Api] -> m [Api]) -> IO [Api] -> m [Api]
forall a b. (a -> b) -> a -> b
$ do
Int
n <- (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr CInt -> CUInt -> IO CInt
rtmidi_get_compiled_api Ptr CInt
forall a. Ptr a
nullPtr 0)
[CInt]
as <- Int -> (Ptr CInt -> IO [CInt]) -> IO [CInt]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n ((Ptr CInt -> IO [CInt]) -> IO [CInt])
-> (Ptr CInt -> IO [CInt]) -> IO [CInt]
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr CInt
ptr -> do
Ptr CInt -> CUInt -> IO CInt
rtmidi_get_compiled_api Ptr CInt
ptr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
Int -> Ptr CInt -> IO [CInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr CInt
ptr
[Api] -> IO [Api]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CInt -> Api) -> [CInt] -> [Api]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Api
forall a. Enum a => Int -> a
toEnum (Int -> Api) -> (CInt -> Int) -> CInt -> Api
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [CInt]
as)
openPort :: (MonadIO m, IsDevice d)
=> d
-> Int
-> String
-> m ()
openPort :: d -> Int -> String -> m ()
openPort d :: d
d n :: Int
n name :: String
name = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ d -> (Ptr Wrapper -> IO ()) -> IO ()
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d ((Ptr Wrapper -> IO ()) -> IO ())
-> (Ptr Wrapper -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr ->
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
name (Ptr Wrapper -> CUInt -> CString -> IO ()
rtmidi_open_port Ptr Wrapper
dptr (Int -> CUInt
forall a. Enum a => Int -> a
toEnum Int
n))
openVirtualPort :: (MonadIO m, IsDevice d) => d -> String -> m ()
openVirtualPort :: d -> String -> m ()
openVirtualPort d :: d
d name :: String
name = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ d -> (Ptr Wrapper -> IO ()) -> IO ()
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d ((Ptr Wrapper -> IO ()) -> IO ())
-> (Ptr Wrapper -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr -> do
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
name (Ptr Wrapper -> CString -> IO ()
rtmidi_open_virtual_port Ptr Wrapper
dptr)
closePort :: (MonadIO m, IsDevice d) => d -> m ()
closePort :: d -> m ()
closePort d :: d
d = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (d -> (Ptr Wrapper -> IO ()) -> IO ()
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d Ptr Wrapper -> IO ()
rtmidi_close_port)
portCount :: (MonadIO m, IsDevice d) => d -> m Int
portCount :: d -> m Int
portCount d :: d
d = IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ d -> (Ptr Wrapper -> IO Int) -> IO Int
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d ((Ptr Wrapper -> IO Int) -> IO Int)
-> (Ptr Wrapper -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr -> do
CUInt
x <- Ptr Wrapper -> IO CUInt
rtmidi_get_port_count Ptr Wrapper
dptr
Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
x)
portName :: (MonadIO m, IsDevice d) => d -> Int -> m (Maybe String)
portName :: d -> Int -> m (Maybe String)
portName d :: d
d n :: Int
n = IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ d -> (Ptr Wrapper -> IO (Maybe String)) -> IO (Maybe String)
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded d
d ((Ptr Wrapper -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr Wrapper -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr -> do
CString
x <- Ptr Wrapper -> CUInt -> IO CString
rtmidi_get_port_name Ptr Wrapper
dptr (Int -> CUInt
forall a. Enum a => Int -> a
toEnum Int
n)
Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
String
s <- CString -> IO String
peekCString CString
x
case String
s of
[] -> Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
_ -> Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String
forall a. a -> Maybe a
Just String
s)
listPorts :: (MonadIO m, IsDevice d) => d -> m [(Int, String)]
listPorts :: d -> m [(Int, String)]
listPorts d :: d
d = IO [(Int, String)] -> m [(Int, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Int, String)] -> m [(Int, String)])
-> IO [(Int, String)] -> m [(Int, String)]
forall a b. (a -> b) -> a -> b
$ d -> IO Int
forall (m :: * -> *) d. (MonadIO m, IsDevice d) => d -> m Int
portCount d
d IO Int -> (Int -> IO [(Int, String)]) -> IO [(Int, String)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Int, String)] -> Int -> Int -> IO [(Int, String)]
forall (f :: * -> *).
MonadIO f =>
[(Int, String)] -> Int -> Int -> f [(Int, String)]
go [] 0 where
go :: [(Int, String)] -> Int -> Int -> f [(Int, String)]
go acc :: [(Int, String)]
acc i :: Int
i c :: Int
c =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
c
then [(Int, String)] -> f [(Int, String)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Int, String)] -> [(Int, String)]
forall a. [a] -> [a]
reverse [(Int, String)]
acc)
else do
Maybe String
mn <- d -> Int -> f (Maybe String)
forall (m :: * -> *) d.
(MonadIO m, IsDevice d) =>
d -> Int -> m (Maybe String)
portName d
d Int
i
let acc' :: [(Int, String)]
acc' = [(Int, String)]
-> (String -> [(Int, String)]) -> Maybe String -> [(Int, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Int, String)]
acc (\n :: String
n -> (Int
i, String
n)(Int, String) -> [(Int, String)] -> [(Int, String)]
forall a. a -> [a] -> [a]
:[(Int, String)]
acc) Maybe String
mn
[(Int, String)] -> Int -> Int -> f [(Int, String)]
go [(Int, String)]
acc' (Int -> Int
forall a. Enum a => a -> a
succ Int
i) Int
c
findPort :: (MonadIO m, IsDevice d) => d -> (String -> Bool) -> m (Maybe Int)
findPort :: d -> (String -> Bool) -> m (Maybe Int)
findPort d :: d
d f :: String -> Bool
f = IO (Maybe Int) -> m (Maybe Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Int) -> m (Maybe Int))
-> IO (Maybe Int) -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ d -> IO Int
forall (m :: * -> *) d. (MonadIO m, IsDevice d) => d -> m Int
portCount d
d IO Int -> (Int -> IO (Maybe Int)) -> IO (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> IO (Maybe Int)
forall (f :: * -> *). MonadIO f => Int -> Int -> f (Maybe Int)
go 0 where
go :: Int -> Int -> f (Maybe Int)
go i :: Int
i c :: Int
c =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
c
then Maybe Int -> f (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
else do
Maybe String
mn <- d -> Int -> f (Maybe String)
forall (m :: * -> *) d.
(MonadIO m, IsDevice d) =>
d -> Int -> m (Maybe String)
portName d
d Int
i
case Maybe String
mn of
Just n :: String
n | String -> Bool
f String
n -> Maybe Int -> f (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i)
_ -> Int -> Int -> f (Maybe Int)
go (Int -> Int
forall a. Enum a => a -> a
succ Int
i) Int
c
defaultInput :: MonadIO m => m InputDevice
defaultInput :: m InputDevice
defaultInput = IO InputDevice -> m InputDevice
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputDevice -> m InputDevice)
-> IO InputDevice -> m InputDevice
forall a b. (a -> b) -> a -> b
$ do
Ptr Wrapper
dptr <- IO (Ptr Wrapper)
rtmidi_in_create_default
Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
Ptr Wrapper -> IO InputDevice
newInputDevice Ptr Wrapper
dptr
createInput :: MonadIO m
=> Api
-> String
-> Int
-> m InputDevice
createInput :: Api -> String -> Int -> m InputDevice
createInput api :: Api
api clientName :: String
clientName queueSizeLimit :: Int
queueSizeLimit = IO InputDevice -> m InputDevice
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputDevice -> m InputDevice)
-> IO InputDevice -> m InputDevice
forall a b. (a -> b) -> a -> b
$ do
Ptr Wrapper
dptr <- String -> (CString -> IO (Ptr Wrapper)) -> IO (Ptr Wrapper)
forall a. String -> (CString -> IO a) -> IO a
withCString String
clientName (\str :: CString
str -> CInt -> CString -> CUInt -> IO (Ptr Wrapper)
rtmidi_in_create (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Api -> Int
forall a. Enum a => a -> Int
fromEnum Api
api)) CString
str (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
queueSizeLimit))
Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
Ptr Wrapper -> IO InputDevice
newInputDevice Ptr Wrapper
dptr
foreign import ccall "wrapper"
mkCallbackPointer :: (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()) -> IO (FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()))
adaptCallbackCTypes :: (Double -> [Word8] -> IO ()) -> (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
adaptCallbackCTypes :: (Double -> [Word8] -> IO ())
-> CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()
adaptCallbackCTypes f :: Double -> [Word8] -> IO ()
f (CDouble t :: Double
t) d :: Ptr CUChar
d s :: CInt
s _ = Int -> Ptr CUChar -> IO [CUChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
s) Ptr CUChar
d IO [CUChar] -> ([CUChar] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: [CUChar]
a -> Double -> [Word8] -> IO ()
f Double
t ([CUChar] -> [Word8]
forall a b. Coercible a b => a -> b
coerce [CUChar]
a)
setCallback :: MonadUnliftIO m
=> InputDevice
-> (Double -> [Word8] -> m ())
-> m ()
setCallback :: InputDevice -> (Double -> [Word8] -> m ()) -> m ()
setCallback d :: InputDevice
d c :: Double -> [Word8] -> m ()
c = ((forall a. m a -> IO a) -> IO ()) -> m ()
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \run :: forall a. m a -> IO a
run -> InputDevice -> (Ptr Wrapper -> IO ()) -> IO ()
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr InputDevice
d ((Ptr Wrapper -> IO ()) -> IO ())
-> (Ptr Wrapper -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr -> do
FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
f <- (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
-> IO (FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()))
mkCallbackPointer ((Double -> [Word8] -> IO ())
-> CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()
adaptCallbackCTypes (\ts :: Double
ts bytes :: [Word8]
bytes -> m () -> IO ()
forall a. m a -> IO a
run (Double -> [Word8] -> m ()
c Double
ts [Word8]
bytes)))
Ptr Wrapper
-> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
-> Ptr ()
-> IO ()
rtmidi_in_set_callback Ptr Wrapper
dptr FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
f Ptr ()
forall a. Ptr a
nullPtr
setForeignCallback :: MonadIO m
=> InputDevice
-> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
-> Ptr ()
-> m ()
setForeignCallback :: InputDevice
-> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
-> Ptr ()
-> m ()
setForeignCallback d :: InputDevice
d f :: FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
f ctx :: Ptr ()
ctx = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InputDevice -> (Ptr Wrapper -> IO ()) -> IO ()
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr InputDevice
d ((Ptr Wrapper -> IO ()) -> IO ())
-> (Ptr Wrapper -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr ->
Ptr Wrapper
-> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
-> Ptr ()
-> IO ()
rtmidi_in_set_callback Ptr Wrapper
dptr FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
f Ptr ()
ctx
cancelCallback :: MonadIO m => InputDevice -> m ()
cancelCallback :: InputDevice -> m ()
cancelCallback d :: InputDevice
d = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (InputDevice -> (Ptr Wrapper -> IO ()) -> IO ()
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr InputDevice
d Ptr Wrapper -> IO ()
rtmidi_in_cancel_callback)
ignoreTypes :: MonadIO m
=> InputDevice
-> Bool
-> Bool
-> Bool
-> m ()
ignoreTypes :: InputDevice -> Bool -> Bool -> Bool -> m ()
ignoreTypes d :: InputDevice
d x :: Bool
x y :: Bool
y z :: Bool
z = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (InputDevice -> (Ptr Wrapper -> IO ()) -> IO ()
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded InputDevice
d (\dptr :: Ptr Wrapper
dptr -> Ptr Wrapper -> Bool -> Bool -> Bool -> IO ()
rtmidi_in_ignore_types Ptr Wrapper
dptr Bool
x Bool
y Bool
z))
getMessageSized :: MonadIO m => InputDevice -> Int -> m (Double, [Word8])
getMessageSized :: InputDevice -> Int -> m (Double, [Word8])
getMessageSized d :: InputDevice
d n :: Int
n = IO (Double, [Word8]) -> m (Double, [Word8])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, [Word8]) -> m (Double, [Word8]))
-> IO (Double, [Word8]) -> m (Double, [Word8])
forall a b. (a -> b) -> a -> b
$ (Ptr CSize -> IO (Double, [Word8])) -> IO (Double, [Word8])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Double, [Word8])) -> IO (Double, [Word8]))
-> (Ptr CSize -> IO (Double, [Word8])) -> IO (Double, [Word8])
forall a b. (a -> b) -> a -> b
$ \s :: Ptr CSize
s -> Int -> (Ptr CUChar -> IO (Double, [Word8])) -> IO (Double, [Word8])
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n ((Ptr CUChar -> IO (Double, [Word8])) -> IO (Double, [Word8]))
-> (Ptr CUChar -> IO (Double, [Word8])) -> IO (Double, [Word8])
forall a b. (a -> b) -> a -> b
$ (Ptr CUChar
-> (Ptr (Ptr CUChar) -> IO (Double, [Word8]))
-> IO (Double, [Word8]))
-> (Ptr (Ptr CUChar) -> IO (Double, [Word8]))
-> Ptr CUChar
-> IO (Double, [Word8])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr CUChar
-> (Ptr (Ptr CUChar) -> IO (Double, [Word8]))
-> IO (Double, [Word8])
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ((Ptr (Ptr CUChar) -> IO (Double, [Word8]))
-> Ptr CUChar -> IO (Double, [Word8]))
-> (Ptr (Ptr CUChar) -> IO (Double, [Word8]))
-> Ptr CUChar
-> IO (Double, [Word8])
forall a b. (a -> b) -> a -> b
$ \m :: Ptr (Ptr CUChar)
m -> InputDevice
-> (Ptr Wrapper -> IO (Double, [Word8])) -> IO (Double, [Word8])
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded InputDevice
d ((Ptr Wrapper -> IO (Double, [Word8])) -> IO (Double, [Word8]))
-> (Ptr Wrapper -> IO (Double, [Word8])) -> IO (Double, [Word8])
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr -> do
Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
s (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
CDouble timestamp :: Double
timestamp <- Ptr Wrapper -> Ptr (Ptr CUChar) -> Ptr CSize -> IO CDouble
rtmidi_in_get_message Ptr Wrapper
dptr Ptr (Ptr CUChar)
m Ptr CSize
s
Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
CSize
size <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
s
[Word8]
message <-
case CSize
size of
0 -> [Word8] -> IO [Word8]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
_ -> do
Ptr CUChar
x <- Ptr (Ptr CUChar) -> IO (Ptr CUChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CUChar)
m
[CUChar]
y <- Int -> Ptr CUChar -> IO [CUChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size) Ptr CUChar
x
[Word8] -> IO [Word8]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CUChar] -> [Word8]
forall a b. Coercible a b => a -> b
coerce [CUChar]
y)
(Double, [Word8]) -> IO (Double, [Word8])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
timestamp, [Word8]
message)
getMessage :: MonadIO m => InputDevice -> m (Double, [Word8])
getMessage :: InputDevice -> m (Double, [Word8])
getMessage d :: InputDevice
d = IO (Double, [Word8]) -> m (Double, [Word8])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (InputDevice -> Int -> IO (Double, [Word8])
forall (m :: * -> *).
MonadIO m =>
InputDevice -> Int -> m (Double, [Word8])
getMessageSized InputDevice
d Int
defaultMessageSize)
defaultOutput :: MonadIO m => m OutputDevice
defaultOutput :: m OutputDevice
defaultOutput = IO OutputDevice -> m OutputDevice
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OutputDevice -> m OutputDevice)
-> IO OutputDevice -> m OutputDevice
forall a b. (a -> b) -> a -> b
$ do
Ptr Wrapper
dptr <- IO (Ptr Wrapper)
rtmidi_out_create_default
Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
Ptr Wrapper -> IO OutputDevice
newOutputDevice Ptr Wrapper
dptr
createOutput :: MonadIO m
=> Api
-> String
-> m OutputDevice
createOutput :: Api -> String -> m OutputDevice
createOutput api :: Api
api clientName :: String
clientName = IO OutputDevice -> m OutputDevice
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OutputDevice -> m OutputDevice)
-> IO OutputDevice -> m OutputDevice
forall a b. (a -> b) -> a -> b
$ do
Ptr Wrapper
dptr <- String -> (CString -> IO (Ptr Wrapper)) -> IO (Ptr Wrapper)
forall a. String -> (CString -> IO a) -> IO a
withCString String
clientName (CInt -> CString -> IO (Ptr Wrapper)
rtmidi_out_create (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Api -> Int
forall a. Enum a => a -> Int
fromEnum Api
api)))
Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
Ptr Wrapper -> IO OutputDevice
newOutputDevice Ptr Wrapper
dptr
sendMessage :: MonadIO m => OutputDevice -> [Word8] -> m ()
sendMessage :: OutputDevice -> [Word8] -> m ()
sendMessage d :: OutputDevice
d m :: [Word8]
m = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> (Int -> Ptr Word8 -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Word8]
m ((Int -> Ptr Word8 -> IO ()) -> IO ())
-> (Int -> Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \n :: Int
n ptr :: Ptr Word8
ptr -> OutputDevice -> (Ptr Wrapper -> IO ()) -> IO ()
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr OutputDevice
d ((Ptr Wrapper -> IO ()) -> IO ())
-> (Ptr Wrapper -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr ->
IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ptr Wrapper -> Ptr CUChar -> CInt -> IO CInt
rtmidi_out_send_message Ptr Wrapper
dptr (Ptr Word8 -> Ptr CUChar
forall a b. Coercible a b => a -> b
coerce Ptr Word8
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
currentApi :: MonadIO m => IsDevice d => d -> m Api
currentApi :: d -> m Api
currentApi d :: d
d = IO Api -> m Api
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Api -> m Api) -> IO Api -> m Api
forall a b. (a -> b) -> a -> b
$ d -> (Ptr Wrapper -> IO Api) -> IO Api
forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d ((Ptr Wrapper -> IO Api) -> IO Api)
-> (Ptr Wrapper -> IO Api) -> IO Api
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Wrapper
dptr -> do
CInt
res <-
case d -> DeviceType
forall d. IsDevice d => d -> DeviceType
getDeviceType d
d of
InputDeviceType -> Ptr Wrapper -> IO CInt
rtmidi_in_get_current_api Ptr Wrapper
dptr
OutputDeviceType -> Ptr Wrapper -> IO CInt
rtmidi_out_get_current_api Ptr Wrapper
dptr
Api -> IO Api
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Api
forall a. Enum a => Int -> a
toEnum (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res))