Connection.hs

{-# LANGUAGE ExistentialQuantification
           , FlexibleContexts
           , GeneralizedNewtypeDeriving #-}
-- | A 'Connection' encapsulates the communication with the synthesis server.
-- This module provides functions for opening and closing connections, as well
-- as communication and synchronisation primitives.
module Sound.SC3.Server.Connection
  ( Connection
    -- * Creation and termination
  , open
  , close
    -- * Communication and synchronisation
  , send
  , waitFor
  , waitFor_
  , waitForAll
  , waitForAll_
  ) where

import           Control.Concurrent (forkIO)
import           Control.Concurrent.MVar
import           Control.Concurrent.Chan
import           Control.Monad (replicateM, void)
import           Sound.OpenSoundControl (OSC(..), Transport)
import qualified Sound.OpenSoundControl as OSC
import           Sound.SC3.Server.Notification (Notification(..))
import           Sound.SC3.Server.Connection.ListenerMap (Listener, ListenerId, ListenerMap)
import qualified Sound.SC3.Server.Connection.ListenerMap as ListenerMap

data Connection  = forall t . Transport t => Connection t (MVar ListenerMap)

listeners :: Connection -> MVar ListenerMap
listeners (Connection _ l) = l

recvLoop :: Connection -> IO ()
recvLoop c@(Connection t ls) = do
    osc <- OSC.recv t
    withMVar ls (ListenerMap.broadcast osc)
    recvLoop c

-- | Create a new connection given an OSC transport.
open :: Transport t => t -> IO Connection
open t = do
    ls <- newMVar =<< ListenerMap.empty
    let c = Connection t ls
    void $ forkIO $ recvLoop c
    return c

-- | Close the connection.
--
-- The behavior of sending messages after closing the connection is undefined.
close :: Connection -> IO ()
close (Connection t _) = OSC.close t

-- ====================================================================
-- Communication and synchronization

-- | Create a listener from an IO action and a notification.
mkListener :: (a -> IO ()) -> Notification a -> Listener
mkListener f n osc =
    case n `match` osc of
        Nothing -> return ()
        Just a  -> f a

-- | Add a listener to the listener map.
addListener :: Connection -> Listener -> IO ListenerId
addListener c l = modifyMVar (listeners c) $ \lm -> do
    (uid, lm') <- ListenerMap.add l lm
    return (lm', uid)

-- | Remove a listener from the listener map.
removeListener :: Connection -> ListenerId -> IO ()
removeListener c uid = modifyMVar_ (listeners c) (ListenerMap.delete uid)

-- | Send an OSC packet asynchronously.
send :: Connection -> OSC -> IO ()
send (Connection t _) = OSC.send t

-- | Send an OSC packet and wait for a notification.
--
-- Returns the transformed value.
waitFor :: Connection -> OSC -> Notification a -> IO a
waitFor c osc n = do
    res <- newEmptyMVar
    uid <- addListener c (mkListener (putMVar res) n)
    send c osc
    a <- takeMVar res
    removeListener c uid
    return a

-- | Send an OSC packet and wait for a notification.
--
-- Ignores the transformed value.
waitFor_ :: Connection -> OSC -> Notification a -> IO ()
waitFor_ c osc n = void $ waitFor c osc n

-- | Send an OSC packet and wait for a list of notifications.
--
-- Returns the transformed values, in unspecified order.
waitForAll :: Connection -> OSC -> [Notification a] -> IO [a]
waitForAll c osc [] =
    send c osc >> return []
waitForAll c osc ns = do
    res <- newChan
    uids <- mapM (addListener c . mkListener (writeChan res)) ns
    send c osc
    as <- replicateM (length ns) (readChan res)
    mapM_ (removeListener c) uids
    return as

-- | Send an OSC packet and wait for a list of notifications.
--
-- Ignores the transformed values.
waitForAll_ :: Connection -> OSC -> [Notification a] -> IO ()
waitForAll_ c osc ns = void $ waitForAll c osc ns