RtMidi 0.5.0.3 → 0.6.0.0

raw patch · 9 files changed

+175/−124 lines, 9 filesdep −unliftio-coresetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: unliftio-core

API changes (from Hackage documentation)

Files

• README.md +0/−2
• RtMidi.cabal +1/−2
• Setup.hs +0/−2
• Sound/RtMidi.hs +130/−89
• Sound/RtMidi/Report.hs +25/−11
• examples/callback.hs +1/−1
• examples/playback.hs +3/−3
• examples/poll.hs +2/−4
• test/Main.hs +13/−10

@@ -1,7 +1,5 @@ # RtMidi -[![CircleCI](https://circleci.com/gh/riottracker/RtMidi/tree/master.svg?style=svg)](https://circleci.com/gh/riottracker/RtMidi/tree/master)- Haskell wrapper for [RtMidi](http://www.music.mcgill.ca/~gary/rtmidi/), the lightweight, cross-platform MIDI I/O library.  ## How to use

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                RtMidi-version:             0.5.0.3+version:             0.6.0.0 synopsis:            Haskell wrapper for RtMidi, the lightweight, cross-platform MIDI I/O library. description:         Please see the README on GitHub at <https://github.com/riottracker/RtMidi#readme> category:            Sound@@ -34,7 +34,6 @@   other-modules:       Sound.RtMidi.Foreign   build-depends:       base >=4.14 && <5                      , deepseq >= 1.4.4.0 && < 2-                     , unliftio-core >= 0.1.2.0 && < 1                      , vector >= 0.12.1.2 && < 1   default-language:    Haskell2010   default-extensions:  DeriveGeneric

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -35,13 +35,12 @@   , createOutput   , sendMessage   , currentApi-  ) where+  )+where  import Control.DeepSeq (NFData) 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 qualified Data.Vector.Storable as VS import qualified Data.Vector.Storable.Mutable as VSM@@ -51,6 +50,33 @@ 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@@ -59,13 +85,13 @@ defaultMessageSize = 4  -- | Allows us to discriminate in/out functions in generic contexts-data DeviceType =-    InputDeviceType+data DeviceType+  = InputDeviceType   | OutputDeviceType   deriving stock (Eq, Show, Ord, Enum, Bounded, Generic)   deriving anyclass (NFData) -newtype Device = Device { unDevice :: ForeignPtr Wrapper }+newtype Device = Device {unDevice :: ForeignPtr Wrapper}   deriving stock (Eq, Show)  -- | Generalizes 'InputDevice' and 'OutputDevice' for use in common functions@@ -74,7 +100,7 @@   getDeviceType :: d -> DeviceType  -- | A handle to a device to be used for input-newtype InputDevice = InputDevice { unInputDevice :: Device }+newtype InputDevice = InputDevice {unInputDevice :: Device}   deriving stock (Eq, Show)  instance IsDevice InputDevice where@@ -85,7 +111,7 @@ newInputDevice = fmap (InputDevice . Device) . newForeignPtr rtmidi_in_free  -- | A handle to a device to be used for input-newtype OutputDevice = OutputDevice { unOutputDevice :: Device }+newtype OutputDevice = OutputDevice {unOutputDevice :: Device}   deriving stock (Eq, Show)  instance IsDevice OutputDevice where@@ -96,7 +122,7 @@ newOutputDevice = fmap (OutputDevice . Device) . newForeignPtr rtmidi_out_free  -- | An internal RtMidi error-newtype Error = Error { unError :: String }+newtype Error = Error {unError :: String}   deriving stock (Eq, Show, Generic)   deriving anyclass (NFData) @@ -119,24 +145,24 @@ withDevicePtr d f = withDevicePtrUnguarded d (\dptr -> f dptr <* guardError dptr)  -- | Get the display name for the given 'Api'.-apiDisplayName :: MonadIO m => Api -> m String-apiDisplayName api = liftIO (rtmidi_api_display_name (fromApi api) >>= peekCString)+apiDisplayName :: Api -> IO String+apiDisplayName api = rtmidi_api_display_name (fromApi api) >>= peekCString  -- | Get the internal name for the given 'Api'.-apiName :: MonadIO m => Api -> m String-apiName api = liftIO (rtmidi_api_name (fromApi api) >>= peekCString)+apiName :: Api -> IO String+apiName api = rtmidi_api_name (fromApi api) >>= peekCString  -- | Lookup a compiled 'Api' by name.-compiledApiByName :: MonadIO m => String -> m Api-compiledApiByName name = liftIO (fmap toApi (withCString name rtmidi_compiled_api_by_name))+compiledApiByName :: String -> IO Api+compiledApiByName name = fmap toApi (withCString name rtmidi_compiled_api_by_name)  -- | Check if a device is ok-ready :: (MonadIO m, IsDevice d) => d -> m Bool-ready d = liftIO (withDevicePtr d (fmap ok . peek))+ready :: IsDevice d => d -> IO Bool+ready d = withDevicePtr d (fmap ok . peek)  -- | A static function to determine MIDI 'Api's built in.-compiledApis :: MonadIO m => m [Api]-compiledApis = liftIO $ do+compiledApis :: IO [Api]+compiledApis = do   n <- fmap fromIntegral (rtmidi_get_compiled_api nullPtr 0)   as <- allocaArray n $ \ptr -> do     rtmidi_get_compiled_api ptr (fromIntegral n)@@ -144,37 +170,40 @@   pure (map toApi as)  -- | Open a MIDI connection-openPort :: (MonadIO m, IsDevice d)-         => d-         -> Int          -- ^ port number-         -> String       -- ^ name for the application port that is used-         -> m ()-openPort d n name = liftIO $ withDevicePtr d $ \dptr ->+openPort+  :: IsDevice d+  => d+  -> Int+  -- ^ port number+  -> String+  -- ^ name for the application port that is used+  -> IO ()+openPort d n name = withDevicePtr d $ \dptr ->   withCString name (rtmidi_open_port dptr (toEnum 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 :: (MonadIO m, IsDevice d) => d -> String -> m ()-openVirtualPort d name = liftIO $ withDevicePtr d $ \dptr -> do+openVirtualPort :: IsDevice d => d -> String -> IO ()+openVirtualPort d name = withDevicePtr d $ \dptr -> do   withCString name (rtmidi_open_virtual_port dptr)  -- | Close an open MIDI connection (if one exists).-closePort :: (MonadIO m, IsDevice d) => d -> m ()-closePort d = liftIO (withDevicePtr d rtmidi_close_port)+closePort :: IsDevice d => d -> IO ()+closePort d = withDevicePtr d rtmidi_close_port  -- | Return the number of MIDI ports available to the 'Device'.-portCount :: (MonadIO m, IsDevice d) => d -> m Int-portCount d = liftIO $ withDevicePtr d $ \dptr -> do+portCount :: IsDevice d => d -> IO Int+portCount d = withDevicePtr d $ \dptr -> do   x <- rtmidi_get_port_count dptr   pure (fromIntegral x)  -- | Return a string identifier for the specified MIDI port number. -- -- 'Nothing' is returned if an invalid port specifier is provided.-portName :: (MonadIO m, IsDevice d) => d -> Int -> m (Maybe String)-portName d n = liftIO $ withDevicePtrUnguarded d $ \dptr -> do+portName :: IsDevice d => d -> Int -> IO (Maybe String)+portName d n = withDevicePtrUnguarded d $ \dptr -> do   x <- rtmidi_get_port_name dptr (toEnum n)   guardError dptr   s <- peekCString x@@ -186,14 +215,15 @@ -- -- 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 :: (MonadIO m, IsDevice d) => d -> m [(Int, String)]-listPorts d = liftIO $ portCount d >>= go [] 0 where+listPorts :: IsDevice d => d -> IO [(Int, String)]+listPorts d = portCount d >>= go [] 0+ where   go acc i c =     if i >= c       then pure (reverse acc)       else do         mn <- portName d i-        let acc' = maybe acc (\n -> (i, n):acc) mn+        let acc' = maybe acc (\n -> (i, n) : acc) mn         go acc' (succ i) c  -- | Convenience function to lookup the first port satisfying the predicate.@@ -208,8 +238,9 @@ -- -- 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 :: (MonadIO m, IsDevice d) => d -> (String -> Bool) -> m (Maybe Int)-findPort d f = liftIO $ portCount d >>= go 0 where+findPort :: IsDevice d => d -> (String -> Bool) -> IO (Maybe Int)+findPort d f = portCount d >>= go 0+ where   go i c =     if i >= c       then pure Nothing@@ -220,19 +251,22 @@           _ -> go (succ i) c  -- | Default constructor for a 'Device' to use for input.-defaultInput :: MonadIO m => m InputDevice-defaultInput = liftIO $ do+defaultInput :: IO InputDevice+defaultInput = do   dptr <- rtmidi_in_create_default   guardError dptr   newInputDevice dptr  -- | Create a new 'Device' to use for input.-createInput :: MonadIO m-            => Api        -- ^ API to use-            -> String     -- ^ client name-            -> Int        -- ^ size of the MIDI input queue-            -> m InputDevice-createInput api clientName queueSizeLimit = liftIO $ do+createInput+  :: Api+  -- ^ API to use+  -> String+  -- ^ client name+  -> Int+  -- ^ size of the MIDI input queue+  -> IO InputDevice+createInput api clientName queueSizeLimit = do   dptr <- withCString clientName (\str -> rtmidi_in_create (fromApi api) str (fromIntegral queueSizeLimit))   guardError dptr   newInputDevice dptr@@ -253,21 +287,22 @@ -- 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 :: MonadUnliftIO m-            => InputDevice-            -> (Double -> VS.Vector Word8 -> m ())  -- ^ Function that takes a timestamp and a MIDI message as arguments-            -> m ()-setCallback d c = withRunInIO $ \run -> withDevicePtr d $ \dptr -> do-  f <- mkCallbackPointer (adaptCallbackCTypes (\ts bytes -> run (c ts bytes)))+setCallback+  :: InputDevice+  -> (Double -> VS.Vector Word8 -> IO ())+  -- ^ Function that takes a timestamp and a MIDI message as arguments+  -> IO ()+setCallback d c = withDevicePtr d $ \dptr -> do+  f <- mkCallbackPointer (adaptCallbackCTypes c)   rtmidi_in_set_callback dptr f 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 :: MonadIO m-                  => InputDevice-                  -> (Double -> Ptr Word8 -> Int -> IO ())-                  -> m ()-setUnsafeCallback d c = liftIO $ withDevicePtr d $ \dptr -> do+setUnsafeCallback+  :: InputDevice+  -> (Double -> Ptr Word8 -> Int -> IO ())+  -> IO ()+setUnsafeCallback d c = withDevicePtr d $ \dptr -> do   f <- mkCallbackPointer (adaptUnsafeCallbackCTypes c)   rtmidi_in_set_callback dptr f nullPtr @@ -275,36 +310,40 @@ -- -- 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 :: MonadIO m-                   => InputDevice-                   -> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())-                   -> Ptr () -- ^ Pointer to context that will be passed into the callback-                   -> m ()-setForeignCallback d f ctx = liftIO $ withDevicePtr d $ \dptr ->+setForeignCallback+  :: InputDevice+  -> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ())+  -> Ptr ()+  -- ^ Pointer to context that will be passed into the callback+  -> IO ()+setForeignCallback d f ctx = withDevicePtr d $ \dptr ->   rtmidi_in_set_callback dptr f 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 :: MonadIO m => InputDevice -> m ()-cancelCallback d = liftIO (withDevicePtr d rtmidi_in_cancel_callback)+cancelCallback :: InputDevice -> IO ()+cancelCallback d = withDevicePtr d 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 :: MonadIO m-            => InputDevice-            -> Bool       -- ^ SysEx messages-            -> Bool       -- ^ Time messages-            -> Bool       -- ^ Sense messages-            -> m ()-ignoreTypes d x y z = liftIO (withDevicePtrUnguarded d (\dptr -> rtmidi_in_ignore_types dptr x y z))+ignoreTypes+  :: InputDevice+  -> Bool+  -- ^ SysEx messages+  -> Bool+  -- ^ Time messages+  -> Bool+  -- ^ Sense messages+  -> IO ()+ignoreTypes d x y z = withDevicePtrUnguarded d (\dptr -> rtmidi_in_ignore_types dptr x y z)  -- | Variant of 'getMessage' that allows you to fill a shared buffer, returning timestamp and size.-getMessageMutable :: MonadIO m => InputDevice -> VSM.IOVector Word8 -> m (Double, Int)-getMessageMutable d buf = liftIO $ alloca $ \s -> VSM.unsafeWith buf $ \m -> withDevicePtrUnguarded d $ \dptr -> do+getMessageMutable :: InputDevice -> VSM.IOVector Word8 -> IO (Double, Int)+getMessageMutable d buf = alloca $ \s -> VSM.unsafeWith buf $ \m -> withDevicePtrUnguarded d $ \dptr -> do   poke s (fromIntegral (VSM.length buf))   CDouble !timestamp <- rtmidi_in_get_message dptr (coerce m) s   guardError dptr@@ -313,8 +352,8 @@   pure (timestamp, size)  -- | Variant of 'getMessage' that allows you to set message buffer size (typically for large sysex messages).-getMessageSized :: MonadIO m => InputDevice -> Int -> m (Double, VS.Vector Word8)-getMessageSized d n = liftIO $ do+getMessageSized :: InputDevice -> Int -> IO (Double, VS.Vector Word8)+getMessageSized d n = do   buf <- VSM.new n   (!timestamp, !size) <- getMessageMutable d buf   vec <- VSM.unsafeWith buf (VS.generateM size . peekElemOff)@@ -325,34 +364,36 @@ -- 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 :: MonadIO m => InputDevice -> m (Double, VS.Vector Word8)-getMessage d = liftIO (getMessageSized d defaultMessageSize)+getMessage :: InputDevice -> IO (Double, VS.Vector Word8)+getMessage d = getMessageSized d defaultMessageSize  -- | Default constructor for a 'Device' to use for output.-defaultOutput :: MonadIO m => m OutputDevice-defaultOutput = liftIO $ do+defaultOutput :: IO OutputDevice+defaultOutput = do   dptr <- rtmidi_out_create_default   guardError dptr   newOutputDevice dptr  -- | Create a new 'Device' to use for output.-createOutput :: MonadIO m-             => Api        -- ^ API to use-             -> String     -- ^ client name-             -> m OutputDevice-createOutput api clientName = liftIO $ do+createOutput+  :: Api+  -- ^ API to use+  -> String+  -- ^ client name+  -> IO OutputDevice+createOutput api clientName = do   dptr <- withCString clientName (rtmidi_out_create (fromApi api))   guardError dptr   newOutputDevice dptr  -- | Immediately send a single message out an open MIDI output port.-sendMessage :: MonadIO m => OutputDevice -> VS.Vector Word8 -> m ()-sendMessage d buf = liftIO $ VS.unsafeWith buf $ \m -> withDevicePtr d $ \dptr ->+sendMessage :: OutputDevice -> VS.Vector Word8 -> IO ()+sendMessage d buf = VS.unsafeWith buf $ \m -> withDevicePtr d $ \dptr ->   void (rtmidi_out_send_message dptr (coerce m) (fromIntegral (VS.length buf)))  -- | Returns the specifier for the MIDI 'Api' in use-currentApi :: MonadIO m => IsDevice d => d -> m Api-currentApi d = liftIO $ withDevicePtr d $ \dptr -> do+currentApi :: IsDevice d => d -> IO Api+currentApi d = withDevicePtr d $ \dptr -> do   res <-     case getDeviceType d of       InputDeviceType -> rtmidi_in_get_current_api dptr

@@ -7,13 +7,24 @@   , buildApiReport   , buildCustomReport   , buildReport-  ) where+  )+where  import Control.DeepSeq (NFData)-import Control.Monad.IO.Class (MonadIO) import Data.List (nub) import GHC.Generics (Generic) import Sound.RtMidi+  ( Api+  , apiDisplayName+  , apiName+  , compiledApis+  , createInput+  , createOutput+  , currentApi+  , defaultInput+  , defaultOutput+  , listPorts+  )  -- | MIDI system information specific to a particular API. data ApiReport = ApiReport@@ -22,19 +33,21 @@   , apiRepDisplayName :: !String   , apiInPorts :: ![(Int, String)]   , apiOutPorts :: ![(Int, String)]-  } deriving stock (Eq, Show, Generic)-    deriving anyclass (NFData)+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)  -- | MIDI system information for any number of APIs. data Report = Report   { defaultInApi :: !Api   , defaultOutApi :: !Api   , apiReports :: ![ApiReport]-  } deriving stock (Eq, Show, Generic)-    deriving anyclass (NFData)+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)  -- | Gather information about the given 'Api', including port information.-buildApiReport :: MonadIO m => Api -> m ApiReport+buildApiReport :: Api -> IO ApiReport buildApiReport api = do   name <- apiName api   displayName <- apiDisplayName api@@ -45,9 +58,10 @@   pure (ApiReport api name displayName inPorts outPorts)  -- | Variant of 'buildReport' that allows you to restrict it to the default APIs.-buildCustomReport :: MonadIO m-                  => Bool  -- ^ True to report on default APIs, False to report on all compiled APIs.-                  -> m Report+buildCustomReport+  :: Bool+  -- ^ True to report on default APIs, False to report on all compiled APIs.+  -> IO Report buildCustomReport defaultOnly = do   inDev <- defaultInput   defInApi <- currentApi inDev@@ -58,5 +72,5 @@   pure (Report defInApi defOutApi apiReps)  -- | Gather information about all compiled APIs.-buildReport :: MonadIO m => m Report+buildReport :: IO Report buildReport = buildCustomReport False

