-- | 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 -> PacketOf Message -> IO ()

  -- | Receive and decode an Osc packet.
  recvPacket :: t -> IO (PacketOf Message)

  -- | Receive and either decode an Osc packet.
  recvPacketOr :: t -> IO (Either String 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 = 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 :: forall t. Transport t => t -> Message -> IO ()
sendMessage t
t = t -> PacketOf Message -> IO ()
forall t. Transport t => t -> PacketOf Message -> IO ()
sendPacket t
t (PacketOf Message -> IO ())
-> (Message -> PacketOf Message) -> Message -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> PacketOf Message
forall t. Message -> PacketOf t
Packet_Message

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

-- * Receive

-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.
recvBundle :: (Transport t) => t -> IO (BundleOf Message)
recvBundle :: forall t. Transport t => t -> IO (BundleOf Message)
recvBundle = (PacketOf Message -> BundleOf Message)
-> IO (PacketOf Message) -> IO (BundleOf Message)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PacketOf Message -> BundleOf Message
packet_to_bundle (IO (PacketOf Message) -> IO (BundleOf Message))
-> (t -> IO (PacketOf Message)) -> t -> IO (BundleOf Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO (PacketOf Message)
forall t. Transport t => t -> IO (PacketOf Message)
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 = (PacketOf Message -> Maybe Message)
-> IO (PacketOf Message) -> IO (Maybe Message)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PacketOf Message -> Maybe Message
packet_to_message (IO (PacketOf Message) -> IO (Maybe Message))
-> (t -> IO (PacketOf Message)) -> t -> IO (Maybe Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO (PacketOf Message)
forall t. Transport t => t -> IO (PacketOf Message)
recvPacket

-- | Erroring variant.
recvMessage_err :: (Transport t) => t -> IO Message
recvMessage_err :: forall t. Transport t => t -> IO Message
recvMessage_err = (Maybe Message -> Message) -> IO (Maybe Message) -> IO Message
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Message -> Maybe Message -> Message
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Message
forall a. HasCallStack => [Char] -> a
error [Char]
"recvMessage")) (IO (Maybe Message) -> IO Message)
-> (t -> IO (Maybe Message)) -> t -> IO Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO (Maybe Message)
forall t. Transport t => t -> IO (Maybe Message)
recvMessage

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

-- * Wait

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

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

-- | 'waitUntil' 'packet_is_immediate'.
waitImmediate :: Transport t => t -> IO (PacketOf Message)
waitImmediate :: forall t. Transport t => t -> IO (PacketOf Message)
waitImmediate t
t = t -> (PacketOf Message -> Bool) -> IO (PacketOf Message)
forall t.
Transport t =>
t -> (PacketOf Message -> Bool) -> IO (PacketOf Message)
waitUntil t
t PacketOf Message -> Bool
forall t. PacketOf t -> 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 = t -> (PacketOf Message -> Maybe Message) -> IO Message
forall t a.
Transport t =>
t -> (PacketOf Message -> Maybe a) -> IO a
waitFor t
t PacketOf Message -> 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 (PacketOf Message)
waitAddress :: forall t. Transport t => t -> [Char] -> IO (PacketOf Message)
waitAddress t
t [Char]
s =
  let f :: PacketOf Message -> Maybe (PacketOf Message)
f PacketOf Message
o = if [Char] -> PacketOf Message -> Bool
packet_has_address [Char]
s PacketOf Message
o then PacketOf Message -> Maybe (PacketOf Message)
forall a. a -> Maybe a
Just PacketOf Message
o else Maybe (PacketOf Message)
forall a. Maybe a
Nothing
  in t
-> (PacketOf Message -> Maybe (PacketOf Message))
-> IO (PacketOf Message)
forall t a.
Transport t =>
t -> (PacketOf Message -> Maybe a) -> IO a
waitFor t
t PacketOf Message -> Maybe (PacketOf Message)
f

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

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