-- |
--
-- Copyright   : (C) Keera Studios Ltd, 2013
-- License     : BSD3
-- Maintainer  : support@keera.co.uk
module Hails.Network where

import Data.String               (fromString)
import Data.List
import Data.ReactiveValue
import Network.BSD
import Network.Socket
import Network.Socket.ByteString (sendTo)

-- | Create a UDP sink (a write-only reactive value).
udpSink :: HostName -> String -> IO (ReactiveFieldWrite IO String)
udpSink :: HostName -> HostName -> IO (ReactiveFieldWrite IO HostName)
udpSink HostName
hostname HostName
port = do
  -- Obtain server addr
  [AddrInfo]
addrinfos <- Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo]
getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
hostname) (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
port)
  let serveraddr :: AddrInfo
serveraddr = [AddrInfo] -> AddrInfo
forall a. [a] -> a
head [AddrInfo]
addrinfos

  -- Establish a socket for communication
  Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
serveraddr) SocketType
Datagram ProtocolNumber
defaultProtocol

  -- Send command
  let sendstr :: String -> IO ()
      sendstr :: HostName -> IO ()
sendstr []   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      sendstr HostName
omsg = do let bsMsg :: ByteString
bsMsg = HostName -> ByteString
forall a. IsString a => HostName -> a
fromString HostName
omsg
                        Int
sent <- Socket -> ByteString -> SockAddr -> IO Int
sendTo Socket
sock ByteString
bsMsg (AddrInfo -> SockAddr
addrAddress AddrInfo
serveraddr)
                        HostName -> IO ()
sendstr (Int -> HostName -> HostName
forall i a. Integral i => i -> [a] -> [a]
genericDrop Int
sent HostName
omsg)

  ReactiveFieldWrite IO HostName
-> IO (ReactiveFieldWrite IO HostName)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReactiveFieldWrite IO HostName
 -> IO (ReactiveFieldWrite IO HostName))
-> ReactiveFieldWrite IO HostName
-> IO (ReactiveFieldWrite IO HostName)
forall a b. (a -> b) -> a -> b
$ (HostName -> IO ()) -> ReactiveFieldWrite IO HostName
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite HostName -> IO ()
sendstr