hosc-0.19.1: Haskell Open Sound Control
Safe HaskellSafe-Inferred
LanguageHaskell2010

Sound.OSC

Description

Synopsis

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

Expand
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 liftIO, we would have ended up with this error:

• 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 IO a and returns an (m a): liftIO, enabling us to run the program and see the expected results:

> evalStateT printState "hello"
"hello"

> evalStateT printState 3
3

Instances

Instances details
MonadIO IO

Since: base-4.9.0.0

Instance details

Defined in Control.Monad.IO.Class

Methods

liftIO :: IO a -> IO a Source #

MonadIO m => MonadIO (ReaderT r m) 
Instance details

Defined in Control.Monad.Trans.Reader

Methods

liftIO :: IO a -> ReaderT r m a Source #

type UT = Double Source #

Unix/Posix time in real-valued (fractional) form. The Unix/Posix epoch is January 1, 1970.

type Time = Double Source #

NTP time in real-valued (fractional) form (ie. ntpr). This is the primary form of timestamp used by hosc.

type NTP64 = Word64 Source #

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_ntpi :: UT -> NTP64 Source #

Convert a UT timestamp to an NTPi timestamp.

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.

ut_epoch :: UTCTime Source #

The time at 1970-01-01:00:00:00.

utc_to_ut :: Fractional n => UTCTime -> n Source #

Convert UTCTime 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.

wait :: MonadIO m => Double -> m () Source #

Type restricted pauseThread.

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.

data Datum Source #

The basic elements of OSC messages.

Constructors

Int32 

Fields

Int64 

Fields

Float 

Fields

Double 

Fields

ASCII_String 

Fields

Blob 

Fields

TimeStamp 

Fields

Midi 

Fields

Instances

Instances details
Read Datum Source # 
Instance details

Defined in Sound.OSC.Datum

Show Datum Source # 
Instance details

Defined in Sound.OSC.Datum

Eq Datum Source # 
Instance details

Defined in Sound.OSC.Datum

Methods

(==) :: Datum -> Datum -> Bool Source #

(/=) :: Datum -> Datum -> Bool Source #

data MIDI Source #

Four-byte midi message: port-id, status-byte, data, data.

Constructors

MIDI !Word8 !Word8 !Word8 !Word8 

Instances

Instances details
Read MIDI Source # 
Instance details

Defined in Sound.OSC.Datum

Show MIDI Source # 
Instance details

Defined in Sound.OSC.Datum

Eq MIDI Source # 
Instance details

Defined in Sound.OSC.Datum

Methods

(==) :: MIDI -> MIDI -> Bool Source #

(/=) :: MIDI -> MIDI -> Bool Source #

type BLOB = ByteString Source #

Type for Word8 arrays, these are stored with an Int32 length prefix.

type ASCII = ByteString Source #

Type for ASCII strings (strict Char8 ByteString).

type Datum_Type = Char Source #

Type enumerating Datum categories.

ascii :: String -> ASCII Source #

Type-specialised pack.

ascii_to_string :: ASCII -> String Source #

Type-specialised unpack.

blob_pack :: [Word8] -> BLOB Source #

Type-specialised pack.

blob_unpack :: BLOB -> [Word8] Source #

Type-specialised unpack.

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.

datum_integral :: Integral i => Datum -> Maybe i Source #

Datum as Integral if Int32 or Int64.

let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]
map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing]

datum_floating :: Floating n => Datum -> Maybe n Source #

Datum as Floating if Int32, Int64, Float, Double or TimeStamp.

let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]
mapMaybe datum_floating d == replicate 5 (5::Double)

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")

midi :: (Word8, Word8, Word8, Word8) -> Datum Source #

Four-tuple variant of Midi . MIDI.

midi (0,0,0,0) == Midi (MIDI 0 0 0 0)

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>"

blobPP :: BLOB -> String Source #

Pretty printer for blobs, two-digit zero-padded hexadecimal.

stringPP :: String -> String Source #

Print strings in double quotes iff they contain white space.

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))

data Packet Source #

An OSC Packet is either a Message or a Bundle.

Instances

Instances details
Read Packet Source # 
Instance details

Defined in Sound.OSC.Packet

Show Packet Source # 
Instance details

Defined in Sound.OSC.Packet

Eq Packet Source # 
Instance details

Defined in Sound.OSC.Packet

data Bundle Source #

An OSC bundle, a Time and a sequence of Messages.

Constructors

Bundle 

Instances

Instances details
Read Bundle Source # 
Instance details

Defined in Sound.OSC.Packet

Show Bundle Source # 
Instance details

Defined in Sound.OSC.Packet

Eq Bundle Source # 
Instance details

Defined in Sound.OSC.Packet

Ord Bundle Source #

OSC Bundles can be ordered (time ascending).

Instance details

Defined in Sound.OSC.Packet

data Message Source #

An OSC message, an Address_Pattern and a sequence of Datum.

Constructors

Message 

Instances

Instances details
Read Message Source # 
Instance details

Defined in Sound.OSC.Packet

