-- | An abstract transport layer with implementations for @UDP@ and @TCP@ transport.
module Sound.OSC.Transport.FD where

import Control.Exception {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}

import Sound.OSC.Datum {- hosc -}
import Sound.OSC.Packet {- hosc -}
import qualified Sound.OSC.Wait as Wait {- hosc -}

-- | Abstract over the underlying transport protocol.
class Transport t where
   -- | Encode and send an OSC packet.
   sendPacket :: t -> Packet -> IO ()
   -- | Receive and decode an OSC packet.
   recvPacket :: t -> IO Packet
   -- | Close an existing connection.
   close :: t -> IO ()

-- | Bracket OSC communication.
withTransport :: Transport t => IO t -> (t -> IO a) -> IO a
withTransport :: IO t -> (t -> IO a) -> IO a
withTransport IO t
u = IO t -> (t -> IO ()) -> (t -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO t
u t -> IO ()
forall t. Transport t => t -> IO ()
close

-- * Send

-- | 'sendPacket' of 'Packet_Message'.
sendMessage :: Transport t => t -> Message -> IO ()
sendMessage :: t -> Message -> IO ()
sendMessage t
t = t -> Packet -> IO ()
forall t. Transport t => t -> Packet -> IO ()
sendPacket t
t (Packet -> IO ()) -> (Message -> Packet) -> Message -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Packet
Packet_Message

-- | 'sendPacket' of 'Packet_Bundle'.
sendBundle :: Transport t => t -> Bundle -> IO ()
sendBundle :: t -> Bundle -> IO ()
sendBundle t
t = t -> Packet -> IO ()
forall t. Transport t => t -> Packet -> IO ()
sendPacket t
t (Packet -> IO ()) -> (Bundle -> Packet) -> Bundle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bundle -> Packet
Packet_Bundle

-- * Receive

-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.
recvBundle :: (Transport t) => t -> IO Bundle
recvBundle :: t -> IO Bundle
recvBundle = (Packet -> Bundle) -> IO Packet -> IO Bundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Bundle
packet_to_bundle (IO Packet -> IO Bundle) -> (t -> IO Packet) -> t -> IO Bundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO Packet
forall t. Transport t => t -> IO Packet
recvPacket

-- | Variant of 'recvPacket' that runs 'packet_to_message'.
recvMessage :: (Transport t) => t -> IO (Maybe Message)
recvMessage :: t -> IO (Maybe Message)
recvMessage = (Packet -> Maybe Message) -> IO Packet -> IO (Maybe Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Maybe Message
packet_to_message (IO Packet -> IO (Maybe Message))
-> (t -> IO Packet) -> t -> IO (Maybe Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO Packet
forall t. Transport t => t -> IO Packet
recvPacket

-- | Variant of 'recvPacket' that runs 'packetMessages'.
recvMessages :: (Transport t) => t -> IO [Message]
recvMessages :: t -> IO [Message]
recvMessages = (Packet -> [Message]) -> IO Packet -> IO [Message]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> [Message]
packetMessages (IO Packet -> IO [Message])
-> (t -> IO Packet) -> t -> IO [Message]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO Packet
forall t. Transport t => t -> IO Packet
recvPacket

-- * Timeout

-- | Variant of 'recvPacket' that implements an /n/ second 'timeout'.
recvPacketTimeout :: (Transport t) => Double -> t -> IO (Maybe Packet)
recvPacketTimeout :: Double -> t -> IO (Maybe Packet)
recvPacketTimeout Double
n t
fd = Double -> IO Packet -> IO (Maybe Packet)
forall a. Double -> IO a -> IO (Maybe a)
Wait.timeout_r Double
n (t -> IO Packet
forall t. Transport t => t -> IO Packet
recvPacket t
fd)

-- * Wait

-- | Wait for a 'Packet' where the supplied predicate is 'True',
-- discarding intervening packets.
waitUntil :: (Transport t) => t -> (Packet -> Bool) -> IO Packet
waitUntil :: t -> (Packet -> Bool) -> IO Packet
waitUntil t
t Packet -> Bool
f = (Packet -> Bool) -> IO Packet -> IO Packet
forall (m :: * -> *) a. Monad m => (a -> Bool) -> m a -> m a
Wait.untilPredicate Packet -> Bool
f (t -> IO Packet
forall t. Transport t => t -> IO Packet
recvPacket t
t)

-- | Wait for a 'Packet' where the supplied function does not give
-- 'Nothing', discarding intervening packets.
waitFor :: (Transport t) => t -> (Packet -> Maybe a) -> IO a
waitFor :: t -> (Packet -> Maybe a) -> IO a
waitFor t
t Packet -> Maybe a
f = (Packet -> Maybe a) -> IO Packet -> IO a
forall (m :: * -> *) a b. Monad m => (a -> Maybe b) -> m a -> m b
Wait.untilMaybe Packet -> Maybe a
f (t -> IO Packet
forall t. Transport t => t -> IO Packet
recvPacket t
t)

-- | 'waitUntil' 'packet_is_immediate'.
waitImmediate :: Transport t => t -> IO Packet
waitImmediate :: t -> IO Packet
waitImmediate t
t = t -> (Packet -> Bool) -> IO Packet
forall t. Transport t => t -> (Packet -> Bool) -> IO Packet
waitUntil t
t Packet -> Bool
packet_is_immediate

-- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or
-- immediate mode 'Bundle' with one element.
waitMessage :: Transport t => t -> IO Message
waitMessage :: t -> IO Message
waitMessage t
t = t -> (Packet -> Maybe Message) -> IO Message
forall t a. Transport t => t -> (Packet -> Maybe a) -> IO a
waitFor t
t Packet -> Maybe Message
packet_to_message

-- | A 'waitFor' for variant using 'packet_has_address' to match on
-- the 'Address_Pattern' of incoming 'Packets'.
waitAddress :: Transport t => t -> Address_Pattern -> IO Packet
waitAddress :: t -> Address_Pattern -> IO Packet
waitAddress t
t Address_Pattern
s =
    let f :: Packet -> Maybe Packet
f Packet
o = if Address_Pattern -> Packet -> Bool
packet_has_address Address_Pattern
s Packet
o then Packet -> Maybe Packet
forall a. a -> Maybe a
Just Packet
o else Maybe Packet
forall a. Maybe a
Nothing
    in t -> (Packet -> Maybe Packet) -> IO Packet
forall t a. Transport t => t -> (Packet -> Maybe a) -> IO a
waitFor t
t Packet -> Maybe Packet
f

-- | Variant on 'waitAddress' that returns matching 'Message'.
waitReply :: Transport t => t -> Address_Pattern -> IO Message
waitReply :: t -> Address_Pattern -> IO Message
waitReply t
t Address_Pattern
s =
    let f :: Packet -> Message
f = Message -> Maybe Message -> Message
forall a. a -> Maybe a -> a
fromMaybe (Address_Pattern -> Message
forall a. HasCallStack => Address_Pattern -> a
error Address_Pattern
"waitReply: message not located?") (Maybe Message -> Message)
-> (Packet -> Maybe Message) -> Packet -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (Message -> Bool) -> [Message] -> Maybe Message
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Address_Pattern -> Message -> Bool
message_has_address Address_Pattern
s) ([Message] -> Maybe Message)
-> (Packet -> [Message]) -> Packet -> Maybe Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Packet -> [Message]
packetMessages
    in (Packet -> Message) -> IO Packet -> IO Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Message
f (t -> Address_Pattern -> IO Packet
forall t. Transport t => t -> Address_Pattern -> IO Packet
waitAddress t
t Address_Pattern
s)

-- | Variant of 'waitReply' that runs 'messageDatum'.
waitDatum :: Transport t => t -> Address_Pattern -> IO [Datum]
waitDatum :: t -> Address_Pattern -> IO [Datum]
waitDatum t
t = (Message -> [Datum]) -> IO Message -> IO [Datum]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> [Datum]
messageDatum (IO Message -> IO [Datum])
-> (Address_Pattern -> IO Message) -> Address_Pattern -> IO [Datum]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Address_Pattern -> IO Message
forall t. Transport t => t -> Address_Pattern -> IO Message
waitReply t
t