module Sound.Osc.Transport.Monad where
import Control.Monad
import Control.Monad.IO.Class
import Data.List
import Data.Maybe
import qualified Control.Monad.Trans.Reader as R
import qualified Sound.Osc.Datum as Datum
import qualified Sound.Osc.Transport.Fd as Fd
import qualified Sound.Osc.Packet as Packet
import qualified Sound.Osc.Wait as Wait
class Monad m => SendOsc m where
sendPacket :: Packet.Packet -> m ()
class Monad m => RecvOsc m where
recvPacket :: m Packet.Packet
class (SendOsc m,RecvOsc m) => DuplexOsc m where
class (DuplexOsc m,MonadIO m) => Transport m where
instance (Fd.Transport t,MonadIO io) => SendOsc (R.ReaderT t io) where
sendPacket :: Packet -> ReaderT t io ()
sendPacket Packet
p = (t -> io ()) -> ReaderT t io ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
R.ReaderT (IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> (t -> IO ()) -> t -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Packet -> IO ()) -> Packet -> t -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip t -> Packet -> IO ()
forall t. Transport t => t -> Packet -> IO ()
Fd.sendPacket Packet
p)
instance (Fd.Transport t,MonadIO io) => RecvOsc (R.ReaderT t io) where
recvPacket :: ReaderT t io Packet
recvPacket = (t -> io Packet) -> ReaderT t io Packet
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
R.ReaderT (IO Packet -> io Packet
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Packet -> io Packet) -> (t -> IO Packet) -> t -> io Packet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO Packet
forall t. Transport t => t -> IO Packet
Fd.recvPacket)
instance (Fd.Transport t,MonadIO io) => DuplexOsc (R.ReaderT t io) where
instance (Fd.Transport t,MonadIO io) => Transport (R.ReaderT t io) where
type Connection t a = R.ReaderT t IO a
withTransport :: Fd.Transport t => IO t -> Connection t r -> IO r
withTransport :: forall t r. Transport t => IO t -> Connection t r -> IO r
withTransport IO t
u = IO t -> (t -> IO r) -> IO r
forall t a. Transport t => IO t -> (t -> IO a) -> IO a
Fd.withTransport IO t
u ((t -> IO r) -> IO r)
-> (Connection t r -> t -> IO r) -> Connection t r -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection t r -> t -> IO r
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT
withTransport_ :: Fd.Transport t => IO t -> Connection t r -> IO ()
withTransport_ :: forall t r. Transport t => IO t -> Connection t r -> IO ()
withTransport_ IO t
u = IO r -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO r -> IO ())
-> (Connection t r -> IO r) -> Connection t r -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO t -> Connection t r -> IO r
forall t r. Transport t => IO t -> Connection t r -> IO r
withTransport IO t
u
sendMessage :: SendOsc m => Packet.Message -> m ()
sendMessage :: forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage = Packet -> m ()
forall (m :: * -> *). SendOsc m => Packet -> m ()
sendPacket (Packet -> m ()) -> (Message -> Packet) -> Message -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Packet
Packet.Packet_Message
sendBundle :: SendOsc m => Packet.Bundle -> m ()
sendBundle :: forall (m :: * -> *). SendOsc m => Bundle -> m ()
sendBundle = Packet -> m ()
forall (m :: * -> *). SendOsc m => Packet -> m ()
sendPacket (Packet -> m ()) -> (Bundle -> Packet) -> Bundle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bundle -> Packet
Packet.Packet_Bundle
recvBundle :: (RecvOsc m) => m Packet.Bundle
recvBundle :: forall (m :: * -> *). RecvOsc m => m Bundle
recvBundle = (Packet -> Bundle) -> m Packet -> m Bundle
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Bundle
Packet.packet_to_bundle m Packet
forall (m :: * -> *). RecvOsc m => m Packet
recvPacket
recvMessage :: (RecvOsc m) => m (Maybe Packet.Message)
recvMessage :: forall (m :: * -> *). RecvOsc m => m (Maybe Message)
recvMessage = (Packet -> Maybe Message) -> m Packet -> m (Maybe Message)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Maybe Message
Packet.packet_to_message m Packet
forall (m :: * -> *). RecvOsc m => m Packet
recvPacket
recvMessage_err :: RecvOsc m => m Packet.Message
recvMessage_err :: forall (m :: * -> *). RecvOsc m => m Message
recvMessage_err = (Maybe Message -> Message) -> m (Maybe Message) -> m Message
forall a b. (a -> b) -> m a -> m 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")) m (Maybe Message)
forall (m :: * -> *). RecvOsc m => m (Maybe Message)
recvMessage
recvMessages :: (RecvOsc m) => m [Packet.Message]
recvMessages :: forall (m :: * -> *). RecvOsc m => m [Message]
recvMessages = (Packet -> [Message]) -> m Packet -> m [Message]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> [Message]
Packet.packetMessages m Packet
forall (m :: * -> *). RecvOsc m => m Packet
recvPacket
waitUntil :: (RecvOsc m) => (Packet.Packet -> Bool) -> m Packet.Packet
waitUntil :: forall (m :: * -> *). RecvOsc m => (Packet -> Bool) -> m Packet
waitUntil Packet -> Bool
f = (Packet -> Bool) -> m Packet -> m Packet
forall (m :: * -> *) a. Monad m => (a -> Bool) -> m a -> m a
Wait.untilPredicate Packet -> Bool
f m Packet
forall (m :: * -> *). RecvOsc m => m Packet
recvPacket
waitFor :: (RecvOsc m) => (Packet.Packet -> Maybe a) -> m a
waitFor :: forall (m :: * -> *) a. RecvOsc m => (Packet -> Maybe a) -> m a
waitFor Packet -> Maybe a
f = (Packet -> Maybe a) -> m Packet -> m a
forall (m :: * -> *) a b. Monad m => (a -> Maybe b) -> m a -> m b
Wait.untilMaybe Packet -> Maybe a
f m Packet
forall (m :: * -> *). RecvOsc m => m Packet
recvPacket
waitImmediate :: RecvOsc m => m Packet.Packet
waitImmediate :: forall (m :: * -> *). RecvOsc m => m Packet
waitImmediate = (Packet -> Bool) -> m Packet
forall (m :: * -> *). RecvOsc m => (Packet -> Bool) -> m Packet
waitUntil Packet -> Bool
Packet.packet_is_immediate
waitMessage :: RecvOsc m => m Packet.Message
waitMessage :: forall (m :: * -> *). RecvOsc m => m Message
waitMessage = (Packet -> Maybe Message) -> m Message
forall (m :: * -> *) a. RecvOsc m => (Packet -> Maybe a) -> m a
waitFor Packet -> Maybe Message
Packet.packet_to_message
waitAddress :: RecvOsc m => Packet.Address_Pattern -> m Packet.Packet
waitAddress :: forall (m :: * -> *). RecvOsc m => [Char] -> m Packet
waitAddress [Char]
s =
let f :: Packet -> Maybe Packet
f Packet
o = if [Char] -> Packet -> Bool
Packet.packet_has_address [Char]
s Packet
o then Packet -> Maybe Packet
forall a. a -> Maybe a
Just Packet
o else Maybe Packet
forall a. Maybe a
Nothing
in (Packet -> Maybe Packet) -> m Packet
forall (m :: * -> *) a. RecvOsc m => (Packet -> Maybe a) -> m a
waitFor Packet -> Maybe Packet
f
waitReply :: RecvOsc m => Packet.Address_Pattern -> m Packet.Message
waitReply :: forall (m :: * -> *). RecvOsc m => [Char] -> m Message
waitReply [Char]
s =
let f :: Packet -> 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)
-> (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 ([Char] -> Message -> Bool
Packet.message_has_address [Char]
s) ([Message] -> Maybe Message)
-> (Packet -> [Message]) -> Packet -> Maybe Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Packet -> [Message]
Packet.packetMessages
in (Packet -> Message) -> m Packet -> m Message
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Packet -> Message
f ([Char] -> m Packet
forall (m :: * -> *). RecvOsc m => [Char] -> m Packet
waitAddress [Char]
s)
waitDatum :: RecvOsc m => Packet.Address_Pattern -> m [Datum.Datum]
waitDatum :: forall (m :: * -> *). RecvOsc m => [Char] -> m [Datum]
waitDatum = (Message -> [Datum]) -> m Message -> m [Datum]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> [Datum]
Packet.messageDatum (m Message -> m [Datum])
-> ([Char] -> m Message) -> [Char] -> m [Datum]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m Message
forall (m :: * -> *). RecvOsc m => [Char] -> m Message
waitReply