RtMidi-0.4.0.0: test/Main.hs

module Main (main) where

import Control.Concurrent (threadDelay)
import Control.Monad (replicateM_, unless, when)
import Data.Foldable (for_)
import Data.IORef (IORef, newIORef, readIORef, modifyIORef)
import Data.List (isInfixOf)
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.Report (Report, buildReport)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (assertFailure, testCase, (@?=))

incIORef :: IORef Int -> IO ()
incIORef = flip modifyIORef succ

-- A simple note-on message
exampleMessage :: VS.Vector Word8
exampleMessage = VS.fromList [0x90, 0x51, 0x7f]

readerCallback :: IORef Int -> Double -> VS.Vector Word8 -> IO ()
readerCallback countRef _ msg = do
  msg @?= exampleMessage
  incIORef countRef

testApiName :: TestTree
testApiName = testCase "apiName" $ do
  actualName1 <- apiName UnspecifiedApi
  actualName1 @?= "unspecified"
  actualName2 <- apiName DummyApi
  actualName2 @?= "dummy"

testApiDisplayName :: TestTree
testApiDisplayName = testCase "apiDisplayName" $ do
  actualName1 <- apiDisplayName UnspecifiedApi
  actualName1 @?= "Unknown"
  actualName2 <- apiDisplayName DummyApi
  actualName2 @?= "Dummy"

testCompiledApiByName :: TestTree
testCompiledApiByName = testCase "compiledApiByName" $ do
  actualApi1 <- compiledApiByName "unspecified"
  actualApi1 @?= UnspecifiedApi
  actualApi2 <- compiledApiByName "dummy"
  actualApi2 @?= UnspecifiedApi
  actualApi3 <- compiledApiByName "invalid"
  actualApi3 @?= UnspecifiedApi

testBuildReport :: TestTree
testBuildReport = testCase "buildReport" $ do
  -- We could test more but we mostly just want to make sure we can run 'buildReport'.
  _ <- buildReport
  pure ()

testVirtualReadWrite :: Api -> TestTree
testVirtualReadWrite api = testCase ("virtual read write with " <> show api) $ do
  let expectedCount = 3
      portName = "rtmidi-test-port"
      -- 100 ms delay in us
      delayUs = 100000
  -- First a check of api name
  name <- apiName api
  actualApi <- compiledApiByName name
  actualApi @?= api
  countRef <- newIORef 0
  -- Create reader with callback
  inDev <- createInput api "rtmidi-test-input" 100
  inApi <- currentApi inDev
  inApi @?= api
  setCallback inDev (readerCallback countRef)
  openVirtualPort inDev portName
  -- Create writer and connect to reader virtual port
  outDev <- createOutput api "rtmidi-test-output"
  outApi <- currentApi outDev
  outApi @?= api
  maybePortNum <- findPort outDev (isInfixOf portName)
  let portNum = maybe (error "Could not find port") id maybePortNum
  openPort outDev portNum portName
  -- Send messages
  replicateM_ expectedCount (sendMessage outDev exampleMessage)
  -- Sleep a bit to ensure message delivery
  threadDelay delayUs
  -- Close writer
  closePort outDev
  -- Close reader
  closePort inDev
  -- Verify number of messages received
  actualCount <- readIORef countRef
  actualCount @?= expectedCount

main :: IO ()
main = do
  apis <- compiledApis
  let rwTests = fmap testVirtualReadWrite (filter (/= DummyApi) apis)
      rwGroup = testGroup "R/W" rwTests
  defaultMain $ testGroup "RtMidi" $
    [ testApiName
    , testApiDisplayName
    , testCompiledApiByName
    , testBuildReport
    , rwGroup
    ]