Show Message Source # 
Instance details

Defined in Sound.OSC.Packet

Eq Message Source # 
Instance details

Defined in Sound.OSC.Packet

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.

bundle :: Time -> [Message] -> Bundle Source #

Bundle constructor. It is an error if the Message list is empty.

packetTime :: Packet -> Time Source #

The Time of Packet, if the Packet is a Message this is immediately.

packetMessages :: Packet -> [Message] Source #

Retrieve the set of Messages from a Packet.

packet_to_bundle :: Packet -> Bundle Source #

If Packet is a Message add immediately timestamp, else id.

packet_to_message :: Packet -> Maybe Message Source #

If Packet is a Message or a Bundle with an immediate time tag and with one element, return the Message, else Nothing.

packet_is_immediate :: Packet -> Bool Source #

Is Packet immediate, ie. a Bundle with timestamp immediately, or a plain Message.

at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a Source #

Variant of either for Packet.

bundle_has_address :: Address_Pattern -> Bundle -> Bool Source #

Do any of the Messages at Bundle have the specified Address_Pattern.

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]])

bundlePP :: FP_Precision -> Bundle -> String Source #

Pretty printer for Bundle.

packetPP :: FP_Precision -> Packet -> String Source #

Pretty printer for Packet.

build_packet :: Packet -> Builder Source #

Builder for 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

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.

class (DuplexOSC m, MonadIO m) => Transport m Source #

Transport is DuplexOSC with a MonadIO constraint.

Instances

Instances details
(Transport t, MonadIO io) => Transport (ReaderT t io) Source #

Transport over ReaderT.

Instance details

Defined in Sound.OSC.Transport.Monad

class (SendOSC m, RecvOSC m) => DuplexOSC m Source #

DuplexOSC is the union of SendOSC and RecvOSC.

Instances

Instances details
(Transport t, MonadIO io) => DuplexOSC (ReaderT t io) Source #

DuplexOSC over ReaderT.

Instance details

Defined in Sound.OSC.Transport.Monad

class Monad m => RecvOSC m where Source #

Receiver monad.

Methods

recvPacket :: m Packet Source #

Receive and decode an OSC packet.

Instances

Instances details
(Transport t, MonadIO io) => RecvOSC (ReaderT t io) Source #

RecvOSC over ReaderT.

Instance details

Defined in Sound.OSC.Transport.Monad

class Monad m => SendOSC m where Source #

Sender monad.

Methods

sendPacket :: Packet -> m () Source #

Encode and send an OSC packet.

Instances

Instances details
(Transport t, MonadIO io) => SendOSC (ReaderT t io) Source #

SendOSC over ReaderT.

Instance details

Defined in Sound.OSC.Transport.Monad

Methods

sendPacket :: Packet -> ReaderT t io () Source #

withTransport :: Transport t => IO t -> Connection t r -> IO r Source #

Bracket Open Sound Control communication.

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.

waitImmediate :: RecvOSC m => m Packet Source #

waitUntil packet_is_immediate.

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.

newtype UDP Source #

The UDP transport handle data type.

Constructors

UDP 

Fields

Instances

Instances details
Transport UDP Source #

UDP is an instance of Transport.

Instance details

Defined in Sound.OSC.Transport.FD.UDP

udpPort :: Integral n => UDP -> IO n Source #

Return the port number associated with the UDP socket.

upd_send_packet :: UDP -> Packet -> IO () Source #

Send packet over UDP using sendAll.

udp_recv_packet :: UDP -> IO Packet Source #

Receive packet over UDP.

udp_close :: UDP -> IO () Source #

Close UDP.

with_udp :: IO UDP -> (UDP -> IO t) -> IO t Source #

Bracket UDP communication.

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.

openUDP :: String -> Int -> IO UDP Source #

Make a UDP connection.

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" []))

udp_server :: Int -> IO UDP Source #

Variant of udpServer that doesn't require the host address.

sendTo :: UDP -> Packet -> SockAddr -> IO () Source #

Send to specified address using 'C.sendAllTo.

recvFrom :: UDP -> IO (Packet, SockAddr) Source #

Recv variant to collect message source address.

newtype TCP Source #

The TCP transport handle data type.

Constructors

TCP 

Fields

Instances

Instances details
Transport TCP Source #

TCP is an instance of Transport.

Instance details

Defined in Sound.OSC.Transport.FD.TCP

tcp_send_packet :: TCP -> Packet -> IO () Source #

Send packet over TCP.

tcp_recv_packet :: TCP -> IO Packet Source #

Receive packet over TCP.

tcp_close :: TCP -> IO () Source #

Close TCP.

with_tcp :: IO TCP -> (TCP -> IO t) -> IO t Source #

Bracket UDP communication.

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)

tcp_server_f :: Socket -> (TCP -> IO ()) -> IO () Source #

accept connection at s and run f.

repeatM_ :: Monad m => m a -> m () Source #

tcp_server :: Int -> (TCP -> IO ()) -> IO () Source #

A trivial TCP OSC server.