{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}

-- | Interface to RtMidi
module Sound.RtMidi
  ( InputDevice
  , OutputDevice
  , IsDevice (getDeviceType)
  , DeviceType (..)
  , Api (..)
  , Error (..)
  , apiName
  , apiDisplayName
  , compiledApiByName
  , ready
  , compiledApis
  , openPort
  , openVirtualPort
  , closePort
  , portCount
  , portName
  , listPorts
  , findPort
  , defaultInput
  , createInput
  , setCallback
  , setUnsafeCallback
  , setForeignCallback
  , cancelCallback
  , ignoreTypes
  , getMessage
  , getMessageSized
  , getMessageMutable
  , defaultOutput
  , createOutput
  , sendMessage
  , sendUnsafeMessage
  , currentApi
  )
where

import Control.DeepSeq (NFData)
import Control.Exception (Exception, throwIO)
import Control.Monad (unless, void)
import Data.Coerce (coerce)
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as VSM
import Data.Word (Word8)
import Foreign (FunPtr, Ptr, Storable (..), alloca, allocaArray, allocaBytes, nullPtr, peekArray)
import Foreign.C (CDouble (..), CInt (..), CSize, CString, CUChar (..), peekCString, peekCStringLen, withCString)
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)
import GHC.Generics (Generic)
import Sound.RtMidi.Foreign
  ( Api (..)
  , Wrapper (..)
  , fromApi
  , rtmidi_api_display_name
  , rtmidi_api_name
  , rtmidi_close_port
  , rtmidi_compiled_api_by_name
  , rtmidi_get_compiled_api
  , rtmidi_get_port_count
  , rtmidi_get_port_name
  , rtmidi_in_cancel_callback
  , rtmidi_in_create
  , rtmidi_in_create_default
  , rtmidi_in_free
  , rtmidi_in_get_current_api
  , rtmidi_in_get_message
  , rtmidi_in_ignore_types
  , rtmidi_in_set_callback
  , rtmidi_open_port
  , rtmidi_open_virtual_port
  , rtmidi_out_create
  , rtmidi_out_create_default
  , rtmidi_out_free
  , rtmidi_out_get_current_api
  , rtmidi_out_send_message
  , toApi
  )

-- The default message size (in bytes) expected from 'getMessage'
-- Mostly just needs to be bigger than the max MIDI message size, which is 3 bytes
-- However, sysex messages can be quite large, so you might have to use the 'getMessageSized' variant.
defaultMessageSize :: Int
defaultMessageSize :: Int
defaultMessageSize = Int
4

-- The max length of port names returned from 'rtmidi_get_port_name'
maxPortNameLength :: Int
maxPortNameLength :: Int
maxPortNameLength = Int
256

