Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Composite of Sound.Osc.Core and Sound.Osc.Transport.Monad.
Synopsis
- class Monad m => MonadIO (m :: Type -> Type) where
- data Message = Message {
- messageAddress :: !Address_Pattern
- messageDatum :: ![Datum]
- data Datum
- type Packet = PacketOf Message
- type Time = Double
- type DatumType = Char
- type Address_Pattern = String
- type Ntp64 = Word64
- class (DuplexOsc m, MonadIO m) => Transport m
- data OscProtocol
- type Ascii = ByteString
- type Blob = ByteString
- data MidiData = MidiData !Word8 !Word8 !Word8 !Word8
- data BundleOf t = Bundle {
- bundleTime :: !Time
- bundleMessages :: ![t]
- type Bundle = BundleOf Message
- data PacketOf t
- = Packet_Message {
- packetMessage :: !Message
- | Packet_Bundle {
- packetBundle :: !(BundleOf t)
- = Packet_Message {
- type NtpReal = Double
- type PosixReal = Double
- class Monad m => SendOsc m where
- sendPacket :: PacketOf Message -> m ()
- class Monad m => RecvOsc m where
- recvPacket :: m (PacketOf Message)
- class (SendOsc m, RecvOsc m) => DuplexOsc m
- type Connection t a = ReaderT t IO a
- type OscHostname = String
- type OscPort = Int
- type OscSocketAddress = (OscProtocol, OscHostname, OscPort)
- data OscSocket
- time :: MonadIO m => m NtpReal
- string :: String -> Datum
- ascii :: String -> Ascii
- float :: Real n => n -> Datum
- double :: Real n => n -> Datum
- decodeMessage :: ByteString -> Message
- decodeBundle :: ByteString -> BundleOf Message
- decodePacket :: ByteString -> PacketOf Message
- get_packet :: Get (PacketOf Message)
- decodePacket_strict :: ByteString -> PacketOf Message
- decodeMessageOr :: ByteString -> Either String Message
- decodeBundleOr :: ByteString -> Either String Bundle
- decodePacketOr :: ByteString -> Either String Packet
- build_packet :: PacketOf Message -> Builder
- encodeMessage :: Message -> ByteString
- encodeBundle :: BundleOf Message -> ByteString
- encodePacket :: PacketOf Message -> ByteString
- encodePacket_strict :: PacketOf Message -> ByteString
- getSystemTimeAsNtpReal :: IO NtpReal
- pauseThreadLimit :: Fractional n => n
- untilPredicate :: Monad m => (a -> Bool) -> m a -> m a
- ascii_to_string :: Ascii -> String
- blob_pack :: [Word8] -> Blob
- blob_pack_int :: [Int] -> Blob
- blob_unpack :: Blob -> [Word8]
- blob_unpack_int :: Blob -> [Int]
- midi_pack :: [Word8] -> MidiData
- midi_pack_int :: [Int] -> MidiData
- midi_unpack_int :: MidiData -> [Int]
- osc_types_required :: [(DatumType, String)]
- osc_types_optional :: [(DatumType, String)]
- osc_types :: [(DatumType, String)]
- osc_type_name :: DatumType -> Maybe String
- osc_type_name_err :: DatumType -> String
- datum_tag :: Datum -> DatumType
- datum_type_name :: Datum -> (DatumType, 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
- midi :: (Word8, Word8, Word8, Word8) -> Datum
- blob :: [Word8] -> Datum
- signatureFor :: [Datum] -> String
- descriptor :: [Datum] -> Ascii
- descriptor_tags :: Ascii -> Ascii
- message :: Address_Pattern -> [Datum] -> Message
- messageSignature :: Message -> String
- messageDescriptor :: Message -> Ascii
- bundle :: Time -> [t] -> BundleOf t
- p_bundle :: Time -> [t] -> PacketOf t
- p_message :: Address_Pattern -> [Datum] -> PacketOf t
- immediately :: Time
- packetTime :: PacketOf t -> Time
- at_packet :: (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a
- packetMessages :: PacketOf Message -> [Message]
- packet_to_bundle :: PacketOf Message -> BundleOf Message
- packet_to_message :: PacketOf Message -> Maybe Message
- packet_is_immediate :: PacketOf t -> Bool
- message_has_address :: Address_Pattern -> Message -> Bool
- bundle_has_address :: Address_Pattern -> BundleOf Message -> Bool
- packet_has_address :: Address_Pattern -> PacketOf Message -> Bool
- ntpr_to_ntpi :: NtpReal -> Ntp64
- ntpi_to_ntpr :: Ntp64 -> NtpReal
- ntp_posix_epoch_diff :: Num n => n
- posix_to_ntpi :: PosixReal -> Ntp64
- posix_to_ntpr :: Num n => n -> n
- ntpr_to_posix :: Num n => n -> n
- ntpi_to_posix :: Ntp64 -> PosixReal
- ntpr_to_posixtime :: NtpReal -> POSIXTime
- posixtime_to_ntpr :: POSIXTime -> NtpReal
- posix_epoch :: UTCTime
- utc_to_posix :: Fractional n => UTCTime -> n
- getCurrentTimeAsPosix :: IO PosixReal
- getPosixTimeAsPosix :: IO PosixReal
- currentTime :: IO NtpReal
- getSystemTimeInMicroseconds :: IO (Int64, Word32)
- pauseThreadFor :: RealFrac n => n -> IO ()
- pauseThreadUntilTime :: RealFrac n => n -> IO ()
- sleepThreadFor :: RealFrac n => n -> IO ()
- sleepThreadUntilTime :: RealFrac n => n -> IO ()
- wait :: MonadIO m => Double -> m ()
- pauseThread :: (MonadIO m, RealFrac n) => n -> m ()
- sleepThread :: (RealFrac n, MonadIO m) => n -> m ()
- pauseThreadUntil :: (MonadIO m, RealFrac n) => n -> m ()
- sleepThreadUntil :: (RealFrac n, MonadIO m) => n -> m ()
- untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b
- withTransport :: Transport t => IO t -> Connection t r -> IO r
- sendMessage :: SendOsc m => Message -> m ()
- sendBundle :: SendOsc m => BundleOf Message -> m ()
- recvBundle :: RecvOsc m => m (BundleOf Message)
- recvMessage :: RecvOsc m => m (Maybe Message)
- recvMessage_err :: RecvOsc m => m Message
- recvMessages :: RecvOsc m => m [Message]
- waitUntil :: RecvOsc m => (PacketOf Message -> Bool) -> m (PacketOf Message)
- waitFor :: RecvOsc m => (PacketOf Message -> Maybe a) -> m a
- waitImmediate :: RecvOsc m => m (PacketOf Message)
- waitMessage :: RecvOsc m => m Message
- waitAddress :: RecvOsc m => Address_Pattern -> m (PacketOf Message)
- waitReply :: RecvOsc m => Address_Pattern -> m Message
- waitDatum :: RecvOsc m => Address_Pattern -> m [Datum]
- withTransport_ :: Transport t => IO t -> Connection t r -> IO ()
- openOscSocket :: OscSocketAddress -> IO OscSocket
Documentation
class Monad m => MonadIO (m :: Type -> Type) where #
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:
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
Instances
An Osc message, an Address_Pattern
and a sequence of Datum
.
Message | |
|
The basic elements of Osc messages.
Int32 | |
Int64 | |
Float | |
Double | |
AsciiString | |
| |
Blob | |
TimeStamp | |
| |
Midi | |
A real-valued time stamp. For Osc proper this is an Ntp64 time in real-valued (fractional) form. For SuperCollider Nrt programs this is elapsed time since the start of the score. This is the primary form of timestamp used by hosc.
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
.
Type for binary (integeral) representation of a 64-bit Ntp timestamp (ie. ntpi). The Ntp epoch is January 1, 1900. Ntp v4 also includes a 128-bit format, which is not used by Osc.
data OscProtocol Source #
Protocol, either Udp or Tcp
Instances
Read OscProtocol Source # | |
Defined in Sound.Osc.Transport.Fd.Socket readsPrec :: Int -> ReadS OscProtocol # readList :: ReadS [OscProtocol] # readPrec :: ReadPrec OscProtocol # readListPrec :: ReadPrec [OscProtocol] # | |
Show OscProtocol Source # | |
Defined in Sound.Osc.Transport.Fd.Socket showsPrec :: Int -> OscProtocol -> ShowS # show :: OscProtocol -> String # showList :: [OscProtocol] -> ShowS # | |
Eq OscProtocol Source # | |
Defined in Sound.Osc.Transport.Fd.Socket (==) :: OscProtocol -> OscProtocol -> Bool # (/=) :: OscProtocol -> OscProtocol -> Bool # |
type Ascii = ByteString Source #
Type for Ascii strings (strict Char8 ByteString)
Four-byte midi message: port-id, status-byte, data, data.
An Osc bundle, a Time
and a sequence of Message
s.
The type parameter specifies the element type.
Ordinarily this is Message, which does not allow recursion.
Bundle | |
|
Instances
Read t => Read (BundleOf t) Source # | |
Show t => Show (BundleOf t) Source # | |
Eq t => Eq (BundleOf t) Source # | |
Eq t => Ord (BundleOf t) Source # | Osc |
Packet_Message | |
| |
Packet_Bundle | |
|
type PosixReal = Double Source #
Unix/Posix
time in real-valued (fractional) form.
The Unix/Posix epoch is January 1, 1970.
class Monad m => SendOsc m where Source #
Sender monad.
sendPacket :: PacketOf Message -> m () Source #
Encode and send an Osc packet.
class Monad m => RecvOsc m where Source #
Receiver monad.
recvPacket :: m (PacketOf Message) Source #
Receive and decode an Osc packet.
type Connection t a = ReaderT t IO a Source #
Transport connection.
type OscHostname = String Source #
Hostname
type OscSocketAddress = (OscProtocol, OscHostname, OscPort) Source #
Socket address
string :: String -> Datum Source #
AsciiString
of pack.
>>>
string "string" == AsciiString (ByteString.Char8.pack "string")
True
float :: Real n => n -> Datum Source #
Type generalised Float.
>>>
float (1::Int) == float (1::Double)
True
>>>
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)
True
>>>
double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77
True
decodeMessage :: ByteString -> Message Source #
Decode an Osc Message
from a lazy ByteString.
>>>
let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]
>>>
decodeMessage b == Message "/g_free" [Int32 0]
True
decodeBundle :: ByteString -> BundleOf Message Source #
Decode an Osc BundleOf
from a lazy ByteString.
decodePacket :: ByteString -> PacketOf Message Source #
Decode an Osc packet from a lazy ByteString.
>>>
let b = ByteString.Lazy.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])
True
decodePacket_strict :: ByteString -> PacketOf Message Source #
Decode an Osc packet from a strict Char8 ByteString.
decodeMessageOr :: ByteString -> Either String Message Source #
Either decode Osc message or return an error message. Prevents application halt for non-valid messagebundlepacket arrives.
>>>
let b = ByteString.Lazy.pack [1,2,3,2,1]
>>>
decodePacketOr b
Left "not enough bytes"
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
True
encodeBundle :: BundleOf Message -> ByteString Source #
Encode an Osc BundleOf
, 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
True
encodePacket :: PacketOf Message -> ByteString Source #
Encode an Osc Packet
.
encodePacket_strict :: PacketOf Message -> ByteString Source #
Encode an Osc Packet
to a strict ByteString
.
getSystemTimeAsNtpReal :: IO NtpReal Source #
Get the system time, epoch start of 1970 UTC, leap-seconds ignored. getSystemTime is typically much faster than getCurrentTime, however it is not available in Hugs.
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
.
untilPredicate :: Monad m => (a -> Bool) -> m a -> m a Source #
Repeat action until predicate f is True
when applied to result.
ascii_to_string :: Ascii -> String Source #
Type-specialised unpack.
blob_pack_int :: [Int] -> Blob Source #
Type-specialised pack.
blob_unpack :: Blob -> [Word8] Source #
Type-specialised unpack.
blob_unpack_int :: Blob -> [Int] Source #
Type-specialised unpack.
midi_pack_int :: [Int] -> MidiData Source #
Type-specialised pack.
midi_unpack_int :: MidiData -> [Int] Source #
Type-specialised unpack.
osc_types_required :: [(DatumType, String)] Source #
List of required data types (tag, name).
osc_types_optional :: [(DatumType, String)] Source #
List of optional data types (tag,name).
osc_type_name_err :: DatumType -> String Source #
Erroring variant.
int32 :: Integral n => n -> Datum Source #
Type generalised Datum
.
>>>
int32 (1::Int32) == int32 (1::Integer)
True
>>>
d_int32 (int32 (maxBound::Int32)) == maxBound
True
>>>
int32 (((2::Int) ^ (64::Int))::Int) == Int32 0
True
int64 :: Integral n => n -> Datum Source #
Type generalised Int64.
>>>
int64 (1::Int32) == int64 (1::Integer)
True
>>>
d_int64 (int64 (maxBound::Int64)) == maxBound
True
signatureFor :: [Datum] -> String Source #
Message argument types are given by a signature.
>>>
signatureFor [Int32 1,Float 1,string "1"]
",ifs"
descriptor :: [Datum] -> Ascii Source #
The descriptor is an Ascii encoded signature.
>>>
descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs"
True
descriptor_tags :: Ascii -> Ascii Source #
Descriptor tags are comma
prefixed.
message :: Address_Pattern -> [Datum] -> Message Source #
Message
constructor. It is an error
if the Address_Pattern
doesn't conform to the Osc specification.
messageSignature :: Message -> String Source #
messageDescriptor :: Message -> Ascii Source #
immediately :: Time Source #
Constant indicating a bundle to be executed immediately.
It has the Ntp64 representation of 1
.
>>>
immediately == (1 / (2 ^ 32))
True
packetTime :: PacketOf t -> Time Source #
The Time
of Packet
, if the Packet
is a Message
this is immediately
.
packet_to_bundle :: PacketOf Message -> BundleOf Message Source #
If Packet
is a Message
add immediately
timestamp, else id
.
packet_is_immediate :: PacketOf t -> Bool Source #
Is Packet
immediate, ie. a BundleOf
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 -> BundleOf Message -> Bool Source #
Do any of the Message
s at 'Bundle Message' have the specified
Address_Pattern
.
packet_has_address :: Address_Pattern -> PacketOf Message -> Bool Source #
Does Packet
have the specified Address_Pattern
, ie.
message_has_address
or bundle_has_address
.
ntpr_to_ntpi :: NtpReal -> Ntp64 Source #
Convert an NtpReal timestamp to an Ntp64 timestamp.
>>>
ntpr_to_ntpi 0
0
fmap ntpr_to_ntpi time
ntpi_to_ntpr :: Ntp64 -> NtpReal Source #
Convert an Ntp64
timestamp to a real-valued Ntp timestamp.
>>>
ntpi_to_ntpr 0
0.0
ntp_posix_epoch_diff :: Num n => n Source #
Difference (in seconds) between Ntp and Posix epochs.
>>>
ntp_posix_epoch_diff / (24 * 60 * 60)
25567.0
>>>
25567 `div` 365
70
posix_to_ntpi :: PosixReal -> Ntp64 Source #
Convert a PosixReal timestamp to an Ntp64 timestamp.
posix_to_ntpr :: Num n => n -> n Source #
Convert Unix/Posix
to Ntp
.
ntpr_to_posix :: Num n => n -> n Source #
Convert Ntp
to Unix/Posix
.
posix_epoch :: UTCTime Source #
The time at 1970-01-01:00:00:00 which is the Unix/Posix epoch.
utc_to_posix :: Fractional n => UTCTime -> n Source #
Convert UTCTime
to Unix/Posix
.
getCurrentTimeAsPosix :: IO PosixReal Source #
utc_to_posix of Clock.getCurrentTime.
getPosixTimeAsPosix :: IO PosixReal Source #
realToFrac of Clock.Posix.getPOSIXTime
get_ct = getCurrentTimeAsPosix get_pt = getPosixTimeAsPosix (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1) print (pt - ct,pt - ct < 1e-5)
currentTime :: IO NtpReal Source #
Read current real-valued Ntp
timestamp.
getSystemTimeInMicroseconds :: IO (Int64, Word32) Source #
System time with fractional part in microseconds (us) instead of nanoseconds (ns).
pauseThreadFor :: RealFrac n => n -> IO () Source #
Pause current thread for the indicated duration (in seconds), see pauseThreadLimit
.
pauseThreadUntilTime :: RealFrac n => n -> IO () Source #
Pause current thread until the given time, see pauseThreadLimit
.
sleepThreadFor :: RealFrac n => n -> IO () Source #
Sleep current thread for the indicated duration (in seconds).
Divides long sleeps into parts smaller than pauseThreadLimit
.
sleepThreadUntilTime :: RealFrac n => n -> IO () Source #
Sleep current thread until the given time.
Divides long sleeps into parts smaller than pauseThreadLimit
.
pauseThread :: (MonadIO m, RealFrac n) => n -> m () Source #
sleepThread :: (RealFrac n, MonadIO m) => n -> m () Source #
pauseThreadUntil :: (MonadIO m, RealFrac n) => n -> m () Source #
sleepThreadUntil :: (RealFrac n, MonadIO m) => n -> m () Source #
untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b Source #
Repeat action until f does not give Nothing
when applied to result.
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
.
recvBundle :: RecvOsc m => m (BundleOf Message) 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 => (PacketOf Message -> Bool) -> m (PacketOf Message) Source #
Wait for a Packet
where the supplied predicate is True
,
discarding intervening packets.
waitFor :: RecvOsc m => (PacketOf Message -> 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 (PacketOf Message) 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
.
withTransport_ :: Transport t => IO t -> Connection t r -> IO () Source #
void
of withTransport
.
openOscSocket :: OscSocketAddress -> IO OscSocket Source #
Open socket at address