@@ -4,7 +4,7 @@ import Sound.RtMidi (closePort, defaultInput, openPort, setCallback)  callback :: Double -> VS.Vector Word8 -> IO ()-callback delta msg = putStrLn $ (VS.foldr (showHex . fromEnum) "" msg) ++ " - " ++ (show delta)+callback delta msg = putStrLn $ VS.foldr (showHex . fromEnum) "" msg ++ " - " ++ show delta  main :: IO () main = do

@@ -1,13 +1,13 @@ import Control.Concurrent (threadDelay) import qualified Data.Vector.Storable as VS-import Sound.RtMidi (closePort, defaultOutput, openPort, sendMessage, portCount, portName)+import Sound.RtMidi (closePort, defaultOutput, openPort, portCount, portName, sendMessage)  main :: IO () main = do   device <- defaultOutput   numPorts <- portCount device-  ports <- mapM (portName device) [0..numPorts-1]-  mapM_ (\t -> putStrLn $ show t) $ zip [0..] ports+  ports <- mapM (portName device) [0 .. numPorts - 1]+  mapM_ print $ zip [0 ..] ports   putStrLn "select port: "   selection <- getLine   openPort device (read selection) "RtMidi"

@@ -1,14 +1,12 @@ import Control.Concurrent (forkIO, killThread)-import Control.Monad (forever)+import Control.Monad (forever, when) import qualified Data.Vector.Storable as VS import Sound.RtMidi (InputDevice, closePort, defaultInput, getMessage, openPort)  mainLoop :: InputDevice -> IO () mainLoop d = do   m <- getMessage d-  if VS.length (snd m) > 0 then-    putStrLn $ show m-  else return ()+  when (VS.length (snd m) > 0) $ print m  main :: IO () main = do