-- | Allows us to discriminate in/out functions in generic contexts
data DeviceType
  = InputDeviceType
  | OutputDeviceType
  deriving stock (DeviceType -> DeviceType -> Bool
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
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, Eq DeviceType
DeviceType -> DeviceType -> Bool
DeviceType -> DeviceType -> Ordering
DeviceType -> DeviceType -> DeviceType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeviceType -> DeviceType -> DeviceType
$cmin :: DeviceType -> DeviceType -> DeviceType
max :: DeviceType -> DeviceType -> DeviceType
$cmax :: DeviceType -> DeviceType -> DeviceType
>= :: DeviceType -> DeviceType -> Bool
$c>= :: DeviceType -> DeviceType -> Bool
> :: DeviceType -> DeviceType -> Bool
$c> :: DeviceType -> DeviceType -> Bool
<= :: DeviceType -> DeviceType -> Bool
$c<= :: DeviceType -> DeviceType -> Bool
< :: DeviceType -> DeviceType -> Bool
$c< :: DeviceType -> DeviceType -> Bool
compare :: DeviceType -> DeviceType -> Ordering
$ccompare :: DeviceType -> DeviceType -> Ordering
Ord, Int -> DeviceType
DeviceType -> Int
DeviceType -> [DeviceType]
DeviceType -> DeviceType
DeviceType -> DeviceType -> [DeviceType]
DeviceType -> DeviceType -> DeviceType -> [DeviceType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DeviceType -> DeviceType -> DeviceType -> [DeviceType]
$cenumFromThenTo :: DeviceType -> DeviceType -> DeviceType -> [DeviceType]
enumFromTo :: DeviceType -> DeviceType -> [DeviceType]
$cenumFromTo :: DeviceType -> DeviceType -> [DeviceType]
enumFromThen :: DeviceType -> DeviceType -> [DeviceType]
$cenumFromThen :: DeviceType -> DeviceType -> [DeviceType]
enumFrom :: DeviceType -> [DeviceType]
$cenumFrom :: DeviceType -> [DeviceType]
fromEnum :: DeviceType -> Int
$cfromEnum :: DeviceType -> Int
toEnum :: Int -> DeviceType
$ctoEnum :: Int -> DeviceType
pred :: DeviceType -> DeviceType
$cpred :: DeviceType -> DeviceType
succ :: DeviceType -> DeviceType
$csucc :: DeviceType -> DeviceType
Enum, DeviceType
forall a. a -> a -> Bounded a
maxBound :: DeviceType
$cmaxBound :: DeviceType
minBound :: DeviceType
$cminBound :: DeviceType
Bounded, forall x. Rep DeviceType x -> DeviceType
forall x. DeviceType -> Rep DeviceType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeviceType x -> DeviceType
$cfrom :: forall x. DeviceType -> Rep DeviceType x
Generic)
  deriving anyclass (DeviceType -> ()
forall a. (a -> ()) -> NFData a
rnf :: DeviceType -> ()
$crnf :: DeviceType -> ()
NFData)

newtype Device = Device {Device -> ForeignPtr Wrapper
unDevice :: ForeignPtr Wrapper}
  deriving stock (Device -> Device -> Bool
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
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)

-- | Generalizes 'InputDevice' and 'OutputDevice' for use in common functions
class IsDevice d where
  toDevice :: d -> Device
  getDeviceType :: d -> DeviceType

-- | A handle to a device to be used for input
newtype InputDevice = InputDevice {InputDevice -> Device
unInputDevice :: Device}
  deriving stock (InputDevice -> InputDevice -> Bool
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
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 InputDevice
_ = DeviceType
InputDeviceType

newInputDevice :: Ptr Wrapper -> IO InputDevice
newInputDevice :: Ptr Wrapper -> IO InputDevice
newInputDevice = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Device -> InputDevice
InputDevice forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr Wrapper -> Device
Device) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Wrapper -> IO ())
rtmidi_in_free

-- | A handle to a device to be used for input
newtype OutputDevice = OutputDevice {OutputDevice -> Device
unOutputDevice :: Device}
  deriving stock (OutputDevice -> OutputDevice -> Bool
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
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 OutputDevice
_ = DeviceType
OutputDeviceType

newOutputDevice :: Ptr Wrapper -> IO OutputDevice
newOutputDevice :: Ptr Wrapper -> IO OutputDevice
newOutputDevice = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Device -> OutputDevice
OutputDevice forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr Wrapper -> Device
Device) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Wrapper -> IO ())
rtmidi_out_free

-- | An internal RtMidi error
newtype Error = Error {Error -> String
unError :: String}
  deriving stock (Error -> Error -> Bool
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
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, forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic)
  deriving anyclass (Error -> ()
forall a. (a -> ()) -> NFData a
rnf :: Error -> ()
$crnf :: Error -> ()
NFData)

instance Exception Error

-- Detects and throws internal errors
guardError :: Ptr Wrapper -> IO ()
guardError :: Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr = do
  Wrapper
