Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Sound.OSC
Description
Composite of Sound.OSC.Core and Sound.OSC.Transport.Monad.
Synopsis
- class Monad m => MonadIO (m :: Type -> Type) where
- type UT = Double
- type Time = Double
- type NTP64 = Word64
- immediately :: Time
- ntpr_to_ntpi :: Time -> NTP64
- ntpi_to_ntpr :: NTP64 -> Time
- ntp_ut_epoch_diff :: Num n => n
- ut_to_ntpi :: UT -> NTP64
- ut_to_ntpr :: Num n => n -> n
- ntpr_to_ut :: Num n => n -> n
- ntpi_to_ut :: NTP64 -> UT
- ntpr_to_posixtime :: Time -> POSIXTime
- posixtime_to_ntpr :: POSIXTime -> Time
- ut_epoch :: UTCTime
- utc_to_ut :: Fractional n => UTCTime -> n
- time :: MonadIO m => m Time
- pauseThreadLimit :: Fractional n => n
- pauseThread :: (MonadIO m, RealFrac n) => n -> m ()
- wait :: MonadIO m => Double -> m ()
- pauseThreadUntil :: MonadIO m => Time -> m ()
- sleepThread :: (RealFrac n, MonadIO m) => n -> m ()
- sleepThreadUntil :: MonadIO m => Time -> m ()
- iso_8601_fmt :: String
- iso_8601_to_utctime :: String -> Maybe UTCTime
- utctime_to_iso_8601 :: UTCTime -> String
- ntpr_to_iso_8601 :: Time -> String
- iso_8601_to_ntpr :: String -> Maybe Time
- time_pp :: Time -> String
- type FP_Precision = Maybe Int
- data Datum
- data MIDI = MIDI !Word8 !Word8 !Word8 !Word8
- type BLOB = ByteString
- type ASCII = ByteString
- type Datum_Type = Char
- ascii :: String -> ASCII
- ascii_to_string :: ASCII -> String
- blob_pack :: [Word8] -> BLOB
- blob_unpack :: BLOB -> [Word8]
- osc_types_required :: [(Datum_Type, String)]
- osc_types_optional :: [(Datum_Type, String)]
- osc_types :: [(Datum_Type, String)]
- osc_type_name :: Datum_Type -> Maybe String
- osc_type_name_err :: Datum_Type -> String
- datum_tag :: Datum -> Datum_Type
- datum_type_name :: Datum -> (Datum_Type, String)
- datum_integral :: Integral i => Datum -> Maybe i
- datum_floating :: Floating n => Datum -> Maybe n
- int32 :: Integral n => n -> Datum
- int64 :: Integral n => n -> Datum
- float :: Real n => n -> Datum
- double :: Real n => n -> Datum
- string :: String -> Datum
- midi :: (Word8, Word8, Word8, Word8) -> Datum
- blob :: [Word8] -> Datum
- descriptor :: [Datum] -> ASCII
- descriptor_tags :: ASCII -> ASCII
- floatPP :: RealFloat n => FP_Precision -> n -> String
- timePP :: FP_Precision -> Time -> String
- vecPP :: (a -> String) -> [a] -> String
- blobPP :: BLOB -> String
- stringPP :: String -> String
- datumPP :: FP_Precision -> Datum -> String
- datum_pp_typed :: FP_Precision -> Datum -> String
- parse_datum :: Datum_Type -> String -> Maybe Datum
- parse_datum_err :: Datum_Type -> String -> Datum
- data Packet
- = Packet_Message {
- packetMessage :: !Message
- | Packet_Bundle {
- packetBundle :: !Bundle
- = Packet_Message {
- data Bundle = Bundle {
- bundleTime :: !Time
- bundleMessages :: ![Message]
- data Message = Message {
- messageAddress :: !Address_Pattern
- messageDatum :: ![Datum]
- type Address_Pattern = String
- message :: Address_Pattern -> [Datum] -> Message
- bundle :: Time -> [Message] -> Bundle
- p_bundle :: Time -> [Message] -> Packet
- p_message :: Address_Pattern -> [Datum] -> Packet
- packetTime :: Packet -> Time
- packetMessages :: Packet -> [Message]
- packet_to_bundle :: Packet -> Bundle
- packet_to_message :: Packet -> Maybe Message
- packet_is_immediate :: Packet -> Bool
- at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a
- message_has_address :: Address_Pattern -> Message -> Bool
- bundle_has_address :: Address_Pattern -> Bundle -> Bool
- packet_has_address :: Address_Pattern -> Packet -> Bool
- messagePP :: FP_Precision -> Message -> String
- bundlePP :: FP_Precision -> Bundle -> String
- packetPP :: FP_Precision -> Packet -> String
- build_packet :: Packet -> Builder
- encodePacket :: Packet -> ByteString
- encodeMessage :: Message -> ByteString
- encodeBundle :: Bundle -> ByteString
- encodePacket_strict :: Packet -> ByteString
- get_packet :: Get Packet
- decodeMessage :: ByteString -> Message
- decodeBundle :: ByteString -> Bundle
- decodePacket :: ByteString -> Packet
- decodePacket_strict :: ByteString -> Packet
- timeout_r :: Double -> IO a -> IO (Maybe a)
- untilPredicate :: Monad m => (a -> Bool) -> m a -> m a
- untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b
- type Connection t a = ReaderT t IO a
- class (DuplexOSC m, MonadIO m) => Transport m
- class (SendOSC m, RecvOSC m) => DuplexOSC m
- class Monad m => RecvOSC m where
- recvPacket :: m Packet
- class Monad m => SendOSC m where
- sendPacket :: Packet -> m ()
- withTransport :: Transport t => IO t -> Connection t r -> IO r
- withTransport_ :: Transport t => IO t -> Connection t r -> IO ()
- sendMessage :: SendOSC m => Message -> m ()
- sendBundle :: SendOSC m => Bundle -> m ()
- recvBundle :: RecvOSC m => m Bundle
- recvMessage :: RecvOSC m => m (Maybe Message)
- recvMessage_err :: RecvOSC m => m Message
- recvMessages :: RecvOSC m => m [Message]
- waitUntil :: RecvOSC m => (Packet -> Bool) -> m Packet
- waitFor :: RecvOSC m => (Packet -> Maybe a) -> m a
- waitImmediate :: RecvOSC m => m Packet
- waitMessage :: RecvOSC m => m Message
- waitAddress :: RecvOSC m => Address_Pattern -> m Packet
- waitReply :: RecvOSC m => Address_Pattern -> m Message
- waitDatum :: RecvOSC m => Address_Pattern -> m [Datum]
- newtype UDP = UDP {}
- udpPort :: Integral n => UDP -> IO n
- upd_send_packet :: UDP -> Packet -> IO ()
- udp_recv_packet :: UDP -> IO Packet
- udp_close :: UDP -> IO ()
- with_udp :: IO UDP -> (UDP -> IO t) -> IO t
- udp_socket :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO UDP
- set_udp_opt :: SocketOption -> Int -> UDP -> IO ()
- get_udp_opt :: SocketOption -> UDP -> IO Int
- openUDP :: String -> Int -> IO UDP
- udpServer :: String -> Int -> IO UDP
- udp_server :: Int -> IO UDP
- sendTo :: UDP -> Packet -> SockAddr -> IO ()
- recvFrom :: UDP -> IO (Packet, SockAddr)
- newtype TCP = TCP {}
- tcp_send_packet :: TCP -> Packet -> IO ()
- tcp_recv_packet :: TCP -> IO Packet
- tcp_close :: TCP -> IO ()
- with_tcp :: IO TCP -> (TCP -> IO t) -> IO t
- tcp_socket :: (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket
- socket_to_tcp :: Socket -> IO TCP
- tcp_handle :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO TCP
- openTCP :: String -> Int -> IO TCP
- tcp_server_f :: Socket -> (TCP -> IO ()) -> IO ()
- repeatM_ :: Monad m => m a -> m ()
- tcp_server :: Int -> (TCP -> IO ()) -> IO ()
Documentation
class Monad m => MonadIO (m :: Type -> Type) where Source #
Monads in which IO
computations may be embedded.
Any monad built by applying a sequence of monad transformers to the
IO
monad will be an instance of this class.
Instances should satisfy the following laws, which state that liftIO
is a transformer of monads:
Methods
liftIO :: IO a -> m a Source #
Lift a computation from the IO
monad.
This allows us to run IO computations in any monadic stack, so long as it supports these kinds of operations
(i.e. IO
is the base monad for the stack).
Example
import Control.Monad.Trans.State -- from the "transformers" library printState :: Show s => StateT s IO () printState = do state <- get liftIO $ print state
Had we omitted
, we would have ended up with this error:liftIO
• Couldn't match type ‘IO’ with ‘StateT s IO’ Expected type: StateT s IO () Actual type: IO ()
The important part here is the mismatch between StateT s IO ()
and
.IO
()
Luckily, we know of a function that takes an
and returns an IO
a(m a)
:
,
enabling us to run the program and see the expected results:liftIO
> evalStateT printState "hello" "hello" > evalStateT printState 3 3
Unix/Posix
time in real-valued (fractional) form.
The Unix/Posix epoch is January 1, 1970.
NTP
time in real-valued (fractional) form (ie. ntpr
).
This is the primary form of timestamp used by hosc.
Type for binary (integeral) representation of a 64-bit NTP
timestamp (ie. ntpi
).
The NTP epoch is January 1, 1900.
NTPv4 also includes a 128-bit format, which is not used by OSC.
immediately :: Time Source #
Constant indicating a bundle to be executed immediately.
It has the NTP64 representation of 1
.
ntpr_to_ntpi :: Time -> NTP64 Source #
Convert a real-valued NTP timestamp to an NTPi
timestamp.
ntpr_to_ntpi immediately == 1 fmap ntpr_to_ntpi time
ntpi_to_ntpr :: NTP64 -> Time Source #
Convert an NTPi
timestamp to a real-valued NTP timestamp.
ntp_ut_epoch_diff :: Num n => n Source #
Difference (in seconds) between NTP and UT epochs.
ntp_ut_epoch_diff / (24 * 60 * 60) == 25567 25567 `div` 365 == 70
ut_to_ntpr :: Num n => n -> n Source #
Convert Unix/Posix
to NTP
.
ntpr_to_ut :: Num n => n -> n Source #
Convert NTP
to Unix/Posix
.
ntpi_to_ut :: NTP64 -> UT Source #
Convert NTPi
to Unix/Posix
.
time :: MonadIO m => m Time Source #
Read current real-valued NTP
timestamp.
get_ct = fmap utc_to_ut T.getCurrentTime get_pt = fmap realToFrac T.getPOSIXTime (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1) print (pt - ct,pt - ct < 1e-5)
pauseThreadLimit :: Fractional n => n Source #
The pauseThread
limit (in seconds).
Values larger than this require a different thread delay mechanism, see sleepThread
.
The value is the number of microseconds in maxBound::Int
.
pauseThread :: (MonadIO m, RealFrac n) => n -> m () Source #
Pause current thread for the indicated duration (in seconds), see pauseThreadLimit
.
pauseThreadUntil :: MonadIO m => Time -> m () Source #
Pause current thread until the given Time
, see pauseThreadLimit
.
sleepThread :: (RealFrac n, MonadIO m) => n -> m () Source #
Sleep current thread for the indicated duration (in seconds).
Divides long sleeps into parts smaller than pauseThreadLimit
.
sleepThreadUntil :: MonadIO m => Time -> m () Source #
Sleep current thread until the given Time
.
Divides long sleeps into parts smaller than pauseThreadLimit
.
iso_8601_fmt :: String Source #
Detailed 37-character ISO 8601 format, including fractional seconds and '+0000' suffix.
iso_8601_to_utctime :: String -> Maybe UTCTime Source #
Parse time according to iso_8601_fmt
iso_8601_to_utctime "2015-11-26T00:29:37,145875000000+0000"
utctime_to_iso_8601 :: UTCTime -> String Source #
UTC time in iso_8601_fmt
.
tm <- fmap (utctime_to_iso_8601 . T.posixSecondsToUTCTime) T.getPOSIXTime (length tm,sum [4+1+2+1+2,1,2+1+2+1+2,1,12,1,4],sum [10,1,8,1,12,1,4]) == (37,37,37)
ntpr_to_iso_8601 :: Time -> String Source #
ISO 8601 of Time
.
tm <- fmap ntpr_to_iso_8601 time import System.Process {- process -} rawSystem "date" ["-d",tm]
t = 15708783354150518784 s = "2015-11-26T00:22:19,366058349609+0000" ntpr_to_iso_8601 (ntpi_to_ntpr t) == s
iso_8601_to_ntpr :: String -> Maybe Time Source #
Time
of ISO 8601.
t = 15708783354150518784 s = "2015-11-26T00:22:19,366058349609+0000" fmap ntpr_to_ntpi (iso_8601_to_ntpr s) == Just t
time_pp :: Time -> String Source #
Alias for ntpr_to_iso_8601
.
time_pp immediately == "1900-01-01T00:00:00,000000000000+0000" fmap time_pp time
type FP_Precision = Maybe Int Source #
Perhaps a precision value for floating point numbers.
The basic elements of OSC messages.
Constructors
Int32 | |
Int64 | |
Float | |
Double | |
ASCII_String | |
Fields
| |
Blob | |
TimeStamp | |
Fields
| |
Midi | |
Four-byte midi message: port-id, status-byte, data, data.
type ASCII = ByteString Source #
Type for ASCII strings (strict Char
8 ByteString
).
type Datum_Type = Char Source #
Type enumerating Datum categories.
osc_types_required :: [(Datum_Type, String)] Source #
List of required data types (tag,name).
osc_types_optional :: [(Datum_Type, String)] Source #
List of optional data types (tag,name).
osc_types :: [(Datum_Type, String)] Source #
List of all data types (tag,name).
osc_type_name :: Datum_Type -> Maybe String Source #
Lookup name of type.
osc_type_name_err :: Datum_Type -> String Source #
Erroring variant.
datum_tag :: Datum -> Datum_Type Source #
Single character identifier of an OSC datum.
datum_type_name :: Datum -> (Datum_Type, String) Source #
Type and name of Datum
.
int32 :: Integral n => n -> Datum Source #
Type generalised Int32
.
int32 (1::Int32) == int32 (1::Integer) d_int32 (int32 (maxBound::Int32)) == maxBound int32 (((2::Int) ^ (64::Int))::Int) == Int32 0
int64 :: Integral n => n -> Datum Source #
Type generalised Int64.
int64 (1::Int32) == int64 (1::Integer) d_int64 (int64 (maxBound::Int64)) == maxBound
float :: Real n => n -> Datum Source #
Type generalised Float.
float (1::Int) == float (1::Double) floatRange (undefined::Float) == (-125,128) isInfinite (d_float (float (encodeFloat 1 256 :: Double))) == True
double :: Real n => n -> Datum Source #
Type generalised Double.
double (1::Int) == double (1::Double) double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77
string :: String -> Datum Source #
ASCII_String
of pack
.
string "string" == ASCII_String (Char8.pack "string")
descriptor :: [Datum] -> ASCII Source #
Message argument types are given by a descriptor.
descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs"
descriptor_tags :: ASCII -> ASCII Source #
Descriptor tags are comma
prefixed.
floatPP :: RealFloat n => FP_Precision -> n -> String Source #
Variant of showFFloat
that deletes trailing zeros.
map (floatPP (Just 4)) [1,pi] == ["1.0","3.1416"]
timePP :: FP_Precision -> Time -> String Source #
Pretty printer for Time
.
timePP (Just 4) (1/3) == "0.3333"
vecPP :: (a -> String) -> [a] -> String Source #
Pretty printer for vectors.
vecPP show [1::Int,2,3] == "<1,2,3>"
datumPP :: FP_Precision -> Datum -> String Source #
Pretty printer for Datum
.
let d = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60),blob [12,16]] map (datumPP (Just 5)) d== ["1","1.2","str","M<0,144,64,96>","B<0C,10>"]
datum_pp_typed :: FP_Precision -> Datum -> String Source #
Variant of datumPP
that appends the datum_type_name
.
parse_datum :: Datum_Type -> String -> Maybe Datum Source #
Given Datum_Type
attempt to parse Datum
at String
.
parse_datum 'i' "42" == Just (Int32 42) parse_datum 'h' "42" == Just (Int64 42) parse_datum 'f' "3.14159" == Just (Float 3.14159) parse_datum 'd' "3.14159" == Just (Double 3.14159) parse_datum 's' "\"pi\"" == Just (string "pi") parse_datum 'b' "[112,105]" == Just (Blob (blob_pack [112,105])) parse_datum 'm' "(0,144,60,90)" == Just (midi (0,144,60,90))
parse_datum_err :: Datum_Type -> String -> Datum Source #
Erroring variant of parse_datum
.
Constructors
Packet_Message | |
Fields
| |
Packet_Bundle | |
Fields
|
Constructors
Bundle | |
Fields
|
Instances
Read Bundle Source # | |
Show Bundle Source # | |
Eq Bundle Source # | |
Ord Bundle Source # | OSC |
An OSC message, an Address_Pattern
and a sequence of Datum
.
Constructors
Message | |
Fields
|
type Address_Pattern = String Source #
OSC address pattern. This is strictly an ASCII value, however it
is very common to pattern match on addresses and matching on
Data.ByteString.Char8 requires OverloadedStrings
.
message :: Address_Pattern -> [Datum] -> Message Source #
Message
constructor. It is an error
if the Address_Pattern
doesn't conform to the OSC specification.
packetTime :: Packet -> Time Source #
The Time
of Packet
, if the Packet
is a Message
this is
immediately
.
packet_to_bundle :: Packet -> Bundle Source #
If Packet
is a Message
add immediately
timestamp, else id
.
packet_is_immediate :: Packet -> Bool Source #
Is Packet
immediate, ie. a Bundle
with timestamp
immediately
, or a plain Message.
message_has_address :: Address_Pattern -> Message -> Bool Source #
Does Message
have the specified Address_Pattern
.
bundle_has_address :: Address_Pattern -> Bundle -> Bool Source #
Do any of the Message
s at Bundle
have the specified
Address_Pattern
.
packet_has_address :: Address_Pattern -> Packet -> Bool Source #
Does Packet
have the specified Address_Pattern
, ie.
message_has_address
or bundle_has_address
.
messagePP :: FP_Precision -> Message -> String Source #
Pretty printer for Message
.
messagePP Nothing (Message "/m" [int32 0,float 1.0,string "s",midi (1,2,3,4),blob [1,2,3]])
encodePacket :: Packet -> ByteString Source #
Encode an OSC Packet
.
encodeMessage :: Message -> ByteString Source #
Encode an OSC Message
, ie. encodePacket
of Packet_Message
.
let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] encodeMessage (Message "/g_free" [Int32 0]) == L.pack m
encodeBundle :: Bundle -> ByteString Source #
Encode an OSC Bundle
, ie. encodePacket
of Packet_Bundle
.
let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] let b = [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,16] ++ m encodeBundle (Bundle immediately [Message "/g_free" [Int32 0]]) == L.pack b
encodePacket_strict :: Packet -> ByteString Source #
Encode an OSC Packet
to a strict ByteString
.
decodeMessage :: ByteString -> Message Source #
Decode an OSC Message
from a lazy ByteString.
let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] decodeMessage b == Message "/g_free" [Int32 0]
decodeBundle :: ByteString -> Bundle Source #
Decode an OSC Bundle
from a lazy ByteString.
decodePacket :: ByteString -> Packet Source #
Decode an OSC packet from a lazy ByteString.
let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] decodePacket b == Packet_Message (Message "/g_free" [Int32 0])
decodePacket_strict :: ByteString -> Packet Source #
Decode an OSC packet from a strict Char8 ByteString.
timeout_r :: Double -> IO a -> IO (Maybe a) Source #
Variant of timeout
where time is given in fractional seconds.
untilPredicate :: Monad m => (a -> Bool) -> m a -> m a Source #
Repeat action until predicate f is True
when applied to result.
untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b Source #
Repeat action until f does not give Nothing
when applied to result.
type Connection t a = ReaderT t IO a Source #
Transport connection.
withTransport :: Transport t => IO t -> Connection t r -> IO r Source #
Bracket Open Sound Control communication.
withTransport_ :: Transport t => IO t -> Connection t r -> IO () Source #
void
of withTransport
.
sendMessage :: SendOSC m => Message -> m () Source #
Type restricted synonym for sendOSC
.
sendBundle :: SendOSC m => Bundle -> m () Source #
Type restricted synonym for sendOSC
.
recvBundle :: RecvOSC m => m Bundle Source #
Variant of recvPacket
that runs packet_to_bundle
.
recvMessage :: RecvOSC m => m (Maybe Message) Source #
Variant of recvPacket
that runs packet_to_message
.
recvMessage_err :: RecvOSC m => m Message Source #
Erroring variant.
recvMessages :: RecvOSC m => m [Message] Source #
Variant of recvPacket
that runs packetMessages
.
waitUntil :: RecvOSC m => (Packet -> Bool) -> m Packet Source #
Wait for a Packet
where the supplied predicate is True
,
discarding intervening packets.
waitFor :: RecvOSC m => (Packet -> Maybe a) -> m a Source #
Wait for a Packet
where the supplied function does not give
Nothing
, discarding intervening packets.
waitMessage :: RecvOSC m => m Message Source #
waitFor
packet_to_message
, ie. an incoming Message
or
immediate mode Bundle
with one element.
waitAddress :: RecvOSC m => Address_Pattern -> m Packet Source #
A waitFor
for variant using packet_has_address
to match on
the Address_Pattern
of incoming Packets
.
waitReply :: RecvOSC m => Address_Pattern -> m Message Source #
Variant on waitAddress
that returns matching Message
.
waitDatum :: RecvOSC m => Address_Pattern -> m [Datum] Source #
Variant of waitReply
that runs messageDatum
.
The UDP transport handle data type.
udp_socket :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO UDP Source #
Create and initialise UDP socket.
set_udp_opt :: SocketOption -> Int -> UDP -> IO () Source #
Set option, ie. Broadcast
or RecvTimeOut
.
get_udp_opt :: SocketOption -> UDP -> IO Int Source #
Get option.
udpServer :: String -> Int -> IO UDP Source #
Trivial UDP
server socket.
import Control.Concurrent
let u0 = udpServer "127.0.0.1" 57300 t0 <- forkIO (FD.withTransport u0 (\fd -> forever (FD.recvMessage fd >>= print)))
let u1 = openUDP "127.0.0.1" 57300 FD.withTransport u1 (\fd -> FD.sendMessage fd (Packet.message "/n" []))
The TCP transport handle data type.
tcp_socket :: (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket Source #
Create and initialise TCP socket.
tcp_handle :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO TCP Source #
Create and initialise TCP.
openTCP :: String -> Int -> IO TCP Source #
Make a TCP
connection.
import Sound.OSC.Datum import Sound.OSC.Time let t = openTCP "127.0.0.1" 57110 let m1 = Packet.message "/dumpOSC" [Int32 1] let m2 = Packet.message "/g_new" [Int32 1] FD.withTransport t (\fd -> let f = FD.sendMessage fd in f m1 >> pauseThread 0.25 >> f m2)