-- | Osc over Udp/Tcp implementation.
module Sound.Osc.Transport.Fd.Socket where

import qualified Sound.Osc.Transport.Fd as Fd {- hosc -}
import qualified Sound.Osc.Transport.Fd.Tcp as Fd.Tcp {- hosc -}
import qualified Sound.Osc.Transport.Fd.Udp as Fd.Udp {- hosc -}

-- | Protocol, either Udp or Tcp
data OscProtocol = Udp | Tcp
  deriving (OscProtocol -> OscProtocol -> Bool
(OscProtocol -> OscProtocol -> Bool)
-> (OscProtocol -> OscProtocol -> Bool) -> Eq OscProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OscProtocol -> OscProtocol -> Bool
== :: OscProtocol -> OscProtocol -> Bool
$c/= :: OscProtocol -> OscProtocol -> Bool
/= :: OscProtocol -> OscProtocol -> Bool
Eq, ReadPrec [OscProtocol]
ReadPrec OscProtocol
Int -> ReadS OscProtocol
ReadS [OscProtocol]
(Int -> ReadS OscProtocol)
-> ReadS [OscProtocol]
-> ReadPrec OscProtocol
-> ReadPrec [OscProtocol]
-> Read OscProtocol
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OscProtocol
readsPrec :: Int -> ReadS OscProtocol
$creadList :: ReadS [OscProtocol]
readList :: ReadS [OscProtocol]
$creadPrec :: ReadPrec OscProtocol
readPrec :: ReadPrec OscProtocol
$creadListPrec :: ReadPrec [OscProtocol]
readListPrec :: ReadPrec [OscProtocol]
Read, Int -> OscProtocol -> ShowS
[OscProtocol] -> ShowS
OscProtocol -> String
(Int -> OscProtocol -> ShowS)
-> (OscProtocol -> String)
-> ([OscProtocol] -> ShowS)
-> Show OscProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OscProtocol -> ShowS
showsPrec :: Int -> OscProtocol -> ShowS
$cshow :: OscProtocol -> String
show :: OscProtocol -> String
$cshowList :: [OscProtocol] -> ShowS
showList :: [OscProtocol] -> ShowS
Show)

-- | Hostname
type OscHostname = String

-- | Port number
type OscPort = Int

-- | Socket address
type OscSocketAddress = (OscProtocol, OscHostname, OscPort)

-- | Socket
data OscSocket = OscUdpSocket Fd.Udp.Udp | OscTcpSocket Fd.Tcp.Tcp

-- | Open socket at address
openOscSocket :: OscSocketAddress -> IO OscSocket
openOscSocket :: OscSocketAddress -> IO OscSocket
openOscSocket OscSocketAddress
address =
  case OscSocketAddress
address of
    (OscProtocol
Tcp, String
hostname, Int
port) -> (Tcp -> OscSocket) -> IO Tcp -> IO OscSocket
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tcp -> OscSocket
OscTcpSocket (String -> Int -> IO Tcp
Fd.Tcp.openTcp String
hostname Int
port)
    (OscProtocol
Udp, String
hostname, Int
port) -> (Udp -> OscSocket) -> IO Udp -> IO OscSocket
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Udp -> OscSocket
OscUdpSocket (String -> Int -> IO Udp
Fd.Udp.openUdp String
hostname Int
port)

-- | 'OscSocket' is an instance of 'Fd.Transport'.
instance Fd.Transport OscSocket where
  sendPacket :: OscSocket -> Packet -> IO ()
sendPacket (OscTcpSocket Tcp
fd) = Tcp -> Packet -> IO ()
Fd.Tcp.tcp_send_packet Tcp
fd
  sendPacket (OscUdpSocket Udp
fd) = Udp -> Packet -> IO ()
Fd.Udp.udp_send_packet Udp
fd
  recvPacket :: OscSocket -> IO Packet
recvPacket (OscTcpSocket Tcp
fd) = Tcp -> IO Packet
Fd.Tcp.tcp_recv_packet Tcp
fd
  recvPacket (OscUdpSocket Udp
fd) = Udp -> IO Packet
Fd.Udp.udp_recv_packet Udp
fd
  recvPacketOr :: OscSocket -> IO (Either String Packet)
recvPacketOr (OscTcpSocket Tcp
fd) = Tcp -> IO (Either String Packet)
Fd.Tcp.tcp_recv_packet_or Tcp
fd
  recvPacketOr (OscUdpSocket Udp
fd) = Udp -> IO (Either String Packet)
Fd.Udp.udp_recv_packet_or Udp
fd
  close :: OscSocket -> IO ()
close (OscTcpSocket Tcp
fd) = Tcp -> IO ()
Fd.Tcp.tcp_close Tcp
fd
  close (OscUdpSocket Udp
fd) = Udp -> IO ()
Fd.Udp.udp_close Udp
fd