w <- forall a. Storable a => Ptr a -> IO a
peek Ptr Wrapper
dptr
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Wrapper -> Bool
ok Wrapper
w) forall a b. (a -> b) -> a -> b
$ do
    String
e <- CString -> IO String
peekCString (Wrapper -> CString
msg Wrapper
w)
    forall e a. Exception e => e -> IO a
throwIO (String -> Error
Error String
e)

-- Operate on the underlying device ptr
withDevicePtrUnguarded :: IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded :: forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> ForeignPtr Wrapper
unDevice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. IsDevice d => d -> Device
toDevice

-- Operate on the underlying device ptr and guard for errors
withDevicePtr :: IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr :: forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d Ptr Wrapper -> IO a
f = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded d
d (\Ptr Wrapper
dptr -> Ptr Wrapper -> IO a
f Ptr Wrapper
dptr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr)

-- | Get the display name for the given 'Api'.
apiDisplayName :: Api -> IO String
apiDisplayName :: Api -> IO String
apiDisplayName Api
api = ApiInternal -> IO CString
rtmidi_api_display_name (Api -> ApiInternal
fromApi Api
api) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

-- | Get the internal name for the given 'Api'.
apiName :: Api -> IO String
apiName :: Api -> IO String
apiName Api
api = ApiInternal -> IO CString
rtmidi_api_name (Api -> ApiInternal
fromApi Api
api) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

-- | Lookup a compiled 'Api' by name.
compiledApiByName :: String -> IO Api
compiledApiByName :: String -> IO Api
compiledApiByName String
name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApiInternal -> Api
toApi (forall a. String -> (CString -> IO a) -> IO a
withCString String
name CString -> IO ApiInternal
rtmidi_compiled_api_by_name)

-- | Check if a device is ok
ready :: IsDevice d => d -> IO Bool
ready :: forall d. IsDevice d => d -> IO Bool
ready d
d = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Wrapper -> Bool
ok forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Ptr a -> IO a
peek)

-- | A static function to determine MIDI 'Api's built in.
compiledApis :: IO [Api]
compiledApis :: IO [Api]
compiledApis = do
  Int
n <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr ApiInternal -> CUInt -> IO CInt
rtmidi_get_compiled_api forall a. Ptr a
nullPtr CUInt
0)
  [ApiInternal]
as <- forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n forall a b. (a -> b) -> a -> b
$ \Ptr ApiInternal
ptr -> do
    Ptr ApiInternal -> CUInt -> IO CInt
rtmidi_get_compiled_api Ptr ApiInternal
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr ApiInternal
ptr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a -> b) -> [a] -> [b]
map ApiInternal -> Api
toApi [ApiInternal]
as)

-- | Open a MIDI connection
openPort
  :: IsDevice d
  => d
  -> Int
  -- ^ port number
  -> String
  -- ^ name for the application port that is used
  -> IO ()
openPort :: forall d. IsDevice d => d -> Int -> String -> IO ()
openPort d
d Int
n String
name = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d forall a b. (a -> b) -> a -> b
$ \Ptr Wrapper
dptr ->
  forall a. String -> (CString -> IO a) -> IO a
withCString String
name (Ptr Wrapper -> CUInt -> CString -> IO ()
rtmidi_open_port Ptr Wrapper
dptr (forall a. Enum a => Int -> a
toEnum Int
n))

-- | This function creates a virtual MIDI output port to which other software applications can connect.
--
-- This type of functionality is currently only supported by the Macintosh OS X, Linux ALSA and JACK APIs
-- (the function does nothing with the other APIs).
openVirtualPort :: IsDevice d => d -> String -> IO ()
openVirtualPort :: forall d. IsDevice d => d -> String -> IO ()
openVirtualPort d
d String
name = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d forall a b. (a -> b) -> a -> b
$ \Ptr Wrapper
dptr -> do
  forall a. String -> (CString -> IO a) -> IO a
