-- | 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 :: forall t a. Transport t => IO t -> (t -> IO a) -> IO a
withTransport IO t
u = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO t
u forall t. Transport t => t -> IO ()
close

-- * Send

-- | 'sendPacket' of 'Packet_Message'.
sendMessage :: Transport t => t -> Message -> IO ()
sendMessage :: forall t. Transport t => t -> Message -> IO ()
sendMessage t
t = forall t. Transport t => t -> Packet -> IO ()
sendPacket t
t 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 :: forall t. Transport t => t -> Bundle -> IO ()
sendBundle t
t = forall t. Transport t => t -> Packet -> IO ()
sendPacket t
t 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 :: forall t. Transport t => t -> IO Bundle
recvBundle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Bundle
packet_to_bundle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Transport t => t -> IO Packet
recvPacket

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

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

-- * Wait

-- | Wait for a 'Packet' where the supplied predicate is 'True',
-- discarding intervening packets.
waitUntil :: (Transport t) => t -> (Packet -> Bool) -> IO Packet
waitUntil :: forall t. Transport t => t -> (Packet -> Bool) -> IO Packet
waitUntil t
t Packet -> Bool
f = forall (m :: * -> *) a. Monad m => (a -> Bool) -> m a -> m a
Wait.untilPredicate Packet -> Bool
f (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 :: forall t a. Transport t => t -> (Packet -> Maybe a) -> IO a
waitFor t
t Packet -> Maybe a
f = forall (m :: * -> *) a b. Monad m => (a -> Maybe b) -> m a -> m b
Wait.untilMaybe Packet -> Maybe a
f (forall t. Transport t => t -> IO Packet
recvPacket t
t)

-- | 'waitUntil' 'packet_is_immediate'.
waitImmediate :: Transport t => t -> IO Packet
waitImmediate :: forall t. Transport t => t -> IO Packet
waitImmediate t
t = 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 :: forall t. Transport t => t -> IO Message
waitMessage t
t = 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 :: forall t. Transport t => 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 forall a. a -> Maybe a
Just Packet
o else forall a. Maybe a
Nothing
    in 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 :: forall t. Transport t => t -> Address_Pattern -> IO Message
waitReply t
t Address_Pattern
s =
    let f :: Packet -> Message
f = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => Address_Pattern -> a
error Address_Pattern
"waitReply: message not located?") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Address_Pattern -> Message -> Bool
message_has_address Address_Pattern
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Packet -> [Message]
packetMessages
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Message
f (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 :: forall t. Transport t => t -> Address_Pattern -> IO [Datum]
waitDatum t
t = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> [Datum]
messageDatum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Transport t => t -> Address_Pattern -> IO Message
waitReply t
t