@@ -3,11 +3,12 @@ import Control.Concurrent (threadDelay) import Control.Monad (replicateM_, unless, when) import Data.Foldable (for_)-import Data.IORef (IORef, newIORef, readIORef, modifyIORef)+import Data.IORef (IORef, modifyIORef, newIORef, readIORef) import Data.List (isInfixOf)+import Data.Maybe (fromMaybe) import qualified Data.Vector.Storable as VS import Data.Word (Word8)-import Sound.RtMidi (Api (..), apiName, apiDisplayName, closePort, compiledApiByName, compiledApis, createInput, createOutput, currentApi, findPort, sendMessage, setCallback, openPort, openVirtualPort)+import Sound.RtMidi (Api (..), apiDisplayName, apiName, closePort, compiledApiByName, compiledApis, createInput, createOutput, currentApi, findPort, openPort, openVirtualPort, sendMessage, setCallback) import Sound.RtMidi.Report (Report, buildReport) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertFailure, testCase, (@?=))@@ -75,7 +76,7 @@   outApi <- currentApi outDev   outApi @?= api   maybePortNum <- findPort outDev (isInfixOf portName)-  let portNum = maybe (error "Could not find port") id maybePortNum+  let portNum = fromMaybe (error "Could not find port") maybePortNum   openPort outDev portNum portName   -- Send messages   replicateM_ expectedCount (sendMessage outDev exampleMessage)@@ -94,10 +95,12 @@   apis <- compiledApis   let rwTests = fmap testVirtualReadWrite (filter (/= DummyApi) apis)       rwGroup = testGroup "R/W" rwTests-  defaultMain $ testGroup "RtMidi" $-    [ testApiName-    , testApiDisplayName-    , testCompiledApiByName-    , testBuildReport-    , rwGroup-    ]+  defaultMain $+    testGroup+      "RtMidi"+      [ testApiName+      , testApiDisplayName+      , testCompiledApiByName+      , testBuildReport+      , rwGroup+      ]