withCString String
name (Ptr Wrapper -> CString -> IO ()
rtmidi_open_virtual_port Ptr Wrapper
dptr)

-- | Close an open MIDI connection (if one exists).
closePort :: IsDevice d => d -> IO ()
closePort :: forall d. IsDevice d => d -> IO ()
closePort d
d = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d Ptr Wrapper -> IO ()
rtmidi_close_port

-- | Return the number of MIDI ports available to the 'Device'.
portCount :: IsDevice d => d -> IO Int
portCount :: forall d. IsDevice d => d -> IO Int
portCount d
d = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d forall a b. (a -> b) -> a -> b
$ \Ptr Wrapper
dptr -> do
  CUInt
x <- Ptr Wrapper -> IO CUInt
rtmidi_get_port_count Ptr Wrapper
dptr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
x)

-- | Return a string identifier for the specified MIDI port number.
--
-- 'Nothing' is returned if an invalid port specifier is provided.
portName :: IsDevice d => d -> Int -> IO (Maybe String)
portName :: forall d. IsDevice d => d -> Int -> IO (Maybe String)
portName d
d Int
n = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded d
d forall a b. (a -> b) -> a -> b
$ \Ptr Wrapper
dptr -> do
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
lenPtr -> do
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
lenPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPortNameLength)
    forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
maxPortNameLength forall a b. (a -> b) -> a -> b
$ \CString
namePtr -> do
      CInt
used <- Ptr Wrapper -> CUInt -> CString -> Ptr CInt -> IO CInt
rtmidi_get_port_name Ptr Wrapper
dptr (forall a. Enum a => Int -> a
toEnum Int
n) CString
namePtr Ptr CInt
lenPtr
      Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
      String
s <- CStringLen -> IO String
peekCStringLen (CString
namePtr, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
used)
      case String
s of
        [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just String
s)

-- | Convenience function to list ports.
--
-- Note that the underlying library does not offer an "atomic" interface for this
-- so results may be inconsistent if you connect/disconnect ports during this call.
listPorts :: IsDevice d => d -> IO [(Int, String)]
listPorts :: forall d. IsDevice d => d -> IO [(Int, String)]
listPorts d
d = forall d. IsDevice d => d -> IO Int
portCount d
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Int, String)] -> Int -> Int -> IO [(Int, String)]
go [] Int
0
 where
  go :: [(Int, String)] -> Int -> Int -> IO [(Int, String)]
go [(Int, String)]
acc Int
i Int
c =
    if Int
i forall a. Ord a => a -> a -> Bool
>= Int
c
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> [a]
reverse [(Int, String)]
acc)
      else do
        Maybe String
mn <- forall d. IsDevice d => d -> Int -> IO (Maybe String)
portName d
d Int
i
        let acc' :: [(Int, String)]
acc' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Int, String)]
acc (\String
n -> (Int
i, String
n) forall a. a -> [a] -> [a]
: [(Int, String)]
acc) Maybe String
mn
        [(Int, String)] -> Int -> Int -> IO [(Int, String)]
go [(Int, String)]
acc' (forall a. Enum a => a -> a
succ Int
i) Int
c

-- | Convenience function to lookup the first port satisfying the predicate.
--
-- You may want to find an exact name:
--
-- > findPort d (== name)
--
-- Or you may want to match part of a name:
--
-- > findPort d (isInfixOf name)
--
-- Note that if you are performing many lookups, it's better to use 'listPorts' and
-- do the lookups yourself (see the caveats there too).
findPort :: IsDevice d => d -> (String -> Bool) -> IO (Maybe Int)
findPort :: forall d. IsDevice d => d -> (String -> Bool) -> IO (Maybe Int)
findPort d
d String -> Bool
f = forall d. IsDevice d => d -> IO Int
portCount d
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> IO (Maybe Int)
go Int
0
 where
  go :: Int -> Int -> IO (Maybe Int)
go Int
i Int
c =
    if Int
i forall a. Ord a => a -> a -> Bool
>= Int
c
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      else do
        Maybe String
mn <- forall d. IsDevice d => d -> Int -> IO (Maybe String)
portName d
d Int
i
        case Maybe String
mn of
          Just String
n | String -> Bool
f String
n -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Int
i)
          Maybe String
_ -> Int -> Int -> IO (Maybe Int)
go (forall a. Enum a => a -> a
succ Int
i) Int
c

-- | Default constructor for a 'Device' to use for input.
defaultInput :: IO InputDevice
defaultInput :: IO InputDevice
defaultInput = 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

-- | Create a new 'Device' to use for input.
createInput
  :: Api
  -- ^ API to use
  -> String
  -- ^ client name
  -> Int
  -- ^ size of the MIDI input queue
  -> IO InputDevice
createInput :: Api -> String -> Int -> IO InputDevice
createInput Api
api String
clientName Int
queueSizeLimit = do
  Ptr Wrapper
dptr <- forall a. String -> (CString -> IO a) -> IO a
withCString String
clientName (\CString
str -> ApiInternal -> CString -> CUInt -> IO (Ptr Wrapper)
rtmidi_in_create (Api -> ApiInternal
fromApi Api
api) CString
str (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 -> VS.Vector Word8 -> IO ()) -> (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
adaptCallbackCTypes :: (Double -> Vector Word8 -> IO ())
-> CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()
adaptCallbackCTypes !Double -> Vector Word8 -> IO ()
f (CDouble !Double
t) Ptr CUChar
m CInt
s Ptr ()
_ = do
  Vector Word8
buf <- forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> (Int -> m a) -> m (Vector a)
VS.generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
s) (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (coerce :: forall a b. Coercible a b => a -> b
coerce Ptr CUChar
m))
  Double -> Vector Word8 -> IO ()
f Double
t Vector Word8
buf

adaptUnsafeCallbackCTypes :: (Double -> Ptr Word8 -> Int -> IO ()) -> (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
adaptUnsafeCallbackCTypes :: (Double -> Ptr Word8 -> Int -> IO ())
-> CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()
adaptUnsafeCallbackCTypes !Double -> Ptr Word8 -> Int -> IO ()
f (CDouble !Double
t) Ptr CUChar
m CInt
s Ptr ()
_ = Double -> Ptr Word8 -> Int -> IO ()
f Double
t (coerce :: forall a b. Coercible a b => a -> b
coerce Ptr CUChar
m) (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
s)

-- | Set a callback function to be invoked for incoming MIDI messages.
--
-- The callback function will be called whenever an incoming MIDI message is received.
-- While not absolutely necessary, it is best to set the callback function before opening a MIDI port to avoid leaving
-- some messages in the queue.
setCallback
  :: InputDevice
  -> (Double -> VS.Vector Word8 -> IO ())
  -- ^ Function that takes a timestamp and a MIDI message as arguments
  -> IO ()
setCallback :: InputDevice -> (Double -> Vector Word8 -> IO ()) -> IO ()
setCallback InputDevice
d Double -> Vector Word8 -> IO ()
c = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr InputDevice
d forall a b. (a -> b) -> a -> b
$ \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 -> Vector Word8 -> IO ())
-> CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()
adaptCallbackCTypes Double -> Vector Word8 -> IO ()
c)
  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 forall a. Ptr a
nullPtr

-- | A variant of 'setCallback' that takes a raw pointer and length. It is unsafe to share or reference the pointer beyond the
-- scope of the callback, as the RtMidi-owned memory it references may have been changed or freed.
setUnsafeCallback
  :: InputDevice
  -> (Double -> Ptr Word8 -> Int -> IO ())
  -> IO ()
setUnsafeCallback :: InputDevice -> (Double -> Ptr Word8 -> Int -> IO ()) -> IO ()
setUnsafeCallback InputDevice
d Double -> Ptr Word8 -> Int -> IO ()
c = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr InputDevice
d forall a b. (a -> b) -> a -> b
$ \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 -> Ptr Word8 -> Int -> IO ())
-> CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()
adaptUnsafeCallbackCTypes Double -> Ptr Word8 -> Int -> IO ()
c)
  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 forall a. Ptr a
nullPtr

-- | Set a /foreign/ callback function to be invoked for incoming MIDI messages.
--
-- This variant allows you to set the callback to a C function pointer so we're not forced
-- to enter a Haskell wrapper every invocation.
setForeignCallback
  :: InputDevice
  -> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
  -> Ptr ()
  -- ^ Pointer to context that will be passed into the callback
  -> IO ()
setForeignCallback :: InputDevice
-> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
-> Ptr ()
-> IO ()
setForeignCallback InputDevice
d FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())
f Ptr ()
ctx = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr InputDevice
d forall a b. (a -> b) -> a -> b
$ \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

-- | Cancel use of the current callback function (if one exists).
--
-- Subsequent incoming MIDI messages will be written to the queue and can be retrieved with the `getMessage` function.
cancelCallback :: InputDevice -> IO ()
cancelCallback :: InputDevice -> IO ()
cancelCallback InputDevice
d = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr InputDevice
d Ptr Wrapper -> IO ()
rtmidi_in_cancel_callback

-- | Specify whether certain MIDI message types should be queued or ignored during input.
--
-- By default, MIDI timing and active sensing messages are ignored during message input because of their
-- relative high data rates. MIDI sysex messages are ignored by default as well.
-- Variable values of 'True' imply that the respective message type will be ignored.
ignoreTypes
  :: InputDevice
  -> Bool
  -- ^ SysEx messages
  -> Bool
  -- ^ Time messages
  -> Bool
  -- ^ Sense messages
  -> IO ()
ignoreTypes :: InputDevice -> Bool -> Bool -> Bool -> IO ()
ignoreTypes InputDevice
d Bool
x Bool
y Bool
z = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded InputDevice
d (\Ptr Wrapper
dptr -> Ptr Wrapper -> Bool -> Bool -> Bool -> IO ()
rtmidi_in_ignore_types Ptr Wrapper
dptr Bool
x Bool
y Bool
z)

-- | Variant of 'getMessage' that allows you to fill a shared buffer, returning timestamp and size.
getMessageMutable :: InputDevice -> VSM.IOVector Word8 -> IO (Double, Int)
getMessageMutable :: InputDevice -> IOVector Word8 -> IO (Double, Int)
getMessageMutable InputDevice
d IOVector Word8
buf = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
s -> forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
VSM.unsafeWith IOVector Word8
buf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
m -> forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtrUnguarded InputDevice
d forall a b. (a -> b) -> a -> b
$ \Ptr Wrapper
dptr -> do
  forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a s. Storable a => MVector s a -> Int
VSM.length IOVector Word8
buf))
  CDouble !Double
timestamp <- Ptr Wrapper -> Ptr (Ptr CUChar) -> Ptr CSize -> IO CDouble
rtmidi_in_get_message Ptr Wrapper
dptr (coerce :: forall a b. Coercible a b => a -> b
coerce Ptr Word8
m) Ptr CSize
s
  Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
  CSize
csize <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
s
  let !size :: Int
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
csize
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
timestamp, Int
size)

-- | Variant of 'getMessage' that allows you to set message buffer size (typically for large sysex messages).
getMessageSized :: InputDevice -> Int -> IO (Double, VS.Vector Word8)
getMessageSized :: InputDevice -> Int -> IO (Double, Vector Word8)
getMessageSized InputDevice
d Int
n = do
  IOVector Word8
buf <- forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
VSM.new Int
n
  (!Double
timestamp, !Int
size) <- InputDevice -> IOVector Word8 -> IO (Double, Int)
getMessageMutable InputDevice
d IOVector Word8
buf
  Vector Word8
vec <- forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
VSM.unsafeWith IOVector Word8
buf (forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> (Int -> m a) -> m (Vector a)
VS.generateM Int
size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
timestamp, Vector Word8
vec)

-- | Return data bytes for the next available MIDI message in the input queue and the event delta-time in seconds.
--
-- This function returns immediately whether a new message is available or not.
-- A valid message is indicated by whether the list contains any elements.
-- Note that large sysex messages will be silently dropped! Use 'getMessageSized' or use a callback to get these safely.
getMessage :: InputDevice -> IO (Double, VS.Vector Word8)
getMessage :: InputDevice -> IO (Double, Vector Word8)
getMessage InputDevice
d = InputDevice -> Int -> IO (Double, Vector Word8)
getMessageSized InputDevice
d Int
defaultMessageSize

-- | Default constructor for a 'Device' to use for output.
defaultOutput :: IO OutputDevice
defaultOutput :: IO OutputDevice
defaultOutput = 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

-- | Create a new 'Device' to use for output.
createOutput
  :: Api
  -- ^ API to use
  -> String
  -- ^ client name
  -> IO OutputDevice
createOutput :: Api -> String -> IO OutputDevice
createOutput Api
api String
clientName = do
  Ptr Wrapper
dptr <- forall a. String -> (CString -> IO a) -> IO a
withCString String
clientName (ApiInternal -> CString -> IO (Ptr Wrapper)
rtmidi_out_create (Api -> ApiInternal
fromApi Api
api))
  Ptr Wrapper -> IO ()
guardError Ptr Wrapper
dptr
  Ptr Wrapper -> IO OutputDevice
newOutputDevice Ptr Wrapper
dptr

-- | Immediately send a single message out an open MIDI output port.
sendMessage :: OutputDevice -> VS.Vector Word8 -> IO ()
sendMessage :: OutputDevice -> Vector Word8 -> IO ()
sendMessage OutputDevice
d Vector Word8
buf = forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector Word8
buf (\Ptr Word8
ptr -> OutputDevice -> Ptr Word8 -> Int -> IO ()
sendUnsafeMessage OutputDevice
d Ptr Word8
ptr (forall a. Storable a => Vector a -> Int
VS.length Vector Word8
buf))

-- | A variant of 'sendMessage' that allows reading directly from pinned memory.
sendUnsafeMessage :: OutputDevice -> Ptr Word8 -> Int -> IO ()
sendUnsafeMessage :: OutputDevice -> Ptr Word8 -> Int -> IO ()
sendUnsafeMessage OutputDevice
d Ptr Word8
ptr Int
size =
  forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr OutputDevice
d forall a b. (a -> b) -> a -> b
$ \Ptr Wrapper
dptr -> forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ptr Wrapper -> Ptr CUChar -> CInt -> IO CInt
rtmidi_out_send_message Ptr Wrapper
dptr (coerce :: forall a b. Coercible a b => a -> b
coerce Ptr Word8
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size))

-- | Returns the specifier for the MIDI 'Api' in use
currentApi :: IsDevice d => d -> IO Api
currentApi :: forall d. IsDevice d => d -> IO Api
currentApi d
d = forall d a. IsDevice d => d -> (Ptr Wrapper -> IO a) -> IO a
withDevicePtr d
d forall a b. (a -> b) -> a -> b
$ \Ptr Wrapper
dptr -> do
  ApiInternal
res <-
    case forall d. IsDevice d => d -> DeviceType
getDeviceType d
d of
      DeviceType
InputDeviceType -> Ptr Wrapper -> IO ApiInternal
rtmidi_in_get_current_api Ptr Wrapper
dptr
      DeviceType
OutputDeviceType -> Ptr Wrapper -> IO ApiInternal
rtmidi_out_get_current_api Ptr Wrapper
dptr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiInternal -> Api
toApi ApiInternal
res)